]> code.delx.au - gnu-emacs/blobdiff - src/eval.c
(map_char_table): New arg SUBTABLE. Callers changed.
[gnu-emacs] / src / eval.c
index cb10719124439ed8e6cebee363b4a2ad8b7c2364..eb08972bc67d8442280ddde10bf85b857c360bd6 100644 (file)
@@ -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 <config.h>
@@ -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,6 +135,12 @@ 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;
@@ -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;
 }
@@ -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;
@@ -789,9 +803,9 @@ Otherwise, the macro is expanded and the expansion is considered\n\
 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;
@@ -811,7 +825,7 @@ definitions to shadow the loaded ones for use in file byte-compilation.")
        {
          QUIT;
          sym = def;
-         tem = Fassq (sym, env);
+         tem = Fassq (sym, environment);
          if (NILP (tem))
            {
              def = XSYMBOL (sym)->function;
@@ -820,11 +834,11 @@ definitions to shadow the loaded ones for use in file byte-compilation.")
            }
          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 */
@@ -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
@@ -960,8 +977,8 @@ unwind_to_catch (catch, value)
 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;
 
@@ -971,9 +988,9 @@ Both TAG and VALUE are evalled.")
        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)));
     }
 }
 
@@ -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)
@@ -1208,8 +1242,8 @@ See also the function `condition-case'.")
 #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
@@ -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,8 +1356,15 @@ 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)
@@ -1325,15 +1373,20 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
          && ! 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)));
-         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;
 }
 \f
 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;
 
@@ -2756,7 +2819,7 @@ Output stream used is value of `standard-output'.")
 }
 
 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\
@@ -2764,7 +2827,7 @@ the value is (t FUNCTION ARG-VALUES...).\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;
 {
@@ -2813,7 +2876,7 @@ Typing C-g sets `quit-flag' non-nil, regardless of `inhibit-quit'.");
   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;
@@ -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;