(enum fringe_bitmap_type): Define here.
[bpt/emacs.git] / src / lread.c
index 6fd967d..70f0a3f 100644 (file)
@@ -201,7 +201,7 @@ int load_dangerous_libraries;
 static Lisp_Object Vbytecomp_version_regexp;
 
 static void to_multibyte P_ ((char **, char **, int *));
-static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object, 
+static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
                              Lisp_Object (*) (), int,
                              Lisp_Object, Lisp_Object));
 static Lisp_Object load_unwind P_ ((Lisp_Object));
@@ -215,7 +215,7 @@ static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));
    The READCHAR and UNREAD macros are meant for reading/unreading a
    byte code; they do not handle multibyte characters.  The caller
    should manage them if necessary.
-   
+
    [ Actually that seems to be a lie; READCHAR will definitely read
      multibyte characters from buffer sources, at least.  Is the
      comment just out of date?
@@ -233,7 +233,7 @@ readchar (readcharfun)
   register int c;
 
   readchar_count++;
-  
+
   if (BUFFERP (readcharfun))
     {
       register struct buffer *inbuffer = XBUFFER (readcharfun);
@@ -411,7 +411,7 @@ unreadchar (readcharfun, c)
 static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
                                            Lisp_Object));
 static Lisp_Object read0 P_ ((Lisp_Object));
-static Lisp_Object read1 P_ ((Lisp_Object, int *, int)); 
+static Lisp_Object read1 P_ ((Lisp_Object, int *, int));
 
 static Lisp_Object read_list P_ ((int, Lisp_Object));
 static Lisp_Object read_vector P_ ((Lisp_Object, int));
@@ -457,7 +457,7 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
   if (display_hourglass_p)
     cancel_hourglass ();
 #endif
-  
+
   delayed_switch_frame = Qnil;
 
   /* Read until we get an acceptable event.  */
@@ -498,7 +498,7 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
                XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
            }
        }
-         
+
       /* If we don't have a character now, deal with it appropriately.  */
       if (!INTEGERP (val))
        {
@@ -637,11 +637,20 @@ record_load_unwind (old)
   return Vloads_in_progress = old;
 }
 
+/* This handler function is used via internal_condition_case_1.  */
+
+static Lisp_Object
+load_error_handler (data)
+     Lisp_Object data;
+{
+  return Qnil;
+}
 
 DEFUN ("load", Fload, Sload, 1, 5, 0,
        doc: /* Execute a file of Lisp code named FILE.
 First try FILE with `.elc' appended, then try with `.el',
- then try FILE unmodified.  Environment variable references in FILE
+ then try FILE unmodified (the exact suffixes are determined by
+`load-suffixes').  Environment variable references in FILE
  are replaced with their values by calling `substitute-in-file-name'.
 This function searches the directories in `load-path'.
 If optional second arg NOERROR is non-nil,
@@ -691,7 +700,16 @@ Return t if file exists.  */)
      everywhere, it accidentally stayed here.  Since then, enough people
      supposedly have things like (load "$PROJECT/foo.el") in their .emacs
      that it seemed risky to remove.  */
-  file = Fsubstitute_in_file_name (file);
+  if (! NILP (noerror))
+    {
+      file = internal_condition_case_1 (Fsubstitute_in_file_name, file,
+                                       Qt, load_error_handler);
+      if (NILP (file))
+       return Qnil;
+    }
+  else
+    file = Fsubstitute_in_file_name (file);
+
 
   /* Avoid weird lossage with null string as arg,
      since it would try to load a directory as a Lisp file */
@@ -730,9 +748,8 @@ Return t if file exists.  */)
   if (fd == -1)
     {
       if (NILP (noerror))
-       while (1)
-         Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"),
-                                      Fcons (file, Qnil)));
+       Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"),
+                                    Fcons (file, Qnil)));
       else
        return Qnil;
     }
@@ -792,8 +809,12 @@ Return t if file exists.  */)
            {
              safe_p = 0;
              if (!load_dangerous_libraries)
-               error ("File `%s' was not compiled in Emacs",
-                      SDATA (found));
+               {
+                 if (fd >= 0)
+                   emacs_close (fd);
+                 error ("File `%s' was not compiled in Emacs",
+                        SDATA (found));
+               }
              else if (!NILP (nomessage))
                message_with_string ("File `%s' not compiled in Emacs", found, 1);
            }
@@ -823,7 +844,7 @@ Return t if file exists.  */)
                  Lisp_Object file;
                  file = Fsubstring (found, make_number (0), make_number (-1));
                  message_with_string ("Source file `%s' newer than byte-compiled file",
-                                      file, STRING_MULTIBYTE (file));
+                                      file, 1);
                }
            }
        }
@@ -958,7 +979,7 @@ static int
 complete_filename_p (pathname)
      Lisp_Object pathname;
 {
-  register unsigned char *s = SDATA (pathname);
+  register const unsigned char *s = SDATA (pathname);
   return (IS_DIRECTORY_SEP (s[0])
          || (SCHARS (pathname) > 2
              && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
@@ -1122,7 +1143,7 @@ openp (path, str, suffixes, storeptr, predicate)
            }
          else
            {
-             char *pfn;
+             const char *pfn;
 
              encoded_fn = ENCODE_FILE (string);
              pfn = SDATA (encoded_fn);
@@ -1201,7 +1222,7 @@ build_load_history (stream, source)
                {
                  newelt = XCAR (tem2);
 
-                 if (NILP (Fmemq (newelt, tem)))
+                 if (NILP (Fmember (newelt, tem)))
                    Fsetcar (tail, Fcons (XCAR (tem),
                                          Fcons (newelt, XCDR (tem))));
 
@@ -1372,7 +1393,7 @@ it specifies the file name to use for `load-history'.
 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
 for this invocation.
 
-The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that
+The optional fifth argument DO-ALLOW-PRINT, if non-nil, specifies that
 `print' and related functions should work normally even if PRINTFLAG is nil.
 
 This function preserves the position of point.  */)
@@ -1529,7 +1550,7 @@ read_internal_start (stream, start, end)
       read_from_string_index_byte = string_char_to_byte (stream, startval);
       read_from_string_limit = endval;
     }
-      
+
   retval = read0 (stream);
   if (EQ (Vread_with_symbol_positions, Qt)
       || EQ (Vread_with_symbol_positions, stream))
@@ -1676,9 +1697,13 @@ read_escape (readcharfun, stringp, byterep)
       return c | alt_modifier;
 
     case 's':
+      if (stringp)
+       return ' ';
       c = READCHAR;
-      if (c != '-')
-       error ("Invalid escape character syntax");
+      if (c != '-') {
+       UNREAD (c);
+       return ' ';
+      }
       c = READCHAR;
       if (c == '\\')
        c = read_escape (readcharfun, 0, byterep);
@@ -1730,7 +1755,7 @@ read_escape (readcharfun, stringp, byterep)
                break;
              }
          }
-       
+
        *byterep = 1;
        return i;
       }
@@ -1804,11 +1829,11 @@ read_integer (readcharfun, radix)
        }
       else if (c == '+')
        c = READCHAR;
-  
+
       while (c >= 0)
        {
          int digit;
-      
+
          if (c >= '0' && c <= '9')
            digit = c - '0';
          else if (c >= 'a' && c <= 'z')
@@ -1873,7 +1898,7 @@ to_multibyte (p, end, nchars)
   if (nbytes != *nchars)
     nbytes = str_as_multibyte (read_buffer, read_buffer_size,
                               *p - read_buffer, nchars);
-  
+
   *p = read_buffer + nbytes;
 }
 
@@ -1971,7 +1996,7 @@ read1 (readcharfun, pch, first_in_list)
                        == (SCHARS (tmp) - 1) * BITS_PER_CHAR))
                Fsignal (Qinvalid_read_syntax,
                         Fcons (make_string ("#&...", 5), Qnil));
-               
+
              val = Fmake_bool_vector (length, Qnil);
              bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
                     size_in_chars);
@@ -2026,7 +2051,7 @@ read1 (readcharfun, pch, first_in_list)
          UNGCPRO;
          return tmp;
        }
-      
+
       /* #@NUMBER is used to skip NUMBER following characters.
         That's used in .elc files to skip over doc strings
         and function definitions.  */
@@ -2043,7 +2068,7 @@ read1 (readcharfun, pch, first_in_list)
            }
          if (c >= 0)
            UNREAD (c);
-         
+
          if (load_force_doc_strings && EQ (readcharfun, Qget_file_char))
            {
              /* If we are supposed to force doc strings into core right now,
@@ -2098,6 +2123,14 @@ read1 (readcharfun, pch, first_in_list)
 
          goto retry;
        }
+      if (c == '!')
+       {
+         /* #! appears at the beginning of an executable file.
+            Skip the first line.  */
+         while (c != '\n')
+           c = READCHAR;
+         goto retry;
+       }
       if (c == '$')
        return Vload_file_name;
       if (c == '\'')
@@ -2141,7 +2174,7 @@ read1 (readcharfun, pch, first_in_list)
 
              /* ...and #n# will use the real value from now on.  */
              Fsetcdr (cell, tem);
-             
+
              return tem;
            }
          /* #n# returns a previously read object.  */
@@ -2154,7 +2187,7 @@ read1 (readcharfun, pch, first_in_list)
            }
          else if (c == 'r' ||  c == 'R')
            return read_integer (readcharfun, n);
-         
+
          /* Fall through to error message.  */
        }
       else if (c == 'x' || c == 'X')
@@ -2218,16 +2251,48 @@ read1 (readcharfun, pch, first_in_list)
     case '?':
       {
        int discard;
+       int next_char;
+       int ok;
 
        c = READCHAR;
        if (c < 0)
          end_of_file_error ();
 
+       /* Accept `single space' syntax like (list ? x) where the
+          whitespace character is SPC or TAB.
+          Other literal whitespace like NL, CR, and FF are not accepted,
+          as there are well-established escape sequences for these.  */
+       if (c == ' ' || c == '\t')
+         return make_number (c);
+
        if (c == '\\')
          c = read_escape (readcharfun, 0, &discard);
        else if (BASE_LEADING_CODE_P (c))
          c = read_multibyte (c, readcharfun);
 
+       next_char = READCHAR;
+       if (next_char == '.')
+         {
+           /* Only a dotted-pair dot is valid after a char constant.  */
+           int next_next_char = READCHAR;
+           UNREAD (next_next_char);
+
+           ok = (next_next_char <= 040
+                 || index ("\"';([#?", next_next_char)
+                 || (!first_in_list && next_next_char == '`')
+                 || (new_backquote_flag && next_next_char == ','));
+         }
+       else
+         {
+           ok = (next_char <= 040
+                 || index ("\"';()[]#?", next_char)
+                 || (!first_in_list && next_char == '`')
+                 || (new_backquote_flag && next_char == ','));
+         }
+       UNREAD (next_char);
+       if (!ok)
+         Fsignal (Qinvalid_read_syntax, Fcons (make_string ("?", 1), Qnil));
+
        return make_number (c);
       }
 
@@ -2380,7 +2445,9 @@ read1 (readcharfun, pch, first_in_list)
        UNREAD (next_char);
 
        if (next_char <= 040
-           || index ("\"'`,(", next_char))
+           || index ("\"';([#?", next_char)
+           || (!first_in_list && next_char == '`')
+           || (new_backquote_flag && next_char == ','))
          {
            *pch = c;
            return Qnil;
@@ -2401,9 +2468,9 @@ read1 (readcharfun, pch, first_in_list)
          char *end = read_buffer + read_buffer_size;
 
          while (c > 040
-                && !(c == '\"' || c == '\'' || c == ';'
-                     || c == '(' || c == ')'
-                     || c == '[' || c == ']' || c == '#'))
+                && !index ("\"';()[]#", c)
+                && !(!first_in_list && c == '`')
+                && !(new_backquote_flag && c == ','))
            {
              if (end - p < MAX_MULTIBYTE_LENGTH)
                {
@@ -2413,7 +2480,7 @@ read1 (readcharfun, pch, first_in_list)
                  p = read_buffer + offset;
                  end = read_buffer + read_buffer_size;
                }
-             
+
              if (c == '\\')
                {
                  c = READCHAR;
@@ -2507,7 +2574,7 @@ read1 (readcharfun, pch, first_in_list)
            : intern (read_buffer);
          if (EQ (Vread_with_symbol_positions, Qt)
              || EQ (Vread_with_symbol_positions, readcharfun))
-           Vread_symbol_positions_list = 
+           Vread_symbol_positions_list =
              /* Kind of a hack; this will probably fail if characters
                 in the symbol name were escaped.  Not really a big
                 deal, though.  */
@@ -2538,7 +2605,7 @@ substitute_object_in_subtree (object, placeholder)
   /* Make all the substitutions. */
   check_object
     = substitute_object_recurse (object, placeholder, object);
-  
+
   /* Clear seen_list because we're done with it. */
   seen_list = Qnil;
 
@@ -2582,7 +2649,7 @@ substitute_object_recurse (object, placeholder, subtree)
      read_objects.  */
   if (!EQ (Qnil, Frassq (subtree, read_objects)))
     seen_list = Fcons (subtree, seen_list);
-      
+
   /* Recurse according to subtree's type.
      Every branch must return a Lisp_Object.  */
   switch (XTYPE (subtree))
@@ -2595,7 +2662,7 @@ substitute_object_recurse (object, placeholder, subtree)
          {
            Lisp_Object idx = make_number (i);
            SUBSTITUTE (Faref (subtree, idx),
-                       Faset (subtree, idx, true_value)); 
+                       Faset (subtree, idx, true_value));
          }
        return subtree;
       }
@@ -2616,7 +2683,7 @@ substitute_object_recurse (object, placeholder, subtree)
 
        INTERVAL    root_interval = STRING_INTERVALS (subtree);
        Lisp_Object arg           = Fcons (object, placeholder);
-          
+
        traverse_intervals_noorder (root_interval,
                                    &substitute_in_interval, arg);
 
@@ -2653,7 +2720,7 @@ isfloat_string (cp)
      register char *cp;
 {
   register int state;
-  
+
   char *start = cp;
 
   state = 0;
@@ -2784,7 +2851,7 @@ read_vector (readcharfun, bytecodeflag)
     }
   return vector;
 }
-  
+
 /* FLAG = 1 means check for ] to terminate rather than ) and .
    FLAG = -1 means check for starting with defun
     and make structure pure.  */
@@ -2803,7 +2870,7 @@ read_list (flag, readcharfun)
   struct gcpro gcpro1, gcpro2;
   /* 0 is the normal case.
      1 means this list is a doc reference; replace it with the number 0.
-     2 means this list is a doc reference; replace it with the doc string.  */ 
+     2 means this list is a doc reference; replace it with the doc string.  */
   int doc_reference = 0;
 
   /* Initialize this to 1 if we are reading a list.  */
@@ -2973,7 +3040,6 @@ Lisp_Object initial_obarray;
 int oblookup_last_bucket_number;
 
 static int hash_string ();
-Lisp_Object oblookup ();
 
 /* Get an error if OBARRAY is not an obarray.
    If it is one, return it.  */
@@ -2997,7 +3063,7 @@ check_obarray (obarray)
 
 Lisp_Object
 intern (str)
-     char *str;
+     const char *str;
 {
   Lisp_Object tem;
   int len = strlen (str);
@@ -3080,8 +3146,7 @@ it defaults to the value of `obarray'.  */)
      (name, obarray)
      Lisp_Object name, obarray;
 {
-  register Lisp_Object tem;
-  struct Lisp_String *string;
+  register Lisp_Object tem, string;
 
   if (NILP (obarray)) obarray = Vobarray;
   obarray = check_obarray (obarray);
@@ -3089,12 +3154,12 @@ it defaults to the value of `obarray'.  */)
   if (!SYMBOLP (name))
     {
       CHECK_STRING (name);
-      string = XSTRING (name);
+      string = name;
     }
   else
-    string = XSTRING (SYMBOL_NAME (name));
+    string = SYMBOL_NAME (name);
 
-  tem = oblookup (obarray, string->data, string->size, STRING_BYTES (string));
+  tem = oblookup (obarray, SDATA (string), SCHARS (string), SBYTES (string));
   if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
     return Qnil;
   else
@@ -3175,7 +3240,7 @@ OBARRAY defaults to the value of the variable `obarray'.  */)
 Lisp_Object
 oblookup (obarray, ptr, size, size_byte)
      Lisp_Object obarray;
-     register char *ptr;
+     register const char *ptr;
      int size, size_byte;
 {
   int hash;
@@ -3216,11 +3281,11 @@ oblookup (obarray, ptr, size, size_byte)
 
 static int
 hash_string (ptr, len)
-     unsigned char *ptr;
+     const unsigned char *ptr;
      int len;
 {
-  register unsigned char *p = ptr;
-  register unsigned char *end = p + len;
+  register const unsigned char *p = ptr;
+  register const unsigned char *end = p + len;
   register unsigned char c;
   register int hash = 0;
 
@@ -3294,7 +3359,7 @@ init_obarray ()
   /* Intern nil in the obarray */
   XSYMBOL (Qnil)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
   XSYMBOL (Qnil)->constant = 1;
-  
+
   /* These locals are to kludge around a pyramid compiler bug. */
   hash = hash_string ("nil", 3);
   /* Separate statement here to avoid VAXC bug. */
@@ -3427,7 +3492,7 @@ defvar_per_buffer (namestring, address, type, doc)
   SET_SYMBOL_VALUE (sym, val);
   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 */
@@ -3599,8 +3664,8 @@ init_lread ()
 #endif
 
 #ifndef WINDOWSNT
-  /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is 
-     almost never correct, thereby causing a warning to be printed out that 
+  /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
+     almost never correct, thereby causing a warning to be printed out that
      confuses users.  Since PATH_LOADSEARCH is always overridden by the
      EMACSLOADPATH environment variable below, disable the warning on NT.  */
 
@@ -3711,19 +3776,19 @@ the toplevel; bind it instead. */);
   Vread_with_symbol_positions = Qnil;
 
   DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list,
-              doc: /* An list mapping read symbols to their positions.
+              doc: /* A list mapping read symbols to their positions.
 This variable is modified during calls to `read' or
 `read-from-string', but only when `read-with-symbol-positions' is
 non-nil.
 
 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
-CHAR-POSITION is an integer giving the offset of that occurence of the
+CHAR-POSITION is an integer giving the offset of that occurrence of the
 symbol from the position where `read' or `read-from-string' started.
 
 Note that a symbol will appear multiple times in this list, if it was
 read multiple times.  The list is in the same order as the symbols
 were read in. */);
-  Vread_symbol_positions_list = Qnil;  
+  Vread_symbol_positions_list = Qnil;
 
   DEFVAR_LISP ("load-path", &Vload_path,
               doc: /* *List of directories to search for files to load.
@@ -3762,9 +3827,12 @@ when the corresponding call to `provide' is made.  */);
 Each alist element is a list that starts with a file name,
 except for one element (optional) that starts with nil and describes
 definitions evaluated from buffers not visiting files.
-The remaining elements of each list are symbols defined as functions
-or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',
-and `(autoload . SYMBOL)'.  */);
+The remaining elements of each list are symbols defined as functions,
+and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
+`(defvar . VARIABLE), `(autoload . SYMBOL)', and `(t . SYMBOL)'.
+An element `(t . SYMBOL)' precedes an entry that is just SYMBOL,
+and means that SYMBOL was an autoload before this file redefined it
+as a function.  */);
   Vload_history = Qnil;
 
   DEFVAR_LISP ("load-file-name", &Vload_file_name,
@@ -3884,7 +3952,7 @@ to load.  See also `load-dangerous-libraries'.  */);
   staticpro (&read_objects);
   read_objects = Qnil;
   staticpro (&seen_list);
-  
+
   Vloads_in_progress = Qnil;
   staticpro (&Vloads_in_progress);
 }