* message.el (message-expand-group): Pass the common

prefix substring of completion to `display-completion-list'.

* mh-comp.el (mh-complete-word): Pass the common
prefix substring of completion to `display-completion-list'.

* dabbrev.el (dabbrev-completion): Pass the common
prefix substring of completion to `display-completion-list'.

* filecache.el (file-cache-minibuffer-complete)
(file-cache-complete): Ditto.

* tempo.el (tempo-display-completions): Ditto.

* wid-edit.el (widget-file-complete, widget-color-complete): Ditto.

* emacs-lisp/lisp.el (lisp-complete-symbol): Ditto.

* eshell/em-hist.el (eshell-list-history): Ditto.

* mail/mailabbrev.el (mail-abbrev-complete-alias): Ditto.

* progmodes/etags.el (complete-tag): Ditto.

* progmodes/make-mode.el (makefile-complete): Ditto.

* progmodes/meta-mode.el (meta-complete-symbol): Ditto.

* progmodes/octave-mod.el (octave-complete-symbol): Ditto.

* progmodes/pascal.el (pascal-complete-word)
(pascal-show-completions): Ditto.

* textmodes/bibtex.el (bibtex-complete-internal): Ditto.

* simple.el (completion-common-substring): New variable.
(completion-setup-function): Use `completion-common-substring'
to put faces.

* minibuf.c (Fdisplay_completion_list): Add new optional
argument COMMON_SUBSTRING. Bind `completion-common-substring'
to the optional argument during running `completion-setup-hook'.

19 files changed, 100 insertions, 24 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e5a4976e73..a40199fd91 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,44 @@
+2005-10-16  Masatake YAMATO  <[email protected]>
+
+	* dabbrev.el (dabbrev-completion): Pass the common
+	prefix substring of completion to `display-completion-list'.
+
+	* filecache.el (file-cache-minibuffer-complete)
+	(file-cache-complete): Ditto.
+
+	* tempo.el (tempo-display-completions): Ditto.
+
+	* wid-edit.el (widget-file-complete, widget-color-complete): Ditto.
+
+	* emacs-lisp/lisp.el (lisp-complete-symbol): Ditto.
+
+	* eshell/em-hist.el (eshell-list-history): Ditto.
+
+	* mail/mailabbrev.el (mail-abbrev-complete-alias): Ditto.
+
+	* mail/mailalias.el (mail-complete): Ditto.
+
+	* progmodes/etags.el (complete-tag): Ditto.
+
+	* progmodes/make-mode.el (makefile-complete): Ditto.
+
+	* progmodes/meta-mode.el (meta-complete-symbol): Ditto.
+
+	* progmodes/octave-mod.el (octave-complete-symbol): Ditto.
+
+	* progmodes/pascal.el (pascal-complete-word)
+	(pascal-show-completions): Ditto.
+
+	* progmodes/python.el (python-complete-symbol): Ditto.
+
+	* textmodes/bibtex.el (bibtex-complete-internal): Ditto.
+
+	* textmodes/org.el (org-complete): Ditto.
+
+	* simple.el (completion-common-substring): New variable.
+	(completion-setup-function): Use `completion-common-substring'
+	to put faces.
+
 2005-10-16  YAMAMOTO Mitsuharu  <[email protected]>
 
 	* term/mac-win.el: Apply 2005-10-09 change for term/x-win.el.
diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el
index 2139e7c576..b330f2b10d 100644
--- a/lisp/dabbrev.el
+++ b/lisp/dabbrev.el
@@ -461,7 +461,8 @@ if there is a suitable one already."
       ;; * String is a common substring completion already.  Make list.
       (message "Making completion list...")
       (with-output-to-temp-buffer "*Completions*"
-	(display-completion-list (all-completions init my-obarray)))
+	(display-completion-list (all-completions init my-obarray)
+				 init))
       (message "Making completion list...done")))
     (and (window-minibuffer-p (selected-window))
 	 (message nil))))
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index d248882d88..4b799ebfed 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -586,7 +586,7 @@ considered."
 			 (setq list (cdr list)))
 		       (setq list (nreverse new))))
 		 (with-output-to-temp-buffer "*Completions*"
-		   (display-completion-list list)))
+		   (display-completion-list list pattern)))
 	       (message "Making completion list...%s" "done")))))))
 
 ;;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index fd887e5fa8..e784402854 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -507,7 +507,7 @@ See also `eshell-read-history'."
 	;; Change "completion" to "history reference"
 	;; to make the display accurate.
 	(with-output-to-temp-buffer history-buffer
-	  (display-completion-list history)
+	  (display-completion-list history prefix)
 	  (set-buffer history-buffer)
 	  (forward-line 3)
 	  (while (search-backward "completion" nil 'move)
diff --git a/lisp/filecache.el b/lisp/filecache.el
index bb45bb392f..442f729dd1 100644
--- a/lisp/filecache.el
+++ b/lisp/filecache.el
@@ -607,7 +607,7 @@ the name is considered already unique; only the second substitution
 			    completion-setup-hook)))
 		    )
 		(with-output-to-temp-buffer file-cache-completions-buffer
-		  (display-completion-list completion-list))
+		  (display-completion-list completion-list string))
 		)
 	      )
 	  (setq file-cache-string (file-cache-file-name completion-string))
@@ -700,7 +700,7 @@ the name is considered already unique; only the second substitution
 	   )
 	  (t
 	   (with-output-to-temp-buffer "*Completions*"
-	     (display-completion-list all))
+	     (display-completion-list all pattern))
 	   ))
     ))
 
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index abbfb096ab..ba1298f365 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,8 @@
+2005-10-16  Masatake YAMATO  <[email protected]>
+
+	* message.el (message-expand-group): Pass the common
+	prefix substring of completion to `display-completion-list'.
+
 2005-10-09  Daniel Brockman <[email protected]>
 
 	* format-spec.el (format-spec): Propagate text properties of % spec.
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index d64d8dbd2b..b7607ad30e 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -6691,7 +6691,7 @@ those headers."
 	  (let ((buffer-read-only nil))
 	    (erase-buffer)
 	    (let ((standard-output (current-buffer)))
-	      (display-completion-list (sort completions 'string<)))
+	      (display-completion-list (sort completions 'string<) string))
 	    (goto-char (point-min))
 	    (delete-region (point) (progn (forward-line 3) (point))))))))))
 
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index 06af543b4d..587b7d0187 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -587,7 +587,8 @@ of a mail alias.  The value is set up, buffer-local, when first needed.")
 		(prog2
 		    (message "Making completion list...")
 		    (all-completions alias mail-abbrevs)
-		  (message "Making completion list...done"))))))))
+		  (message "Making completion list...done"))
+		alias))))))
 
 (defun mail-abbrev-next-line (&optional arg)
   "Expand any mail abbrev, then move cursor vertically down ARG lines.
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index d69d36c10a..0b995552c8 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,3 +1,8 @@
+2005-10-16  Masatake YAMATO  <[email protected]>
+
+	* mh-comp.el (mh-complete-word): Pass the common
+	prefix substring of completion to `display-completion-list'.
+
 2005-10-15  Satyaki Das  <[email protected]>
 
 	* mh-init.el (mh-image-load-path-called-flag): New variable which
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index 7289207cfb..2aec8e8df9 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -1650,7 +1650,8 @@ Any match found replaces the text from BEGIN to END."
           ((stringp completion)
            (if (equal word completion)
                (with-output-to-temp-buffer completions-buffer
-                 (display-completion-list (all-completions word choices)))
+                 (display-completion-list (all-completions word choices)
+                                          word))
              (ignore-errors
                (kill-buffer completions-buffer))
              (delete-region begin end)
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index f6e8697543..ac2cc23048 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2015,7 +2015,8 @@ for \\[find-tag] (which see)."
 	   (message "Making completion list...")
 	   (with-output-to-temp-buffer "*Completions*"
 	     (display-completion-list
-	      (all-completions pattern 'tags-complete-tag nil)))
+	      (all-completions pattern 'tags-complete-tag nil)
+	      pattern))
 	   (message "Making completion list...%s" "done")))))
 
 (dolist (x '("^No tags table in use; use .* to select one$"
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 11ae1c66aa..3a55129c89 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -1176,7 +1176,7 @@ The context determines which are considered."
 	(message "Making completion list...")
 	(let ((list (all-completions try table)))
 	  (with-output-to-temp-buffer "*Completions*"
-	    (display-completion-list list)))
+	    (display-completion-list list try)))
 	(message "Making completion list...done"))))))
 
 
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index 9ae3e5a593..f5bbb4d68d 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -509,7 +509,7 @@ If the list was changed, sort the list and remove duplicates first."
                  (message "Making completion list...")
                  (let ((list (all-completions symbol list nil)))
                    (with-output-to-temp-buffer "*Completions*"
-                     (display-completion-list list)))
+                     (display-completion-list list symbol)))
                  (message "Making completion list... done"))))
       (funcall (nth 1 entry)))))
 
diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el
index e37f3b14a1..b65ad9eac1 100644
--- a/lisp/progmodes/octave-mod.el
+++ b/lisp/progmodes/octave-mod.el
@@ -1252,7 +1252,7 @@ variables."
 	     ;; Taken from comint.el
 	     (message "Making completion list...")
 	     (with-output-to-temp-buffer "*Completions*"
-	       (display-completion-list list))
+	       (display-completion-list list string))
 	     (message "Hit space to flush")
 	     (let (key first)
 	       (if (save-excursion
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index 3cd243580e..801096b9b0 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -1378,7 +1378,7 @@ indent of the current line in parameterlist."
 	    ((and (not (null (cdr allcomp))) (= (length pascal-str)
 						(length match)))
 	     (with-output-to-temp-buffer "*Completions*"
-	       (display-completion-list allcomp))
+	       (display-completion-list allcomp pascal-str))
 	     ;; Wait for a keypress. Then delete *Completion*  window
 	     (momentary-string-display "" (point))
 	     (delete-window (get-buffer-window (get-buffer "*Completions*")))
@@ -1398,7 +1398,7 @@ indent of the current line in parameterlist."
 		    (all-completions pascal-str 'pascal-completion))))
     ;; Show possible completions in a temporary buffer.
     (with-output-to-temp-buffer "*Completions*"
-      (display-completion-list allcomp))
+      (display-completion-list allcomp pascal-str))
     ;; Wait for a keypress. Then delete *Completion*  window
     (momentary-string-display "" (point))
     (delete-window (get-buffer-window (get-buffer "*Completions*")))))
diff --git a/lisp/simple.el b/lisp/simple.el
index cab04c135d..8f98b1cc90 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4844,10 +4844,13 @@ Called from `temp-buffer-show-hook'."
   "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'.")
+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'.
 
-;; This function goes in completion-setup-hook, so that it is called
-;; after the text of the completion list buffer is written.
 (defface completions-first-difference
   '((t (:inherit bold)))
   "Face put on the first uncommon character in completions in *Completions* buffer."
@@ -4867,6 +4870,17 @@ of the differing parts is, by contrast, slightly highlighted."
 (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)))
@@ -4905,9 +4919,11 @@ of the differing parts is, by contrast, slightly highlighted."
 		      (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))
diff --git a/lisp/tempo.el b/lisp/tempo.el
index 4939715a31..62ba3c9aca 100644
--- a/lisp/tempo.el
+++ b/lisp/tempo.el
@@ -717,11 +717,13 @@ non-nil, a buffer containing possible completions is displayed."
   (if tempo-leave-completion-buffer
       (with-output-to-temp-buffer "*Completions*"
 	(display-completion-list
-	 (all-completions string tag-list)))
+	 (all-completions string tag-list)
+	 string))
     (save-window-excursion
       (with-output-to-temp-buffer "*Completions*"
 	(display-completion-list
-	 (all-completions string tag-list)))
+	 (all-completions string tag-list)
+	 string))
       (sit-for 32767))))
 
 ;;;
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 2177f72fd0..50d8ccad76 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -2522,7 +2522,8 @@ of a word, all strings are listed.  Return completion."
            (message "Making completion list...")
            (with-output-to-temp-buffer "*Completions*"
              (display-completion-list (all-completions part-of-word
-                                                       completions)))
+                                                       completions)
+				      part-of-word))
            (message "Making completion list...done")
            ;; return value is handled by choose-completion-string-functions
            nil))))
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 9dea809dc9..8335a20212 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -3012,7 +3012,8 @@ It will read a file name from the minibuffer when invoked."
 	   (with-output-to-temp-buffer "*Completions*"
 	     (display-completion-list
 	      (sort (file-name-all-completions name-part directory)
-		    'string<)))
+		    'string<)
+	      name-part))
 	   (message "Making completion list...%s" "done")))))
 
 (defun widget-file-prompt-value (widget prompt value unbound)
@@ -3571,7 +3572,8 @@ example:
 	  (t
 	   (message "Making completion list...")
 	   (with-output-to-temp-buffer "*Completions*"
-	     (display-completion-list (all-completions prefix list nil)))
+	     (display-completion-list (all-completions prefix list nil)
+				      prefix))
 	   (message "Making completion list...done")))))
 
 (defun widget-color-sample-face-get (widget)