emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Enhanced enhanced visual feedback in `*Completions*' buffer


From: Masatake YAMATO
Subject: Re: Enhanced enhanced visual feedback in `*Completions*' buffer
Date: Mon, 10 Oct 2005 04:12:36 +0900 (JST)

> > The feature seems like a natural generalization of the existing
> > feature, but
> > 
> >     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'.
> > 
> > is somewhat of a pain in the neck.  And it would need to be documented
> > in NEWS and the Lisp manual.
> 
> Yes, it would need.
> 
> > Have you found all the functions in Emacs that would need to be changed?
> 
> Not yet. I may have to check all the place where `display-completion-list' 
> is used.
> 
> > Is this variable the best API for it?  Would it be better
> > to add an optional argument to display-completion-list?
> 
> What you wrote is much beter. 
> I'll rewrite my patch.

I've added an optional argument COMMON_SUBSTRING to `display-completion-list'.
`display-completion-list' binds `completion-common-substring' to 
COMMON_SUBSTRING
during running `completion-setup-hook'.
`completion-setup-function' uses `completion-common-substring' to put the faces.

The client code of `display-completion-list' needed to pass the
optional argument if the faces in *Completions* are needed. I have
modified many `display-completion-list' invocations in *.el to pass
the optional argument, too. However, modifications for following files
are not yet: ido.el, tmm.el, term.el, complete.el, viper-macs.el,
viper-ex.el, idlwave.el, iswitchb.el, pcomplete.el, comint.el. The
modifications for the files are not easy.

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

        * 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-10  Masatake YAMATO  <address@hidden>

        * 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-10  Masatake YAMATO  <address@hidden>

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

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

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


Index: src/minibuf.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/minibuf.c,v
retrieving revision 1.286
diff -u -r1.286 minibuf.c
--- src/minibuf.c       30 Sep 2005 18:30:10 -0000      1.286
+++ src/minibuf.c       9 Oct 2005 15:50:48 -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,17 @@
 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'.  
+If optional send arg COMMON_SUBSTRING is non-nil, the value is
+bound to `completion-common-substring' during running the 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 +2380,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 +2529,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;
 }
Index: lisp/textmodes/org.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/textmodes/org.el,v
retrieving revision 1.39
diff -u -r1.39 org.el
--- lisp/textmodes/org.el       26 Sep 2005 09:41:32 -0000      1.39
+++ lisp/textmodes/org.el       9 Oct 2005 15:50:51 -0000
@@ -2841,7 +2841,7 @@
             (message "Making completion list...")
             (let ((list (sort (all-completions pattern table) 'string<)))
               (with-output-to-temp-buffer "*Completions*"
-                (display-completion-list list)))
+                (display-completion-list list pattern)))
             (message "Making completion list...%s" "done"))))))
 
 ;;; Comments, TODO and DEADLINE
Index: lisp/textmodes/bibtex.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/textmodes/bibtex.el,v
retrieving revision 1.100
diff -u -r1.100 bibtex.el
--- lisp/textmodes/bibtex.el    1 Oct 2005 20:09:22 -0000       1.100
+++ lisp/textmodes/bibtex.el    9 Oct 2005 15:50:52 -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))))
Index: lisp/progmodes/python.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/progmodes/python.el,v
retrieving revision 1.33
diff -u -r1.33 python.el
--- lisp/progmodes/python.el    24 Sep 2005 10:58:16 -0000      1.33
+++ lisp/progmodes/python.el    9 Oct 2005 15:50:53 -0000
@@ -1652,7 +1652,7 @@
                (t
                 (message "Making completion list...")
                 (with-output-to-temp-buffer "*Completions*"
-                  (display-completion-list completions))
+                  (display-completion-list completions symbol))
                 (message "Making completion list...%s" "done"))))))))
 
 (eval-when-compile (require 'hippie-exp))
Index: lisp/progmodes/pascal.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/progmodes/pascal.el,v
retrieving revision 1.47
diff -u -r1.47 pascal.el
--- lisp/progmodes/pascal.el    24 Sep 2005 13:43:58 -0000      1.47
+++ lisp/progmodes/pascal.el    9 Oct 2005 15:50:54 -0000
@@ -1380,7 +1380,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*")))
@@ -1400,7 +1400,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*")))))
Index: lisp/progmodes/octave-mod.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/progmodes/octave-mod.el,v
retrieving revision 1.28
diff -u -r1.28 octave-mod.el
--- lisp/progmodes/octave-mod.el        26 Aug 2005 13:41:26 -0000      1.28
+++ lisp/progmodes/octave-mod.el        9 Oct 2005 15:50:55 -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
Index: lisp/progmodes/meta-mode.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/progmodes/meta-mode.el,v
retrieving revision 1.14
diff -u -r1.14 meta-mode.el
--- lisp/progmodes/meta-mode.el 1 Aug 2005 08:37:48 -0000       1.14
+++ lisp/progmodes/meta-mode.el 9 Oct 2005 15:50:56 -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)))))
 
Index: lisp/progmodes/make-mode.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/progmodes/make-mode.el,v
retrieving revision 1.107
diff -u -r1.107 make-mode.el
--- lisp/progmodes/make-mode.el 9 Sep 2005 01:24:59 -0000       1.107
+++ lisp/progmodes/make-mode.el 9 Oct 2005 15:50:58 -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"))))))
 
 
Index: lisp/progmodes/etags.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/progmodes/etags.el,v
retrieving revision 1.188
diff -u -r1.188 etags.el
--- lisp/progmodes/etags.el     24 Sep 2005 13:43:58 -0000      1.188
+++ lisp/progmodes/etags.el     9 Oct 2005 15:51:00 -0000
@@ -2025,7 +2025,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$"
Index: lisp/mh-e/mh-comp.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/mh-e/mh-comp.el,v
retrieving revision 1.13
diff -u -r1.13 mh-comp.el
--- lisp/mh-e/mh-comp.el        24 Sep 2005 13:45:50 -0000      1.13
+++ lisp/mh-e/mh-comp.el        9 Oct 2005 15:51:01 -0000
@@ -1644,7 +1644,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)
Index: lisp/mail/mailalias.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/mail/mailalias.el,v
retrieving revision 1.58
diff -u -r1.58 mailalias.el
--- lisp/mail/mailalias.el      25 Aug 2005 11:00:38 -0000      1.58
+++ lisp/mail/mailalias.el      9 Oct 2005 15:51:01 -0000
@@ -423,7 +423,8 @@
                 (message "Making completion list...")
                 (with-output-to-temp-buffer "*Completions*"
                   (display-completion-list
-                   (all-completions pattern list)))
+                   (all-completions pattern list)
+                   pattern))
                 (message "Making completion list...%s" "done"))))
       (funcall mail-complete-function arg))))
 
Index: lisp/mail/mailabbrev.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/mail/mailabbrev.el,v
retrieving revision 1.78
diff -u -r1.78 mailabbrev.el
--- lisp/mail/mailabbrev.el     24 Sep 2005 13:43:59 -0000      1.78
+++ lisp/mail/mailabbrev.el     9 Oct 2005 15:51:03 -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.
Index: lisp/gnus/message.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/gnus/message.el,v
retrieving revision 1.91
diff -u -r1.91 message.el
--- lisp/gnus/message.el        4 Oct 2005 22:51:05 -0000       1.91
+++ lisp/gnus/message.el        9 Oct 2005 15:51:06 -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))))))))))
 
Index: lisp/eshell/em-hist.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/eshell/em-hist.el,v
retrieving revision 1.19
diff -u -r1.19 em-hist.el
--- lisp/eshell/em-hist.el      1 Aug 2005 15:04:33 -0000       1.19
+++ lisp/eshell/em-hist.el      9 Oct 2005 15:51:07 -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)
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     9 Oct 2005 15:51:07 -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
Index: lisp/wid-edit.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/wid-edit.el,v
retrieving revision 1.148
diff -u -r1.148 wid-edit.el
--- lisp/wid-edit.el    6 Oct 2005 08:20:44 -0000       1.148
+++ lisp/wid-edit.el    9 Oct 2005 15:51:09 -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)
Index: lisp/tempo.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/tempo.el,v
retrieving revision 1.29
diff -u -r1.29 tempo.el
--- lisp/tempo.el       6 Aug 2005 22:13:43 -0000       1.29
+++ lisp/tempo.el       9 Oct 2005 15:51:10 -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))))
 
 ;;;
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      9 Oct 2005 15:51:12 -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'.")
+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 @@
 (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))
Index: lisp/filecache.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/filecache.el,v
retrieving revision 1.25
diff -u -r1.25 filecache.el
--- lisp/filecache.el   6 Aug 2005 22:13:42 -0000       1.25
+++ lisp/filecache.el   9 Oct 2005 15:51:12 -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))
           ))
     ))
 
Index: lisp/dabbrev.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/dabbrev.el,v
retrieving revision 1.79
diff -u -r1.79 dabbrev.el
--- lisp/dabbrev.el     6 Aug 2005 22:13:42 -0000       1.79
+++ lisp/dabbrev.el     9 Oct 2005 15:51:13 -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))))




reply via email to

[Prev in Thread] Current Thread [Next in Thread]