Avoid overriding completion table when reading buffers

This fixes Bug#53604, and allows 'read-buffer-function' to check if it
is being called by 'read-buffer-to-switch', and react accordingly, for
example immediately by showing the *Completions* buffer.

* lisp/window.el (read-buffer-to-switch-current-buffer): New var.
(read-buffer-to-switch): Use it.
* lisp/minibuffer.el (buffers-except-current-if-switching): New fun.
* src/minibuf.c (Fread_buffer): Use it.

* etc/NEWS: Announce 'read-buffer-to-switch-current-buffer'.

diff --git a/etc/NEWS b/etc/NEWS
index 04c8a47dc26562398efc4106daaa1c6d94974bcb..a4edd6f189187ed3fa18d4d33ca3e4a0062c2247 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1303,6 +1303,13 @@ values.
 \f
 * Lisp Changes in Emacs 30.1
 
+---
+** New variable 'read-buffer-to-switch-current-buffer'.
+'read-buffer-to-switch' let-binds this variable to the current buffer
+from which you are switching.  You can check for this variable in your
+'read-buffer-function' to determine if the caller intends to switch to
+the buffer that this function reads.
+
 ** New function 'merge-ordered-lists'.
 Mostly used internally to do a kind of topological sort of
 inheritance hierarchies.

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index a9814fb0bacf28bc7440078a5afd7ce63b9ea9b3..11813512036c84ea3ce5088225c5b1f91ec1039c 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3602,6 +3602,22 @@ See `read-file-name' for the meaning of the arguments."
                             (minibuffer-maybe-quote-filename val))))
        val))))
 
+(defun buffers-except-current-if-switching (string pred action)
+  "Perform completion ACTION of STRING subject to PRED.
+
+This is similar to `internal-complete-buffer', except that this
+function excludes `read-buffer-to-switch-current-buffer' when it
+is not nil."
+  (let* ((except (when read-buffer-to-switch-current-buffer
+                   (buffer-name read-buffer-to-switch-current-buffer)))
+         (predicate
+          (if except
+              (lambda (name)
+                (and (or (not pred) (funcall pred name))
+                     (not (equal except (car (ensure-list name))))))
+            pred)))
+    (internal-complete-buffer string predicate action)))
+
 (defun internal-complete-buffer-except (&optional buffer)
   "Perform completion on all buffers excluding BUFFER.
 BUFFER nil or omitted means use the current buffer.

diff --git a/lisp/window.el b/lisp/window.el
index 848f93dbbe4e19535746f6e4c4a84f401ef556a0..59e1f94e4d007b3c3713ebfdaac9cb33dbcc695d 100644 (file)
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -8864,6 +8864,13 @@ another window."
   :group 'windows
   :group 'tex-run)
 
+(defvar read-buffer-to-switch-current-buffer nil
+  "Buffer that `read-buffer-to-switch' ignores as a completion candidate.
+
+`read-buffer-to-switch' let-binds this variable to the current
+buffer when you invoke that function.  When
+`read-buffer-to-switch' is not executing, this variable is nil.")
+
 (defun read-buffer-to-switch (prompt)
   "Read the name of a buffer to switch to, prompting with PROMPT.
 Return the name of the buffer as a string.
@@ -8871,8 +8878,9 @@ Return the name of the buffer as a string.
 This function is intended for the `switch-to-buffer' family of
 commands since these need to omit the name of the current buffer
 from the list of completions and default values."
-  (read-buffer prompt (other-buffer (current-buffer))
-               (confirm-nonexistent-file-or-buffer)))
+  (let ((read-buffer-to-switch-current-buffer (current-buffer)))
+    (read-buffer prompt (other-buffer (current-buffer))
+                 (confirm-nonexistent-file-or-buffer))))
 
 (defun window-normalize-buffer-to-switch-to (buffer-or-name)
   "Normalize BUFFER-OR-NAME argument of buffer switching functions.

diff --git a/src/minibuf.c b/src/minibuf.c
index 58adde1bf668ed892b5de1d36f9e3a719e6a76b4..f9aef1bac85685da7a86287ddb22fc1f4f31d0e5 100644 (file)
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1530,7 +1530,7 @@ function, instead of the usual behavior.  */)
                          CONSP (def) ? XCAR (def) : def);
        }
 
-      result = Fcompleting_read (prompt, intern ("internal-complete-buffer"),
+      result = Fcompleting_read (prompt, intern ("buffers-except-current-if-switching"),
                                 predicate, require_match, Qnil,
                                 Qbuffer_name_history, def, Qnil);
     }