(completion-setup-function): Emphasize the first uncommon characters in the completio...

(completion-emphasis): New face.
(completion-de-emphasis): New face.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f9597cdbe4d2a84203a8448780c8267d7b229c7a..89a18361dddd67e162ae09c43fd8b9c449c73a93 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2004-03-26  Masatake YAMATO  <jet@gyve.org>
+
+       * simple.el (completion-setup-function): Emphasize the
+       first uncommon characters in the completions;and de-emphasize
+       the common prefix substrings.
+       (completion-emphasis): New face.
+       (completion-de-emphasis): New face.
+
 2004-03-25  Sam Steingold  <sds@gnu.org>
 
        * vc.el (vc-print-log): Fixed a bug in the last patch:

diff --git a/lisp/simple.el b/lisp/simple.el
index f41b9cbd11a292af05485fc9370f63c0449c6616..6bc89ae175046442343371fe2068ce3a0d4b064b 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4116,6 +4116,15 @@ The completion list buffer is available as the value of `standard-output'.")
 
 ;; This function goes in completion-setup-hook, so that it is called
 ;; after the text of the completion list buffer is written.
+(defface completion-emphasis 
+  '((t (:inherit bold)))
+  "Face put on the first uncommon character in completions in *Completions* buffer."
+  :group 'completion)
+
+(defface completion-de-emphasis 
+  '((t (:inherit default)))
+  "Face put on the common prefix substring in completions in *Completions* buffer."
+  :group 'completion)
 
 (defun completion-setup-function ()
   (save-excursion
@@ -4145,6 +4154,27 @@ The completion list buffer is available as the value of `standard-output'.")
        (save-match-data
          (if (minibufferp mainbuf)
              (setq completion-base-size 0))))
+       ;; Put emphasis and de-emphasis faces on completions.
+      (when completion-base-size
+       (let ((common-string-length (length 
+                                    (substring mbuf-contents 
+                                               completion-base-size)))
+             (element-start (next-single-property-change 
+                             (point-min)
+                             'mouse-face))
+             element-common-end)
+         (while element-start
+           (setq element-common-end  (+ element-start common-string-length))
+           (when (and (get-char-property element-start 'mouse-face)
+                      (get-char-property element-common-end 'mouse-face))
+             (put-text-property element-start element-common-end
+                                'font-lock-face 'completion-de-emphasis)
+             (put-text-property element-common-end (1+ element-common-end)
+                                'font-lock-face 'completion-emphasis))
+           (setq element-start (next-single-property-change 
+                                element-start
+                                'mouse-face)))))
+      ;; Insert help string.
       (goto-char (point-min))
       (if (display-mouse-p)
          (insert (substitute-command-keys