Quit minibuffers without aborting kmacros

* doc/lispref/commands.texi (Quitting): Document `minibuffer-quit'
(Recursive Editing): Document throwing of function values to `exit'.

* doc/lispref/errors.texi (Standard Errors): Document
`minibuffer-quit'

* lisp/minibuffer.el (minibuffer-quit-recursive-edit): New function.

* lisp/simple.el (minibuffer-error-function): Do not abort keyboard
macro execution if is minibuffer-quit is signaled (bug#48603).
* src/data.c (syms_of_data): New error symbol `minibuffer-quit'

* src/keyboard.c (recursive_edit_1): Implement throwing of function
values to `exit`.  In that case, the function will be called without
arguments before returning from the command loop.
(cmd_error):
(Fcommand_error_default_function): Do not abort keyboard macro
execution if minibuffer-quit is signaled.
(command_loop_2): New argument HANDLERS.

* src/macros.c (Fexecute_kbd_macro): Use command_loop_2 instead of
command_loop_1.

* src/minibuf.c (Fabort_minibuffers): Use it.

diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index f30419c3ee70d2bc3837203bda6d879c90d68047..b4a8b733a0b0d70922edc504d0dc355fa47b5a66 100644 (file)
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -3381,6 +3381,12 @@ nil)}.  This is the same thing that quitting does.  (See @code{signal}
 in @ref{Errors}.)
 @end deffn
 
+  To quit without aborting a keyboard macro definition or execution,
+you can signal the @code{minibuffer-quit} condition.  This has almost
+the same effect as the @code{quit} condition except that the error
+handling in the command loop handles it without exiting keyboard macro
+definition or execution.
+
   You can specify a character other than @kbd{C-g} to use for quitting.
 See the function @code{set-input-mode} in @ref{Input Modes}.
 
@@ -3565,12 +3571,14 @@ commands.
 @code{recursive-edit}.  This function contains the command loop; it also
 contains a call to @code{catch} with tag @code{exit}, which makes it
 possible to exit the recursive editing level by throwing to @code{exit}
-(@pxref{Catch and Throw}).  If you throw a value other than @code{t},
-then @code{recursive-edit} returns normally to the function that called
-it.  The command @kbd{C-M-c} (@code{exit-recursive-edit}) does this.
+(@pxref{Catch and Throw}).  If you throw a @code{nil} value, then
+@code{recursive-edit} returns normally to the function that called it.
+The command @kbd{C-M-c} (@code{exit-recursive-edit}) does this.
 Throwing a @code{t} value causes @code{recursive-edit} to quit, so that
 control returns to the command loop one level up.  This is called
 @dfn{aborting}, and is done by @kbd{C-]} (@code{abort-recursive-edit}).
+You can also throw a function value.  In that case,
+@code{recursive-edit} will call it without arguments before returning.
 
   Most applications should not use recursive editing, except as part of
 using the minibuffer.  Usually it is more convenient for the user if you

diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi
index fb393b951f19b3118bd2be9d93e6a1042d52dbe8..f848218e267099c2a11ab0d02341a2da3007e6a9 100644 (file)
--- a/doc/lispref/errors.texi
+++ b/doc/lispref/errors.texi
@@ -20,8 +20,9 @@ the errors in accessing files have the condition @code{file-error}.  If
 we do not say here that a certain error symbol has additional error
 conditions, that means it has none.
 
-  As a special exception, the error symbol @code{quit} does not have the
-condition @code{error}, because quitting is not considered an error.
+  As a special exception, the error symbols @code{quit} and
+@code{minibuffer-quit} don't have the condition @code{error}, because
+quitting is not considered an error.
 
   Most of these error symbols are defined in C (mainly @file{data.c}),
 but some are defined in Lisp.  For example, the file @file{userlock.el}
@@ -40,6 +41,10 @@ The message is @samp{error}.  @xref{Errors}.
 @item quit
 The message is @samp{Quit}.  @xref{Quitting}.
 
+@item minibuffer-quit
+The message is @samp{Quit}.  This is a subcategory of @code{quit}.
+@xref{Quitting}.
+
 @item args-out-of-range
 The message is @samp{Args out of range}.  This happens when trying to
 access an element beyond the range of a sequence, buffer, or other

diff --git a/etc/NEWS b/etc/NEWS
index 953c952d05d8522497572ce5c2aca7746d20fd7f..df09d81bcfee8695500f5dd8b8928f3ce7216413 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2682,6 +2682,15 @@ also keep the type information of their arguments.  Use the
 ---
 *** New face 'perl-heredoc', used for heredoc elements.
 
++++
+** A function can now be thrown to the 'exit' label in addition to t or nil.
+The command loop will call it with zero arguments before returning.
+
++++
+** New error symbol 'minibuffer-quit'.
+Signaling it has almost the same effect as 'quit' except that it
+doesn't cause keyboard macro termination.
+
 ---
 *** The command 'cperl-set-style' offers the new value "PBP".
 This value customizes Emacs to use the style recommended in Damian

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 813ce14c59b0f581753892a3da08ae9c216667f7..1578ab8e1ea65ebcec60d2d0eff8e2c3a8a10f9f 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2328,6 +2328,15 @@ variables.")
   (setq deactivate-mark nil)
   (throw 'exit nil))
 
+(defun minibuffer-quit-recursive-edit ()
+  "Quit the command that requested this recursive edit without error.
+Like `abort-recursive-edit' without aborting keyboard macro
+execution."
+  ;; See Info node `(elisp)Recursive Editing' for an explanation of
+  ;; throwing a function to `exit'.
+  (throw 'exit (lambda ()
+                 (signal 'minibuffer-quit nil))))
+
 (defun self-insert-and-exit ()
   "Terminate minibuffer input."
   (interactive)

diff --git a/lisp/simple.el b/lisp/simple.el
index 5741c24eb7bc5e7e67a79735a30420936c52dd89..1a49fe24252da670d5a790423c41a625967f573c 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2879,8 +2879,10 @@ Go to the history element by the absolute history position HIST-POS."
 The same as `command-error-default-function' but display error messages
 at the end of the minibuffer using `minibuffer-message' to not obscure
 the minibuffer contents."
-  (discard-input)
-  (ding)
+  (if (memq 'minibuffer-quit (get (car data) 'error-conditions))
+      (ding t)
+    (discard-input)
+    (ding))
   (let ((string (error-message-string data)))
     ;; If we know from where the error was signaled, show it in
     ;; *Messages*.

diff --git a/src/data.c b/src/data.c
index 9adfafacaa541afdfb80f653e77ca3e940ac06b7..ffca7e753550fa1aed6ca14df848cef6a008c64e 100644 (file)
--- a/src/data.c
+++ b/src/data.c
@@ -3901,6 +3901,7 @@ syms_of_data (void)
   DEFSYM (Qerror, "error");
   DEFSYM (Quser_error, "user-error");
   DEFSYM (Qquit, "quit");
+  DEFSYM (Qminibuffer_quit, "minibuffer-quit");
   DEFSYM (Qwrong_length_argument, "wrong-length-argument");
   DEFSYM (Qwrong_type_argument, "wrong-type-argument");
   DEFSYM (Qargs_out_of_range, "args-out-of-range");
@@ -3973,6 +3974,7 @@ syms_of_data (void)
   Fput (sym, Qerror_message, build_pure_c_string (msg))
 
   PUT_ERROR (Qquit, Qnil, "Quit");
+  PUT_ERROR (Qminibuffer_quit, pure_cons (Qquit, Qnil), "Quit");
 
   PUT_ERROR (Quser_error, error_tail, "");
   PUT_ERROR (Qwrong_length_argument, error_tail, "Wrong length argument");

diff --git a/src/keyboard.c b/src/keyboard.c
index 77d6bbba623e3442746173d82e977d1e4dbf1713..db934686594fac50f26da622eccb07753ab22684 100644 (file)
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -725,6 +725,9 @@ recursive_edit_1 (void)
   if (STRINGP (val))
     xsignal1 (Qerror, val);
 
+  if (FUNCTIONP (val))
+    call0 (val);
+
   return unbind_to (count, Qnil);
 }
 
@@ -921,6 +924,7 @@ static Lisp_Object
 cmd_error (Lisp_Object data)
 {
   Lisp_Object old_level, old_length;
+  Lisp_Object conditions;
   char macroerror[sizeof "After..kbd macro iterations: "
                  + INT_STRLEN_BOUND (EMACS_INT)];
 
@@ -940,10 +944,15 @@ cmd_error (Lisp_Object data)
   else
     *macroerror = 0;
 
+  conditions = Fget (XCAR (data), Qerror_conditions);
+  if (NILP (Fmemq (Qminibuffer_quit, conditions)))
+    {
+      Vexecuting_kbd_macro = Qnil;
+      executing_kbd_macro = Qnil;
+    }
+
   Vstandard_output = Qt;
   Vstandard_input = Qt;
-  Vexecuting_kbd_macro = Qnil;
-  executing_kbd_macro = Qnil;
   kset_prefix_arg (current_kboard, Qnil);
   kset_last_prefix_arg (current_kboard, Qnil);
   cancel_echoing ();
@@ -998,6 +1007,7 @@ Default value of `command-error-function'.  */)
   (Lisp_Object data, Lisp_Object context, Lisp_Object signal)
 {
   struct frame *sf = SELECTED_FRAME ();
+  Lisp_Object conditions;
 
   CHECK_STRING (context);
 
@@ -1024,17 +1034,27 @@ Default value of `command-error-function'.  */)
     }
   else
     {
+      conditions = Fget (XCAR (data), Qerror_conditions);
+
       clear_message (1, 0);
-      Fdiscard_input ();
       message_log_maybe_newline ();
-      bitch_at_user ();
+
+      if (!NILP (Fmemq (Qminibuffer_quit, conditions)))
+       {
+         Fding (Qt);
+       }
+      else
+       {
+         Fdiscard_input ();
+         bitch_at_user ();
+       }
 
       print_error_message (data, Qt, SSDATA (context), signal);
     }
   return Qnil;
 }
 
-static Lisp_Object command_loop_2 (Lisp_Object);
+static Lisp_Object command_loop_1 (void);
 static Lisp_Object top_level_1 (Lisp_Object);
 
 /* Entry to editor-command-loop.
@@ -1062,7 +1082,7 @@ command_loop (void)
   if (command_loop_level > 0 || minibuf_level > 0)
     {
       Lisp_Object val;
-      val = internal_catch (Qexit, command_loop_2, Qnil);
+      val = internal_catch (Qexit, command_loop_2, Qerror);
       executing_kbd_macro = Qnil;
       return val;
     }
@@ -1070,7 +1090,7 @@ command_loop (void)
     while (1)
       {
        internal_catch (Qtop_level, top_level_1, Qnil);
-       internal_catch (Qtop_level, command_loop_2, Qnil);
+       internal_catch (Qtop_level, command_loop_2, Qerror);
        executing_kbd_macro = Qnil;
 
        /* End of file in -batch run causes exit here.  */
@@ -1083,15 +1103,16 @@ command_loop (void)
    editing loop, and reenter the editing loop.
    When there is an error, cmd_error runs and returns a non-nil
    value to us.  A value of nil means that command_loop_1 itself
-   returned due to end of file (or end of kbd macro).  */
+   returned due to end of file (or end of kbd macro).  HANDLERS is a
+   list of condition names, passed to internal_condition_case.  */
 
-static Lisp_Object
-command_loop_2 (Lisp_Object ignore)
+Lisp_Object
+command_loop_2 (Lisp_Object handlers)
 {
   register Lisp_Object val;
 
   do
-    val = internal_condition_case (command_loop_1, Qerror, cmd_error);
+    val = internal_condition_case (command_loop_1, handlers, cmd_error);
   while (!NILP (val));
 
   return Qnil;
@@ -1234,7 +1255,7 @@ static int read_key_sequence (Lisp_Object *, Lisp_Object,
                               bool, bool, bool, bool);
 static void adjust_point_for_property (ptrdiff_t, bool);
 
-Lisp_Object
+static Lisp_Object
 command_loop_1 (void)
 {
   modiff_count prev_modiff = 0;

diff --git a/src/lisp.h b/src/lisp.h
index 1795b9d811b7ccb4aa1c340a49133948f022aaf1..b3f1dc16b13d928fa77542d79635bbb98fde9a23 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4417,7 +4417,7 @@ extern bool detect_input_pending_ignore_squeezables (void);
 extern bool detect_input_pending_run_timers (bool);
 extern void safe_run_hooks (Lisp_Object);
 extern void cmd_error_internal (Lisp_Object, const char *);
-extern Lisp_Object command_loop_1 (void);
+extern Lisp_Object command_loop_2 (Lisp_Object);
 extern Lisp_Object read_menu_command (void);
 extern Lisp_Object recursive_edit_1 (void);
 extern void record_auto_save (void);

diff --git a/src/macros.c b/src/macros.c
index 60d0766a75403818006d2192cba7294d5ae83111..0752a5bb6f612b93ac0318c984b1868579d82d03 100644 (file)
--- a/src/macros.c
+++ b/src/macros.c
@@ -324,7 +324,7 @@ buffer before the macro is executed.  */)
            break;
        }
 
-      command_loop_1 ();
+      command_loop_2 (list1 (Qminibuffer_quit));
 
       executing_kbd_macro_iterations = ++success_count;
 

diff --git a/src/minibuf.c b/src/minibuf.c
index 1b842b772116ec001c25218d3598dc29898ea97b..0f4349e70b846efaef1b7aaea7a32eb1a8fd73bf 100644 (file)
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -496,7 +496,7 @@ confirm the aborting of the current minibuffer and all contained ones.  */)
        }
     }
   else
-    Fthrow (Qexit, Qt);
+    CALLN (Ffuncall, intern ("minibuffer-quit-recursive-edit"));
   return Qnil;
 }