You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
#include <config.h>
Lisp_Object Qand_rest, Qand_optional;
Lisp_Object Qdebug_on_error;
+/* This holds either the symbol `run-hooks' or nil.
+ It is nil at an early stage of startup, and when Emacs
+ is shutting down. */
Lisp_Object Vrun_hooks;
/* Non-nil means record all fset's and provide's, to be undone
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;
+
+/* Non-nil means call the debugger even if the error will be handled. */
+Lisp_Object Vdebug_on_signal;
+
+/* Hook for edebug to use. */
+Lisp_Object Vsignal_hook_function;
+
/* Nonzero means enter debugger if a quit signal
is handled by the command loop's error handler. */
int debug_on_quit;
-/* The value of num_nonmacro_input_chars as of the last time we
+/* The value of num_nonmacro_input_events as of the last time we
started to enter the debugger. If we decide to enter the debugger
- again when this is still equal to num_nonmacro_input_chars, then we
+ again when this is still equal to num_nonmacro_input_events, then we
know that the debugger itself has an error, and we should just
signal the error instead of entering an infinite loop of debugger
invocations. */
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 */
{
specpdl_size = 50;
specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
+ specpdl_ptr = specpdl;
max_specpdl_size = 600;
- max_lisp_eval_depth = 200;
+ max_lisp_eval_depth = 300;
Vrun_hooks = Qnil;
}
Vquit_flag = Qnil;
debug_on_next_call = 0;
lisp_eval_depth = 0;
- /* This is less than the initial value of num_nonmacro_input_chars. */
+ /* This is less than the initial value of num_nonmacro_input_events. */
when_entered_debugger = -1;
}
if (specpdl_size + 40 > max_specpdl_size)
max_specpdl_size = specpdl_size + 40;
debug_on_next_call = 0;
- when_entered_debugger = num_nonmacro_input_chars;
+ when_entered_debugger = num_nonmacro_input_events;
return apply1 (Vdebugger, arg);
}
{
Lisp_Object documentation;
+ if (!SYMBOLP (variable))
+ return Qnil;
+
documentation = Fget (variable, Qvariable_documentation);
if (INTEGERP (documentation) && XINT (documentation) < 0)
return Qt;
in place of FORM. When a non-macro-call results, it is returned.\n\n\
The second optional arg ENVIRONMENT species an environment of macro\n\
definitions to shadow the loaded ones for use in file byte-compilation.")
- (form, env)
- register Lisp_Object form;
- Lisp_Object env;
+ (form, environment)
+ Lisp_Object form;
+ Lisp_Object environment;
{
/* With cleanups from Hallvard Furuseth. */
register Lisp_Object expander, sym, def, tem;
{
QUIT;
sym = def;
- tem = Fassq (sym, env);
+ tem = Fassq (sym, environment);
if (NILP (tem))
{
def = XSYMBOL (sym)->function;
}
break;
}
- /* Right now TEM is the result from SYM in ENV,
+ /* Right now TEM is the result from SYM in ENVIRONMENT,
and if TEM is nil then DEF is SYM's function definition. */
if (NILP (tem))
{
- /* SYM is not mentioned in ENV.
+ /* SYM is not mentioned in ENVIRONMENT.
Look at its function definition. */
if (EQ (def, Qunbound) || !CONSP (def))
/* Not defined or definition not suitable */
if (EQ (tem, Qt) || EQ (tem, Qmacro))
/* Yes, load it and try again. */
{
+ struct gcpro gcpro1;
+ GCPRO1 (form);
do_autoload (def, sym);
+ UNGCPRO;
continue;
}
else
DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
"(throw TAG VALUE): throw to the catch for TAG and return VALUE from it.\n\
Both TAG and VALUE are evalled.")
- (tag, val)
- register Lisp_Object tag, val;
+ (tag, value)
+ register Lisp_Object tag, value;
{
register struct catchtag *c;
for (c = catchlist; c; c = c->next)
{
if (EQ (c->tag, tag))
- unwind_to_catch (c, val);
+ unwind_to_catch (c, value);
}
- tag = Fsignal (Qno_catch, Fcons (tag, Fcons (val, Qnil)));
+ tag = Fsignal (Qno_catch, Fcons (tag, Fcons (value, Qnil)));
}
}
return val;
}
+/* Call the function BFUN with no arguments, catching errors within it
+ according to HANDLERS. If there is an error, call HFUN with
+ one argument which is the data that describes the error:
+ (SIGNALNAME . DATA)
+
+ HANDLERS can be a list of conditions to catch.
+ If HANDLERS is Qt, catch all errors.
+ If HANDLERS is Qerror, catch all errors
+ but allow the debugger to run if that is enabled. */
+
Lisp_Object
internal_condition_case (bfun, handlers, hfun)
Lisp_Object (*bfun) ();
return val;
}
+/* Like internal_condition_case but call HFUN with ARG as its argument. */
+
Lisp_Object
internal_condition_case_1 (bfun, arg, handlers, hfun)
Lisp_Object (*bfun) ();
extern int gc_in_progress;
extern int waiting_for_input;
Lisp_Object debugger_value;
+ Lisp_Object string;
quit_error_check ();
immediate_quit = 0;
if (gc_in_progress || waiting_for_input)
abort ();
-#ifdef HAVE_X_WINDOWS
+#ifdef HAVE_WINDOW_SYSTEM
TOTALLY_UNBLOCK_INPUT;
#endif
+ /* This hook is used by edebug. */
+ if (! NILP (Vsignal_hook_function))
+ Ffuncall (Vsignal_hook_function, error_symbol, data);
+
conditions = Fget (error_symbol, Qerror_conditions);
for (; handlerlist; handlerlist = handlerlist->next)
#else
if (EQ (clause, Qlambda))
{
- /* We can't return values to code which signalled an error, but we
- can continue code which has signalled a quit. */
+ /* We can't return values to code which signaled an error, but we
+ can continue code which has signaled a quit. */
if (EQ (error_symbol, Qquit))
return Qnil;
else
/* If no handler is present now, try to run the debugger,
and if that fails, throw to top level. */
find_handler_clause (Qerror, conditions, error_symbol, data, &debugger_value);
- Fthrow (Qtop_level, Qt);
+ if (catchlist != 0)
+ Fthrow (Qtop_level, Qt);
+
+ if (! EQ (data, memory_signal_data))
+ data = Fcons (error_symbol, data);
+
+ string = Ferror_message_string (data);
+ fatal (XSTRING (string)->data, 0, 0);
}
/* Return nonzero iff LIST is a non-nil atom or
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 (handlers, Qt)) /* t is used by handlers for all conditions, set up by C code. */
return Qt;
- if (EQ (handlers, Qerror)) /* error is used similarly, but means display a backtrace too */
+ /* error is used similarly, but means print an error message
+ and run the debugger if that is enabled. */
+ if (EQ (handlers, Qerror)
+ || !NILP (Vdebug_on_signal)) /* This says call debugger even if
+ there is a handler. */
{
+ int count = specpdl_ptr - specpdl;
+ int debugger_called = 0;
+
if (wants_debugger (Vstack_trace_on_error, conditions))
internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace, Qnil);
if ((EQ (sig, Qquit)
? debug_on_quit
: wants_debugger (Vdebug_on_error, conditions))
- && when_entered_debugger < num_nonmacro_input_chars)
+ && ! skip_debugger (conditions, Fcons (sig, data))
+ && when_entered_debugger < num_nonmacro_input_events)
{
- int count = specpdl_ptr - specpdl;
specbind (Qdebug_on_error, Qnil);
- *debugger_value_ptr =
- call_debugger (Fcons (Qerror,
- Fcons (Fcons (sig, data),
- Qnil)));
- return unbind_to (count, Qlambda);
+ *debugger_value_ptr
+ = call_debugger (Fcons (Qerror,
+ Fcons (Fcons (sig, data),
+ Qnil)));
+ debugger_called = 1;
+ }
+ /* If there is no handler, return saying whether we ran the debugger. */
+ if (EQ (handlers, Qerror))
+ {
+ if (debugger_called)
+ return unbind_to (count, Qlambda);
+ return Qt;
}
- return Qt;
}
for (h = handlers; CONSP (h); h = Fcdr (h))
{
return Qnil;
}
+/* Load an autoloaded function.
+ FUNNAME is the symbol which is the function's name.
+ FUNDEF is the autoload definition (a list). */
+
do_autoload (fundef, funname)
Lisp_Object fundef, funname;
{
int count = specpdl_ptr - specpdl;
Lisp_Object fun, val, queue, first, second;
+ struct gcpro gcpro1, gcpro2, gcpro3;
fun = funname;
CHECK_SYMBOL (funname, 0);
+ GCPRO3 (fun, funname, fundef);
/* Value saved here is to be restored into Vautoload_queue */
record_unwind_protect (un_autoload, Vautoload_queue);
if (!NILP (Fequal (fun, fundef)))
error ("Autoloading failed to define function %s",
XSYMBOL (funname)->name->data);
+ UNGCPRO;
}
\f
DEFUN ("eval", Feval, Seval, 1, 1, 0,
return Qnil;
}
-DEFUN ("run-hook-with-args",
- Frun_hook_with_args, Srun_hook_with_args, 1, MANY, 0,
+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\
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,
+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\
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,
+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\
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;
enum run_hooks_condition cond;
{
Lisp_Object sym, val, ret;
+ struct gcpro gcpro1, gcpro2;
+
+ /* If we are dying or still initializing,
+ don't do anything--it would probably crash if we tried. */
+ if (NILP (Vrun_hooks))
+ return;
sym = args[0];
val = find_symbol_value (sym);
}
else
{
+ GCPRO2 (sym, val);
+
for (;
CONSP (val) && ((cond == to_completion)
|| (cond == until_success ? NILP (ret)
globals = XCONS (globals)->cdr)
{
args[0] = XCONS (globals)->car;
- ret = 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
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);
+ }
+ }
+ 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
if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue))
store_symval_forwarding (symbol, ovalue, value);
else
- Fset (symbol, value);
+ set_internal (symbol, value, 1);
}
void
else if (NILP (specpdl_ptr->symbol))
Fprogn (specpdl_ptr->old_value);
else
- Fset (specpdl_ptr->symbol, specpdl_ptr->old_value);
+ set_internal (specpdl_ptr->symbol, specpdl_ptr->old_value, 1);
}
if (NILP (Vquit_flag) && quitf) Vquit_flag = Qt;
}
DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 1, "",
- "Return the function and arguments N frames up from current execution point.\n\
+ "Return the function and arguments NFRAMES up from current execution point.\n\
If that frame has not evaluated the arguments yet (or is a special form),\n\
the value is (nil FUNCTION ARG-FORMS...).\n\
If that frame has evaluated its arguments and called its function already,\n\
A &rest arg is represented as the tail of the list ARG-VALUES.\n\
FUNCTION is whatever was supplied as car of evaluated list,\n\
or a lambda expression for macro calls.\n\
-If N is more than the number of frames, the value is nil.")
+If NFRAMES is more than the number of frames, the value is nil.")
(nframes)
Lisp_Object nframes;
{
DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit,
"Non-nil inhibits C-g quitting from happening immediately.\n\
Note that `quit-flag' will still be set by typing C-g,\n\
-so a quit will be signalled as soon as `inhibit-quit' is nil.\n\
+so a quit will be signaled as soon as `inhibit-quit' is nil.\n\
To prevent this happening, set `quit-flag' to nil\n\
before making `inhibit-quit' nil.");
Vinhibit_quit = Qnil;
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'.");
If due to `eval' entry, one arg, t.");
Vdebugger = Qnil;
+ DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function,
+ "If non-nil, this is a function for `signal' to call.\n\
+It receives the same arguments that `signal' was given.\n\
+The Edebug package uses this to regain control.");
+ Vsignal_hook_function = Qnil;
+
Qmocklisp_arguments = intern ("mocklisp-arguments");
staticpro (&Qmocklisp_arguments);
DEFVAR_LISP ("mocklisp-arguments", &Vmocklisp_arguments,
"While in a mocklisp function, the list of its unevaluated args.");
Vmocklisp_arguments = Qt;
- DEFVAR_LISP ("run-hooks", &Vrun_hooks,
- "Set to the function `run-hooks', if that function has been defined.\n\
-Otherwise, nil (in a bare Emacs without preloaded Lisp code).");
+ DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal,
+ "*Non-nil means call the debugger regardless of condition handlers.\n\
+Note that `debug-on-error', `debug-on-quit' and friends\n\
+still determine whether to handle the particular condition.");
+ Vdebug_on_signal = Qnil;
+
+ Vrun_hooks = intern ("run-hooks");
+ staticpro (&Vrun_hooks);
staticpro (&Vautoload_queue);
Vautoload_queue = Qnil;