;; internal use only.
;; Functional completion tables have an extended calling conventions:
-;; - The `action' can be (additionally to nil, t, and lambda) of the form
-;; (boundaries . SUFFIX) in which case it should return
+;; The `action' can be (additionally to nil, t, and lambda) of the form
+;; - (boundaries . SUFFIX) in which case it should return
;; (boundaries START . END). See `completion-boundaries'.
;; Any other return value should be ignored (so we ignore values returned
;; from completion tables that don't know about this new `action' form).
+;; - `metadata' in which case it should return (metadata . ALIST) where
+;; ALIST is the metadata of this table. See `completion-metadata'.
+;; Any other return value should be ignored (so we ignore values returned
+;; from completion tables that don't know about this new `action' form).
;;; Bugs:
;; - choose-completion doesn't know how to quote the text it inserts.
;; E.g. it fails to double the dollars in file-name completion, or
;; to backslash-escape spaces and other chars in comint completion.
-;; - when completing ~/tmp/fo$$o, the highligting in *Completions*
+;; - when completing ~/tmp/fo$$o, the highlighting in *Completions*
;; is off by one position.
;; - all code like PCM which relies on all-completions to match
;; its argument gets confused because all-completions returns unquoted
;;; Todo:
-;; - extend `boundaries' to provide various other meta-data about the
-;; output of `all-completions':
-;; - preferred sorting order when displayed in *Completions*.
-;; - annotations/text-properties to add when displayed in *Completions*.
+;; - for M-x, cycle-sort commands that have no key binding first.
+;; - Make things like icomplete-mode or lightning-completion work with
+;; completion-in-region-mode.
+;; - extend `metadata':
;; - quoting/unquoting (so we can complete files names with envvars
;; and backslashes, and all-completion can list names without
;; quoting backslashes and dollars).
;; - indicate how to turn all-completion's output into
;; try-completion's output: e.g. completion-ignored-extensions.
;; maybe that could be merged with the "quote" operation above.
-;; - completion hook to run when the completion is
-;; selected/inserted (maybe this should be provided some other
-;; way, e.g. as text-property, so `try-completion can also return it?)
-;; both for when it's inserted via TAB or via choose-completion.
;; - indicate that `all-completions' doesn't do prefix-completion
;; but just returns some list that relates in some other way to
;; the provided string (as is the case in filecache.el), in which
;; \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.
-;; This can't be done identically just by tweaking completion,
-;; because partial-completion-mode's behavior is to expand <string.h>
-;; to /usr/include/string.h only when exiting the minibuffer, at which
-;; point the completion code is actually not involved normally.
-;; Partial-completion-mode does it via a find-file-not-found-function.
-;; - special code for C-x C-f <> to visit the file ref'd at point
-;; via (require 'foo) or #include "foo". ffap seems like a better
-;; place for this feature (supplemented with major-mode-provided
-;; functions to find the file ref'd at point).
-
;; - case-sensitivity currently confuses two issues:
;; - whether or not a particular completion table should be case-sensitive
;; (i.e. whether strings that differ only by case are semantically
and for file names the result is the positions delimited by
the closest directory separators."
(let ((boundaries (if (functionp table)
- (funcall table string pred (cons 'boundaries suffix)))))
+ (funcall table string pred
+ (cons 'boundaries suffix)))))
(if (not (eq (car-safe boundaries) 'boundaries))
(setq boundaries nil))
(cons (or (cadr boundaries) 0)
(or (cddr boundaries) (length suffix)))))
+(defun completion-metadata (string table pred)
+ "Return the metadata of elements to complete at the end of STRING.
+This metadata is an alist. Currently understood keys are:
+- `category': the kind of objects returned by `all-completions'.
+ Used by `completion-category-overrides'.
+- `annotation-function': function to add annotations in *Completions*.
+ Takes one argument (STRING), which is a possible completion and
+ returns a string to append to STRING.
+- `display-sort-function': function to sort entries in *Completions*.
+ Takes one argument (COMPLETIONS) and should return a new list
+ of completions. Can operate destructively.
+- `cycle-sort-function': function to sort entries when cycling.
+ Works like `display-sort-function'.
+The metadata of a completion table should be constant between two boundaries."
+ (let ((metadata (if (functionp table)
+ (funcall table string pred 'metadata))))
+ (if (eq (car-safe metadata) 'metadata)
+ metadata
+ '(metadata))))
+
+(defun completion--field-metadata (field-start)
+ (completion-metadata (buffer-substring-no-properties field-start (point))
+ minibuffer-completion-table
+ minibuffer-completion-predicate))
+
+(defun completion-metadata-get (metadata prop)
+ (cdr (assq prop metadata)))
+
(defun completion--some (fun xs)
"Apply FUN to each element of XS in turn.
Return the first non-nil returned value.
ACTION can be one of nil, t or `lambda'."
(cond
((functionp table) (funcall table string pred action))
- ((eq (car-safe action) 'boundaries)
- (cons 'boundaries (completion-boundaries string table pred (cdr action))))
+ ((eq (car-safe action) 'boundaries) nil)
+ ((eq action 'metadata) nil)
(t
(funcall
(cond
that can be used as the COLLECTION argument to `try-completion' and
`all-completions'. See Info node `(elisp)Programmed Completion'."
(lambda (string pred action)
- (if (eq (car-safe action) 'boundaries)
+ (if (or (eq (car-safe action) 'boundaries) (eq action 'metadata))
;; `fun' is not supposed to return another function but a plain old
;; completion table, whose boundaries are always trivial.
nil
(setq ,var (,fun)))
,var))))
-(defun completion-table-case-fold (table string pred action)
- (let ((completion-ignore-case t))
- (complete-with-action action table string pred)))
+(defun completion-table-case-fold (table &optional dont-fold)
+ "Return new completion TABLE that is case insensitive.
+If DONT-FOLD is non-nil, return a completion table that is
+case sensitive instead."
+ (lambda (string pred action)
+ (let ((completion-ignore-case (not dont-fold)))
+ (complete-with-action action table string pred))))
(defun completion-table-with-context (prefix table string pred action)
;; TODO: add `suffix' maybe?
in which case TERMINATOR-REGEXP is a regular expression whose submatch
number 1 should match TERMINATOR. This is used when there is a need to
distinguish occurrences of the TERMINATOR strings which are really terminators
-from others (e.g. escaped)."
+from others (e.g. escaped). In this form, the car of TERMINATOR can also be,
+instead of a string, a function that takes the completion and returns the
+\"terminated\" string."
;; FIXME: This implementation is not right since it only adds the terminator
;; in try-completion, so any completion-style that builds the completion via
;; all-completions won't get the terminator, and selecting an entry in
(bounds (completion-boundaries string table pred suffix))
(terminator-regexp (if (consp terminator)
(cdr terminator) (regexp-quote terminator)))
- (max (string-match terminator-regexp suffix)))
+ (max (and terminator-regexp
+ (string-match terminator-regexp suffix))))
(list* 'boundaries (car bounds)
(min (cdr bounds) (or max (length suffix))))))
((eq action nil)
(let ((comp (try-completion string table pred)))
(if (consp terminator) (setq terminator (car terminator)))
(if (eq comp t)
- (concat string terminator)
- (if (and (stringp comp)
- ;; FIXME: Try to avoid this second call, especially since
+ (if (functionp terminator)
+ (funcall terminator string)
+ (concat string terminator))
+ (if (and (stringp comp) (not (zerop (length comp)))
+ ;; Try to avoid the second call to try-completion, since
;; it may be very inefficient (because `comp' made us
;; jump to a new boundary, so we complete in that
;; boundary with an empty start string).
- ;; completion-boundaries might help.
+ (let ((newbounds (completion-boundaries comp table pred "")))
+ (< (car newbounds) (length comp)))
(eq (try-completion comp table pred) t))
- (concat comp terminator)
+ (if (functionp terminator)
+ (funcall terminator comp)
+ (concat comp terminator))
comp))))
- ((eq action t)
+ ;; completion-table-with-terminator is always used for
+ ;; "sub-completions" so it's only called if the terminator is missing,
+ ;; in which case `test-completion' should return nil.
+ ((eq action 'lambda) nil)
+ (t
;; FIXME: We generally want the `try' and `all' behaviors to be
;; consistent so pcm can merge the `all' output to get the `try' output,
;; but that sometimes clashes with the need for `all' output to look
;; good in *Completions*.
;; (mapcar (lambda (s) (concat s terminator))
;; (all-completions string table pred))))
- (all-completions string table pred))
- ;; completion-table-with-terminator is always used for
- ;; "sub-completions" so it's only called if the terminator is missing,
- ;; in which case `test-completion' should return nil.
- ((eq action 'lambda) nil)))
+ (complete-with-action action table string pred))))
(defun completion-table-with-predicate (table pred1 strict string pred2 action)
"Make a completion table equivalent to TABLE but filtered through PRED1.
(test-completion string table pred2))
(t
(or (complete-with-action action table string
- (if (null pred2) pred1
+ (if (not (and pred1 pred2))
+ (or pred1 pred2)
(lambda (x)
;; Call `pred1' first, so that `pred2'
;; really can't tell that `x' is in table.
- (if (funcall pred1 x) (funcall pred2 x)))))
+ (and (funcall pred1 x) (funcall pred2 x)))))
;; If completion failed and we're not applying pred1 strictly, try
;; again without pred1.
- (and (not strict)
+ (and (not strict) pred1 pred2
(complete-with-action action table string pred2))))))
(defun completion-table-in-turn (&rest tables)
;; is on, the field doesn't cover the entire minibuffer contents.
(delete-region (minibuffer-prompt-end) (point-max)))
+(defvar completion-show-inline-help t
+ "If non-nil, print helpful inline messages during completion.")
+
(defcustom completion-auto-help t
"Non-nil means automatically provide help for invalid completion input.
If the value is t the *Completion* buffer is displayed whenever completion
follow the calling convention of `completion-all-completions'),
and DOC describes the way this style of completion works.")
+(defconst completion--styles-type
+ `(repeat :tag "insert a new menu to add more styles"
+ (choice ,@(mapcar (lambda (x) (list 'const (car x)))
+ completion-styles-alist))))
+(defconst completion--cycling-threshold-type
+ '(choice (const :tag "No cycling" nil)
+ (const :tag "Always cycle" t)
+ (integer :tag "Threshold")))
+
(defcustom completion-styles
;; First, use `basic' because prefix completion has been the standard
;; for "ever" and works well in most cases, so using it first
;; and simply add "bar" to the end of the result.
emacs22)
"List of completion styles to use.
-The available styles are listed in `completion-styles-alist'."
- :type `(repeat (choice ,@(mapcar (lambda (x) (list 'const (car x)))
- completion-styles-alist)))
+The available styles are listed in `completion-styles-alist'.
+
+Note that `completion-category-overrides' may override these
+styles for specific categories, such as files, buffers, etc."
+ :type completion--styles-type
:group 'minibuffer
:version "23.1")
-(defun completion-try-completion (string table pred point)
+(defcustom completion-category-overrides
+ '((buffer (styles . (basic substring))))
+ "List of `completion-styles' overrides for specific categories.
+Each override has the shape (CATEGORY . ALIST) where ALIST is
+an association list that can specify properties such as:
+- `styles': the list of `completion-styles' to use for that category.
+- `cycle': the `completion-cycle-threshold' to use for that category."
+ :type `(alist :key-type (choice :tag "Category"
+ (const buffer)
+ (const file)
+ (const unicode-name)
+ symbol)
+ :value-type
+ (set :tag "Properties to override"
+ (cons :tag "Completion Styles"
+ (const :tag "Select a style from the menu;" styles)
+ ,completion--styles-type)
+ (cons :tag "Completion Cycling"
+ (const :tag "Select one value from the menu." cycle)
+ ,completion--cycling-threshold-type))))
+
+(defun completion--styles (metadata)
+ (let* ((cat (completion-metadata-get metadata 'category))
+ (over (assq 'styles (cdr (assq cat completion-category-overrides)))))
+ (if over
+ (delete-dups (append (cdr over) (copy-sequence completion-styles)))
+ completion-styles)))
+
+(defun completion-try-completion (string table pred point &optional metadata)
"Try to complete STRING using completion table TABLE.
Only the elements of table that satisfy predicate PRED are considered.
POINT is the position of point within STRING.
(completion--some (lambda (style)
(funcall (nth 1 (assq style completion-styles-alist))
string table pred point))
- completion-styles))
+ (completion--styles (or metadata
+ (completion-metadata
+ (substring string 0 point)
+ table pred)))))
-(defun completion-all-completions (string table pred point)
+(defun completion-all-completions (string table pred point &optional metadata)
"List the possible completions of STRING in completion table TABLE.
Only the elements of table that satisfy predicate PRED are considered.
POINT is the position of point within STRING.
(completion--some (lambda (style)
(funcall (nth 2 (assq style completion-styles-alist))
string table pred point))
- completion-styles))
+ (completion--styles (or metadata
+ (completion-metadata
+ (substring string 0 point)
+ table pred)))))
(defun minibuffer--bitset (modified completions exact)
(logior (if modified 4 0)
(setq end (- end suffix-len))
(setq newtext (substring newtext 0 (- suffix-len))))
(goto-char beg)
- (insert newtext)
+ (insert-and-inherit newtext)
(delete-region (point) (+ (point) (- end beg)))
(forward-char suffix-len)))
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")))
+ :type completion--cycling-threshold-type)
+
+(defun completion--cycle-threshold (metadata)
+ (let* ((cat (completion-metadata-get metadata 'category))
+ (over (assq 'cycle (cdr (assq cat completion-category-overrides)))))
+ (if over (cdr over) completion-cycle-threshold)))
(defvar completion-all-sorted-completions nil)
(make-variable-buffer-local 'completion-all-sorted-completions)
(defvar completion-fail-discreetly nil
"If non-nil, stay quiet when there is no match.")
-(defun completion--do-completion (&optional try-completion-function)
+(defun completion--message (msg)
+ (if completion-show-inline-help
+ (minibuffer-message msg)))
+
+(defun completion--do-completion (&optional try-completion-function
+ expect-exact)
"Do the completion and return a summary of what happened.
M = completion was performed, the text was Modified.
C = there were available Completions.
100 4 ??? impossible
101 5 ??? impossible
110 6 some completion happened
- 111 7 completed to an exact completion"
+ 111 7 completed to an exact completion
+
+TRY-COMPLETION-FUNCTION is a function to use in place of `try-completion'.
+EXPECT-EXACT, if non-nil, means that there is no need to tell the user
+when the buffer's text is already an exact match."
(let* ((beg (field-beginning))
(end (field-end))
(string (buffer-substring beg end))
+ (md (completion--field-metadata beg))
(comp (funcall (or try-completion-function
'completion-try-completion)
string
minibuffer-completion-table
minibuffer-completion-predicate
- (- (point) beg))))
+ (- (point) beg)
+ md)))
(cond
((null comp)
(minibuffer-hide-completions)
(unless completion-fail-discreetly
- (ding) (minibuffer-message "No match"))
+ (ding)
+ (completion--message "No match"))
(minibuffer--bitset nil nil nil))
((eq t comp)
(minibuffer-hide-completions)
- (goto-char (field-end))
+ (goto-char end)
+ (completion--done string 'finished
+ (unless expect-exact "Sole completion"))
(minibuffer--bitset nil nil t)) ;Exact and unique match.
(t
;; `completed' should be t if some completion was done, which doesn't
;; 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)
+ (completion--do-completion try-completion-function expect-exact)
;; It did find a match. Do we match some possibility exactly now?
- (let ((exact (test-completion completion
- minibuffer-completion-table
- minibuffer-completion-predicate))
+ (let* ((exact (test-completion completion
+ minibuffer-completion-table
+ minibuffer-completion-predicate))
+ (threshold (completion--cycle-threshold md))
(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
+ (when (and threshold
;; Check that the completion didn't make
;; us jump to a different boundary.
(or (not completed)
(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)))))
+ (consp (nthcdr threshold comps)))))
;; Fewer than completion-cycle-threshold remaining
;; completions: let's cycle.
(setq completed t exact t)
;; We could also decide to refresh the completions,
;; if they're displayed (and assuming there are
;; completions left).
- (minibuffer-hide-completions))
+ (minibuffer-hide-completions)
+ (if exact
+ ;; If completion did not put point at end of field,
+ ;; it's a sign that completion is not finished.
+ (completion--done completion
+ (if (< comp-pos (length completion))
+ 'exact 'unknown))))
;; Show the completion table, if requested.
((not exact)
- (if (case completion-auto-help
+ (if (case completion-auto-help
(lazy (eq this-command last-command))
(t completion-auto-help))
(minibuffer-completion-help)
- (minibuffer-message "Next char not unique")))
+ (completion--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
+ ;; means we've already given a "Complete, but 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))))
+ (t
+ (if (and (eq this-command last-command) completion-auto-help)
+ (minibuffer-completion-help))
+ (completion--done completion 'exact
+ (unless expect-exact
+ "Complete, but not unique"))))
(minibuffer--bitset completed t exact))))))))
t)
(t (case (completion--do-completion)
(#b000 nil)
- (#b001 (minibuffer-message "Sole completion")
- t)
- (#b011 (minibuffer-message "Complete, but not unique")
- t)
(t t)))))
(defun completion--flush-all-sorted-completions (&rest _ignore)
(setq completion-cycling nil)
(setq completion-all-sorted-completions nil))
+(defun completion--metadata (string base md-at-point table pred)
+ ;; Like completion-metadata, but for the specific case of getting the
+ ;; metadata at `base', which tends to trigger pathological behavior for old
+ ;; completion tables which don't understand `metadata'.
+ (let ((bounds (completion-boundaries string table pred "")))
+ (if (eq (car bounds) base) md-at-point
+ (completion-metadata (substring string 0 base) table pred))))
+
(defun completion-all-sorted-completions ()
(or completion-all-sorted-completions
(let* ((start (field-beginning))
(end (field-end))
- (all (completion-all-completions (buffer-substring start end)
- minibuffer-completion-table
- minibuffer-completion-predicate
- (- (point) start)))
+ (string (buffer-substring start end))
+ (md (completion--field-metadata start))
+ (all (completion-all-completions
+ string
+ minibuffer-completion-table
+ minibuffer-completion-predicate
+ (- (point) start)
+ md))
(last (last all))
- (base-size (or (cdr last) 0)))
+ (base-size (or (cdr last) 0))
+ (all-md (completion--metadata (buffer-substring-no-properties
+ start (point))
+ base-size md
+ minibuffer-completion-table
+ minibuffer-completion-predicate))
+ (sort-fun (completion-metadata-get all-md 'cycle-sort-function)))
(when last
(setcdr last nil)
- ;; Prefer shorter completions.
- (setq all (sort all (lambda (c1 c2)
- (let ((s1 (get-text-property
- 0 :completion-cycle-penalty c1))
- (s2 (get-text-property
- 0 :completion-cycle-penalty c2)))
- (if (eq s1 s2)
- (< (length c1) (length c2))
- (< (or s1 (length c1))
- (or s2 (length c2))))))))
+ (setq all (if sort-fun (funcall sort-fun all)
+ ;; Prefer shorter completions, by default.
+ (sort all (lambda (c1 c2) (< (length c1) (length c2))))))
;; Prefer recently used completions.
- ;; FIXME: Additional sorting ideas:
- ;; - for M-x, prefer commands that have no key binding.
- (let ((hist (symbol-value minibuffer-history-variable)))
- (setq all (sort all (lambda (c1 c2)
- (> (length (member c1 hist))
- (length (member c2 hist)))))))
+ (when (minibufferp)
+ (let ((hist (symbol-value minibuffer-history-variable)))
+ (setq all (sort all (lambda (c1 c2)
+ (> (length (member c1 hist))
+ (length (member c2 hist))))))))
;; Cache the result. This is not just for speed, but also so that
;; repeated calls to minibuffer-force-complete can cycle through
;; all possibilities.
;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
(let* ((start (field-beginning))
(end (field-end))
- (all (completion-all-sorted-completions)))
- (if (not (consp all))
- (minibuffer-message (if all "No more completions" "No completions"))
+ ;; (md (completion--field-metadata start))
+ (all (completion-all-sorted-completions))
+ (base (+ start (or (cdr (last all)) 0))))
+ (cond
+ ((not (consp all))
+ (completion--message
+ (if all "No more completions" "No completions")))
+ ((not (consp (cdr all)))
+ (let ((mod (equal (car all) (buffer-substring-no-properties base end))))
+ (if mod (completion--replace base end (car all)))
+ (completion--done (buffer-substring-no-properties start (point))
+ 'finished (unless mod "Sole completion"))))
+ (t
(setq completion-cycling t)
- (goto-char end)
- (insert (car all))
- (delete-region (+ start (cdr (last all))) end)
+ (completion--replace base end (car all))
+ (completion--done (buffer-substring-no-properties start (point)) 'sole)
;; If completing file names, (car all) may be a directory, so we'd now
;; have a new set of possible completions and might want to reset
;; completion-all-sorted-completions to nil, but we prefer not to,
;; through the previous possible completions.
(let ((last (last all)))
(setcdr last (cons (car all) (cdr last)))
- (setq completion-all-sorted-completions (cdr all))))))
+ (setq completion-all-sorted-completions (cdr all)))))))
(defvar minibuffer-confirm-exit-commands
'(minibuffer-complete minibuffer-complete-word PC-complete PC-complete-word)
;; file, so `try-completion' actually completes to
;; that file.
(= (length string) (length compl)))
- (goto-char end)
- (insert compl)
- (delete-region beg end))))
+ (completion--replace beg end compl))))
(exit-minibuffer))
((memq minibuffer-completion-confirm '(confirm confirm-after-completion))
(t
;; Call do-completion, but ignore errors.
(case (condition-case nil
- (completion--do-completion)
+ (completion--do-completion nil 'expect-exact)
(error 1))
((#b001 #b011) (exit-minibuffer))
(#b111 (if (not minibuffer-completion-confirm)
nil))
(t nil))))))
-(defun completion--try-word-completion (string table predicate point)
- (let ((comp (completion-try-completion string table predicate point)))
+(defun completion--try-word-completion (string table predicate point md)
+ (let ((comp (completion-try-completion string table predicate point md)))
(if (not (consp comp))
comp
(while (and exts (not (consp tem)))
(setq tem (completion-try-completion
(concat before (pop exts) after)
- table predicate (1+ point))))
+ table predicate (1+ point) md)))
(if (consp tem) (setq comp tem))))
;; Completing a single word is actually more difficult than completing
(interactive)
(case (completion--do-completion 'completion--try-word-completion)
(#b000 nil)
- (#b001 (minibuffer-message "Sole completion")
- t)
- (#b011 (minibuffer-message "Complete, but not unique")
- t)
(t t)))
(defface completions-annotations '((t :inherit italic))
(column 0)
(rows (/ (length strings) columns))
(row 0)
+ (first t)
(laststring nil))
;; The insertion should be "sensible" no matter what choices were made
;; for the parameters above.
(dolist (str strings)
(unless (equal laststring str) ; Remove (consecutive) duplicates.
(setq laststring str)
+ ;; FIXME: `string-width' doesn't pay attention to
+ ;; `display' properties.
(let ((length (if (consp str)
(+ (string-width (car str))
(string-width (cadr str)))
(forward-line 1)
(end-of-line)))
(insert " \t")
- (set-text-properties (- (point) 1) (point)
+ (set-text-properties (1- (point)) (point)
`(display (space :align-to ,column)))))
(t
;; Horizontal format
- (unless (bolp)
+ (unless first
(if (< wwidth (+ (max colwidth length) column))
;; No space for `str' at point, move to next line.
(progn (insert "\n") (setq column 0))
;; Leave the space unpropertized so that in the case we're
;; already past the goal column, there is still
;; a space displayed.
- (set-text-properties (- (point) 1) (point)
+ (set-text-properties (1- (point)) (point)
;; We can't just set tab-width, because
;; completion-setup-function will kill
;; all local variables :-(
`(display (space :align-to ,column)))
nil))))
+ (setq first nil)
(if (not (consp str))
(put-text-property (point) (progn (insert str) (point))
'mouse-face 'highlight)
(run-hooks 'completion-setup-hook)))
nil)
+(defvar completion-extra-properties nil
+ "Property list of extra properties of the current completion job.
+These include:
+`:annotation-function': 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 data via `minibuffer-completion-table' and related variables.
+`:exit-function': Function to run after completion is performed.
+ The function takes at least 2 parameters (STRING and STATUS) where STRING
+ is the text to which the field was completed and STATUS indicates what
+ kind of operation happened: if text is now complete it's `finished', if text
+ cannot be further completed but completion is not finished, it's `sole', if
+ text is a valid completion but may be further completed, it's `exact', and
+ other STATUSes may be added in the future.")
+
(defvar completion-annotate-function
nil
;; Note: there's a lot of scope as for when to add annotations and
will be displayed next to the completion. The function can access the
completion table and predicates via `minibuffer-completion-table' and related
variables.")
+(make-obsolete-variable 'completion-annotate-function
+ 'completion-extra-properties "24.1")
+
+(defun completion--done (string &optional finished message)
+ (let* ((exit-fun (plist-get completion-extra-properties :exit-function))
+ (pre-msg (and exit-fun (current-message))))
+ (assert (memq finished '(exact sole finished unknown)))
+ ;; FIXME: exit-fun should receive `finished' as a parameter.
+ (when exit-fun
+ (when (eq finished 'unknown)
+ (setq finished
+ (if (eq (try-completion string
+ minibuffer-completion-table
+ minibuffer-completion-predicate)
+ t)
+ 'finished 'exact)))
+ (funcall exit-fun string finished))
+ (when (and message
+ ;; Don't output any message if the exit-fun already did so.
+ (equal pre-msg (and exit-fun (current-message))))
+ (completion--message message))))
(defun minibuffer-completion-help ()
"Display a list of possible completions of the current minibuffer contents."
(let* ((start (field-beginning))
(end (field-end))
(string (field-string))
+ (md (completion--field-metadata start))
(completions (completion-all-completions
string
minibuffer-completion-table
minibuffer-completion-predicate
- (- (point) (field-beginning)))))
+ (- (point) (field-beginning))
+ md)))
(message nil)
- (if (and completions
- (or (consp (cdr completions))
- (not (equal (car completions) string))))
- (let* ((last (last completions))
- (base-size (cdr last))
- ;; If the *Completions* buffer is shown in a new
- ;; window, mark it as softly-dedicated, so bury-buffer in
- ;; minibuffer-hide-completions will know whether to
- ;; delete the window or not.
- (display-buffer-mark-dedicated 'soft))
- (with-output-to-temp-buffer "*Completions*"
- ;; Remove the base-size tail because `sort' requires a properly
- ;; nil-terminated list.
- (when last (setcdr last nil))
- (setq completions (sort completions 'string-lessp))
- (when completion-annotate-function
- (setq completions
- (mapcar (lambda (s)
- (let ((ann
- (funcall completion-annotate-function s)))
- (if ann (list s ann) s)))
- completions)))
- (with-current-buffer standard-output
- (set (make-local-variable 'completion-base-position)
- (list (+ start base-size)
- ;; FIXME: We should pay attention to completion
- ;; boundaries here, but currently
- ;; completion-all-completions does not give us the
- ;; necessary information.
- end)))
- (display-completion-list completions)))
-
- ;; If there are no completions, or if the current input is already the
- ;; only possible completion, then hide (previous&stale) completions.
- (minibuffer-hide-completions)
- (ding)
- (minibuffer-message
- (if completions "Sole completion" "No completions")))
+ (if (or (null completions)
+ (and (not (consp (cdr completions)))
+ (equal (car completions) string)))
+ (progn
+ ;; If there are no completions, or if the current input is already
+ ;; the sole completion, then hide (previous&stale) completions.
+ (minibuffer-hide-completions)
+ (ding)
+ (minibuffer-message
+ (if completions "Sole completion" "No completions")))
+
+ (let* ((last (last completions))
+ (base-size (cdr last))
+ (prefix (unless (zerop base-size) (substring string 0 base-size)))
+ (all-md (completion--metadata (buffer-substring-no-properties
+ start (point))
+ base-size md
+ minibuffer-completion-table
+ minibuffer-completion-predicate))
+ (afun (or (completion-metadata-get all-md 'annotation-function)
+ (plist-get completion-extra-properties
+ :annotation-function)
+ completion-annotate-function))
+ ;; If the *Completions* buffer is shown in a new
+ ;; window, mark it as softly-dedicated, so bury-buffer in
+ ;; minibuffer-hide-completions will know whether to
+ ;; delete the window or not.
+ (display-buffer-mark-dedicated 'soft))
+ (with-output-to-temp-buffer "*Completions*"
+ ;; Remove the base-size tail because `sort' requires a properly
+ ;; nil-terminated list.
+ (when last (setcdr last nil))
+ (setq completions
+ ;; FIXME: This function is for the output of all-completions,
+ ;; not completion-all-completions. Often it's the same, but
+ ;; not always.
+ (let ((sort-fun (completion-metadata-get
+ all-md 'display-sort-function)))
+ (if sort-fun
+ (funcall sort-fun completions)
+ (sort completions 'string-lessp))))
+ (when afun
+ (setq completions
+ (mapcar (lambda (s)
+ (let ((ann (funcall afun s)))
+ (if ann (list s ann) s)))
+ completions)))
+
+ (with-current-buffer standard-output
+ (set (make-local-variable 'completion-base-position)
+ (list (+ start base-size)
+ ;; FIXME: We should pay attention to completion
+ ;; boundaries here, but currently
+ ;; completion-all-completions does not give us the
+ ;; necessary information.
+ end))
+ (set (make-local-variable 'completion-list-insert-choice-function)
+ (let ((ctable minibuffer-completion-table)
+ (cpred minibuffer-completion-predicate)
+ (cprops completion-extra-properties))
+ (lambda (start end choice)
+ (unless (or (zerop (length prefix))
+ (equal prefix
+ (buffer-substring-no-properties
+ (max (point-min)
+ (- start (length prefix)))
+ start)))
+ (message "*Completions* out of date"))
+ ;; FIXME: Use `md' to do quoting&terminator here.
+ (completion--replace start end choice)
+ (let* ((minibuffer-completion-table ctable)
+ (minibuffer-completion-predicate cpred)
+ (completion-extra-properties cprops)
+ (result (concat prefix choice))
+ (bounds (completion-boundaries
+ result ctable cpred "")))
+ ;; If the completion introduces a new field, then
+ ;; completion is not finished.
+ (completion--done result
+ (if (eq (car bounds) (length result))
+ 'exact 'finished)))))))
+
+ (display-completion-list completions))))
nil))
(defun minibuffer-hide-completions ()
(defvar completion-in-region--data nil)
+(defvar completion-in-region-mode-predicate nil
+ "Predicate to tell `completion-in-region-mode' when to exit.
+It is called with no argument and should return nil when
+`completion-in-region-mode' should exit (and hence pop down
+the *Completions* buffer).")
+
+(defvar completion-in-region-mode--predicate nil
+ "Copy of the value of `completion-in-region-mode-predicate'.
+This holds the value `completion-in-region-mode-predicate' had when
+we entered `completion-in-region-mode'.")
+
(defun completion-in-region (start end collection &optional predicate)
"Complete the text between START and END using COLLECTION.
Return nil if there is no valid completion, else t.
-Point needs to be somewhere between START and END."
+Point needs to be somewhere between START and END.
+PREDICATE (a function called with no arguments) says when to
+exit."
(assert (<= start (point)) (<= (point) end))
- ;; FIXME: undisplay the *Completions* buffer once the completion is done.
(with-wrapper-hook
;; FIXME: Maybe we should use this hook to provide a "display
;; completions" operation as well.
(minibuffer-completion-predicate predicate)
(ol (make-overlay start end nil nil t)))
(overlay-put ol 'field 'completion)
- (completion-in-region-mode 1)
- (setq completion-in-region--data
- (list (current-buffer) start end collection))
+ (when completion-in-region-mode-predicate
+ (completion-in-region-mode 1)
+ (setq completion-in-region--data
+ (list (current-buffer) start end collection)))
(unwind-protect
(call-interactively 'minibuffer-complete)
(delete-overlay ol)))))
(defvar completion-in-region-mode-map
(let ((map (make-sparse-keymap)))
+ ;; FIXME: Only works if completion-in-region-mode was activated via
+ ;; completion-at-point called directly.
(define-key map "?" 'completion-help-at-point)
(define-key map "\t" 'completion-at-point)
map)
(save-excursion
(goto-char (nth 2 completion-in-region--data))
(line-end-position)))
- (let ((comp-data (run-hook-wrapped
- 'completion-at-point-functions
- ;; Only use the known-safe functions.
- #'completion--capf-wrapper 'safe)))
- (eq (car comp-data)
- ;; We're still in the same completion field.
- (nth 1 completion-in-region--data)))))
+ (funcall completion-in-region-mode--predicate)))
(completion-in-region-mode -1)))
;; (defalias 'completion-in-region--prech 'completion-in-region--postch)
(unless (equal "*Completions*" (buffer-name (window-buffer)))
(minibuffer-hide-completions))
;; (add-hook 'pre-command-hook #'completion-in-region--prech)
+ (assert completion-in-region-mode-predicate)
+ (setq completion-in-region-mode--predicate
+ completion-in-region-mode-predicate)
(add-hook 'post-command-hook #'completion-in-region--postch)
(push `(completion-in-region-mode . ,completion-in-region-mode-map)
minor-mode-overriding-map-alist)))
START and END delimit the entity to complete and should include point,
COLLECTION is the completion table to use to complete it, and
PROPS is a property list for additional information.
-Currently supported properties are:
- `:predicate' a predicate that completion candidates need to satisfy.
- `:annotation-function' the value to use for `completion-annotate-function'.")
+Currently supported properties are all the properties that can appear in
+`completion-extra-properties' plus:
+ `:predicate' a predicate that completion candidates need to satisfy.
+ `:exclusive' If `no', means that if the completion data does not match the
+ text at point failure, then instead of reporting a completion failure,
+ the completion should try the next completion function.")
(defvar completion--capf-misbehave-funs nil
- "List of functions found on `completion-at-point-functions' that misbehave.")
+ "List of functions found on `completion-at-point-functions' that misbehave.
+These are functions that neither return completion data nor a completion
+function but instead perform completion right away.")
(defvar completion--capf-safe-funs nil
- "List of well-behaved functions found on `completion-at-point-functions'.")
+ "List of well-behaved functions found on `completion-at-point-functions'.
+These are functions which return proper completion data rather than
+a completion function or god knows what else.")
(defun completion--capf-wrapper (fun which)
+ ;; FIXME: The safe/misbehave handling assumes that a given function will
+ ;; always return the same kind of data, but this breaks down with functions
+ ;; like comint-completion-at-point or mh-letter-completion-at-point, which
+ ;; could be sometimes safe and sometimes misbehaving (and sometimes neither).
(if (case which
(all t)
(safe (member fun completion--capf-safe-funs))
(optimist (not (member fun completion--capf-misbehave-funs))))
(let ((res (funcall fun)))
(cond
- ((consp res)
+ ((and (consp res) (not (functionp res)))
(unless (member fun completion--capf-safe-funs)
- (push fun completion--capf-safe-funs)))
+ (push fun completion--capf-safe-funs))
+ (and (eq 'no (plist-get (nthcdr 3 res) :exclusive))
+ ;; FIXME: Here we'd need to decide whether there are
+ ;; valid completions against the current text. But this depends
+ ;; on the actual completion UI (e.g. with the default completion
+ ;; it depends on completion-style) ;-(
+ ;; We approximate this result by checking whether prefix
+ ;; completion might work, which means that non-prefix completion
+ ;; will not work (or not right) for completion functions that
+ ;; are non-exclusive.
+ (null (try-completion (buffer-substring-no-properties
+ (car res) (point))
+ (nth 2 res)
+ (plist-get (nthcdr 3 res) :predicate)))
+ (setq res nil)))
((not (or (listp res) (functionp res)))
(unless (member fun completion--capf-misbehave-funs)
(message
"Completion function %S uses a deprecated calling convention" fun)
(push fun completion--capf-misbehave-funs))))
- res)))
+ (if res (cons fun res)))))
(defun completion-at-point ()
"Perform completion on the text around point.
(interactive)
(let ((res (run-hook-wrapped 'completion-at-point-functions
#'completion--capf-wrapper 'all)))
- (cond
- ((functionp res) (funcall res))
- ((consp 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)
+ (pcase res
+ (`(,_ . ,(and (pred functionp) f)) (funcall f))
+ (`(,hookfun . (,start ,end ,collection . ,plist))
+ (let* ((completion-extra-properties plist)
+ (completion-in-region-mode-predicate
+ (lambda ()
+ ;; We're still in the same completion field.
+ (eq (car-safe (funcall hookfun)) start))))
+ (completion-in-region start end collection
(plist-get plist :predicate))))
- (res)))) ;Maybe completion already happened and the function returned t.
+ ;; Maybe completion already happened and the function returned t.
+ (_ (cdr res)))))
(defun completion-help-at-point ()
"Display the completions on the text around point.
(let ((res (run-hook-wrapped 'completion-at-point-functions
;; Ignore misbehaving functions.
#'completion--capf-wrapper 'optimist)))
- (cond
- ((functionp res)
- (message "Don't know how to show completions for %S" res))
- ((consp res)
- (let* ((plist (nthcdr 3 res))
- (minibuffer-completion-table (nth 2 res))
+ (pcase res
+ (`(,_ . ,(and (pred functionp) f))
+ (message "Don't know how to show completions for %S" f))
+ (`(,hookfun . (,start ,end ,collection . ,plist))
+ (let* ((minibuffer-completion-table collection)
(minibuffer-completion-predicate (plist-get plist :predicate))
- (completion-annotate-function
- (or (plist-get plist :annotation-function)
- completion-annotate-function))
- (ol (make-overlay (nth 0 res) (nth 1 res) nil nil t)))
+ (completion-extra-properties plist)
+ (completion-in-region-mode-predicate
+ (lambda ()
+ ;; We're still in the same completion field.
+ (eq (car-safe (funcall hookfun)) start)))
+ (ol (make-overlay start end nil nil t)))
;; FIXME: We should somehow (ab)use completion-in-region-function or
;; introduce a corresponding hook (plus another for word-completion,
;; and another for force-completion, maybe?).
(overlay-put ol 'field 'completion)
+ (completion-in-region-mode 1)
+ (setq completion-in-region--data
+ (list (current-buffer) start end collection))
(unwind-protect
(call-interactively 'minibuffer-completion-help)
(delete-overlay ol))))
- (res
+ (`(,hookfun . ,_)
;; The hook function already performed completion :-(
;; Not much we can do at this point.
+ (message "%s already performed completion!" hookfun)
nil)
- (t (message "Nothing to complete at point")))))
+ (_ (message "Nothing to complete at point")))))
;;; Key bindings.
-(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map
- 'minibuffer-local-filename-must-match-map "23.1")
-
(let ((map minibuffer-local-map))
(define-key map "\C-g" 'abort-recursive-edit)
(define-key map "\r" 'exit-minibuffer)
(define-key map "\n" 'exit-minibuffer))
-(let ((map minibuffer-local-completion-map))
- (define-key map "\t" 'minibuffer-complete)
- ;; M-TAB is already abused for many other purposes, so we should find
- ;; another binding for it.
- ;; (define-key map "\e\t" 'minibuffer-force-complete)
- (define-key map " " 'minibuffer-complete-word)
- (define-key map "?" 'minibuffer-completion-help))
+(defvar minibuffer-local-completion-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map "\t" 'minibuffer-complete)
+ ;; M-TAB is already abused for many other purposes, so we should find
+ ;; another binding for it.
+ ;; (define-key map "\e\t" 'minibuffer-force-complete)
+ (define-key map " " 'minibuffer-complete-word)
+ (define-key map "?" 'minibuffer-completion-help)
+ map)
+ "Local keymap for minibuffer input with completion.")
+
+(defvar minibuffer-local-must-match-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-completion-map)
+ (define-key map "\r" 'minibuffer-complete-and-exit)
+ (define-key map "\n" 'minibuffer-complete-and-exit)
+ map)
+ "Local keymap for minibuffer input with completion, for exact match.")
-(let ((map minibuffer-local-must-match-map))
- (define-key map "\r" 'minibuffer-complete-and-exit)
- (define-key map "\n" 'minibuffer-complete-and-exit))
+(defvar minibuffer-local-filename-completion-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map " " nil)
+ map)
+ "Local keymap for minibuffer input with completion for filenames.
+Gets combined either with `minibuffer-local-completion-map' or
+with `minibuffer-local-must-match-map'.")
-(let ((map minibuffer-local-filename-completion-map))
- (define-key map " " nil))
-(let ((map minibuffer-local-filename-must-match-map))
- (define-key map " " nil))
+(defvar minibuffer-local-filename-must-match-map (make-sparse-keymap))
+(make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1")
+(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map
+ 'minibuffer-local-filename-must-match-map "23.1")
(let ((map minibuffer-local-ns-map))
(define-key map " " 'exit-minibuffer)
(define-key map "\t" 'exit-minibuffer)
(define-key map "?" 'self-insert-and-exit))
+(defvar minibuffer-inactive-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ (define-key map "e" 'find-file-other-frame)
+ (define-key map "f" 'find-file-other-frame)
+ (define-key map "b" 'switch-to-buffer-other-frame)
+ (define-key map "i" 'info)
+ (define-key map "m" 'mail)
+ (define-key map "n" 'make-frame)
+ (define-key map [mouse-1] (lambda () (interactive)
+ (with-current-buffer "*Messages*"
+ (goto-char (point-max))
+ (display-buffer (current-buffer)))))
+ ;; So the global down-mouse-1 binding doesn't clutter the execution of the
+ ;; above mouse-1 binding.
+ (define-key map [down-mouse-1] #'ignore)
+ map)
+ "Keymap for use in the minibuffer when it is not active.
+The non-mouse bindings in this keymap can only be used in minibuffer-only
+frames, since the minibuffer can normally not be selected when it is
+not active.")
+
+(define-derived-mode minibuffer-inactive-mode nil "InactiveMinibuffer"
+ :abbrev-table nil ;abbrev.el is not loaded yet during dump.
+ ;; Note: this major mode is called from minibuf.c.
+ "Major mode to use in the minibuffer when it is not active.
+This is only used when the minibuffer area has no active minibuffer.")
+
;;; Completion tables.
(defun minibuffer--double-dollars (str)
;; other table that provides the "main" completion. Let the
;; other table handle the test-completion case.
nil)
- ((eq (car-safe action) 'boundaries)
- ;; Only return boundaries if there's something to complete,
+ ((or (eq (car-safe action) 'boundaries) (eq action 'metadata))
+ ;; Only return boundaries/metadata if there's something to complete,
;; since otherwise when we're used in
;; completion-table-in-turn, we could return boundaries and
;; let some subsequent table return a list of completions.
(when (try-completion (substring string beg) table nil)
;; Compute the boundaries of the subfield to which this
;; completion applies.
- (let ((suffix (cdr action)))
- (list* 'boundaries
- (or (match-beginning 2) (match-beginning 1))
- (when (string-match "[^[:alnum:]_]" suffix)
- (match-beginning 0))))))
+ (if (eq action 'metadata)
+ '(metadata (category . environment-variable))
+ (let ((suffix (cdr action)))
+ (list* 'boundaries
+ (or (match-beginning 2) (match-beginning 1))
+ (when (string-match "[^[:alnum:]_]" suffix)
+ (match-beginning 0)))))))
(t
(if (eq (aref string (1- beg)) ?{)
(setq table (apply-partially 'completion-table-with-terminator
(defun completion-file-name-table (string pred action)
"Completion table for file names."
- (ignore-errors
- (cond
- ((eq (car-safe action) 'boundaries)
- (let ((start (length (file-name-directory string)))
- (end (string-match-p "/" (cdr action))))
- (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)))
+ (condition-case nil
+ (cond
+ ((eq action 'metadata) '(metadata (category . file)))
+ ((eq (car-safe action) 'boundaries)
+ (let ((start (length (file-name-directory string)))
+ (end (string-match-p "/" (cdr action))))
+ (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)))
- (t
- (let* ((name (file-name-nondirectory string))
- (specdir (file-name-directory string))
- (realdir (or specdir default-directory)))
+ ((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)))
- (cond
- ((null action)
- (let ((comp (file-name-completion name realdir pred)))
- (if (stringp comp)
- (concat specdir comp)
- comp)))
-
- ((eq action t)
- (let ((all (file-name-all-completions name realdir)))
-
- ;; Check the predicate, if necessary.
- (unless (memq pred '(nil file-exists-p))
- (let ((comp ())
- (pred
- (if (eq pred 'file-directory-p)
- ;; Brute-force speed up for directory checking:
- ;; Discard strings which don't end in a slash.
- (lambda (s)
- (let ((len (length s)))
- (and (> len 0) (eq (aref s (1- len)) ?/))))
- ;; Must do it the hard (and slow) way.
- pred)))
- (let ((default-directory (expand-file-name realdir)))
- (dolist (tem all)
- (if (funcall pred tem) (push tem comp))))
- (setq all (nreverse comp))))
-
- all))))))))
+ (t
+ (let* ((name (file-name-nondirectory string))
+ (specdir (file-name-directory string))
+ (realdir (or specdir default-directory)))
+
+ (cond
+ ((null action)
+ (let ((comp (file-name-completion name realdir pred)))
+ (if (stringp comp)
+ (concat specdir comp)
+ comp)))
+
+ ((eq action t)
+ (let ((all (file-name-all-completions name realdir)))
+
+ ;; Check the predicate, if necessary.
+ (unless (memq pred '(nil file-exists-p))
+ (let ((comp ())
+ (pred
+ (if (eq pred 'file-directory-p)
+ ;; Brute-force speed up for directory checking:
+ ;; Discard strings which don't end in a slash.
+ (lambda (s)
+ (let ((len (length s)))
+ (and (> len 0) (eq (aref s (1- len)) ?/))))
+ ;; Must do it the hard (and slow) way.
+ pred)))
+ (let ((default-directory (expand-file-name realdir)))
+ (dolist (tem all)
+ (if (funcall pred tem) (push tem comp))))
+ (setq all (nreverse comp))))
+
+ all))))))
+ (file-error nil))) ;PCM often calls with invalid directories.
(defvar read-file-name-predicate nil
"Current predicate used by `read-file-name-internal'.")
(funcall (or read-file-name-function #'read-file-name-default)
prompt dir default-filename mustmatch initial predicate))
+;; minibuffer-completing-file-name is a variable used internally in minibuf.c
+;; to determine whether to use minibuffer-local-filename-completion-map or
+;; minibuffer-local-completion-map. It shouldn't be exported to Elisp.
+;; FIXME: Actually, it is also used in rfn-eshadow.el we'd otherwise have to
+;; use (eq minibuffer-completion-table #'read-file-name-internal), which is
+;; probably even worse. Maybe We should add some read-file-name-setup-hook
+;; instead, but for now, let's keep this non-obsolete.
+;;(make-obsolete-variable 'minibuffer-completing-file-name nil "24.1" 'get)
+
(defun read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate)
"Default method for reading file names.
See `read-file-name' for the meaning of the arguments."
(defun completion-pcm--prepare-delim-re (delims)
(setq completion-pcm--delim-wild-regex (concat "[" delims "*]")))
-(defcustom completion-pcm-word-delimiters "-_./: "
+(defcustom completion-pcm-word-delimiters "-_./:| "
"A string of characters treated as word delimiters for completion.
Some arcane rules:
If `]' is in this string, it must come first.
(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', `prefix'."
+or a symbol, see `completion-pcm--merge-completions'."
(if (and point (< point (length string)))
(let ((prefix (substring string 0 point))
(suffix (substring string point)))
(case-fold-search completion-ignore-case)
(completion-regexp-list (cons regex completion-regexp-list))
(compl (all-completions
- (concat prefix (if (stringp (car pattern)) (car pattern) ""))
+ (concat prefix
+ (if (stringp (car pattern)) (car pattern) ""))
table pred)))
(if (not (functionp table))
;; The internal functions already obeyed completion-regexp-list.
"Find all completions for STRING at POINT in TABLE, satisfying PRED.
POINT is a position inside STRING.
FILTER is a function applied to the return value, that can be used, e.g. to
-filter out additional entries (because TABLE migth not obey PRED)."
+filter out additional entries (because TABLE might not obey PRED)."
(unless filter (setq filter 'identity))
(let* ((beforepoint (substring string 0 point))
(afterpoint (substring string point))
(- (length newbeforepoint)
(car newbounds)))))
(dolist (submatch suball)
- (setq all (nconc (mapcar
- (lambda (s) (concat submatch between s))
- (funcall filter
- (completion-pcm--all-completions
- (concat subprefix submatch between)
- pattern table pred)))
- all)))
+ (setq all (nconc
+ (mapcar
+ (lambda (s) (concat submatch between s))
+ (funcall filter
+ (completion-pcm--all-completions
+ (concat subprefix submatch between)
+ pattern table pred)))
+ all)))
;; FIXME: This can come in handy for try-completion,
;; but isn't right for all-completions, since it lists
;; invalid completions.
(mapcar 'completion--sreverse strs))))
(defun completion-pcm--merge-completions (strs pattern)
- "Extract the commonality in STRS, with the help of PATTERN."
+ "Extract the commonality in STRS, with the help of PATTERN.
+PATTERN can contain strings and symbols chosen among `star', `any', `point',
+and `prefix'. They all match anything (aka \".*\") but are merged differently:
+`any' only grows from the left (when matching \"a1b\" and \"a2b\" it gets
+ completed to just \"a\").
+`prefix' only grows from the right (when matching \"a1b\" and \"a2b\" it gets
+ completed to just \"b\").
+`star' grows from both ends and is reified into a \"*\" (when matching \"a1b\"
+ and \"a2b\" it gets completed to \"a*b\").
+`point' is like `star' except that it gets reified as the position of point
+ instead of being reified as a \"*\" character.
+The underlying idea is that we should return a string which still matches
+the same set of elements."
;; When completing while ignoring case, we want to try and avoid
;; completing "fo" to "foO" when completing against "FOO" (bug#4219).
;; So we try and make sure that the string we return is all made up
(let* ((prefix (try-completion fixed comps))
(unique (or (and (eq prefix t) (setq prefix fixed))
(eq t (try-completion prefix comps)))))
- (unless (equal prefix "") (push prefix res))
+ (unless (or (eq elem 'prefix)
+ (equal prefix ""))
+ (push prefix res))
;; If there's only one completion, `elem' is not useful
;; any more: it can only match the empty string.
;; FIXME: in some cases, it may be necessary to turn an
(let ((newstr (completion-initials-expand string table pred)))
(when newstr
(completion-pcm-try-completion newstr table pred (length newstr)))))
-
+\f
+(defvar completing-read-function 'completing-read-default
+ "The function called by `completing-read' to do its work.
+It should accept the same arguments as `completing-read'.")
+
+(defun completing-read-default (prompt collection &optional predicate
+ require-match initial-input
+ hist def inherit-input-method)
+ "Default method for reading from the minibuffer with completion.
+See `completing-read' for the meaning of the arguments."
+
+ (when (consp initial-input)
+ (setq initial-input
+ (cons (car initial-input)
+ ;; `completing-read' uses 0-based index while
+ ;; `read-from-minibuffer' uses 1-based index.
+ (1+ (cdr initial-input)))))
+
+ (let* ((minibuffer-completion-table collection)
+ (minibuffer-completion-predicate predicate)
+ (minibuffer-completion-confirm (unless (eq require-match t)
+ require-match))
+ (base-keymap (if require-match
+ minibuffer-local-must-match-map
+ minibuffer-local-completion-map))
+ (keymap (if (memq minibuffer-completing-file-name '(nil lambda))
+ base-keymap
+ ;; Layer minibuffer-local-filename-completion-map
+ ;; on top of the base map.
+ (make-composed-keymap
+ minibuffer-local-filename-completion-map
+ ;; Set base-keymap as the parent, so that nil bindings
+ ;; in minibuffer-local-filename-completion-map can
+ ;; override bindings in base-keymap.
+ base-keymap)))
+ (result (read-from-minibuffer prompt initial-input keymap
+ nil hist def inherit-input-method)))
+ (when (and (equal result "") def)
+ (setq result (if (consp def) (car def) def)))
+ result))
\f
;; Miscellaneous
HCoop / bpt / emacs.git / blobdiff