(replace-match rep t t))))
(setq crm-current-separator sep crm-canonical-separator rep)
(crm-highlight-separators (minibuffer-prompt-end) (point-max))
- (when (get-buffer-window "*Completions*" 0)
+ (when (get-buffer-window completions-buffer-name 0)
;; Update *Completions* to avoid stale `completion-base-affixes'.
(minibuffer-completion-help)))
((looking-at (rx (? (group (+ (in " 0<>^_-"))))
(? (group (+ digit)))
(? (group ?. (+ digit)))
- (group alpha)))
+ (group graph)))
(let* ((beg (point))
(end (match-end 0))
(flags (match-string 1))
(completions-predicate-description minibuffer-completion-predicate)
")")))))))
+(defvar-local completions-buffer-name "*Completions*"
+ "Name of the completions list buffer for the current (mini)buffer.")
(defun completion--message (msg)
(if completion-show-inline-help
(completed
(cond
((pcase completion-auto-help
- ('visible (get-buffer-window "*Completions*" 0))
+ ('visible (get-buffer-window completions-buffer-name 0))
('always t))
(minibuffer-completion-help beg end))
(t (minibuffer-hide-completions)
"Toggle completion case-sensitively for the current minibuffer."
(interactive "" minibuffer-mode)
(setq-local completion-ignore-case (not completion-ignore-case))
- (when (get-buffer-window "*Completions*" 0) (minibuffer-completion-help))
+ (when (get-buffer-window completions-buffer-name 0) (minibuffer-completion-help))
(minibuffer-message "Completion is now case-%ssensitive"
(if completion-ignore-case "in" "")))
prompt-end (+ prompt-end base-size))))
(user-error "No partial completion input to restore"))
(completion--replace (+ prompt-end base-size) (point-max) string)
- (when (get-buffer-window "*Completions*" 0)
+ (when (get-buffer-window completions-buffer-name 0)
;; Refresh *Completions* buffer, if already visible.
(minibuffer-completion-help))))
;; Set cycling after modifying the buffer since the flush hook resets it.
(unless dont-cycle
;; If *Completions* is visible, highlight the current candidate.
- (when-let ((win (get-buffer-window "*Completions*" 0))
- (pm (with-current-buffer "*Completions*"
+ (when-let ((win (get-buffer-window completions-buffer-name 0))
+ (pm (with-current-buffer completions-buffer-name
(save-excursion
(goto-char (point-min))
(when-let ((pm (text-property-search-forward
(interactive
(list (let ((styles (completion--styles (completion--field-metadata
(minibuffer-prompt-end))))
- (current (when-let ((buf (get-buffer "*Completions*")))
+ (current (when-let ((buf (get-buffer completions-buffer-name)))
(buffer-local-value 'completions-style buf)))
(enable-recursive-minibuffers t))
(pcase current-prefix-arg
'minibuffer-completion-styles-history)))))))
minibuffer-mode)
(setq-local completion-local-styles styles)
- (when (get-buffer-window "*Completions*" 0)
+ (when (get-buffer-window completions-buffer-name 0)
(minibuffer-completion-help))
(message (format "Using completion style%s `%s'"
(ngettext "" "s" (length styles))
(if ann (list s ann) s)))
completions)))))
(setq minibuffer-scroll-window
- (let ((standard-output (get-buffer-create "*Completions*")))
+ (let ((standard-output (get-buffer-create completions-buffer-name)))
(completions-display
completions
:group-function group-fun
(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.
(interactive)
- (let ((win (get-buffer-window "*Completions*" 0)))
+ (let ((win (get-buffer-window completions-buffer-name 0)))
(if win (with-selected-window win (bury-buffer)))))
(defun exit-minibuffer ()
(setq deactivate-mark nil)
(throw 'exit nil))
-(defun minibuffer-restore-windows ()
- "Restore some windows on exit from minibuffer.
-When `read-minibuffer-restore-windows' is nil, then this function
-added to `minibuffer-exit-hook' will remove at least the window
-that displays the \"*Completions*\" buffer."
- (unless read-minibuffer-restore-windows
- (minibuffer-hide-completions)))
-
-(add-hook 'minibuffer-exit-hook 'minibuffer-restore-windows)
-
(defun minibuffer-quit-recursive-edit (&optional levels)
"Quit the command that requested this recursive edit or minibuffer input.
Do so without terminating keyboard macro recording or execution.
(if (null completion-in-region-mode)
(progn
(setq completion-in-region--data nil)
- (unless (equal "*Completions*" (buffer-name (window-buffer)))
+ (unless (equal completions-buffer-name (buffer-name (window-buffer)))
(minibuffer-hide-completions)))
;; (add-hook 'pre-command-hook #'completion-in-region--prech)
(cl-assert completion-in-region-mode-predicate)
(or (car (minibuffer-completion-action))
(user-error "No applicable action"))
(concat prefix input))
- (when-let ((buf (get-buffer "*Completions*"))
+ (when-let ((buf (get-buffer completions-buffer-name))
(win (get-buffer-window buf 0)))
(with-current-buffer buf
(save-excursion
;; matches from subsequent styles.
nil)
+(defun minibuffer-kill-completions-buffer ()
+ "Kill the *Completions* buffer for this minibuffer."
+ (when-let ((buf (get-buffer completions-buffer-name))) (kill-buffer buf)))
+
\f
(defvar completing-read-function #'completing-read-default
"The function called by `completing-read' to do its work.
It should accept the same arguments as `completing-read'.")
+(defcustom minibuffer-completions-buffer-name-format "*Minibuffer%{%d%} Completions*"
+ "Format string for minibuffer completions list buffer names.
+
+For nested minibuffers, the construct \"%d\" is substituted with the
+current minibuffer depth, \"%{\" is substituted with \"<\", and \"%}?\"
+is substituted with \">\". For regular (non-nested) minibuffers, these
+constructs are all substituted with the empty string.
+
+The resulting string is the buffer name for the completions list buffer
+of the current minibuffer."
+ :version "30.1"
+ :type 'string)
+
(defun completing-read-default (prompt collection &optional predicate
require-match initial-input
hist def inherit-input-method)
(result
(minibuffer-with-setup-hook
(lambda ()
+ (setq-local completions-buffer-name
+ (format-spec
+ minibuffer-completions-buffer-name-format
+ `((?d . ,(let ((md (minibuffer-depth)))
+ (if (equal md 1)
+ ""
+ (number-to-string md))))
+ (?{ . ,(if (< 1 (minibuffer-depth)) "<" ""))
+ (?} . ,(if (< 1 (minibuffer-depth)) ">" "")))))
(setq-local minibuffer-completion-command
(car (last (cons this-command
(function-alias-p this-command)))))
(setq-local minibuffer--require-match require-match)
(setq-local minibuffer--original-buffer buffer)
;; Copy the value from original buffer to the minibuffer.
- (setq-local completion-ignore-case c-i-c))
+ (setq-local completion-ignore-case c-i-c)
+ (add-hook 'minibuffer-exit-hook
+ #'minibuffer-kill-completions-buffer nil t))
(read-from-minibuffer prompt initial-input keymap
nil hist def inherit-input-method))))
(when (and (equal result "") def)
When used in a minibuffer window, select the window with completions,
and execute the forms."
(declare (indent 0) (debug t))
- `(let ((window (or (get-buffer-window "*Completions*" 0)
+ `(let ((window (or (get-buffer-window completions-buffer-name 0)
;; Make sure we have a completions window.
(progn (minibuffer-completion-help)
- (get-buffer-window "*Completions*" 0)))))
+ (get-buffer-window completions-buffer-name 0)))))
(when window
(with-selected-window window
,@body))))
(user-error "No history available"))))
;; FIXME: Can we make it work for CRM?
(let ((completion-in-region-mode-predicate
- (lambda () (get-buffer-window "*Completions*" 0))))
+ (lambda () (get-buffer-window completions-buffer-name 0))))
(completion-in-region
(minibuffer--completion-prompt-end) (point-max)
(completion-table-with-metadata
minibuffer-default (funcall minibuffer-default-add-function)))
(let ((completions (ensure-list minibuffer-default))
(completion-in-region-mode-predicate
- (lambda () (get-buffer-window "*Completions*" 0))))
+ (lambda () (get-buffer-window completions-buffer-name 0))))
(completion-in-region
(minibuffer--completion-prompt-end) (point-max)
(completion-table-with-metadata
(interactive nil minibuffer-mode)
(setq-local completions-exclude-exceptional-candidates
(not completions-exclude-exceptional-candidates))
- (when (get-buffer-window "*Completions*" 0) (minibuffer-completion-help))
+ (when (get-buffer-window completions-buffer-name 0)
+ (minibuffer-completion-help))
(minibuffer-message "Completion now %scludes exceptional canddiates"
(if completions-exclude-exceptional-candidates
"ex" "in")))
(interactive nil minibuffer-mode)
(setq-local minibuffer-completion-annotations
(not minibuffer-completion-annotations))
- (when (get-buffer-window "*Completions*" 0) (minibuffer-completion-help)))
+ (when (get-buffer-window completions-buffer-name 0)
+ (minibuffer-completion-help)))
(defun minibuffer-widen-completions (&optional all)
"Remove restrictions on current minibuffer completions list.
(defun completions-auto-update ()
"Update the *Completions* buffer, if it is visible."
- (when (get-buffer-window "*Completions*" 0)
+ (when (get-buffer-window completions-buffer-name 0)
;; Preserve current `completion--input'.
(let ((completion--input completion--input))
(if completion-in-region-mode
(defun completions-auto-update-start-timer ()
"Start an idle timer for updating *Completions*."
(and (null completions-auto-update-timer)
- (get-buffer-window "*Completions*" 0)
+ (get-buffer-window completions-buffer-name 0)
(setq completions-auto-update-timer
(run-with-idle-timer completions-auto-update-idle-time
nil #'completions-auto-update))))
(unless (or (timerp minibuffer-hint-timer)
;; Let `completions-auto-update-mode' do its thing.
(and completions-auto-update-mode
- (get-buffer-window "*Completions*" 0)))
+ (get-buffer-window completions-buffer-name 0)))
(setq minibuffer-hint-timer
(run-with-idle-timer minibuffer-hint-idle-time
nil (minibuffer-hint-fn (current-buffer))))))
(defun switch-to-completions ()
"Select the completion list window."
(interactive)
- (when-let ((window (or (get-buffer-window "*Completions*" 0)
+ (when-let ((window (or (get-buffer-window completions-buffer-name 0)
;; Make sure we have a completions window.
(progn (minibuffer-completion-help)
- (get-buffer-window "*Completions*" 0)))))
+ (get-buffer-window completions-buffer-name 0)))))
(select-window window)
(when (bobp)
(cond
'("a" "ab" "ac")
(execute-kbd-macro (kbd "a TAB TAB"))
(should (equal (car messages) "Complete, but not unique"))
- (should-not (get-buffer-window "*Completions*" 0))
+ (should-not (get-buffer-window completions-buffer-name 0))
(execute-kbd-macro (kbd "b TAB"))
(should (equal (car messages) "Sole completion"))))
(let ((completion-auto-help t))
(completing-read-with-minibuffer-setup
'("a" "ab" "ac")
(execute-kbd-macro (kbd "a TAB TAB"))
- (should (get-buffer-window "*Completions*" 0))
+ (should (get-buffer-window completions-buffer-name 0))
(execute-kbd-macro (kbd "b TAB"))
(should (equal (car messages) "Sole completion"))))
(let ((completion-auto-help 'visible))
(completing-read-with-minibuffer-setup
'("a" "ab" "ac" "achoo")
(execute-kbd-macro (kbd "a TAB TAB"))
- (should (get-buffer-window "*Completions*" 0))
+ (should (get-buffer-window completions-buffer-name 0))
(execute-kbd-macro (kbd "ch TAB"))
(should (equal (car messages) "Sole completion")))))))
(completing-read-with-minibuffer-setup
'("aa" "ab" "ac")
(execute-kbd-macro (kbd "a TAB"))
- (should (and (get-buffer-window "*Completions*" 0)
- (eq (current-buffer) (get-buffer "*Completions*"))))
+ (should (and completion-reference-buffer
+ (get-buffer-window (buffer-local-value 'completions-buffer-name
+ completion-reference-buffer)
+ 0)
+ (eq (current-buffer)
+ (get-buffer (buffer-local-value 'completions-buffer-name
+ completion-reference-buffer)))))
(execute-kbd-macro (kbd "TAB TAB TAB"))
- (should (and (get-buffer-window "*Completions*" 0)
+ (should (and (get-buffer-window completions-buffer-name 0)
(eq (current-buffer) (get-buffer " *Minibuf-1*"))))
(execute-kbd-macro (kbd "S-TAB"))
- (should (and (get-buffer-window "*Completions*" 0)
- (eq (current-buffer) (get-buffer "*Completions*"))))))
+ (should (and completion-reference-buffer
+ (get-buffer-window (buffer-local-value 'completions-buffer-name
+ completion-reference-buffer)
+ 0)
+ (eq (current-buffer)
+ (get-buffer (buffer-local-value 'completions-buffer-name
+ completion-reference-buffer)))))))
(let ((completion-auto-select 'second-tab))
(completing-read-with-minibuffer-setup
'("aa" "ab" "ac")
(execute-kbd-macro (kbd "a TAB"))
- (should (and (get-buffer-window "*Completions*" 0)
- (not (eq (current-buffer) (get-buffer "*Completions*")))))
+ (should (and (get-buffer-window completions-buffer-name 0)
+ (not (eq (current-buffer) (get-buffer completions-buffer-name)))))
(execute-kbd-macro (kbd "TAB TAB"))
- (should (eq (current-buffer) (get-buffer "*Completions*"))))))
+ (should (and completion-reference-buffer
+ (get-buffer-window (buffer-local-value 'completions-buffer-name
+ completion-reference-buffer)
+ 0)
+ (eq (current-buffer)
+ (get-buffer (buffer-local-value 'completions-buffer-name
+ completion-reference-buffer))))))))
(ert-deftest completion-auto-wrap-test ()
(let ((completion-auto-wrap nil))
(tramp--test-deftest-with-ls tramp-test26-file-name-completion)
-;; This test is inspired by Bug#51386, Bug#52758, Bug#53513, Bug#54042
-;; and Bug#60505.
-(ert-deftest tramp-test26-interactive-file-name-completion ()
- "Check interactive completion with different `completion-styles'."
- ;; Method, user and host name in completion mode.
- (tramp-cleanup-connection tramp-test-vec nil 'keep-password)
-
- (let ((method (file-remote-p ert-remote-temporary-file-directory 'method))
- (user (file-remote-p ert-remote-temporary-file-directory 'user))
- (host (file-remote-p ert-remote-temporary-file-directory 'host))
- (hop (file-remote-p ert-remote-temporary-file-directory 'hop))
- (orig-syntax tramp-syntax)
- (non-essential t)
- (inhibit-message t))
- (when (and (stringp host) (string-match tramp-host-with-port-regexp host))
- (setq host (match-string 1 host)))
-
- ;; (trace-function #'tramp-completion-file-name-handler)
- ;; (trace-function #'completion-file-name-table)
- (unwind-protect
- (dolist (syntax (if (tramp--test-expensive-test-p)
- (tramp-syntax-values) `(,orig-syntax)))
- (tramp-change-syntax syntax)
- ;; This has cleaned up all connection data, which are used
- ;; for completion. We must refill the cache.
- (tramp-set-connection-property tramp-test-vec "property" nil)
-
- (dolist
- (style
- (if (tramp--test-expensive-test-p)
- ;; It doesn't work for `initials' and `shorthand'
- ;; completion styles. Should it?
- ;; `orderless' passes the tests, but it is an ELPA package.
- '(emacs21 emacs22 basic partial-completion substring flex)
- '(basic)))
-
- (when (assoc style completion-styles-alist)
- (let* (;; Force the real minibuffer in batch mode.
- (executing-kbd-macro noninteractive)
- (completion-styles `(,style))
- completion-category-defaults
- completion-category-overrides
- ;; This is needed for the `simplified' syntax,
- (tramp-default-method method)
- (method-string
- (unless (string-empty-p tramp-method-regexp)
- (concat method tramp-postfix-method-format)))
- (user-string
- (unless (tramp-string-empty-or-nil-p user)
- (concat user tramp-postfix-user-format)))
- ;; This is needed for the IPv6 host name syntax.
- (ipv6-prefix
- (and (string-match-p tramp-ipv6-regexp host)
- tramp-prefix-ipv6-format))
- (ipv6-postfix
- (and (string-match-p tramp-ipv6-regexp host)
- tramp-postfix-ipv6-format))
- (host-string
- (unless (tramp-string-empty-or-nil-p host)
- (concat
- ipv6-prefix host
- ipv6-postfix tramp-postfix-host-format)))
- ;; The hop string fits only the initial syntax.
- (hop (and (eq tramp-syntax orig-syntax) hop))
- test result completions)
-
- (dolist
- (test-and-result
- ;; These are triples of strings (TEST-STRING
- ;; RESULT-CHECK COMPLETION-CHECK). RESULT-CHECK
- ;; could be not unique, in this case it is a list
- ;; (RESULT1 RESULT2 ...).
- (append
- ;; Complete method name.
- (unless (string-empty-p tramp-method-regexp)
- `((,(concat
- tramp-prefix-format hop
- (substring-no-properties
- method 0 (min 2 (length method))))
- ,(concat tramp-prefix-format hop method-string)
- ,method-string)))
- ;; Complete user name.
- (unless (tramp-string-empty-or-nil-p user)
- `((,(concat
- tramp-prefix-format hop method-string
- (substring-no-properties
- user 0 (min 2 (length user))))
- ,(concat
- tramp-prefix-format hop method-string user-string)
- ,user-string)))
- ;; Complete host name.
- (unless (tramp-string-empty-or-nil-p host)
- `((,(concat
- tramp-prefix-format hop method-string
- ipv6-prefix
- (substring-no-properties
- host 0 (min 2 (length host))))
- (,(concat
- tramp-prefix-format hop method-string host-string)
- ,(concat
- tramp-prefix-format hop method-string
- user-string host-string))
- ,host-string)))
- ;; Complete user and host name.
- (unless (or (tramp-string-empty-or-nil-p user)
- (tramp-string-empty-or-nil-p host))
- `((,(concat
- tramp-prefix-format hop method-string user-string
- ipv6-prefix
- (substring-no-properties
- host 0 (min 2 (length host))))
- ,(concat
- tramp-prefix-format hop method-string
- user-string host-string)
- ,host-string)))))
-
- (ignore-errors (kill-buffer "*Completions*"))
- ;; (and (bufferp trace-buffer) (kill-buffer trace-buffer))
- (discard-input)
- (setq test (car test-and-result)
- unread-command-events
- (mapcar #'identity (concat test "\t\t\r"))
- completions nil
- result (read-file-name "Prompt: "))
-
- (if (or (not (get-buffer "*Completions*"))
- (string-match-p
- (if (string-empty-p tramp-method-regexp)
- (rx
- (| (regexp tramp-postfix-user-regexp)
- (regexp tramp-postfix-host-regexp))
- eos)
- (rx
- (| (regexp tramp-postfix-method-regexp)
- (regexp tramp-postfix-user-regexp)
- (regexp tramp-postfix-host-regexp))
- eos))
- result))
- (progn
- ;; (tramp--test-message
- ;; "syntax: %s style: %s test: %s result: %s"
- ;; syntax style test result)
- (if (stringp (cadr test-and-result))
- (should
- (string-prefix-p (cadr test-and-result) result))
- (should
- (let (res)
- (dolist (elem (cadr test-and-result) res)
- (setq
- res (or res (string-prefix-p elem result))))))))
-
- (with-current-buffer "*Completions*"
- ;; We must remove leading `default-directory'.
- (goto-char (point-min))
- (let ((inhibit-read-only t))
- (while (search-forward-regexp "//" nil 'noerror)
- (delete-region (line-beginning-position) (point))))
- (goto-char (point-min))
- (search-forward-regexp
- (rx bol (0+ nonl)
- (any "Pp") "ossible completions"
- (0+ nonl) eol))
- (forward-line 1)
- (setq completions
- (split-string
- (buffer-substring-no-properties (point) (point-max))
- (rx (any "\r\n\t ")) 'omit)))
-
- ;; (tramp--test-message
- ;; "syntax: %s style: %s test: %s result: %s completions: %S"
- ;; syntax style test result completions)
- (should (member (caddr test-and-result) completions))))))))
-
- ;; Cleanup.
- ;; (tramp--test-message "%s" (tramp-get-buffer-string trace-buffer))
- ;; (untrace-function #'tramp-completion-file-name-handler)
- ;; (untrace-function #'completion-file-name-table)
- (tramp-change-syntax orig-syntax))))
-
(ert-deftest tramp-test27-load ()
"Check `load'."
(skip-unless (tramp--test-enabled))
projects / emacs.git / commitdiff