From f5fab556d45e13d12f83b2d8cd49fe343546c2f6 Mon Sep 17 00:00:00 2001 From: Masatake YAMATO Date: Sun, 16 Oct 2005 09:31:48 +0000 Subject: [PATCH] * message.el (message-expand-group): Pass the common prefix substring of completion to `display-completion-list'. * mh-comp.el (mh-complete-word): Pass the common prefix substring of completion to `display-completion-list'. * 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. * 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. * textmodes/bibtex.el (bibtex-complete-internal): Ditto. * simple.el (completion-common-substring): New variable. (completion-setup-function): Use `completion-common-substring' to put faces. * minibuf.c (Fdisplay_completion_list): Add new optional argument COMMON_SUBSTRING. Bind `completion-common-substring' to the optional argument during running `completion-setup-hook'. --- lisp/ChangeLog | 41 ++++++++++++++++++++++++++++++++++++ lisp/dabbrev.el | 3 ++- lisp/emacs-lisp/lisp.el | 2 +- lisp/eshell/em-hist.el | 2 +- lisp/filecache.el | 4 ++-- lisp/gnus/ChangeLog | 5 +++++ lisp/gnus/message.el | 2 +- lisp/mail/mailabbrev.el | 3 ++- lisp/mh-e/ChangeLog | 5 +++++ lisp/mh-e/mh-comp.el | 3 ++- lisp/progmodes/etags.el | 3 ++- lisp/progmodes/make-mode.el | 2 +- lisp/progmodes/meta-mode.el | 2 +- lisp/progmodes/octave-mod.el | 2 +- lisp/progmodes/pascal.el | 4 ++-- lisp/simple.el | 26 ++++++++++++++++++----- lisp/tempo.el | 6 ++++-- lisp/textmodes/bibtex.el | 3 ++- lisp/wid-edit.el | 6 ++++-- src/ChangeLog | 6 ++++++ src/minibuf.c | 32 +++++++++++++++++++++------- 21 files changed, 130 insertions(+), 32 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e5a4976e73a..a40199fd91c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,44 @@ +2005-10-16 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-16 YAMAMOTO Mitsuharu * term/mac-win.el: Apply 2005-10-09 change for term/x-win.el. diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 2139e7c5761..b330f2b10d7 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -461,7 +461,8 @@ if there is a suitable one already." ;; * 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)))) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index d248882d882..4b799ebfedf 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -586,7 +586,7 @@ considered." (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 diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index fd887e5fa86..e7844028542 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -507,7 +507,7 @@ See also `eshell-read-history'." ;; 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) diff --git a/lisp/filecache.el b/lisp/filecache.el index bb45bb392f3..442f729dd15 100644 --- a/lisp/filecache.el +++ b/lisp/filecache.el @@ -607,7 +607,7 @@ the name is considered already unique; only the second substitution 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 @@ the name is considered already unique; only the second substitution ) (t (with-output-to-temp-buffer "*Completions*" - (display-completion-list all)) + (display-completion-list all pattern)) )) )) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index abbfb096ab1..ba1298f3650 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,8 @@ +2005-10-16 Masatake YAMATO + + * message.el (message-expand-group): Pass the common + prefix substring of completion to `display-completion-list'. + 2005-10-09 Daniel Brockman * format-spec.el (format-spec): Propagate text properties of % spec. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index d64d8dbd2bf..b7607ad30e0 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -6691,7 +6691,7 @@ those headers." (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)))))))))) diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index 06af543b4da..587b7d0187e 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el @@ -587,7 +587,8 @@ of a mail alias. The value is set up, buffer-local, when first needed.") (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. diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index d69d36c10af..0b995552c85 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,8 @@ +2005-10-16 Masatake YAMATO + + * mh-comp.el (mh-complete-word): Pass the common + prefix substring of completion to `display-completion-list'. + 2005-10-15 Satyaki Das * mh-init.el (mh-image-load-path-called-flag): New variable which diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 7289207cfb2..2aec8e8df9a 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -1650,7 +1650,8 @@ Any match found replaces the text from BEGIN to END." ((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) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index f6e8697543f..ac2cc23048a 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -2015,7 +2015,8 @@ for \\[find-tag] (which see)." (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$" diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 11ae1c66aa7..3a55129c899 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -1176,7 +1176,7 @@ The context determines which are considered." (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")))))) diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index 9ae3e5a5935..f5bbb4d68db 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -509,7 +509,7 @@ If the list was changed, sort the list and remove duplicates first." (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))))) diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el index e37f3b14a15..b65ad9eac1a 100644 --- a/lisp/progmodes/octave-mod.el +++ b/lisp/progmodes/octave-mod.el @@ -1252,7 +1252,7 @@ variables." ;; 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 diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index 3cd243580e2..801096b9b0f 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -1378,7 +1378,7 @@ indent of the current line in parameterlist." ((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 @@ indent of the current line in parameterlist." (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*"))))) diff --git a/lisp/simple.el b/lisp/simple.el index cab04c135d9..8f98b1cc907 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -4844,10 +4844,13 @@ Called from `temp-buffer-show-hook'." "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 @@ of the differing parts is, by contrast, slightly highlighted." (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 @@ of the differing parts is, by contrast, slightly highlighted." (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)) diff --git a/lisp/tempo.el b/lisp/tempo.el index 4939715a31c..62ba3c9acae 100644 --- a/lisp/tempo.el +++ b/lisp/tempo.el @@ -717,11 +717,13 @@ non-nil, a buffer containing possible completions is displayed." (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)))) ;;; diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 2177f72fd0d..50d8ccad764 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -2522,7 +2522,8 @@ of a word, all strings are listed. Return completion." (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)))) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 9dea809dc91..8335a202120 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -3012,7 +3012,8 @@ It will read a file name from the minibuffer when invoked." (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 @@ example: (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) diff --git a/src/ChangeLog b/src/ChangeLog index 4a27cac6fb9..d0b52872983 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2005-10-16 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-16 YAMAMOTO Mitsuharu * mac.c [TARGET_API_MAC_CARBON] (get_cfstring_encoding_from_lisp): diff --git a/src/minibuf.c b/src/minibuf.c index 28789b60bde..d7ef048c138 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -2351,7 +2351,7 @@ Return nil if there is no valid completion, else t. */) } 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 @@ alternative, the second serves as annotation. 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 @@ It can find the completion buffer in `standard-output'. */) 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 @@ It can find the completion buffer in `standard-output'. */) } } - 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; } -- 2.39.5