if an error is handled by the command loop's error handler. */
Lisp_Object Vdebug_on_error;
+/* List of conditions and regexps specifying error messages which
+ do not enter the debugger even if Vdebug_on_errors says they should. */
+Lisp_Object Vdebug_ignored_errors;
+
/* Nonzero means enter debugger if a quit signal
is handled by the command loop's error handler. */
int debug_on_quit;
void specbind (), record_unwind_protect ();
+Lisp_Object run_hook_with_args ();
+
Lisp_Object funcall_lambda ();
extern Lisp_Object ml_apply (); /* Apply a mocklisp function to unevaluated argument list */
return 0;
}
+/* Return 1 if an error with condition-symbols CONDITIONS,
+ and described by SIGNAL-DATA, should skip the debugger
+ according to debugger-ignore-errors. */
+
+static int
+skip_debugger (conditions, data)
+ Lisp_Object conditions, data;
+{
+ Lisp_Object tail;
+ int first_string = 1;
+ Lisp_Object error_message;
+
+ for (tail = Vdebug_ignored_errors; CONSP (tail);
+ tail = XCONS (tail)->cdr)
+ {
+ if (STRINGP (XCONS (tail)->car))
+ {
+ if (first_string)
+ {
+ error_message = Ferror_message_string (data);
+ first_string = 0;
+ }
+ if (fast_string_match (XCONS (tail)->car, error_message) >= 0)
+ return 1;
+ }
+ else
+ {
+ Lisp_Object contail;
+
+ for (contail = conditions; CONSP (contail);
+ contail = XCONS (contail)->cdr)
+ if (EQ (XCONS (tail)->car, XCONS (contail)->car))
+ return 1;
+ }
+ }
+
+ return 0;
+}
+
/* Value of Qlambda means we have called debugger and user has continued.
Store value returned from debugger into *DEBUGGER_VALUE_PTR. */
if ((EQ (sig, Qquit)
? debug_on_quit
: wants_debugger (Vdebug_on_error, conditions))
+ && ! skip_debugger (conditions, Fcons (sig, data))
&& when_entered_debugger < num_nonmacro_input_chars)
{
int count = specpdl_ptr - specpdl;
specbind (Qdebug_on_error, Qnil);
- *debugger_value_ptr =
- call_debugger (Fcons (Qerror,
- Fcons (Fcons (sig, data),
- Qnil)));
+ *debugger_value_ptr
+ = call_debugger (Fcons (Qerror,
+ Fcons (Fcons (sig, data),
+ Qnil)));
return unbind_to (count, Qlambda);
}
return Qt;
RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args));
}
\f
-DEFUN ("run-hook-with-args", Frun_hook_with_args, Srun_hook_with_args, 1, MANY, 0,
+/* Run hook variables in various ways. */
+
+enum run_hooks_condition {to_completion, until_success, until_failure};
+
+DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 1, MANY, 0,
+ "Run each hook in HOOKS. Major mode functions use this.\n\
+Each argument should be a symbol, a hook variable.\n\
+These symbols are processed in the order specified.\n\
+If a hook symbol has a non-nil value, that value may be a function\n\
+or a list of functions to be called to run the hook.\n\
+If the value is a function, it is called with no arguments.\n\
+If it is a list, the elements are called, in order, with no arguments.\n\
+\n\
+To make a hook variable buffer-local, use `make-local-hook',\n\
+not `make-local-variable'.")
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object hook[1];
+ register int i;
+
+ for (i = 0; i < nargs; i++)
+ {
+ hook[0] = args[i];
+ run_hook_with_args (1, hook, to_completion);
+ }
+
+ return Qnil;
+}
+
+DEFUN ("run-hook-with-args",
+ Frun_hook_with_args, Srun_hook_with_args, 1, MANY, 0,
"Run HOOK with the specified arguments ARGS.\n\
HOOK should be a symbol, a hook variable. If HOOK has a non-nil\n\
value, that value may be a function or a list of functions to be\n\
It is best not to depend on the value return by `run-hook-with-args',\n\
as that may change.\n\
\n\
-To make a hook variable buffer-local, use `make-local-hook', not\n\
-`make-local-variable'.")
+To make a hook variable buffer-local, use `make-local-hook',\n\
+not `make-local-variable'.")
(nargs, args)
int nargs;
Lisp_Object *args;
{
- Lisp_Object sym, val;
+ return run_hook_with_args (nargs, args, to_completion);
+}
+
+DEFUN ("run-hook-with-args-until-success",
+ Frun_hook_with_args_until_success, Srun_hook_with_args_until_success,
+ 1, MANY, 0,
+ "Run HOOK with the specified arguments ARGS.\n\
+HOOK should be a symbol, a hook variable. Its value should\n\
+be a list of functions. We call those functions, one by one,\n\
+passing arguments ARGS to each of them, until one of them\n\
+returns a non-nil value. Then we return that value.\n\
+If all the functions return nil, we return nil.\n\
+\n\
+To make a hook variable buffer-local, use `make-local-hook',\n\
+not `make-local-variable'.")
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ return run_hook_with_args (nargs, args, until_success);
+}
+
+DEFUN ("run-hook-with-args-until-failure",
+ Frun_hook_with_args_until_failure, Srun_hook_with_args_until_failure,
+ 1, MANY, 0,
+ "Run HOOK with the specified arguments ARGS.\n\
+HOOK should be a symbol, a hook variable. Its value should\n\
+be a list of functions. We call those functions, one by one,\n\
+passing arguments ARGS to each of them, until one of them\n\
+returns nil. Then we return nil.\n\
+If all the functions return non-nil, we return non-nil.\n\
+\n\
+To make a hook variable buffer-local, use `make-local-hook',\n\
+not `make-local-variable'.")
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ return run_hook_with_args (nargs, args, until_failure);
+}
+
+/* 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.
+ The caller (or its caller, etc) must gcpro all of ARGS,
+ except that it isn't necessary to gcpro ARGS[0]. */
+
+Lisp_Object
+run_hook_with_args (nargs, args, cond)
+ int nargs;
+ Lisp_Object *args;
+ enum run_hooks_condition cond;
+{
+ Lisp_Object sym, val, ret;
+ struct gcpro gcpro1, gcpro2;
sym = args[0];
val = find_symbol_value (sym);
+ ret = (cond == until_failure ? Qt : Qnil);
+
if (EQ (val, Qunbound) || NILP (val))
- return Qnil;
+ return ret;
else if (!CONSP (val) || EQ (XCONS (val)->car, Qlambda))
{
args[0] = val;
}
else
{
- for (; CONSP (val); val = XCONS (val)->cdr)
+ GCPRO2 (sym, val);
+
+ for (;
+ CONSP (val) && ((cond == to_completion)
+ || (cond == until_success ? NILP (ret)
+ : !NILP (ret)));
+ val = XCONS (val)->cdr)
{
if (EQ (XCONS (val)->car, Qt))
{
it means to run the global binding too. */
Lisp_Object globals;
- for (globals = Fdefault_value (sym); CONSP (globals);
+ for (globals = Fdefault_value (sym);
+ CONSP (globals) && ((cond == to_completion)
+ || (cond == until_success ? NILP (ret)
+ : !NILP (ret)));
globals = XCONS (globals)->cdr)
{
args[0] = XCONS (globals)->car;
- Ffuncall (nargs, args);
+ /* 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);
}
}
else
{
args[0] = XCONS (val)->car;
- Ffuncall (nargs, args);
+ ret = Ffuncall (nargs, args);
+ }
+ }
+
+ UNGCPRO;
+ return ret;
+ }
+}
+
+/* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual
+ present value of that symbol.
+ Call each element of FUNLIST,
+ passing each of them the rest of ARGS.
+ The caller (or its caller, etc) must gcpro all of ARGS,
+ except that it isn't necessary to gcpro ARGS[0]. */
+
+Lisp_Object
+run_hook_list_with_args (funlist, nargs, args)
+ Lisp_Object funlist;
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object sym;
+ Lisp_Object val;
+ struct gcpro gcpro1, gcpro2;
+
+ sym = args[0];
+ GCPRO2 (sym, val);
+
+ for (val = funlist; CONSP (val); val = XCONS (val)->cdr)
+ {
+ if (EQ (XCONS (val)->car, Qt))
+ {
+ /* t indicates this hook has a local binding;
+ it means to run the global binding too. */
+ Lisp_Object globals;
+
+ for (globals = Fdefault_value (sym);
+ CONSP (globals);
+ globals = XCONS (globals)->cdr)
+ {
+ args[0] = XCONS (globals)->car;
+ /* 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))
+ Ffuncall (nargs, args);
}
}
- return Qnil;
+ else
+ {
+ args[0] = XCONS (val)->car;
+ Ffuncall (nargs, args);
+ }
}
+ UNGCPRO;
+ return Qnil;
}
+/* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
+
+void
+run_hook_with_args_2 (hook, arg1, arg2)
+ Lisp_Object hook, arg1, arg2;
+{
+ Lisp_Object temp[3];
+ temp[0] = hook;
+ temp[1] = arg1;
+ temp[2] = arg2;
+
+ Frun_hook_with_args (3, temp);
+}
+\f
/* Apply fn to arg */
Lisp_Object
apply1 (fn, arg)
See also variable `debug-on-quit'.");
Vdebug_on_error = Qnil;
+ DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors,
+ "*List of errors for which the debugger should not be called.\n\
+Each element may be a condition-name or a regexp that matches error messages.\n\
+If any element applies to a given error, that error skips the debugger\n\
+and just returns to top level.\n\
+This overrides the variable `debug-on-error'.\n\
+It does not apply to errors handled by `condition-case'.");
+ Vdebug_ignored_errors = Qnil;
+
DEFVAR_BOOL ("debug-on-quit", &debug_on_quit,
"*Non-nil means enter debugger if quit is signaled (C-g, for example).\n\
Does not apply if quit is handled by a `condition-case'.");
defsubr (&Seval);
defsubr (&Sapply);
defsubr (&Sfuncall);
+ defsubr (&Srun_hooks);
+ defsubr (&Srun_hook_with_args);
+ defsubr (&Srun_hook_with_args_until_success);
+ defsubr (&Srun_hook_with_args_until_failure);
defsubr (&Sfetch_bytecode);
defsubr (&Sbacktrace_debug);
defsubr (&Sbacktrace);