Enhanced enhanced visual feedback in `*Completions*' buffer

[Masatake YAMATO]

Hi,

"Enhanced visual feedback in `*Completions*' buffer" was supported
completion performed in minibuffer only. Attached patch generalizes
the function; it supports completion performed outside of minibuffer.

I introduce a variable, `completion-common-string' which is used as a
hint in `completion-setup-function' to put faces to *Completions*
buffer. Client code like `lisp-complete-symbol' sets
`completion-common-string'.

Masatake YAMATO

2005-10-08  Masatake YAMATO  <address@hidden>

        * simple.el (completion-common-string): New variable.
        (completion-setup-function): Use `completion-common-string'.

        * emacs-lisp/lisp.el (lisp-complete-symbol): Bind
        the completion pattern to `completion-common-string'.

Index: lisp/emacs-lisp/lisp.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/emacs-lisp/lisp.el,v
retrieving revision 1.68
diff -u -r1.68 lisp.el
--- lisp/emacs-lisp/lisp.el     6 Aug 2005 17:08:59 -0000       1.68
+++ lisp/emacs-lisp/lisp.el     8 Oct 2005 05:34:44 -0000
@@ -585,8 +585,9 @@
                                         new))
                         (setq list (cdr list)))
                       (setq list (nreverse new))))
-                (with-output-to-temp-buffer "*Completions*"
-                  (display-completion-list list)))
+                (let ((completion-common-string pattern))
+                  (with-output-to-temp-buffer "*Completions*"
+                    (display-completion-list list))))
               (message "Making completion list...%s" "done")))))))
 
 ;;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e
Index: lisp/simple.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/simple.el,v
retrieving revision 1.754
diff -u -r1.754 simple.el
--- lisp/simple.el      6 Oct 2005 06:55:45 -0000       1.754
+++ lisp/simple.el      8 Oct 2005 05:34:45 -0000
@@ -4867,6 +4867,20 @@
 (defvar completion-root-regexp "^/"
   "Regexp to use in `completion-setup-function' to find the root directory.")
 
+(defvar completion-common-string nil
+  "Common prefix substring to use in `completion-setup-function' to put faces.
+Set this variable when completion is performed in a buffer other than 
minibuffer.
+
+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.)
+
+Typical usage:
+\(let ((completion-common-string pattern))
+   (with-output-to-temp-buffer \"*Completions*\"
+      (display-completion-list (all-completions pattern obarray 
predicate)))))")
+
 (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-string)
        (let* ((common-string-length
-               (- (length mbuf-contents) completion-base-size))
+               (if completion-base-size
+                   (- (length mbuf-contents) completion-base-size)
+                 (length completion-common-string)))
               (element-start (next-single-property-change
                               (point-min)
                               'mouse-face))