emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] /srv/bzr/emacs/trunk r103769: Don't reset post-command-hoo


From: Stefan Monnier
Subject: [Emacs-diffs] /srv/bzr/emacs/trunk r103769: Don't reset post-command-hook to nil upon error.
Date: Mon, 28 Mar 2011 16:26:35 -0400
User-agent: Bazaar (2.0.3)

------------------------------------------------------------
revno: 103769
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Mon 2011-03-28 16:26:35 -0400
message:
  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.
modified:
  doc/lispref/ChangeLog
  doc/lispref/commands.texi
  etc/NEWS
  src/ChangeLog
  src/eval.c
  src/keyboard.c
  src/lisp.h
=== modified file 'doc/lispref/ChangeLog'
--- a/doc/lispref/ChangeLog     2011-03-21 00:20:24 +0000
+++ b/doc/lispref/ChangeLog     2011-03-28 20:26:35 +0000
@@ -1,3 +1,8 @@
+2011-03-28  Stefan Monnier  <address@hidden>
+
+       * commands.texi (Command Overview): post-command-hook is not reset to
+       nil any more.
+
 2011-03-19  Stefan Monnier  <address@hidden>
 
        * strings.texi (String Conversion): Don't mention

=== modified file 'doc/lispref/commands.texi'
--- a/doc/lispref/commands.texi 2011-02-05 22:30:14 +0000
+++ b/doc/lispref/commands.texi 2011-03-28 20:26:35 +0000
@@ -91,8 +91,9 @@
 
   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

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2011-03-27 10:55:07 +0000
+++ b/etc/NEWS  2011-03-28 20:26:35 +0000
@@ -748,6 +748,11 @@
 
 * 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.

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2011-03-28 03:29:18 +0000
+++ b/src/ChangeLog     2011-03-28 20:26:35 +0000
@@ -1,3 +1,20 @@
+2011-03-28  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>
 
        * dispextern.h (string_buffer_position): Remove declaration.

=== modified file 'src/eval.c'
--- a/src/eval.c        2011-03-16 07:44:19 +0000
+++ b/src/eval.c        2011-03-28 20:26:35 +0000
@@ -30,19 +30,19 @@
 #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 @@
   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 @@
             || 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 @@
   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 @@
 
   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 @@
          /* 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 @@
   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 @@
          ? 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 @@
 }
 
 
-/* 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 @@
 }
 
 
-/* dump an error message; called like printf */
+/* Dump an error message; called like printf.  */
 
 /* VARARGS 1 */
 void
@@ -2024,7 +2021,7 @@
   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 @@
 
   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 @@
     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 @@
 
       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 @@
        }
       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 @@
     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 @@
     {
       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 @@
 
 /* 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 @@
   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 @@
 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 @@
 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 @@
 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 @@
 
   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 @@
       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 @@
              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 @@
   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 @@
   }
 }
 
-/* Call function fn on no arguments */
+/* Call function fn on no arguments.  */
 Lisp_Object
 call0 (Lisp_Object fn)
 {
@@ -2632,7 +2660,7 @@
   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 @@
   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 @@
   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 @@
   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 @@
   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 @@
   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 @@
   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 @@
   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 @@
       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 @@
   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);

=== modified file 'src/keyboard.c'
--- a/src/keyboard.c    2011-03-27 02:27:11 +0000
+++ b/src/keyboard.c    2011-03-28 20:26:35 +0000
@@ -254,7 +254,6 @@
 /* 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 @@
 static Lisp_Object
 safe_run_hooks_1 (void)
 {
-  return Frun_hooks (1, &Vinhibit_quit);
-}
-
-/* Subroutine for safe_run_hooks: handle an error by clearing out the hook.  */
-
-static Lisp_Object
-safe_run_hooks_error (Lisp_Object 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);
+  eassert (CONSP (Vinhibit_quit));
+  return call0 (XCDR (Vinhibit_quit));
+}
+
+/* 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 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)
+{
+  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 @@
 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 @@
   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 @@
   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

=== modified file 'src/lisp.h'
--- a/src/lisp.h        2011-03-27 02:27:11 +0000
+++ b/src/lisp.h        2011-03-28 20:26:35 +0000
@@ -2278,7 +2278,7 @@
 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_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_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;


reply via email to

[Prev in Thread] Current Thread [Next in Thread]