diff lisp/simple.el @ 83082:108bb5537c12

Merged in changes from CVS HEAD Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-161 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-162 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-163 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-164 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-165 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-166 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-167 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-168 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-169 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-170 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-171 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-172 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-122
author Karoly Lorentey <lorentey@elte.hu>
date Thu, 25 Mar 2004 22:21:45 +0000
parents f1717549fabe
children 2a24736eb420 0d3eea319893
line wrap: on
line diff
--- a/lisp/simple.el	Fri Mar 19 23:21:11 2004 +0000
+++ b/lisp/simple.el	Thu Mar 25 22:21:45 2004 +0000
@@ -4116,6 +4116,15 @@
 
 ;; 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 @@
 	(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