From f6d6298639ae43539581c2079666d76a54f1557e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 28 Mar 2011 16:26:35 -0400 Subject: [PATCH] Don't reset post-command-hook to nil upon error. * src/eval.c (enum run_hooks_condition): Remove. (funcall_nil, funcall_not): New functions. (run_hook_with_args): Call each function through a `funcall' argument. Remove `cond' argument, now redundant. (Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success) (Frun_hook_with_args_until_failure): Adjust accordingly. (run_hook_wrapped_funcall, Frun_hook_wrapped): New functions. * src/keyboard.c (safe_run_hook_funcall): New function. (safe_run_hooks_1, safe_run_hooks_error, safe_run_hooks): On error, don't set the hook to nil, but remove the offending function instead. (Qcommand_hook_internal): Remove, unused. (syms_of_keyboard): Don't initialize Qcommand_hook_internal nor define Vcommand_hook_internal. * doc/lispref/commands.texi (Command Overview): post-command-hook is not reset to nil any more. --- doc/lispref/ChangeLog | 5 ++ doc/lispref/commands.texi | 5 +- etc/NEWS | 5 ++ src/ChangeLog | 17 +++++ src/eval.c | 155 ++++++++++++++++++++++---------------- src/keyboard.c | 82 ++++++++++++++------ src/lisp.h | 7 +- 7 files changed, 187 insertions(+), 89 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index c705aae4934..1eb3cfa2556 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,8 @@ +2011-03-28 Stefan Monnier + + * commands.texi (Command Overview): post-command-hook is not reset to + nil any more. + 2011-03-19 Stefan Monnier * strings.texi (String Conversion): Don't mention diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 4f8d554a68b..eb42ddb11a4 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -91,8 +91,9 @@ and also when the command loop is first entered. At that time, Quitting is suppressed while running @code{pre-command-hook} and @code{post-command-hook}. If an error happens while executing one of -these hooks, it terminates execution of the hook, and clears the hook -variable to @code{nil} so as to prevent an infinite loop of errors. +these hooks, it does not terminate execution of the hook; instead +the error is silenced and the function in which the error occurred +is removed from the hook. A request coming into the Emacs server (@pxref{Emacs Server,,, emacs, The GNU Emacs Manual}) runs these two hooks just as a keyboard diff --git a/etc/NEWS b/etc/NEWS index c48af3a3b40..969b1cdcf5f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -748,6 +748,11 @@ sc.el, x-menu.el, rnews.el, rnewspost.el * Lisp changes in Emacs 24.1 +** pre/post-command-hook are not reset to nil upon error. +Instead, the offending function is removed. + +** New low-level function run-hook-wrapped. + ** byte-compile-disable-print-circle is obsolete. ** deferred-action-list and deferred-action-function are obsolete. ** Removed the stack-trace-on-error variable. diff --git a/src/ChangeLog b/src/ChangeLog index 75b75ab522c..be55ef369b3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,20 @@ +2011-03-28 Stefan Monnier + + * keyboard.c (safe_run_hook_funcall): New function. + (safe_run_hooks_1, safe_run_hooks_error, safe_run_hooks): On error, + don't set the hook to nil, but remove the offending function instead. + (Qcommand_hook_internal): Remove, unused. + (syms_of_keyboard): Don't initialize Qcommand_hook_internal nor define + Vcommand_hook_internal. + + * eval.c (enum run_hooks_condition): Remove. + (funcall_nil, funcall_not): New functions. + (run_hook_with_args): Call each function through a `funcall' argument. + Remove `cond' argument, now redundant. + (Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success) + (Frun_hook_with_args_until_failure): Adjust accordingly. + (run_hook_wrapped_funcall, Frun_hook_wrapped): New functions. + 2011-03-28 Juanma Barranquero * dispextern.h (string_buffer_position): Remove declaration. diff --git a/src/eval.c b/src/eval.c index f68274e6e8c..75874367f2c 100644 --- a/src/eval.c +++ b/src/eval.c @@ -30,19 +30,19 @@ along with GNU Emacs. If not, see . */ #include "xterm.h" #endif -/* This definition is duplicated in alloc.c and keyboard.c */ -/* Putting it in lisp.h makes cc bomb out! */ +/* This definition is duplicated in alloc.c and keyboard.c. */ +/* Putting it in lisp.h makes cc bomb out! */ struct backtrace { struct backtrace *next; Lisp_Object *function; - Lisp_Object *args; /* Points to vector of args. */ + Lisp_Object *args; /* Points to vector of args. */ int nargs; /* Length of vector. If nargs is UNEVALLED, args points to slot holding - list of unevalled args */ + list of unevalled args. */ char evalargs; - /* Nonzero means call value of debugger when done with this operation. */ + /* Nonzero means call value of debugger when done with this operation. */ char debug_on_exit; }; @@ -146,7 +146,7 @@ init_eval (void) when_entered_debugger = -1; } -/* unwind-protect function used by call_debugger. */ +/* Unwind-protect function used by call_debugger. */ static Lisp_Object restore_stack_limits (Lisp_Object data) @@ -556,7 +556,7 @@ interactive_p (int exclude_subrs_p) || btp->nargs == UNEVALLED)) btp = btp->next; - /* btp now points at the frame of the innermost function that isn't + /* `btp' now points at the frame of the innermost function that isn't a special form, ignoring frames for Finteractive_p and/or Fbytecode at the top. If this frame is for a built-in function (such as load or eval-region) return nil. */ @@ -564,7 +564,7 @@ interactive_p (int exclude_subrs_p) if (exclude_subrs_p && SUBRP (fun)) return 0; - /* btp points to the frame of a Lisp function that called interactive-p. + /* `btp' points to the frame of a Lisp function that called interactive-p. Return t if that function was called interactively. */ if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively)) return 1; @@ -965,11 +965,11 @@ usage: (let VARLIST BODY...) */) varlist = Fcar (args); - /* Make space to hold the values to give the bound variables */ + /* Make space to hold the values to give the bound variables. */ elt = Flength (varlist); SAFE_ALLOCA_LISP (temps, XFASTINT (elt)); - /* Compute the values and store them in `temps' */ + /* Compute the values and store them in `temps'. */ GCPRO2 (args, *temps); gcpro2.nvars = 0; @@ -1072,7 +1072,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */) /* SYM is not mentioned in ENVIRONMENT. Look at its function definition. */ if (EQ (def, Qunbound) || !CONSP (def)) - /* Not defined or definition not suitable */ + /* Not defined or definition not suitable. */ break; if (EQ (XCAR (def), Qautoload)) { @@ -1213,10 +1213,7 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value) byte_stack_list = catch->byte_stack; gcprolist = catch->gcpro; #ifdef DEBUG_GCPRO - if (gcprolist != 0) - gcpro_level = gcprolist->level + 1; - else - gcpro_level = 0; + gcpro_level = gcprolist ? gcprolist->level + 1 : gcpro_level = 0; #endif backtrace_list = catch->backlist; lisp_eval_depth = catch->lisp_eval_depth; @@ -1824,7 +1821,7 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data) ? debug_on_quit : wants_debugger (Vdebug_on_error, conditions)) && ! skip_debugger (conditions, combined_data) - /* rms: what's this for? */ + /* RMS: What's this for? */ && when_entered_debugger < num_nonmacro_input_events) { call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil))); @@ -1891,7 +1888,7 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions, } -/* dump an error message; called like vprintf */ +/* Dump an error message; called like vprintf. */ void verror (const char *m, va_list ap) { @@ -1928,7 +1925,7 @@ verror (const char *m, va_list ap) } -/* dump an error message; called like printf */ +/* Dump an error message; called like printf. */ /* VARARGS 1 */ void @@ -2024,7 +2021,7 @@ this does nothing and returns nil. */) CHECK_SYMBOL (function); CHECK_STRING (file); - /* If function is defined and not as an autoload, don't override */ + /* If function is defined and not as an autoload, don't override. */ if (!EQ (XSYMBOL (function)->function, Qunbound) && !(CONSP (XSYMBOL (function)->function) && EQ (XCAR (XSYMBOL (function)->function), Qautoload))) @@ -2159,7 +2156,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, backtrace.next = backtrace_list; backtrace_list = &backtrace; - backtrace.function = &original_fun; /* This also protects them from gc */ + backtrace.function = &original_fun; /* This also protects them from gc. */ backtrace.args = &original_args; backtrace.nargs = UNEVALLED; backtrace.evalargs = 1; @@ -2169,7 +2166,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, do_debug_on_call (Qt); /* At this point, only original_fun and original_args - have values that will be used below */ + have values that will be used below. */ retry: /* Optimize for no indirection. */ @@ -2190,8 +2187,9 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, CHECK_CONS_LIST (); - if (XINT (numargs) < XSUBR (fun)->min_args || - (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs))) + if (XINT (numargs) < XSUBR (fun)->min_args + || (XSUBR (fun)->max_args >= 0 + && XSUBR (fun)->max_args < XINT (numargs))) xsignal2 (Qwrong_number_of_arguments, original_fun, numargs); else if (XSUBR (fun)->max_args == UNEVALLED) @@ -2201,7 +2199,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, } else if (XSUBR (fun)->max_args == MANY) { - /* Pass a vector of evaluated arguments */ + /* Pass a vector of evaluated arguments. */ Lisp_Object *vals; register int argnum = 0; USE_SAFE_ALLOCA; @@ -2364,7 +2362,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) fun = indirect_function (fun); if (EQ (fun, Qunbound)) { - /* Let funcall get the error */ + /* Let funcall get the error. */ fun = args[0]; goto funcall; } @@ -2373,11 +2371,11 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) { if (numargs < XSUBR (fun)->min_args || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) - goto funcall; /* Let funcall get the error */ + goto funcall; /* Let funcall get the error. */ else if (XSUBR (fun)->max_args > numargs) { /* Avoid making funcall cons up a yet another new vector of arguments - by explicitly supplying nil's for optional values */ + by explicitly supplying nil's for optional values. */ SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args); for (i = numargs; i < XSUBR (fun)->max_args;) funcall_args[++i] = Qnil; @@ -2415,9 +2413,16 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) /* Run hook variables in various ways. */ -enum run_hooks_condition {to_completion, until_success, until_failure}; -static Lisp_Object run_hook_with_args (int, Lisp_Object *, - enum run_hooks_condition); +Lisp_Object run_hook_with_args (int, Lisp_Object *, + Lisp_Object (*funcall) + (int nargs, Lisp_Object *args)); + +static Lisp_Object +funcall_nil (int nargs, Lisp_Object *args) +{ + Ffuncall (nargs, args); + return Qnil; +} DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0, doc: /* Run each hook in HOOKS. @@ -2442,7 +2447,7 @@ usage: (run-hooks &rest HOOKS) */) for (i = 0; i < nargs; i++) { hook[0] = args[i]; - run_hook_with_args (1, hook, to_completion); + run_hook_with_args (1, hook, funcall_nil); } return Qnil; @@ -2465,7 +2470,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. usage: (run-hook-with-args HOOK &rest ARGS) */) (int nargs, Lisp_Object *args) { - return run_hook_with_args (nargs, args, to_completion); + return run_hook_with_args (nargs, args, funcall_nil); } DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success, @@ -2485,7 +2490,13 @@ Instead, use `add-hook' and specify t for the LOCAL argument. usage: (run-hook-with-args-until-success HOOK &rest ARGS) */) (int nargs, Lisp_Object *args) { - return run_hook_with_args (nargs, args, until_success); + return run_hook_with_args (nargs, args, Ffuncall); +} + +static Lisp_Object +funcall_not (int nargs, Lisp_Object *args) +{ + return NILP (Ffuncall (nargs, args)) ? Qt : Qnil; } DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure, @@ -2504,21 +2515,45 @@ Instead, use `add-hook' and specify t for the LOCAL argument. usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */) (int nargs, Lisp_Object *args) { - return run_hook_with_args (nargs, args, until_failure); + return NILP (run_hook_with_args (nargs, args, funcall_not)) ? Qt : Qnil; } +static Lisp_Object +run_hook_wrapped_funcall (int nargs, Lisp_Object *args) +{ + Lisp_Object tmp = args[0], ret; + args[0] = args[1]; + args[1] = tmp; + ret = Ffuncall (nargs, args); + args[1] = args[0]; + args[0] = tmp; + return ret; +} + +DEFUN ("run-hook-wrapped", Frun_hook_wrapped, Srun_hook_wrapped, 2, MANY, 0, + doc: /* Run HOOK, passing each function through WRAP-FUNCTION. +I.e. instead of calling each function FUN directly with arguments ARGS, +it calls WRAP-FUNCTION with arguments FUN and ARGS. +As soon as a call to WRAP-FUNCTION returns non-nil, `run-hook-wrapped' +aborts and returns that value. +usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS) */) + (int nargs, Lisp_Object *args) +{ + return run_hook_with_args (nargs, args, run_hook_wrapped_funcall); +} + /* ARGS[0] should be a hook symbol. Call each of the functions in the hook value, passing each of them as arguments all the rest of ARGS (all NARGS - 1 elements). - COND specifies a condition to test after each call - to decide whether to stop. + FUNCALL specifies how to call each function on the hook. The caller (or its caller, etc) must gcpro all of ARGS, except that it isn't necessary to gcpro ARGS[0]. */ -static Lisp_Object -run_hook_with_args (int nargs, Lisp_Object *args, enum run_hooks_condition cond) +Lisp_Object +run_hook_with_args (int nargs, Lisp_Object *args, + Lisp_Object (*funcall) (int nargs, Lisp_Object *args)) { - Lisp_Object sym, val, ret; + Lisp_Object sym, val, ret = Qnil; struct gcpro gcpro1, gcpro2, gcpro3; /* If we are dying or still initializing, @@ -2528,14 +2563,13 @@ run_hook_with_args (int nargs, Lisp_Object *args, enum run_hooks_condition cond) sym = args[0]; val = find_symbol_value (sym); - ret = (cond == until_failure ? Qt : Qnil); if (EQ (val, Qunbound) || NILP (val)) return ret; else if (!CONSP (val) || EQ (XCAR (val), Qlambda)) { args[0] = val; - return Ffuncall (nargs, args); + return funcall (nargs, args); } else { @@ -2543,9 +2577,7 @@ run_hook_with_args (int nargs, Lisp_Object *args, enum run_hooks_condition cond) GCPRO3 (sym, val, global_vals); for (; - CONSP (val) && ((cond == to_completion) - || (cond == until_success ? NILP (ret) - : !NILP (ret))); + CONSP (val) && NILP (ret); val = XCDR (val)) { if (EQ (XCAR (val), Qt)) @@ -2558,30 +2590,26 @@ run_hook_with_args (int nargs, Lisp_Object *args, enum run_hooks_condition cond) if (!CONSP (global_vals) || EQ (XCAR (global_vals), Qlambda)) { args[0] = global_vals; - ret = Ffuncall (nargs, args); + ret = funcall (nargs, args); } else { for (; - (CONSP (global_vals) - && (cond == to_completion - || (cond == until_success - ? NILP (ret) - : !NILP (ret)))); + CONSP (global_vals) && NILP (ret); global_vals = XCDR (global_vals)) { args[0] = XCAR (global_vals); /* In a global value, t should not occur. If it does, we must ignore it to avoid an endless loop. */ if (!EQ (args[0], Qt)) - ret = Ffuncall (nargs, args); + ret = funcall (nargs, args); } } } else { args[0] = XCAR (val); - ret = Ffuncall (nargs, args); + ret = funcall (nargs, args); } } @@ -2603,7 +2631,7 @@ run_hook_with_args_2 (Lisp_Object hook, Lisp_Object arg1, Lisp_Object arg2) Frun_hook_with_args (3, temp); } -/* Apply fn to arg */ +/* Apply fn to arg. */ Lisp_Object apply1 (Lisp_Object fn, Lisp_Object arg) { @@ -2622,7 +2650,7 @@ apply1 (Lisp_Object fn, Lisp_Object arg) } } -/* Call function fn on no arguments */ +/* Call function fn on no arguments. */ Lisp_Object call0 (Lisp_Object fn) { @@ -2632,7 +2660,7 @@ call0 (Lisp_Object fn) RETURN_UNGCPRO (Ffuncall (1, &fn)); } -/* Call function fn with 1 argument arg1 */ +/* Call function fn with 1 argument arg1. */ /* ARGSUSED */ Lisp_Object call1 (Lisp_Object fn, Lisp_Object arg1) @@ -2647,7 +2675,7 @@ call1 (Lisp_Object fn, Lisp_Object arg1) RETURN_UNGCPRO (Ffuncall (2, args)); } -/* Call function fn with 2 arguments arg1, arg2 */ +/* Call function fn with 2 arguments arg1, arg2. */ /* ARGSUSED */ Lisp_Object call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2) @@ -2662,7 +2690,7 @@ call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2) RETURN_UNGCPRO (Ffuncall (3, args)); } -/* Call function fn with 3 arguments arg1, arg2, arg3 */ +/* Call function fn with 3 arguments arg1, arg2, arg3. */ /* ARGSUSED */ Lisp_Object call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3) @@ -2678,7 +2706,7 @@ call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3) RETURN_UNGCPRO (Ffuncall (4, args)); } -/* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */ +/* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */ /* ARGSUSED */ Lisp_Object call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, @@ -2696,7 +2724,7 @@ call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, RETURN_UNGCPRO (Ffuncall (5, args)); } -/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */ +/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */ /* ARGSUSED */ Lisp_Object call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, @@ -2715,7 +2743,7 @@ call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, RETURN_UNGCPRO (Ffuncall (6, args)); } -/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */ +/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */ /* ARGSUSED */ Lisp_Object call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, @@ -2735,7 +2763,7 @@ call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, RETURN_UNGCPRO (Ffuncall (7, args)); } -/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7 */ +/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */ /* ARGSUSED */ Lisp_Object call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, @@ -3079,7 +3107,7 @@ grow_specpdl (void) specpdl_ptr = specpdl + count; } -/* specpdl_ptr->symbol is a field which describes which variable is +/* `specpdl_ptr->symbol' is a field which describes which variable is let-bound, so it can be properly undone when we unbind_to. It can have the following two shapes: - SYMBOL : if it's a plain symbol, it means that we have let-bound @@ -3318,7 +3346,7 @@ Output stream used is value of `standard-output'. */) else { tem = *backlist->function; - Fprin1 (tem, Qnil); /* This can QUIT */ + Fprin1 (tem, Qnil); /* This can QUIT. */ write_string ("(", -1); if (backlist->nargs == MANY) { @@ -3588,6 +3616,7 @@ The value the function returns is not used. */); defsubr (&Srun_hook_with_args); defsubr (&Srun_hook_with_args_until_success); defsubr (&Srun_hook_with_args_until_failure); + defsubr (&Srun_hook_wrapped); defsubr (&Sfetch_bytecode); defsubr (&Sbacktrace_debug); defsubr (&Sbacktrace); diff --git a/src/keyboard.c b/src/keyboard.c index 06f375e0d9c..3fea3df07d5 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -254,7 +254,6 @@ Lisp_Object Qecho_area_clear_hook; /* Hooks to run before and after each command. */ Lisp_Object Qpre_command_hook; Lisp_Object Qpost_command_hook; -Lisp_Object Qcommand_hook_internal; Lisp_Object Qdeferred_action_function; @@ -1815,20 +1814,63 @@ adjust_point_for_property (EMACS_INT last_pt, int modified) static Lisp_Object safe_run_hooks_1 (void) { - return Frun_hooks (1, &Vinhibit_quit); + eassert (CONSP (Vinhibit_quit)); + return call0 (XCDR (Vinhibit_quit)); } -/* Subroutine for safe_run_hooks: handle an error by clearing out the hook. */ +/* Subroutine for safe_run_hooks: handle an error by clearing out the function + from the hook. */ static Lisp_Object -safe_run_hooks_error (Lisp_Object data) +safe_run_hooks_error (Lisp_Object error_data) +{ + Lisp_Object hook + = CONSP (Vinhibit_quit) ? XCAR (Vinhibit_quit) : Vinhibit_quit; + Lisp_Object fun = CONSP (Vinhibit_quit) ? XCDR (Vinhibit_quit) : Qnil; + Lisp_Object args[4]; + args[0] = build_string ("Error in %s (%s): %s"); + args[1] = hook; + args[2] = fun; + args[3] = error_data; + Fmessage (4, args); + if (SYMBOLP (hook)) + { + Lisp_Object val; + int found = 0; + Lisp_Object newval = Qnil; + for (val = find_symbol_value (hook); CONSP (val); val = XCDR (val)) + if (EQ (fun, XCAR (val))) + found = 1; + else + newval = Fcons (XCAR (val), newval); + if (found) + return Fset (hook, Fnreverse (newval)); + /* Not found in the local part of the hook. Let's look at the global + part. */ + newval = Qnil; + for (val = (NILP (Fdefault_boundp (hook)) ? Qnil + : Fdefault_value (hook)); + CONSP (val); val = XCDR (val)) + if (EQ (fun, XCAR (val))) + found = 1; + else + newval = Fcons (XCAR (val), newval); + if (found) + return Fset_default (hook, Fnreverse (newval)); + } + return Qnil; +} + +static Lisp_Object +safe_run_hook_funcall (int nargs, Lisp_Object *args) { - Lisp_Object args[3]; - args[0] = build_string ("Error in %s: %s"); - args[1] = Vinhibit_quit; - args[2] = data; - Fmessage (3, args); - return Fset (Vinhibit_quit, Qnil); + eassert (nargs == 1); + if (CONSP (Vinhibit_quit)) + XSETCDR (Vinhibit_quit, args[0]); + else + Vinhibit_quit = Fcons (Vinhibit_quit, args[0]); + + return internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error); } /* If we get an error while running the hook, cause the hook variable @@ -1838,10 +1880,13 @@ safe_run_hooks_error (Lisp_Object data) void safe_run_hooks (Lisp_Object hook) { + /* FIXME: our `internal_condition_case' does not provide any way to pass data + to its body or to its handlers other than via globals such as + dynamically-bound variables ;-) */ int count = SPECPDL_INDEX (); specbind (Qinhibit_quit, hook); - internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error); + run_hook_with_args (1, &hook, safe_run_hook_funcall); unbind_to (count, Qnil); } @@ -11438,9 +11483,6 @@ syms_of_keyboard (void) Qdeferred_action_function = intern_c_string ("deferred-action-function"); staticpro (&Qdeferred_action_function); - Qcommand_hook_internal = intern_c_string ("command-hook-internal"); - staticpro (&Qcommand_hook_internal); - Qfunction_key = intern_c_string ("function-key"); staticpro (&Qfunction_key); Qmouse_click = intern_c_string ("mouse-click"); @@ -11908,22 +11950,18 @@ Buffer modification stores t in this variable. */); Qdeactivate_mark = intern_c_string ("deactivate-mark"); staticpro (&Qdeactivate_mark); - DEFVAR_LISP ("command-hook-internal", Vcommand_hook_internal, - doc: /* Temporary storage of `pre-command-hook' or `post-command-hook'. */); - Vcommand_hook_internal = Qnil; - DEFVAR_LISP ("pre-command-hook", Vpre_command_hook, doc: /* Normal hook run before each command is executed. If an unhandled error happens in running this hook, -the hook value is set to nil, since otherwise the error -might happen repeatedly and make Emacs nonfunctional. */); +the function in which the error occurred is unconditionally removed, since +otherwise the error might happen repeatedly and make Emacs nonfunctional. */); Vpre_command_hook = Qnil; DEFVAR_LISP ("post-command-hook", Vpost_command_hook, doc: /* Normal hook run after each command is executed. If an unhandled error happens in running this hook, -the hook value is set to nil, since otherwise the error -might happen repeatedly and make Emacs nonfunctional. */); +the function in which the error occurred is unconditionally removed, since +otherwise the error might happen repeatedly and make Emacs nonfunctional. */); Vpost_command_hook = Qnil; #if 0 diff --git a/src/lisp.h b/src/lisp.h index 8c7d4da8aa9..1e255df1ecc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2278,7 +2278,7 @@ void staticpro (Lisp_Object *); struct window; struct frame; -/* Defined in data.c */ +/* Defined in data.c. */ extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound; extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; extern Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range; @@ -2812,7 +2812,7 @@ extern void init_obarray (void); extern void init_lread (void); extern void syms_of_lread (void); -/* Defined in eval.c */ +/* Defined in eval.c. */ extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro; extern Lisp_Object Qinhibit_quit; extern Lisp_Object Vautoload_queue; @@ -2830,6 +2830,9 @@ EXFUN (Frun_hooks, MANY); EXFUN (Frun_hook_with_args, MANY); EXFUN (Frun_hook_with_args_until_failure, MANY); extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object); +extern Lisp_Object run_hook_with_args (int nargs, Lisp_Object *args, + Lisp_Object (*funcall) + (int nargs, Lisp_Object *args)); EXFUN (Fprogn, UNEVALLED); EXFUN (Finteractive_p, 0); EXFUN (Fthrow, 2) NO_RETURN; -- 2.39.5