;; Copyright (C) 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Package: emacs
;; This file is part of GNU Emacs.
;; 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.
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.
(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.
(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,
(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))))))))
;; 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)
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 ()
(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)
(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")
(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),
`: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."
+ "Perform completion on the text around point.
+The completion method is determined by `completion-at-point-functions'."
(interactive)
(let ((res (run-hook-with-args-until-success
'completion-at-point-functions)))
((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))
(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'
(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)
;; 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))
: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.
(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)))
(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
(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.
(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
;; `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)))))
(mapconcat (lambda (x) (cond
((stringp x) x)
((eq x 'star) "*")
- ((eq x 'any) "")
- ((eq x 'point) "")))
+ (t ""))) ;any, point, prefix.
pattern
""))
(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)))
'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)
HCoop / bpt / emacs.git / blobdiff