From 8e7efa7a253968afc041b4bd23205889e0169e13 Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Mon, 11 Dec 2023 21:39:20 +0100
Subject: [PATCH] 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'.
---
 etc/NEWS           |  7 +++++++
 lisp/minibuffer.el | 16 ++++++++++++++++
 lisp/window.el     | 12 ++++++++++--
 src/minibuf.c      |  2 +-
 4 files changed, 34 insertions(+), 3 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 04c8a47dc26..a4edd6f1891 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1303,6 +1303,13 @@ values.
 
 * 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 a9814fb0bac..11813512036 100644
--- 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 848f93dbbe4..59e1f94e4d0 100644
--- 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 58adde1bf66..f9aef1bac85 100644
--- 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);
     }
-- 
2.39.5