]> code.delx.au - gnu-emacs/blobdiff - src/lread.c
Omit ‘const’ on locals
[gnu-emacs] / src / lread.c
index ae175296ddbdbd61018428c0b4e81901c8556c3f..f7ce0daf1fa9f1b253ff79480a84dfd7204c3876 100644 (file)
@@ -31,6 +31,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <math.h>
 #include <stat-time.h>
 #include "lisp.h"
+#include "dispextern.h"
 #include "intervals.h"
 #include "character.h"
 #include "buffer.h"
@@ -39,7 +40,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <epaths.h>
 #include "commands.h"
 #include "keyboard.h"
-#include "frame.h"
+#include "systime.h"
 #include "termhooks.h"
 #include "blockinput.h"
 
@@ -974,6 +975,16 @@ This uses the variables `load-suffixes' and `load-file-rep-suffixes'.  */)
   return Fnreverse (lst);
 }
 
+/* Returns true if STRING ends with SUFFIX */
+static bool
+suffix_p (Lisp_Object string, const char *suffix)
+{
+  size_t suffix_len = strlen (suffix);
+  size_t string_len = SBYTES (string);
+
+  return string_len >= suffix_len && !strcmp (SSDATA (string) + string_len - suffix_len, suffix);
+}
+
 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',
@@ -1025,7 +1036,6 @@ Return t if the file exists and loads successfully.  */)
   int fd;
   int fd_index;
   ptrdiff_t count = SPECPDL_INDEX ();
-  struct gcpro gcpro1, gcpro2, gcpro3;
   Lisp_Object found, efound, hist_file_name;
   /* True means we printed the ".el is newer" message.  */
   bool newer = 0;
@@ -1044,10 +1054,7 @@ Return t if the file exists and loads successfully.  */)
     if (!NILP (handler))
       return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
 
-  /* Do this after the handler to avoid
-     the need to gcpro noerror, nomessage and nosuffix.
-     (Below here, we care only whether they are nil or not.)
-     The presence of this call is the result of a historical accident:
+  /* The presence of this call is the result of a historical accident:
      it used to be in every file-operation and when it got removed
      everywhere, it accidentally stayed here.  Since then, enough people
      supposedly have things like (load "$PROJECT/foo.el") in their .emacs
@@ -1073,17 +1080,11 @@ Return t if the file exists and loads successfully.  */)
     {
       Lisp_Object suffixes;
       found = Qnil;
-      GCPRO2 (file, found);
 
       if (! NILP (must_suffix))
        {
          /* Don't insist on adding a suffix if FILE already ends with one.  */
-         ptrdiff_t size = SBYTES (file);
-         if (size > 3
-             && !strcmp (SSDATA (file) + size - 3, ".el"))
-           must_suffix = Qnil;
-         else if (size > 4
-                  && !strcmp (SSDATA (file) + size - 4, ".elc"))
+         if (suffix_p (file, ".el") || suffix_p (file, ".elc"))
            must_suffix = Qnil;
          /* Don't insist on adding a suffix
             if the argument includes a directory name.  */
@@ -1101,7 +1102,6 @@ Return t if the file exists and loads successfully.  */)
        }
 
       fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer);
-      UNGCPRO;
     }
 
   if (fd == -1)
@@ -1156,6 +1156,13 @@ Return t if the file exists and loads successfully.  */)
       record_unwind_protect_int (close_file_unwind, fd);
     }
 
+#ifdef HAVE_MODULES
+  if (suffix_p (found, MODULES_SUFFIX))
+    {
+      return Fmodule_load (found);
+    }
+#endif
+
   /* Check if we're stuck in a recursive load cycle.
 
      2000-09-21: It's not possible to just check for the file loaded
@@ -1194,8 +1201,7 @@ Return t if the file exists and loads successfully.  */)
   specbind (Qold_style_backquotes, Qnil);
   record_unwind_protect (load_warn_old_style_backquotes, file);
 
-  if (!memcmp (SDATA (found) + SBYTES (found) - 4, ".elc", 4)
-      || (fd >= 0 && (version = safe_to_load_version (fd)) > 0))
+  if (suffix_p (found, ".elc") || (fd >= 0 && (version = safe_to_load_version (fd)) > 0))
     /* Load .elc files directly, but not when they are
        remote and have no handler!  */
     {
@@ -1204,8 +1210,6 @@ Return t if the file exists and loads successfully.  */)
          struct stat s1, s2;
          int result;
 
-         GCPRO3 (file, found, hist_file_name);
-
          if (version < 0
              && ! (version = safe_to_load_version (fd)))
            {
@@ -1250,7 +1254,6 @@ Return t if the file exists and loads successfully.  */)
                     }
                 }
             } /* !load_prefer_newer */
-         UNGCPRO;
        }
     }
   else
@@ -1272,8 +1275,6 @@ Return t if the file exists and loads successfully.  */)
        }
     }
 
-  GCPRO3 (file, found, hist_file_name);
-
   if (fd < 0)
     {
       /* We somehow got here with fd == -2, meaning the file is deemed
@@ -1339,8 +1340,6 @@ Return t if the file exists and loads successfully.  */)
   if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
     call1 (Qdo_after_load_evaluation, hist_file_name) ;
 
-  UNGCPRO;
-
   xfree (saved_doc_string);
   saved_doc_string = 0;
   saved_doc_string_size = 0;
@@ -1402,7 +1401,8 @@ directories, make sure the PREDICATE function returns `dir-ok' for them.  */)
    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,
+   PREDICATE t means the files are binary.
+   PREDICATE non-nil and non-t means don't open the files,
    just look for one that satisfies the predicate.  In this case,
    return 1 on success.  The predicate can be a lisp function or
    an integer to pass to `access' (in which case file-name-handlers
@@ -1417,7 +1417,7 @@ directories, make sure the PREDICATE function returns `dir-ok' for them.  */)
 
    If NEWER is true, try all SUFFIXes and return the result for the
    newest file that exists.  Does not apply to remote files,
-   or if PREDICATE is specified.  */
+   or if a non-nil and non-t PREDICATE is specified.  */
 
 int
 openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
@@ -1429,7 +1429,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
   bool absolute;
   ptrdiff_t want_length;
   Lisp_Object filename;
-  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6, gcpro7;
   Lisp_Object string, tail, encoded_fn, save_string;
   ptrdiff_t max_suffix_len = 0;
   int last_errno = ENOENT;
@@ -1450,7 +1449,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
     }
 
   string = filename = encoded_fn = save_string = Qnil;
-  GCPRO7 (str, string, save_string, filename, path, suffixes, encoded_fn);
 
   if (storeptr)
     *storeptr = Qnil;
@@ -1519,10 +1517,11 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
          else
            string = make_string (fn, fnlen);
          handler = Ffind_file_name_handler (string, Qfile_exists_p);
-         if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
+         if ((!NILP (handler) || (!NILP (predicate) && !EQ (predicate, Qt)))
+             && !NATNUMP (predicate))
             {
              bool exists;
-             if (NILP (predicate))
+             if (NILP (predicate) || EQ (predicate, Qt))
                exists = !NILP (Ffile_readable_p (string));
              else
                {
@@ -1545,7 +1544,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
                   if (storeptr)
                     *storeptr = string;
                  SAFE_FREE ();
-                  UNGCPRO;
                   return -2;
                }
            }
@@ -1576,7 +1574,8 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
                }
              else
                {
-                 fd = emacs_open (pfn, O_RDONLY, 0);
+                 int oflags = O_RDONLY + (NILP (predicate) ? 0 : O_BINARY);
+                 fd = emacs_open (pfn, oflags, 0);
                  if (fd < 0)
                    {
                      if (errno != ENOENT)
@@ -1618,7 +1617,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
                       if (storeptr)
                         *storeptr = string;
                      SAFE_FREE ();
-                      UNGCPRO;
                       return fd;
                     }
                }
@@ -1629,7 +1627,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
                   if (storeptr)
                     *storeptr = save_string;
                  SAFE_FREE ();
-                  UNGCPRO;
                   return save_fd;
                 }
            }
@@ -1639,7 +1636,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
     }
 
   SAFE_FREE ();
-  UNGCPRO;
   errno = last_errno;
   return -1;
 }
@@ -1743,14 +1739,11 @@ readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand)
   val = call2 (macroexpand, val, Qnil);
   if (EQ (CAR_SAFE (val), Qprogn))
     {
-      struct gcpro gcpro1;
       Lisp_Object subforms = XCDR (val);
 
-      GCPRO1 (subforms);
       for (val = Qnil; CONSP (subforms); subforms = XCDR (subforms))
           val = readevalloop_eager_expand_eval (XCAR (subforms),
                                                 macroexpand);
-      UNGCPRO;
     }
   else
       val = eval_sub (call2 (macroexpand, val, Qt));
@@ -1772,10 +1765,9 @@ readevalloop (Lisp_Object readcharfun,
              Lisp_Object unibyte, Lisp_Object readfun,
              Lisp_Object start, Lisp_Object end)
 {
-  register int c;
-  register Lisp_Object val;
+  int c;
+  Lisp_Object val;
   ptrdiff_t count = SPECPDL_INDEX ();
-  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
   struct buffer *b = 0;
   bool continue_reading_p;
   Lisp_Object lex_bound;
@@ -1810,7 +1802,7 @@ readevalloop (Lisp_Object readcharfun,
   if (! NILP (start) && !b)
     emacs_abort ();
 
-  specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun.  */
+  specbind (Qstandard_input, readcharfun);
   specbind (Qcurrent_load_list, Qnil);
   record_unwind_protect_int (readevalloop_1, load_convert_to_unibyte);
   load_convert_to_unibyte = !NILP (unibyte);
@@ -1823,8 +1815,6 @@ readevalloop (Lisp_Object readcharfun,
            (NILP (lex_bound) || EQ (lex_bound, Qunbound)
             ? Qnil : list1 (Qt)));
 
-  GCPRO4 (sourcename, readfun, start, end);
-
   /* Try to ensure sourcename is a truename, except whilst preloading.  */
   if (NILP (Vpurify_flag)
       && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
@@ -1885,7 +1875,7 @@ readevalloop (Lisp_Object readcharfun,
 
       /* Ignore whitespace here, so we can detect eof.  */
       if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r'
-         || c == 0xa0)  /* NBSP */
+         || c == NO_BREAK_SPACE)
        goto read_next;
 
       if (!NILP (Vpurify_flag) && c == '(')
@@ -1943,8 +1933,6 @@ readevalloop (Lisp_Object readcharfun,
   build_load_history (sourcename,
                      stream || whole_buffer);
 
-  UNGCPRO;
-
   unbind_to (count, Qnil);
 }
 
@@ -2143,6 +2131,15 @@ read0 (Lisp_Object readcharfun)
 static ptrdiff_t read_buffer_size;
 static char *read_buffer;
 
+/* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes.  */
+
+static void
+grow_read_buffer (void)
+{
+  read_buffer = xpalloc (read_buffer, &read_buffer_size,
+                        MAX_MULTIBYTE_LENGTH, -1, 1);
+}
+
 /* Read a \-escape sequence, assuming we already read the `\'.
    If the escape sequence forces unibyte, return eight-bit char.  */
 
@@ -2661,14 +2658,12 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
       if (c == '(')
        {
          Lisp_Object tmp;
-         struct gcpro gcpro1;
          int ch;
 
          /* Read the string itself.  */
          tmp = read1 (readcharfun, &ch, 0);
          if (ch != 0 || !STRINGP (tmp))
            invalid_syntax ("#");
-         GCPRO1 (tmp);
          /* Read the intervals and their properties.  */
          while (1)
            {
@@ -2686,7 +2681,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
                invalid_syntax ("Invalid string property list");
              Fset_text_properties (beg, end, plist, tmp);
            }
-         UNGCPRO;
+
          return tmp;
        }
 
@@ -2793,7 +2788,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
          uninterned_symbol = 1;
          c = READCHAR;
          if (!(c > 040
-               && c != 0xa0    /* NBSP */
+               && c != NO_BREAK_SPACE
                && (c >= 0200
                    || strchr ("\"';()[]#`,", c) == NULL)))
            {
@@ -3010,10 +3005,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
            if (end - p < MAX_MULTIBYTE_LENGTH)
              {
                ptrdiff_t offset = p - read_buffer;
-               if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
-                 memory_full (SIZE_MAX);
-               read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
-               read_buffer_size *= 2;
+               grow_read_buffer ();
                p = read_buffer + offset;
                end = read_buffer + read_buffer_size;
              }
@@ -3024,7 +3016,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
 
                ch = read_escape (readcharfun, 1);
 
-               /* CH is -1 if \ newline has just been seen.  */
+               /* CH is -1 if \ newline or \ space has just been seen.  */
                if (ch == -1)
                  {
                    if (p == read_buffer)
@@ -3127,7 +3119,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
     default:
     default_label:
       if (c <= 040) goto retry;
-      if (c == 0xa0) /* NBSP */
+      if (c == NO_BREAK_SPACE)
        goto retry;
 
     read_symbol:
@@ -3144,10 +3136,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
              if (end - p < MAX_MULTIBYTE_LENGTH)
                {
                  ptrdiff_t offset = p - read_buffer;
-                 if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
-                   memory_full (SIZE_MAX);
-                 read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
-                 read_buffer_size *= 2;
+                 grow_read_buffer ();
                  p = read_buffer + offset;
                  end = read_buffer + read_buffer_size;
                }
@@ -3167,17 +3156,14 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
              c = READCHAR;
            }
          while (c > 040
-                && c != 0xa0 /* NBSP */
+                && c != NO_BREAK_SPACE
                 && (c >= 0200
                     || strchr ("\"';()[]#`,", c) == NULL));
 
          if (p == end)
            {
              ptrdiff_t offset = p - read_buffer;
-             if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
-               memory_full (SIZE_MAX);
-             read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
-             read_buffer_size *= 2;
+             grow_read_buffer ();
              p = read_buffer + offset;
              end = read_buffer + read_buffer_size;
            }
@@ -3280,7 +3266,7 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
     {
     case Lisp_Vectorlike:
       {
-       ptrdiff_t i, length = 0;
+       ptrdiff_t i = 0, length = 0;
        if (BOOL_VECTOR_P (subtree))
          return subtree;               /* No sub-objects anyway.  */
        else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
@@ -3295,7 +3281,9 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
             behavior.  */
          wrong_type_argument (Qsequencep, subtree);
 
-       for (i = 0; i < length; i++)
+       if (SUB_CHAR_TABLE_P (subtree))
+         i = 2;
+       for ( ; i < length; i++)
          SUBSTITUTE (AREF (subtree, i),
                      ASET (subtree, i, true_value));
        return subtree;
@@ -3566,7 +3554,6 @@ read_list (bool flag, Lisp_Object readcharfun)
 {
   Lisp_Object val, tail;
   Lisp_Object elt, tem;
-  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.  */
@@ -3581,9 +3568,7 @@ read_list (bool flag, Lisp_Object readcharfun)
   while (1)
     {
       int ch;
-      GCPRO2 (val, tail);
       elt = read1 (readcharfun, &ch, first_in_list);
-      UNGCPRO;
 
       first_in_list = 0;
 
@@ -3626,13 +3611,12 @@ read_list (bool flag, Lisp_Object readcharfun)
            return val;
          if (ch == '.')
            {
-             GCPRO2 (val, tail);
              if (!NILP (tail))
                XSETCDR (tail, read0 (readcharfun));
              else
                val = read0 (readcharfun);
              read1 (readcharfun, &ch, 0);
-             UNGCPRO;
+
              if (ch == ')')
                {
                  if (doc_reference == 1)
@@ -3776,8 +3760,11 @@ intern_1 (const char *str, ptrdiff_t len)
   Lisp_Object obarray = check_obarray (Vobarray);
   Lisp_Object tem = oblookup (obarray, str, len, len);
 
-  return SYMBOLP (tem) ? tem : intern_driver (make_string (str, len),
-                                             obarray, tem);
+  return (SYMBOLP (tem) ? tem
+         /* The above `oblookup' was done on the basis of nchars==nbytes, so
+            the string has to be unibyte.  */
+         : intern_driver (make_unibyte_string (str, len),
+                          obarray, tem));
 }
 
 Lisp_Object
@@ -4413,9 +4400,10 @@ init_lread (void)
 void
 dir_warning (char const *use, Lisp_Object dirname)
 {
-  static char const format[] = "Warning: %s `%s': %s\n";
+  static char const format[] = "Warning: %s '%s': %s\n";
   int access_errno = errno;
-  fprintf (stderr, format, use, SSDATA (dirname), strerror (access_errno));
+  fprintf (stderr, format, use, SSDATA (ENCODE_SYSTEM (dirname)),
+          strerror (access_errno));
 
   /* Don't log the warning before we've initialized!!  */
   if (initialized)
@@ -4502,16 +4490,26 @@ were read in.  */);
 
   DEFVAR_LISP ("load-path", Vload_path,
               doc: /* List of directories to search for files to load.
-Each element is a string (directory name) or nil (meaning `default-directory').
-Initialized during startup as described in Info node `(elisp)Library Search'.  */);
+Each element is a string (directory file name) or nil (meaning
+`default-directory').
+Initialized during startup as described in Info node `(elisp)Library Search'.
+Use `directory-file-name' when adding items to this path.  However, Lisp
+programs that process this list should tolerate directories both with
+and without trailing slashes.  */);
 
   DEFVAR_LISP ("load-suffixes", Vload_suffixes,
               doc: /* List of suffixes for (compiled or source) Emacs Lisp files.
 This list should not include the empty string.
 `load' and related functions try to append these suffixes, in order,
 to the specified file name if a Lisp suffix is allowed or required.  */);
+#ifdef HAVE_MODULES
+  Vload_suffixes = list3 (build_pure_c_string (".elc"),
+                         build_pure_c_string (".el"),
+                         build_pure_c_string (MODULES_SUFFIX));
+#else
   Vload_suffixes = list2 (build_pure_c_string (".elc"),
                          build_pure_c_string (".el"));
+#endif
   DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
               doc: /* List of suffixes that indicate representations of \
 the same file.
@@ -4536,7 +4534,7 @@ customize `jka-compr-load-suffixes' rather than the present variable.  */);
 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).
+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
@@ -4587,8 +4585,10 @@ of the file, regardless of whether or not it has the `.elc' extension.  */);
 
   DEFVAR_LISP ("load-read-function", Vload_read_function,
               doc: /* Function used by `load' and `eval-region' for reading expressions.
-The default is nil, which means use the function `read'.  */);
-  Vload_read_function = Qnil;
+Called with a single argument (the stream from which to read).
+The default is to use the function `read'.  */);
+  DEFSYM (Qread, "read");
+  Vload_read_function = Qread;
 
   DEFVAR_LISP ("load-source-file-function", Vload_source_file_function,
               doc: /* Function called in `load' to load an Emacs Lisp source file.