1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-28 07:45:00 +00:00

(minibuffer-message): If the current buffer is not

a minibuffer, insert the message in the echo area rather than at the
end of the buffer.
(completion-annotate-function): New variable.
(minibuffer-completion-help): Use it.
(completion--embedded-envvar-table): Environment vars are
always case-sensitive.
This commit is contained in:
Stefan Monnier 2009-08-30 03:45:30 +00:00
parent 744256cf1b
commit ab22be48bd
2 changed files with 96 additions and 38 deletions

View File

@ -1,3 +1,13 @@
2009-08-30 Stefan Monnier <monnier@iro.umontreal.ca>
* minibuffer.el (minibuffer-message): If the current buffer is not
a minibuffer, insert the message in the echo area rather than at the
end of the buffer.
(completion-annotate-function): New variable.
(minibuffer-completion-help): Use it.
(completion--embedded-envvar-table): Environment vars are
always case-sensitive.
2009-08-30 Glenn Morris <rgm@gnu.org> 2009-08-30 Glenn Morris <rgm@gnu.org>
* progmodes/fortran.el (fortran-start-prog-re): New constant, extracted * progmodes/fortran.el (fortran-start-prog-re): New constant, extracted

View File

@ -30,7 +30,6 @@
;; (boundaries START . END). See `completion-boundaries'. ;; (boundaries START . END). See `completion-boundaries'.
;; Any other return value should be ignored (so we ignore values returned ;; Any other return value should be ignored (so we ignore values returned
;; from completion tables that don't know about this new `action' form). ;; from completion tables that don't know about this new `action' form).
;; See `completion-boundaries'.
;;; Bugs: ;;; Bugs:
@ -40,10 +39,23 @@
;; - choose-completion can't automatically figure out the boundaries ;; - choose-completion can't automatically figure out the boundaries
;; corresponding to the displayed completions. `base-size' gives the left ;; corresponding to the displayed completions. `base-size' gives the left
;; boundary, but not the righthand one. So we need to add ;; boundary, but not the righthand one. So we need to add
;; completion-extra-size (and also completion-no-auto-exit). ;; completion-extra-size.
;;; Todo: ;;; Todo:
;; - make partial-complete-mode obsolete:
;; - make M-x lch TAB expand to list-command-history.
;; (not sure how/where it's implemented in complete.el)
;; - (?) <foo.h> style completion for file names.
;; - case-sensitivity is currently confuses two issues:
;; - whether or not a particular completion table should be case-sensitive
;; (i.e. whether strings that different only by case are semantically
;; equivalent)
;; - whether the user wants completion to pay attention to case.
;; e.g. we may want to make it possible for the user to say "first try
;; completion case-sensitively, and if that fails, try to ignore case".
;; - make lisp-complete-symbol and sym-comp use it. ;; - make lisp-complete-symbol and sym-comp use it.
;; - add support for ** to pcm. ;; - add support for ** to pcm.
;; - Make read-file-name-predicate obsolete. ;; - Make read-file-name-predicate obsolete.
@ -248,31 +260,38 @@ The text is displayed for `minibuffer-message-timeout' seconds,
or until the next input event arrives, whichever comes first. or until the next input event arrives, whichever comes first.
Enclose MESSAGE in [...] if this is not yet the case. Enclose MESSAGE in [...] if this is not yet the case.
If ARGS are provided, then pass MESSAGE through `format'." If ARGS are provided, then pass MESSAGE through `format'."
;; Clear out any old echo-area message to make way for our new thing. (if (not (minibufferp (current-buffer)))
(message nil) (progn
(setq message (if (and (null args) (string-match-p "\\` *\\[.+\\]\\'" message)) (if args
;; Make sure we can put-text-property. (apply 'message message args)
(copy-sequence message) (message "%s" message))
(concat " [" message "]"))) (prog1 (sit-for (or minibuffer-message-timeout 1000000))
(when args (setq message (apply 'format message args))) (message nil)))
(let ((ol (make-overlay (point-max) (point-max) nil t t)) ;; Clear out any old echo-area message to make way for our new thing.
;; A quit during sit-for normally only interrupts the sit-for, (message nil)
;; but since minibuffer-message is used at the end of a command, (setq message (if (and (null args) (string-match-p "\\` *\\[.+\\]\\'" message))
;; at a time when the command has virtually finished already, a C-g ;; Make sure we can put-text-property.
;; should really cause an abort-recursive-edit instead (i.e. as if (copy-sequence message)
;; the C-g had been typed at top-level). Binding inhibit-quit here (concat " [" message "]")))
;; is an attempt to get that behavior. (when args (setq message (apply 'format message args)))
(inhibit-quit t)) (let ((ol (make-overlay (point-max) (point-max) nil t t))
(unwind-protect ;; A quit during sit-for normally only interrupts the sit-for,
(progn ;; but since minibuffer-message is used at the end of a command,
(unless (zerop (length message)) ;; at a time when the command has virtually finished already, a C-g
;; The current C cursor code doesn't know to use the overlay's ;; should really cause an abort-recursive-edit instead (i.e. as if
;; marker's stickiness to figure out whether to place the cursor ;; the C-g had been typed at top-level). Binding inhibit-quit here
;; before or after the string, so let's spoon-feed it the pos. ;; is an attempt to get that behavior.
(put-text-property 0 1 'cursor t message)) (inhibit-quit t))
(overlay-put ol 'after-string message) (unwind-protect
(sit-for (or minibuffer-message-timeout 1000000))) (progn
(delete-overlay ol)))) (unless (zerop (length message))
;; The current C cursor code doesn't know to use the overlay's
;; marker's stickiness to figure out whether to place the cursor
;; before or after the string, so let's spoon-feed it the pos.
(put-text-property 0 1 'cursor t message))
(overlay-put ol 'after-string message)
(sit-for (or minibuffer-message-timeout 1000000)))
(delete-overlay ol)))))
(defun minibuffer-completion-contents () (defun minibuffer-completion-contents ()
"Return the user input in a minibuffer before point as a string. "Return the user input in a minibuffer before point as a string.
@ -343,6 +362,8 @@ Only the elements of table that satisfy predicate PRED are considered.
POINT is the position of point within STRING. POINT is the position of point within STRING.
The return value is a list of completions and may contain the base-size The return value is a list of completions and may contain the base-size
in the last `cdr'." in the last `cdr'."
;; FIXME: We need to additionally return completion-extra-size (similar
;; to completion-base-size but for the text after point).
;; The property `completion-styles' indicates that this functional ;; The property `completion-styles' indicates that this functional
;; completion-table claims to take care of completion styles itself. ;; completion-table claims to take care of completion styles itself.
;; [I.e. It will most likely call us back at some point. ] ;; [I.e. It will most likely call us back at some point. ]
@ -872,6 +893,23 @@ the completions buffer."
(run-hooks 'completion-setup-hook))) (run-hooks 'completion-setup-hook)))
nil) nil)
(defvar completion-annotate-function
nil
;; Note: there's a lot of scope as for when to add annotations and
;; what annotations to add. E.g. completing-help.el allowed adding
;; the first line of docstrings to M-x completion. But there's
;; a tension, since such annotations, while useful at times, can
;; actually drown the useful information.
;; So completion-annotate-function should be used parsimoniously, or
;; else only used upon a user's request (e.g. we could add a command
;; to completion-list-mode to add annotations to the current
;; completions).
"Function to add annotations in the *Completions* buffer.
The function takes a completion and should either return nil, or a string that
will be displayed next to the completion. The function can access the
completion table and predicates via `minibuffer-completion-table' and related
variables.")
(defun minibuffer-completion-help () (defun minibuffer-completion-help ()
"Display a list of possible completions of the current minibuffer contents." "Display a list of possible completions of the current minibuffer contents."
(interactive) (interactive)
@ -892,8 +930,15 @@ the completions buffer."
;; Remove the base-size tail because `sort' requires a properly ;; Remove the base-size tail because `sort' requires a properly
;; nil-terminated list. ;; nil-terminated list.
(when last (setcdr last nil)) (when last (setcdr last nil))
(display-completion-list (nconc (sort completions 'string-lessp) (setq completions (sort completions 'string-lessp))
base-size)))) (when completion-annotate-function
(setq completions
(mapcar (lambda (s)
(let ((ann
(funcall completion-annotate-function s)))
(if ann (list s ann) s)))
completions)))
(display-completion-list (nconc completions base-size))))
;; If there are no completions, or if the current input is already the ;; If there are no completions, or if the current input is already the
;; only possible completion, then hide (previous&stale) completions. ;; only possible completion, then hide (previous&stale) completions.
@ -998,8 +1043,11 @@ the completions buffer."
(if (eq (aref string (1- beg)) ?{) (if (eq (aref string (1- beg)) ?{)
(setq table (apply-partially 'completion-table-with-terminator (setq table (apply-partially 'completion-table-with-terminator
"}" table))) "}" table)))
(completion-table-with-context ;; Even if file-name completion is case-insensitive, we want
prefix table (substring string beg) pred action))))) ;; envvar completion to be case-sensitive.
(let ((completion-ignore-case nil))
(completion-table-with-context
prefix table (substring string beg) pred action))))))
(defun completion--file-name-table (string pred action) (defun completion--file-name-table (string pred action)
"Internal subroutine for `read-file-name'. Do not call this." "Internal subroutine for `read-file-name'. Do not call this."
@ -1447,15 +1495,15 @@ or a symbol chosen among `any', `star', `point'."
(defun completion-pcm--pattern->regex (pattern &optional group) (defun completion-pcm--pattern->regex (pattern &optional group)
(let ((re (let ((re
(concat "\\`" (concat "\\`"
(mapconcat (mapconcat
(lambda (x) (lambda (x)
(case x (case x
((star any point) ((star any point)
(if (if (consp group) (memq x group) group) (if (if (consp group) (memq x group) group)
"\\(.*?\\)" ".*?")) "\\(.*?\\)" ".*?"))
(t (regexp-quote x)))) (t (regexp-quote x))))
pattern pattern
"")))) ""))))
;; Avoid pathological backtracking. ;; Avoid pathological backtracking.
(while (string-match "\\.\\*\\?\\(?:\\\\[()]\\)*\\(\\.\\*\\?\\)" re) (while (string-match "\\.\\*\\?\\(?:\\\\[()]\\)*\\(\\.\\*\\?\\)" re)