;; - 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?
(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)
+ :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))
(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))
;; 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)
(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))
(with-wrapper-hook
;; FIXME: Maybe we should use this hook to provide a "display
;;; 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.")
-(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-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-filename-completion-map))
- (define-key map " " nil))
-(let ((map minibuffer-local-filename-must-match-map))
- (define-key map " " nil))
+(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'.")
+
+(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)
(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'.")
(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)))
"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))
(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
(minibuffer-completion-predicate predicate)
(minibuffer-completion-confirm (unless (eq require-match t)
require-match))
- (keymap (if require-match
- (if (memq minibuffer-completing-file-name '(nil lambda))
+ (base-keymap (if require-match
minibuffer-local-must-match-map
- minibuffer-local-filename-must-match-map)
- (if (memq minibuffer-completing-file-name '(nil lambda))
- minibuffer-local-completion-map
- minibuffer-local-filename-completion-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)
HCoop / bpt / emacs.git / blobdiff