(num_nonmacro_input_events):

[gnu-emacs] / src / eval.c

diff --git a/src/eval.c b/src/eval.c
index 76baf97f5fe84925911cd4981f83180d78fab2a3..50b8879300426c0df7d3d014d9d189a1ea1ae560 100644 (file)
--- 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
 
 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>
 
 
 #include <config.h>


@@ -89,6 +90,9 @@ Lisp_Object Qmocklisp_arguments, Vmocklisp_arguments, Qmocklisp;
 Lisp_Object Qand_rest, Qand_optional;
 Lisp_Object Qdebug_on_error;
 
 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
 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;
 
    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;
 
 /* 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
    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.  */
    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_size = 50;
   specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));

+  specpdl_ptr = specpdl;

   max_specpdl_size = 600;
   max_specpdl_size = 600;

-  max_lisp_eval_depth = 200;
+  max_lisp_eval_depth = 300;

 
   Vrun_hooks = Qnil;
 }
 
   Vrun_hooks = Qnil;
 }


@@ -171,7 +182,7 @@ init_eval ()
   Vquit_flag = Qnil;
   debug_on_next_call = 0;
   lisp_eval_depth = 0;
   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;
 }
 
   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;
   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);
 }
 
   return apply1 (Vdebugger, arg);
 }
 


@@ -647,6 +658,9 @@ for the variable is `*'.")
 {
   Lisp_Object documentation;
   
 {
   Lisp_Object documentation;
   

+  if (!SYMBOLP (variable))
+      return Qnil;
+

   documentation = Fget (variable, Qvariable_documentation);
   if (INTEGERP (documentation) && XINT (documentation) < 0)
     return Qt;
   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)
 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.  */
      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.  */
                {
              if (EQ (tem, Qt) || EQ (tem, Qmacro))
                /* Yes, load it and try again.  */
                {

+                 struct gcpro gcpro1;
+                 GCPRO1 (form);

                  do_autoload (def, sym);
                  do_autoload (def, sym);

+                 UNGCPRO;

                  continue;
                }
              else
                  continue;
                }
              else


@@ -1082,6 +1099,16 @@ See also the function `signal' for more info.")
   return val;
 }
 
   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) ();
 Lisp_Object
 internal_condition_case (bfun, handlers, hfun)
      Lisp_Object (*bfun) ();


@@ -1123,6 +1150,8 @@ internal_condition_case (bfun, handlers, hfun)
   return val;
 }
 
   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) ();
 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;
   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 ();
 
 
   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
 
   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)
   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);
   /* 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 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, 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))
       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)));
          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))
     {
     }
   for (h = handlers; CONSP (h); h = Fcdr (h))
     {


@@ -1538,14 +1591,20 @@ un_autoload (oldqueue)
   return Qnil;
 }
 
   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;
 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);
 
   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);
 
   /* 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);
   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,
 }
 \f
 DEFUN ("eval", Feval, Seval, 1, 1, 0,


@@ -1893,8 +1953,8 @@ not `make-local-variable'.")
   return Qnil;
 }
       
   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\
   "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);
 }
 
   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\
   "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);
 }
 
   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\
   "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;
 
   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);
   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
   if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue))
     store_symval_forwarding (symbol, ovalue, value);
   else

-    Fset (symbol, value);
+    set_internal (symbol, value, 1);

 }
 
 void
 }
 
 void


@@ -2626,7 +2689,7 @@ unbind_to (count, value)
       else if (NILP (specpdl_ptr->symbol))
        Fprogn (specpdl_ptr->old_value);
       else
       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;
 
     }
   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;
 
 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;
 
   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;
 
   staticpro (&Vautoload_queue);
   Vautoload_queue = Qnil;