(read1): Before calling index, check if the 2nd
[bpt/emacs.git] / src / lread.c
index f273ce6..73345d3 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);
                }
            }
        }
@@ -1100,8 +1121,8 @@ openp (path, str, suffixes, storeptr, predicate)
                  handler = Ffind_file_name_handler (filename, Qfile_exists_p);
             It's not clear why that was the case and it breaks things like
             (load "/bar.el") where the file is actually "/bar.el.gz".  */
-         handler = Ffind_file_name_handler (filename, Qfile_exists_p);
          string = build_string (fn);
+         handler = Ffind_file_name_handler (string, Qfile_exists_p);
          if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
             {
              if (NILP (predicate))
@@ -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 >= 0)
+           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,50 @@ 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
+                 || (next_next_char < 0200
+                     && (index ("\"';([#?", next_next_char)
+                         || (!first_in_list && next_next_char == '`')
+                         || (new_backquote_flag && next_next_char == ','))));
+         }
+       else
+         {
+           ok = (next_char <= 040
+                 || (next_char < 0200
+                     && (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 +2447,10 @@ read1 (readcharfun, pch, first_in_list)
        UNREAD (next_char);
 
        if (next_char <= 040
-           || index ("\"'`,(", next_char))
+           || (next_char < 0200
+               && index ("\"';([#?", next_char)
+               || (!first_in_list && next_char == '`')
+               || (new_backquote_flag && next_char == ',')))
          {
            *pch = c;
            return Qnil;
@@ -2401,9 +2471,10 @@ read1 (readcharfun, pch, first_in_list)
          char *end = read_buffer + read_buffer_size;
 
          while (c > 040
-                && !(c == '\"' || c == '\'' || c == ';'
-                     || c == '(' || c == ')'
-                     || c == '[' || c == ']' || c == '#'))
+                && (c >= 0200
+                    || (!index ("\"';()[]#", c)
+                        && !(!first_in_list && c == '`')
+                        && !(new_backquote_flag && c == ','))))
            {
              if (end - p < MAX_MULTIBYTE_LENGTH)
                {
@@ -2413,7 +2484,7 @@ read1 (readcharfun, pch, first_in_list)
                  p = read_buffer + offset;
                  end = read_buffer + read_buffer_size;
                }
-             
+
              if (c == '\\')
                {
                  c = READCHAR;
@@ -2507,7 +2578,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 +2609,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 +2653,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 +2666,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 +2687,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 +2724,7 @@ isfloat_string (cp)
      register char *cp;
 {
   register int state;
-  
+
   char *start = cp;
 
   state = 0;
@@ -2784,7 +2855,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 +2874,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.  */
@@ -3292,7 +3363,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. */
@@ -3425,7 +3496,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 */
@@ -3597,8 +3668,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.  */
 
@@ -3709,19 +3780,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,7 +3833,10 @@ 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,
 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
-`(defvar . VARIABLE), and `(autoload . SYMBOL)'.  */);
+`(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,
@@ -3882,7 +3956,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);
 }