diff lisp/simple.el @ 83386:db4e74787e6f

Merged from miles@gnu.org--gnu-2005 (patch 133-141, 596-609) Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-596 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-597 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-598 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-599 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-600 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-601 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-602 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-603 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-604 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-605 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-606 Remove lisp/toolbar directory * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-607 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-608 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-609 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-133 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-134 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-135 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-136 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-137 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-138 Update from CVS: texi/gnus.texi (RSS): Fix key description. * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-139 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-140 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-141 Update from CVS: texi/gnus.texi (Document Server Internals): Addition. git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-426
author Karoly Lorentey <lorentey@elte.hu>
date Wed, 19 Oct 2005 14:06:17 +0000
parents 08b4dd6a6e87 13abee3a9bc6
children 0181341f0aca
line wrap: on
line diff
--- a/lisp/simple.el	Wed Oct 19 14:03:44 2005 +0000
+++ b/lisp/simple.el	Wed Oct 19 14:06:17 2005 +0000
@@ -4848,10 +4848,13 @@
   "Normal hook run at the end of setting up a completion list buffer.
 When this hook is run, the current buffer is the one in which the
 command to display the completion list buffer was run.
-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.
+The completion list buffer is available as the value of `standard-output'.
+The common prefix substring for completion may be available as the 
+value of `completion-common-substring'. See also `display-completion-list'.")
+
+
+;; Variables and faces used in `completion-setup-function'.
+
 (defface completions-first-difference
   '((t (:inherit bold)))
   "Face put on the first uncommon character in completions in *Completions* buffer."
@@ -4871,6 +4874,17 @@
 (defvar completion-root-regexp "^/"
   "Regexp to use in `completion-setup-function' to find the root directory.")
 
+(defvar completion-common-substring nil
+  "Common prefix substring to use in `completion-setup-function' to put faces.
+The value is set by `display-completion-list' during running `completion-setup-hook'.
+
+To put faces, `completions-first-difference' and `completions-common-part' 
+into \"*Completions*\* buffer, the common prefix substring in completions is
+needed as a hint. (Minibuffer is a special case. The content of minibuffer itself 
+is the substring.)")
+
+;; This function goes in completion-setup-hook, so that it is called
+;; after the text of the completion list buffer is written.
 (defun completion-setup-function ()
   (let ((mainbuf (current-buffer))
 	(mbuf-contents (minibuffer-contents)))
@@ -4909,9 +4923,11 @@
 		      (funcall (get minibuffer-completion-table 'completion-base-size-function)))
 	      (setq completion-base-size 0))))
       ;; Put faces on first uncommon characters and common parts.
-      (when completion-base-size
+      (when (or completion-base-size completion-common-substring)
 	(let* ((common-string-length
-		(- (length mbuf-contents) completion-base-size))
+		(if completion-base-size
+		    (- (length mbuf-contents) completion-base-size)
+		  (length completion-common-substring)))
 	       (element-start (next-single-property-change
 			       (point-min)
 			       'mouse-face))