diff options
Diffstat (limited to 'lisp/minibuffer.el')
| -rw-r--r-- | lisp/minibuffer.el | 324 |
1 files changed, 235 insertions, 89 deletions
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 006e873ac57..78580c86e45 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> +;; Package: emacs ;; This file is part of GNU Emacs. @@ -76,6 +77,9 @@ ;; the provided string (as is the case in filecache.el), in which ;; case partial-completion (for example) doesn't make any sense ;; and neither does the completions-first-difference highlight. +;; - indicate how to display the completions in *Completions* (turn +;; \n into something else, add special boundaries between +;; completions). E.g. when completing from the kill-ring. ;; - make partial-completion-mode obsolete: ;; - (?) <foo.h> style completion for file names. @@ -407,6 +411,12 @@ Furthermore, for completions that are done step by step in subfields, the method is applied to all the preceding fields that do not yet match. E.g. C-x C-f /u/mo/s TAB could complete to /usr/monnier/src. Additionally the user can use the char \"*\" as a glob pattern.") + (substring + completion-substring-try-completion completion-substring-all-completions + "Completion of the string taken as a substring. +I.e. when completing \"foo_bar\" (where _ is the position of point), +it will consider all completions candidates matching the glob +pattern \"*foo*bar*\".") (initials completion-initials-try-completion completion-initials-all-completions "Completion of acronyms and initialisms. @@ -504,6 +514,25 @@ Moves point to the end of the new text." (delete-region (point) (+ (point) (- end beg))) (forward-char suffix-len))) +(defcustom completion-cycle-threshold nil + "Number of completion candidates below which cycling is used. +Depending on this setting `minibuffer-complete' may use cycling, +like `minibuffer-force-complete'. +If nil, cycling is never used. +If t, cycling is always used. +If an integer, cycling is used as soon as there are fewer completion +candidates than this number." + :type '(choice (const :tag "No cycling" nil) + (const :tag "Always cycle" t) + (integer :tag "Threshold"))) + +(defvar completion-all-sorted-completions nil) +(make-variable-buffer-local 'completion-all-sorted-completions) +(defvar completion-cycling nil) + +(defvar completion-fail-discreetly nil + "If non-nil, stay quiet when there is no match.") + (defun completion--do-completion (&optional try-completion-function) "Do the completion and return a summary of what happened. M = completion was performed, the text was Modified. @@ -532,11 +561,13 @@ E = after completion we now have an Exact match. (cond ((null comp) (minibuffer-hide-completions) - (ding) (minibuffer-message "No match") (minibuffer--bitset nil nil nil)) + (unless completion-fail-discreetly + (ding) (minibuffer-message "No match")) + (minibuffer--bitset nil nil nil)) ((eq t comp) (minibuffer-hide-completions) (goto-char (field-end)) - (minibuffer--bitset nil nil t)) ;Exact and unique match. + (minibuffer--bitset nil nil t)) ;Exact and unique match. (t ;; `completed' should be t if some completion was done, which doesn't ;; include simply changing the case of the entered string. However, @@ -556,34 +587,62 @@ E = after completion we now have an Exact match. (forward-char (- comp-pos (length completion))) (if (not (or unchanged completed)) - ;; The case of the string changed, but that's all. We're not sure - ;; whether this is a unique completion or not, so try again using - ;; the real case (this shouldn't recurse again, because the next - ;; time try-completion will return either t or the exact string). - (completion--do-completion try-completion-function) + ;; The case of the string changed, but that's all. We're not sure + ;; whether this is a unique completion or not, so try again using + ;; the real case (this shouldn't recurse again, because the next + ;; time try-completion will return either t or the exact string). + (completion--do-completion try-completion-function) ;; It did find a match. Do we match some possibility exactly now? (let ((exact (test-completion completion minibuffer-completion-table - minibuffer-completion-predicate))) - (if completed - ;; We could also decide to refresh the completions, - ;; if they're displayed (and assuming there are - ;; completions left). - (minibuffer-hide-completions) - ;; Show the completion table, if requested. - (cond - ((not exact) - (if (case completion-auto-help - (lazy (eq this-command last-command)) - (t completion-auto-help)) - (minibuffer-completion-help) - (minibuffer-message "Next char not unique"))) - ;; If the last exact completion and this one were the same, it - ;; means we've already given a "Next char not unique" message - ;; and the user's hit TAB again, so now we give him help. - ((eq this-command last-command) - (if completion-auto-help (minibuffer-completion-help))))) + minibuffer-completion-predicate)) + (comps + ;; Check to see if we want to do cycling. We do it + ;; here, after having performed the normal completion, + ;; so as to take advantage of the difference between + ;; try-completion and all-completions, for things + ;; like completion-ignored-extensions. + (when (and completion-cycle-threshold + ;; Check that the completion didn't make + ;; us jump to a different boundary. + (or (not completed) + (< (car (completion-boundaries + (substring completion 0 comp-pos) + minibuffer-completion-table + minibuffer-completion-predicate + "")) + comp-pos))) + (completion-all-sorted-completions)))) + (completion--flush-all-sorted-completions) + (cond + ((and (consp (cdr comps)) ;; There's something to cycle. + (not (ignore-errors + ;; This signal an (intended) error if comps is too + ;; short or if completion-cycle-threshold is t. + (consp (nthcdr completion-cycle-threshold comps))))) + ;; Fewer than completion-cycle-threshold remaining + ;; completions: let's cycle. + (setq completed t exact t) + (setq completion-all-sorted-completions comps) + (minibuffer-force-complete)) + (completed + ;; We could also decide to refresh the completions, + ;; if they're displayed (and assuming there are + ;; completions left). + (minibuffer-hide-completions)) + ;; Show the completion table, if requested. + ((not exact) + (if (case completion-auto-help + (lazy (eq this-command last-command)) + (t completion-auto-help)) + (minibuffer-completion-help) + (minibuffer-message "Next char not unique"))) + ;; If the last exact completion and this one were the same, it + ;; means we've already given a "Next char not unique" message + ;; and the user's hit TAB again, so now we give him help. + ((eq this-command last-command) + (if completion-auto-help (minibuffer-completion-help)))) (minibuffer--bitset completed t exact)))))))) @@ -597,21 +656,26 @@ scroll the window of possible completions." ;; If the previous command was not this, ;; mark the completion buffer obsolete. (unless (eq this-command last-command) + (completion--flush-all-sorted-completions) (setq minibuffer-scroll-window nil)) - (let ((window minibuffer-scroll-window)) + (cond ;; If there's a fresh completion window with a live buffer, ;; and this command is repeated, scroll that window. - (if (window-live-p window) + ((window-live-p minibuffer-scroll-window) + (let ((window minibuffer-scroll-window)) (with-current-buffer (window-buffer window) (if (pos-visible-in-window-p (point-max) window) ;; If end is in view, scroll up to the beginning. (set-window-start window (point-min) nil) ;; Else scroll down one screen. (scroll-other-window)) - nil) - - (case (completion--do-completion) + nil))) + ;; If we're cycling, keep on cycling. + ((and completion-cycling completion-all-sorted-completions) + (minibuffer-force-complete) + t) + (t (case (completion--do-completion) (#b000 nil) (#b001 (minibuffer-message "Sole completion") t) @@ -619,10 +683,8 @@ scroll the window of possible completions." t) (t t))))) -(defvar completion-all-sorted-completions nil) -(make-variable-buffer-local 'completion-all-sorted-completions) - (defun completion--flush-all-sorted-completions (&rest ignore) + (setq completion-cycling nil) (setq completion-all-sorted-completions nil)) (defun completion-all-sorted-completions () @@ -664,6 +726,7 @@ Repeated uses step through the possible completions." (all (completion-all-sorted-completions))) (if (not (consp all)) (minibuffer-message (if all "No more completions" "No completions")) + (setq completion-cycling t) (goto-char end) (insert (car all)) (delete-region (+ start (cdr (last all))) end) @@ -859,13 +922,13 @@ Return nil if there is no valid completion, else t." (defface completions-annotations '((t :inherit italic)) "Face to use for annotations in the *Completions* buffer.") -(defcustom completions-format nil +(defcustom completions-format 'horizontal "Define the appearance and sorting of completions. If the value is `vertical', display completions sorted vertically in columns in the *Completions* buffer. -If the value is `horizontal' or nil, display completions sorted +If the value is `horizontal', display completions sorted horizontally in alphabetical order, rather than down the screen." - :type '(choice (const nil) (const horizontal) (const vertical)) + :type '(choice (const horizontal) (const vertical)) :group 'minibuffer :version "23.2") @@ -1176,7 +1239,7 @@ Point needs to be somewhere between START and END." (call-interactively 'minibuffer-complete) (delete-overlay ol))))) -(defvar completion-at-point-functions nil +(defvar completion-at-point-functions '(tags-completion-at-point-function) "Special hook to find the completion table for the thing at point. It is called without any argument and should return either nil, or a function of no argument to perform completion (discouraged), @@ -1188,24 +1251,31 @@ Currently supported properties are: `:predicate' a predicate that completion candidates need to satisfy. `:annotation-function' the value to use for `completion-annotate-function'.") -(defun completion-at-point () - "Complete the thing at point according to local mode. -This runs the hook `completion-at-point-functions' until a member returns -non-nil." - (interactive) - (let ((res (run-hook-with-args-until-success - 'completion-at-point-functions))) - (cond - ((functionp res) (funcall res)) - (res - (let* ((plist (nthcdr 3 res)) - (start (nth 0 res)) - (end (nth 1 res)) - (completion-annotate-function - (or (plist-get plist :annotation-function) - completion-annotate-function))) - (completion-in-region start end (nth 2 res) - (plist-get plist :predicate))))))) +(defun completion-at-point (&optional arg) + "Perform completion on the text around point. +The completion method is determined by `completion-at-point-functions'. + +With a prefix argument, this command does completion within +the collection of symbols listed in the index of the manual for the +language you are using." + (interactive "P") + (if arg + (info-complete-symbol) + (let ((res (run-hook-with-args-until-success + 'completion-at-point-functions))) + (cond + ((functionp res) (funcall res)) + (res + (let* ((plist (nthcdr 3 res)) + (start (nth 0 res)) + (end (nth 1 res)) + (completion-annotate-function + (or (plist-get plist :annotation-function) + completion-annotate-function))) + (completion-in-region start end (nth 2 res) + (plist-get plist :predicate)))))))) + +(define-obsolete-function-alias 'complete-symbol 'completion-at-point "24.1") ;;; Key bindings. @@ -1305,12 +1375,19 @@ same as `substitute-in-file-name'." ((eq (car-safe action) 'boundaries) (let ((start (length (file-name-directory string))) (end (string-match-p "/" (cdr action)))) - (list* 'boundaries start end))) - - ((eq action 'lambda) - (if (zerop (length string)) - nil ;Not sure why it's here, but it probably doesn't harm. - (funcall (or pred 'file-exists-p) string))) + (list* 'boundaries + ;; if `string' is "C:" in w32, (file-name-directory string) + ;; returns "C:/", so `start' is 3 rather than 2. + ;; Not quite sure what is The Right Fix, but clipping it + ;; back to 2 will work for this particular case. We'll + ;; see if we can come up with a better fix when we bump + ;; into more such problematic cases. + (min start (length string)) end))) + + ((eq action 'lambda) + (if (zerop (length string)) + nil ;Not sure why it's here, but it probably doesn't harm. + (funcall (or pred 'file-exists-p) string))) (t (let* ((name (file-name-nondirectory string)) @@ -1358,19 +1435,20 @@ except that it passes the file name through `substitute-in-file-name'." (cond ((eq (car-safe action) 'boundaries) ;; For the boundaries, we can't really delegate to - ;; completion-file-name-table and then fix them up, because it - ;; would require us to track the relationship between `str' and + ;; substitute-in-file-name+completion-file-name-table and then fix + ;; them up (as we do for the other actions), because it would + ;; require us to track the relationship between `str' and ;; `string', which is difficult. And in any case, if - ;; substitute-in-file-name turns "fo-$TO-ba" into "fo-o/b-ba", there's - ;; no way for us to return proper boundaries info, because the - ;; boundary is not (yet) in `string'. - ;; FIXME: Actually there is a way to return correct boundaries info, - ;; at the condition of modifying the all-completions return accordingly. - (let ((start (length (file-name-directory string))) - (end (string-match-p "/" (cdr action)))) - (list* 'boundaries start end))) + ;; substitute-in-file-name turns "fo-$TO-ba" into "fo-o/b-ba", + ;; there's no way for us to return proper boundaries info, because + ;; the boundary is not (yet) in `string'. + ;; + ;; FIXME: Actually there is a way to return correct boundaries + ;; info, at the condition of modifying the all-completions + ;; return accordingly. But for now, let's not bother. + (completion-file-name-table string pred action)) - (t + (t (let* ((default-directory (if (stringp pred) ;; It used to be that `pred' was abused to pass `dir' @@ -1382,7 +1460,9 @@ except that it passes the file name through `substitute-in-file-name'." (substitute-in-file-name string) (error string))) (comp (completion-file-name-table - str (or pred read-file-name-predicate) action))) + str + (with-no-warnings (or pred read-file-name-predicate)) + action))) (cond ((stringp comp) @@ -1712,6 +1792,12 @@ Return the new suffix." ;; Nothing to merge. suffix)) +(defun completion-basic--pattern (beforepoint afterpoint bounds) + (delete + "" (list (substring beforepoint (car bounds)) + 'point + (substring afterpoint 0 (cdr bounds))))) + (defun completion-basic-try-completion (string table pred point) (lexical-let* ((beforepoint (substring string 0 point)) @@ -1782,6 +1868,14 @@ expression (not containing character ranges like `a-z')." :group 'minibuffer :type 'string) +(defcustom completion-pcm-complete-word-inserts-delimiters nil + "Treat the SPC or - inserted by `minibuffer-complete-word' as delimiters. +Those chars are treated as delimiters iff this variable is non-nil. +I.e. if non-nil, M-x SPC will just insert a \"-\" in the minibuffer, whereas +if nil, it will list all possible commands in *Completions* because none of +the commands start with a \"-\" or a SPC." + :type 'boolean) + (defun completion-pcm--pattern-trivial-p (pattern) (and (stringp (car pattern)) ;; It can be followed by `point' and "" and still be trivial. @@ -1794,7 +1888,7 @@ expression (not containing character ranges like `a-z')." (defun completion-pcm--string->pattern (string &optional point) "Split STRING into a pattern. A pattern is a list where each element is either a string -or a symbol chosen among `any', `star', `point'." +or a symbol chosen among `any', `star', `point', `prefix'." (if (and point (< point (length string))) (let ((prefix (substring string 0 point)) (suffix (substring string point))) @@ -1807,11 +1901,12 @@ or a symbol chosen among `any', `star', `point'." (while (and (setq p (string-match completion-pcm--delim-wild-regex string p)) - ;; If the char was added by minibuffer-complete-word, then - ;; don't treat it as a delimiter, otherwise "M-x SPC" - ;; ends up inserting a "-" rather than listing - ;; all completions. - (not (get-text-property p 'completion-try-word string))) + (or completion-pcm-complete-word-inserts-delimiters + ;; If the char was added by minibuffer-complete-word, + ;; then don't treat it as a delimiter, otherwise + ;; "M-x SPC" ends up inserting a "-" rather than listing + ;; all completions. + (not (get-text-property p 'completion-try-word string)))) ;; Usually, completion-pcm--delim-wild-regex matches a delimiter, ;; meaning that something can be added *before* it, but it can also ;; match a prefix and postfix, in which case something can be added @@ -1837,11 +1932,10 @@ or a symbol chosen among `any', `star', `point'." (concat "\\`" (mapconcat (lambda (x) - (case x - ((star any point) - (if (if (consp group) (memq x group) group) - "\\(.*?\\)" ".*?")) - (t (regexp-quote x)))) + (cond + ((stringp x) (regexp-quote x)) + ((if (consp group) (memq x group) group) "\\(.*?\\)") + (t ".*?"))) pattern "")))) ;; Avoid pathological backtracking. @@ -1997,6 +2091,17 @@ filter out additional entries (because TABLE migth not obey PRED)." (nconc (completion-pcm--hilit-commonality pattern all) (length prefix))))) +(defun completion--sreverse (str) + "Like `reverse' but for a string STR rather than a list." + (apply 'string (nreverse (mapcar 'identity str)))) + +(defun completion--common-suffix (strs) + "Return the common suffix of the strings STRS." + (completion--sreverse + (try-completion + "" + (mapcar 'completion--sreverse strs)))) + (defun completion-pcm--merge-completions (strs pattern) "Extract the commonality in STRS, with the help of PATTERN." ;; When completing while ignoring case, we want to try and avoid @@ -2058,7 +2163,17 @@ filter out additional entries (because TABLE migth not obey PRED)." ;; `any' into a `star' because the surrounding context has ;; changed such that string->pattern wouldn't add an `any' ;; here any more. - (unless unique (push elem res)) + (unless unique + (push elem res) + (when (memq elem '(star point prefix)) + ;; Extract common suffix additionally to common prefix. + ;; Only do it for `point', `star', and `prefix' since for + ;; `any' it could lead to a merged completion that + ;; doesn't itself match the candidates. + (let ((suffix (completion--common-suffix comps))) + (assert (stringp suffix)) + (unless (equal suffix "") + (push suffix res))))) (setq fixed ""))))) ;; We return it in reverse order. res))))) @@ -2067,8 +2182,7 @@ filter out additional entries (because TABLE migth not obey PRED)." (mapconcat (lambda (x) (cond ((stringp x) x) ((eq x 'star) "*") - ((eq x 'any) "") - ((eq x 'point) ""))) + (t ""))) ;any, point, prefix. pattern "")) @@ -2110,6 +2224,7 @@ filter out additional entries (because TABLE migth not obey PRED)." (pointpat (or (memq 'point mergedpat) (memq 'any mergedpat) (memq 'star mergedpat) + ;; Not `prefix'. mergedpat)) ;; New pos from the start. (newpos (length (completion-pcm--pattern->string pointpat))) @@ -2127,7 +2242,38 @@ filter out additional entries (because TABLE migth not obey PRED)." 'completion-pcm--filename-try-filter)) (completion-pcm--merge-try pattern all prefix suffix))) -;;; Initials completion +;;; Substring completion +;; Mostly derived from the code of `basic' completion. + +(defun completion-substring--all-completions (string table pred point) + (let* ((beforepoint (substring string 0 point)) + (afterpoint (substring string point)) + (bounds (completion-boundaries beforepoint table pred afterpoint)) + (suffix (substring afterpoint (cdr bounds))) + (prefix (substring beforepoint 0 (car bounds))) + (basic-pattern (completion-basic--pattern + beforepoint afterpoint bounds)) + (pattern (if (not (stringp (car basic-pattern))) + basic-pattern + (cons 'prefix basic-pattern))) + (all (completion-pcm--all-completions prefix pattern table pred))) + (list all pattern prefix suffix (car bounds)))) + +(defun completion-substring-try-completion (string table pred point) + (destructuring-bind (all pattern prefix suffix carbounds) + (completion-substring--all-completions string table pred point) + (if minibuffer-completing-file-name + (setq all (completion-pcm--filename-try-filter all))) + (completion-pcm--merge-try pattern all prefix suffix))) + +(defun completion-substring-all-completions (string table pred point) + (destructuring-bind (all pattern prefix suffix carbounds) + (completion-substring--all-completions string table pred point) + (when all + (nconc (completion-pcm--hilit-commonality pattern all) + (length prefix))))) + +;; Initials completion ;; Complete /ums to /usr/monnier/src or lch to list-command-history. (defun completion-initials-expand (str table pred) |