mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-28 07:45:00 +00:00
New special form handler-bind
AFAIK, this provides the same semantics as Common Lisp's `handler-bind`, modulo the differences about how error objects and conditions are represented. * lisp/subr.el (handler-bind): New macro. * src/eval.c (pop_handler): New function. (Fhandler_Bind_1): New function. (signal_or_quit): Handle new handlertypes `HANDLER` and `SKIP_CONDITIONS`. (find_handler_clause): Simplify. (syms_of_eval): Defsubr `Fhandler_bind_1`. * doc/lispref/control.texi (Handling Errors): Add `handler-bind`. * test/src/eval-tests.el (eval-tests--handler-bind): New test. * lisp/emacs-lisp/lisp-mode.el (lisp-font-lock-keywords): Move 'handler-bind' from CL-only to generic Lisp. (handler-bind): Remove indentation setting, it now lives in the macro definition.
This commit is contained in:
Stefan Monnier
parent
225710ba79
commit
5ba75e183c
@ -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
|
||||
|
||||
7
etc/NEWS
7
etc/NEWS
@ -1395,6 +1395,13 @@ This is like 'require', but it checks whether the argument 'feature'
|
||||
is already loaded, in which case it either signals an error or
|
||||
forcibly reloads the file that defines the feature.
|
||||
|
||||
+++
|
||||
** 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.
|
||||
See the Info node "(elisp) Handling Errors".
|
||||
|
||||
+++
|
||||
** New 'pop-up-frames' action alist entry for 'display-buffer'.
|
||||
This has the same effect as the variable of the same name and takes
|
||||
|
||||
@ -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)
|
||||
|
||||
22
lisp/subr.el
22
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 object as argument.
|
||||
HANDLERs can either transfer the control via a non-local exit,
|
||||
or return normally. If a handler returns 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
|
||||
|
||||
97
src/eval.c
97
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);
|
||||
|
||||
39
src/lisp.h
39
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
|
||||
{
|
||||
|
||||
@ -303,4 +303,41 @@ expressions works for identifiers starting with period."
|
||||
(should (eq 'bar (default-value 'eval-tests/buffer-local-var)))
|
||||
(should (eq 'bar eval-tests/buffer-local-var)))))
|
||||
|
||||
(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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user