Mercurial > emacs

--- a/lisp/ChangeLog	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/ChangeLog	Sun Oct 16 09:31:48 2005 +0000
@@ -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.
--- a/lisp/dabbrev.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/dabbrev.el	Sun Oct 16 09:31:48 2005 +0000
@@ -461,7 +461,8 @@
       ;; * 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))))
--- a/lisp/emacs-lisp/lisp.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/emacs-lisp/lisp.el	Sun Oct 16 09:31:48 2005 +0000
@@ -586,7 +586,7 @@
 			 (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
--- a/lisp/eshell/em-hist.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/eshell/em-hist.el	Sun Oct 16 09:31:48 2005 +0000
@@ -507,7 +507,7 @@
 	;; 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)
--- a/lisp/filecache.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/filecache.el	Sun Oct 16 09:31:48 2005 +0000
@@ -607,7 +607,7 @@
 			    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 @@
 	   )
 	  (t
 	   (with-output-to-temp-buffer "*Completions*"
-	     (display-completion-list all))
+	     (display-completion-list all pattern))
 	   ))
     ))
--- a/lisp/gnus/ChangeLog	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/gnus/ChangeLog	Sun Oct 16 09:31:48 2005 +0000
@@ -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.
--- a/lisp/gnus/message.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/gnus/message.el	Sun Oct 16 09:31:48 2005 +0000
@@ -6691,7 +6691,7 @@
 	  (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))))))))))
--- a/lisp/mail/mailabbrev.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/mail/mailabbrev.el	Sun Oct 16 09:31:48 2005 +0000
@@ -587,7 +587,8 @@
 		(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.
--- a/lisp/mh-e/ChangeLog	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/mh-e/ChangeLog	Sun Oct 16 09:31:48 2005 +0000
@@ -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
--- a/lisp/mh-e/mh-comp.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/mh-e/mh-comp.el	Sun Oct 16 09:31:48 2005 +0000
@@ -1650,7 +1650,8 @@
           ((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)
--- a/lisp/progmodes/etags.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/progmodes/etags.el	Sun Oct 16 09:31:48 2005 +0000
@@ -2015,7 +2015,8 @@
 	   (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$"
--- a/lisp/progmodes/make-mode.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/progmodes/make-mode.el	Sun Oct 16 09:31:48 2005 +0000
@@ -1176,7 +1176,7 @@
 	(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"))))))
--- a/lisp/progmodes/meta-mode.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/progmodes/meta-mode.el	Sun Oct 16 09:31:48 2005 +0000
@@ -509,7 +509,7 @@
                  (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)))))
--- a/lisp/progmodes/octave-mod.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/progmodes/octave-mod.el	Sun Oct 16 09:31:48 2005 +0000
@@ -1252,7 +1252,7 @@
 	     ;; 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
--- a/lisp/progmodes/pascal.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/progmodes/pascal.el	Sun Oct 16 09:31:48 2005 +0000
@@ -1378,7 +1378,7 @@
 	    ((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 @@
 		    (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*")))))
--- a/lisp/simple.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/simple.el	Sun Oct 16 09:31:48 2005 +0000
@@ -4844,10 +4844,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."
@@ -4867,6 +4870,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)))
@@ -4905,9 +4919,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))
--- a/lisp/tempo.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/tempo.el	Sun Oct 16 09:31:48 2005 +0000
@@ -717,11 +717,13 @@
   (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))))

 ;;;
--- a/lisp/textmodes/bibtex.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/textmodes/bibtex.el	Sun Oct 16 09:31:48 2005 +0000
@@ -2522,7 +2522,8 @@
            (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))))
--- a/lisp/wid-edit.el	Sun Oct 16 03:24:54 2005 +0000
+++ b/lisp/wid-edit.el	Sun Oct 16 09:31:48 2005 +0000
@@ -3012,7 +3012,8 @@
 	   (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 @@
 	  (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)
--- a/src/ChangeLog	Sun Oct 16 03:24:54 2005 +0000
+++ b/src/ChangeLog	Sun Oct 16 09:31:48 2005 +0000
@@ -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):
--- a/src/minibuf.c	Sun Oct 16 03:24:54 2005 +0000
+++ b/src/minibuf.c	Sun Oct 16 09:31:48 2005 +0000
@@ -2351,7 +2351,7 @@
 }

 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 @@
 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 @@
      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 @@
 	}
     }

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