From 8cbb3b93a8dfdcf702f8528da9eea63e5b539de8 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Fri, 5 Apr 2024 10:43:10 +0200 Subject: [PATCH] Use different *Completions* buffers in different minibuffers --- lisp/emacs-lisp/crm.el | 2 +- lisp/format-spec.el | 2 +- lisp/minibuffer.el | 86 +++++++++------- lisp/simple.el | 4 +- test/lisp/minibuffer-tests.el | 38 +++++--- test/lisp/net/tramp-tests.el | 179 ---------------------------------- 6 files changed, 84 insertions(+), 227 deletions(-) diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index fc039d40d2a..3bf0f0cfc6e 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -198,7 +198,7 @@ for REP as well." (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))) diff --git a/lisp/format-spec.el b/lisp/format-spec.el index 73f9fccd793..1b55a05ab8f 100644 --- a/lisp/format-spec.el +++ b/lisp/format-spec.el @@ -99,7 +99,7 @@ is returned, where each format spec is its own element." ((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)) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 139610d64d3..e3128b80bba 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1634,6 +1634,8 @@ it with \\[kill-region]." (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 @@ -1740,7 +1742,7 @@ when the buffer's text is already an exact match." (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) @@ -2030,7 +2032,7 @@ include as `sort-function' in completion metadata." "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" ""))) @@ -2102,7 +2104,7 @@ Interactively, ARG is the prefix argument, and it defaults to 1." 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)))) @@ -2137,8 +2139,8 @@ DONT-CYCLE tells the function not to setup cycling." ;; 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 @@ -2913,7 +2915,7 @@ completions list." (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 @@ -2942,7 +2944,7 @@ completions list." '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)) @@ -3107,7 +3109,7 @@ completions list." (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 @@ -3248,10 +3250,8 @@ function as described in the documentation of `completion-metadata'." (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 () @@ -3271,16 +3271,6 @@ function as described in the documentation of `completion-metadata'." (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. @@ -3415,7 +3405,7 @@ Also respects the obsolete wrapper hook `completion-in-region-functions'. (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) @@ -4376,7 +4366,7 @@ possible completions." (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 @@ -5386,11 +5376,28 @@ which is at the core of flex logic. The extra ;; 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))) + (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) @@ -5412,6 +5419,15 @@ See `completing-read' for the meaning of the arguments." (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))))) @@ -5423,7 +5439,9 @@ See `completing-read' for the meaning of the arguments." (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) @@ -5513,10 +5531,10 @@ the minibuffer was activated, and execute the forms." 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)))) @@ -5614,7 +5632,7 @@ instead of the default completion table." (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 @@ -5631,7 +5649,7 @@ instead of the completion table." 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 @@ -5800,7 +5818,8 @@ members of the minibuffer history list." (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"))) @@ -5810,7 +5829,8 @@ members of the minibuffer history list." (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. @@ -6130,7 +6150,7 @@ This applies to `completions-auto-update-mode', which see." (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 @@ -6141,7 +6161,7 @@ This applies to `completions-auto-update-mode', which see." (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)))) @@ -6215,7 +6235,7 @@ This applies to `completions-auto-update-mode', which see." (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)))))) diff --git a/lisp/simple.el b/lisp/simple.el index 9b40ea98327..5c023eae4d2 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10367,10 +10367,10 @@ back on `completion-list-insert-choice-function' when nil." (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 diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 31c006072b0..95f114934a7 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -391,21 +391,21 @@ '("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"))))))) @@ -414,22 +414,38 @@ (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)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 0b0f87553b9..f580f3b57b0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4818,185 +4818,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (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)) -- 2.39.5