]> code.delx.au - gnu-emacs/blobdiff - src/eval.c
(Ffuncall): Always call CHECK_CONS_LIST on entry.
[gnu-emacs] / src / eval.c
index 0326a828a81279180057f86b42fe9bec316a302e..8700ca222ced1e0fa22128e90de1965075ec0008 100644 (file)
@@ -88,7 +88,7 @@ struct catchtag *catchlist;
 int gcpro_level;
 #endif
 
-Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun, Qdefvar;
+Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
 Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
 Lisp_Object Qand_rest, Qand_optional;
 Lisp_Object Qdebug_on_error;
@@ -204,7 +204,7 @@ init_eval_once ()
   specpdl_size = 50;
   specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
   specpdl_ptr = specpdl;
-  max_specpdl_size = 600;
+  max_specpdl_size = 1000;
   max_lisp_eval_depth = 300;
 
   Vrun_hooks = Qnil;
@@ -540,21 +540,45 @@ usage: (function ARG)  */)
 
 
 DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
-       doc: /* Return t if function in which this appears was called interactively.
+       doc: /* Return t if the function was run directly by user input.
 This means that the function was called with call-interactively (which
 includes being called as the binding of a key)
-and input is currently coming from the keyboard (not in keyboard macro).  */)
+and input is currently coming from the keyboard (not in keyboard macro),
+and Emacs is not running in batch mode (`noninteractive' is nil).
+
+The only known proper use of `interactive-p' is in deciding whether to
+display a helpful message, or how to display it.  If you're thinking
+of using it for any other purpose, it is quite likely that you're
+making a mistake.  Think: what do you want to do when the command is
+called from a keyboard macro?
+
+If you want to test whether your function was called with
+`call-interactively', the way to do that is by adding an extra
+optional argument, and making the `interactive' spec specify non-nil
+unconditionally for that argument.  (`p' is a good way to do this.)  */)
+     ()
+{
+  return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil;
+}
+
+
+DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 0, 0,
+       doc: /* Return t if the function using this was called with call-interactively.
+This is used for implementing advice and other function-modifying
+features of Emacs.
+
+The cleanest way to test whether your function was called with
+`call-interactively', the way to do that is by adding an extra
+optional argument, and making the `interactive' spec specify non-nil
+unconditionally for that argument.  (`p' is a good way to do this.)  */)
      ()
 {
   return interactive_p (1) ? Qt : Qnil;
 }
 
 
-/*  Return 1 if function in which this appears was called
-    interactively.  This means that the function was called with
-    call-interactively (which includes being called as the binding of
-    a key) and input is currently coming from the keyboard (not in
-    keyboard macro).
+/*  Return 1 if function in which this appears was called using
+    call-interactively.
 
     EXCLUDE_SUBRS_P non-zero means always return 0 if the function
     called is a built-in.  */
@@ -566,15 +590,13 @@ interactive_p (exclude_subrs_p)
   struct backtrace *btp;
   Lisp_Object fun;
 
-  if (!INTERACTIVE)
-    return 0;
-
   btp = backtrace_list;
 
   /* If this isn't a byte-compiled function, there may be a frame at
      the top for Finteractive_p.  If so, skip it.  */
   fun = Findirect_function (*btp->function);
-  if (SUBRP (fun) && XSUBR (fun) == &Sinteractive_p)
+  if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p
+                     || XSUBR (fun) == &Scalled_interactively_p))
     btp = btp->next;
 
   /* If we're running an Emacs 18-style byte-compiled function, there
@@ -617,6 +639,7 @@ usage: (defun NAME ARGLIST [DOCSTRING] BODY...)  */)
   register Lisp_Object defn;
 
   fn_name = Fcar (args);
+  CHECK_SYMBOL (fn_name);
   defn = Fcons (Qlambda, Fcdr (args));
   if (!NILP (Vpurify_flag))
     defn = Fpurecopy (defn);
@@ -624,7 +647,7 @@ usage: (defun NAME ARGLIST [DOCSTRING] BODY...)  */)
       && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
     LOADHIST_ATTACH (Fcons (Qt, fn_name));
   Ffset (fn_name, defn);
-  LOADHIST_ATTACH (fn_name);
+  LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
   return fn_name;
 }
 
@@ -656,6 +679,7 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...)  */)
   Lisp_Object lambda_list, doc, tail;
 
   fn_name = Fcar (args);
+  CHECK_SYMBOL (fn_name);
   lambda_list = Fcar (Fcdr (args));
   tail = Fcdr (Fcdr (args));
 
@@ -692,7 +716,7 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...)  */)
       && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload))
     LOADHIST_ATTACH (Fcons (Qt, fn_name));
   Ffset (fn_name, defn);
-  LOADHIST_ATTACH (fn_name);
+  LOADHIST_ATTACH (Fcons (Qdefun, fn_name));
   return fn_name;
 }
 
@@ -718,7 +742,7 @@ The return value is ALIASED.  */)
   sym->indirect_variable = 1;
   sym->value = aliased;
   sym->constant = SYMBOL_CONSTANT_P (aliased);
-  LOADHIST_ATTACH (Fcons (Qdefvar, symbol));
+  LOADHIST_ATTACH (symbol);
   if (!NILP (docstring))
     Fput (symbol, Qvariable_documentation, docstring);
 
@@ -740,6 +764,13 @@ If DOCSTRING starts with *, this variable is identified as a user option.
  This means that M-x set-variable recognizes it.
  See also `user-variable-p'.
 If INITVALUE is missing, SYMBOL's value is not set.
+
+If SYMBOL has a local binding, then this form affects the local
+binding.  This is usually not what you want.  Thus, if you need to
+load a file defining variables, with this form or with `defconst' or
+`defcustom', you should always load that file _outside_ any bindings
+for these variables.  \(`defconst' and `defcustom' behave similarly in
+this respect.)
 usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
      (args)
      Lisp_Object args;
@@ -756,6 +787,21 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
     {
       if (NILP (tem))
        Fset_default (sym, Feval (Fcar (tail)));
+      else
+       { /* Check if there is really a global binding rather than just a let
+            binding that shadows the global unboundness of the var.  */
+         volatile struct specbinding *pdl = specpdl_ptr;
+         while (--pdl >= specpdl)
+           {
+             if (EQ (pdl->symbol, sym) && !pdl->func
+                 && EQ (pdl->old_value, Qunbound))
+               {
+                 message_with_string ("Warning: defvar ignored because %s is let-bound",
+                                      SYMBOL_NAME (sym), 1);
+                 break;
+               }
+           }
+       }
       tail = Fcdr (tail);
       tem = Fcar (tail);
       if (!NILP (tem))
@@ -764,7 +810,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
            tem = Fpurecopy (tem);
          Fput (sym, Qvariable_documentation, tem);
        }
-      LOADHIST_ATTACH (Fcons (Qdefvar, sym));
+      LOADHIST_ATTACH (sym);
     }
   else
     /* Simple (defvar <var>) should not count as a definition at all.
@@ -782,6 +828,10 @@ Always sets the value of SYMBOL to the result of evalling INITVALUE.
 If SYMBOL is buffer-local, its default value is what is set;
  buffer-local values are not affected.
 DOCSTRING is optional.
+
+If SYMBOL has a local binding, then this form sets the local binding's
+value.  However, you should normally not make local bindings for
+variables defined with this form.
 usage: (defconst SYMBOL INITVALUE [DOCSTRING])  */)
      (args)
      Lisp_Object args;
@@ -803,7 +853,7 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING])  */)
        tem = Fpurecopy (tem);
       Fput (sym, Qvariable_documentation, tem);
     }
-  LOADHIST_ATTACH (Fcons (Qdefvar, sym));
+  LOADHIST_ATTACH (sym);
   return sym;
 }
 
@@ -1124,9 +1174,11 @@ unwind_to_catch (catch, value)
   /* Save the value in the tag.  */
   catch->val = value;
 
-  /* Restore the polling-suppression count.  */
+  /* Restore certain special C variables.  */
   set_poll_suppress_count (catch->poll_suppress_count);
-  interrupt_input_blocked = catch->interrupt_input_blocked;
+  UNBLOCK_INPUT_TO (catch->interrupt_input_blocked);
+  handling_signal = 0;
+  immediate_quit = 0;
 
   do
     {
@@ -1220,7 +1272,7 @@ VAR may be nil; then you do not get access to the signal information.
 
 The value of the last BODY form is returned from the condition-case.
 See also the function `signal' for more info.
-usage: (condition-case VAR BODYFORM HANDLERS...)  */)
+usage: (condition-case VAR BODYFORM &rest HANDLERS)  */)
      (args)
      Lisp_Object args;
 {
@@ -1235,10 +1287,10 @@ usage: (condition-case VAR BODYFORM HANDLERS...)  */)
   handlers = Fcdr (Fcdr (args));
   CHECK_SYMBOL (var);
 
-  for (val = handlers; ! NILP (val); val = Fcdr (val))
+  for (val = handlers; CONSP (val); val = XCDR (val))
     {
       Lisp_Object tem;
-      tem = Fcar (val);
+      tem = XCAR (val);
       if (! (NILP (tem)
             || (CONSP (tem)
                 && (SYMBOLP (XCAR (tem))
@@ -2015,6 +2067,8 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
       args_left = original_args;
       numargs = Flength (args_left);
 
+      CHECK_CONS_LIST ();
+
       if (XINT (numargs) < XSUBR (fun)->min_args ||
          (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs)))
        return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil)));
@@ -2138,14 +2192,13 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
        return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
     }
  done:
+  CHECK_CONS_LIST ();
+
   lisp_eval_depth--;
   if (backtrace.debug_on_exit)
     val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
   backtrace_list = backtrace.next;
 
-#ifdef HAVE_CARBON
-  mac_check_for_quit_char();
-#endif
   return val;
 }
 \f
@@ -2274,7 +2327,7 @@ called to run the hook.  If the value is a function, it is called with
 the given arguments and its return value is returned.  If it is a list
 of functions, those functions are called, in order,
 with the given arguments ARGS.
-It is best not to depend on the value return by `run-hook-with-args',
+It is best not to depend on the value returned by `run-hook-with-args',
 as that may change.
 
 Do not use `make-local-variable' to make a hook variable buffer-local.
@@ -2290,11 +2343,14 @@ usage: (run-hook-with-args HOOK &rest ARGS)  */)
 DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success,
        Srun_hook_with_args_until_success, 1, MANY, 0,
        doc: /* Run HOOK with the specified arguments ARGS.
-HOOK should be a symbol, a hook variable.  Its value should
-be a list of functions.  We call those functions, one by one,
-passing arguments ARGS to each of them, until one of them
+HOOK should be a symbol, a hook variable.  If HOOK has a non-nil
+value, that value may be a function or a list of functions to be
+called to run the hook.  If the value is a function, it is called with
+the given arguments and its return value is returned.
+If it is a list of functions, those functions are called, in order,
+with the given arguments ARGS, until one of them
 returns a non-nil value.  Then we return that value.
-If all the functions return nil, we return nil.
+However, if they all return nil, we return nil.
 
 Do not use `make-local-variable' to make a hook variable buffer-local.
 Instead, use `add-hook' and specify t for the LOCAL argument.
@@ -2309,11 +2365,13 @@ usage: (run-hook-with-args-until-success HOOK &rest ARGS)  */)
 DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
        Srun_hook_with_args_until_failure, 1, MANY, 0,
        doc: /* Run HOOK with the specified arguments ARGS.
-HOOK should be a symbol, a hook variable.  Its value should
-be a list of functions.  We call those functions, one by one,
-passing arguments ARGS to each of them, until one of them
-returns nil.  Then we return nil.
-If all the functions return non-nil, we return non-nil.
+HOOK should be a symbol, a hook variable.  If HOOK has a non-nil
+value, that value may be a function or a list of functions to be
+called to run the hook.  If the value is a function, it is called with
+the given arguments and its return value is returned.
+If it is a list of functions, those functions are called, in order,
+with the given arguments ARGS, until one of them returns nil.
+Then we return nil.  However, if they all return non-nil, we return non-nil.
 
 Do not use `make-local-variable' to make a hook variable buffer-local.
 Instead, use `add-hook' and specify t for the LOCAL argument.
@@ -2684,6 +2742,8 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
   if (debug_on_next_call)
     do_debug_on_call (Qlambda);
 
+  CHECK_CONS_LIST ();
+
  retry:
 
   fun = args[0];
@@ -2692,7 +2752,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
 
   if (SUBRP (fun))
     {
-      if (numargs < XSUBR (fun)->min_args
+       if (numargs < XSUBR (fun)->min_args
          || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
        {
          XSETFASTINT (lisp_numargs, numargs);
@@ -2784,12 +2844,14 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
       else if (EQ (funcar, Qautoload))
        {
          do_autoload (fun, args[0]);
+         CHECK_CONS_LIST ();
          goto retry;
        }
       else
        return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
     }
  done:
+  CHECK_CONS_LIST ();
   lisp_eval_depth--;
   if (backtrace.debug_on_exit)
     val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
@@ -3242,6 +3304,25 @@ If NFRAMES is more than the number of frames, the value is nil.  */)
 }
 
 \f
+void
+mark_backtrace ()
+{
+  register struct backtrace *backlist;
+  register int i;
+
+  for (backlist = backtrace_list; backlist; backlist = backlist->next)
+    {
+      mark_object (*backlist->function);
+
+      if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
+       i = 0;
+      else
+       i = backlist->nargs - 1;
+      for (; i >= 0; i--)
+       mark_object (backlist->args[i]);
+    }
+}
+
 void
 syms_of_eval ()
 {
@@ -3264,7 +3345,11 @@ Emacs could overflow the real C stack, and crash.  */);
 
   DEFVAR_LISP ("quit-flag", &Vquit_flag,
               doc: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil.
-Typing C-g sets `quit-flag' non-nil, regardless of `inhibit-quit'.  */);
+If the value is t, that means do an ordinary quit.
+If the value equals `throw-on-input', that means quit by throwing
+to the tag specified in `throw-on-input'; it's for handling `while-no-input'.
+Typing C-g sets `quit-flag' to t, regardless of `inhibit-quit',
+but `inhibit-quit' non-nil prevents anything from taking notice of that.  */);
   Vquit_flag = Qnil;
 
   DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit,
@@ -3304,9 +3389,6 @@ before making `inhibit-quit' nil.  */);
   Qdefun = intern ("defun");
   staticpro (&Qdefun);
 
-  Qdefvar = intern ("defvar");
-  staticpro (&Qdefvar);
-
   Qand_rest = intern ("&rest");
   staticpro (&Qand_rest);
 
@@ -3420,6 +3502,7 @@ The value the function returns is not used.  */);
   defsubr (&Scondition_case);
   defsubr (&Ssignal);
   defsubr (&Sinteractive_p);
+  defsubr (&Scalled_interactively_p);
   defsubr (&Scommandp);
   defsubr (&Sautoload);
   defsubr (&Seval);