Include <config.h> instead of "config.h".

[bpt/emacs.git] / src / eval.c

diff --git a/src/eval.c b/src/eval.c
index e1f56c0..1b05bf0 100644 (file)
--- a/src/eval.c
+++ b/src/eval.c
@@ -1,5 +1,5 @@
 /* Evaluator for GNU Emacs Lisp interpreter.
-   Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -18,7 +18,7 @@ along with GNU Emacs; see the file COPYING.  If not, write to
 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 
 
-#include "config.h"
+#include <config.h>
 #include "lisp.h"
 #include "blockinput.h"
 
@@ -524,6 +524,7 @@ See also the function `interactive'.")
   if (!NILP (Vpurify_flag))
     defn = Fpurecopy (defn);
   Ffset (fn_name, defn);
+  LOADHIST_ATTACH (fn_name);
   return fn_name;
 }
 
@@ -545,6 +546,7 @@ and the result should be a form to be evaluated instead of the original.")
   if (!NILP (Vpurify_flag))
     defn = Fpurecopy (defn);
   Ffset (fn_name, defn);
+  LOADHIST_ATTACH (fn_name);
   return fn_name;
 }
 
@@ -580,6 +582,7 @@ If INITVALUE is missing, SYMBOL's value is not set.")
        tem = Fpurecopy (tem);
       Fput (sym, Qvariable_documentation, tem);
     }
+  LOADHIST_ATTACH (sym);
   return sym;
 }
 
@@ -611,6 +614,7 @@ it would override the user's choice.")
        tem = Fpurecopy (tem);
       Fput (sym, Qvariable_documentation, tem);
     }
+  LOADHIST_ATTACH (sym);
   return sym;
 }
 
@@ -742,7 +746,8 @@ until TEST returns nil.")
 
   test = Fcar (args);
   body = Fcdr (args);
-  while (tem = Feval (test), !NILP (tem))
+  while (tem = Feval (test),
+        (!EQ (Vmocklisp_arguments, Qt) ? XINT (tem) : !NILP (tem)))
     {
       QUIT;
       Fprogn (body);
@@ -908,10 +913,7 @@ unwind_to_catch (catch, value)
   catch->val = value;
 
   /* Restore the polling-suppression count.  */
-  if (catch->poll_suppress_count > poll_suppress_count)
-    abort ();
-  while (catch->poll_suppress_count < poll_suppress_count)
-    start_polling ();
+  set_poll_suppress_count (catch->poll_suppress_count);
 
   do
     {
@@ -1141,7 +1143,7 @@ See also the function `condition-case'.")
          if (EQ (sig, Qquit))
            return Qnil;
          else
-       error ("Returning a value from an error is no longer supported");
+           error ("Cannot return from the debugger in an error");
        }
 #endif
 
@@ -1377,7 +1379,7 @@ do_autoload (fundef, funname)
      Lisp_Object fundef, funname;
 {
   int count = specpdl_ptr - specpdl;
-  Lisp_Object fun, val;
+  Lisp_Object fun, val, queue, first, second;
 
   fun = funname;
   CHECK_SYMBOL (funname, 0);
@@ -1386,14 +1388,31 @@ do_autoload (fundef, funname)
   record_unwind_protect (un_autoload, Vautoload_queue);
   Vautoload_queue = Qt;
   Fload (Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil);
+
+  /* Save the old autoloads, in case we ever do an unload. */
+  queue = Vautoload_queue;
+  while (CONSP (queue))
+    {
+      first = Fcar (queue);
+      second = Fcdr (first);
+      first = Fcar (first);
+
+      /* Note: This test is subtle.  The cdr of an autoload-queue entry
+        may be an atom if the autoload entry was generated by a defalias
+        or fset. */
+      if (CONSP (second))
+         Fput(first, Qautoload, (Fcdr (second)));
+
+      queue = Fcdr (queue);
+    }
+
   /* Once loading finishes, don't undo it.  */
   Vautoload_queue = Qt;
   unbind_to (count, Qnil);
 
   fun = Findirect_function (fun);
 
-  if (XTYPE (fun) == Lisp_Cons
-      && EQ (XCONS (fun)->car, Qautoload))
+  if (!NILP (Fequal (fun, fundef)))
     error ("Autoloading failed to define function %s",
           XSYMBOL (funname)->name->data);
 }
@@ -1714,18 +1733,18 @@ call0 (fn)
   RETURN_UNGCPRO (Ffuncall (1, &fn));
 }
 
-/* Call function fn with argument arg */
+/* Call function fn with 1 argument arg1 */
 /* ARGSUSED */
 Lisp_Object
-call1 (fn, arg)
-     Lisp_Object fn, arg;
+call1 (fn, arg1)
+     Lisp_Object fn, arg1;
 {
   struct gcpro gcpro1;
 #ifdef NO_ARG_ARRAY
   Lisp_Object args[2];  
 
   args[0] = fn;
-  args[1] = arg;
+  args[1] = arg1;
   GCPRO1 (args[0]);
   gcpro1.nvars = 2;
   RETURN_UNGCPRO (Ffuncall (2, args));
@@ -1736,18 +1755,18 @@ call1 (fn, arg)
 #endif /* not NO_ARG_ARRAY */
 }
 
-/* Call function fn with arguments arg, arg1 */
+/* Call function fn with 2 arguments arg1, arg2 */
 /* ARGSUSED */
 Lisp_Object
-call2 (fn, arg, arg1)
-     Lisp_Object fn, arg, arg1;
+call2 (fn, arg1, arg2)
+     Lisp_Object fn, arg1, arg2;
 {
   struct gcpro gcpro1;
 #ifdef NO_ARG_ARRAY
   Lisp_Object args[3];
   args[0] = fn;
-  args[1] = arg;
-  args[2] = arg1;
+  args[1] = arg1;
+  args[2] = arg2;
   GCPRO1 (args[0]);
   gcpro1.nvars = 3;
   RETURN_UNGCPRO (Ffuncall (3, args));
@@ -1758,19 +1777,19 @@ call2 (fn, arg, arg1)
 #endif /* not NO_ARG_ARRAY */
 }
 
-/* Call function fn with arguments arg, arg1, arg2 */
+/* Call function fn with 3 arguments arg1, arg2, arg3 */
 /* ARGSUSED */
 Lisp_Object
-call3 (fn, arg, arg1, arg2)
-     Lisp_Object fn, arg, arg1, arg2;
+call3 (fn, arg1, arg2, arg3)
+     Lisp_Object fn, arg1, arg2, arg3;
 {
   struct gcpro gcpro1;
 #ifdef NO_ARG_ARRAY
   Lisp_Object args[4];
   args[0] = fn;
-  args[1] = arg;
-  args[2] = arg1;
-  args[3] = arg2;
+  args[1] = arg1;
+  args[2] = arg2;
+  args[3] = arg3;
   GCPRO1 (args[0]);
   gcpro1.nvars = 4;
   RETURN_UNGCPRO (Ffuncall (4, args));
@@ -1781,6 +1800,81 @@ call3 (fn, arg, arg1, arg2)
 #endif /* not NO_ARG_ARRAY */
 }
 
+/* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
+/* ARGSUSED */
+Lisp_Object
+call4 (fn, arg1, arg2, arg3, arg4)
+     Lisp_Object fn, arg1, arg2, arg3, arg4;
+{
+  struct gcpro gcpro1;
+#ifdef NO_ARG_ARRAY
+  Lisp_Object args[5];
+  args[0] = fn;
+  args[1] = arg1;
+  args[2] = arg2;
+  args[3] = arg3;
+  args[4] = arg4;
+  GCPRO1 (args[0]);
+  gcpro1.nvars = 5;
+  RETURN_UNGCPRO (Ffuncall (5, args));
+#else /* not NO_ARG_ARRAY */
+  GCPRO1 (fn);
+  gcpro1.nvars = 5;
+  RETURN_UNGCPRO (Ffuncall (5, &fn));
+#endif /* not NO_ARG_ARRAY */
+}
+
+/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
+/* ARGSUSED */
+Lisp_Object
+call5 (fn, arg1, arg2, arg3, arg4, arg5)
+     Lisp_Object fn, arg1, arg2, arg3, arg4, arg5;
+{
+  struct gcpro gcpro1;
+#ifdef NO_ARG_ARRAY
+  Lisp_Object args[6];
+  args[0] = fn;
+  args[1] = arg1;
+  args[2] = arg2;
+  args[3] = arg3;
+  args[4] = arg4;
+  args[5] = arg5;
+  GCPRO1 (args[0]);
+  gcpro1.nvars = 6;
+  RETURN_UNGCPRO (Ffuncall (6, args));
+#else /* not NO_ARG_ARRAY */
+  GCPRO1 (fn);
+  gcpro1.nvars = 6;
+  RETURN_UNGCPRO (Ffuncall (6, &fn));
+#endif /* not NO_ARG_ARRAY */
+}
+
+/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
+/* ARGSUSED */
+Lisp_Object
+call6 (fn, arg1, arg2, arg3, arg4, arg5, arg6)
+     Lisp_Object fn, arg1, arg2, arg3, arg4, arg5, arg6;
+{
+  struct gcpro gcpro1;
+#ifdef NO_ARG_ARRAY
+  Lisp_Object args[7];
+  args[0] = fn;
+  args[1] = arg1;
+  args[2] = arg2;
+  args[3] = arg3;
+  args[4] = arg4;
+  args[5] = arg5;
+  args[6] = arg6;
+  GCPRO1 (args[0]);
+  gcpro1.nvars = 7;
+  RETURN_UNGCPRO (Ffuncall (7, args));
+#else /* not NO_ARG_ARRAY */
+  GCPRO1 (fn);
+  gcpro1.nvars = 7;
+  RETURN_UNGCPRO (Ffuncall (7, &fn));
+#endif /* not NO_ARG_ARRAY */
+}
+
 DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
   "Call first argument as a function, passing remaining arguments to it.\n\
 Thus, (funcall 'cons 'x 'y) returns (x . y).")