]> code.delx.au - gnu-emacs/blobdiff - src/lread.c
(Fget_char_property): Update call to overlays_at.
[gnu-emacs] / src / lread.c
index efc2b3149b2271205d9fe4f0bc0684d0b490311b..3a1bc00c03fa687b688668d2e0e154176057e0f3 100644 (file)
@@ -21,9 +21,6 @@ Boston, MA 02111-1307, USA.  */
 
 
 #include <config.h>
-#define _XOPEN_SOURCE 500      /* for Unix 98 ftello on GNU */
-#define __EXTENSIONS__         /* Keep Solaris 2.6 happy with the
-                                  above, else things we need are hidden.  */
 #include <stdio.h>
 #include <sys/types.h>
 #include <sys/stat.h>
@@ -31,15 +28,12 @@ Boston, MA 02111-1307, USA.  */
 #include <errno.h>
 #include "lisp.h"
 #include "intervals.h"
-
-#ifndef standalone
 #include "buffer.h"
 #include "charset.h"
 #include <epaths.h>
 #include "commands.h"
 #include "keyboard.h"
 #include "termhooks.h"
-#endif
 
 #ifdef lint
 #include <sys/inode.h>
@@ -60,9 +54,7 @@ Boston, MA 02111-1307, USA.  */
 #define X_OK 01
 #endif
 
-#ifdef LISP_FLOAT_TYPE
 #include <math.h>
-#endif /* LISP_FLOAT_TYPE */
 
 #ifdef HAVE_SETLOCALE
 #include <locale.h>
@@ -296,12 +288,10 @@ readchar (readcharfun)
     {
       if (read_from_string_index >= read_from_string_limit)
        c = -1;
-      else if (STRING_MULTIBYTE (readcharfun))
+      else
        FETCH_STRING_CHAR_ADVANCE (c, readcharfun,
                                   read_from_string_index,
                                   read_from_string_index_byte);
-      else
-       c = XSTRING (readcharfun)->data[read_from_string_index++];
 
       return c;
     }
@@ -408,11 +398,13 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
                     input_method)
      int no_switch_frame, ascii_required, error_nonascii, input_method;
 {
-#ifdef standalone
-  return make_number (getchar ());
-#else
   register Lisp_Object val, delayed_switch_frame;
 
+#ifdef HAVE_WINDOW_SYSTEM
+  if (display_busy_cursor_p)
+    cancel_busy_cursor ();
+#endif
+  
   delayed_switch_frame = Qnil;
 
   /* Read until we get an acceptable event.  */
@@ -470,8 +462,11 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
   if (! NILP (delayed_switch_frame))
     unread_switch_frame = delayed_switch_frame;
 
-  return val;
+#ifdef HAVE_WINDOW_SYSTEM
+  if (display_busy_cursor_p)
+    start_busy_cursor ();
 #endif
+  return val;
 }
 
 DEFUN ("read-char", Fread_char, Sread_char, 0, 2, 0,
@@ -539,6 +534,52 @@ static void readevalloop ();
 static Lisp_Object load_unwind ();
 static Lisp_Object load_descriptor_unwind ();
 
+/* Non-zero means load dangerous compiled Lisp files.  */
+
+int load_dangerous_libraries;
+
+/* A regular expression used to detect files compiled with Emacs.  */
+
+static Lisp_Object Vbytecomp_version_regexp;
+
+
+/* Value is non-zero if the file asswociated with file descriptor FD
+   is a compiled Lisp file that's safe to load.  Only files compiled
+   with Emacs are safe to load.  Files compiled with XEmacs can lead
+   to a crash in Fbyte_code because of an incompatible change in the
+   byte compiler.  */
+
+static int
+safe_to_load_p (fd)
+     int fd;
+{
+  char buf[512];
+  int nbytes, i;
+  int safe_p = 1;
+
+  /* Read the first few bytes from the file, and look for a line
+     specifying the byte compiler version used.  */
+  nbytes = emacs_read (fd, buf, sizeof buf - 1);
+  if (nbytes > 0)
+    {
+      buf[nbytes] = '\0';
+
+      /* Skip to the next newline, skipping over the initial `ELC'
+        with NUL bytes following it.  */
+      for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
+       ;
+
+      if (i < nbytes
+         && fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
+                                             buf + i) < 0)
+       safe_p = 0;
+    }
+
+  lseek (fd, 0, SEEK_SET);
+  return safe_p;
+}
+
+
 DEFUN ("load", Fload, Sload, 1, 5, 0,
   "Execute a file of Lisp code named FILE.\n\
 First try FILE with `.elc' appended, then try with `.el',\n\
@@ -569,6 +610,7 @@ Return t if file exists.")
   /* 1 means we are loading a compiled file.  */
   int compiled = 0;
   Lisp_Object handler;
+  int safe_p = 1;
   char *fmode = "r";
 #ifdef DOS_NT
   fmode = "rt";
@@ -627,6 +669,7 @@ Return t if file exists.")
        return Qnil;
     }
 
+  /* Tell startup.el whether or not we found the user's init file.  */
   if (EQ (Qt, Vuser_init_file))
     Vuser_init_file = found;
 
@@ -653,6 +696,16 @@ Return t if file exists.")
       struct stat s1, s2;
       int result;
 
+      if (!safe_to_load_p (fd))
+       {
+         safe_p = 0;
+         if (!load_dangerous_libraries)
+           error ("File `%s' was not compiled in Emacs",
+                  XSTRING (found)->data);
+         else if (!NILP (nomessage))
+           message_with_string ("File `%s' not compiled in Emacs", found, 1);
+       }
+
       compiled = 1;
 
 #ifdef DOS_NT
@@ -675,6 +728,8 @@ Return t if file exists.")
     }
   else
     {
+    load_source:
+
       /* We are loading a source file (*.el).  */
       if (!NILP (Vload_source_file_function))
        {
@@ -703,7 +758,10 @@ Return t if file exists.")
 
   if (NILP (nomessage))
     {
-      if (!compiled)
+      if (!safe_p)
+       message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
+                file, 1);
+      else if (!compiled)
        message_with_string ("Loading %s (source)...", file, 1);
       else if (newer)
        message_with_string ("Loading %s (compiled; note, source file is newer)...",
@@ -738,13 +796,16 @@ Return t if file exists.")
   saved_doc_string_size = 0;
 
   if (prev_saved_doc_string)
-    free (prev_saved_doc_string);
+    xfree (prev_saved_doc_string);
   prev_saved_doc_string = 0;
   prev_saved_doc_string_size = 0;
 
   if (!noninteractive && NILP (nomessage))
     {
-      if (!compiled)
+      if (!safe_p)
+       message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
+                file, 1);
+      else if (!compiled)
        message_with_string ("Loading %s (source)...done", file, 1);
       else if (newer)
        message_with_string ("Loading %s (compiled; note, source file is newer)...done",
@@ -1041,6 +1102,22 @@ readevalloop_1 (old)
   return Qnil;
 }
 
+/* Signal an `end-of-file' error, if possible with file name
+   information.  */
+
+static void
+end_of_file_error ()
+{
+  Lisp_Object data;
+
+  if (STRINGP (Vload_file_name))
+    data = Fcons (Vload_file_name, Qnil);
+  else
+    data = Qnil;
+
+  Fsignal (Qend_of_file, data);
+}
+
 /* UNIBYTE specifies how to set load_convert_to_unibyte
    for this invocation.
    READFUN, if non-nil, is used instead of `read'.  */
@@ -1059,6 +1136,7 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read
   int count = specpdl_ptr - specpdl;
   struct gcpro gcpro1;
   struct buffer *b = 0;
+  int continue_reading_p;
 
   if (BUFFERP (readcharfun))
     b = XBUFFER (readcharfun);
@@ -1076,7 +1154,8 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read
 
   LOADHIST_ATTACH (sourcename);
 
-  while (1)
+  continue_reading_p = 1;
+  while (continue_reading_p)
     {
       if (b != 0 && NILP (b->name))
        error ("Reading from killed buffer");
@@ -1105,8 +1184,20 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read
        {
          UNREAD (c);
          read_objects = Qnil;
-         if (! NILP (readfun))
-           val = call1 (readfun, readcharfun);
+         if (!NILP (readfun))
+           {
+             val = call1 (readfun, readcharfun);
+
+             /* If READCHARFUN has set point to ZV, we should
+                stop reading, even if the form read sets point
+                to a different value when evaluated.  */
+             if (BUFFERP (readcharfun))
+               {
+                 struct buffer *b = XBUFFER (readcharfun);
+                 if (BUF_PT (b) == BUF_ZV (b))
+                   continue_reading_p = 0;
+               }
+           }
          else if (! NILP (Vload_read_function))
            val = call1 (Vload_read_function, readcharfun);
          else
@@ -1114,6 +1205,7 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read
        }
 
       val = (*evalfun) (val);
+
       if (printflag)
        {
          Vvalues = Fcons (val, Vvalues);
@@ -1130,8 +1222,6 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read
   unbind_to (count, Qnil);
 }
 
-#ifndef standalone
-
 DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
   "Execute the current buffer as Lisp code.\n\
 Programs can pass two arguments, BUFFER and PRINTFLAG.\n\
@@ -1246,7 +1336,6 @@ This function does not move point.")
   return unbind_to (count, Qnil);
 }
 
-#endif /* standalone */
 \f
 DEFUN ("read", Fread, Sread, 0, 1, 0,
   "Read one Lisp expression as text from STREAM, return as Lisp object.\n\
@@ -1272,10 +1361,8 @@ STREAM or the value of `standard-input' may be:\n\
   new_backquote_flag = 0;
   read_objects = Qnil;
 
-#ifndef standalone
   if (EQ (stream, Qread_char))
     return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
-#endif
 
   if (STRINGP (stream))
     return Fcar (Fread_from_string (stream, Qnil, Qnil));
@@ -1540,6 +1627,72 @@ read_escape (readcharfun, stringp)
     }
 }
 
+
+/* Read an integer in radix RADIX using READCHARFUN to read
+   characters.  RADIX must be in the interval [2..36]; if it isn't, a
+   read error is signaled .  Value is the integer read.  Signals an
+   error if encountering invalid read syntax or if RADIX is out of
+   range.  */
+
+static Lisp_Object
+read_integer (readcharfun, radix)
+     Lisp_Object readcharfun;
+     int radix;
+{
+  int number, ndigits, invalid_p, c, sign;
+
+  if (radix < 2 || radix > 36)
+    invalid_p = 1;
+  else
+    {
+      number = ndigits = invalid_p = 0;
+      sign = 1;
+
+      c = READCHAR;
+      if (c == '-')
+       {
+         c = READCHAR;
+         sign = -1;
+       }
+      else if (c == '+')
+       c = READCHAR;
+  
+      while (c >= 0)
+       {
+         int digit;
+      
+         if (c >= '0' && c <= '9')
+           digit = c - '0';
+         else if (c >= 'a' && c <= 'z')
+           digit = c - 'a' + 10;
+         else if (c >= 'A' && c <= 'Z')
+           digit = c - 'A' + 10;
+         else
+           {
+             UNREAD (c);
+             break;
+           }
+
+         if (digit < 0 || digit >= radix)
+           invalid_p = 1;
+
+         number = radix * number + digit;
+         ++ndigits;
+         c = READCHAR;
+       }
+    }
+
+  if (ndigits == 0 || invalid_p)
+    {
+      char buf[50];
+      sprintf (buf, "integer, radix %d", radix);
+      Fsignal (Qinvalid_read_syntax, Fcons (build_string (buf), Qnil));
+    }
+
+  return make_number (sign * number);
+}
+
+
 /* If the next token is ')' or ']' or '.', we store that character
    in *PCH and the return value is not interesting.  Else, we store
    zero in *PCH and we read and return one lisp object.
@@ -1560,7 +1713,8 @@ read1 (readcharfun, pch, first_in_list)
  retry:
 
   c = READCHAR;
-  if (c < 0) return Fsignal (Qend_of_file, Qnil);
+  if (c < 0)
+    end_of_file_error ();
 
   switch (c)
     {
@@ -1812,8 +1966,17 @@ read1 (readcharfun, pch, first_in_list)
                return XCDR (tem);
              /* Fall through to error message.  */
            }
+         else if (c == 'r' ||  c == 'R')
+           return read_integer (readcharfun, n);
+         
          /* Fall through to error message.  */
        }
+      else if (c == 'x' || c == 'X')
+       return read_integer (readcharfun, 16);
+      else if (c == 'o' || c == 'O')
+       return read_integer (readcharfun, 8);
+      else if (c == 'b' || c == 'B')
+       return read_integer (readcharfun, 2);
 
       UNREAD (c);
       Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
@@ -1869,7 +2032,8 @@ read1 (readcharfun, pch, first_in_list)
     case '?':
       {
        c = READCHAR;
-       if (c < 0) return Fsignal (Qend_of_file, Qnil);
+       if (c < 0)
+         end_of_file_error ();
 
        if (c == '\\')
          c = read_escape (readcharfun, 0);
@@ -1957,7 +2121,7 @@ read1 (readcharfun, pch, first_in_list)
              }
          }
        if (c < 0)
-         return Fsignal (Qend_of_file, Qnil);
+         end_of_file_error ();
 
        /* If purifying, and string starts with \ newline,
           return zero instead.  This is for doc strings
@@ -1966,13 +2130,15 @@ read1 (readcharfun, pch, first_in_list)
          return make_number (0);
 
        if (force_multibyte)
-         nchars = multibyte_chars_in_text (read_buffer, p - read_buffer);
+         p = read_buffer + str_as_multibyte (read_buffer, end - read_buffer,
+                                             p - read_buffer, &nchars);
        else if (force_singlebyte)
          nchars = p - read_buffer;
        else if (load_convert_to_unibyte)
          {
            Lisp_Object string;
-           nchars = multibyte_chars_in_text (read_buffer, p - read_buffer);
+           p = read_buffer + str_as_multibyte (read_buffer, end - read_buffer,
+                                               p - read_buffer, &nchars);
            if (p - read_buffer != nchars)
              {
                string = make_multibyte_string (read_buffer, nchars,
@@ -1982,12 +2148,13 @@ read1 (readcharfun, pch, first_in_list)
          }
        else if (EQ (readcharfun, Qget_file_char)
                 || EQ (readcharfun, Qlambda))
-         /* Nowadays, reading directly from a file
-            is used only for compiled Emacs Lisp files,
-            and those always use the Emacs internal encoding.
-            Meanwhile, Qlambda is used for reading dynamic byte code
-            (compiled with byte-compile-dynamic = t).  */
-         nchars = multibyte_chars_in_text (read_buffer, p - read_buffer);
+         /* Nowadays, reading directly from a file is used only for
+            compiled Emacs Lisp files, and those always use the
+            Emacs internal encoding.  Meanwhile, Qlambda is used
+            for reading dynamic byte code (compiled with
+            byte-compile-dynamic = t).  */
+         p = read_buffer + str_as_multibyte (read_buffer, end - read_buffer,
+                                             p - read_buffer, &nchars);
        else
          /* In all other cases, if we read these bytes as
             separate characters, treat them as separate characters now.  */
@@ -2004,15 +2171,11 @@ read1 (readcharfun, pch, first_in_list)
 
     case '.':
       {
-#ifdef LISP_FLOAT_TYPE
-       /* If a period is followed by a number, then we should read it
-          as a floating point number.  Otherwise, it denotes a dotted
-          pair.  */
        int next_char = READCHAR;
        UNREAD (next_char);
 
-       if (! (next_char >= '0' && next_char <= '9'))
-#endif
+       if (next_char <= 040
+           || index ("\"'`,(", next_char))
          {
            *pch = c;
            return Qnil;
@@ -2035,11 +2198,6 @@ read1 (readcharfun, pch, first_in_list)
          while (c > 040
                 && !(c == '\"' || c == '\'' || c == ';' || c == '?'
                      || c == '(' || c == ')'
-#ifndef LISP_FLOAT_TYPE
-                     /* If we have floating-point support, then we need
-                        to allow <digits><dot><digits>.  */
-                     || c =='.'
-#endif /* not LISP_FLOAT_TYPE */
                      || c == '[' || c == ']' || c == '#'
                      ))
            {
@@ -2086,17 +2244,13 @@ read1 (readcharfun, pch, first_in_list)
            if (p1 != p)
              {
                while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
-#ifdef LISP_FLOAT_TYPE
                /* Integers can have trailing decimal points.  */
                if (p1 > read_buffer && p1 < p && *p1 == '.') p1++;
-#endif
                if (p1 == p)
                  /* It is an integer. */
                  {
-#ifdef LISP_FLOAT_TYPE
                    if (p1[-1] == '.')
                      p1[-1] = '\0';
-#endif
                    if (sizeof (int) == sizeof (EMACS_INT))
                      XSETINT (val, atoi (read_buffer));
                    else if (sizeof (long) == sizeof (EMACS_INT))
@@ -2106,7 +2260,6 @@ read1 (readcharfun, pch, first_in_list)
                    return val;
                  }
              }
-#ifdef LISP_FLOAT_TYPE
            if (isfloat_string (read_buffer))
              {
                /* Compute NaN and infinities using 0.0 in a variable,
@@ -2139,7 +2292,6 @@ read1 (readcharfun, pch, first_in_list)
 
                return make_float (negative ? - value : value);
              }
-#endif
          }
 
        if (uninterned_symbol)
@@ -2219,7 +2371,7 @@ substitute_object_recurse (object, placeholder, subtree)
     case Lisp_Vectorlike:
       {
        int i;
-       int length = Flength(subtree);
+       int length = XINT (Flength(subtree));
        for (i = 0; i < length; i++)
          {
            Lisp_Object idx = make_number (i);
@@ -2271,8 +2423,6 @@ substitute_in_interval (interval, arg)
 }
 
 \f
-#ifdef LISP_FLOAT_TYPE
-
 #define LEAD_INT 1
 #define DOT_CHAR 2
 #define TRAIL_INT 4
@@ -2342,7 +2492,7 @@ isfloat_string (cp)
              || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
              || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
 }
-#endif /* LISP_FLOAT_TYPE */
+
 \f
 static Lisp_Object
 read_vector (readcharfun, bytecodeflag)
@@ -2939,7 +3089,7 @@ init_obarray ()
   staticpro (&Qvariable_documentation);
 
   read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH;
-  read_buffer = (char *) malloc (read_buffer_size);
+  read_buffer = (char *) xmalloc (read_buffer_size);
 }
 \f
 void
@@ -3022,8 +3172,6 @@ defvar_lisp (namestring, address)
   staticpro (address);
 }
 
-#ifndef standalone
-
 /* Similar but define a variable whose value is the Lisp Object stored in
    the current buffer.  address is the address of the slot in the buffer
    that is current now. */
@@ -3046,15 +3194,15 @@ defvar_per_buffer (namestring, address, type, doc)
   XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd;
   XBUFFER_OBJFWD (val)->offset = offset;
   XSYMBOL (sym)->value = val;
-  *(Lisp_Object *)(offset + (char *)&buffer_local_symbols) = sym;
-  *(Lisp_Object *)(offset + (char *)&buffer_local_types) = type;
-  if (XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags)) == 0)
+  PER_BUFFER_SYMBOL (offset) = sym;
+  PER_BUFFER_TYPE (offset) = type;
+  
+  if (PER_BUFFER_IDX (offset) == 0)
     /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
        slot of buffer_local_flags */
     abort ();
 }
 
-#endif /* standalone */
 
 /* Similar but define a variable whose value is the Lisp Object stored
    at a particular offset in the current kboard object.  */
@@ -3320,7 +3468,8 @@ Each alist element is a list that starts with a file name,\n\
 except for one element (optional) that starts with nil and describes\n\
 definitions evaluated from buffers not visiting files.\n\
 The remaining elements of each list are symbols defined as functions\n\
-or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
+or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',\n\
+and `(autoload . SYMBOL)'.");
   Vload_history = Qnil;
 
   DEFVAR_LISP ("load-file-name", &Vload_file_name,
@@ -3358,9 +3507,9 @@ This is useful when the file being loaded is a temporary copy.");
   load_force_doc_strings = 0;
 
   DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte,
-     "Non-nil means `load' converts strings to unibyte whenever possible.\n\
-This is normally used in `load-with-code-conversion'\n\
-for loading non-compiled files.");
+     "Non-nil means `read' converts strings to unibyte whenever possible.\n\
+This is normally bound by `load' and `eval-buffer' to control `read',\n\
+and is not meant for users to change.");
   load_convert_to_unibyte = 0;
 
   DEFVAR_LISP ("source-directory", &Vsource_directory,
@@ -3378,6 +3527,16 @@ You cannot count on them to still be there!");
      "List of all DEFVAR_BOOL variables, used by the byte code optimizer.");
   Vbyte_boolean_vars = Qnil;
 
+  DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries,
+     "Non-nil means load dangerous compiled Lisp files.\n\
+Some versions of XEmacs use different byte codes than Emacs.  These\n\
+incompatible byte codes can make Emacs crash when it tries to execute\n\
+them.");
+  load_dangerous_libraries = 0;
+
+  Vbytecomp_version_regexp = build_string ("^;;;.in Emacs version");
+  staticpro (&Vbytecomp_version_regexp);
+
   /* Vsource_directory was initialized in init_lread.  */
 
   load_descriptor_list = Qnil;