;;; minibuffer.el --- Minibuffer completion functions
-;; Copyright (C) 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; internal use only.
;; Functional completion tables have an extended calling conventions:
-;; - If completion-all-completions-with-base-size is set, then all-completions
-;; should return the base-size in the last cdr.
;; - 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'.
(eval-when-compile (require 'cl))
-(defvar completion-all-completions-with-base-size nil
- "If non-nil, `all-completions' may return the base-size in the last cdr.
-The base-size is the length of the prefix that is elided from each
-element in the returned list of completions. See `completion-base-size'.")
-
;;; Completion table manipulation
;; New completion-table operation.
(or res
(if firsterror (signal (car firsterror) (cdr firsterror))))))
-(defun apply-partially (fun &rest args)
- "Do a \"curried\" partial application of FUN to ARGS.
-ARGS is a list of the first N arguments to pass to FUN.
-The result is a new function that takes the remaining arguments,
-and calls FUN."
- (lexical-let ((fun fun) (args1 args))
- (lambda (&rest args2) (apply fun (append args1 args2)))))
-
(defun complete-with-action (action table string pred)
"Perform completion ACTION.
STRING is the string to complete.
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 result of the `dynamic-completion-table' form is a function
+The result of the `completion-table-dynamic' form is a function
that can be used as the COLLECTION argument to `try-completion' and
`all-completions'. See Info node `(elisp)Programmed Completion'."
(lexical-let ((fun fun))
(cond
;; In case of try-completion, add the prefix.
((stringp comp) (concat prefix comp))
- ;; In case of non-empty all-completions,
- ;; add the prefix size to the base-size.
- ((consp comp)
- (let ((last (last comp)))
- (when completion-all-completions-with-base-size
- (setcdr last (+ (or (cdr last) 0) (length prefix))))
- comp))
(t comp)))))
(defun completion-table-with-terminator (terminator table string pred action)
;; 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*.
- ;; (let* ((all (all-completions string table pred))
- ;; (last (last all))
- ;; (base-size (cdr last)))
- ;; (when all
- ;; (setcdr all nil)
- ;; (nconc (mapcar (lambda (s) (concat s terminator)) all) base-size)))
+ ;; (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,
If ARGS are provided, then pass MESSAGE through `format'."
;; Clear out any old echo-area message to make way for our new thing.
(message nil)
- (setq message (if (and (null args) (string-match "\\[.+\\]" message))
+ (setq message (if (and (null args) (string-match-p "\\` *\\[.+\\]\\'" message))
;; Make sure we can put-text-property.
(copy-sequence message)
(concat " [" message "]")))
(defun delete-minibuffer-contents ()
"Delete all user input in a minibuffer.
If the current buffer is not a minibuffer, erase its entire contents."
- (delete-field))
+ ;; We used to do `delete-field' here, but when file name shadowing
+ ;; is on, the field doesn't cover the entire minibuffer contents.
+ (delete-region (minibuffer-prompt-end) (point-max)))
(defcustom completion-auto-help t
"Non-nil means automatically provide help for invalid completion input.
TRY-COMPLETION is the function that does the completion, and
ALL-COMPLETIONS is the function that lists the completions.")
-(defcustom completion-styles '(basic partial-completion)
- "List of completion styles to use."
+(defcustom completion-styles '(basic partial-completion 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)))
:group 'minibuffer
POINT is the position of point within STRING.
The return value is a list of completions and may contain the base-size
in the last `cdr'."
- (let ((completion-all-completions-with-base-size t))
- ;; The property `completion-styles' indicates that this functional
- ;; completion-table claims to take care of completion styles itself.
- ;; [I.e. It will most likely call us back at some point. ]
- (if (and (symbolp table) (get table 'completion-styles))
- ;; Extended semantics for functional completion-tables:
- ;; They accept a 4th argument `point' and when called with action=t
- ;; and this 4th argument (a position inside `string'), they may
- ;; return BASE-SIZE in the last `cdr'.
- (funcall table string pred t point)
- (completion--some (lambda (style)
- (funcall (nth 2 (assq style completion-styles-alist))
- string table pred point))
- completion-styles))))
+ ;; The property `completion-styles' indicates that this functional
+ ;; completion-table claims to take care of completion styles itself.
+ ;; [I.e. It will most likely call us back at some point. ]
+ (if (and (symbolp table) (get table 'completion-styles))
+ ;; Extended semantics for functional completion-tables:
+ ;; They accept a 4th argument `point' and when called with action=t
+ ;; and this 4th argument (a position inside `string'), they may
+ ;; return BASE-SIZE in the last `cdr'.
+ (funcall table string pred t point)
+ (completion--some (lambda (style)
+ (funcall (nth 2 (assq style completion-styles-alist))
+ string table pred point))
+ completion-styles)))
(defun minibuffer--bitset (modified completions exact)
(logior (if modified 4 0)
(- (point) beg))))
(cond
((null comp)
+ (minibuffer-hide-completions)
(ding) (minibuffer-message "No match") (minibuffer--bitset nil nil nil))
- ((eq t comp) (minibuffer--bitset nil nil t)) ;Exact and unique match.
+ ((eq t comp)
+ (minibuffer-hide-completions)
+ (goto-char (field-end))
+ (minibuffer--bitset nil nil t)) ;Exact and unique match.
(t
;; `completed' should be t if some completion was done, which doesn't
;; include simply changing the case of the entered string. However,
(let ((exact (test-completion completion
minibuffer-completion-table
minibuffer-completion-predicate)))
- (unless completed
+ (if completed
+ ;; We could also decide to refresh the completions,
+ ;; if they're displayed (and assuming there are
+ ;; completions left).
+ (minibuffer-hide-completions)
;; Show the completion table, if requested.
(cond
((not exact)
(t completion-auto-help))
(minibuffer-completion-help)
(minibuffer-message "Next char not unique")))
- ;; If the last exact completion and this one were the same,
- ;; it means we've already given a "Complete but not unique"
- ;; message and the user's hit TAB again, so now we give him help.
+ ;; If the last exact completion and this one were the same, it
+ ;; means we've already given a "Next char 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)))))
(case (completion--do-completion)
(#b000 nil)
- (#b001 (goto-char (field-end))
- (minibuffer-message "Sole completion")
+ (#b001 (minibuffer-message "Sole completion")
t)
- (#b011 (goto-char (field-end))
- (minibuffer-message "Complete, but not unique")
+ (#b011 (minibuffer-message "Complete, but not unique")
t)
(t t)))))
;; through the previous possible completions.
(setq completion-all-sorted-completions (cdr all)))))
+(defvar minibuffer-confirm-exit-commands
+ '(minibuffer-complete minibuffer-complete-word PC-complete PC-complete-word)
+ "A list of commands which cause an immediately following
+`minibuffer-complete-and-exit' to ask for extra confirmation.")
+
(defun minibuffer-complete-and-exit ()
- "If the minibuffer contents is a valid completion then exit.
-Otherwise try to complete it. If completion leads to a valid completion,
-a repetition of this command will exit.
-If `minibuffer-completion-confirm' is equal to `confirm', then do not
-try to complete, but simply ask for confirmation and accept any
-input if confirmed."
+ "Exit if the minibuffer contains a valid completion.
+Otherwise, try to complete the minibuffer contents. If
+completion leads to a valid completion, a repetition of this
+command will exit.
+
+If `minibuffer-completion-confirm' is `confirm', do not try to
+ complete; instead, ask for confirmation and accept any input if
+ confirmed.
+If `minibuffer-completion-confirm' is `confirm-after-completion',
+ do not try to complete; instead, ask for confirmation if the
+ preceding minibuffer command was a member of
+ `minibuffer-confirm-exit-commands', and accept the input
+ otherwise."
(interactive)
(let ((beg (field-beginning))
(end (field-end)))
(delete-region beg end))))
(exit-minibuffer))
- ((eq minibuffer-completion-confirm 'confirm-only)
+ ((eq minibuffer-completion-confirm 'confirm)
;; The user is permitted to exit with an input that's rejected
- ;; by test-completion, but at the condition to confirm her choice.
+ ;; by test-completion, after confirming her choice.
(if (eq last-command this-command)
(exit-minibuffer)
(minibuffer-message "Confirm")
nil))
+ ((eq minibuffer-completion-confirm 'confirm-after-completion)
+ ;; Similar to the above, but only if trying to exit immediately
+ ;; after typing TAB (this catches most minibuffer typos).
+ (if (memq last-command minibuffer-confirm-exit-commands)
+ (progn (minibuffer-message "Confirm")
+ nil)
+ (exit-minibuffer)))
+
(t
;; Call do-completion, but ignore errors.
(case (condition-case nil
;; If completion finds next char not unique,
;; consider adding a space or a hyphen.
(when (= (length string) (length (car comp)))
- (let ((exts '(" " "-"))
+ ;; Mark the added char with the `completion-word' property, so it
+ ;; can be handled specially by completion styles such as
+ ;; partial-completion.
+ ;; We used to remove `partial-completion' from completion-styles
+ ;; 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))
- ;; If the user hasn't entered any text yet, then she
- ;; presumably hits SPC to see the *completions*, but
- ;; partial-completion will often find a " " or a "-" to match.
- ;; So disable partial-completion in that situation.
- (completion-styles
- (or (and (equal string "")
- (remove 'partial-completion completion-styles))
- completion-styles))
tem)
(while (and exts (not (consp tem)))
(setq tem (completion-try-completion
(interactive)
(case (completion--do-completion 'completion--try-word-completion)
(#b000 nil)
- (#b001 (goto-char (field-end))
- (minibuffer-message "Sole completion")
+ (#b001 (minibuffer-message "Sole completion")
t)
- (#b011 (goto-char (field-end))
- (minibuffer-message "Complete, but not unique")
+ (#b011 (minibuffer-message "Complete, but not unique")
t)
(t t)))
+(defface completions-annotations '((t :inherit italic))
+ "Face to use for annotations in the *Completions* buffer.")
+
(defun completion--insert-strings (strings)
"Insert a list of STRINGS into the current buffer.
Uses columns to keep the listing readable but compact.
;; 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.
+ (unless (equal laststring str) ; Remove (consecutive) duplicates.
(setq laststring str)
- (unless (bolp)
- (insert " \t")
- (setq column (+ column colwidth))
- ;; 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)
- ;; We can't just set tab-width, because
- ;; completion-setup-function will kill all
- ;; local variables :-(
- `(display (space :align-to ,column)))
- (when (< wwidth (+ (max colwidth
- (if (consp str)
- (+ (string-width (car str))
- (string-width (cadr str)))
- (string-width str)))
- column))
- (delete-char -2) (insert "\n") (setq column 0)))
- (if (not (consp str))
- (put-text-property (point) (progn (insert str) (point))
- 'mouse-face 'highlight)
- (put-text-property (point) (progn (insert (car str)) (point))
- 'mouse-face 'highlight)
- (put-text-property (point) (progn (insert (cadr str)) (point))
- 'mouse-face nil)))))))
+ (let ((length (if (consp str)
+ (+ (string-width (car str))
+ (string-width (cadr str)))
+ (string-width str))))
+ (unless (bolp)
+ (if (< wwidth (+ (max colwidth length) column))
+ ;; No space for `str' at point, move to next line.
+ (progn (insert "\n") (setq column 0))
+ (insert " \t")
+ ;; 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)
+ ;; We can't just set tab-width, because
+ ;; completion-setup-function will kill all
+ ;; local variables :-(
+ `(display (space :align-to ,column)))
+ nil))
+ (if (not (consp str))
+ (put-text-property (point) (progn (insert str) (point))
+ 'mouse-face 'highlight)
+ (put-text-property (point) (progn (insert (car str)) (point))
+ 'mouse-face 'highlight)
+ (add-text-properties (point) (progn (insert (cadr str)) (point))
+ '(mouse-face nil
+ face completions-annotations)))
+ ;; Next column to align to.
+ (setq column (+ column
+ ;; Round up to a whole number of columns.
+ (* colwidth (ceiling length colwidth))))))))))
(defvar completion-common-substring nil)
(make-obsolete-variable 'completion-common-substring nil "23.1")
of the differing parts is, by contrast, slightly highlighted."
:group 'completion)
-(defun completion-hilit-commonality (completions prefix-len)
+(defun completion-hilit-commonality (completions prefix-len base-size)
(when completions
- (let* ((last (last completions))
- (base-size (cdr last))
- (com-str-len (- prefix-len (or base-size 0))))
- ;; Remove base-size during mapcar, and add it back later.
- (setcdr last nil)
+ (let ((com-str-len (- prefix-len (or base-size 0))))
(nconc
(mapcar
(lambda (elem)
(car (setq elem (cons (copy-sequence (car elem))
(cdr elem))))
(setq elem (copy-sequence elem)))))
- (put-text-property 0 com-str-len
+ (put-text-property 0
+ ;; If completion-boundaries returns incorrect
+ ;; values, all-completions may return strings
+ ;; that don't contain the prefix.
+ (min com-str-len (length str))
'font-lock-face 'completions-common-part
str)
(if (> (length str) com-str-len)
completions)
base-size))))
-(defun display-completion-list (completions &optional common-substring base-size)
+(defun display-completion-list (completions &optional common-substring)
"Display the list of completions, COMPLETIONS, using `standard-output'.
Each element may be just a symbol or string
or may be a list of two strings to be printed as if concatenated.
At the end, this runs the normal hook `completion-setup-hook'.
It can find the completion buffer in `standard-output'.
-The optional arg COMMON-SUBSTRING, if non-nil, should be a string
+The obsolete optional arg COMMON-SUBSTRING, if non-nil, should be a string
specifying a common substring for adding the faces
`completions-first-difference' and `completions-common-part' to
-the completions buffer.
-
-The optional arg BASE-SIZE, if non-nil, which should be an
-integer that specifies the value of `completion-base-size' for
-the completion buffer."
+the completions buffer."
(if common-substring
(setq completions (completion-hilit-commonality
- completions (length common-substring))))
+ completions (length common-substring)
+ ;; We don't know the base-size.
+ nil)))
(if (not (bufferp standard-output))
;; This *never* (ever) happens, so there's no point trying to be clever.
(with-temp-buffer
(let ((standard-output (current-buffer))
(completion-setup-hook nil))
- (display-completion-list completions common-substring base-size))
+ (display-completion-list completions common-substring))
(princ (buffer-string)))
- (with-current-buffer standard-output
- (goto-char (point-max))
- (if (null completions)
- (insert "There are no possible completions of what you have typed.")
-
- (insert "Possible completions are:\n")
- (let ((last (last completions)))
- ;; If BASE-SIZE is unspecified, set it from the tail of the list.
- (set (make-local-variable 'completion-base-size)
- (or base-size (cdr last) 0))
- (setcdr last nil)) ;Make completions a properly nil-terminated list.
- (completion--insert-strings completions))))
+ (let ((mainbuf (current-buffer)))
+ (with-current-buffer standard-output
+ (goto-char (point-max))
+ (if (null completions)
+ (insert "There are no possible completions of what you have typed.")
+ (insert "Possible completions are:\n")
+ (let ((last (last completions)))
+ ;; Set base-size from the tail of the list.
+ (set (make-local-variable 'completion-base-size)
+ (or (cdr last)
+ (and (minibufferp mainbuf) 0)))
+ (setcdr last nil)) ; Make completions a properly nil-terminated list.
+ (completion--insert-strings completions)))))
;; The hilit used to be applied via completion-setup-hook, so there
;; may still be some code that uses completion-common-substring.
(if completions "Sole completion" "No completions")))
nil))
+(defun minibuffer-hide-completions ()
+ "Get rid of an out-of-date *Completions* buffer."
+ ;; FIXME: We could/should use minibuffer-scroll-window here, but it
+ ;; can also point to the minibuffer-parent-window, so it's a bit tricky.
+ (let ((win (get-buffer-window "*Completions*" 0)))
+ (if win (with-selected-window win (bury-buffer)))))
+
(defun exit-minibuffer ()
"Terminate this minibuffer argument."
(interactive)
(defun self-insert-and-exit ()
"Terminate minibuffer input."
(interactive)
- (if (characterp last-command-char)
+ (if (characterp last-command-event)
(call-interactively 'self-insert-command)
(ding))
(exit-minibuffer))
(defun completion--make-envvar-table ()
(mapcar (lambda (enventry)
- (substring enventry 0 (string-match "=" enventry)))
+ (substring enventry 0 (string-match-p "=" enventry)))
process-environment))
(defconst completion--embedded-envvar-re
;; FIXME: Actually, this is not always right in the presence of
;; envvars, but there's not much we can do, I think.
(let ((start (length (file-name-directory string)))
- (end (string-match "/" (cdr action))))
+ (end (string-match-p "/" (cdr action))))
(list* 'boundaries start end)))
(t
str))))
((eq action t)
- (let ((all (file-name-all-completions name realdir))
- ;; FIXME: Actually, this is not always right in the presence
- ;; of envvars, but there's not much we can do, I think.
- (base-size (length (file-name-directory string))))
+ (let ((all (file-name-all-completions name realdir)))
;; Check the predicate, if necessary.
(unless (memq read-file-name-predicate '(nil file-exists-p))
(if (funcall pred tem) (push tem comp))))
(setq all (nreverse comp))))
- (if (and completion-all-completions-with-base-size (consp all))
- ;; Add base-size, but only if the list is non-empty.
- (nconc all base-size)
- all)))
+ all))
(t
;; Only other case actually used is ACTION = lambda.
If the user exits with an empty minibuffer, this function returns
an empty string. (This can only happen if the user erased the
pre-inserted contents or if `insert-default-directory' is nil.)
-Fourth arg MUSTMATCH non-nil means require existing file's name.
- Non-nil and non-t means also require confirmation after completion.
+
+Fourth arg MUSTMATCH can take the following values:
+- nil means that the user can exit with any input.
+- t means that the user is not allowed to exit unless
+ the input is (or completes to) an existing file.
+- `confirm' means that the user can exit with any input, but she needs
+ to confirm her choice if the input is not an existing file.
+- `confirm-after-completion' means that the user can exit with any
+ input, but she needs to confirm her choice if she called
+ `minibuffer-complete' right before `minibuffer-complete-and-exit'
+ and the input is not an existing file.
+- anything else behaves like t except that typing RET does not exit if it
+ does non-null completion.
+
Fifth arg INITIAL specifies text to start with.
+
If optional sixth arg PREDICATE is non-nil, possible completions and
the resulting file name must satisfy (funcall PREDICATE NAME).
DIR should be an absolute directory name. It defaults to the value of
`default-directory'.
-If this command was invoked with the mouse, use a file dialog box if
-`use-dialog-box' is non-nil, and the window system or X toolkit in use
-provides a file dialog box.
+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. For graphical file
+dialogs, any the special values of MUSTMATCH; `confirm' and
+`confirm-after-completion' are treated as equivalent to nil.
See also `read-file-name-completion-ignore-case'
and `read-file-name-function'."
(completing-read prompt 'read-file-name-internal
nil mustmatch insdef 'file-name-history
default-filename)))
- ;; If DIR contains a file name, split it.
- (let ((file (file-name-nondirectory dir)))
- (when (and default-filename (not (zerop (length file))))
+ ;; If DEFAULT-FILENAME not supplied and DIR contains
+ ;; a file name, split it.
+ (let ((file (file-name-nondirectory dir))
+ ;; When using a dialog, revert to nil and non-nil
+ ;; interpretation of mustmatch. confirm options
+ ;; need to be interpreted as nil, otherwise
+ ;; it is impossible to create new files using
+ ;; dialogs with the default settings.
+ (dialog-mustmatch
+ (and (not (eq mustmatch 'confirm))
+ (not (eq mustmatch 'confirm-after-completion))
+ mustmatch)))
+ (when (and (not default-filename)
+ (not (zerop (length file))))
(setq default-filename file)
(setq dir (file-name-directory dir)))
(if default-filename
(setq default-filename
(expand-file-name default-filename dir)))
(setq add-to-history t)
- (x-file-dialog prompt dir default-filename mustmatch
+ (x-file-dialog prompt dir default-filename
+ dialog-mustmatch
(eq predicate 'file-directory-p)))))
(replace-in-history (eq (car-safe file-name-history) val)))
(defun internal-complete-buffer-except (&optional buffer)
"Perform completion on all buffers excluding BUFFER.
+BUFFER nil or omitted means use the current buffer.
Like `internal-complete-buffer', but removes BUFFER from the completion list."
(lexical-let ((except (if (stringp buffer) buffer (buffer-name buffer))))
(apply-partially 'completion-table-with-predicate
(defun completion-emacs21-all-completions (string table pred point)
(completion-hilit-commonality
(all-completions string table pred)
- (length string)))
+ (length string)
+ (car (completion-boundaries string table pred ""))))
(defun completion-emacs22-try-completion (string table pred point)
(let ((suffix (substring string point))
(cons (concat completion suffix) (length completion)))))
(defun completion-emacs22-all-completions (string table pred point)
- (completion-hilit-commonality
- (all-completions (substring string 0 point) table pred)
- point))
+ (let ((beforepoint (substring string 0 point)))
+ (completion-hilit-commonality
+ (all-completions beforepoint table pred)
+ point
+ (car (completion-boundaries beforepoint table pred "")))))
;;; Basic completion.
'point
(substring afterpoint 0 (cdr bounds)))))
(all (completion-pcm--all-completions prefix pattern table pred)))
- (completion-hilit-commonality
- (if (consp all) (nconc all (car bounds)) all)
- point)))
+ (completion-hilit-commonality all point (car bounds))))
;;; Partial-completion-mode style completion.
-(defvar completion-pcm--delim-wild-regex nil)
+(defvar completion-pcm--delim-wild-regex nil
+ "Regular expression matching delimiters controlling the partial-completion.
+Typically, this regular expression simply matches a delimiter, meaning
+that completion can add something at (match-beginning 0), but if it has
+a submatch 1, then completion can add something at (match-end 1).
+This is used when the delimiter needs to be of size zero (e.g. the transition
+from lowercase to uppercase characters).")
(defun completion-pcm--prepare-delim-re (delims)
(setq completion-pcm--delim-wild-regex (concat "[" delims "*]")))
:type 'string)
(defun completion-pcm--pattern-trivial-p (pattern)
- (and (stringp (car pattern)) (null (cdr pattern))))
+ (and (stringp (car pattern))
+ ;; It can be followed by `point' and "" and still be trivial.
+ (let ((trivial t))
+ (dolist (elem (cdr pattern))
+ (unless (member elem '(point ""))
+ (setq trivial nil)))
+ trivial)))
(defun completion-pcm--string->pattern (string &optional point)
"Split STRING into a pattern.
(p 0)
(p0 0))
- (while (setq p (string-match completion-pcm--delim-wild-regex string p))
+ (while (and (setq p (string-match completion-pcm--delim-wild-regex
+ string p))
+ ;; If the char was added by minibuffer-complete-word, then
+ ;; don't treat it as a delimiter, otherwise "M-x SPC"
+ ;; ends up inserting a "-" rather than listing
+ ;; all completions.
+ (not (get-text-property p 'completion-try-word string)))
+ ;; Usually, completion-pcm--delim-wild-regex matches a delimiter,
+ ;; meaning that something can be added *before* it, but it can also
+ ;; match a prefix and postfix, in which case something can be added
+ ;; in-between (e.g. match [[:lower:]][[:upper:]]).
+ ;; This is determined by the presence of a submatch-1 which delimits
+ ;; the prefix.
+ (if (match-end 1) (setq p (match-end 1)))
(push (substring string p0 p) pattern)
(if (eq (aref string p) ?*)
(progn
(defun completion-pcm--all-completions (prefix pattern table pred)
"Find all completions for PATTERN in TABLE obeying PRED.
PATTERN is as returned by `completion-pcm--string->pattern'."
+ ;; (assert (= (car (completion-boundaries prefix table pred ""))
+ ;; (length prefix)))
;; Find an initial list of possible completions.
(if (completion-pcm--pattern-trivial-p pattern)
;; Minibuffer contains no delimiters -- simple case!
- (let* ((all (all-completions (concat prefix (car pattern)) table pred))
- (last (last all)))
- (if last (setcdr last nil))
- all)
+ (all-completions (concat prefix (car pattern)) table pred)
;; Use all-completions to do an initial cull. This is a big win,
;; since all-completions is written in C!
(let* (;; Convert search pattern to a standard regular expression.
(regex (completion-pcm--pattern->regex pattern))
- (completion-regexp-list (cons regex completion-regexp-list))
+ (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) ""))
- table pred))
- (last (last compl)))
- (when last
- (if (and (numberp (cdr last)) (/= (cdr last) (length prefix)))
- (message "Inconsistent base-size returned by completion table %s"
- table))
- (setcdr last nil))
+ table pred)))
(if (not (functionp table))
;; The internal functions already obeyed completion-regexp-list.
compl
- (let ((case-fold-search completion-ignore-case)
- (poss ()))
+ (let ((poss ()))
(dolist (c compl)
- (when (string-match regex c) (push c poss)))
+ (when (string-match-p regex c) (push c poss)))
poss)))))
(defun completion-pcm--hilit-commonality (pattern completions)
(when completions
(let* ((re (completion-pcm--pattern->regex pattern '(point)))
- (last (last completions))
- (base-size (cdr last)))
+ (case-fold-search completion-ignore-case))
;; Remove base-size during mapcar, and add it back later.
- (setcdr last nil)
- (nconc
- (mapcar
- (lambda (str)
- ;; Don't modify the string itself.
- (setq str (copy-sequence str))
- (unless (string-match re str)
- (error "Internal error: %s does not match %s" re str))
- (let ((pos (or (match-beginning 1) (match-end 0))))
- (put-text-property 0 pos
- 'font-lock-face 'completions-common-part
- str)
- (if (> (length str) pos)
- (put-text-property pos (1+ pos)
- 'font-lock-face 'completions-first-difference
- str)))
- str)
- completions)
- base-size))))
+ (mapcar
+ (lambda (str)
+ ;; Don't modify the string itself.
+ (setq str (copy-sequence str))
+ (unless (string-match re str)
+ (error "Internal error: %s does not match %s" re str))
+ (let ((pos (or (match-beginning 1) (match-end 0))))
+ (put-text-property 0 pos
+ 'font-lock-face 'completions-common-part
+ str)
+ (if (> (length str) pos)
+ (put-text-property pos (1+ pos)
+ 'font-lock-face 'completions-first-difference
+ str)))
+ str)
+ completions))))
(defun completion-pcm--find-all-completions (string table pred point
&optional filter)
(regexp-opt completion-ignored-extensions)
"\\)\\'")))
(dolist (f all)
- (unless (string-match re f) (push f try)))
+ (unless (string-match-p re f) (push f try)))
(or try all))))
-
+
(defun completion-pcm--merge-try (pattern all prefix suffix)
(cond
HCoop / bpt / emacs.git / blobdiff