* keymap.c (Fmake_sparse_keymap): Purecopy the name.
[bpt/emacs.git] / src / eval.c
index 2652064..136b75f 100644 (file)
@@ -1,6 +1,6 @@
 /* Evaluator for GNU Emacs Lisp interpreter.
    Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
-                 2002, 2003, 2004, 2005, 2006, 2007, 2008
+                 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
                  Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -20,12 +20,12 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 
 #include <config.h>
+#include <setjmp.h>
 #include "lisp.h"
 #include "blockinput.h"
 #include "commands.h"
 #include "keyboard.h"
 #include "dispextern.h"
-#include <setjmp.h>
 
 #if HAVE_X_WINDOWS
 #include "xterm.h"
@@ -49,41 +49,6 @@ struct backtrace
 
 struct backtrace *backtrace_list;
 
-/* This structure helps implement the `catch' and `throw' control
-   structure.  A struct catchtag contains all the information needed
-   to restore the state of the interpreter after a non-local jump.
-
-   Handlers for error conditions (represented by `struct handler'
-   structures) just point to a catch tag to do the cleanup required
-   for their jumps.
-
-   catchtag structures are chained together in the C calling stack;
-   the `next' member points to the next outer catchtag.
-
-   A call like (throw TAG VAL) searches for a catchtag whose `tag'
-   member is TAG, and then unbinds to it.  The `val' member is used to
-   hold VAL while the stack is unwound; `val' is returned as the value
-   of the catch form.
-
-   All the other members are concerned with restoring the interpreter
-   state.  */
-
-struct catchtag
-{
-  Lisp_Object tag;
-  Lisp_Object val;
-  struct catchtag *next;
-  struct gcpro *gcpro;
-  jmp_buf jmp;
-  struct backtrace *backlist;
-  struct handler *handlerlist;
-  int lisp_eval_depth;
-  int pdlcount;
-  int poll_suppress_count;
-  int interrupt_input_blocked;
-  struct byte_stack *byte_stack;
-};
-
 struct catchtag *catchlist;
 
 #ifdef DEBUG_GCPRO
@@ -97,6 +62,7 @@ Lisp_Object Qand_rest, Qand_optional;
 Lisp_Object Qdebug_on_error;
 Lisp_Object Qdeclare;
 Lisp_Object Qdebug;
+extern Lisp_Object Qinteractive_form;
 
 /* This holds either the symbol `run-hooks' or nil.
    It is nil at an early stage of startup, and when Emacs
@@ -222,7 +188,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 = 400;
+  max_lisp_eval_depth = 500;
 
   Vrun_hooks = Qnil;
 }
@@ -455,7 +421,7 @@ usage: (progn BODY...)  */)
 }
 
 DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0,
-       doc: /* Eval FIRST and BODY sequentially; value from FIRST.
+       doc: /* Eval FIRST and BODY sequentially; return value from FIRST.
 The value of FIRST is saved during the evaluation of the remaining args,
 whose values are discarded.
 usage: (prog1 FIRST BODY...)  */)
@@ -489,7 +455,7 @@ usage: (prog1 FIRST BODY...)  */)
 }
 
 DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0,
-       doc: /* Eval FORM1, FORM2 and BODY sequentially; value from FORM2.
+       doc: /* Eval FORM1, FORM2 and BODY sequentially; return value from FORM2.
 The value of FORM2 is saved during the evaluation of the
 remaining args, whose values are discarded.
 usage: (prog2 FORM1 FORM2 BODY...)  */)
@@ -585,10 +551,10 @@ usage: (function ARG)  */)
 
 
 DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
-       doc: /* Return t if the function was run directly by user input.
+       doc: /* Return t if the containing 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 a 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
@@ -597,28 +563,41 @@ 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.)  */)
+To test whether your function was called with `call-interactively',
+either (i) add an extra optional argument and give it an `interactive'
+spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
+use `called-interactively-p'.  */)
      ()
 {
   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.
+DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 1, 0,
+       doc: /* Return t if the containing function was called by `call-interactively'.
+If KIND is `interactive', then only return t if the call was made
+interactively by the user, i.e. not in `noninteractive' mode nor
+when `executing-kbd-macro'.
+If KIND is `any', on the other hand, it will return t for any kind of
+interactive call, including being called as the binding of a key, or
+from a keyboard macro, or in `noninteractive' mode.
 
-The cleanest way to test whether your function was called with
-`call-interactively' 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.)  */)
-     ()
+The only known proper use of `interactive' for KIND 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?
+
+This function is meant for implementing advice and other
+function-modifying features.  Instead of using this, it is sometimes
+cleaner to give your function an extra optional argument whose
+`interactive' spec specifies non-nil unconditionally (\"p\" is a good
+way to do this), or via (not (or executing-kbd-macro noninteractive)).  */)
+     (kind)
+     Lisp_Object kind;
 {
-  return interactive_p (1) ? Qt : Qnil;
+  return ((INTERACTIVE || !EQ (kind, intern ("interactive")))
+         && interactive_p (1)) ? Qt : Qnil;
 }
 
 
@@ -706,7 +685,8 @@ the list ARGS... as it appears in the expression,
 and the result should be a form to be evaluated instead of the original.
 
 DECL is a declaration, optional, which can specify how to indent
-calls to this macro and how Edebug should handle it.  It looks like this:
+calls to this macro, how Edebug should handle it, and which argument
+should be treated as documentation.  It looks like this:
   (declare SPECS...)
 The elements can look like this:
   (indent INDENT)
@@ -715,6 +695,10 @@ The elements can look like this:
   (debug DEBUG)
        Set NAME's `edebug-form-spec' property to DEBUG.  (This is
        equivalent to writing a `def-edebug-spec' for the macro.)
+
+  (doc-string ELT)
+       Set NAME's `doc-string-elt' property to ELT.
+
 usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...)  */)
      (args)
      Lisp_Object args;
@@ -934,6 +918,13 @@ user_variable_p_eh (ignore)
   return Qnil;
 }
 
+static Lisp_Object
+lisp_indirect_variable (Lisp_Object sym)
+{
+  XSETSYMBOL (sym, indirect_variable (XSYMBOL (sym)));
+  return sym;
+}
+
 DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0,
        doc: /* Return t if VARIABLE is intended to be set and modified by users.
 \(The alternative is a variable used internally in a Lisp program.)
@@ -954,7 +945,7 @@ chain of symbols.  */)
 
   /* If indirect and there's an alias loop, don't check anything else.  */
   if (XSYMBOL (variable)->indirect_variable
-      && NILP (internal_condition_case_1 (indirect_variable, variable,
+      && NILP (internal_condition_case_1 (lisp_indirect_variable, variable,
                                           Qt, user_variable_p_eh)))
     return Qnil;
 
@@ -1365,7 +1356,7 @@ instead of a single condition name.  Then it handles all of them.
 
 When a handler handles an error, control returns to the `condition-case'
 and it executes the handler's BODY...
-with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA) from the error.
+with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
 (If VAR is nil, the handler can't access that information.)
 Then the value of the last BODY form is returned from the `condition-case'
 expression.
@@ -1863,6 +1854,36 @@ skip_debugger (conditions, data)
   return 0;
 }
 
+/* Call the debugger if calling it is currently enabled for CONDITIONS.
+   SIG and DATA describe the signal, as in find_handler_clause.  */
+
+static 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 want 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;
+}
+
 /* Value of Qlambda means we have called debugger and user has continued.
    There are two ways to pass SIG and DATA:
     = SIG is the error symbol, and DATA is the rest of the data.
@@ -1899,16 +1920,17 @@ find_handler_clause (handlers, conditions, sig, data)
     {
       if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions))
        {
+         max_lisp_eval_depth += 15;
          max_specpdl_size++;
-    #ifdef PROTOTYPES
-         internal_with_output_to_temp_buffer ("*Backtrace*",
-                                              (Lisp_Object (*) (Lisp_Object)) Fbacktrace,
-                                              Qnil);
-    #else
-         internal_with_output_to_temp_buffer ("*Backtrace*",
-                                              Fbacktrace, Qnil);
-    #endif
+         if (noninteractive)
+           Fbacktrace ();
+         else
+           internal_with_output_to_temp_buffer
+             ("*Backtrace*",
+              (Lisp_Object (*) (Lisp_Object)) Fbacktrace,
+              Qnil);
          max_specpdl_size--;
+         max_lisp_eval_depth -= 15;
        }
 
       if (!debugger_considered)
@@ -1963,36 +1985,6 @@ find_handler_clause (handlers, conditions, sig, data)
   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 */
@@ -2070,7 +2062,7 @@ then strings and vectors are not accepted.  */)
   fun = function;
   while (SYMBOLP (fun))
     {
-      Lisp_Object tmp = Fget (fun, intern ("interactive-form"));
+      Lisp_Object tmp = Fget (fun, Qinteractive_form);
       if (!NILP (tmp))
        if_prop = Qt;
       fun = Fsymbol_function (fun);
@@ -2104,7 +2096,6 @@ then strings and vectors are not accepted.  */)
     return Qnil;
 }
 
-/* ARGSUSED */
 DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0,
        doc: /* Define FUNCTION to autoload from FILE.
 FUNCTION is a symbol; FILE is a file name string to pass to `load'.
@@ -2121,9 +2112,7 @@ this does nothing and returns nil.  */)
      (function, file, docstring, interactive, type)
      Lisp_Object function, file, docstring, interactive, type;
 {
-#ifdef NO_ARG_ARRAY
   Lisp_Object args[4];
-#endif
 
   CHECK_SYMBOL (function);
   CHECK_STRING (file);
@@ -2139,16 +2128,15 @@ this does nothing and returns nil.  */)
        not useful and else we get loads of them from the loaddefs.el.  */
     LOADHIST_ATTACH (Fcons (Qautoload, function));
 
-#ifdef NO_ARG_ARRAY
-  args[0] = file;
+  if (NILP (Vpurify_flag))
+    args[0] = file;
+  else
+    args[0] = Fpurecopy (file);
   args[1] = docstring;
   args[2] = interactive;
   args[3] = type;
 
   return Ffset (function, Fcons (Qautoload, Flist (4, &args[0])));
-#else /* NO_ARG_ARRAY */
-  return Ffset (function, Fcons (Qautoload, Flist (4, &file)));
-#endif /* not NO_ARG_ARRAY */
 }
 
 Lisp_Object
@@ -3652,7 +3640,8 @@ If the value is a list, an error only means to enter the debugger
 if one of its condition symbols appears in the list.
 When you evaluate an expression interactively, this variable
 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
-See also variable `debug-on-quit'.  */);
+The command `toggle-debug-on-error' toggles this.
+See also the variable `debug-on-quit'.  */);
   Vdebug_on_error = Qnil;
 
   DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors,