]> code.delx.au - gnu-emacs/blobdiff - src/eval.c
(set_text_properties): New function. Like
[gnu-emacs] / src / eval.c
index e8ff6857053410ab67ce450d9c0c4b8b79aad8d4..f911433e7120668db6f1a4b1661d98547676b0a8 100644 (file)
@@ -1,5 +1,5 @@
 /* Evaluator for GNU Emacs Lisp interpreter.
-   Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995 Free Software Foundation, Inc.
+   Copyright (C) 1985, 86, 87, 93, 94, 95, 1999 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -21,10 +21,6 @@ Boston, MA 02111-1307, USA.  */
 
 #include <config.h>
 
-#ifdef STDC_HEADERS
-#include <stdlib.h>
-#endif
-
 #include "lisp.h"
 #include "blockinput.h"
 
@@ -85,10 +81,16 @@ struct catchtag
     int lisp_eval_depth;
     int pdlcount;
     int poll_suppress_count;
+    struct byte_stack *byte_stack;
   };
 
 struct catchtag *catchlist;
 
+#ifdef DEBUG_GCPRO
+/* Count levels of GCPRO to detect failure to UNGCPRO.  */
+int gcpro_level;
+#endif
+
 Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
 Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
 Lisp_Object Qmocklisp_arguments, Vmocklisp_arguments, Qmocklisp;
@@ -189,6 +191,9 @@ init_eval ()
   Vquit_flag = Qnil;
   debug_on_next_call = 0;
   lisp_eval_depth = 0;
+#ifdef DEBUG_GCPRO
+  gcpro_level = 0;
+#endif
   /* This is less than the initial value of num_nonmacro_input_events.  */
   when_entered_debugger = -1;
 }
@@ -322,11 +327,11 @@ CONDITION's value if non-nil is returned from the cond-form.")
       val = Feval (Fcar (clause));
       if (!NILP (val))
        {
-         if (!EQ (XCONS (clause)->cdr, Qnil))
-           val = Fprogn (XCONS (clause)->cdr);
+         if (!EQ (XCDR (clause), Qnil))
+           val = Fprogn (XCDR (clause));
          break;
        }
-      args = XCONS (args)->cdr;
+      args = XCDR (args);
     }
   UNGCPRO;
 
@@ -623,7 +628,7 @@ If INITVALUE is missing, SYMBOL's value is not set.")
 
 DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0,
   "(defconst SYMBOL INITVALUE DOCSTRING): define SYMBOL as a constant variable.\n\
-The intent is that nether programs nor users should ever change this value.\n\
+The intent is that neither programs nor users should ever change this value.\n\
 Always sets the value of SYMBOL to the result of evalling INITVALUE.\n\
 If SYMBOL is buffer-local, its default value is what is set;\n\
  buffer-local values are not affected.\n\
@@ -670,9 +675,9 @@ for the variable is `*'.")
     return Qt;
   /* If it is (STRING . INTEGER), a negative integer means a user variable.  */
   if (CONSP (documentation)
-      && STRINGP (XCONS (documentation)->car)
-      && INTEGERP (XCONS (documentation)->cdr)
-      && XINT (XCONS (documentation)->cdr) < 0)
+      && STRINGP (XCAR (documentation))
+      && INTEGERP (XCDR (documentation))
+      && XINT (XCDR (documentation)) < 0)
     return Qt;
   return Qnil;
 }  
@@ -818,7 +823,7 @@ definitions to shadow the loaded ones for use in file byte-compilation.")
       if (!CONSP (form))
        break;
       /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
-      def = sym = XCONS (form)->car;
+      def = sym = XCAR (form);
       tem = Qnil;
       /* Trace symbols aliases to other symbols
         until we get a symbol that is not an alias.  */
@@ -844,7 +849,7 @@ definitions to shadow the loaded ones for use in file byte-compilation.")
          if (EQ (def, Qunbound) || !CONSP (def))
            /* Not defined or definition not suitable */
            break;
-         if (EQ (XCONS (def)->car, Qautoload))
+         if (EQ (XCAR (def), Qautoload))
            {
              /* Autoloading function: will it be a macro when loaded?  */
              tem = Fnth (make_number (4), def);
@@ -860,17 +865,17 @@ definitions to shadow the loaded ones for use in file byte-compilation.")
              else
                break;
            }
-         else if (!EQ (XCONS (def)->car, Qmacro))
+         else if (!EQ (XCAR (def), Qmacro))
            break;
-         else expander = XCONS (def)->cdr;
+         else expander = XCDR (def);
        }
       else
        {
-         expander = XCONS (tem)->cdr;
+         expander = XCDR (tem);
          if (NILP (expander))
            break;
        }
-      form = apply1 (expander, XCONS (form)->cdr);
+      form = apply1 (expander, XCDR (form));
     }
   return form;
 }
@@ -918,6 +923,7 @@ internal_catch (tag, func, arg)
   c.pdlcount = specpdl_ptr - specpdl;
   c.poll_suppress_count = poll_suppress_count;
   c.gcpro = gcprolist;
+  c.byte_stack = byte_stack_list;
   catchlist = &c;
 
   /* Call FUNC.  */
@@ -970,7 +976,14 @@ unwind_to_catch (catch, value)
     }
   while (! last_time);
 
+  byte_stack_list = catch->byte_stack;
   gcprolist = catch->gcpro;
+#ifdef DEBUG_GCPRO
+  if (gcprolist != 0)
+    gcpro_level = gcprolist->level + 1;
+  else
+    gcpro_level = 0;
+#endif
   backtrace_list = catch->backlist;
   lisp_eval_depth = catch->lisp_eval_depth;
   
@@ -1062,8 +1075,8 @@ See also the function `signal' for more info.")
       tem = Fcar (val);
       if (! (NILP (tem)
             || (CONSP (tem)
-                && (SYMBOLP (XCONS (tem)->car)
-                    || CONSP (XCONS (tem)->car)))))
+                && (SYMBOLP (XCAR (tem))
+                    || CONSP (XCAR (tem))))))
        error ("Invalid condition handler", tem);
     }
 
@@ -1075,6 +1088,7 @@ See also the function `signal' for more info.")
   c.pdlcount = specpdl_ptr - specpdl;
   c.poll_suppress_count = poll_suppress_count;
   c.gcpro = gcprolist;
+  c.byte_stack = byte_stack_list;
   if (_setjmp (c.jmp))
     {
       if (!NILP (h.var))
@@ -1135,6 +1149,7 @@ internal_condition_case (bfun, handlers, hfun)
   c.pdlcount = specpdl_ptr - specpdl;
   c.poll_suppress_count = poll_suppress_count;
   c.gcpro = gcprolist;
+  c.byte_stack = byte_stack_list;
   if (_setjmp (c.jmp))
     {
       return (*hfun) (c.val);
@@ -1174,6 +1189,7 @@ internal_condition_case_1 (bfun, arg, handlers, hfun)
   c.pdlcount = specpdl_ptr - specpdl;
   c.poll_suppress_count = poll_suppress_count;
   c.gcpro = gcprolist;
+  c.byte_stack = byte_stack_list;
   if (_setjmp (c.jmp))
     {
       return (*hfun) (c.val);
@@ -1217,9 +1233,8 @@ See also the function `condition-case'.")
   Lisp_Object debugger_value;
   Lisp_Object string;
   Lisp_Object real_error_symbol;
-  Lisp_Object combined_data;
+  extern int display_busy_cursor_p;
 
-  quit_error_check ();
   immediate_quit = 0;
   if (gc_in_progress || waiting_for_input)
     abort ();
@@ -1231,6 +1246,11 @@ See also the function `condition-case'.")
   else
     real_error_symbol = error_symbol;
 
+#ifdef HAVE_X_WINDOWS
+  if (display_busy_cursor_p)
+    Fx_hide_busy_cursor (Qt);
+#endif
+
   /* This hook is used by edebug.  */
   if (! NILP (Vsignal_hook_function))
     call2 (Vsignal_hook_function, error_symbol, data);
@@ -1306,11 +1326,11 @@ wants_debugger (list, conditions)
   while (CONSP (conditions))
     {
       Lisp_Object this, tail;
-      this = XCONS (conditions)->car;
-      for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr)
-       if (EQ (XCONS (tail)->car, this))
+      this = XCAR (conditions);
+      for (tail = list; CONSP (tail); tail = XCDR (tail))
+       if (EQ (XCAR (tail), this))
          return 1;
-      conditions = XCONS (conditions)->cdr;
+      conditions = XCDR (conditions);
     }
   return 0;
 }
@@ -1328,16 +1348,16 @@ skip_debugger (conditions, data)
   Lisp_Object error_message;
 
   for (tail = Vdebug_ignored_errors; CONSP (tail);
-       tail = XCONS (tail)->cdr)
+       tail = XCDR (tail))
     {
-      if (STRINGP (XCONS (tail)->car))
+      if (STRINGP (XCAR (tail)))
        {
          if (first_string)
            {
              error_message = Ferror_message_string (data);
              first_string = 0;
            }
-         if (fast_string_match (XCONS (tail)->car, error_message) >= 0)
+         if (fast_string_match (XCAR (tail), error_message) >= 0)
            return 1;
        }
       else
@@ -1345,8 +1365,8 @@ skip_debugger (conditions, data)
          Lisp_Object contail;
 
          for (contail = conditions; CONSP (contail);
-              contail = XCONS (contail)->cdr)
-           if (EQ (XCONS (tail)->car, XCONS (contail)->car))
+              contail = XCDR (contail))
+           if (EQ (XCAR (tail), XCAR (contail)))
              return 1;
        }
     }
@@ -1453,7 +1473,7 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
              tem = Fmemq (Fcar (condit), conditions);
              if (!NILP (tem))
                return handler;
-             condit = XCONS (condit)->cdr;
+             condit = XCDR (condit);
            }
        }
     }
@@ -1521,8 +1541,6 @@ Also, a symbol satisfies `commandp' if its function definition does so.")
 {
   register Lisp_Object fun;
   register Lisp_Object funcar;
-  register Lisp_Object tem;
-  register int i = 0;
 
   fun = function;
 
@@ -1594,7 +1612,7 @@ this does nothing and returns nil.")
   /* If function is defined and not as an autoload, don't override */
   if (!EQ (XSYMBOL (function)->function, Qunbound)
       && !(CONSP (XSYMBOL (function)->function)
-          && EQ (XCONS (XSYMBOL (function)->function)->car, Qautoload)))
+          && EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
     return Qnil;
 
 #ifdef NO_ARG_ARRAY
@@ -1642,19 +1660,22 @@ do_autoload (fundef, funname)
      Lisp_Object fundef, funname;
 {
   int count = specpdl_ptr - specpdl;
-  Lisp_Object fun, val, queue, first, second;
+  Lisp_Object fun, 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 */
+  /* Preserve the match data.  */
+  record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
+  
+  /* Value saved here is to be restored into Vautoload_queue.  */
   record_unwind_protect (un_autoload, Vautoload_queue);
   Vautoload_queue = Qt;
   Fload (Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil, Qt);
 
-  /* Save the old autoloads, in case we ever do an unload. */
+  /* Save the old autoloads, in case we ever do an unload.  */
   queue = Vautoload_queue;
   while (CONSP (queue))
     {
@@ -1664,7 +1685,7 @@ do_autoload (fundef, funname)
 
       /* 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. */
+        or fset.  */
       if (CONSP (second))
        Fput (first, Qautoload, (Fcdr (second)));
 
@@ -1693,6 +1714,11 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
   struct backtrace backtrace;
   struct gcpro gcpro1, gcpro2, gcpro3;
 
+  /* Since Fsignal resets this to 0, it had better be 0 now
+     or else we have a potential bug.  */
+  if (interrupt_input_blocked != 0)
+    abort ();
+  
   if (SYMBOLP (form))
     {
       if (EQ (Vmocklisp_arguments, Qt))
@@ -1916,7 +1942,7 @@ Thus, (apply '+ 1 2 '(3 4)) returns 10.")
     return Ffuncall (nargs - 1, args);
   else if (numargs == 1)
     {
-      args [nargs - 1] = XCONS (spread_arg)->car;
+      args [nargs - 1] = XCAR (spread_arg);
       return Ffuncall (nargs, args);
     }
 
@@ -1964,8 +1990,8 @@ Thus, (apply '+ 1 2 '(3 4)) returns 10.")
   i = nargs - 1;
   while (!NILP (spread_arg))
     {
-      funcall_args [i++] = XCONS (spread_arg)->car;
-      spread_arg = XCONS (spread_arg)->cdr;
+      funcall_args [i++] = XCAR (spread_arg);
+      spread_arg = XCDR (spread_arg);
     }
 
   RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args));
@@ -2074,7 +2100,8 @@ run_hook_with_args (nargs, args, cond)
      enum run_hooks_condition cond;
 {
   Lisp_Object sym, val, ret;
-  struct gcpro gcpro1, gcpro2;
+  Lisp_Object globals;
+  struct gcpro gcpro1, gcpro2, gcpro3;
 
   /* If we are dying or still initializing,
      don't do anything--it would probably crash if we tried.  */
@@ -2087,34 +2114,34 @@ run_hook_with_args (nargs, args, cond)
 
   if (EQ (val, Qunbound) || NILP (val))
     return ret;
-  else if (!CONSP (val) || EQ (XCONS (val)->car, Qlambda))
+  else if (!CONSP (val) || EQ (XCAR (val), Qlambda))
     {
       args[0] = val;
       return Ffuncall (nargs, args);
     }
   else
     {
-      GCPRO2 (sym, val);
+      globals = Qnil;
+      GCPRO3 (sym, val, globals);
 
       for (;
           CONSP (val) && ((cond == to_completion)
                           || (cond == until_success ? NILP (ret)
                               : !NILP (ret)));
-          val = XCONS (val)->cdr)
+          val = XCDR (val))
        {
-         if (EQ (XCONS (val)->car, Qt))
+         if (EQ (XCAR (val), Qt))
            {
              /* t indicates this hook has a local binding;
                 it means to run the global binding too.  */
-             Lisp_Object globals;
 
              for (globals = Fdefault_value (sym);
                   CONSP (globals) && ((cond == to_completion)
                                       || (cond == until_success ? NILP (ret)
                                           : !NILP (ret)));
-                  globals = XCONS (globals)->cdr)
+                  globals = XCDR (globals))
                {
-                 args[0] = XCONS (globals)->car;
+                 args[0] = XCAR (globals);
                  /* In a global value, t should not occur.  If it does, we
                     must ignore it to avoid an endless loop.  */
                  if (!EQ (args[0], Qt))
@@ -2123,7 +2150,7 @@ run_hook_with_args (nargs, args, cond)
            }
          else
            {
-             args[0] = XCONS (val)->car;
+             args[0] = XCAR (val);
              ret = Ffuncall (nargs, args);
            }
        }
@@ -2148,24 +2175,25 @@ run_hook_list_with_args (funlist, nargs, args)
 {
   Lisp_Object sym;
   Lisp_Object val;
-  struct gcpro gcpro1, gcpro2;
+  Lisp_Object globals;
+  struct gcpro gcpro1, gcpro2, gcpro3;
 
   sym = args[0];
-  GCPRO2 (sym, val);
+  globals = Qnil;
+  GCPRO3 (sym, val, globals);
 
-  for (val = funlist; CONSP (val); val = XCONS (val)->cdr)
+  for (val = funlist; CONSP (val); val = XCDR (val))
     {
-      if (EQ (XCONS (val)->car, Qt))
+      if (EQ (XCAR (val), Qt))
        {
          /* t indicates this hook has a local binding;
             it means to run the global binding too.  */
-         Lisp_Object globals;
 
          for (globals = Fdefault_value (sym);
               CONSP (globals);
-              globals = XCONS (globals)->cdr)
+              globals = XCDR (globals))
            {
-             args[0] = XCONS (globals)->car;
+             args[0] = XCAR (globals);
              /* In a global value, t should not occur.  If it does, we
                 must ignore it to avoid an endless loop.  */
              if (!EQ (args[0], Qt))
@@ -2174,7 +2202,7 @@ run_hook_list_with_args (funlist, nargs, args)
        }
       else
        {
-         args[0] = XCONS (val)->car;
+         args[0] = XCAR (val);
          Ffuncall (nargs, args);
        }
     }
@@ -2660,8 +2688,8 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
       tem = read_doc_string (XVECTOR (object)->contents[COMPILED_BYTECODE]);
       if (!CONSP (tem))
        error ("invalid byte code");
-      XVECTOR (object)->contents[COMPILED_BYTECODE] = XCONS (tem)->car;
-      XVECTOR (object)->contents[COMPILED_CONSTANTS] = XCONS (tem)->cdr;
+      XVECTOR (object)->contents[COMPILED_BYTECODE] = XCAR (tem);
+      XVECTOR (object)->contents[COMPILED_CONSTANTS] = XCDR (tem);
     }
   return object;
 }