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.
This commit is contained in:
Stefan Monnier
parent
947b656632
commit
f6d6298639
7 changed files with 187 additions and 89 deletions
|
|
@ -1,3 +1,8 @@
|
|||
2011-03-28 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* commands.texi (Command Overview): post-command-hook is not reset to
|
||||
nil any more.
|
||||
|
||||
2011-03-19 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* strings.texi (String Conversion): Don't mention
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
5
etc/NEWS
5
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.
|
||||
|
|
|
|||
|
|
@ -1,3 +1,20 @@
|
|||
2011-03-28 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* 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 <lekktu@gmail.com>
|
||||
|
||||
* dispextern.h (string_buffer_position): Remove declaration.
|
||||
|
|
|
|||
155
src/eval.c
155
src/eval.c
|
|
@ -30,19 +30,19 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
|
|||
#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);
|
||||
|
|
|
|||
|
|
@ -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 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);
|
||||
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)
|
||||
{
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue