;;; minibuffer.el --- Minibuffer completion functions -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Package: emacs
;;; Bugs:
-;; - completion-all-sorted-completions list all the completions, whereas
+;; - completion-all-sorted-completions lists all the completions, whereas
;; it should only lists the ones that `try-completion' would consider.
;; E.g. it should honor completion-ignored-extensions.
;; - choose-completion can't automatically figure out the boundaries
(let ((firsterror nil)
res)
(while (and (not res) xs)
- (condition-case err
+ (condition-case-unless-debug err
(setq res (funcall fun (pop xs)))
(error (unless firsterror (setq firsterror err)) nil)))
(or res
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'."
+`all-completions'. See Info node `(elisp)Programmed Completion'.
+
+See also the related function `completion-table-with-cache'."
(lambda (string pred action)
(if (or (eq (car-safe action) 'boundaries) (eq action 'metadata))
;; `fun' is not supposed to return another function but a plain old
(current-buffer)))
(complete-with-action action (funcall fun string) string pred)))))
+(defun completion-table-with-cache (fun &optional ignore-case)
+ "Create dynamic completion table from function FUN, with cache.
+This is a wrapper for `completion-table-dynamic' that saves the last
+argument-result pair from FUN, so that several lookups with the
+same argument (or with an argument that starts with the first one)
+only need to call FUN once. This can be useful when FUN performs a
+relatively slow operation, such as calling an external process.
+
+When IGNORE-CASE is non-nil, FUN is expected to be case-insensitive."
+ ;; See eg bug#11906.
+ (let* (last-arg last-result
+ (new-fun
+ (lambda (arg)
+ (if (and last-arg (string-prefix-p last-arg arg ignore-case))
+ last-result
+ (prog1
+ (setq last-result (funcall fun arg))
+ (setq last-arg arg))))))
+ (completion-table-dynamic new-fun)))
+
(defmacro lazy-completion-table (var fun)
"Initialize variable VAR as a lazy completion table.
If the completion table VAR is used for the first time (e.g., by passing VAR
"Create a completion table that tries each table in TABLES in turn."
;; FIXME: the boundaries may come from TABLE1 even when the completion list
;; is returned by TABLE2 (because TABLE1 returned an empty list).
+ ;; Same potential problem if any of the tables use quoting.
(lambda (string pred action)
(completion--some (lambda (table)
(complete-with-action action table string pred))
tables)))
+(defun completion-table-merge (&rest tables)
+ "Create a completion table that collects completions from all TABLES."
+ ;; FIXME: same caveats as in `completion-table-in-turn'.
+ (lambda (string pred action)
+ (cond
+ ((null action)
+ (let ((retvals (mapcar (lambda (table)
+ (try-completion string table pred))
+ tables)))
+ (if (member string retvals)
+ string
+ (try-completion string
+ (mapcar (lambda (value)
+ (if (eq value t) string value))
+ (delq nil retvals))
+ pred))))
+ ((eq action t)
+ (apply #'append (mapcar (lambda (table)
+ (all-completions string table pred))
+ tables)))
+ (t
+ (completion--some (lambda (table)
+ (complete-with-action action table string pred))
+ tables)))))
+
(defun completion-table-with-quoting (table unquote requote)
;; A difficult part of completion-with-quoting is to map positions in the
;; quoted string to equivalent positions in the unquoted string and
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
(message nil)))
;; Clear out any old echo-area message to make way for our new thing.
(message nil)
- (setq message (if (and (null args) (string-match-p "\\` *\\[.+\\]\\'" message))
+ (setq message (if (and (null args)
+ (string-match-p "\\` *\\[.+\\]\\'" message))
;; Make sure we can put-text-property.
(copy-sequence message)
(concat " [" message "]")))
"Return the user input in a minibuffer before point as a string.
In Emacs-22, that was what completion commands operated on."
(declare (obsolete nil "24.4"))
- (buffer-substring (field-beginning) (point)))
+ (buffer-substring (minibuffer-prompt-end) (point)))
(defun delete-minibuffer-contents ()
"Delete all user input in a minibuffer.
is requested but cannot be done.
If the value is `lazy', the *Completions* buffer is only displayed after
the second failed attempt to complete."
- :type '(choice (const nil) (const t) (const lazy))
- :group 'minibuffer)
+ :type '(choice (const nil) (const t) (const lazy)))
(defconst completion-styles-alist
'((emacs21
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
;; 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)
- (funcall (nth n (assq style
- completion-styles-alist))
- string table pred point))
- (completion--styles metadata))))
+ (result
+ (completion--some (lambda (style)
+ (funcall (nth n (assq style
+ completion-styles-alist))
+ string table pred point))
+ (completion--styles metadata))))
(if requote
(funcall requote result n)
result)))
(setq end (- end suffix-len))
(setq newtext (substring newtext 0 (- suffix-len))))
(goto-char beg)
- (insert-and-inherit newtext)
- (delete-region (point) (+ (point) (- end beg)))
+ (let ((length (- end beg))) ;Read `end' before we insert the text.
+ (insert-and-inherit newtext)
+ (delete-region (point) (+ (point) length)))
(forward-char suffix-len)))
(defcustom completion-cycle-threshold nil
"Number of completion candidates below which cycling is used.
-Depending on this setting `minibuffer-complete' may use cycling,
+Depending on this setting `completion-in-region' may use cycling,
like `minibuffer-force-complete'.
If nil, cycling is never used.
If t, cycling is always used.
(over (assq 'cycle (cdr (assq cat completion-category-overrides)))))
(if over (cdr over) completion-cycle-threshold)))
-(defvar completion-all-sorted-completions nil)
-(make-variable-buffer-local 'completion-all-sorted-completions)
+(defvar-local completion-all-sorted-completions nil)
(defvar-local completion--all-sorted-completions-location nil)
(defvar completion-cycling nil)
(if completion-show-inline-help
(minibuffer-message msg)))
-(defun completion--do-completion (&optional try-completion-function
- expect-exact)
+(defun completion--do-completion (beg end &optional
+ try-completion-function expect-exact)
"Do the completion and return a summary of what happened.
M = completion was performed, the text was Modified.
C = there were available Completions.
TRY-COMPLETION-FUNCTION is a function to use in place of `try-completion'.
EXPECT-EXACT, if non-nil, means that there is no need to tell the user
when the buffer's text is already an exact match."
- (let* ((beg (field-beginning))
- (end (field-end))
- (string (buffer-substring beg end))
+ (let* ((string (buffer-substring beg end))
(md (completion--field-metadata beg))
(comp (funcall (or try-completion-function
'completion-try-completion)
(if unchanged
(goto-char end)
;; Insert in minibuffer the chars we got.
- (completion--replace beg end completion))
+ (completion--replace beg end completion)
+ (setq end (+ beg (length completion))))
;; Move point to its completion-mandated destination.
(forward-char (- comp-pos (length completion)))
;; whether this is a unique completion or not, so try again using
;; the real case (this shouldn't recurse again, because the next
;; time try-completion will return either t or the exact string).
- (completion--do-completion try-completion-function expect-exact)
+ (completion--do-completion beg end
+ try-completion-function expect-exact)
;; It did find a match. Do we match some possibility exactly now?
(let* ((exact (test-completion completion
minibuffer-completion-predicate
""))
comp-pos)))
- (completion-all-sorted-completions))))
+ (completion-all-sorted-completions beg end))))
(completion--flush-all-sorted-completions)
(cond
((and (consp (cdr comps)) ;; There's something to cycle.
;; Not more than completion-cycle-threshold remaining
;; completions: let's cycle.
(setq completed t exact t)
- (completion--cache-all-sorted-completions comps)
- (minibuffer-force-complete))
+ (completion--cache-all-sorted-completions beg end comps)
+ (minibuffer-force-complete beg end))
(completed
;; We could also decide to refresh the completions,
;; if they're displayed (and assuming there are
(if (pcase completion-auto-help
(`lazy (eq this-command last-command))
(_ completion-auto-help))
- (minibuffer-completion-help)
+ (minibuffer-completion-help beg end)
(completion--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.
(t
(if (and (eq this-command last-command) completion-auto-help)
- (minibuffer-completion-help))
+ (minibuffer-completion-help beg end))
(completion--done completion 'exact
(unless expect-exact
"Complete, but not unique"))))
If you repeat this command after it displayed such a list,
scroll the window of possible completions."
(interactive)
+ (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,
;; mark the completion buffer obsolete.
(setq this-command 'completion-at-point)
;; If end is in view, scroll up to the beginning.
(set-window-start window (point-min) nil)
;; Else scroll down one screen.
- (scroll-other-window))
+ (with-selected-window window
+ (scroll-up)))
nil)))
;; If we're cycling, keep on cycling.
((and completion-cycling completion-all-sorted-completions)
- (minibuffer-force-complete)
+ (minibuffer-force-complete beg end)
t)
- (t (pcase (completion--do-completion)
+ (t (pcase (completion--do-completion beg end)
(#b000 nil)
(_ t)))))
-(defun completion--cache-all-sorted-completions (comps)
+(defun completion--cache-all-sorted-completions (beg end comps)
(add-hook 'after-change-functions
'completion--flush-all-sorted-completions nil t)
(setq completion--all-sorted-completions-location
- (cons (copy-marker (field-beginning)) (copy-marker (field-end))))
+ (cons (copy-marker beg) (copy-marker end)))
(setq completion-all-sorted-completions comps))
(defun completion--flush-all-sorted-completions (&optional start end _len)
(if (eq (car bounds) base) md-at-point
(completion-metadata (substring string 0 base) table pred))))
-(defun completion-all-sorted-completions ()
+(defun completion-all-sorted-completions (&optional start end)
(or completion-all-sorted-completions
- (let* ((start (field-beginning))
- (end (field-end))
+ (let* ((start (or start (minibuffer-prompt-end)))
+ (end (or end (point-max)))
(string (buffer-substring start end))
(md (completion--field-metadata start))
(all (completion-all-completions
;; Cache the result. This is not just for speed, but also so that
;; repeated calls to minibuffer-force-complete can cycle through
;; all possibilities.
- (completion--cache-all-sorted-completions (nconc all base-size))))))
+ (completion--cache-all-sorted-completions
+ start end (nconc all base-size))))))
(defun minibuffer-force-complete-and-exit ()
"Complete the minibuffer with first of the matches and exit."
(interactive)
- (minibuffer-force-complete)
- (minibuffer--complete-and-exit
- ;; 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"))))
+ (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")))))
-(defun minibuffer-force-complete ()
+(defun minibuffer-force-complete (&optional start end)
"Complete the minibuffer to an exact match.
Repeated uses step through the possible completions."
(interactive)
;; FIXME: Need to deal with the extra-size issue here as well.
;; FIXME: ~/src/emacs/t<M-TAB>/lisp/minibuffer.el completes to
;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
- (let* ((start (copy-marker (field-beginning)))
- (end (field-end))
+ (let* ((start (copy-marker (or start (minibuffer-prompt-end))))
+ (end (or end (point-max)))
;; (md (completion--field-metadata start))
- (all (completion-all-sorted-completions))
+ (all (completion-all-sorted-completions start end))
(base (+ start (or (cdr (last all)) 0))))
(cond
((not (consp all))
'finished (when done "Sole completion"))))
(t
(completion--replace base end (car all))
+ (setq end (+ base (length (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)
- (setq this-command 'completion-at-point) ;For minibuffer-complete.
+ (setq this-command 'completion-at-point) ;For completion-in-region.
;; 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)))
- (completion--cache-all-sorted-completions (cdr all)))
+ (completion--cache-all-sorted-completions start end (cdr all)))
;; Make sure repeated uses cycle, even though completion--done might
;; have added a space or something that moved us outside of the field.
;; (bug#12221).
(interactive)
(let ((completion-extra-properties extra-prop))
(completion-in-region start (point) table pred)))))
- (set-temporary-overlay-map
+ (set-transient-map
(let ((map (make-sparse-keymap)))
(define-key map [remap completion-at-point] cmd)
(define-key map (vector last-command-event) cmd)
`minibuffer-confirm-exit-commands', and accept the input
otherwise."
(interactive)
- (minibuffer--complete-and-exit
+ (completion-complete-and-exit (minibuffer-prompt-end) (point-max)
+ #'exit-minibuffer))
+
+(defun completion-complete-and-exit (beg end exit-function)
+ (completion--complete-and-exit
+ beg end exit-function
(lambda ()
(pcase (condition-case nil
- (completion--do-completion nil 'expect-exact)
+ (completion--do-completion beg end
+ nil 'expect-exact)
(error 1))
- ((or #b001 #b011) (exit-minibuffer))
+ ((or #b001 #b011) (funcall exit-function))
(#b111 (if (not minibuffer-completion-confirm)
- (exit-minibuffer)
+ (funcall exit-function)
(minibuffer-message "Confirm")
nil))
(_ nil)))))
-(defun minibuffer--complete-and-exit (completion-function)
+(defun completion--complete-and-exit (beg end
+ exit-function completion-function)
"Exit from `require-match' minibuffer.
COMPLETION-FUNCTION is called if the current buffer's content does not
appear to be a match."
- (let ((beg (field-beginning))
- (end (field-end)))
(cond
;; Allow user to specify null string
- ((= beg end) (exit-minibuffer))
+ ((= beg end) (funcall exit-function))
((test-completion (buffer-substring beg end)
minibuffer-completion-table
minibuffer-completion-predicate)
;; that file.
(= (length string) (length compl)))
(completion--replace beg end compl))))
- (exit-minibuffer))
+ (funcall exit-function))
((memq minibuffer-completion-confirm '(confirm confirm-after-completion))
;; The user is permitted to exit with an input that's rejected
;; catches most minibuffer typos).
(and (eq minibuffer-completion-confirm 'confirm-after-completion)
(not (memq last-command minibuffer-confirm-exit-commands))))
- (exit-minibuffer)
+ (funcall exit-function)
(minibuffer-message "Confirm")
nil))
(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)))
(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)
is added, provided that matches some possible completion.
Return nil if there is no valid completion, else t."
(interactive)
- (pcase (completion--do-completion 'completion--try-word-completion)
+ (completion-in-region--single-word
+ (minibuffer-prompt-end) (point-max)
+ minibuffer-completion-table minibuffer-completion-predicate))
+
+(defun completion-in-region--single-word (beg end collection
+ &optional predicate)
+ (let ((minibuffer-completion-table collection)
+ (minibuffer-completion-predicate predicate))
+ (pcase (completion--do-completion beg end
+ #'completion--try-word-completion)
(#b000 nil)
- (_ t)))
+ (_ t))))
(defface completions-annotations '((t :inherit italic))
"Face to use for annotations in the *Completions* buffer.")
If the value is `horizontal', display completions sorted
horizontally in alphabetical order, rather than down the screen."
:type '(choice (const horizontal) (const vertical))
- :group 'minibuffer
:version "23.2")
(defun completion--insert-strings (strings)
(defface completions-first-difference
'((t (:inherit bold)))
- "Face added on the first uncommon character in completions in *Completions* buffer."
- :group 'completion)
+ "Face for the first uncommon character in completions.
+See also the face `completions-common-part'.")
(defface completions-common-part '((t nil))
- "Face added on the common prefix substring in completions in *Completions* buffer.
-The idea of `completions-common-part' is that you can use it to
-make the common parts less visible than normal, so that the rest
-of the differing parts is, by contrast, slightly highlighted."
- :group 'completion)
-
-(defun completion-hilit-commonality (completions prefix-len base-size)
+ "Face for the common prefix substring in completions.
+The idea of this face is that you can use it to make the common parts
+less visible than normal, so that the differing parts are emphasized
+by contrast.
+See also the face `completions-first-difference'.")
+
+(defun completion-hilit-commonality (completions prefix-len &optional base-size)
+ "Apply font-lock highlighting to a list of completions, COMPLETIONS.
+PREFIX-LEN is an integer. BASE-SIZE is an integer or nil (meaning zero).
+
+This adds the face `completions-common-part' to the first
+\(PREFIX-LEN - BASE-SIZE) characters of each completion, and the face
+`completions-first-difference' to the first character after that.
+
+It returns a list with font-lock properties applied to each element,
+and with BASE-SIZE appended as the last element."
(when completions
(let ((com-str-len (- prefix-len (or base-size 0))))
(nconc
The actual completion alternatives, as inserted, are given `mouse-face'
properties of `highlight'.
At the end, this runs the normal hook `completion-setup-hook'.
-It can find the completion buffer in `standard-output'.
-
-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."
+It can find the completion buffer in `standard-output'."
+ (declare (advertised-calling-convention (completions) "24.4"))
(if common-substring
(setq completions (completion-hilit-commonality
completions (length common-substring)
(equal pre-msg (and exit-fun (current-message))))
(completion--message message))))
-(defun minibuffer-completion-help ()
+(defun minibuffer-completion-help (&optional start end)
"Display a list of possible completions of the current minibuffer contents."
(interactive)
(message "Making completion list...")
- (let* ((start (field-beginning))
- (end (field-end))
- (string (field-string))
+ (let* ((start (or start (minibuffer-prompt-end)))
+ (end (or end (point-max)))
+ (string (buffer-substring start end))
(md (completion--field-metadata start))
(completions (completion-all-completions
string
minibuffer-completion-table
minibuffer-completion-predicate
- (- (point) (field-beginning))
+ (- (point) start)
md)))
(message nil)
(if (or (null completions)
(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))
(if (memq system-type '(ms-dos windows-nt darwin cygwin))
t nil)
"Non-nil means when reading a file name completion ignores case."
- :group 'minibuffer
:type 'boolean
: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.
completion-in-region-functions (start end collection predicate)
(let ((minibuffer-completion-table collection)
- (minibuffer-completion-predicate predicate)
- (ol (make-overlay start end nil nil t)))
- (overlay-put ol 'field 'completion)
+ (minibuffer-completion-predicate predicate))
;; HACK: if the text we are completing is already in a field, we
;; want the completion field to take priority (e.g. Bug#6830).
- (overlay-put ol 'priority 100)
(when completion-in-region-mode-predicate
- (completion-in-region-mode 1)
(setq completion-in-region--data
- (list (if (markerp start) start (copy-marker start))
- (copy-marker end) collection)))
- ;; FIXME: `minibuffer-complete' should call `completion-in-region' rather
- ;; than the other way around!
- (unwind-protect
- (call-interactively 'minibuffer-complete)
- (delete-overlay ol)))))
+ `(,(if (markerp start) start (copy-marker start))
+ ,(copy-marker end t) ,collection ,predicate))
+ (completion-in-region-mode 1))
+ (completion--in-region-1 start end))))
(defvar completion-in-region-mode-map
(let ((map (make-sparse-keymap)))
"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.
;; (defalias 'completion-in-region--prech 'completion-in-region--postch)
+(defvar completion-in-region-mode nil) ;Explicit defvar, i.s.o defcustom.
+
(define-minor-mode completion-in-region-mode
- "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."
+ "Transient minor mode used during `completion-in-region'."
:global t
:group 'minibuffer
- (setq completion-in-region--data nil)
+ ;; Prevent definition of a custom-variable since it makes no sense to
+ ;; customize this variable.
+ :variable completion-in-region-mode
;; (remove-hook 'pre-command-hook #'completion-in-region--prech)
(remove-hook 'post-command-hook #'completion-in-region--postch)
(setq minor-mode-overriding-map-alist
(delq (assq 'completion-in-region-mode minor-mode-overriding-map-alist)
minor-mode-overriding-map-alist))
(if (null completion-in-region-mode)
- (unless (equal "*Completions*" (buffer-name (window-buffer)))
- (minibuffer-hide-completions))
+ (progn
+ (setq completion-in-region--data nil)
+ (unless (equal "*Completions*" (buffer-name (window-buffer)))
+ (minibuffer-hide-completions)))
;; (add-hook 'pre-command-hook #'completion-in-region--prech)
(cl-assert completion-in-region-mode-predicate)
(setq completion-in-region-mode--predicate
(lambda ()
;; We're still in the same completion field.
(let ((newstart (car-safe (funcall hookfun))))
- (and newstart (= newstart start)))))
- (ol (make-overlay start end nil nil t)))
+ (and newstart (= newstart start))))))
;; FIXME: We should somehow (ab)use completion-in-region-function or
;; introduce a corresponding hook (plus another for word-completion,
;; and another for force-completion, maybe?).
- (overlay-put ol 'field 'completion)
- (overlay-put ol 'priority 100)
- (completion-in-region-mode 1)
(setq completion-in-region--data
- (list start (copy-marker end) collection))
- (unwind-protect
- (call-interactively 'minibuffer-completion-help)
- (delete-overlay ol))))
+ `(,start ,(copy-marker end t) ,collection
+ ,(plist-get plist :predicate)))
+ (completion-in-region-mode 1)
+ (minibuffer-completion-help start end)))
(`(,hookfun . ,_)
;; The hook function already performed completion :-(
;; Not much we can do at this point.
For some commands, exiting with an empty minibuffer has a special meaning,
such as making the current buffer visit no file in the case of
`set-visited-file-name'."
- :group 'minibuffer
:type 'boolean)
;; Not always defined, but only called if next-read-file-uses-dialog-p says so.
(defun read-file-name (prompt &optional dir default-filename mustmatch initial predicate)
"Read file name, prompting with PROMPT and completing in directory DIR.
-Value is not expanded---you must call `expand-file-name' yourself.
+The return value is not expanded---you must call `expand-file-name' yourself.
DIR is the directory to use for completing relative file names.
It should be an absolute directory name, or nil (which means the
;; Refresh other vars.
(completion-pcm--prepare-delim-re value))
:initialize 'custom-initialize-reset
- :group 'minibuffer
:type 'string)
(defcustom completion-pcm-complete-word-inserts-delimiters nil
"Treat the SPC or - inserted by `minibuffer-complete-word' as delimiters.
-Those chars are treated as delimiters iff this variable is non-nil.
+Those chars are treated as delimiters if this variable is non-nil.
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."
(completion-pcm--string->pattern suffix)))
(let* ((pattern nil)
(p 0)
- (p0 p))
+ (p0 p)
+ (pending nil))
(while (and (setq p (string-match completion-pcm--delim-wild-regex
string p))
;; 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)
+ (unless (= p0 p)
+ (if pending (push pending pattern))
+ (push (substring string p0 p) pattern))
+ (setq pending nil)
(if (eq (aref string p) ?*)
(progn
(push 'star pattern)
(setq p0 (1+ p)))
(push 'any pattern)
- (setq p0 p))
- (cl-incf p))
-
+ (if (match-end 1)
+ (setq p0 p)
+ (push (substring string p (match-end 0)) pattern)
+ ;; `any-delim' is used so that "a-b" also finds "array->beginning".
+ (setq pending 'any-delim)
+ (setq p0 (match-end 0))))
+ (setq p p0))
+
+ (when (> (length string) p0)
+ (if pending (push pending pattern))
+ (push (substring string p0) pattern))
;; An empty string might be erroneously added at the beginning.
;; It should be avoided properly, but it's so easy to remove it here.
- (delete "" (nreverse (cons (substring string p0) pattern))))))
+ (delete "" (nreverse pattern)))))
+
+(defun completion-pcm--optimize-pattern (p)
+ ;; Remove empty strings in a separate phase since otherwise a ""
+ ;; might prevent some other optimization, as in '(any "" any).
+ (setq p (delete "" p))
+ (let ((n '()))
+ (while p
+ (pcase p
+ (`(,(and s1 (pred stringp)) ,(and s2 (pred stringp)) . ,rest)
+ (setq p (cons (concat s1 s2) rest)))
+ (`(,(and p1 (pred symbolp)) ,(and p2 (guard (eq p1 p2))) . ,_)
+ (setq p (cdr p)))
+ (`(star ,(pred symbolp) . ,rest) (setq p `(star . ,rest)))
+ (`(,(pred symbolp) star . ,rest) (setq p `(star . ,rest)))
+ (`(point ,(or `any `any-delim) . ,rest) (setq p `(point . ,rest)))
+ (`(,(or `any `any-delim) point . ,rest) (setq p `(point . ,rest)))
+ (`(any ,(or `any `any-delim) . ,rest) (setq p `(any . ,rest)))
+ (`(,(pred symbolp)) (setq p nil)) ;Implicit terminating `any'.
+ (_ (push (pop p) n))))
+ (nreverse n)))
(defun completion-pcm--pattern->regex (pattern &optional group)
(let ((re
(lambda (x)
(cond
((stringp x) (regexp-quote x))
- ((if (consp group) (memq x group) group) "\\(.*?\\)")
- (t ".*?")))
+ (t
+ (let ((re (if (eq x 'any-delim)
+ (concat completion-pcm--delim-wild-regex "*?")
+ ".*?")))
+ (if (if (consp group) (memq x group) group)
+ (concat "\\(" re "\\)")
+ re)))))
pattern
""))))
;; Avoid pathological backtracking.
(setq string (substring string (car bounds) (+ point (cdr bounds))))
(let* ((relpoint (- point (car bounds)))
(pattern (completion-pcm--string->pattern string relpoint))
- (all (condition-case err
+ (all (condition-case-unless-debug err
(funcall filter
(completion-pcm--all-completions
prefix pattern table pred))
- (error (unless firsterror (setq firsterror err)) nil))))
+ (error (setq firsterror err) nil))))
(when (and (null all)
(> (car bounds) 0)
(null (ignore-errors (try-completion prefix table pred))))
(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)