;;; minibuffer.el --- Minibuffer completion functions -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Package: emacs
;;; Completion table manipulation
;; New completion-table operation.
-(defun completion-boundaries (string table pred suffix)
- "Return the boundaries of the completions returned by TABLE for STRING.
+(defun completion-boundaries (string collection pred suffix)
+ "Return the boundaries of text on which COLLECTION will operate.
STRING is the string on which completion will be performed.
SUFFIX is the string after point.
+If COLLECTION is a function, it is called with 3 arguments: STRING,
+PRED, and a cons cell of the form (boundaries . SUFFIX).
+
The result is of the form (START . END) where START is the position
in STRING of the beginning of the completion field and END is the position
in SUFFIX of the end of the completion field.
E.g. for simple completion tables, the result is always (0 . (length SUFFIX))
and for file names the result is the positions delimited by
the closest directory separators."
- (let ((boundaries (if (functionp table)
- (funcall table string pred
+ (let ((boundaries (if (functionp collection)
+ (funcall collection string pred
(cons 'boundaries suffix)))))
(if (not (eq (car-safe boundaries) 'boundaries))
(setq boundaries nil))
(t 'test-completion))
string table pred))))
-(defun completion-table-dynamic (fun)
+(defun completion-table-dynamic (fun &optional switch-buffer)
"Use function FUN as a dynamic completion table.
FUN is called with one argument, the string for which completion is required,
and it should return an alist containing all the intended possible completions.
This alist may be a full list of possible completions so that FUN can ignore
-the value of its argument. If completion is performed in the minibuffer,
-FUN will be called in the buffer from which the minibuffer was entered.
+the value of its argument.
+If SWITCH-BUFFER is non-nil and completion is performed in the
+minibuffer, FUN will be called in the buffer from which the minibuffer
+was entered.
The result of the `completion-table-dynamic' form is a function
that can be used as the COLLECTION argument to `try-completion' and
;; `fun' is not supposed to return another function but a plain old
;; completion table, whose boundaries are always trivial.
nil
- (with-current-buffer (let ((win (minibuffer-selected-window)))
- (if (window-live-p win) (window-buffer win)
- (current-buffer)))
+ (with-current-buffer (if (not switch-buffer) (current-buffer)
+ (let ((win (minibuffer-selected-window)))
+ (if (window-live-p win) (window-buffer win)
+ (current-buffer))))
(complete-with-action action (funcall fun string) string pred)))))
(defun completion-table-with-cache (fun &optional ignore-case)
(lambda (,str)
(when (functionp ,var)
(setq ,var (funcall #',fun)))
- ,var))))
+ ,var)
+ 'do-switch-buffer)))
(defun completion-table-case-fold (table &optional dont-fold)
"Return new completion TABLE that is case insensitive.
form (concat S1 S) in the same way as TABLE completes strings of
the form (concat S2 S)."
(lambda (string pred action)
- (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil
- completion-ignore-case))
+ (let* ((str (if (string-prefix-p s1 string completion-ignore-case)
(concat s2 (substring string (length s1)))))
(res (if str (complete-with-action action table str pred))))
(when res
(+ beg (- (length s1) (length s2))))
. ,(and (eq (car-safe res) 'boundaries) (cddr res)))))
((stringp res)
- (if (eq t (compare-strings res 0 (length s2) s2 nil nil
- completion-ignore-case))
+ (if (string-prefix-p s2 string completion-ignore-case)
(concat s1 (substring res (length s2)))))
((eq action t)
(let ((bounds (completion-boundaries str table pred "")))
completions))
((eq action 'completion--unquote)
- (let ((ustring (funcall unquote string))
- (uprefix (funcall unquote (substring string 0 pred))))
- ;; We presume (more or less) that `concat' and `unquote' commute.
- (cl-assert (string-prefix-p uprefix ustring))
- (list ustring table (length uprefix)
+ ;; PRED is really a POINT in STRING.
+ ;; We should return a new set (STRING TABLE POINT REQUOTE)
+ ;; where STRING is a new (unquoted) STRING to match against the new TABLE
+ ;; using a new POINT inside it, and REQUOTE is a requoting function which
+ ;; should reverse the unquoting, (i.e. it receives the completion result
+ ;; of using the new TABLE and should turn it into the corresponding
+ ;; quoted result).
+ (let* ((qpos pred)
+ (ustring (funcall unquote string))
+ (uprefix (funcall unquote (substring string 0 qpos)))
+ ;; FIXME: we really should pass `qpos' to `unquote' and have that
+ ;; function give us the corresponding `uqpos'. But for now we
+ ;; presume (more or less) that `concat' and `unquote' commute.
+ (uqpos (if (string-prefix-p uprefix ustring)
+ ;; Yay!! They do seem to commute!
+ (length uprefix)
+ ;; They don't commute this time! :-(
+ ;; Maybe qpos is in some text that disappears in the
+ ;; ustring (bug#17239). Let's try a second chance guess.
+ (let ((usuffix (funcall unquote (substring string qpos))))
+ (if (string-suffix-p usuffix ustring)
+ ;; Yay!! They still "commute" in a sense!
+ (- (length ustring) (length usuffix))
+ ;; Still no luck! Let's just choose *some* position
+ ;; within ustring.
+ (/ (+ (min (length uprefix) (length ustring))
+ (max (- (length ustring) (length usuffix)) 0))
+ 2))))))
+ (list ustring table uqpos
(lambda (unquoted-result op)
(pcase op
(1 ;;try
The text is displayed for `minibuffer-message-timeout' seconds,
or until the next input event arrives, whichever comes first.
Enclose MESSAGE in [...] if this is not yet the case.
-If ARGS are provided, then pass MESSAGE through `format'."
+If ARGS are provided, then pass MESSAGE through `format-message'."
(if (not (minibufferp (current-buffer)))
(progn
(if args
;; Make sure we can put-text-property.
(copy-sequence message)
(concat " [" message "]")))
- (when args (setq message (apply 'format message args)))
+ (when args (setq message (apply #'format-message message args)))
(let ((ol (make-overlay (point-max) (point-max) nil t t))
;; A quit during sit-for normally only interrupts the sit-for,
;; but since minibuffer-message is used at the end of a command,
:type completion--styles-type
:version "23.1")
-(defcustom completion-category-overrides
- '((buffer (styles . (basic substring))))
- "List of `completion-styles' overrides for specific categories.
+(defvar completion-category-defaults
+ '((buffer (styles . (basic substring)))
+ (unicode-name (styles . (basic substring)))
+ (project-file (styles . (basic substring))))
+ "Default settings for specific completion categories.
+Each entry 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.
+Categories are symbols such as `buffer' and `file', used when
+completing buffer and file names, respectively.")
+
+(defcustom completion-category-overrides nil
+ "List of category-specific user overrides for completion styles.
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.
Categories are symbols such as `buffer' and `file', used when
-completing buffer and file names, respectively."
- :version "24.1"
+completing buffer and file names, respectively.
+This overrides the defaults specified in `completion-category-defaults'."
+ :version "25.1"
:type `(alist :key-type (choice :tag "Category"
(const buffer)
(const file)
(const :tag "Select one value from the menu." cycle)
,completion--cycling-threshold-type))))
+(defun completion--category-override (category tag)
+ (or (assq tag (cdr (assq category completion-category-overrides)))
+ (assq tag (cdr (assq category completion-category-defaults)))))
+
(defun completion--styles (metadata)
(let* ((cat (completion-metadata-get metadata 'category))
- (over (assq 'styles (cdr (assq cat completion-category-overrides)))))
+ (over (completion--category-override cat 'styles)))
(if over
(delete-dups (append (cdr over) (copy-sequence completion-styles)))
completion-styles)))
;; part of the string (e.g. substitute-in-file-name).
(let ((requote
(when (completion-metadata-get metadata 'completion--unquote-requote)
+ (cl-assert (functionp table))
(let ((new (funcall table string point 'completion--unquote)))
(setq string (pop new))
(setq table (pop new))
(setq point (pop new))
+ (cl-assert (<= point (length string)))
(pop new))))
(result
(completion--some (lambda (style)
(defun completion--cycle-threshold (metadata)
(let* ((cat (completion-metadata-get metadata 'category))
- (over (assq 'cycle (cdr (assq cat completion-category-overrides)))))
+ (over (completion--category-override cat 'cycle)))
(if over (cdr over) completion-cycle-threshold)))
(defvar-local completion-all-sorted-completions nil)
If you repeat this command after it displayed such a list,
scroll the window of possible completions."
(interactive)
- (completion-in-region (minibuffer-prompt-end) (point-max)
- minibuffer-completion-table
- minibuffer-completion-predicate))
+ (when (<= (minibuffer-prompt-end) (point))
+ (completion-in-region (minibuffer-prompt-end) (point-max)
+ minibuffer-completion-table
+ minibuffer-completion-predicate)))
(defun completion--in-region-1 (beg end)
;; If the previous command was not this,
;; that file.
(= (length string) (length compl)))
(completion--replace beg end compl))))
- (funcall exit-function))
+ (funcall exit-function))
((memq minibuffer-completion-confirm '(confirm confirm-after-completion))
;; The user is permitted to exit with an input that's rejected
(t
;; Call do-completion, but ignore errors.
- (funcall completion-function))))
+ (funcall completion-function))))
(defun completion--try-word-completion (string table predicate point md)
(let ((comp (completion-try-completion string table predicate point md)))
;; instead, but it was too blunt, leading to situations where SPC
;; was the only insertable char at point but minibuffer-complete-word
;; refused inserting it.
- (let* ((exts (mapcar (lambda (str) (propertize str 'completion-try-word t))
- '(" " "-")))
- (before (substring string 0 point))
- (after (substring string point))
- (comps
- (delete nil
- (mapcar (lambda (ext)
- (completion-try-completion
- (concat before ext after)
- table predicate (1+ point) md))
- exts))))
- (when (and (null (cdr comps)) (consp (car comps)))
- (setq comp (car comps)))))
+ (let ((exts (mapcar (lambda (str) (propertize str 'completion-try-word t))
+ '(" " "-")))
+ (before (substring string 0 point))
+ (after (substring string point))
+ tem)
+ ;; If both " " and "-" lead to completions, prefer " " so SPC behaves
+ ;; a bit more like a self-inserting key (bug#17375).
+ (while (and exts (not (consp tem)))
+ (setq tem (completion-try-completion
+ (concat before (pop exts) after)
+ table predicate (1+ point) md)))
+ (if (consp tem) (setq comp tem))))
;; Completing a single word is actually more difficult than completing
;; as much as possible, because we first have to find the "current
(if completions "Sole completion" "No completions")))
(let* ((last (last completions))
- (base-size (cdr last))
+ (base-size (or (cdr last) 0))
(prefix (unless (zerop base-size) (substring string 0 base-size)))
(all-md (completion--metadata (buffer-substring-no-properties
start (point))
;; 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*"
+ (display-buffer-mark-dedicated 'soft)
+ ;; Disable `pop-up-windows' temporarily to allow
+ ;; `display-buffer--maybe-pop-up-frame-or-window'
+ ;; in the display actions below to pop up a frame
+ ;; if `pop-up-frames' is non-nil, but not to pop up a window.
+ (pop-up-windows nil))
+ (with-displayed-buffer-window
+ "*Completions*"
+ ;; This is a copy of `display-buffer-fallback-action'
+ ;; where `display-buffer-use-some-window' is replaced
+ ;; with `display-buffer-at-bottom'.
+ `((display-buffer--maybe-same-window
+ display-buffer-reuse-window
+ display-buffer--maybe-pop-up-frame-or-window
+ ;; Use `display-buffer-below-selected' for inline completions,
+ ;; but not in the minibuffer (e.g. in `eval-expression')
+ ;; for which `display-buffer-at-bottom' is used.
+ ,(if (eq (selected-window) (minibuffer-window))
+ 'display-buffer-at-bottom
+ 'display-buffer-below-selected))
+ ,(if temp-buffer-resize-mode
+ '(window-height . resize-temp-buffer-window)
+ '(window-height . shrink-window-if-larger-than-buffer))
+ ,(when temp-buffer-resize-mode
+ '(preserve-size . (nil . t))))
+ nil
;; Remove the base-size tail because `sort' requires a properly
;; nil-terminated list.
(when last (setcdr last nil))
(exit-minibuffer))
(defvar completion-in-region-functions nil
- "Wrapper hook around `completion-in-region'.")
+ "Wrapper hook around `completion--in-region'.")
(make-obsolete-variable 'completion-in-region-functions
'completion-in-region-function "24.4")
(defvar completion-in-region-function #'completion--in-region
"Function to perform the job of `completion-in-region'.
The function is called with 4 arguments: START END COLLECTION PREDICATE.
-The arguments and expected return value are like the ones of
+The arguments and expected return value are as specified for
`completion-in-region'.")
(defvar completion-in-region--data nil)
(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.
-PREDICATE (a function called with no arguments) says when to
-exit."
+PREDICATE (a function called with no arguments) says when to exit.
+This calls the function that `completion-in-region-function' specifies
+\(passing the same four arguments that it received) to do the work,
+and returns whatever it does. The return value should be nil
+if there was no valid completion, else t."
(cl-assert (<= start (point)) (<= (point) end))
(funcall completion-in-region-function start end collection predicate))
:version "22.1")
(defun completion--in-region (start end collection &optional predicate)
+ "Default function to use for `completion-in-region-function'.
+Its arguments and return value are as specified for `completion-in-region'.
+This respects the wrapper hook `completion-in-region-functions'."
(with-wrapper-hook
;; FIXME: Maybe we should use this hook to provide a "display
;; completions" operation as well.
"Keymap activated during `completion-in-region'.")
;; It is difficult to know when to exit completion-in-region-mode (i.e. hide
-;; the *Completions*).
+;; the *Completions*). Here's how previous packages did it:
;; - lisp-mode: never.
;; - comint: only do it if you hit SPC at the right time.
;; - pcomplete: pop it down on SPC or after some time-delay.
(defvar completion-at-point-functions '(tags-completion-at-point-function)
"Special hook to find the completion table for the thing at point.
-Each function on this hook is called in turns without any argument and should
+Each function on this hook is called in turn without any argument and should
return either nil to mean that it is not applicable at point,
or a function of no argument to perform completion (discouraged),
or a list of the form (START END COLLECTION . PROPS) where
(completion-in-region start end collection
(plist-get plist :predicate))))
;; Maybe completion already happened and the function returned t.
- (_ (cdr res)))))
+ (_
+ (when (cdr res)
+ (message "Warning: %S failed to return valid completion data!"
+ (car res)))
+ (cdr res)))))
(defun completion-help-at-point ()
"Display the completions on the text around point.
(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."
- (unless dir (setq dir default-directory))
+ (unless dir (setq dir (or default-directory "~/")))
(unless (file-name-absolute-p dir) (setq dir (expand-file-name dir)))
(unless default-filename
(setq default-filename (if initial (expand-file-name initial dir)
(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))))
+ (nreverse (try-completion "" (mapcar #'reverse strs))))
(defun completion-pcm--merge-completions (strs pattern)
"Extract the commonality in STRS, with the help of PATTERN.
;; Not `prefix'.
mergedpat))
;; New pos from the start.
- (newpos (length (completion-pcm--pattern->string pointpat)))
+ (newpos (length (completion-pcm--pattern->string pointpat)))
;; Do it afterwards because it changes `pointpat' by side effect.
(merged (completion-pcm--pattern->string (nreverse mergedpat))))
- (setq suffix (completion--merge-suffix merged newpos suffix))
+ (setq suffix (completion--merge-suffix
+ ;; The second arg should ideally be "the position right
+ ;; after the last char of `merged' that comes from the text
+ ;; to be completed". But completion-pcm--merge-completions
+ ;; currently doesn't give us that info. So instead we just
+ ;; use the "last but one" position, which tends to work
+ ;; well in practice since `suffix' always starts
+ ;; with a boundary and we hence mostly/only care about
+ ;; merging this boundary (bug#15419).
+ merged (max 0 (1- (length merged))) suffix))
(cons (concat prefix merged suffix) (+ newpos (length prefix)))))))
(defun completion-pcm-try-completion (string table pred point)
(string-match completion-pcm--delim-wild-regex str
(car bounds)))
(if (zerop (car bounds))
+ ;; FIXME: Don't hardcode "-" (bug#17559).
(mapconcat 'string str "-")
;; If there's a boundary, it's trickier. The main use-case
;; we consider here is file-name completion. We'd like