* Re: Enhanced enhanced visual feedback in `*Completions*' buffer
2005-10-09 4:16 ` Masatake YAMATO
@ 2005-10-09 19:12 ` Masatake YAMATO
2005-10-10 4:15 ` Richard M. Stallman
1 sibling, 0 replies; 5+ messages in thread
From: Masatake YAMATO @ 2005-10-09 19:12 UTC (permalink / raw)
Cc: emacs-devel
> > 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 <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-10 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-10 Masatake YAMATO <jet@gyve.org>
* message.el (message-expand-group): Pass the common
prefix substring of completion to `display-completion-list'.
2005-10-10 Masatake YAMATO <jet@gyve.org>
* 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 @@
}
\f
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"))))))
\f
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))))
^ permalink raw reply [flat|nested] 5+ messages in thread