bug#49700: 27.2; [PATCH] Refactor minibuffer aborting

[miha]

The attached patch removes special handling of the 'exit tag from
internal_catch.  This special handling was introduced by Alan in commit
Sun Jan 10 20:32:40 2021 +0000
(c7c154bb5756e0ae71d342c5d8aabf725877f186), hence me CC-ing him.

It also exposes Vminibuffer_list to lisp through the new function
Fminibuffer_alist.

From 498dbfbd9e527183fce34e548b7362e5db1b25bf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= <miha@kamnitnik.top>
Date: Thu, 22 Jul 2021 17:49:45 +0200
Subject: [PATCH] Refactor minibuffer aborting

* src/minibuf.c (Finnermost_minibuffer_p): Remove.  Use the new
function `minibuffer-alist' instead.

(Fminibuffer_innermost_command_loop_p): Remove.

(minibuf_c_loop_level): Remove, not needed anymore.

(Fminibuffer_alist): New function.

(Fabort_minibuffers): Re-implement this function in lisp.  To quit
multiple recursive edit levels, use the mechanism of throwing a
function value to 'exit.

* lisp/minibuffer.el (exit-minibuffer): Use `minibuffer-alist'.

* doc/lispref/minibuf.texi (Recursive Mini):
* etc/NEWS: Document new function `minibuffer-alist'.

* src/eval.c (internal_catch): Remove special handling of 'exit tag.
---
 doc/lispref/minibuf.texi |  8 ++++
 etc/NEWS                 |  4 ++
 lisp/minibuffer.el       | 44 ++++++++++++++++++--
 src/eval.c               | 22 ----------
 src/lisp.h               |  1 -
 src/minibuf.c            | 89 ++++++++++------------------------------
 6 files changed, 74 insertions(+), 94 deletions(-)

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 196dd99076..90e738f3ea 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -2645,6 +2645,14 @@ Recursive Mini
 returns zero.
 @end defun
 
+@defun minibuffer-alist
+Return an alist of all minibuffers and their recursion depths.  The
+car of each element is a minibuffer and the cdr is what the function
+@code{recursion-depth} would have returned after this minibuffer
+activation.  The number of elements of the returned list is equal to
+the current minibuffer depth.
+@end defun
+
 @defopt enable-recursive-minibuffers
 If this variable is non-@code{nil}, you can invoke commands (such as
 @code{find-file}) that use minibuffers even while the minibuffer is
diff --git a/etc/NEWS b/etc/NEWS
index 95218faa1b..364c1b814b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -3094,6 +3094,10 @@ The former is now declared obsolete.

 * Lisp Changes in Emacs 28.1
 
++++
+** New function 'minibuffer-alist'
+Returns an alist of all minibuffers and their recursion depths.
+
 +++
 *** New function 'split-string-shell-command'.
 This splits a shell command string into separate components,
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 1578ab8e1e..702e7e105d 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2315,10 +2315,11 @@ exit-minibuffer
   "Terminate this minibuffer argument."
   (interactive)
   (when (minibufferp)
-    (when (not (minibuffer-innermost-command-loop-p))
-      (error "%s" "Not in most nested command loop"))
-    (when (not (innermost-minibuffer-p))
-      (error "%s" "Not in most nested minibuffer")))
+    (let ((minibufs (minibuffer-alist)))
+      (when (not (eq (current-buffer) (caar minibufs)))
+        (error "%s" "Not in most nested minibuffer"))
+      (when (/= (recursion-depth) (cdar minibufs))
+        (error "%s" "Not in most nested command loop"))))
   ;; If the command that uses this has made modifications in the minibuffer,
   ;; we don't want them to cause deactivation of the mark in the original
   ;; buffer.
@@ -2328,6 +2329,41 @@ exit-minibuffer
   (setq deactivate-mark nil)
   (throw 'exit nil))
 
+(defun abort-minibuffers ()
+  "Abort the current minibuffer.
+If we are not currently in the innermost minibuffer, prompt the user to
+confirm the aborting of the current minibuffer and all contained ones."
+  (interactive)
+  (let* ((minibufs (minibuffer-alist))
+         (buffer (current-buffer))
+         (found nil)
+         (minibuffer-level (recursion-depth))
+         (outermost-p t))
+    (while (and (not found) minibufs)
+      (when (/= minibuffer-level (cdar minibufs))
+        (error "Not in most nested command loop"))
+      (if (eq buffer (caar minibufs))
+          (setq found t)
+        (setq outermost-p nil)
+        (setq minibufs (cdr minibufs))
+        (cl-decf minibuffer-level)))
+    (unless found
+      (error "Not in a minibuffer"))
+    (if outermost-p
+        (minibuffer-quit-recursive-edit)
+      (when (yes-or-no-p
+             (format "Abort %s minibuffer levels? "
+                     (- (recursion-depth) minibuffer-level -1)))
+        (let (exit-fun)
+          (setq exit-fun
+                (lambda ()
+                  (if (> (recursion-depth) minibuffer-level)
+                      (throw 'exit exit-fun)
+                    (signal 'minibuffer-quit nil))))
+          ;; See Info node `(elisp)Recursive Editing' for an
+          ;; explanation of throwing a function to `exit'.
+          (throw 'exit exit-fun))))))
+
 (defun minibuffer-quit-recursive-edit ()
   "Quit the command that requested this recursive edit without error.
 Like `abort-recursive-edit' without aborting keyboard macro
diff --git a/src/eval.c b/src/eval.c
index 48104bd0f4..76fe671b6d 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1174,14 +1174,6 @@ #define clobbered_eassert(E) verify (sizeof (E) != 0)
    FUNC should return a Lisp_Object.
    This is how catches are done from within C code.  */
 
-/* MINIBUFFER_QUIT_LEVEL is to handle quitting from nested minibuffers by
-   throwing t to tag `exit'.
-   0 means there is no (throw 'exit t) in progress, or it wasn't from
-     a minibuffer which isn't the most nested;
-   N > 0 means the `throw' was done from the minibuffer at level N which
-     wasn't the most nested.  */
-EMACS_INT minibuffer_quit_level = 0;
-
 Lisp_Object
 internal_catch (Lisp_Object tag,
                Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
@@ -1189,9 +1181,6 @@ internal_catch (Lisp_Object tag,
   /* This structure is made part of the chain `catchlist'.  */
   struct handler *c = push_handler (tag, CATCHER);
 
-  if (EQ (tag, Qexit))
-    minibuffer_quit_level = 0;
-
   /* Call FUNC.  */
   if (! sys_setjmp (c->jmp))
     {
@@ -1205,17 +1194,6 @@ internal_catch (Lisp_Object tag,
       Lisp_Object val = handlerlist->val;
       clobbered_eassert (handlerlist == c);
       handlerlist = handlerlist->next;
-      if (EQ (tag, Qexit) && EQ (val, Qt) && minibuffer_quit_level > 0)
-       /* If we've thrown t to tag `exit' from within a minibuffer, we
-          exit all minibuffers more deeply nested than the current
-          one.  */
-       {
-         if (minibuf_level > minibuffer_quit_level
-             && !NILP (Fminibuffer_innermost_command_loop_p (Qnil)))
-            Fthrow (Qexit, Qt);
-         else
-           minibuffer_quit_level = 0;
-       }
       return val;
     }
 }
diff --git a/src/lisp.h b/src/lisp.h
index 80efd77113..fd89b464fc 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4111,7 +4111,6 @@ intern_c_string (const char *str)
 }
 
 /* Defined in eval.c.  */
-extern EMACS_INT minibuffer_quit_level;
 extern Lisp_Object Vautoload_queue;
 extern Lisp_Object Vrun_hooks;
 extern Lisp_Object Vsignaling_function;
diff --git a/src/minibuf.c b/src/minibuf.c
index 0f4349e70b..d9e404b7b0 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -71,7 +71,6 @@ Copyright (C) 1985-1986, 1993-2021 Free Software Foundation, 
Inc.
 static ptrdiff_t minibuf_prompt_width;
 
 static Lisp_Object nth_minibuffer (EMACS_INT depth);
-static EMACS_INT minibuf_c_loop_level (EMACS_INT depth);
 static void set_minibuffer_mode (Lisp_Object buf, EMACS_INT depth);
 static bool live_minibuffer_p (Lisp_Object);
 
@@ -423,33 +422,28 @@ DEFUN ("minibufferp", Fminibufferp,
     ? Qt : Qnil;
 }
 
-DEFUN ("innermost-minibuffer-p", Finnermost_minibuffer_p,
-       Sinnermost_minibuffer_p, 0, 1, 0,
-       doc: /* Return t if BUFFER is the most nested active minibuffer.
-No argument or nil as argument means use the current buffer as BUFFER.  */)
-  (Lisp_Object buffer)
-{
-  if (NILP (buffer))
-    buffer = Fcurrent_buffer ();
-  return EQ (buffer, (Fcar (Fnthcdr (make_fixnum (minibuf_level),
-                                    Vminibuffer_list))))
-    ? Qt
-    : Qnil;
-}
-
-DEFUN ("minibuffer-innermost-command-loop-p", 
Fminibuffer_innermost_command_loop_p,
-       Sminibuffer_innermost_command_loop_p, 0, 1, 0,
-       doc: /* Return t if BUFFER is a minibuffer at the current command loop 
level.
-No argument or nil as argument means use the current buffer as BUFFER.  */)
-  (Lisp_Object buffer)
+DEFUN ("minibuffer-alist", Fminibuffer_alist, Sminibuffer_alist, 0, 0, 0,
+       doc: /* Return an alist of minibuffers.
+Elements are of the form (MINIBUFFER . DEPTH), where depth is the
+recursion depth the MINIBUFFER.  The returned minibuffers are sorted
+in the order from the innermost minibuffer to the outermost one.  */)
+  (void)
 {
-  EMACS_INT depth;
-  if (NILP (buffer))
-    buffer = Fcurrent_buffer ();
-  depth = this_minibuffer_depth (buffer);
-  return depth && minibuf_c_loop_level (depth) == command_loop_level
-    ? Qt
-    : Qnil;
+  Lisp_Object bufs_tail = Fcdr (Vminibuffer_list);
+  Lisp_Object cll_tail = Fcdr (Vcommand_loop_level_list);
+  Lisp_Object ret = Qnil;
+  for (int i = 1;
+       i <= minibuf_level && !NILP (bufs_tail) && !NILP (cll_tail);
+       i++)
+    {
+      EMACS_INT depth = XFIXNUM (Fcar (cll_tail)) + i;
+      Lisp_Object pair = Fcons (Fcar (bufs_tail),
+                               make_fixnum (depth));
+      ret = Fcons (pair, ret);
+      cll_tail = Fcdr (cll_tail);
+      bufs_tail = Fcdr (bufs_tail);
+    }
+  return ret;
 }
 
 /* Return the nesting depth of the active minibuffer BUFFER, or 0 if
@@ -471,35 +465,6 @@ this_minibuffer_depth (Lisp_Object buffer)
   return 0;
 }
 
-DEFUN ("abort-minibuffers", Fabort_minibuffers, Sabort_minibuffers, 0, 0, "",
-       doc: /* Abort the current minibuffer.
-If we are not currently in the innermost minibuffer, prompt the user to
-confirm the aborting of the current minibuffer and all contained ones.  */)
-  (void)
-{
-  EMACS_INT minibuf_depth = this_minibuffer_depth (Qnil);
-  Lisp_Object array[2];
-  AUTO_STRING (fmt, "Abort %s minibuffer levels? ");
-
-  if (!minibuf_depth)
-    error ("Not in a minibuffer");
-  if (NILP (Fminibuffer_innermost_command_loop_p (Qnil)))
-    error ("Not in most nested command loop");
-  if (minibuf_depth < minibuf_level)
-    {
-      array[0] = fmt;
-      array[1] = make_fixnum (minibuf_level - minibuf_depth + 1);
-      if (!NILP (Fyes_or_no_p (Fformat (2, array))))
-       {
-         minibuffer_quit_level = minibuf_depth;
-         Fthrow (Qexit, Qt);
-       }
-    }
-  else
-    CALLN (Ffuncall, intern ("minibuffer-quit-recursive-edit"));
-  return Qnil;
-}
-
 DEFUN ("minibuffer-prompt-end", Fminibuffer_prompt_end,
        Sminibuffer_prompt_end, 0, 0, 0,
        doc: /* Return the buffer position of the end of the minibuffer prompt.
@@ -1045,14 +1010,6 @@ get_minibuffer (EMACS_INT depth)
   return buf;
 }
 
-static EMACS_INT minibuf_c_loop_level (EMACS_INT depth)
-{
-  Lisp_Object cll = Fnth (make_fixnum (depth), Vcommand_loop_level_list);
-  if (FIXNUMP (cll))
-    return XFIXNUM (cll);
-  return 0;
-}
-
 static void
 run_exit_minibuf_hook (void)
 {
@@ -2539,9 +2496,7 @@ syms_of_minibuf (void)
   defsubr (&Sminibuffer_prompt);
 
   defsubr (&Sminibufferp);
-  defsubr (&Sinnermost_minibuffer_p);
-  defsubr (&Sminibuffer_innermost_command_loop_p);
-  defsubr (&Sabort_minibuffers);
+  defsubr (&Sminibuffer_alist);
   defsubr (&Sminibuffer_prompt_end);
   defsubr (&Sminibuffer_contents);
   defsubr (&Sminibuffer_contents_no_properties);
-- 
2.32.0

signature.asc
Description: PGP signature