X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/34c6724464237db4bfd5b3fa57e8b0f66a92f618..aaf34461ff5804e5cebe163b31e535da72e81d87:/src/eval.c diff --git a/src/eval.c b/src/eval.c index b1bd3daef7..13ea0ba7eb 100644 --- a/src/eval.c +++ b/src/eval.c @@ -6,7 +6,7 @@ This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2, or (at your option) +the Free Software Foundation; either version 3, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, @@ -97,6 +97,7 @@ Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag; Lisp_Object Qand_rest, Qand_optional; Lisp_Object Qdebug_on_error; Lisp_Object Qdeclare; +Lisp_Object Qdebug; /* This holds either the symbol `run-hooks' or nil. It is nil at an early stage of startup, and when Emacs @@ -220,7 +221,7 @@ init_eval_once () specpdl_ptr = specpdl; /* Don't forget to update docs (lispref node "Local Variables"). */ max_specpdl_size = 1000; - max_lisp_eval_depth = 300; + max_lisp_eval_depth = 400; Vrun_hooks = Qnil; } @@ -329,7 +330,7 @@ DEFUN ("or", For, Sor, 0, UNEVALLED, 0, doc: /* Eval args until one of them yields non-nil, then return that value. The remaining args are not evalled at all. If all args return nil, return nil. -usage: (or CONDITIONS ...) */) +usage: (or CONDITIONS...) */) (args) Lisp_Object args; { @@ -354,7 +355,7 @@ DEFUN ("and", Fand, Sand, 0, UNEVALLED, 0, doc: /* Eval args until one of them yields nil, then return nil. The remaining args are not evalled at all. If no arg yields nil, return the last arg's value. -usage: (and CONDITIONS ...) */) +usage: (and CONDITIONS...) */) (args) Lisp_Object args; { @@ -433,7 +434,7 @@ usage: (cond CLAUSES...) */) DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0, doc: /* Eval BODY forms sequentially and return value of last one. -usage: (progn BODY ...) */) +usage: (progn BODY...) */) (args) Lisp_Object args; { @@ -530,7 +531,7 @@ Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'. The second VAL is not computed until after the first SYM is set, and so on; each VAL can use the new value of variables set earlier in the `setq'. The return value of the `setq' form is the value of the last VAL. -usage: (setq SYM VAL SYM VAL ...) */) +usage: (setq [SYM VAL]...) */) (args) Lisp_Object args; { @@ -1595,8 +1596,7 @@ internal_condition_case_2 (bfun, nargs, args, handlers, hfun) static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object, - Lisp_Object *)); + Lisp_Object, Lisp_Object)); DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. @@ -1622,7 +1622,6 @@ See also the function `condition-case'. */) Lisp_Object conditions; extern int gc_in_progress; extern int waiting_for_input; - Lisp_Object debugger_value; Lisp_Object string; Lisp_Object real_error_symbol; struct backtrace *bp; @@ -1680,7 +1679,7 @@ See also the function `condition-case'. */) register Lisp_Object clause; clause = find_handler_clause (handlerlist->handler, conditions, - error_symbol, data, &debugger_value); + error_symbol, data); if (EQ (clause, Qlambda)) { @@ -1711,7 +1710,7 @@ See also the function `condition-case'. */) handlerlist = allhandlers; /* 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); + find_handler_clause (Qerror, conditions, error_symbol, data); if (catchlist != 0) Fthrow (Qtop_level, Qt); @@ -1794,7 +1793,7 @@ signal_error (s, arg) } -/* Return nonzero iff LIST is a non-nil atom or +/* Return nonzero if LIST is a non-nil atom or a list containing one of CONDITIONS. */ static int @@ -1863,75 +1862,54 @@ skip_debugger (conditions, data) = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA). This is for memory-full errors only. - Store value returned from debugger into *DEBUGGER_VALUE_PTR. - We need to increase max_specpdl_size temporarily around anything we do that can push on the specpdl, so as not to get a second error here in case we're handling specpdl overflow. */ static Lisp_Object -find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) +find_handler_clause (handlers, conditions, sig, data) Lisp_Object handlers, conditions, sig, data; - Lisp_Object *debugger_value_ptr; { register Lisp_Object h; register Lisp_Object tem; + int debugger_called = 0; + int debugger_considered = 0; - if (EQ (handlers, Qt)) /* t is used by handlers for all conditions, set up by C code. */ + /* t is used by handlers for all conditions, set up by C code. */ + if (EQ (handlers, Qt)) return Qt; + + /* Don't run the debugger for a memory-full error. + (There is no room in memory to do that!) */ + if (NILP (sig)) + debugger_considered = 1; + /* 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 debugger_called = 0; - Lisp_Object sig_symbol, combined_data; - /* This is set to 1 if we are handling a memory-full error, - because these must not run the debugger. - (There is no room in memory to do that!) */ - int no_debugger = 0; - - if (NILP (sig)) - { - combined_data = data; - sig_symbol = Fcar (data); - no_debugger = 1; - } - else - { - combined_data = Fcons (sig, data); - sig_symbol = sig; - } - - if (wants_debugger (Vstack_trace_on_error, conditions)) + if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions)) { max_specpdl_size++; -#ifdef PROTOTYPES + #ifdef PROTOTYPES internal_with_output_to_temp_buffer ("*Backtrace*", (Lisp_Object (*) (Lisp_Object)) Fbacktrace, Qnil); -#else + #else internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace, Qnil); -#endif + #endif max_specpdl_size--; } - if (! no_debugger - /* Don't try to run the debugger with interrupts blocked. - The editing loop would return anyway. */ - && ! INPUT_BLOCKED_P - && (EQ (sig_symbol, Qquit) - ? debug_on_quit - : wants_debugger (Vdebug_on_error, conditions)) - && ! skip_debugger (conditions, combined_data) - && when_entered_debugger < num_nonmacro_input_events) + + if (!debugger_considered) { - *debugger_value_ptr - = call_debugger (Fcons (Qerror, - Fcons (combined_data, Qnil))); - debugger_called = 1; + debugger_considered = 1; + debugger_called = maybe_call_debugger (conditions, sig, data); } + /* If there is no handler, return saying whether we ran the debugger. */ if (EQ (handlers, Qerror)) { @@ -1940,6 +1918,7 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) return Qt; } } + for (h = handlers; CONSP (h); h = Fcdr (h)) { Lisp_Object handler, condit; @@ -1958,18 +1937,55 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) /* Handle a list of condition names in handler HANDLER. */ else if (CONSP (condit)) { - while (CONSP (condit)) + Lisp_Object tail; + for (tail = condit; CONSP (tail); tail = XCDR (tail)) { - tem = Fmemq (Fcar (condit), conditions); + tem = Fmemq (Fcar (tail), conditions); if (!NILP (tem)) - return handler; - condit = XCDR (condit); + { + /* This handler is going to apply. + Does it allow the debugger to run first? */ + if (! debugger_considered && !NILP (Fmemq (Qdebug, condit))) + maybe_call_debugger (conditions, sig, data); + return handler; + } } } } + return Qnil; } +/* Call the debugger if calling it is currently enabled for CONDITIONS. + SIG and DATA describe the signal, as in find_handler_clause. */ + +int +maybe_call_debugger (conditions, sig, data) + Lisp_Object conditions, sig, data; +{ + Lisp_Object combined_data; + + combined_data = Fcons (sig, data); + + if ( + /* Don't try to run the debugger with interrupts blocked. + The editing loop would return anyway. */ + ! INPUT_BLOCKED_P + /* Does user wants to enter debugger for this kind of error? */ + && (EQ (sig, Qquit) + ? debug_on_quit + : wants_debugger (Vdebug_on_error, conditions)) + && ! skip_debugger (conditions, combined_data) + /* rms: what's this for? */ + && when_entered_debugger < num_nonmacro_input_events) + { + call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil))); + return 1; + } + + return 0; +} + /* dump an error message; called like printf */ /* VARARGS 1 */ @@ -2034,42 +2050,49 @@ then strings and vectors are not accepted. */) { register Lisp_Object fun; register Lisp_Object funcar; + Lisp_Object if_prop = Qnil; fun = function; - fun = indirect_function (fun); - if (EQ (fun, Qunbound)) + fun = indirect_function (fun); /* Check cycles. */ + if (NILP (fun) || EQ (fun, Qunbound)) return Qnil; + /* Check an `interactive-form' property if present, analogous to the + function-documentation property. */ + fun = function; + while (SYMBOLP (fun)) + { + Lisp_Object tmp = Fget (fun, intern ("interactive-form")); + if (!NILP (tmp)) + if_prop = Qt; + fun = Fsymbol_function (fun); + } + /* Emacs primitives are interactive if their DEFUN specifies an interactive spec. */ if (SUBRP (fun)) - { - if (XSUBR (fun)->prompt) - return Qt; - else - return Qnil; - } + return XSUBR (fun)->prompt ? Qt : if_prop; /* Bytecode objects are interactive if they are long enough to have an element whose index is COMPILED_INTERACTIVE, which is where the interactive spec is stored. */ else if (COMPILEDP (fun)) return ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE - ? Qt : Qnil); + ? Qt : if_prop); /* Strings and vectors are keyboard macros. */ - if (NILP (for_call_interactively) && (STRINGP (fun) || VECTORP (fun))) - return Qt; + if (STRINGP (fun) || VECTORP (fun)) + return NILP (for_call_interactively) ? Qt : Qnil; /* Lists may represent commands. */ if (!CONSP (fun)) return Qnil; funcar = XCAR (fun); if (EQ (funcar, Qlambda)) - return Fassq (Qinteractive, Fcdr (XCDR (fun))); + return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; if (EQ (funcar, Qautoload)) - return Fcar (Fcdr (Fcdr (XCDR (fun)))); + return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; else return Qnil; } @@ -3610,6 +3633,9 @@ before making `inhibit-quit' nil. */); Qand_optional = intern ("&optional"); staticpro (&Qand_optional); + Qdebug = intern ("debug"); + staticpro (&Qdebug); + DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error, doc: /* *Non-nil means errors display a backtrace buffer. More precisely, this happens for any error that is handled