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

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.

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))))

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

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)

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))
 	   ))
     ))
 

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.

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))))))))))
 

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.

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

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)

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$"

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"))))))
 
 

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)))))
 

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

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*")))))

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))

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))))
 
 ;;;

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))))

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)

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):

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'.  */)
+It can find the completion buffer in `standard-output'.  
-     (completions)
+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;
 }