* 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'.

21 files changed, 130 insertions, 32 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e5a4976e73a..a40199fd91c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,44 @@
+2005-10-16  Masatake YAMATO  <jet@gyve.org>
+
+        * 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  <mituharu@math.s.chiba-u.ac.jp>
 
         * 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 2139e7c5761..b330f2b10d7 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 d248882d882..4b799ebfedf 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 fd887e5fa86..e7844028542 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 bb45bb392f3..442f729dd15 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 abbfb096ab1..ba1298f3650 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,8 @@
+2005-10-16  Masatake YAMATO  <jet@gyve.org>
+
+        * message.el (message-expand-group): Pass the common
+        prefix substring of completion to `display-completion-list'.
+
 2005-10-09  Daniel Brockman <daniel@brockman.se>
 
         * format-spec.el (format-spec): Propagate text properties of % spec.
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index d64d8dbd2bf..b7607ad30e0 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 06af543b4da..587b7d0187e 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 d69d36c10af..0b995552c85 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,3 +1,8 @@
+2005-10-16  Masatake YAMATO  <jet@gyve.org>
+
+        * mh-comp.el (mh-complete-word): Pass the common
+        prefix substring of completion to `display-completion-list'.
+
 2005-10-15  Satyaki Das  <satyaki@theforce.stanford.edu>
 
         * 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 7289207cfb2..2aec8e8df9a 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 f6e8697543f..ac2cc23048a 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 11ae1c66aa7..3a55129c899 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 9ae3e5a5935..f5bbb4d68db 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 e37f3b14a15..b65ad9eac1a 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 3cd243580e2..801096b9b0f 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 cab04c135d9..8f98b1cc907 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 4939715a31c..62ba3c9acae 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 2177f72fd0d..50d8ccad764 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 9dea809dc91..8335a202120 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)
diff --git a/src/ChangeLog b/src/ChangeLog
index 4a27cac6fb9..d0b52872983 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+2005-10-16  Masatake YAMATO  <jet@gyve.org>
+
+        * minibuf.c (Fdisplay_completion_list): Add new optional
+        argument COMMON_SUBSTRING. Bind `completion-common-substring' 
+        to the optional argument during running `completion-setup-hook'.
+
 2005-10-16  YAMAMOTO Mitsuharu  <mituharu@math.s.chiba-u.ac.jp>
 
         * mac.c [TARGET_API_MAC_CARBON] (get_cfstring_encoding_from_lisp):
diff --git a/src/minibuf.c b/src/minibuf.c
index 28789b60bde..d7ef048c138 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -2351,7 +2351,7 @@ Return nil if there is no valid completion, else t.  */)
 }
 
 DEFUN ("display-completion-list", Fdisplay_completion_list, Sdisplay_completion_list,
-       1, 1, 0,
+       1, 2, 0,
        doc: /* Display the list of completions, COMPLETIONS, using `standard-output'.
 Each element may be just a symbol or string
 or may be a list of two strings to be printed as if concatenated.
@@ -2361,14 +2361,23 @@ alternative, the second serves as annotation.
 The actual completion alternatives, as inserted, are given `mouse-face'
 properties of `highlight'.
 At the end, this runs the normal hook `completion-setup-hook'.
-It can find the completion buffer in `standard-output'.  */)
-     (completions)
+It can find the completion buffer in `standard-output'.  
+The optional second arg COMMON-SUBSTRING is a string. 
+It is used to put faces, `completions-first-difference` and
+`completions-common-part' on the completion bufffer. The
+`completions-common-part' face is put on the common substring
+specified by COMMON-SUBSTRING. If COMMON-SUBSTRING is nil,
+the faces are not put. 
+Internally, COMMON-SUBSTRING is bound to `completion-common-substring' 
+during running `completion-setup-hook'. */)
+     (completions, common_substring)
      Lisp_Object completions;
+     Lisp_Object common_substring;
 {
   Lisp_Object tail, elt;
   register int i;
   int column = 0;
-  struct gcpro gcpro1, gcpro2;
+  struct gcpro gcpro1, gcpro2, gcpro3;
   struct buffer *old = current_buffer;
   int first = 1;
 
@@ -2377,7 +2386,7 @@ It can find the completion buffer in `standard-output'.  */)
      except for ELT.  ELT can be pointing to a string
      when terpri or Findent_to calls a change hook.  */
   elt = Qnil;
-  GCPRO2 (completions, elt);
+  GCPRO3 (completions, elt, common_substring);
 
   if (BUFFERP (Vstandard_output))
     set_buffer_internal (XBUFFER (Vstandard_output));
@@ -2526,13 +2535,20 @@ It can find the completion buffer in `standard-output'.  */)
         }
     }
 
-  UNGCPRO;
-
   if (BUFFERP (Vstandard_output))
     set_buffer_internal (old);
 
   if (!NILP (Vrun_hooks))
-    call1 (Vrun_hooks, intern ("completion-setup-hook"));
+    {
+      int count1 = SPECPDL_INDEX ();
+
+      specbind (intern ("completion-common-substring"), common_substring);
+      call1 (Vrun_hooks, intern ("completion-setup-hook"));
+      
+      unbind_to (count1, Qnil);
+    }
+
+  UNGCPRO;
 
   return Qnil;
 }