;;; minibuffer.el --- Minibuffer completion functions -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2015 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 "")))
(defun completion-table-with-predicate (table pred1 strict string pred2 action)
"Make a completion table equivalent to TABLE but filtered through PRED1.
-PRED1 is a function of one argument which returns non-nil if and only if the
-argument is an element of TABLE which should be considered for completion.
-STRING, PRED2, and ACTION are the usual arguments to completion tables,
-as described in `try-completion', `all-completions', and `test-completion'.
-If STRICT is t, the predicate always applies; if nil it only applies if
-it does not reduce the set of possible completions to nothing.
-Note: TABLE needs to be a proper completion table which obeys predicates."
+PRED1 is a function of one argument which returns non-nil if and
+only if the argument is an element of TABLE which should be
+considered for completion. STRING, PRED2, and ACTION are the
+usual arguments to completion tables, as described in
+`try-completion', `all-completions', and `test-completion'. If
+STRICT is t, the predicate always applies; if nil it only applies
+if it does not reduce the set of possible completions to nothing.
+Note: TABLE needs to be a proper completion table which obeys
+predicates."
(cond
((and (not strict) (eq action 'lambda))
;; Ignore pred1 since it doesn't really have to apply anyway.
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))
(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,
(defun minibuffer-force-complete-and-exit ()
"Complete the minibuffer with first of the matches and exit."
(interactive)
- (if (and (eq (minibuffer-prompt-end) (point-max))
- minibuffer-default)
- ;; Use the provided default if there's one (bug#17545).
- (minibuffer-complete-and-exit)
- (minibuffer-force-complete)
- (completion--complete-and-exit
- (minibuffer-prompt-end) (point-max) #'exit-minibuffer
- ;; If the previous completion completed to an element which fails
- ;; test-completion, then we shouldn't exit, but that should be rare.
- (lambda () (minibuffer-message "Incomplete")))))
+ (minibuffer-force-complete)
+ (completion--complete-and-exit
+ (minibuffer-prompt-end) (point-max) #'exit-minibuffer
+ ;; If the previous completion completed to an element which fails
+ ;; test-completion, then we shouldn't exit, but that should be rare.
+ (lambda () (minibuffer-message "Incomplete"))))
(defun minibuffer-force-complete (&optional start end)
"Complete the minibuffer to an exact match.
;; 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)))
(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 . fit-window-to-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))
(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.
(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