From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: miha--- via "Bug reports for GNU Emacs, the Swiss army knife of text editors" Newsgroups: gmane.emacs.bugs Subject: bug#49700: 27.2; [PATCH] Refactor minibuffer aborting Date: Fri, 23 Jul 2021 01:05:41 +0200 Message-ID: <87pmvaar0a.fsf@miha-pc> Reply-To: miha@kamnitnik.top Mime-Version: 1.0 Content-Type: multipart/signed; boundary="==-=-="; micalg=pgp-sha256; protocol="application/pgp-signature" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="13828"; mail-complaints-to="usenet@ciao.gmane.io" Cc: Alan Mackenzie To: 49700@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Jul 23 01:04:12 2021 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1m6hjg-0003Iv-Cf for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 23 Jul 2021 01:04:12 +0200 Original-Received: from localhost ([::1]:46448 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1m6hjd-0005gB-Kx for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 22 Jul 2021 19:04:09 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:49420) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1m6hjW-0005dM-FJ for bug-gnu-emacs@gnu.org; Thu, 22 Jul 2021 19:04:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:58493) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1m6hjW-00086v-6W for bug-gnu-emacs@gnu.org; Thu, 22 Jul 2021 19:04:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1m6hjW-0006ms-22 for bug-gnu-emacs@gnu.org; Thu, 22 Jul 2021 19:04:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: miha@kamnitnik.top Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 22 Jul 2021 23:04:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 49700 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.162699502326065 (code B ref -1); Thu, 22 Jul 2021 23:04:01 +0000 Original-Received: (at submit) by debbugs.gnu.org; 22 Jul 2021 23:03:43 +0000 Original-Received: from localhost ([127.0.0.1]:41806 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1m6hjC-0006mI-JT for submit@debbugs.gnu.org; Thu, 22 Jul 2021 19:03:43 -0400 Original-Received: from lists.gnu.org ([209.51.188.17]:33840) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1m6hj8-0006m7-Fr for submit@debbugs.gnu.org; Thu, 22 Jul 2021 19:03:41 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:49362) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1m6hj8-0005ax-7q for bug-gnu-emacs@gnu.org; Thu, 22 Jul 2021 19:03:38 -0400 Original-Received: from kamnitnik.top ([2001:19f0:5001:bf2:5400:2ff:fee0:2626]:35322 helo=mail.kamnitnik.top) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1m6hj5-0007mV-Jd for bug-gnu-emacs@gnu.org; Thu, 22 Jul 2021 19:03:37 -0400 Original-Received: from localhost (unknown [IPv6:2a00:ee2:e04:9300:e609:6c46:d026:8c47]) by mail.kamnitnik.top (Postfix) with ESMTPSA id B4D12BCF6D; Thu, 22 Jul 2021 23:03:30 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=kamnitnik.top; s=mail; t=1626995010; bh=KrUF6u19LOCnJlB96Rimph7y4gPGgKwWkMNFdwN+XoY=; h=From:To:Cc:Subject:Date:From; b=Nk1PG1+xZzRU81uGes1jOiGFxfW+nEpcBg75p+ir9HVlIeYuTllNA9TBgisjogBSO FcuEHwG7ulJYYXRljF7Em2jqwgKpfc45MHZaTuIg7JWr/I1dXUVXjBafAHz/7QbiB0 dIXCBZv6XYuS5xj3k2qe3bt7tgMcUsJj55KRYRVdGnVFKTALM78/x0j0N24Zg7aC4q fZXHfliEbLBedBQWoQO9Q9Bd6YD//LWxPoPsAxI6f9myenOVsq43WIZny8qxVJiTeY lFOBx0oqAEZbyTdinn3wS8t/KtXAaOgyhdSpAygqNAI0lhc/tEN3PI/Sw0Eovlkckh HwTy2fgaSrFXg== Received-SPF: pass client-ip=2001:19f0:5001:bf2:5400:2ff:fee0:2626; envelope-from=miha@kamnitnik.top; helo=mail.kamnitnik.top X-Spam_score_int: 9 X-Spam_score: 0.9 X-Spam_bar: / X-Spam_report: (0.9 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FROM_SUSPICIOUS_NTLD=0.499, FROM_SUSPICIOUS_NTLD_FP=0.546, PDS_OTHER_BAD_TLD=1.997, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=no autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:210550 Archived-At: --==-=-= Content-Type: multipart/mixed; boundary="=-=-=" --=-=-= Content-Type: text/plain 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. --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Refactor-minibuffer-aborting.patch Content-Transfer-Encoding: quoted-printable From=20498dbfbd9e527183fce34e548b7362e5db1b25bf Mon Sep 17 00:00:00 2001 From: =3D?UTF-8?q?Miha=3D20Rihtar=3DC5=3DA1i=3DC4=3D8D?=3D 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. =2D-- 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 =2D-- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -2645,6 +2645,14 @@ Recursive Mini returns zero. @end defun =20 +@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 =2D-- a/etc/NEWS +++ b/etc/NEWS @@ -3094,6 +3094,10 @@ The former is now declared obsolete. * Lisp Changes in Emacs 28.1 =20 ++++ +** 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 =2D-- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2315,10 +2315,11 @@ exit-minibuffer "Terminate this minibuffer argument." (interactive) (when (minibufferp) =2D (when (not (minibuffer-innermost-command-loop-p)) =2D (error "%s" "Not in most nested command loop")) =2D (when (not (innermost-minibuffer-p)) =2D (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 (/=3D (recursion-depth) (cdar minibufs)) + (error "%s" "Not in most nested command loop")))) ;; If the command that uses this has made modifications in the minibuffe= r, ;; 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)) =20 +(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 (/=3D 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 =2D-- a/src/eval.c +++ b/src/eval.c @@ -1174,14 +1174,6 @@ #define clobbered_eassert(E) verify (sizeof (E) !=3D= 0) FUNC should return a Lisp_Object. This is how catches are done from within C code. */ =20 =2D/* MINIBUFFER_QUIT_LEVEL is to handle quitting from nested minibuffers by =2D throwing t to tag `exit'. =2D 0 means there is no (throw 'exit t) in progress, or it wasn't from =2D a minibuffer which isn't the most nested; =2D N > 0 means the `throw' was done from the minibuffer at level N which =2D wasn't the most nested. */ =2DEMACS_INT minibuffer_quit_level =3D 0; =2D 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 =3D push_handler (tag, CATCHER); =20 =2D if (EQ (tag, Qexit)) =2D minibuffer_quit_level =3D 0; =2D /* Call FUNC. */ if (! sys_setjmp (c->jmp)) { @@ -1205,17 +1194,6 @@ internal_catch (Lisp_Object tag, Lisp_Object val =3D handlerlist->val; clobbered_eassert (handlerlist =3D=3D c); handlerlist =3D handlerlist->next; =2D if (EQ (tag, Qexit) && EQ (val, Qt) && minibuffer_quit_level > 0) =2D /* If we've thrown t to tag `exit' from within a minibuffer, we =2D exit all minibuffers more deeply nested than the current =2D one. */ =2D { =2D if (minibuf_level > minibuffer_quit_level =2D && !NILP (Fminibuffer_innermost_command_loop_p (Qnil))) =2D Fthrow (Qexit, Qt); =2D else =2D minibuffer_quit_level =3D 0; =2D } return val; } } diff --git a/src/lisp.h b/src/lisp.h index 80efd77113..fd89b464fc 100644 =2D-- a/src/lisp.h +++ b/src/lisp.h @@ -4111,7 +4111,6 @@ intern_c_string (const char *str) } =20 /* Defined in eval.c. */ =2Dextern 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 =2D-- a/src/minibuf.c +++ b/src/minibuf.c @@ -71,7 +71,6 @@ Copyright (C) 1985-1986, 1993-2021 Free Software Foundati= on, Inc. static ptrdiff_t minibuf_prompt_width; =20 static Lisp_Object nth_minibuffer (EMACS_INT depth); =2Dstatic 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); =20 @@ -423,33 +422,28 @@ DEFUN ("minibufferp", Fminibufferp, ? Qt : Qnil; } =20 =2DDEFUN ("innermost-minibuffer-p", Finnermost_minibuffer_p, =2D Sinnermost_minibuffer_p, 0, 1, 0, =2D doc: /* Return t if BUFFER is the most nested active minibuffer. =2DNo argument or nil as argument means use the current buffer as BUFFER. = */) =2D (Lisp_Object buffer) =2D{ =2D if (NILP (buffer)) =2D buffer =3D Fcurrent_buffer (); =2D return EQ (buffer, (Fcar (Fnthcdr (make_fixnum (minibuf_level), =2D Vminibuffer_list)))) =2D ? Qt =2D : Qnil; =2D} =2D =2DDEFUN ("minibuffer-innermost-command-loop-p", Fminibuffer_innermost_comm= and_loop_p, =2D Sminibuffer_innermost_command_loop_p, 0, 1, 0, =2D doc: /* Return t if BUFFER is a minibuffer at the current command= loop level. =2DNo argument or nil as argument means use the current buffer as BUFFER. = */) =2D (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) { =2D EMACS_INT depth; =2D if (NILP (buffer)) =2D buffer =3D Fcurrent_buffer (); =2D depth =3D this_minibuffer_depth (buffer); =2D return depth && minibuf_c_loop_level (depth) =3D=3D command_loop_level =2D ? Qt =2D : Qnil; + Lisp_Object bufs_tail =3D Fcdr (Vminibuffer_list); + Lisp_Object cll_tail =3D Fcdr (Vcommand_loop_level_list); + Lisp_Object ret =3D Qnil; + for (int i =3D 1; + i <=3D minibuf_level && !NILP (bufs_tail) && !NILP (cll_tail); + i++) + { + EMACS_INT depth =3D XFIXNUM (Fcar (cll_tail)) + i; + Lisp_Object pair =3D Fcons (Fcar (bufs_tail), + make_fixnum (depth)); + ret =3D Fcons (pair, ret); + cll_tail =3D Fcdr (cll_tail); + bufs_tail =3D Fcdr (bufs_tail); + } + return ret; } =20 /* Return the nesting depth of the active minibuffer BUFFER, or 0 if @@ -471,35 +465,6 @@ this_minibuffer_depth (Lisp_Object buffer) return 0; } =20 =2DDEFUN ("abort-minibuffers", Fabort_minibuffers, Sabort_minibuffers, 0, 0= , "", =2D doc: /* Abort the current minibuffer. =2DIf we are not currently in the innermost minibuffer, prompt the user to =2Dconfirm the aborting of the current minibuffer and all contained ones. = */) =2D (void) =2D{ =2D EMACS_INT minibuf_depth =3D this_minibuffer_depth (Qnil); =2D Lisp_Object array[2]; =2D AUTO_STRING (fmt, "Abort %s minibuffer levels? "); =2D =2D if (!minibuf_depth) =2D error ("Not in a minibuffer"); =2D if (NILP (Fminibuffer_innermost_command_loop_p (Qnil))) =2D error ("Not in most nested command loop"); =2D if (minibuf_depth < minibuf_level) =2D { =2D array[0] =3D fmt; =2D array[1] =3D make_fixnum (minibuf_level - minibuf_depth + 1); =2D if (!NILP (Fyes_or_no_p (Fformat (2, array)))) =2D { =2D minibuffer_quit_level =3D minibuf_depth; =2D Fthrow (Qexit, Qt); =2D } =2D } =2D else =2D CALLN (Ffuncall, intern ("minibuffer-quit-recursive-edit")); =2D return Qnil; =2D} =2D DEFUN ("minibuffer-prompt-end", Fminibuffer_prompt_end, Sminibuffer_prompt_end, 0, 0, 0, doc: /* Return the buffer position of the end of the minibuffer pro= mpt. @@ -1045,14 +1010,6 @@ get_minibuffer (EMACS_INT depth) return buf; } =20 =2Dstatic EMACS_INT minibuf_c_loop_level (EMACS_INT depth) =2D{ =2D Lisp_Object cll =3D Fnth (make_fixnum (depth), Vcommand_loop_level_lis= t); =2D if (FIXNUMP (cll)) =2D return XFIXNUM (cll); =2D return 0; =2D} =2D static void run_exit_minibuf_hook (void) { @@ -2539,9 +2496,7 @@ syms_of_minibuf (void) defsubr (&Sminibuffer_prompt); =20 defsubr (&Sminibufferp); =2D defsubr (&Sinnermost_minibuffer_p); =2D defsubr (&Sminibuffer_innermost_command_loop_p); =2D defsubr (&Sabort_minibuffers); + defsubr (&Sminibuffer_alist); defsubr (&Sminibuffer_prompt_end); defsubr (&Sminibuffer_contents); defsubr (&Sminibuffer_contents_no_properties); =2D-=20 2.32.0 --=-=-=-- --==-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJHBAEBCAAxFiEEmxVnesoT5rQXvVXnswkaGpIVmT8FAmD5+cUTHG1paGFAa2Ft bml0bmlrLnRvcAAKCRCzCRoakhWZP2cCD/9pmOUMHw2TLZS+ToU9fJJ32r90Ak+2 ri5j3oIONUDsGptomerBsZ58qhzIjrqcUtAvZmNmyfMl934cLUwCZYqLNrR4nRfg cKUm+7efzmgYiXNheGXjg7NFMLQkb1SEydQGp4D3elEso/knNEqA4+PCi+udvznZ plKIj+WNpyumdsYbKAxgq2SBjCxC0xs0beQbaoLQQQukyGPx3CdQ9RNPnnP/OeDN anYsPNhHQsYR5xSMtJTJTWL48jZvbAKS5CQd0rtoF7ODwKrK+D0h+uJfBOIFLrim ezDq5+I0iBfeB0hMVDhLCvU/u919sdC9we9oZo6Y0MWgSQJ0q40R2Z8N4M721aSs k0/oPXhwcuKVaFTE0n0uBcK1wiRFvry5hbgVFf83Ro1W8pyisMxzfm0VRBq+iECP eO518AOXNnRsPGLNpafpsqAkSS7m8e1M2laH4DJ//fJWmMkiegP1cZIBjSrGJpfH nDdkqnuFCAjV9v1o2KyzIhk8lkLcRYm2GkmzjLZr4f9GPhpNcio5QkTUqwaS9vjq Cvt4uCF2Likgtv8n6886caxNX7ao712BZLDpOs6d+wGXy47wuGgROUePWvD/SPrT 1dr0J7/xMOoeNX4TnkEKibSgAoCQxhYd8jtfagkGTNc4yMQNgsy7hmnpRmlBcN/n I/RoGmhKZo+1gw== =OOYx -----END PGP SIGNATURE----- --==-=-=--