X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/79e8bfbf2736fd3d1121f6bf92d2f7e12b240494..be857679f65f098614295fd511978c6d1a318b1e:/src/eval.c diff --git a/src/eval.c b/src/eval.c index 76baf97f5f..50b8879300 100644 --- a/src/eval.c +++ b/src/eval.c @@ -15,7 +15,8 @@ GNU General Public License for more details. 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 @@ -89,6 +90,9 @@ Lisp_Object Qmocklisp_arguments, Vmocklisp_arguments, Qmocklisp; 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 @@ -131,13 +135,19 @@ Lisp_Object Vdebug_on_error; 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. */ @@ -156,8 +166,9 @@ init_eval_once () { 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; } @@ -171,7 +182,7 @@ init_eval () 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; } @@ -184,7 +195,7 @@ call_debugger (arg) 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); } @@ -647,6 +658,9 @@ for the variable is `*'.") { Lisp_Object documentation; + if (!SYMBOLP (variable)) + return Qnil; + documentation = Fget (variable, Qvariable_documentation); if (INTEGERP (documentation) && XINT (documentation) < 0) return Qt; @@ -790,7 +804,7 @@ 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, environment) - register Lisp_Object form; + Lisp_Object form; Lisp_Object environment; { /* With cleanups from Hallvard Furuseth. */ @@ -836,7 +850,10 @@ definitions to shadow the loaded ones for use in file byte-compilation.") 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 @@ -1082,6 +1099,16 @@ See also the function `signal' for more info.") 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) (); @@ -1123,6 +1150,8 @@ internal_condition_case (bfun, handlers, hfun) 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) (); @@ -1181,16 +1210,21 @@ See also the function `condition-case'.") 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) @@ -1236,7 +1270,14 @@ See also the function `condition-case'.") /* 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 @@ -1315,25 +1356,37 @@ find_handler_clause (handlers, conditions, sig, data, 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)) && ! skip_debugger (conditions, Fcons (sig, data)) - && when_entered_debugger < num_nonmacro_input_chars) + && 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_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)) { @@ -1538,14 +1591,20 @@ un_autoload (oldqueue) 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); @@ -1578,6 +1637,7 @@ do_autoload (fundef, funname) if (!NILP (Fequal (fun, fundef))) error ("Autoloading failed to define function %s", XSYMBOL (funname)->name->data); + UNGCPRO; } DEFUN ("eval", Feval, Seval, 1, 1, 0, @@ -1893,8 +1953,8 @@ not `make-local-variable'.") 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\ @@ -1914,9 +1974,8 @@ not `make-local-variable'.") 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\ @@ -1933,9 +1992,8 @@ not `make-local-variable'.") 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\ @@ -1969,6 +2027,11 @@ run_hook_with_args (nargs, args, 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); ret = (cond == until_failure ? Qt : Qnil); @@ -2588,7 +2651,7 @@ specbind (symbol, value) if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue)) store_symval_forwarding (symbol, ovalue, value); else - Fset (symbol, value); + set_internal (symbol, value, 1); } void @@ -2626,7 +2689,7 @@ unbind_to (count, value) 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; @@ -2891,15 +2954,26 @@ If due to `apply' or `funcall' entry, one arg, `lambda'.\n\ 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;