diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index d4bd8c14ae3..4107963eed5 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -2293,6 +2293,44 @@ should be robust if one does occur. Note that this macro uses @code{condition-case-unless-debug} rather than @code{condition-case}. @end defmac +Occasionally, we want to catch some errors and record some information +about the conditions in which they occurred, such as the full +backtrace, or the current buffer. This kinds of information is sadly +not available in the handlers of a @code{condition-case} because the +stack is unwound before running that handler, so the handler is run in +the dynamic context of the @code{condition-case} rather than that of +the place where the error was signaled. For those circumstances, you +can use the following form: + +@defmac handler-bind handlers body@dots{} +This special form runs @var{body} and if it executes without error, +the value it returns becomes the value of the @code{handler-bind} +form. In this case, the @code{handler-bind} has no effect. + +@var{handlers} should be a list of elements of the form +@code{(@var{conditions} @var{handler})} where @var{conditions} is an +error condition name to be handled, or a list of condition names, and +@var{handler} should be a form whose evaluation should return a function. + +Before running @var{body}, @code{handler-bind} evaluates all the +@var{handler} forms and installs those handlers to be active during +the evaluation of @var{body}. These handlers are searched together +with those installed by @code{condition-case}. When the innermost +matching handler is one installed by @code{handler-bind}, the +@var{handler} function is called with a single argument holding the +error description. + +@var{handler} is called in the dynamic context where the error +happened, without first unwinding the stack, meaning that all the +dynamic bindings are still in effect, except that all the error +handlers between the code that signaled the error and the +@code{handler-bind} are temporarily suspended. Like any normal +function, @var{handler} can exit non-locally, typically via +@code{throw}, or it can return normally. If @var{handler} returns +normally, it means the handler @emph{declined} to handle the error and +the search for an error handler is continued where it left off. +@end defmac + @node Error Symbols @subsubsection Error Symbols and Condition Names @cindex error symbol diff --git a/etc/NEWS b/etc/NEWS index c002ec33d45..b2a7c98ddda 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1361,6 +1361,12 @@ values. * Lisp Changes in Emacs 30.1 ++++ +** New special form 'handler-bind'. +Provides a functionality similar to `condition-case` except it runs the +handler code without unwinding the stack, such that we can record the +backtrace and other dynamic state at the point of the error. + +++ ** New 'pop-up-frames' action alist entry for 'display-buffer'. This has the same effect as the variable of the same name and takes diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index b1fc65b09ac..22d69e255af 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -343,7 +343,7 @@ This will generate compile-time constants from BINDINGS." (lisp-vdefs '("defvar")) (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1" "prog2" "lambda" "unwind-protect" "condition-case" - "when" "unless" "with-output-to-string" + "when" "unless" "with-output-to-string" "handler-bind" "ignore-errors" "dotimes" "dolist" "declare")) (lisp-errs '("warn" "error" "signal")) ;; Elisp constructs. Now they are update dynamically @@ -376,7 +376,7 @@ This will generate compile-time constants from BINDINGS." (cl-kw '("block" "break" "case" "ccase" "compiler-let" "ctypecase" "declaim" "destructuring-bind" "do" "do*" "ecase" "etypecase" "eval-when" "flet" "flet*" - "go" "handler-case" "handler-bind" "in-package" ;; "inline" + "go" "handler-case" "in-package" ;; "inline" "labels" "letf" "locally" "loop" "macrolet" "multiple-value-bind" "multiple-value-prog1" "proclaim" "prog" "prog*" "progv" @@ -1346,7 +1346,6 @@ Lisp function does not specify a special indentation." (put 'catch 'lisp-indent-function 1) (put 'condition-case 'lisp-indent-function 2) (put 'handler-case 'lisp-indent-function 1) ;CL -(put 'handler-bind 'lisp-indent-function 1) ;CL (put 'unwind-protect 'lisp-indent-function 1) (put 'with-output-to-temp-buffer 'lisp-indent-function 1) (put 'closure 'lisp-indent-function 2) diff --git a/lisp/subr.el b/lisp/subr.el index 93428c4a518..600b4d27f18 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -7497,6 +7497,28 @@ predicate conditions in CONDITION." (push buf bufs))) bufs)) +(defmacro handler-bind (handlers &rest body) + "Setup error HANDLERS around execution of BODY. +HANDLERS is a list of (CONDITIONS HANDLER) where +CONDITIONS should be a list of condition names (symbols) or +a single condition name and HANDLER is a form whose evaluation +returns a function. +When an error is signaled during execution of BODY, if that +error matches CONDITIONS, then the associated HANDLER +function is called with the error as argument. +HANDLERs can either transfer the control via a non-local exit, +or return normally. If they return normally the search for an +error handler continues from where it left off." + ;; FIXME: Completion support as in `condition-case'? + (declare (indent 1) (debug ((&rest (sexp form)) body))) + (let ((args '())) + (dolist (cond+handler handlers) + (let ((handler (car (cdr cond+handler))) + (conds (car cond+handler))) + (push `',(ensure-list conds) args) + (push handler args))) + `(handler-bind-1 (lambda () ,@body) ,@(nreverse args)))) + (defmacro with-memoization (place &rest code) "Return the value of CODE and stash it in PLACE. If PLACE's value is non-nil, then don't bother evaluating CODE diff --git a/src/eval.c b/src/eval.c index e13bf2103e1..063414deb0f 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1198,6 +1198,12 @@ usage: (catch TAG BODY...) */) #define clobbered_eassert(E) verify (sizeof (E) != 0) +static void +pop_handler (void) +{ + handlerlist = handlerlist->next; +} + /* Set up a catch, then call C function FUNC on argument ARG. FUNC should return a Lisp_Object. This is how catches are done from within C code. */ @@ -1361,6 +1367,43 @@ usage: (condition-case VAR BODYFORM &rest HANDLERS) */) return internal_lisp_condition_case (var, bodyform, handlers); } +DEFUN ("handler-bind-1", Fhandler_bind_1, Shandler_bind_1, 1, MANY, 0, + doc: /* Setup error handlers around execution of BODYFUN. +BODYFUN be a function and it is called with no arguments. +CONDITIONS should be a list of condition names (symbols). +When an error is signaled during executon of BODYFUN, if that +error matches one of CONDITIONS, then the associated HANDLER is +called with the error as argument. +HANDLER should either transfer the control via a non-local exit, +or return normally. +If it returns normally, the search for an error handler continues +from where it left off. + +usage: (handler-bind BODYFUN [CONDITIONS HANDLER]...) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + eassert (nargs >= 1); + Lisp_Object bodyfun = args[0]; + int count = 0; + if (nargs % 2 == 0) + error ("Trailing CONDITIONS withount HANDLER in `handler-bind`"); + for (ptrdiff_t i = nargs - 2; i > 0; i -= 2) + { + Lisp_Object conditions = args[i], handler = args[i + 1]; + if (NILP (conditions)) + continue; + else if (!CONSP (conditions)) + conditions = Fcons (conditions, Qnil); + struct handler *c = push_handler (conditions, HANDLER_BIND); + c->val = handler; + c->bytecode_dest = count++; + } + Lisp_Object ret = call0 (bodyfun); + for (; count > 0; count--) + pop_handler (); + return ret; +} + /* Like Fcondition_case, but the args are separate rather than passed in a list. Used by Fbyte_code. */ @@ -1737,6 +1780,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) = (NILP (error_symbol) ? Fcar (data) : error_symbol); Lisp_Object clause = Qnil; struct handler *h; + int skip; if (gc_in_progress || waiting_for_input) emacs_abort (); @@ -1759,6 +1803,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) /* Edebug takes care of restoring these variables when it exits. */ max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20); + /* FIXME: 'handler-bind' makes `signal-hook-function' obsolete? */ call2 (Vsignal_hook_function, error_symbol, data); } @@ -1778,16 +1823,42 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) Vsignaling_function = backtrace_function (pdl); } - for (h = handlerlist; h; h = h->next) + for (skip = 0, h = handlerlist; h; skip++, h = h->next) { - if (h->type == CATCHER_ALL) + switch (h->type) { + case CATCHER_ALL: clause = Qt; break; - } - if (h->type != CONDITION_CASE) - continue; - clause = find_handler_clause (h->tag_or_ch, conditions); + case CATCHER: + continue; + case CONDITION_CASE: + clause = find_handler_clause (h->tag_or_ch, conditions); + break; + case HANDLER_BIND: + { + if (!NILP (find_handler_clause (h->tag_or_ch, conditions))) + { + Lisp_Object error_data + = (NILP (error_symbol) + ? data : Fcons (error_symbol, data)); + push_handler (make_fixnum (skip + h->bytecode_dest), + SKIP_CONDITIONS); + call1 (h->val, error_data); + pop_handler (); + } + continue; + } + case SKIP_CONDITIONS: + { + int toskip = XFIXNUM (h->tag_or_ch); + while (toskip-- >= 0) + h = h->next; + continue; + } + default: + abort (); + } if (!NILP (clause)) break; } @@ -1804,7 +1875,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) || (CONSP (clause) && !NILP (Fmemq (Qdebug, clause))) /* Special handler that means "print a message and run debugger if requested". */ - || EQ (h->tag_or_ch, Qerror))) + || EQ (clause, Qerror))) { debugger_called = maybe_call_debugger (conditions, error_symbol, data); @@ -1818,8 +1889,9 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) with debugging. Make sure to use `debug-early' unconditionally to not interfere with ERT or other packages that install custom debuggers. */ + /* FIXME: This could be turned into a `handler-bind` at toplevel? */ if (!debugger_called && !NILP (error_symbol) - && (NILP (clause) || EQ (h->tag_or_ch, Qerror)) + && (NILP (clause) || EQ (clause, Qerror)) && noninteractive && backtrace_on_error_noninteractive && NILP (Vinhibit_debugger) && !NILP (Ffboundp (Qdebug_early))) @@ -1833,6 +1905,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) /* If an error is signaled during a Lisp hook in redisplay, write a backtrace into the buffer *Redisplay-trace*. */ + /* FIXME: Turn this into a `handler-bind` installed during redisplay? */ if (!debugger_called && !NILP (error_symbol) && backtrace_on_redisplay_error && (NILP (clause) || h == redisplay_deep_handler) @@ -2058,13 +2131,10 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions) register Lisp_Object h; /* t is used by handlers for all conditions, set up by C code. */ - if (EQ (handlers, Qt)) - return Qt; - /* error is used similarly, but means print an error message and run the debugger if that is enabled. */ - if (EQ (handlers, Qerror)) - return Qt; + if (!CONSP (handlers)) + return handlers; for (h = handlers; CONSP (h); h = XCDR (h)) { @@ -4494,6 +4564,7 @@ alist of active lexical bindings. */); defsubr (&Sthrow); defsubr (&Sunwind_protect); defsubr (&Scondition_case); + defsubr (&Shandler_bind_1); DEFSYM (QCsuccess, ":success"); defsubr (&Ssignal); defsubr (&Scommandp); diff --git a/src/lisp.h b/src/lisp.h index ed1b007d4c5..84d7853a4f1 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3543,7 +3543,8 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) } /* This structure helps implement the `catch/throw' and `condition-case/signal' - control structures. A struct handler contains all the information needed to + control structures as well as 'handler-bind'. + A struct handler contains all the information needed to restore the state of the interpreter after a non-local jump. Handler structures are chained together in a doubly linked list; the `next' @@ -3564,9 +3565,41 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) state. Members are volatile if their values need to survive _longjmp when - a 'struct handler' is a local variable. */ + a 'struct handler' is a local variable. -enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL }; + When running the HANDLER of a 'handler-bind', we need to + temporarily "mute" the CONDITION_CASEs and HANDLERs that are "below" + the current handler, but without hiding any CATCHERs. We do that by + installing a SKIP_CONDITIONS which tells the search to skip the + N next conditions. */ + +enum handlertype { + CATCHER, /* Entry for 'catch'. + 'tag_or_ch' holds the catch's tag. + 'val' holds the retval during longjmp. */ + CONDITION_CASE, /* Entry for 'condition-case'. + 'tag_or_ch' holds the list of conditions. + 'val' holds the retval during longjmp. */ + CATCHER_ALL, /* Wildcard which catches all 'throw's. + 'tag_or_ch' is unused. + 'val' holds the retval during longjmp. */ + HANDLER_BIND, /* Entry for 'handler-bind'. + 'tag_or_ch' holds the list of conditions. + 'val' holds the handler function. + The rest of the handler is unused, + except for 'bytecode_dest' that holds + the number of preceding HANDLER_BIND + entries which belong to the same + 'handler-bind' (and hence need to + be muted together). */ + SKIP_CONDITIONS /* Mask out the N preceding entries. + Used while running the handler of + a HANDLER_BIND to hides the condition + handlers underneath (and including) + the 'handler-bind'. + 'tag_or_ch' holds that number, the rest + is unused. */ +}; enum nonlocal_exit { diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index 4589763b2f5..f288b985579 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -282,4 +282,41 @@ expressions works for identifiers starting with period." (should-error (defvaralias 'eval-tests--my-c 'eval-tests--my-d) :type 'cyclic-variable-indirection)) +(ert-deftest eval-tests--handler-bind () + ;; A `handler-bind' has no effect if no error is signaled. + (should (equal (catch 'tag + (handler-bind ((error (lambda (_err) (throw 'tag 'wow)))) + 'noerror)) + 'noerror)) + ;; The handler is called from within the dynamic extent where the + ;; error is signaled, unlike `condition-case'. + (should (equal (catch 'tag + (handler-bind ((error (lambda (_err) (throw 'tag 'err)))) + (list 'inner-catch + (catch 'tag + (user-error "hello"))))) + '(inner-catch err))) + ;; But inner condition handlers are temporarily muted. + (should (equal (condition-case nil + (handler-bind + ((error (lambda (_err) + (signal 'wrong-type-argument nil)))) + (list 'result + (condition-case nil + (user-error "hello") + (wrong-type-argument 'inner-handler)))) + (wrong-type-argument 'wrong-type-argument)) + 'wrong-type-argument)) + ;; Handlers do not apply to the code run within the handlers. + (should (equal (condition-case nil + (handler-bind + ((error (lambda (_err) + (signal 'wrong-type-argument nil))) + (wrong-type-argument + (lambda (_err) (user-error "wrong-type-argument")))) + (user-error "hello")) + (wrong-type-argument 'wrong-type-argument) + (error 'plain-error)) + 'wrong-type-argument))) + ;;; eval-tests.el ends here