;;; minibuffer.el --- Minibuffer completion functions -*- lexical-binding: t -*-
-;; Copyright (C) 2008-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Package: emacs
;;; Todo:
+;; - Make *Completions* readable even if some of the completion
+;; entries have LF chars or spaces in them (including at
+;; beginning/end) or are very long.
;; - for M-x, cycle-sort commands that have no key binding first.
;; - Make things like icomplete-mode or lightning-completion work with
;; completion-in-region-mode.
;; - whether the user wants completion to pay attention to case.
;; e.g. we may want to make it possible for the user to say "first try
;; completion case-sensitively, and if that fails, try to ignore case".
+;; Maybe the trick is that we should distinguish completion-ignore-case in
+;; try/all-completions (obey user's preference) from its use in
+;; test-completion (obey the underlying object's semantics).
;; - add support for ** to pcm.
;; - Add vc-file-name-completion-table to read-file-name-internal.
;; that `concat' and `unquote' commute (which tends to be the case).
;; And we ask `requote' to do the work of mapping from unquoted positions
;; back to quoted positions.
+ ;; FIXME: For some forms of "quoting" such as the truncation behavior of
+ ;; substitute-in-file-name, it would be desirable not to requote completely.
"Return a new completion table operating on quoted text.
TABLE operates on the unquoted text.
UNQUOTE is a function that takes a string and returns a new unquoted string.
(eq t (compare-strings s1 nil nil s2 nil nil 'ignore-case)))
(defun completion--twq-all (string ustring completions boundary
- unquote requote)
+ _unquote requote)
(when completions
(pcase-let*
((prefix
(`(,qfullpos . ,qfun)
(funcall requote (+ boundary (length prefix)) string))
(qfullprefix (substring string 0 qfullpos))
- (_ (cl-assert (completion--string-equal-p
- (funcall unquote qfullprefix)
- (concat (substring ustring 0 boundary) prefix))
- t))
+ ;; FIXME: This assertion can be wrong, e.g. in Cygwin, where
+ ;; (unquote "c:\bin") => "/usr/bin" but (unquote "c:\") => "/".
+ ;;(cl-assert (completion--string-equal-p
+ ;; (funcall unquote qfullprefix)
+ ;; (concat (substring ustring 0 boundary) prefix))
+ ;; t))
(qboundary (car (funcall requote boundary string)))
(_ (cl-assert (<= qboundary qfullpos)))
;; FIXME: this split/quote/concat business messes up the carefully
(let* ((new (substring completion (length prefix)))
(qnew (funcall qfun new))
(qcompletion (concat qprefix qnew)))
- (cl-assert
- (completion--string-equal-p
- (funcall unquote
- (concat (substring string 0 qboundary)
- qcompletion))
- (concat (substring ustring 0 boundary)
- completion))
- t)
+ ;; FIXME: Similarly here, Cygwin's mapping trips this
+ ;; assertion.
+ ;;(cl-assert
+ ;; (completion--string-equal-p
+ ;; (funcall unquote
+ ;; (concat (substring string 0 qboundary)
+ ;; qcompletion))
+ ;; (concat (substring ustring 0 boundary)
+ ;; completion))
+ ;; t)
qcompletion))
completions)
qboundary))))
(defun minibuffer-completion-contents ()
"Return the user input in a minibuffer before point as a string.
-That is what completion commands operate on."
+In Emacs-22, that was what completion commands operated on."
+ (declare (obsolete nil "24.4"))
(buffer-substring (field-beginning) (point)))
(defun delete-minibuffer-contents ()
"Delete all user input in a minibuffer.
If the current buffer is not a minibuffer, erase its entire contents."
+ (interactive)
;; 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)))
(const buffer)
(const file)
(const unicode-name)
+ (const bookmark)
symbol)
:value-type
(set :tag "Properties to override"
like `minibuffer-force-complete'.
If nil, cycling is never used.
If t, cycling is always used.
-If an integer, cycling is used as soon as there are fewer completion
-candidates than this number."
+If an integer, cycling is used so long as there are not more
+completion candidates than this number."
:version "24.1"
:type completion--cycling-threshold-type)
(defvar completion-all-sorted-completions nil)
(make-variable-buffer-local 'completion-all-sorted-completions)
+(defvar-local completion--all-sorted-completions-location nil)
(defvar completion-cycling nil)
(defvar completion-fail-discreetly nil
;; This signal an (intended) error if comps is too
;; short or if completion-cycle-threshold is t.
(consp (nthcdr threshold comps)))))
- ;; Fewer than completion-cycle-threshold remaining
+ ;; Not more than completion-cycle-threshold remaining
;; completions: let's cycle.
(setq completed t exact t)
(completion--cache-all-sorted-completions comps)
(cond
;; If there's a fresh completion window with a live buffer,
;; and this command is repeated, scroll that window.
- ((window-live-p minibuffer-scroll-window)
+ ((and (window-live-p minibuffer-scroll-window)
+ (eq t (frame-visible-p (window-frame minibuffer-scroll-window))))
(let ((window minibuffer-scroll-window))
(with-current-buffer (window-buffer window)
(if (pos-visible-in-window-p (point-max) window)
(defun completion--cache-all-sorted-completions (comps)
(add-hook 'after-change-functions
- 'completion--flush-all-sorted-completions nil t)
+ 'completion--flush-all-sorted-completions nil t)
+ (setq completion--all-sorted-completions-location
+ (cons (copy-marker (field-beginning)) (copy-marker (field-end))))
(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)
- (setq completion-cycling nil)
- (setq completion-all-sorted-completions nil))
+(defun completion--flush-all-sorted-completions (&optional start end _len)
+ (unless (and start end
+ (or (> start (cdr completion--all-sorted-completions-location))
+ (< end (car completion--all-sorted-completions-location))))
+ (remove-hook 'after-change-functions
+ 'completion--flush-all-sorted-completions t)
+ (setq completion-cycling nil)
+ (setq completion-all-sorted-completions nil)))
(defun completion--metadata (string base md-at-point table pred)
;; Like completion-metadata, but for the specific case of getting the
(sort-fun (completion-metadata-get all-md 'cycle-sort-function)))
(when last
(setcdr last nil)
+
+ ;; Delete duplicates: do it after setting last's cdr to nil (so
+ ;; it's a proper list), and be careful to reset `last' since it
+ ;; may be a different cons-cell.
+ (setq all (delete-dups all))
+ (setq last (last all))
+
(setq all (if sort-fun (funcall sort-fun all)
;; Prefer shorter completions, by default.
(sort all (lambda (c1 c2) (< (length c1) (length c2))))))
;; all possibilities.
(completion--cache-all-sorted-completions (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"))))
+
(defun minibuffer-force-complete ()
"Complete the minibuffer to an exact match.
Repeated uses step through the possible completions."
(interactive)
+ (setq minibuffer-scroll-window nil)
;; 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 (field-beginning))
+ (let* ((start (copy-marker (field-beginning)))
(end (field-end))
;; (md (completion--field-metadata start))
(all (completion-all-sorted-completions))
(completion--message
(if all "No more completions" "No completions")))
((not (consp (cdr all)))
- (let ((mod (equal (car all) (buffer-substring-no-properties base end))))
- (if mod (completion--replace base end (car all)))
+ (let ((done (equal (car all) (buffer-substring-no-properties base end))))
+ (unless done (completion--replace base end (car all)))
(completion--done (buffer-substring-no-properties start (point))
- 'finished (unless mod "Sole completion"))))
+ 'finished (when done "Sole completion"))))
(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)
+ (setq this-command 'completion-at-point) ;For minibuffer-complete.
;; 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 (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).
+ (let* ((table minibuffer-completion-table)
+ (pred minibuffer-completion-predicate)
+ (extra-prop completion-extra-properties)
+ (cmd
+ (lambda () "Cycle through the possible completions."
+ (interactive)
+ (let ((completion-extra-properties extra-prop))
+ (completion-in-region start (point) table pred)))))
+ (set-temporary-overlay-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [remap completion-at-point] cmd)
+ (define-key map (vector last-command-event) cmd)
+ map)))))))
(defvar minibuffer-confirm-exit-commands
'(completion-at-point minibuffer-complete
`minibuffer-confirm-exit-commands', and accept the input
otherwise."
(interactive)
+ (minibuffer--complete-and-exit
+ (lambda ()
+ (pcase (condition-case nil
+ (completion--do-completion nil 'expect-exact)
+ (error 1))
+ ((or #b001 #b011) (exit-minibuffer))
+ (#b111 (if (not minibuffer-completion-confirm)
+ (exit-minibuffer)
+ (minibuffer-message "Confirm")
+ nil))
+ (_ nil)))))
+
+(defun minibuffer--complete-and-exit (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
(t
;; Call do-completion, but ignore errors.
- (pcase (condition-case nil
- (completion--do-completion nil 'expect-exact)
- (error 1))
- ((or #b001 #b011) (exit-minibuffer))
- (#b111 (if (not minibuffer-completion-confirm)
- (exit-minibuffer)
- (minibuffer-message "Confirm")
- nil))
- (_ nil))))))
+ (funcall completion-function)))))
(defun completion--try-word-completion (string table predicate point md)
(let ((comp (completion-try-completion string table predicate point md)))
'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)))
+ (let ((beg (point))
+ (end (progn (insert (cadr str)) (point))))
+ (put-text-property beg end 'mouse-face nil)
+ (font-lock-prepend-text-property beg end 'face
+ 'completions-annotations)))
(cond
((eq completions-format 'vertical)
;; Vertical format
(defface completions-first-difference
'((t (:inherit bold)))
- "Face put on the first uncommon character in completions in *Completions* buffer."
+ "Face added on the first uncommon character in completions in *Completions* buffer."
:group 'completion)
-(defface completions-common-part
- '((t (:inherit default)))
- "Face put on the common prefix substring in completions in *Completions* buffer.
+(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."
(car (setq elem (cons (copy-sequence (car elem))
(cdr elem))))
(setq elem (copy-sequence elem)))))
- (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)
+ (font-lock-prepend-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))
+ 'face 'completions-common-part str)
(if (> (length str) com-str-len)
- (put-text-property com-str-len (1+ com-str-len)
- 'font-lock-face 'completions-first-difference
- str)))
+ (font-lock-prepend-text-property com-str-len (1+ com-str-len)
+ 'face
+ 'completions-first-difference
+ str)))
elem)
completions)
base-size))))
(let* ((exit-fun (plist-get completion-extra-properties :exit-function))
(pre-msg (and exit-fun (current-message))))
(cl-assert (memq finished '(exact sole finished unknown)))
- ;; FIXME: exit-fun should receive `finished' as a parameter.
(when exit-fun
(when (eq finished 'unknown)
(setq finished
(exit-minibuffer))
(defvar completion-in-region-functions nil
- "Wrapper hook around `completion-in-region'.
-The functions on this special hook are called with 5 arguments:
- NEXT-FUN START END COLLECTION PREDICATE.
-NEXT-FUN is a function of four arguments (START END COLLECTION PREDICATE)
-that performs the default operation. The other four arguments are like
-the ones passed to `completion-in-region'. The functions on this hook
-are expected to perform completion on START..END using COLLECTION
-and PREDICATE, either by calling NEXT-FUN or by doing it themselves.")
+ "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
+`completion-in-region'.")
(defvar completion-in-region--data nil)
PREDICATE (a function called with no arguments) says when to
exit."
(cl-assert (<= start (point)) (<= (point) end))
+ (funcall completion-in-region-function start end collection predicate))
+
+(defun completion--in-region (start end collection &optional predicate)
(with-wrapper-hook
;; FIXME: Maybe we should use this hook to provide a "display
;; completions" operation as well.
(when completion-in-region-mode-predicate
(completion-in-region-mode 1)
(setq completion-in-region--data
- (list (current-buffer) start end collection)))
+ (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)))))
(or unread-command-events ;Don't pop down the completions in the middle of
;mouse-drag-region/mouse-set-point.
(and completion-in-region--data
- (and (eq (car completion-in-region--data)
+ (and (eq (marker-buffer (nth 0 completion-in-region--data))
(current-buffer))
- (>= (point) (nth 1 completion-in-region--data))
+ (>= (point) (nth 0 completion-in-region--data))
(<= (point)
(save-excursion
- (goto-char (nth 2 completion-in-region--data))
+ (goto-char (nth 1 completion-in-region--data))
(line-end-position)))
(funcall completion-in-region-mode--predicate)))
(completion-in-region-mode -1)))
(let ((res (run-hook-wrapped 'completion-at-point-functions
#'completion--capf-wrapper 'all)))
(pcase res
- (`(,_ . ,(and (pred functionp) f)) (funcall f))
- (`(,hookfun . (,start ,end ,collection . ,plist))
- (let* ((completion-extra-properties plist)
- (completion-in-region-mode-predicate
- (lambda ()
- ;; We're still in the same completion field.
- (eq (car-safe (funcall hookfun)) start))))
- (completion-in-region start end collection
- (plist-get plist :predicate))))
- ;; Maybe completion already happened and the function returned t.
- (_ (cdr res)))))
+ (`(,_ . ,(and (pred functionp) f)) (funcall f))
+ (`(,hookfun . (,start ,end ,collection . ,plist))
+ (unless (markerp start) (setq start (copy-marker start)))
+ (let* ((completion-extra-properties plist)
+ (completion-in-region-mode-predicate
+ (lambda ()
+ ;; We're still in the same completion field.
+ (let ((newstart (car-safe (funcall hookfun))))
+ (and newstart (= newstart start))))))
+ (completion-in-region start end collection
+ (plist-get plist :predicate))))
+ ;; Maybe completion already happened and the function returned t.
+ (_ (cdr res)))))
(defun completion-help-at-point ()
"Display the completions on the text around point.
(pcase res
(`(,_ . ,(and (pred functionp) f))
(message "Don't know how to show completions for %S" f))
- (`(,hookfun . (,start ,end ,collection . ,plist))
- (let* ((minibuffer-completion-table collection)
- (minibuffer-completion-predicate (plist-get plist :predicate))
- (completion-extra-properties plist)
- (completion-in-region-mode-predicate
- (lambda ()
- ;; We're still in the same completion field.
- (eq (car-safe (funcall hookfun)) start)))
- (ol (make-overlay start end nil nil t)))
- ;; 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 (current-buffer) start end collection))
- (unwind-protect
- (call-interactively 'minibuffer-completion-help)
- (delete-overlay ol))))
- (`(,hookfun . ,_)
- ;; The hook function already performed completion :-(
- ;; Not much we can do at this point.
- (message "%s already performed completion!" hookfun)
- nil)
- (_ (message "Nothing to complete at point")))))
+ (`(,hookfun . (,start ,end ,collection . ,plist))
+ (unless (markerp start) (setq start (copy-marker start)))
+ (let* ((minibuffer-completion-table collection)
+ (minibuffer-completion-predicate (plist-get plist :predicate))
+ (completion-extra-properties plist)
+ (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)))
+ ;; 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))))
+ (`(,hookfun . ,_)
+ ;; The hook function already performed completion :-(
+ ;; Not much we can do at this point.
+ (message "%s already performed completion!" hookfun)
+ nil)
+ (_ (message "Nothing to complete at point")))))
;;; Key bindings.
(define-key map "i" 'info)
(define-key map "m" 'mail)
(define-key map "n" 'make-frame)
- (define-key map [mouse-1] (lambda () (interactive)
- (with-current-buffer "*Messages*"
- (goto-char (point-max))
- (display-buffer (current-buffer)))))
+ (define-key map [mouse-1] 'view-echo-area-messages)
;; So the global down-mouse-1 binding doesn't clutter the execution of the
;; above mouse-1 binding.
(define-key map [down-mouse-1] #'ignore)
process-environment))
(defconst completion--embedded-envvar-re
+ ;; We can't reuse env--substitute-vars-regexp because we need to match only
+ ;; potentially-unfinished envvars at end of string.
(concat "\\(?:^\\|[^$]\\(?:\\$\\$\\)*\\)"
"$\\([[:alnum:]_]*\\|{\\([^}]*\\)\\)\\'"))
"use the regular PRED argument" "23.2")
(defun completion--sifn-requote (upos qstr)
- ;; We're looking for `qupos' such that:
+ ;; We're looking for `qpos' such that:
;; (equal (substring (substitute-in-file-name qstr) 0 upos)
- ;; (substitute-in-file-name (substring qstr 0 qupos)))
+ ;; (substitute-in-file-name (substring qstr 0 qpos)))
;; Big problem here: we have to reverse engineer substitute-in-file-name to
;; find the position corresponding to UPOS in QSTR, but
;; substitute-in-file-name can do anything, depending on file-name-handlers.
+ ;; substitute-in-file-name does the following kind of things:
+ ;; - expand env-var references.
+ ;; - turn backslashes into slashes.
+ ;; - truncate some prefix of the input.
+ ;; - rewrite some prefix.
+ ;; Some of these operations are written in external libraries and we'd rather
+ ;; not hard code any assumptions here about what they actually do. IOW, we
+ ;; want to treat substitute-in-file-name as a black box, as much as possible.
;; Kind of like in rfn-eshadow-update-overlay, only worse.
- ;; FIXME: example of thing we do not handle: Tramp's makes
- ;; (substitute-in-file-name "/foo:~/bar//baz") -> "/scpc:foo:/baz".
- ;; FIXME: One way to try and handle "all" cases is to require
- ;; substitute-in-file-name to preserve text-properties, so we could
- ;; apply text-properties to the input string and then look for them in
- ;; the output to understand what comes from where.
- (let ((qpos 0))
- ;; Handle substitute-in-file-name's truncation behavior.
- (let (tpos)
- (while (and (string-match "[\\/][~/\\]" qstr qpos)
- ;; Hopefully our regexp covers all truncation cases.
- ;; Also let's make sure sifn indeed truncates here.
+ ;; Example of things we need to handle:
+ ;; - Tramp (substitute-in-file-name "/foo:~/bar//baz") => "/scpc:foo:/baz".
+ ;; - Cygwin (substitute-in-file-name "C:\bin") => "/usr/bin"
+ ;; (substitute-in-file-name "C:\") => "/"
+ ;; (substitute-in-file-name "C:\bi") => "/bi"
+ (let* ((ustr (substitute-in-file-name qstr))
+ (uprefix (substring ustr 0 upos))
+ qprefix)
+ ;; Main assumption: nothing after qpos should affect the text before upos,
+ ;; so we can work our way backward from the end of qstr, one character
+ ;; at a time.
+ ;; Second assumptions: If qpos is far from the end this can be a bit slow,
+ ;; so we speed it up by doing a first loop that skips a word at a time.
+ ;; This word-sized loop is careful not to cut in the middle of env-vars.
+ (while (let ((boundary (string-match "\\(\\$+{?\\)?\\w+\\W*\\'" qstr)))
+ (and boundary
(progn
- (setq tpos (1+ (match-beginning 0)))
- (equal (substitute-in-file-name qstr)
- (substitute-in-file-name (substring qstr tpos)))))
- (setq qpos tpos)))
- ;; `upos' is relative to the position corresponding to `qpos' in
- ;; (substitute-in-file-name qstr), so as qpos moves forward, upos
- ;; gets smaller.
- (while (and (> upos 0)
- (string-match "\\$\\(\\$\\|\\([[:alnum:]_]+\\|{[^}]*}\\)\\)?"
- qstr qpos))
- (cond
- ((>= (- (match-beginning 0) qpos) upos) ; UPOS is before current match.
- (setq qpos (+ qpos upos))
- (setq upos 0))
- ((not (match-end 1)) ;A sole $: probably an error.
- (setq upos (- upos (- (match-end 0) qpos)))
- (setq qpos (match-end 0)))
- (t
- (setq upos (- upos (- (match-beginning 0) qpos)))
- (setq qpos (match-end 0))
- (setq upos (- upos (length (substitute-in-file-name
- (match-string 0 qstr))))))))
- ;; If `upos' is negative, it's because it's within the expansion of an
- ;; envvar, i.e. there is no exactly matching qpos, so we just use the next
- ;; available qpos right after the envvar.
- (cons (if (>= upos 0) (+ qpos upos) qpos)
- #'minibuffer--double-dollars)))
+ (setq qprefix (substring qstr 0 boundary))
+ (string-prefix-p uprefix
+ (substitute-in-file-name qprefix)))))
+ (setq qstr qprefix))
+ (let ((qpos (length qstr)))
+ (while (and (> qpos 0)
+ (string-prefix-p uprefix
+ (substitute-in-file-name
+ (substring qstr 0 (1- qpos)))))
+ (setq qpos (1- qpos)))
+ (cons qpos #'minibuffer--double-dollars))))
(defalias 'completion--file-name-table
(completion-table-with-quoting #'completion-file-name-table
(modify-syntax-entry c "." table))
'(?/ ?: ?\\))
table)
- "Syntax table to be used in minibuffer for reading file name.")
+ "Syntax table used when reading a file name in the minibuffer.")
;; minibuffer-completing-file-name is a variable used internally in minibuf.c
;; to determine whether to use minibuffer-local-filename-completion-map or
;; here any more.
(unless unique
(push elem res)
- (when (memq elem '(star point prefix))
- ;; Extract common suffix additionally to common prefix.
- ;; Only do it for `point', `star', and `prefix' since for
- ;; `any' it could lead to a merged completion that
- ;; doesn't itself match the candidates.
- (let ((suffix (completion--common-suffix comps)))
+ ;; Extract common suffix additionally to common prefix.
+ ;; Don't do it for `any' since it could lead to a merged
+ ;; completion that doesn't itself match the candidates.
+ (when (and (memq elem '(star point prefix))
+ ;; If prefix is one of the completions, there's no
+ ;; suffix left to find.
+ (not (assoc-string prefix comps t)))
+ (let ((suffix
+ (completion--common-suffix
+ (if (zerop (length prefix)) comps
+ ;; Ignore the chars in the common prefix, so we
+ ;; don't merge '("abc" "abbc") as "ab*bc".
+ (let ((skip (length prefix)))
+ (mapcar (lambda (str) (substring str skip))
+ comps))))))
(cl-assert (stringp suffix))
(unless (equal suffix "")
(push suffix res)))))