Port to C89.
[bpt/emacs.git] / src / lread.c
index 6647382..ae945d1 100644 (file)
@@ -1,6 +1,7 @@
 /* Lisp parsing and input streams.
 
-Copyright (C) 1985-1989, 1993-1995, 1997-2012  Free Software Foundation, Inc.
+Copyright (C) 1985-1989, 1993-1995, 1997-2013 Free Software Foundation,
+Inc.
 
 This file is part of GNU Emacs.
 
@@ -19,7 +20,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 
 #include <config.h>
-#include <stdio.h>
+#include "sysstdio.h"
 #include <sys/types.h>
 #include <sys/stat.h>
 #include <sys/file.h>
@@ -37,7 +38,6 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "keyboard.h"
 #include "frame.h"
 #include "termhooks.h"
-#include "coding.h"
 #include "blockinput.h"
 
 #ifdef MSDOS
@@ -95,14 +95,6 @@ static Lisp_Object Qload_in_progress;
    It must be set to nil before all top-level calls to read0.  */
 static Lisp_Object read_objects;
 
-/* True means READCHAR should read bytes one by one (not character)
-   when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
-   This is set by read1 temporarily while handling #@NUMBER.  */
-static bool load_each_byte;
-
-/* List of descriptors now open for Fload.  */
-static Lisp_Object load_descriptor_list;
-
 /* File for get_file_char to read from.  Use by load.  */
 static FILE *instream;
 
@@ -154,7 +146,6 @@ static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool,
                           Lisp_Object, Lisp_Object,
                           Lisp_Object, Lisp_Object);
 static Lisp_Object load_unwind (Lisp_Object);
-static Lisp_Object load_descriptor_unwind (Lisp_Object);
 \f
 /* Functions that read one byte from the current source READCHARFUN
    or unreads one byte.  If the integer argument C is -1, it returns
@@ -205,6 +196,9 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
 
       ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
 
+      if (! BUFFER_LIVE_P (inbuffer))
+       return -1;
+
       if (pt_byte >= BUF_ZV_BYTE (inbuffer))
        return -1;
 
@@ -327,7 +321,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
       return c;
     }
   c = (*readbyte) (-1, readcharfun);
-  if (c < 0 || load_each_byte)
+  if (c < 0)
     return c;
   if (multibyte)
     *multibyte = 1;
@@ -352,6 +346,46 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
   return STRING_CHAR (buf);
 }
 
+#define FROM_FILE_P(readcharfun)                       \
+  (EQ (readcharfun, Qget_file_char)                    \
+   || EQ (readcharfun, Qget_emacs_mule_file_char))
+
+static void
+skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
+{
+  if (FROM_FILE_P (readcharfun))
+    {
+      block_input ();          /* FIXME: Not sure if it's needed.  */
+      fseek (instream, n, SEEK_CUR);
+      unblock_input ();
+    }
+  else
+    { /* We're not reading directly from a file.  In that case, it's difficult
+        to reliably count bytes, since these are usually meant for the file's
+        encoding, whereas we're now typically in the internal encoding.
+        But luckily, skip_dyn_bytes is used to skip over a single
+        dynamic-docstring (or dynamic byte-code) which is always quoted such
+        that \037 is the final char.  */
+      int c;
+      do {
+       c = READCHAR;
+      } while (c >= 0 && c != '\037');
+    }
+}
+
+static void
+skip_dyn_eof (Lisp_Object readcharfun)
+{
+  if (FROM_FILE_P (readcharfun))
+    {
+      block_input ();          /* FIXME: Not sure if it's needed.  */
+      fseek (instream, 0, SEEK_END);
+      unblock_input ();
+    }
+  else
+    while (READCHAR >= 0);
+}
+
 /* Unread the character C in the way appropriate for the stream READCHARFUN.
    If the stream is a user function, call it with the char as argument.  */
 
@@ -403,17 +437,9 @@ unreadchar (Lisp_Object readcharfun, int c)
     {
       unread_char = c;
     }
-  else if (EQ (readcharfun, Qget_file_char)
-          || EQ (readcharfun, Qget_emacs_mule_file_char))
+  else if (FROM_FILE_P (readcharfun))
     {
-      if (load_each_byte)
-       {
-         block_input ();
-         ungetc (c, instream);
-         unblock_input ();
-       }
-      else
-       unread_char = c;
+      unread_char = c;
     }
   else
     call1 (readcharfun, make_number (c));
@@ -601,17 +627,17 @@ read_filtered_event (bool no_switch_frame, bool ascii_required,
       end_time = add_emacs_time (current_emacs_time (), wait_time);
     }
 
-/* Read until we get an acceptable event.  */
+  /* Read until we get an acceptable event.  */
  retry:
   do
-    val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0,
+    val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0,
                     NUMBERP (seconds) ? &end_time : NULL);
   while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */
 
   if (BUFFERP (val))
     goto retry;
 
-  /* switch-frame events are put off until after the next ASCII
+  /* `switch-frame' events are put off until after the next ASCII
      character.  This is better than signaling an error just because
      the last characters were typed to a separate minibuffer frame,
      for example.  Eventually, some code which can deal with
@@ -797,7 +823,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun)
     {
       bool rv = 0;
       enum {
-       NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX,
+       NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX
       } beg_end_state = NOMINAL;
       bool in_file_vars = 0;
 
@@ -1267,7 +1293,7 @@ Return t if the file exists and loads successfully.  */)
   if (fd >= 0)
     {
       emacs_close (fd);
-      stream = fopen (SSDATA (efound), fmode);
+      stream = emacs_fopen (SSDATA (efound), fmode);
     }
   else
     stream = NULL;
@@ -1297,12 +1323,9 @@ Return t if the file exists and loads successfully.  */)
        message_with_string ("Loading %s...", file, 1);
     }
 
-  record_unwind_protect (load_unwind, make_save_value (stream, 0));
-  record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
+  record_unwind_protect (load_unwind, make_save_pointer (stream));
   specbind (Qload_file_name, found);
   specbind (Qinhibit_file_name_operation, Qnil);
-  load_descriptor_list
-    = Fcons (make_number (fileno (stream)), load_descriptor_list);
   specbind (Qload_in_progress, Qt);
 
   instream = stream;
@@ -1356,7 +1379,7 @@ Return t if the file exists and loads successfully.  */)
 static Lisp_Object
 load_unwind (Lisp_Object arg)  /* Used as unwind-protect function in load.  */
 {
-  FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
+  FILE *stream = XSAVE_POINTER (arg, 0);
   if (stream != NULL)
     {
       block_input ();
@@ -1365,26 +1388,6 @@ load_unwind (Lisp_Object arg)  /* Used as unwind-protect function in load.  */
     }
   return Qnil;
 }
-
-static Lisp_Object
-load_descriptor_unwind (Lisp_Object oldlist)
-{
-  load_descriptor_list = oldlist;
-  return Qnil;
-}
-
-/* Close all descriptors in use for Floads.
-   This is used when starting a subprocess.  */
-
-void
-close_load_descs (void)
-{
-#ifndef WINDOWSNT
-  Lisp_Object tail;
-  for (tail = load_descriptor_list; CONSP (tail); tail = XCDR (tail))
-    emacs_close (XFASTINT (XCAR (tail)));
-#endif
-}
 \f
 static bool
 complete_filename_p (Lisp_Object pathname)
@@ -1418,14 +1421,15 @@ static Lisp_Object Qdir_ok;
 
 /* Search for a file whose name is STR, looking in directories
    in the Lisp list PATH, and trying suffixes from SUFFIX.
-   On success, returns a file descriptor.  On failure, returns -1.
+   On success, return a file descriptor (or 1 or -2 as described below).
+   On failure, return -1 and set errno.
 
    SUFFIXES is a list of strings containing possible suffixes.
    The empty suffix is automatically added if the list is empty.
 
    PREDICATE non-nil means don't open the files,
    just look for one that satisfies the predicate.  In this case,
-   returns 1 on success.  The predicate can be a lisp function or
+   return 1 on success.  The predicate can be a lisp function or
    an integer to pass to `access' (in which case file-name-handlers
    are ignored).
 
@@ -1437,7 +1441,8 @@ static Lisp_Object Qdir_ok;
    but store the found remote file name in *STOREPTR.  */
 
 int
-openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *storeptr, Lisp_Object predicate)
+openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
+       Lisp_Object *storeptr, Lisp_Object predicate)
 {
   ptrdiff_t fn_size = 100;
   char buf[100];
@@ -1448,6 +1453,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
   Lisp_Object string, tail, encoded_fn;
   ptrdiff_t max_suffix_len = 0;
+  int last_errno = ENOENT;
 
   CHECK_STRING (str);
 
@@ -1517,14 +1523,22 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
          if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
             {
              bool exists;
+             last_errno = ENOENT;
              if (NILP (predicate))
                exists = !NILP (Ffile_readable_p (string));
              else
                {
                  Lisp_Object tmp = call1 (predicate, string);
-                 exists = !NILP (tmp)
-                   && (EQ (tmp, Qdir_ok)
-                       || NILP (Ffile_directory_p (string)));
+                 if (NILP (tmp))
+                   exists = 0;
+                 else if (EQ (tmp, Qdir_ok)
+                          || NILP (Ffile_directory_p (string)))
+                   exists = 1;
+                 else
+                   {
+                     exists = 0;
+                     last_errno = EISDIR;
+                   }
                }
 
              if (exists)
@@ -1546,21 +1560,36 @@ 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 = (((XFASTINT (predicate) & ~INT_MAX) == 0
-                      && (faccessat (AT_FDCWD, pfn, XFASTINT (predicate),
+               {
+                 fd = -1;
+                 if (INT_MAX < XFASTINT (predicate))
+                   last_errno = EINVAL;
+                 else if (faccessat (AT_FDCWD, pfn, XFASTINT (predicate),
                                      AT_EACCESS)
                           == 0)
-                      && ! file_directory_p (pfn))
-                     ? 1 : -1);
+                   {
+                     if (file_directory_p (pfn))
+                       last_errno = EISDIR;
+                     else
+                       fd = 1;
+                   }
+               }
              else
                {
-                 struct stat st;
                  fd = emacs_open (pfn, O_RDONLY, 0);
-                 if (0 <= fd
-                     && (fstat (fd, &st) != 0 || S_ISDIR (st.st_mode)))
+                 if (fd < 0)
+                   last_errno = errno;
+                 else
                    {
-                     emacs_close (fd);
-                     fd = -1;
+                     struct stat st;
+                     int err = (fstat (fd, &st) != 0 ? errno
+                                : S_ISDIR (st.st_mode) ? EISDIR : 0);
+                     if (err)
+                       {
+                         last_errno = err;
+                         emacs_close (fd);
+                         fd = -1;
+                       }
                    }
                }
 
@@ -1579,6 +1608,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
     }
 
   UNGCPRO;
+  errno = last_errno;
   return -1;
 }
 
@@ -1961,7 +1991,9 @@ STREAM or the value of `standard-input' may be:
   if (EQ (stream, Qt))
     stream = Qread_char;
   if (EQ (stream, Qread_char))
-    return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
+    /* FIXME: ¿¡ When is this used !?  */
+    return call1 (intern ("read-minibuffer"),
+                 build_string ("Lisp expression: "));
 
   return read_internal_start (stream, Qnil, Qnil);
 }
@@ -2344,7 +2376,7 @@ read_integer (Lisp_Object readcharfun, EMACS_INT radix)
          while (c == '0');
        }
 
-      while (-1 <= (digit = digit_to_number (c, radix)))
+      while ((digit = digit_to_number (c, radix)) >= -1)
        {
          if (digit == -1)
            valid = 0;
@@ -2387,7 +2419,6 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
   bool multibyte;
 
   *pch = 0;
-  load_each_byte = 0;
 
  retry:
 
@@ -2597,29 +2628,40 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
          return tmp;
        }
 
-      /* #@NUMBER is used to skip NUMBER following characters.
+      /* #@NUMBER is used to skip NUMBER following bytes.
         That's used in .elc files to skip over doc strings
         and function definitions.  */
       if (c == '@')
        {
          enum { extra = 100 };
-         ptrdiff_t i, nskip = 0;
+         ptrdiff_t i, nskip = 0, digits = 0;
 
-         load_each_byte = 1;
          /* Read a decimal integer.  */
          while ((c = READCHAR) >= 0
                 && c >= '0' && c <= '9')
            {
              if ((STRING_BYTES_BOUND - extra) / 10 <= nskip)
                string_overflow ();
+             digits++;
              nskip *= 10;
              nskip += c - '0';
+             if (digits == 2 && nskip == 0)
+               { /* We've just seen #@00, which means "skip to end".  */
+                 skip_dyn_eof (readcharfun);
+                 return Qnil;
+               }
            }
-         UNREAD (c);
+         if (nskip > 0)
+           /* We can't use UNREAD here, because in the code below we side-step
+               READCHAR.  Instead, assume the first char after #@NNN occupies
+               a single byte, which is the case normally since it's just
+               a space.  */
+           nskip--;
+         else
+           UNREAD (c);
 
          if (load_force_doc_strings
-             && (EQ (readcharfun, Qget_file_char)
-                 || EQ (readcharfun, Qget_emacs_mule_file_char)))
+             && (FROM_FILE_P (readcharfun)))
            {
              /* If we are supposed to force doc strings into core right now,
                 record the last string that we skipped,
@@ -2658,19 +2700,17 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
              saved_doc_string_position = file_tell (instream);
 
              /* Copy that many characters into saved_doc_string.  */
+             block_input ();
              for (i = 0; i < nskip && c >= 0; i++)
-               saved_doc_string[i] = c = READCHAR;
+               saved_doc_string[i] = c = getc (instream);
+             unblock_input ();
 
              saved_doc_string_length = i;
            }
          else
-           {
-             /* Skip that many characters.  */
-             for (i = 0; i < nskip && c >= 0; i++)
-               c = READCHAR;
-           }
+           /* Skip that many bytes.  */
+           skip_dyn_bytes (readcharfun, nskip);
 
-         load_each_byte = 0;
          goto retry;
        }
       if (c == '!')
@@ -3281,12 +3321,12 @@ string_to_number (char const *string, int base, bool ignore_trailing)
   state = 0;
 
   leading_digit = digit_to_number (*cp, base);
-  if (0 <= leading_digit)
+  if (leading_digit >= 0)
     {
       state |= LEAD_INT;
       do
        ++cp;
-      while (0 <= digit_to_number (*cp, base));
+      while (digit_to_number (*cp, base) >= 0);
     }
   if (*cp == '.')
     {
@@ -3363,7 +3403,7 @@ string_to_number (char const *string, int base, bool ignore_trailing)
 
   /* If the number uses integer and not float syntax, and is in C-language
      range, use its value, preferably as a fixnum.  */
-  if (0 <= leading_digit && ! float_syntax)
+  if (leading_digit >= 0 && ! float_syntax)
     {
       uintmax_t n;
 
@@ -3516,7 +3556,7 @@ read_list (bool flag, Lisp_Object readcharfun)
        {
          if (NILP (Vdoc_file_name))
            /* We have not yet called Snarf-documentation, so assume
-              this file is described in the DOC-MM.NN file
+              this file is described in the DOC file
               and Snarf-documentation will fill in the right value later.
               For now, replace the whole list with 0.  */
            doc_reference = 1;
@@ -3557,8 +3597,10 @@ read_list (bool flag, Lisp_Object readcharfun)
                {
                  if (doc_reference == 1)
                    return make_number (0);
-                 if (doc_reference == 2)
+                 if (doc_reference == 2 && INTEGERP (XCDR (val)))
                    {
+                     char *saved = NULL;
+                     file_offset saved_position;
                      /* Get a doc string from the file we are loading.
                         If it's in saved_doc_string, get it from there.
 
@@ -3569,72 +3611,48 @@ read_list (bool flag, Lisp_Object readcharfun)
                         doc string, caller must make it
                         multibyte.  */
 
-                     EMACS_INT pos = XINT (XCDR (val));
                      /* Position is negative for user variables.  */
-                     if (pos < 0) pos = -pos;
+                     EMACS_INT pos = eabs (XINT (XCDR (val)));
                      if (pos >= saved_doc_string_position
                          && pos < (saved_doc_string_position
                                    + saved_doc_string_length))
                        {
-                         ptrdiff_t start = pos - saved_doc_string_position;
-                         ptrdiff_t from, to;
-
-                         /* Process quoting with ^A,
-                            and find the end of the string,
-                            which is marked with ^_ (037).  */
-                         for (from = start, to = start;
-                              saved_doc_string[from] != 037;)
-                           {
-                             int c = saved_doc_string[from++];
-                             if (c == 1)
-                               {
-                                 c = saved_doc_string[from++];
-                                 if (c == 1)
-                                   saved_doc_string[to++] = c;
-                                 else if (c == '0')
-                                   saved_doc_string[to++] = 0;
-                                 else if (c == '_')
-                                   saved_doc_string[to++] = 037;
-                               }
-                             else
-                               saved_doc_string[to++] = c;
-                           }
-
-                         return make_unibyte_string (saved_doc_string + start,
-                                                     to - start);
+                         saved = saved_doc_string;
+                         saved_position = saved_doc_string_position;
                        }
                      /* Look in prev_saved_doc_string the same way.  */
                      else if (pos >= prev_saved_doc_string_position
                               && pos < (prev_saved_doc_string_position
                                         + prev_saved_doc_string_length))
                        {
-                         ptrdiff_t start =
-                           pos - prev_saved_doc_string_position;
+                         saved = prev_saved_doc_string;
+                         saved_position = prev_saved_doc_string_position;
+                       }
+                     if (saved)
+                       {
+                         ptrdiff_t start = pos - saved_position;
                          ptrdiff_t from, to;
 
                          /* Process quoting with ^A,
                             and find the end of the string,
                             which is marked with ^_ (037).  */
                          for (from = start, to = start;
-                              prev_saved_doc_string[from] != 037;)
+                              saved[from] != 037;)
                            {
-                             int c = prev_saved_doc_string[from++];
+                             int c = saved[from++];
                              if (c == 1)
                                {
-                                 c = prev_saved_doc_string[from++];
-                                 if (c == 1)
-                                   prev_saved_doc_string[to++] = c;
-                                 else if (c == '0')
-                                   prev_saved_doc_string[to++] = 0;
-                                 else if (c == '_')
-                                   prev_saved_doc_string[to++] = 037;
+                                 c = saved[from++];
+                                 saved[to++] = (c == 1 ? c
+                                                : c == '0' ? 0
+                                                : c == '_' ? 037
+                                                : c);
                                }
                              else
-                               prev_saved_doc_string[to++] = c;
+                               saved[to++] = c;
                            }
 
-                         return make_unibyte_string (prev_saved_doc_string
-                                                     + start,
+                         return make_unibyte_string (saved + start,
                                                      to - start);
                        }
                      else
@@ -4331,9 +4349,6 @@ init_lread (void)
 
   load_in_progress = 0;
   Vload_file_name = Qnil;
-
-  load_descriptor_list = Qnil;
-
   Vstandard_input = Qt;
   Vloads_in_progress = Qnil;
 }
@@ -4466,15 +4481,15 @@ customize `jka-compr-load-suffixes' rather than the present variable.  */);
   DEFSYM (Qload_in_progress, "load-in-progress");
 
   DEFVAR_LISP ("after-load-alist", Vafter_load_alist,
-              doc: /* An alist of expressions to be evalled when particular files are loaded.
-Each element looks like (REGEXP-OR-FEATURE FORMS...).
+              doc: /* An alist of functions to be evalled when particular files are loaded.
+Each element looks like (REGEXP-OR-FEATURE FUNCS...).
 
 REGEXP-OR-FEATURE is either a regular expression to match file names, or
 a symbol \(a feature name).
 
 When `load' is run and the file-name argument matches an element's
 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
-REGEXP-OR-FEATURE, the FORMS in the element are executed.
+REGEXP-OR-FEATURE, the FUNCS in the element are called.
 
 An error in FORMS does not undo the load, but does prevent execution of
 the rest of the FORMS.  */);
@@ -4525,12 +4540,16 @@ The default is nil, which means use the function `read'.  */);
   Vload_read_function = Qnil;
 
   DEFVAR_LISP ("load-source-file-function", Vload_source_file_function,
-              doc: /* Function called in `load' for loading an Emacs Lisp source file.
-This function is for doing code conversion before reading the source file.
-If nil, loading is done without any code conversion.
-Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
- FULLNAME is the full name of FILE.
-See `load' for the meaning of the remaining arguments.  */);
+              doc: /* Function called in `load' to load an Emacs Lisp source file.
+The value should be a function for doing code conversion before
+reading a source file.  It can also be nil, in which case loading is
+done without any code conversion.
+
+If the value is a function, it is called with four arguments,
+FULLNAME, FILE, NOERROR, NOMESSAGE.  FULLNAME is the absolute name of
+the file to load, FILE is the non-absolute name (for messages etc.),
+and NOERROR and NOMESSAGE are the corresponding arguments passed to
+`load'.  The function should return t if the file was loaded.  */);
   Vload_source_file_function = Qnil;
 
   DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings,
@@ -4602,9 +4621,6 @@ variables, this must be set in the first line of a file.  */);
 
   /* Vsource_directory was initialized in init_lread.  */
 
-  load_descriptor_list = Qnil;
-  staticpro (&load_descriptor_list);
-
   DEFSYM (Qcurrent_load_list, "current-load-list");
   DEFSYM (Qstandard_input, "standard-input");
   DEFSYM (Qread_char, "read-char");