aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorStefan Monnier2011-03-28 16:26:35 -0400
committerStefan Monnier2011-03-28 16:26:35 -0400
commitf6d6298639ae43539581c2079666d76a54f1557e (patch)
tree851ead8f971b04dc30905d465e305e3d9efdf49d /src
parent947b656632a76ebb01eda0550c34b1ac43684a98 (diff)
downloademacs-f6d6298639ae43539581c2079666d76a54f1557e.tar.gz
emacs-f6d6298639ae43539581c2079666d76a54f1557e.zip
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.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog17
-rw-r--r--src/eval.c155
-rw-r--r--src/keyboard.c82
-rw-r--r--src/lisp.h7
4 files changed, 174 insertions, 87 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 75b75ab522c..be55ef369b3 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,20 @@
12011-03-28 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * keyboard.c (safe_run_hook_funcall): New function.
4 (safe_run_hooks_1, safe_run_hooks_error, safe_run_hooks): On error,
5 don't set the hook to nil, but remove the offending function instead.
6 (Qcommand_hook_internal): Remove, unused.
7 (syms_of_keyboard): Don't initialize Qcommand_hook_internal nor define
8 Vcommand_hook_internal.
9
10 * eval.c (enum run_hooks_condition): Remove.
11 (funcall_nil, funcall_not): New functions.
12 (run_hook_with_args): Call each function through a `funcall' argument.
13 Remove `cond' argument, now redundant.
14 (Frun_hooks, Frun_hook_with_args, Frun_hook_with_args_until_success)
15 (Frun_hook_with_args_until_failure): Adjust accordingly.
16 (run_hook_wrapped_funcall, Frun_hook_wrapped): New functions.
17
12011-03-28 Juanma Barranquero <lekktu@gmail.com> 182011-03-28 Juanma Barranquero <lekktu@gmail.com>
2 19
3 * dispextern.h (string_buffer_position): Remove declaration. 20 * 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 <http://www.gnu.org/licenses/>. */
30#include "xterm.h" 30#include "xterm.h"
31#endif 31#endif
32 32
33/* This definition is duplicated in alloc.c and keyboard.c */ 33/* This definition is duplicated in alloc.c and keyboard.c. */
34/* Putting it in lisp.h makes cc bomb out! */ 34/* Putting it in lisp.h makes cc bomb out! */
35 35
36struct backtrace 36struct backtrace
37{ 37{
38 struct backtrace *next; 38 struct backtrace *next;
39 Lisp_Object *function; 39 Lisp_Object *function;
40 Lisp_Object *args; /* Points to vector of args. */ 40 Lisp_Object *args; /* Points to vector of args. */
41 int nargs; /* Length of vector. 41 int nargs; /* Length of vector.
42 If nargs is UNEVALLED, args points to slot holding 42 If nargs is UNEVALLED, args points to slot holding
43 list of unevalled args */ 43 list of unevalled args. */
44 char evalargs; 44 char evalargs;
45 /* Nonzero means call value of debugger when done with this operation. */ 45 /* Nonzero means call value of debugger when done with this operation. */
46 char debug_on_exit; 46 char debug_on_exit;
47}; 47};
48 48
@@ -146,7 +146,7 @@ init_eval (void)
146 when_entered_debugger = -1; 146 when_entered_debugger = -1;
147} 147}
148 148
149/* unwind-protect function used by call_debugger. */ 149/* Unwind-protect function used by call_debugger. */
150 150
151static Lisp_Object 151static Lisp_Object
152restore_stack_limits (Lisp_Object data) 152restore_stack_limits (Lisp_Object data)
@@ -556,7 +556,7 @@ interactive_p (int exclude_subrs_p)
556 || btp->nargs == UNEVALLED)) 556 || btp->nargs == UNEVALLED))
557 btp = btp->next; 557 btp = btp->next;
558 558
559 /* btp now points at the frame of the innermost function that isn't 559 /* `btp' now points at the frame of the innermost function that isn't
560 a special form, ignoring frames for Finteractive_p and/or 560 a special form, ignoring frames for Finteractive_p and/or
561 Fbytecode at the top. If this frame is for a built-in function 561 Fbytecode at the top. If this frame is for a built-in function
562 (such as load or eval-region) return nil. */ 562 (such as load or eval-region) return nil. */
@@ -564,7 +564,7 @@ interactive_p (int exclude_subrs_p)
564 if (exclude_subrs_p && SUBRP (fun)) 564 if (exclude_subrs_p && SUBRP (fun))
565 return 0; 565 return 0;
566 566
567 /* btp points to the frame of a Lisp function that called interactive-p. 567 /* `btp' points to the frame of a Lisp function that called interactive-p.
568 Return t if that function was called interactively. */ 568 Return t if that function was called interactively. */
569 if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively)) 569 if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
570 return 1; 570 return 1;
@@ -965,11 +965,11 @@ usage: (let VARLIST BODY...) */)
965 965
966 varlist = Fcar (args); 966 varlist = Fcar (args);
967 967
968 /* Make space to hold the values to give the bound variables */ 968 /* Make space to hold the values to give the bound variables. */
969 elt = Flength (varlist); 969 elt = Flength (varlist);
970 SAFE_ALLOCA_LISP (temps, XFASTINT (elt)); 970 SAFE_ALLOCA_LISP (temps, XFASTINT (elt));
971 971
972 /* Compute the values and store them in `temps' */ 972 /* Compute the values and store them in `temps'. */
973 973
974 GCPRO2 (args, *temps); 974 GCPRO2 (args, *temps);
975 gcpro2.nvars = 0; 975 gcpro2.nvars = 0;
@@ -1072,7 +1072,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
1072 /* SYM is not mentioned in ENVIRONMENT. 1072 /* SYM is not mentioned in ENVIRONMENT.
1073 Look at its function definition. */ 1073 Look at its function definition. */
1074 if (EQ (def, Qunbound) || !CONSP (def)) 1074 if (EQ (def, Qunbound) || !CONSP (def))
1075 /* Not defined or definition not suitable */ 1075 /* Not defined or definition not suitable. */
1076 break; 1076 break;
1077 if (EQ (XCAR (def), Qautoload)) 1077 if (EQ (XCAR (def), Qautoload))
1078 { 1078 {
@@ -1213,10 +1213,7 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value)
1213 byte_stack_list = catch->byte_stack; 1213 byte_stack_list = catch->byte_stack;
1214 gcprolist = catch->gcpro; 1214 gcprolist = catch->gcpro;
1215#ifdef DEBUG_GCPRO 1215#ifdef DEBUG_GCPRO
1216 if (gcprolist != 0) 1216 gcpro_level = gcprolist ? gcprolist->level + 1 : gcpro_level = 0;
1217 gcpro_level = gcprolist->level + 1;
1218 else
1219 gcpro_level = 0;
1220#endif 1217#endif
1221 backtrace_list = catch->backlist; 1218 backtrace_list = catch->backlist;
1222 lisp_eval_depth = catch->lisp_eval_depth; 1219 lisp_eval_depth = catch->lisp_eval_depth;
@@ -1824,7 +1821,7 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
1824 ? debug_on_quit 1821 ? debug_on_quit
1825 : wants_debugger (Vdebug_on_error, conditions)) 1822 : wants_debugger (Vdebug_on_error, conditions))
1826 && ! skip_debugger (conditions, combined_data) 1823 && ! skip_debugger (conditions, combined_data)
1827 /* rms: what's this for? */ 1824 /* RMS: What's this for? */
1828 && when_entered_debugger < num_nonmacro_input_events) 1825 && when_entered_debugger < num_nonmacro_input_events)
1829 { 1826 {
1830 call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil))); 1827 call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil)));
@@ -1891,7 +1888,7 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions,
1891} 1888}
1892 1889
1893 1890
1894/* dump an error message; called like vprintf */ 1891/* Dump an error message; called like vprintf. */
1895void 1892void
1896verror (const char *m, va_list ap) 1893verror (const char *m, va_list ap)
1897{ 1894{
@@ -1928,7 +1925,7 @@ verror (const char *m, va_list ap)
1928} 1925}
1929 1926
1930 1927
1931/* dump an error message; called like printf */ 1928/* Dump an error message; called like printf. */
1932 1929
1933/* VARARGS 1 */ 1930/* VARARGS 1 */
1934void 1931void
@@ -2024,7 +2021,7 @@ this does nothing and returns nil. */)
2024 CHECK_SYMBOL (function); 2021 CHECK_SYMBOL (function);
2025 CHECK_STRING (file); 2022 CHECK_STRING (file);
2026 2023
2027 /* If function is defined and not as an autoload, don't override */ 2024 /* If function is defined and not as an autoload, don't override. */
2028 if (!EQ (XSYMBOL (function)->function, Qunbound) 2025 if (!EQ (XSYMBOL (function)->function, Qunbound)
2029 && !(CONSP (XSYMBOL (function)->function) 2026 && !(CONSP (XSYMBOL (function)->function)
2030 && EQ (XCAR (XSYMBOL (function)->function), Qautoload))) 2027 && EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
@@ -2159,7 +2156,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
2159 2156
2160 backtrace.next = backtrace_list; 2157 backtrace.next = backtrace_list;
2161 backtrace_list = &backtrace; 2158 backtrace_list = &backtrace;
2162 backtrace.function = &original_fun; /* This also protects them from gc */ 2159 backtrace.function = &original_fun; /* This also protects them from gc. */
2163 backtrace.args = &original_args; 2160 backtrace.args = &original_args;
2164 backtrace.nargs = UNEVALLED; 2161 backtrace.nargs = UNEVALLED;
2165 backtrace.evalargs = 1; 2162 backtrace.evalargs = 1;
@@ -2169,7 +2166,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
2169 do_debug_on_call (Qt); 2166 do_debug_on_call (Qt);
2170 2167
2171 /* At this point, only original_fun and original_args 2168 /* At this point, only original_fun and original_args
2172 have values that will be used below */ 2169 have values that will be used below. */
2173 retry: 2170 retry:
2174 2171
2175 /* Optimize for no indirection. */ 2172 /* Optimize for no indirection. */
@@ -2190,8 +2187,9 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
2190 2187
2191 CHECK_CONS_LIST (); 2188 CHECK_CONS_LIST ();
2192 2189
2193 if (XINT (numargs) < XSUBR (fun)->min_args || 2190 if (XINT (numargs) < XSUBR (fun)->min_args
2194 (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs))) 2191 || (XSUBR (fun)->max_args >= 0
2192 && XSUBR (fun)->max_args < XINT (numargs)))
2195 xsignal2 (Qwrong_number_of_arguments, original_fun, numargs); 2193 xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
2196 2194
2197 else if (XSUBR (fun)->max_args == UNEVALLED) 2195 else if (XSUBR (fun)->max_args == UNEVALLED)
@@ -2201,7 +2199,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
2201 } 2199 }
2202 else if (XSUBR (fun)->max_args == MANY) 2200 else if (XSUBR (fun)->max_args == MANY)
2203 { 2201 {
2204 /* Pass a vector of evaluated arguments */ 2202 /* Pass a vector of evaluated arguments. */
2205 Lisp_Object *vals; 2203 Lisp_Object *vals;
2206 register int argnum = 0; 2204 register int argnum = 0;
2207 USE_SAFE_ALLOCA; 2205 USE_SAFE_ALLOCA;
@@ -2364,7 +2362,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
2364 fun = indirect_function (fun); 2362 fun = indirect_function (fun);
2365 if (EQ (fun, Qunbound)) 2363 if (EQ (fun, Qunbound))
2366 { 2364 {
2367 /* Let funcall get the error */ 2365 /* Let funcall get the error. */
2368 fun = args[0]; 2366 fun = args[0];
2369 goto funcall; 2367 goto funcall;
2370 } 2368 }
@@ -2373,11 +2371,11 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
2373 { 2371 {
2374 if (numargs < XSUBR (fun)->min_args 2372 if (numargs < XSUBR (fun)->min_args
2375 || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) 2373 || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
2376 goto funcall; /* Let funcall get the error */ 2374 goto funcall; /* Let funcall get the error. */
2377 else if (XSUBR (fun)->max_args > numargs) 2375 else if (XSUBR (fun)->max_args > numargs)
2378 { 2376 {
2379 /* Avoid making funcall cons up a yet another new vector of arguments 2377 /* Avoid making funcall cons up a yet another new vector of arguments
2380 by explicitly supplying nil's for optional values */ 2378 by explicitly supplying nil's for optional values. */
2381 SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args); 2379 SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args);
2382 for (i = numargs; i < XSUBR (fun)->max_args;) 2380 for (i = numargs; i < XSUBR (fun)->max_args;)
2383 funcall_args[++i] = Qnil; 2381 funcall_args[++i] = Qnil;
@@ -2415,9 +2413,16 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
2415 2413
2416/* Run hook variables in various ways. */ 2414/* Run hook variables in various ways. */
2417 2415
2418enum run_hooks_condition {to_completion, until_success, until_failure}; 2416Lisp_Object run_hook_with_args (int, Lisp_Object *,
2419static Lisp_Object run_hook_with_args (int, Lisp_Object *, 2417 Lisp_Object (*funcall)
2420 enum run_hooks_condition); 2418 (int nargs, Lisp_Object *args));
2419
2420static Lisp_Object
2421funcall_nil (int nargs, Lisp_Object *args)
2422{
2423 Ffuncall (nargs, args);
2424 return Qnil;
2425}
2421 2426
2422DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0, 2427DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
2423 doc: /* Run each hook in HOOKS. 2428 doc: /* Run each hook in HOOKS.
@@ -2442,7 +2447,7 @@ usage: (run-hooks &rest HOOKS) */)
2442 for (i = 0; i < nargs; i++) 2447 for (i = 0; i < nargs; i++)
2443 { 2448 {
2444 hook[0] = args[i]; 2449 hook[0] = args[i];
2445 run_hook_with_args (1, hook, to_completion); 2450 run_hook_with_args (1, hook, funcall_nil);
2446 } 2451 }
2447 2452
2448 return Qnil; 2453 return Qnil;
@@ -2465,7 +2470,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument.
2465usage: (run-hook-with-args HOOK &rest ARGS) */) 2470usage: (run-hook-with-args HOOK &rest ARGS) */)
2466 (int nargs, Lisp_Object *args) 2471 (int nargs, Lisp_Object *args)
2467{ 2472{
2468 return run_hook_with_args (nargs, args, to_completion); 2473 return run_hook_with_args (nargs, args, funcall_nil);
2469} 2474}
2470 2475
2471DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success, 2476DEFUN ("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.
2485usage: (run-hook-with-args-until-success HOOK &rest ARGS) */) 2490usage: (run-hook-with-args-until-success HOOK &rest ARGS) */)
2486 (int nargs, Lisp_Object *args) 2491 (int nargs, Lisp_Object *args)
2487{ 2492{
2488 return run_hook_with_args (nargs, args, until_success); 2493 return run_hook_with_args (nargs, args, Ffuncall);
2494}
2495
2496static Lisp_Object
2497funcall_not (int nargs, Lisp_Object *args)
2498{
2499 return NILP (Ffuncall (nargs, args)) ? Qt : Qnil;
2489} 2500}
2490 2501
2491DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure, 2502DEFUN ("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.
2504usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */) 2515usage: (run-hook-with-args-until-failure HOOK &rest ARGS) */)
2505 (int nargs, Lisp_Object *args) 2516 (int nargs, Lisp_Object *args)
2506{ 2517{
2507 return run_hook_with_args (nargs, args, until_failure); 2518 return NILP (run_hook_with_args (nargs, args, funcall_not)) ? Qt : Qnil;
2508} 2519}
2509 2520
2521static Lisp_Object
2522run_hook_wrapped_funcall (int nargs, Lisp_Object *args)
2523{
2524 Lisp_Object tmp = args[0], ret;
2525 args[0] = args[1];
2526 args[1] = tmp;
2527 ret = Ffuncall (nargs, args);
2528 args[1] = args[0];
2529 args[0] = tmp;
2530 return ret;
2531}
2532
2533DEFUN ("run-hook-wrapped", Frun_hook_wrapped, Srun_hook_wrapped, 2, MANY, 0,
2534 doc: /* Run HOOK, passing each function through WRAP-FUNCTION.
2535I.e. instead of calling each function FUN directly with arguments ARGS,
2536it calls WRAP-FUNCTION with arguments FUN and ARGS.
2537As soon as a call to WRAP-FUNCTION returns non-nil, `run-hook-wrapped'
2538aborts and returns that value.
2539usage: (run-hook-wrapped HOOK WRAP-FUNCTION &rest ARGS) */)
2540 (int nargs, Lisp_Object *args)
2541{
2542 return run_hook_with_args (nargs, args, run_hook_wrapped_funcall);
2543}
2544
2510/* ARGS[0] should be a hook symbol. 2545/* ARGS[0] should be a hook symbol.
2511 Call each of the functions in the hook value, passing each of them 2546 Call each of the functions in the hook value, passing each of them
2512 as arguments all the rest of ARGS (all NARGS - 1 elements). 2547 as arguments all the rest of ARGS (all NARGS - 1 elements).
2513 COND specifies a condition to test after each call 2548 FUNCALL specifies how to call each function on the hook.
2514 to decide whether to stop.
2515 The caller (or its caller, etc) must gcpro all of ARGS, 2549 The caller (or its caller, etc) must gcpro all of ARGS,
2516 except that it isn't necessary to gcpro ARGS[0]. */ 2550 except that it isn't necessary to gcpro ARGS[0]. */
2517 2551
2518static Lisp_Object 2552Lisp_Object
2519run_hook_with_args (int nargs, Lisp_Object *args, enum run_hooks_condition cond) 2553run_hook_with_args (int nargs, Lisp_Object *args,
2554 Lisp_Object (*funcall) (int nargs, Lisp_Object *args))
2520{ 2555{
2521 Lisp_Object sym, val, ret; 2556 Lisp_Object sym, val, ret = Qnil;
2522 struct gcpro gcpro1, gcpro2, gcpro3; 2557 struct gcpro gcpro1, gcpro2, gcpro3;
2523 2558
2524 /* If we are dying or still initializing, 2559 /* 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)
2528 2563
2529 sym = args[0]; 2564 sym = args[0];
2530 val = find_symbol_value (sym); 2565 val = find_symbol_value (sym);
2531 ret = (cond == until_failure ? Qt : Qnil);
2532 2566
2533 if (EQ (val, Qunbound) || NILP (val)) 2567 if (EQ (val, Qunbound) || NILP (val))
2534 return ret; 2568 return ret;
2535 else if (!CONSP (val) || EQ (XCAR (val), Qlambda)) 2569 else if (!CONSP (val) || EQ (XCAR (val), Qlambda))
2536 { 2570 {
2537 args[0] = val; 2571 args[0] = val;
2538 return Ffuncall (nargs, args); 2572 return funcall (nargs, args);
2539 } 2573 }
2540 else 2574 else
2541 { 2575 {
@@ -2543,9 +2577,7 @@ run_hook_with_args (int nargs, Lisp_Object *args, enum run_hooks_condition cond)
2543 GCPRO3 (sym, val, global_vals); 2577 GCPRO3 (sym, val, global_vals);
2544 2578
2545 for (; 2579 for (;
2546 CONSP (val) && ((cond == to_completion) 2580 CONSP (val) && NILP (ret);
2547 || (cond == until_success ? NILP (ret)
2548 : !NILP (ret)));
2549 val = XCDR (val)) 2581 val = XCDR (val))
2550 { 2582 {
2551 if (EQ (XCAR (val), Qt)) 2583 if (EQ (XCAR (val), Qt))
@@ -2558,30 +2590,26 @@ run_hook_with_args (int nargs, Lisp_Object *args, enum run_hooks_condition cond)
2558 if (!CONSP (global_vals) || EQ (XCAR (global_vals), Qlambda)) 2590 if (!CONSP (global_vals) || EQ (XCAR (global_vals), Qlambda))
2559 { 2591 {
2560 args[0] = global_vals; 2592 args[0] = global_vals;
2561 ret = Ffuncall (nargs, args); 2593 ret = funcall (nargs, args);
2562 } 2594 }
2563 else 2595 else
2564 { 2596 {
2565 for (; 2597 for (;
2566 (CONSP (global_vals) 2598 CONSP (global_vals) && NILP (ret);
2567 && (cond == to_completion
2568 || (cond == until_success
2569 ? NILP (ret)
2570 : !NILP (ret))));
2571 global_vals = XCDR (global_vals)) 2599 global_vals = XCDR (global_vals))
2572 { 2600 {
2573 args[0] = XCAR (global_vals); 2601 args[0] = XCAR (global_vals);
2574 /* In a global value, t should not occur. If it does, we 2602 /* In a global value, t should not occur. If it does, we
2575 must ignore it to avoid an endless loop. */ 2603 must ignore it to avoid an endless loop. */
2576 if (!EQ (args[0], Qt)) 2604 if (!EQ (args[0], Qt))
2577 ret = Ffuncall (nargs, args); 2605 ret = funcall (nargs, args);
2578 } 2606 }
2579 } 2607 }
2580 } 2608 }
2581 else 2609 else
2582 { 2610 {
2583 args[0] = XCAR (val); 2611 args[0] = XCAR (val);
2584 ret = Ffuncall (nargs, args); 2612 ret = funcall (nargs, args);
2585 } 2613 }
2586 } 2614 }
2587 2615
@@ -2603,7 +2631,7 @@ run_hook_with_args_2 (Lisp_Object hook, Lisp_Object arg1, Lisp_Object arg2)
2603 Frun_hook_with_args (3, temp); 2631 Frun_hook_with_args (3, temp);
2604} 2632}
2605 2633
2606/* Apply fn to arg */ 2634/* Apply fn to arg. */
2607Lisp_Object 2635Lisp_Object
2608apply1 (Lisp_Object fn, Lisp_Object arg) 2636apply1 (Lisp_Object fn, Lisp_Object arg)
2609{ 2637{
@@ -2622,7 +2650,7 @@ apply1 (Lisp_Object fn, Lisp_Object arg)
2622 } 2650 }
2623} 2651}
2624 2652
2625/* Call function fn on no arguments */ 2653/* Call function fn on no arguments. */
2626Lisp_Object 2654Lisp_Object
2627call0 (Lisp_Object fn) 2655call0 (Lisp_Object fn)
2628{ 2656{
@@ -2632,7 +2660,7 @@ call0 (Lisp_Object fn)
2632 RETURN_UNGCPRO (Ffuncall (1, &fn)); 2660 RETURN_UNGCPRO (Ffuncall (1, &fn));
2633} 2661}
2634 2662
2635/* Call function fn with 1 argument arg1 */ 2663/* Call function fn with 1 argument arg1. */
2636/* ARGSUSED */ 2664/* ARGSUSED */
2637Lisp_Object 2665Lisp_Object
2638call1 (Lisp_Object fn, Lisp_Object arg1) 2666call1 (Lisp_Object fn, Lisp_Object arg1)
@@ -2647,7 +2675,7 @@ call1 (Lisp_Object fn, Lisp_Object arg1)
2647 RETURN_UNGCPRO (Ffuncall (2, args)); 2675 RETURN_UNGCPRO (Ffuncall (2, args));
2648} 2676}
2649 2677
2650/* Call function fn with 2 arguments arg1, arg2 */ 2678/* Call function fn with 2 arguments arg1, arg2. */
2651/* ARGSUSED */ 2679/* ARGSUSED */
2652Lisp_Object 2680Lisp_Object
2653call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2) 2681call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
@@ -2662,7 +2690,7 @@ call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
2662 RETURN_UNGCPRO (Ffuncall (3, args)); 2690 RETURN_UNGCPRO (Ffuncall (3, args));
2663} 2691}
2664 2692
2665/* Call function fn with 3 arguments arg1, arg2, arg3 */ 2693/* Call function fn with 3 arguments arg1, arg2, arg3. */
2666/* ARGSUSED */ 2694/* ARGSUSED */
2667Lisp_Object 2695Lisp_Object
2668call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3) 2696call3 (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)
2678 RETURN_UNGCPRO (Ffuncall (4, args)); 2706 RETURN_UNGCPRO (Ffuncall (4, args));
2679} 2707}
2680 2708
2681/* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */ 2709/* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */
2682/* ARGSUSED */ 2710/* ARGSUSED */
2683Lisp_Object 2711Lisp_Object
2684call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, 2712call4 (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,
2696 RETURN_UNGCPRO (Ffuncall (5, args)); 2724 RETURN_UNGCPRO (Ffuncall (5, args));
2697} 2725}
2698 2726
2699/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */ 2727/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */
2700/* ARGSUSED */ 2728/* ARGSUSED */
2701Lisp_Object 2729Lisp_Object
2702call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, 2730call5 (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,
2715 RETURN_UNGCPRO (Ffuncall (6, args)); 2743 RETURN_UNGCPRO (Ffuncall (6, args));
2716} 2744}
2717 2745
2718/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */ 2746/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */
2719/* ARGSUSED */ 2747/* ARGSUSED */
2720Lisp_Object 2748Lisp_Object
2721call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, 2749call6 (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,
2735 RETURN_UNGCPRO (Ffuncall (7, args)); 2763 RETURN_UNGCPRO (Ffuncall (7, args));
2736} 2764}
2737 2765
2738/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7 */ 2766/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */
2739/* ARGSUSED */ 2767/* ARGSUSED */
2740Lisp_Object 2768Lisp_Object
2741call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, 2769call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
@@ -3079,7 +3107,7 @@ grow_specpdl (void)
3079 specpdl_ptr = specpdl + count; 3107 specpdl_ptr = specpdl + count;
3080} 3108}
3081 3109
3082/* specpdl_ptr->symbol is a field which describes which variable is 3110/* `specpdl_ptr->symbol' is a field which describes which variable is
3083 let-bound, so it can be properly undone when we unbind_to. 3111 let-bound, so it can be properly undone when we unbind_to.
3084 It can have the following two shapes: 3112 It can have the following two shapes:
3085 - SYMBOL : if it's a plain symbol, it means that we have let-bound 3113 - 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'. */)
3318 else 3346 else
3319 { 3347 {
3320 tem = *backlist->function; 3348 tem = *backlist->function;
3321 Fprin1 (tem, Qnil); /* This can QUIT */ 3349 Fprin1 (tem, Qnil); /* This can QUIT. */
3322 write_string ("(", -1); 3350 write_string ("(", -1);
3323 if (backlist->nargs == MANY) 3351 if (backlist->nargs == MANY)
3324 { 3352 {
@@ -3588,6 +3616,7 @@ The value the function returns is not used. */);
3588 defsubr (&Srun_hook_with_args); 3616 defsubr (&Srun_hook_with_args);
3589 defsubr (&Srun_hook_with_args_until_success); 3617 defsubr (&Srun_hook_with_args_until_success);
3590 defsubr (&Srun_hook_with_args_until_failure); 3618 defsubr (&Srun_hook_with_args_until_failure);
3619 defsubr (&Srun_hook_wrapped);
3591 defsubr (&Sfetch_bytecode); 3620 defsubr (&Sfetch_bytecode);
3592 defsubr (&Sbacktrace_debug); 3621 defsubr (&Sbacktrace_debug);
3593 defsubr (&Sbacktrace); 3622 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;
254/* Hooks to run before and after each command. */ 254/* Hooks to run before and after each command. */
255Lisp_Object Qpre_command_hook; 255Lisp_Object Qpre_command_hook;
256Lisp_Object Qpost_command_hook; 256Lisp_Object Qpost_command_hook;
257Lisp_Object Qcommand_hook_internal;
258 257
259Lisp_Object Qdeferred_action_function; 258Lisp_Object Qdeferred_action_function;
260 259
@@ -1815,20 +1814,63 @@ adjust_point_for_property (EMACS_INT last_pt, int modified)
1815static Lisp_Object 1814static Lisp_Object
1816safe_run_hooks_1 (void) 1815safe_run_hooks_1 (void)
1817{ 1816{
1818 return Frun_hooks (1, &Vinhibit_quit); 1817 eassert (CONSP (Vinhibit_quit));
1818 return call0 (XCDR (Vinhibit_quit));
1819} 1819}
1820 1820
1821/* Subroutine for safe_run_hooks: handle an error by clearing out the hook. */ 1821/* Subroutine for safe_run_hooks: handle an error by clearing out the function
1822 from the hook. */
1822 1823
1823static Lisp_Object 1824static Lisp_Object
1824safe_run_hooks_error (Lisp_Object data) 1825safe_run_hooks_error (Lisp_Object error_data)
1826{
1827 Lisp_Object hook
1828 = CONSP (Vinhibit_quit) ? XCAR (Vinhibit_quit) : Vinhibit_quit;
1829 Lisp_Object fun = CONSP (Vinhibit_quit) ? XCDR (Vinhibit_quit) : Qnil;
1830 Lisp_Object args[4];
1831 args[0] = build_string ("Error in %s (%s): %s");
1832 args[1] = hook;
1833 args[2] = fun;
1834 args[3] = error_data;
1835 Fmessage (4, args);
1836 if (SYMBOLP (hook))
1837 {
1838 Lisp_Object val;
1839 int found = 0;
1840 Lisp_Object newval = Qnil;
1841 for (val = find_symbol_value (hook); CONSP (val); val = XCDR (val))
1842 if (EQ (fun, XCAR (val)))
1843 found = 1;
1844 else
1845 newval = Fcons (XCAR (val), newval);
1846 if (found)
1847 return Fset (hook, Fnreverse (newval));
1848 /* Not found in the local part of the hook. Let's look at the global
1849 part. */
1850 newval = Qnil;
1851 for (val = (NILP (Fdefault_boundp (hook)) ? Qnil
1852 : Fdefault_value (hook));
1853 CONSP (val); val = XCDR (val))
1854 if (EQ (fun, XCAR (val)))
1855 found = 1;
1856 else
1857 newval = Fcons (XCAR (val), newval);
1858 if (found)
1859 return Fset_default (hook, Fnreverse (newval));
1860 }
1861 return Qnil;
1862}
1863
1864static Lisp_Object
1865safe_run_hook_funcall (int nargs, Lisp_Object *args)
1825{ 1866{
1826 Lisp_Object args[3]; 1867 eassert (nargs == 1);
1827 args[0] = build_string ("Error in %s: %s"); 1868 if (CONSP (Vinhibit_quit))
1828 args[1] = Vinhibit_quit; 1869 XSETCDR (Vinhibit_quit, args[0]);
1829 args[2] = data; 1870 else
1830 Fmessage (3, args); 1871 Vinhibit_quit = Fcons (Vinhibit_quit, args[0]);
1831 return Fset (Vinhibit_quit, Qnil); 1872
1873 return internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error);
1832} 1874}
1833 1875
1834/* If we get an error while running the hook, cause the hook variable 1876/* If we get an error while running the hook, cause the hook variable
@@ -1838,10 +1880,13 @@ safe_run_hooks_error (Lisp_Object data)
1838void 1880void
1839safe_run_hooks (Lisp_Object hook) 1881safe_run_hooks (Lisp_Object hook)
1840{ 1882{
1883 /* FIXME: our `internal_condition_case' does not provide any way to pass data
1884 to its body or to its handlers other than via globals such as
1885 dynamically-bound variables ;-) */
1841 int count = SPECPDL_INDEX (); 1886 int count = SPECPDL_INDEX ();
1842 specbind (Qinhibit_quit, hook); 1887 specbind (Qinhibit_quit, hook);
1843 1888
1844 internal_condition_case (safe_run_hooks_1, Qt, safe_run_hooks_error); 1889 run_hook_with_args (1, &hook, safe_run_hook_funcall);
1845 1890
1846 unbind_to (count, Qnil); 1891 unbind_to (count, Qnil);
1847} 1892}
@@ -11438,9 +11483,6 @@ syms_of_keyboard (void)
11438 Qdeferred_action_function = intern_c_string ("deferred-action-function"); 11483 Qdeferred_action_function = intern_c_string ("deferred-action-function");
11439 staticpro (&Qdeferred_action_function); 11484 staticpro (&Qdeferred_action_function);
11440 11485
11441 Qcommand_hook_internal = intern_c_string ("command-hook-internal");
11442 staticpro (&Qcommand_hook_internal);
11443
11444 Qfunction_key = intern_c_string ("function-key"); 11486 Qfunction_key = intern_c_string ("function-key");
11445 staticpro (&Qfunction_key); 11487 staticpro (&Qfunction_key);
11446 Qmouse_click = intern_c_string ("mouse-click"); 11488 Qmouse_click = intern_c_string ("mouse-click");
@@ -11908,22 +11950,18 @@ Buffer modification stores t in this variable. */);
11908 Qdeactivate_mark = intern_c_string ("deactivate-mark"); 11950 Qdeactivate_mark = intern_c_string ("deactivate-mark");
11909 staticpro (&Qdeactivate_mark); 11951 staticpro (&Qdeactivate_mark);
11910 11952
11911 DEFVAR_LISP ("command-hook-internal", Vcommand_hook_internal,
11912 doc: /* Temporary storage of `pre-command-hook' or `post-command-hook'. */);
11913 Vcommand_hook_internal = Qnil;
11914
11915 DEFVAR_LISP ("pre-command-hook", Vpre_command_hook, 11953 DEFVAR_LISP ("pre-command-hook", Vpre_command_hook,
11916 doc: /* Normal hook run before each command is executed. 11954 doc: /* Normal hook run before each command is executed.
11917If an unhandled error happens in running this hook, 11955If an unhandled error happens in running this hook,
11918the hook value is set to nil, since otherwise the error 11956the function in which the error occurred is unconditionally removed, since
11919might happen repeatedly and make Emacs nonfunctional. */); 11957otherwise the error might happen repeatedly and make Emacs nonfunctional. */);
11920 Vpre_command_hook = Qnil; 11958 Vpre_command_hook = Qnil;
11921 11959
11922 DEFVAR_LISP ("post-command-hook", Vpost_command_hook, 11960 DEFVAR_LISP ("post-command-hook", Vpost_command_hook,
11923 doc: /* Normal hook run after each command is executed. 11961 doc: /* Normal hook run after each command is executed.
11924If an unhandled error happens in running this hook, 11962If an unhandled error happens in running this hook,
11925the hook value is set to nil, since otherwise the error 11963the function in which the error occurred is unconditionally removed, since
11926might happen repeatedly and make Emacs nonfunctional. */); 11964otherwise the error might happen repeatedly and make Emacs nonfunctional. */);
11927 Vpost_command_hook = Qnil; 11965 Vpost_command_hook = Qnil;
11928 11966
11929#if 0 11967#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 *);
2278struct window; 2278struct window;
2279struct frame; 2279struct frame;
2280 2280
2281/* Defined in data.c */ 2281/* Defined in data.c. */
2282extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound; 2282extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
2283extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; 2283extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
2284extern Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range; 2284extern Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
@@ -2812,7 +2812,7 @@ extern void init_obarray (void);
2812extern void init_lread (void); 2812extern void init_lread (void);
2813extern void syms_of_lread (void); 2813extern void syms_of_lread (void);
2814 2814
2815/* Defined in eval.c */ 2815/* Defined in eval.c. */
2816extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro; 2816extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro;
2817extern Lisp_Object Qinhibit_quit; 2817extern Lisp_Object Qinhibit_quit;
2818extern Lisp_Object Vautoload_queue; 2818extern Lisp_Object Vautoload_queue;
@@ -2830,6 +2830,9 @@ EXFUN (Frun_hooks, MANY);
2830EXFUN (Frun_hook_with_args, MANY); 2830EXFUN (Frun_hook_with_args, MANY);
2831EXFUN (Frun_hook_with_args_until_failure, MANY); 2831EXFUN (Frun_hook_with_args_until_failure, MANY);
2832extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object); 2832extern void run_hook_with_args_2 (Lisp_Object, Lisp_Object, Lisp_Object);
2833extern Lisp_Object run_hook_with_args (int nargs, Lisp_Object *args,
2834 Lisp_Object (*funcall)
2835 (int nargs, Lisp_Object *args));
2833EXFUN (Fprogn, UNEVALLED); 2836EXFUN (Fprogn, UNEVALLED);
2834EXFUN (Finteractive_p, 0); 2837EXFUN (Finteractive_p, 0);
2835EXFUN (Fthrow, 2) NO_RETURN; 2838EXFUN (Fthrow, 2) NO_RETURN;