Commit f5fab556 authored by Masatake YAMATO's avatar Masatake YAMATO
Browse files

* 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'.
parent 2416ec64
2005-10-16 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-16 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
* term/mac-win.el: Apply 2005-10-09 change for term/x-win.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))))
......
......@@ -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
......
......@@ -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)
......
......@@ -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))
))
))
......
2005-10-16 Masatake YAMATO <jet@gyve.org>
* message.el (message-expand-group): Pass the common
prefix substring of completion to `display-completion-list'.
2005-10-09 Daniel Brockman <daniel@brockman.se>
* format-spec.el (format-spec): Propagate text properties of % spec.
......
......@@ -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))))))))))
......
......@@ -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.
......
2005-10-16 Masatake YAMATO <jet@gyve.org>
* mh-comp.el (mh-complete-word): Pass the common
prefix substring of completion to `display-completion-list'.
2005-10-15 Satyaki Das <satyaki@theforce.stanford.edu>
* mh-init.el (mh-image-load-path-called-flag): New variable which
......
......@@ -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)
......
......@@ -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$"
......
......@@ -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"))))))
......
......@@ -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)))))
......
......@@ -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
......
......@@ -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*")))))
......
......@@ -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))
......
......@@ -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))))
;;;
......
......@@ -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))))
......
......@@ -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)
......
2005-10-16 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-16 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
* mac.c [TARGET_API_MAC_CARBON] (get_cfstring_encoding_from_lisp):
......
......@@ -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;
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment