(row_equal_p, update_window_line): Compare fringe bitmaps
[bpt/emacs.git] / src / lread.c
index 5d5e6e6..4aa49c5 100644 (file)
@@ -1,5 +1,5 @@
 /* Lisp parsing and input streams.
-   Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 2001
+   Copyright (C) 1985,86,87,88,89,93,94,95,97,98,99,2000,01,03,2004
       Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -61,6 +61,9 @@ Boston, MA 02111-1307, USA.  */
 #include <locale.h>
 #endif /* HAVE_SETLOCALE */
 
+#ifdef HAVE_FCNTL_H
+#include <fcntl.h>
+#endif
 #ifndef O_RDONLY
 #define O_RDONLY 0
 #endif
@@ -215,7 +218,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 +236,7 @@ readchar (readcharfun)
   register int c;
 
   readchar_count++;
-  
+
   if (BUFFERP (readcharfun))
     {
       register struct buffer *inbuffer = XBUFFER (readcharfun);
@@ -411,7 +414,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 +460,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 +501,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))
        {
@@ -709,7 +712,7 @@ Return t if file exists.  */)
     }
   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 */
@@ -844,7 +847,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);
                }
            }
        }
@@ -941,6 +944,11 @@ Return t if file exists.  */)
        message_with_string ("Loading %s...done", file, 1);
     }
 
+  if (!NILP (Fequal (build_string ("obsolete"),
+                    Ffile_name_nondirectory
+                    (Fdirectory_file_name (Ffile_name_directory (found))))))
+    message_with_string ("Package %s is obsolete", file, 1);
+
   return Qt;
 }
 
@@ -1049,6 +1057,8 @@ openp (path, str, suffixes, storeptr, predicate)
   Lisp_Object string, tail, encoded_fn;
   int max_suffix_len = 0;
 
+  CHECK_STRING (str);
+
   for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
     {
       CHECK_STRING_CAR (tail);
@@ -1121,8 +1131,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))
@@ -1550,7 +1560,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))
@@ -1697,9 +1707,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);
@@ -1751,7 +1765,7 @@ read_escape (readcharfun, stringp, byterep)
                break;
              }
          }
-       
+
        *byterep = 1;
        return i;
       }
@@ -1825,11 +1839,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')
@@ -1894,7 +1908,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;
 }
 
@@ -1992,7 +2006,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);
@@ -2047,7 +2061,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.  */
@@ -2064,7 +2078,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,
@@ -2123,7 +2137,7 @@ read1 (readcharfun, pch, first_in_list)
        {
          /* #! appears at the beginning of an executable file.
             Skip the first line.  */
-         while (c != '\n')
+         while (c != '\n' && c >= 0)
            c = READCHAR;
          goto retry;
        }
@@ -2170,7 +2184,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.  */
@@ -2183,7 +2197,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')
@@ -2247,16 +2261,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);
       }
 
@@ -2325,7 +2373,7 @@ read1 (readcharfun, pch, first_in_list)
              c = 0;
            else if (c == (CHAR_CTL | '?'))
              c = 127;
-
+           
            if (c & CHAR_SHIFT)
              {
                /* Shift modifier is valid only with [A-Za-z].  */
@@ -2409,7 +2457,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;
@@ -2430,9 +2481,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)
                {
@@ -2442,7 +2494,7 @@ read1 (readcharfun, pch, first_in_list)
                  p = read_buffer + offset;
                  end = read_buffer + read_buffer_size;
                }
-             
+
              if (c == '\\')
                {
                  c = READCHAR;
@@ -2536,7 +2588,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.  */
@@ -2567,7 +2619,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;
 
@@ -2611,7 +2663,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))
@@ -2624,7 +2676,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;
       }
@@ -2645,7 +2697,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);
 
@@ -2682,7 +2734,7 @@ isfloat_string (cp)
      register char *cp;
 {
   register int state;
-  
+
   char *start = cp;
 
   state = 0;
@@ -2813,7 +2865,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.  */
@@ -2832,7 +2884,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.  */
@@ -3321,7 +3373,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. */
@@ -3443,7 +3495,6 @@ defvar_per_buffer (namestring, address, type, doc)
 {
   Lisp_Object sym, val;
   int offset;
-  extern struct buffer buffer_local_symbols;
 
   sym = intern (namestring);
   val = allocate_misc ();
@@ -3454,7 +3505,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 */
@@ -3626,8 +3677,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.  */
 
@@ -3750,7 +3801,7 @@ 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.
@@ -3914,7 +3965,10 @@ to load.  See also `load-dangerous-libraries'.  */);
   staticpro (&read_objects);
   read_objects = Qnil;
   staticpro (&seen_list);
-  
+
   Vloads_in_progress = Qnil;
   staticpro (&Vloads_in_progress);
 }
+
+/* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
+   (do not change this comment) */