From 498dbfbd9e527183fce34e548b7362e5db1b25bf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= 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