From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Masatake YAMATO Newsgroups: gmane.emacs.devel Subject: Re: Enhanced enhanced visual feedback in `*Completions*' buffer Date: Mon, 10 Oct 2005 04:12:36 +0900 (JST) Message-ID: <20051010.041236.48799198.jet@gyve.org> References: <20051008.160207.188502984.jet@gyve.org> <20051009.131610.197346394.jet@gyve.org> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: Text/Plain; charset=us-ascii Content-Transfer-Encoding: 7bit X-Trace: sea.gmane.org 1128885850 18453 80.91.229.2 (9 Oct 2005 19:24:10 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Sun, 9 Oct 2005 19:24:10 +0000 (UTC) Cc: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Oct 09 21:24:07 2005 Return-path: Original-Received: from lists.gnu.org ([199.232.76.165]) by ciao.gmane.org with esmtp (Exim 4.43) id 1EOgl6-0002QQ-Om for ged-emacs-devel@m.gmane.org; Sun, 09 Oct 2005 21:22:58 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1EOgl5-000140-CI for ged-emacs-devel@m.gmane.org; Sun, 09 Oct 2005 15:22:55 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1EOgkt-00012a-Cp for emacs-devel@gnu.org; Sun, 09 Oct 2005 15:22:43 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1EOgkr-00011r-JX for emacs-devel@gnu.org; Sun, 09 Oct 2005 15:22:42 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1EOgkr-00011o-Fb for emacs-devel@gnu.org; Sun, 09 Oct 2005 15:22:41 -0400 Original-Received: from [210.130.136.40] (helo=r-maa.spacetown.ne.jp) by monty-python.gnu.org with esmtp (Exim 4.34) id 1EOgko-00028W-DW; Sun, 09 Oct 2005 15:22:39 -0400 Original-Received: from localhost (h219-110-074-077.catv01.itscom.jp [219.110.74.77]) by r-maa.spacetown.ne.jp (8.11.6) with ESMTP id j99JMWx18126; Mon, 10 Oct 2005 04:22:34 +0900 (JST) Original-To: rms@gnu.org In-Reply-To: <20051009.131610.197346394.jet@gyve.org> X-Mailer: Mew version 4.2.53 on Emacs 22.0.50 / Mule 5.0 (SAKAKI) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:43750 Archived-At: > > 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 * 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 * 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 * message.el (message-expand-group): Pass the common prefix substring of completion to `display-completion-list'. 2005-10-10 Masatake YAMATO * 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))))