Add 2009 to copyright years.
[bpt/emacs.git] / src / eval.c
index fbb3a7a..a16576c 100644 (file)
@@ -1,14 +1,14 @@
 /* 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.
 
-GNU Emacs is free software; you can redistribute it and/or modify
+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 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -16,9 +16,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 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, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA.  */
+along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 
 #include <config.h>
@@ -283,7 +281,7 @@ call_debugger (arg)
   if (SPECPDL_INDEX () + 100 > max_specpdl_size)
     max_specpdl_size = SPECPDL_INDEX () + 100;
 
-#ifdef HAVE_X_WINDOWS
+#ifdef HAVE_WINDOW_SYSTEM
   if (display_hourglass_p)
     cancel_hourglass ();
 #endif
@@ -457,7 +455,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...)  */)
@@ -491,7 +489,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...)  */)
@@ -708,7 +706,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)
@@ -717,6 +716,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;
@@ -772,9 +775,10 @@ DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
        doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
 Aliased variables always have the same value; setting one sets the other.
 Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS.  If it is
- omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
- or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
- itself an alias.
+omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
+or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
+itself an alias.  If NEW-ALIAS is bound, and BASE-VARIABLE is not,
+then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
 The return value is BASE-VARIABLE.  */)
      (new_alias, base_variable, docstring)
      Lisp_Object new_alias, base_variable, docstring;
@@ -788,6 +792,12 @@ The return value is BASE-VARIABLE.  */)
     error ("Cannot make a constant an alias");
 
   sym = XSYMBOL (new_alias);
+  /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
+     If n_a is bound, but b_v is not, set the value of b_v to n_a.
+     This is for the sake of define-obsolete-variable-alias and user
+     customizations.  */
+  if (NILP (Fboundp (base_variable)) && !NILP (Fboundp (new_alias)))
+    XSYMBOL(base_variable)->value = sym->value;
   sym->indirect_variable = 1;
   sym->value = base_variable;
   sym->constant = SYMBOL_CONSTANT_P (base_variable);
@@ -929,6 +939,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.)
@@ -949,7 +966,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;
 
@@ -1360,7 +1377,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.
@@ -1640,7 +1657,7 @@ See also the function `condition-case'.  */)
 
 #if 0 /* rms: I don't know why this was here,
         but it is surely wrong for an error that is handled.  */
-#ifdef HAVE_X_WINDOWS
+#ifdef HAVE_WINDOW_SYSTEM
   if (display_hourglass_p)
     cancel_hourglass ();
 #endif
@@ -1858,6 +1875,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.
@@ -1894,16 +1941,18 @@ 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
+#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--;
+         max_lisp_eval_depth -= 15;
        }
 
       if (!debugger_considered)
@@ -1958,36 +2007,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 */
@@ -3236,8 +3255,8 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
          else
            error ("Invalid byte code");
        }
-      AREF (object, COMPILED_BYTECODE) = XCAR (tem);
-      AREF (object, COMPILED_CONSTANTS) = XCDR (tem);
+      ASET (object, COMPILED_BYTECODE, XCAR (tem));
+      ASET (object, COMPILED_CONSTANTS, XCDR (tem));
     }
   return object;
 }
@@ -3647,7 +3666,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,