From 289f4d6cae45c6846d9ef4c245b1635056a2f288 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miha=20Rihtar=C5=A1i=C4=8D?= Date: Sun, 23 May 2021 16:08:43 +0200 Subject: [PATCH] Quit minibuffers without aborting kmacros * 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. * 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. * src/minibuf.c (Fabort_minibuffers): Use it. * lisp/simple.el (minibuffer-error-function): Do not abort keyboard macro execution if is minibuffer-quit is signaled. --- doc/lispref/commands.texi | 14 +++++++++--- doc/lispref/errors.texi | 9 ++++++-- etc/NEWS | 9 ++++++++ lisp/minibuffer.el | 9 ++++++++ lisp/simple.el | 6 ++++-- src/data.c | 2 ++ src/keyboard.c | 45 ++++++++++++++++++++++++++++----------- src/lisp.h | 2 +- src/macros.c | 2 +- src/minibuf.c | 2 +- 10 files changed, 78 insertions(+), 22 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 8199ece110..164e1ad630 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -3378,6 +3378,12 @@ Quitting in @ref{Errors}.) @end deffn + To quit without aborting 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 breaking 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}. @@ -3562,12 +3568,14 @@ Recursive Editing @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 fb393b951f..f848218e26 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -20,8 +20,9 @@ Standard Errors 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 @@ Standard 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 ea74dfe217..1bfd87dcb7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2705,6 +2705,15 @@ the Emacs Lisp reference manual for background. * Lisp Changes in Emacs 28.1 ++++ +** 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. + --- ** Emacs now attempts to test for high-rate subprocess output more fairly. When several subprocesses produce output simultaneously at high rate, diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index ec21b7b93b..400dff058c 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2318,6 +2318,15 @@ exit-minibuffer (setq deactivate-mark nil) (throw 'exit nil)) +(defun minibuffer-quit-recursive-edit () + "Quit the command that requested this recursive edit wihtout error. +Like `abort-recursive-edit' wihtout 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 8849919360..4546bbde2a 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2855,8 +2855,10 @@ minibuffer-error-function 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 d547f5da5e..903d171d8b 100644 --- a/src/data.c +++ b/src/data.c @@ -3899,6 +3899,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"); @@ -3971,6 +3972,7 @@ #define PUT_ERROR(sym, tail, msg) \ 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 47b5e59024..0ac6d24b0a 100644 --- 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 @@ restore_kboard_configuration (int was_locked) 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 @@ DEFUN ("command-error-default-function", Fcommand_error_default_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 @@ DEFUN ("command-error-default-function", Fcommand_error_default_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 @@ some_mouse_moved (void) 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 91b7a89d0f..a30d7b861d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4417,7 +4417,7 @@ fast_string_match_ignore_case (Lisp_Object regexp, Lisp_Object string) 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 60d0766a75..0752a5bb6f 100644 --- a/src/macros.c +++ b/src/macros.c @@ -324,7 +324,7 @@ DEFUN ("execute-kbd-macro", Fexecute_kbd_macro, Sexecute_kbd_macro, 1, 3, 0, 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 cffb7fe787..9f4970320e 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -496,7 +496,7 @@ DEFUN ("abort-minibuffers", Fabort_minibuffers, Sabort_minibuffers, 0, 0, "", } } else - Fthrow (Qexit, Qt); + CALLN (Ffuncall, intern ("minibuffer-quit-recursive-edit")); return Qnil; } -- 2.31.1