Merge from trunk.
[bpt/emacs.git] / src / lread.c
index f2a5278..d38fb51 100644 (file)
@@ -109,9 +109,9 @@ static FILE *instream;
 static int read_pure;
 
 /* For use within read-from-string (this reader is non-reentrant!!)  */
-static EMACS_INT read_from_string_index;
-static EMACS_INT read_from_string_index_byte;
-static EMACS_INT read_from_string_limit;
+static ptrdiff_t read_from_string_index;
+static ptrdiff_t read_from_string_index_byte;
+static ptrdiff_t read_from_string_limit;
 
 /* Number of characters read in the current call to Fread or
    Fread_from_string. */
@@ -209,7 +209,7 @@ readchar (Lisp_Object readcharfun, int *multibyte)
     {
       register struct buffer *inbuffer = XBUFFER (readcharfun);
 
-      EMACS_INT pt_byte = BUF_PT_BYTE (inbuffer);
+      ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
 
       if (pt_byte >= BUF_ZV_BYTE (inbuffer))
        return -1;
@@ -238,7 +238,7 @@ readchar (Lisp_Object readcharfun, int *multibyte)
     {
       register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
 
-      EMACS_INT bytepos = marker_byte_position (readcharfun);
+      ptrdiff_t bytepos = marker_byte_position (readcharfun);
 
       if (bytepos >= BUF_ZV_BYTE (inbuffer))
        return -1;
@@ -372,8 +372,8 @@ unreadchar (Lisp_Object readcharfun, int c)
   else if (BUFFERP (readcharfun))
     {
       struct buffer *b = XBUFFER (readcharfun);
-      EMACS_INT charpos = BUF_PT (b);
-      EMACS_INT bytepos = BUF_PT_BYTE (b);
+      ptrdiff_t charpos = BUF_PT (b);
+      ptrdiff_t bytepos = BUF_PT_BYTE (b);
 
       if (! NILP (BVAR (b, enable_multibyte_characters)))
        BUF_DEC_POS (b, bytepos);
@@ -385,7 +385,7 @@ unreadchar (Lisp_Object readcharfun, int c)
   else if (MARKERP (readcharfun))
     {
       struct buffer *b = XMARKER (readcharfun)->buffer;
-      EMACS_INT bytepos = XMARKER (readcharfun)->bytepos;
+      ptrdiff_t bytepos = XMARKER (readcharfun)->bytepos;
 
       XMARKER (readcharfun)->charpos--;
       if (! NILP (BVAR (b, enable_multibyte_characters)))
@@ -608,8 +608,11 @@ read_filtered_event (int no_switch_frame, int ascii_required,
       int sec, usec;
       double duration = extract_float (seconds);
 
-      sec  = (int) duration;
-      usec = (duration - sec) * 1000000;
+      if (0 < duration)
+       duration_to_sec_usec (duration, &sec, &usec);
+      else
+       sec = usec = 0;
+
       EMACS_GET_TIME (end_time);
       EMACS_SET_SECS_USECS (wait_time, sec, usec);
       EMACS_ADD_TIME (end_time, end_time, wait_time);
@@ -1023,7 +1026,7 @@ Return t if the file exists and loads successfully.  */)
 {
   register FILE *stream;
   register int fd = -1;
-  int count = SPECPDL_INDEX ();
+  ptrdiff_t count = SPECPDL_INDEX ();
   struct gcpro gcpro1, gcpro2, gcpro3;
   Lisp_Object found, efound, hist_file_name;
   /* 1 means we printed the ".el is newer" message.  */
@@ -1124,6 +1127,22 @@ Return t if the file exists and loads successfully.  */)
        handler = Ffind_file_name_handler (found, Qload);
       if (! NILP (handler))
        return call5 (handler, Qload, found, noerror, nomessage, Qt);
+#ifdef DOS_NT
+      /* Tramp has to deal with semi-broken packages that prepend
+        drive letters to remote files.  For that reason, Tramp
+        catches file operations that test for file existence, which
+        makes openp think X:/foo.elc files are remote.  However,
+        Tramp does not catch `load' operations for such files, so we
+        end up with a nil as the `load' handler above.  If we would
+        continue with fd = -2, we will behave wrongly, and in
+        particular try reading a .elc file in the "rt" mode instead
+        of "rb".  See bug #9311 for the results.  To work around
+        this, we try to open the file locally, and go with that if it
+        succeeds.  */
+      fd = emacs_open (SSDATA (ENCODE_FILE (found)), O_RDONLY, 0);
+      if (fd == -1)
+       fd = -2;
+#endif
     }
 
   /* Check if we're stuck in a recursive load cycle.
@@ -1247,9 +1266,17 @@ Return t if the file exists and loads successfully.  */)
   GCPRO3 (file, found, hist_file_name);
 
 #ifdef WINDOWSNT
-  emacs_close (fd);
   efound = ENCODE_FILE (found);
-  stream = fopen (SSDATA (efound), fmode);
+  /* If we somehow got here with fd == -2, meaning the file is deemed
+     to be remote, don't even try to reopen the file locally; just
+     force a failure instead.  */
+  if (fd >= 0)
+    {
+      emacs_close (fd);
+      stream = fopen (SSDATA (efound), fmode);
+    }
+  else
+    stream = NULL;
 #else  /* not WINDOWSNT */
   stream = fdopen (fd, fmode);
 #endif /* not WINDOWSNT */
@@ -1260,7 +1287,7 @@ Return t if the file exists and loads successfully.  */)
     }
 
   if (! NILP (Vpurify_flag))
-    Vpreloaded_file_list = Fcons (Fpurecopy(file), Vpreloaded_file_list);
+    Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list);
 
   if (NILP (nomessage) || force_load_messages)
     {
@@ -1419,16 +1446,16 @@ int
 openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *storeptr, Lisp_Object predicate)
 {
   register int fd;
-  EMACS_INT fn_size = 100;
+  ptrdiff_t fn_size = 100;
   char buf[100];
   register char *fn = buf;
   int absolute = 0;
-  EMACS_INT want_length;
+  ptrdiff_t want_length;
   Lisp_Object filename;
   struct stat st;
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
   Lisp_Object string, tail, encoded_fn;
-  EMACS_INT max_suffix_len = 0;
+  ptrdiff_t max_suffix_len = 0;
 
   CHECK_STRING (str);
 
@@ -1538,7 +1565,9 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
                {
                  /* Check that we can access or open it.  */
                  if (NATNUMP (predicate))
-                   fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
+                   fd = (((XFASTINT (predicate) & ~INT_MAX) == 0
+                          && access (pfn, XFASTINT (predicate)) == 0)
+                         ? 1 : -1);
                  else
                    fd = emacs_open (pfn, O_RDONLY, 0);
 
@@ -1672,7 +1701,7 @@ readevalloop (Lisp_Object readcharfun,
 {
   register int c;
   register Lisp_Object val;
-  int count = SPECPDL_INDEX ();
+  ptrdiff_t count = SPECPDL_INDEX ();
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
   struct buffer *b = 0;
   int continue_reading_p;
@@ -1723,7 +1752,7 @@ readevalloop (Lisp_Object readcharfun,
   continue_reading_p = 1;
   while (continue_reading_p)
     {
-      int count1 = SPECPDL_INDEX ();
+      ptrdiff_t count1 = SPECPDL_INDEX ();
 
       if (b != 0 && NILP (BVAR (b, name)))
        error ("Reading from killed buffer");
@@ -1772,7 +1801,7 @@ readevalloop (Lisp_Object readcharfun,
 
       /* Ignore whitespace here, so we can detect eof.  */
       if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r'
-         || c == 0x8a0)  /* NBSP */
+         || c == 0xa0)  /* NBSP */
        goto read_next;
 
       if (!NILP (Vpurify_flag) && c == '(')
@@ -1849,7 +1878,7 @@ DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
 This function preserves the position of point.  */)
   (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print)
 {
-  int count = SPECPDL_INDEX ();
+  ptrdiff_t count = SPECPDL_INDEX ();
   Lisp_Object tem, buf;
 
   if (NILP (buffer))
@@ -1893,8 +1922,8 @@ which is the input stream for reading characters.
 This function does not move point.  */)
   (Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function)
 {
-  /* FIXME: Do the eval-sexp-add-defvars danse!  */
-  int count = SPECPDL_INDEX ();
+  /* FIXME: Do the eval-sexp-add-defvars dance!  */
+  ptrdiff_t count = SPECPDL_INDEX ();
   Lisp_Object tem, cbuf;
 
   cbuf = Fcurrent_buffer ();
@@ -1941,6 +1970,8 @@ STREAM or the value of `standard-input' may be:
 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
        doc: /* Read one Lisp expression which is represented as text by STRING.
 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
+FINAL-STRING-INDEX is an integer giving the position of the next
+ remaining character in STRING.
 START and END optionally delimit a substring of STRING from which to read;
  they default to 0 and (length STRING) respectively.  */)
   (Lisp_Object string, Lisp_Object start, Lisp_Object end)
@@ -1970,7 +2001,7 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
   if (STRINGP (stream)
       || ((CONSP (stream) && STRINGP (XCAR (stream)))))
     {
-      EMACS_INT startval, endval;
+      ptrdiff_t startval, endval;
       Lisp_Object string;
 
       if (STRINGP (stream))
@@ -1983,9 +2014,9 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
       else
        {
          CHECK_NUMBER (end);
-         endval = XINT (end);
-         if (endval < 0 || endval > SCHARS (string))
+         if (! (0 <= XINT (end) && XINT (end) <= SCHARS (string)))
            args_out_of_range (string, end);
+         endval = XINT (end);
        }
 
       if (NILP (start))
@@ -1993,9 +2024,9 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
       else
        {
          CHECK_NUMBER (start);
-         startval = XINT (start);
-         if (startval < 0 || startval > endval)
+         if (! (0 <= XINT (start) && XINT (start) <= endval))
            args_out_of_range (string, start);
+         startval = XINT (start);
        }
       read_from_string_index = startval;
       read_from_string_index_byte = string_char_to_byte (string, startval);
@@ -2184,7 +2215,7 @@ read_escape (Lisp_Object readcharfun, int stringp)
     case 'x':
       /* A hex escape, as in ANSI C.  */
       {
-       int i = 0;
+       unsigned int i = 0;
        int count = 0;
        while (1)
          {
@@ -2208,7 +2239,9 @@ read_escape (Lisp_Object readcharfun, int stringp)
                UNREAD (c);
                break;
              }
-           if (MAX_CHAR < i)
+           /* Allow hex escapes as large as ?\xfffffff, because some
+              packages use them to denote characters with modifiers.  */
+           if ((CHAR_META | (CHAR_META - 1)) < i)
              error ("Hex character out of range: \\x%x...", i);
            count += count < 3;
          }
@@ -2471,16 +2504,17 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
              if (c == '[')
                {
                  Lisp_Object tmp;
-                 EMACS_INT depth, size;
+                 int depth;
+                 ptrdiff_t size;
 
                  tmp = read_vector (readcharfun, 0);
-                 if (!INTEGERP (AREF (tmp, 0)))
+                 size = ASIZE (tmp);
+                 if (size == 0)
+                   error ("Invalid size char-table");
+                 if (! RANGED_INTEGERP (1, AREF (tmp, 0), 3))
                    error ("Invalid depth in char-table");
                  depth = XINT (AREF (tmp, 0));
-                 if (depth < 1 || depth > 3)
-                   error ("Invalid depth in char-table");
-                 size = ASIZE (tmp) - 2;
-                 if (chartab_size [depth] != size)
+                 if (chartab_size[depth] != size - 2)
                    error ("Invalid size char-table");
                  XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
                  return tmp;
@@ -2659,7 +2693,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
          uninterned_symbol = 1;
          c = READCHAR;
          if (!(c > 040
-               && c != 0x8a0
+               && c != 0xa0    /* NBSP */
                && (c >= 0200
                    || strchr ("\"';()[]#`,", c) == NULL)))
            {
@@ -2794,7 +2828,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
           So we now use the same heuristic as for backquote: old-style
           unquotes are only recognized when first on a list, and when
           followed by a space.
-          Because it's more difficult to peak 2 chars ahead, a new-style
+          Because it's more difficult to peek 2 chars ahead, a new-style
           ,@ can still not be used outside of a `, unless it's in the middle
           of a list.  */
        if (new_backquote_flag
@@ -3007,7 +3041,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
     default:
     default_label:
       if (c <= 040) goto retry;
-      if (c == 0x8a0) /* NBSP */
+      if (c == 0xa0) /* NBSP */
        goto retry;
 
     read_symbol:
@@ -3048,7 +3082,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
              c = READCHAR;
            }
          while (c > 040
-                && c != 0x8a0 /* NBSP */
+                && c != 0xa0 /* NBSP */
                 && (c >= 0200
                     || strchr ("\"';()[]#`,", c) == NULL));
 
@@ -3075,8 +3109,8 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
          }
        {
          Lisp_Object name, result;
-         EMACS_INT nbytes = p - read_buffer;
-         EMACS_INT nchars
+         ptrdiff_t nbytes = p - read_buffer;
+         ptrdiff_t nchars
            = (multibyte
               ? multibyte_chars_in_text ((unsigned char *) read_buffer,
                                          nbytes)
@@ -3861,7 +3895,7 @@ OBARRAY defaults to the value of the variable `obarray'.  */)
    Also store the bucket number in oblookup_last_bucket_number.  */
 
 Lisp_Object
-oblookup (Lisp_Object obarray, register const char *ptr, EMACS_INT size, EMACS_INT size_byte)
+oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff_t size_byte)
 {
   size_t hash;
   size_t obsize;
@@ -3956,7 +3990,7 @@ init_obarray (void)
   Qnil = intern_c_string ("nil");
 
   /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
-     so those two need to be fixed manally.  */
+     so those two need to be fixed manually.  */
   SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound);
   XSYMBOL (Qunbound)->function = Qunbound;
   XSYMBOL (Qunbound)->plist = Qnil;
@@ -4152,13 +4186,16 @@ init_lread (void)
                }
 
              /* Add site-lisp under the installation dir, if it exists.  */
-             tem = Fexpand_file_name (build_string ("site-lisp"),
-                                      Vinstallation_directory);
-             tem1 = Ffile_exists_p (tem);
-             if (!NILP (tem1))
+             if (!no_site_lisp)
                {
-                 if (NILP (Fmember (tem, Vload_path)))
-                   Vload_path = Fcons (tem, Vload_path);
+                 tem = Fexpand_file_name (build_string ("site-lisp"),
+                                          Vinstallation_directory);
+                 tem1 = Ffile_exists_p (tem);
+                 if (!NILP (tem1))
+                   {
+                     if (NILP (Fmember (tem, Vload_path)))
+                       Vload_path = Fcons (tem, Vload_path);
+                   }
                }
 
              /* If Emacs was not built in the source directory,
@@ -4194,11 +4231,14 @@ init_lread (void)
                      if (NILP (Fmember (tem, Vload_path)))
                        Vload_path = Fcons (tem, Vload_path);
 
-                     tem = Fexpand_file_name (build_string ("site-lisp"),
-                                              Vsource_directory);
+                     if (!no_site_lisp)
+                       {
+                         tem = Fexpand_file_name (build_string ("site-lisp"),
+                                                  Vsource_directory);
 
-                     if (NILP (Fmember (tem, Vload_path)))
-                       Vload_path = Fcons (tem, Vload_path);
+                         if (NILP (Fmember (tem, Vload_path)))
+                           Vload_path = Fcons (tem, Vload_path);
+                       }
                    }
                }
              if (!NILP (sitelisp) && !no_site_lisp)
@@ -4271,14 +4311,20 @@ init_lread (void)
 void
 dir_warning (const char *format, Lisp_Object dirname)
 {
-  char *buffer
-    = (char *) alloca (SCHARS (dirname) + strlen (format) + 5);
-
   fprintf (stderr, format, SDATA (dirname));
-  sprintf (buffer, format, SDATA (dirname));
+
   /* Don't log the warning before we've initialized!! */
   if (initialized)
-    message_dolog (buffer, strlen (buffer), 0, STRING_MULTIBYTE (dirname));
+    {
+      char *buffer;
+      ptrdiff_t message_len;
+      USE_SAFE_ALLOCA;
+      SAFE_ALLOCA (buffer, char *,
+                  SBYTES (dirname) + strlen (format) - (sizeof "%s" - 1) + 1);
+      message_len = esprintf (buffer, format, SDATA (dirname));
+      message_dolog (buffer, message_len, 0, STRING_MULTIBYTE (dirname));
+      SAFE_FREE ();
+    }
 }
 
 void