;;; minibuffer.el --- Minibuffer completion functions -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Package: emacs
;; - 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
(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?
- ;; Notice that `pred' may not be a function in some abusive cases.
- (when (functionp pred)
- (setq pred
- ;; Predicates are called differently depending on the nature of
- ;; the completion table :-(
- (cond
- ((vectorp table) ;Obarray.
- (lambda (sym) (funcall pred (concat prefix (symbol-name sym)))))
- ((hash-table-p table)
- (lambda (s _v) (funcall pred (concat prefix s))))
- ((functionp table)
- (lambda (s) (funcall pred (concat prefix s))))
- (t ;Lists and alists.
- (lambda (s)
- (funcall pred (concat prefix (if (consp s) (car s) s))))))))
- (if (eq (car-safe action) 'boundaries)
- (let* ((len (length prefix))
- (bound (completion-boundaries string table pred (cdr action))))
- (list* 'boundaries (+ (car bound) len) (cdr bound)))
- (let ((comp (complete-with-action action table string pred)))
- (cond
- ;; In case of try-completion, add the prefix.
- ((stringp comp) (concat prefix comp))
- (t comp)))))
+ (let ((pred
+ (if (not (functionp pred))
+ ;; Notice that `pred' may not be a function in some abusive cases.
+ pred
+ ;; Predicates are called differently depending on the nature of
+ ;; the completion table :-(
+ (cond
+ ((vectorp table) ;Obarray.
+ (lambda (sym) (funcall pred (concat prefix (symbol-name sym)))))
+ ((hash-table-p table)
+ (lambda (s _v) (funcall pred (concat prefix s))))
+ ((functionp table)
+ (lambda (s) (funcall pred (concat prefix s))))
+ (t ;Lists and alists.
+ (lambda (s)
+ (funcall pred (concat prefix (if (consp s) (car s) s)))))))))
+ (if (eq (car-safe action) 'boundaries)
+ (let* ((len (length prefix))
+ (bound (completion-boundaries string table pred (cdr action))))
+ (list* 'boundaries (+ (car bound) len) (cdr bound)))
+ (let ((comp (complete-with-action action table string pred)))
+ (cond
+ ;; In case of try-completion, add the prefix.
+ ((stringp comp) (concat prefix comp))
+ (t comp))))))
(defun completion-table-with-terminator (terminator table string pred action)
"Construct a completion table like TABLE but with an extra TERMINATOR.
(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)
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")
(defcustom completion-category-overrides
'((buffer (styles . (basic substring))))
- "List of overrides for specific categories.
+ "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 (const buffer)
+- `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"
+ :type `(alist :key-type (choice :tag "Category"
+ (const buffer)
(const file)
+ (const unicode-name)
symbol)
:value-type
- (set
- (cons (const style)
- (repeat ,@(mapcar (lambda (x) (list 'const (car x)))
- completion-styles-alist)))
- (cons (const cycle)
- (choice (const :tag "No cycling" nil)
- (const :tag "Always cycle" t)
- (integer :tag "Threshold"))))))
+ (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))
(defun completion--replace (beg end newtext)
"Replace the buffer text between BEG and END with NEWTEXT.
Moves point to the end of the new text."
+ ;; The properties on `newtext' include things like
+ ;; completions-first-difference, which we don't want to include
+ ;; upon insertion.
+ (set-text-properties 0 (length newtext) nil newtext)
;; Maybe this should be in subr.el.
;; You'd think this is trivial to do, but details matter if you want
;; to keep markers "at the right place" and be robust in the face of
(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")))
+ :version "24.1"
+ :type completion--cycling-threshold-type)
(defun completion--cycle-threshold (metadata)
(let* ((cat (completion-metadata-get metadata 'category))
;; It did find a match. Do we match some possibility exactly now?
(let* ((exact (test-completion completion
- minibuffer-completion-table
- minibuffer-completion-predicate))
+ 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.
+ (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 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
+ ;; 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))))
;; Fewer than completion-cycle-threshold remaining
;; completions: let's cycle.
(setq completed t exact t)
- (setq completion-all-sorted-completions comps)
+ (completion--cache-all-sorted-completions comps)
(minibuffer-force-complete))
(completed
;; We could also decide to refresh the completions,
(#b000 nil)
(t t)))))
+(defun completion--cache-all-sorted-completions (comps)
+ (add-hook 'after-change-functions
+ 'completion--flush-all-sorted-completions nil t)
+ (setq completion-all-sorted-completions comps))
+
(defun completion--flush-all-sorted-completions (&rest _ignore)
(remove-hook 'after-change-functions
'completion--flush-all-sorted-completions t)
;; Cache the result. This is not just for speed, but also so that
;; repeated calls to minibuffer-force-complete can cycle through
;; all possibilities.
- (add-hook 'after-change-functions
- 'completion--flush-all-sorted-completions nil t)
- (setq completion-all-sorted-completions
- (nconc all base-size))))))
+ (completion--cache-all-sorted-completions (nconc all base-size))))))
(defun minibuffer-force-complete ()
"Complete the minibuffer to an exact match.
(completion--done (buffer-substring-no-properties start (point))
'finished (unless mod "Sole completion"))))
(t
- (setq completion-cycling t)
(completion--replace base end (car all))
(completion--done (buffer-substring-no-properties start (point)) 'sole)
+ ;; Set cycling after modifying the buffer since the flush hook resets it.
+ (setq completion-cycling t)
;; 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)))))))
+ (completion--cache-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))
(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)
;; (defalias 'completion-in-region--prech 'completion-in-region--postch)
(define-minor-mode completion-in-region-mode
- "Transient minor mode used during `completion-in-region'."
+ "Transient minor mode used during `completion-in-region'.
+With a prefix argument ARG, enable the modemode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil."
:global t
(setq completion-in-region--data nil)
;; (remove-hook 'pre-command-hook #'completion-in-region--prech)
Each function on this hook is called in turns 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 &rest PROPS) where
+or a list of the form (START END COLLECTION . PROPS) where
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 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.")
+ `:exclusive' If `no', means that if the completion table fails to
+ match the text at point, 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.
(defun completion-file-name-table (string pred action)
"Completion table for file names."
- (ignore-errors
- (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)))
-
- ((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'.")
If this command was invoked with the mouse, use a graphical file
dialog if `use-dialog-box' is non-nil, and the window system or X
toolkit in use provides a file dialog box, and DIR is not a
-remote file. For graphical file dialogs, any the special values
-of MUSTMATCH; `confirm' and `confirm-after-completion' are
-treated as equivalent to nil.
+remote file. For graphical file dialogs, any of the special values
+of MUSTMATCH `confirm' and `confirm-after-completion' are
+treated as equivalent to nil. Some graphical file dialogs respect
+a MUSTMATCH value of t, and some do not (or it only has a cosmetic
+effect, and does not actually prevent the user from entering a
+non-existent file).
See also `read-file-name-completion-ignore-case'
and `read-file-name-function'."
+ ;; If x-gtk-use-old-file-dialog = t (xg_get_file_with_selection),
+ ;; then MUSTMATCH is enforced. But with newer Gtk
+ ;; (xg_get_file_with_chooser), it only has a cosmetic effect.
+ ;; The user can still type a non-existent file name.
(funcall (or read-file-name-function #'read-file-name-default)
prompt dir default-filename mustmatch initial predicate))
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."
+ :version "24.1"
:type 'boolean)
(defun completion-pcm--pattern-trivial-p (pattern)
"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))
mergedpat))
;; New pos from the start.
(newpos (length (completion-pcm--pattern->string pointpat)))
- ;; Do it afterwards because it changes `pointpat' by sideeffect.
+ ;; 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))
HCoop / bpt / emacs.git / blobdiff