]> code.delx.au - gnu-emacs/blobdiff - src/lread.c
Merge from emacs-24; up to 2012-12-06T01:39:03Z!monnier@iro.umontreal.ca
[gnu-emacs] / src / lread.c
index dbbde694cf6936fd644b4ba9ef6b3d81418966a0..2b96dc16359e5ac14ee0f1f3db11251a81982320 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.
 
@@ -440,7 +441,6 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
   block_input ();
   c = getc (instream);
 
-#ifdef EINTR
   /* Interrupted reads have been observed while reading over the network.  */
   while (c == EOF && ferror (instream) && errno == EINTR)
     {
@@ -450,7 +450,6 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
       clearerr (instream);
       c = getc (instream);
     }
-#endif
 
   unblock_input ();
 
@@ -996,18 +995,17 @@ If optional fifth arg MUST-SUFFIX is non-nil, insist on
 the suffix `.elc' or `.el'; don't accept just FILE unless
 it ends in one of those suffixes or includes a directory name.
 
-If this function fails to find a file, it may look for different
-representations of that file before trying another file.
-It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
-to the file name.  Emacs uses this feature mainly to find compressed
-versions of files when Auto Compression mode is enabled.
+If NOSUFFIX is nil, then if a file could not be found, try looking for
+a different representation of the file by adding non-empty suffixes to
+its name, before trying another file.  Emacs uses this feature to find
+compressed versions of files when Auto Compression mode is enabled.
+If NOSUFFIX is non-nil, disable this feature.
 
-The exact suffixes that this function tries out, in the exact order,
-are given by the value of the variable `load-file-rep-suffixes' if
-NOSUFFIX is non-nil and by the return value of the function
-`get-load-suffixes' if MUST-SUFFIX is non-nil.  If both NOSUFFIX and
-MUST-SUFFIX are nil, this function first tries out the latter suffixes
-and then the former.
+The suffixes that this function tries out, when NOSUFFIX is nil, are
+given by the return value of `get-load-suffixes' and the values listed
+in `load-file-rep-suffixes'.  If MUST-SUFFIX is non-nil, only the
+return value of `get-load-suffixes' is used, i.e. the file name is
+required to have a non-empty suffix.
 
 Loading a file records its definitions, and its `provide' and
 `require' calls, in an element of `load-history' whose
@@ -1404,7 +1402,7 @@ Returns the file's name in absolute form, or nil if not found.
 If SUFFIXES is non-nil, it should be a list of suffixes to append to
 file name when searching.
 If non-nil, PREDICATE is used instead of `file-readable-p'.
-PREDICATE can also be an integer to pass to the access(2) function,
+PREDICATE can also be an integer to pass to the faccessat(2) function,
 in which case file-name-handlers are ignored.
 This function will normally skip directories, so if you want it to find
 directories, make sure the PREDICATE function returns `dir-ok' for them.  */)
@@ -1442,14 +1440,12 @@ static Lisp_Object Qdir_ok;
 int
 openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *storeptr, Lisp_Object predicate)
 {
-  int fd;
   ptrdiff_t fn_size = 100;
   char buf[100];
   char *fn = buf;
   bool absolute = 0;
   ptrdiff_t want_length;
   Lisp_Object filename;
-  struct stat st;
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
   Lisp_Object string, tail, encoded_fn;
   ptrdiff_t max_suffix_len = 0;
@@ -1498,7 +1494,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
        {
          ptrdiff_t fnlen, lsuffix = SBYTES (XCAR (tail));
          Lisp_Object handler;
-         bool exists;
 
          /* Concatenate path element/specified name with the suffix.
             If the directory starts with /:, remove that.  */
@@ -1522,6 +1517,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
          handler = Ffind_file_name_handler (string, Qfile_exists_p);
          if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
             {
+             bool exists;
              if (NILP (predicate))
                exists = !NILP (Ffile_readable_p (string));
              else
@@ -1543,30 +1539,40 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
            }
          else
            {
+             int fd;
              const char *pfn;
 
              encoded_fn = ENCODE_FILE (string);
              pfn = SSDATA (encoded_fn);
-             exists = (stat (pfn, &st) == 0 && ! S_ISDIR (st.st_mode));
-             if (exists)
-               {
-                 /* Check that we can access or open it.  */
-                 if (NATNUMP (predicate))
-                   fd = (((XFASTINT (predicate) & ~INT_MAX) == 0
-                          && access (pfn, XFASTINT (predicate)) == 0)
-                         ? 1 : -1);
-                 else
-                   fd = emacs_open (pfn, O_RDONLY, 0);
 
-                 if (fd >= 0)
+             /* Check that we can access or open it.  */
+             if (NATNUMP (predicate))
+               fd = (((XFASTINT (predicate) & ~INT_MAX) == 0
+                      && (faccessat (AT_FDCWD, pfn, XFASTINT (predicate),
+                                     AT_EACCESS)
+                          == 0)
+                      && ! file_directory_p (pfn))
+                     ? 1 : -1);
+             else
+               {
+                 struct stat st;
+                 fd = emacs_open (pfn, O_RDONLY, 0);
+                 if (0 <= fd
+                     && (fstat (fd, &st) != 0 || S_ISDIR (st.st_mode)))
                    {
-                     /* We succeeded; return this descriptor and filename.  */
-                     if (storeptr)
-                       *storeptr = string;
-                     UNGCPRO;
-                     return fd;
+                     emacs_close (fd);
+                     fd = -1;
                    }
                }
+
+             if (fd >= 0)
+               {
+                 /* We succeeded; return this descriptor and filename.  */
+                 if (storeptr)
+                   *storeptr = string;
+                 UNGCPRO;
+                 return fd;
+               }
            }
        }
       if (absolute)
@@ -3564,9 +3570,8 @@ 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))
@@ -3950,12 +3955,13 @@ init_obarray (void)
   /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
      so those two need to be fixed manually.  */
   SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound);
-  set_symbol_function (Qunbound, Qunbound);
+  set_symbol_function (Qunbound, Qnil);
   set_symbol_plist (Qunbound, Qnil);
   SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
   XSYMBOL (Qnil)->constant = 1;
   XSYMBOL (Qnil)->declared_special = 1;
   set_symbol_plist (Qnil, Qnil);
+  set_symbol_function (Qnil, Qnil);
 
   Qt = intern_c_string ("t");
   SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
@@ -3976,7 +3982,7 @@ defsubr (struct Lisp_Subr *sname)
 {
   Lisp_Object sym, tem;
   sym = intern_c_string (sname->symbol_name);
-  XSETTYPED_PVECTYPE (sname, size, PVEC_SUBR);
+  XSETPVECTYPE (sname, PVEC_SUBR);
   XSETSUBR (tem, sname);
   set_symbol_function (sym, tem);
 }
@@ -4082,9 +4088,8 @@ load_path_check (void)
       if (STRINGP (dirfile))
         {
           dirfile = Fdirectory_file_name (dirfile);
-          if (access (SSDATA (dirfile), 0) < 0)
-            dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
-                         XCAR (path_tail));
+          if (! file_accessible_directory_p (SSDATA (dirfile)))
+            dir_warning ("Lisp directory", XCAR (path_tail));
         }
     }
 }
@@ -4196,11 +4201,11 @@ init_lread (void)
              Lisp_Object tem, tem1;
 
               /* Add to the path the lisp subdir of the installation
-                 dir, if it exists.  Note: in out-of-tree builds,
+                 dir, if it is accessible.  Note: in out-of-tree builds,
                  this directory is empty save for Makefile.  */
               tem = Fexpand_file_name (build_string ("lisp"),
                                        Vinstallation_directory);
-              tem1 = Ffile_exists_p (tem);
+              tem1 = Ffile_accessible_directory_p (tem);
               if (!NILP (tem1))
                 {
                   if (NILP (Fmember (tem, Vload_path)))
@@ -4217,10 +4222,10 @@ init_lread (void)
                    Lisp dirs instead.  */
                 Vload_path = nconc2 (Vload_path, dump_path);
 
-              /* Add leim under the installation dir, if it exists. */
+              /* Add leim under the installation dir, if it is accessible. */
               tem = Fexpand_file_name (build_string ("leim"),
                                        Vinstallation_directory);
-              tem1 = Ffile_exists_p (tem);
+              tem1 = Ffile_accessible_directory_p (tem);
               if (!NILP (tem1))
                 {
                   if (NILP (Fmember (tem, Vload_path)))
@@ -4232,7 +4237,7 @@ init_lread (void)
                 {
                   tem = Fexpand_file_name (build_string ("site-lisp"),
                                            Vinstallation_directory);
-                  tem1 = Ffile_exists_p (tem);
+                  tem1 = Ffile_accessible_directory_p (tem);
                   if (!NILP (tem1))
                     {
                       if (NILP (Fmember (tem, Vload_path)))
@@ -4277,7 +4282,7 @@ init_lread (void)
                         {
                           tem = Fexpand_file_name (build_string ("site-lisp"),
                                                    Vsource_directory);
-                          tem1 = Ffile_exists_p (tem);
+                          tem1 = Ffile_accessible_directory_p (tem);
                           if (!NILP (tem1))
                             {
                               if (NILP (Fmember (tem, Vload_path)))
@@ -4333,21 +4338,28 @@ init_lread (void)
   Vloads_in_progress = Qnil;
 }
 
-/* Print a warning, using format string FORMAT, that directory DIRNAME
-   does not exist.  Print it on stderr and put it in *Messages*.  */
+/* Print a warning that directory intended for use USE and with name
+   DIRNAME cannot be accessed.  On entry, errno should correspond to
+   the access failure.  Print the warning on stderr and put it in
+   *Messages*.  */
 
 void
-dir_warning (const char *format, Lisp_Object dirname)
+dir_warning (char const *use, Lisp_Object dirname)
 {
-  fprintf (stderr, format, SDATA (dirname));
+  static char const format[] = "Warning: %s `%s': %s\n";
+  int access_errno = errno;
+  fprintf (stderr, format, use, SSDATA (dirname), strerror (access_errno));
 
   /* Don't log the warning before we've initialized!!  */
   if (initialized)
     {
+      char const *diagnostic = emacs_strerror (access_errno);
       USE_SAFE_ALLOCA;
-      char *buffer = SAFE_ALLOCA (SBYTES (dirname)
-                                 + strlen (format) - (sizeof "%s" - 1) + 1);
-      ptrdiff_t message_len = esprintf (buffer, format, SDATA (dirname));
+      char *buffer = SAFE_ALLOCA (sizeof format - 3 * (sizeof "%s" - 1)
+                                 + strlen (use) + SBYTES (dirname)
+                                 + strlen (diagnostic));
+      ptrdiff_t message_len = esprintf (buffer, format, use, SSDATA (dirname),
+                                       diagnostic);
       message_dolog (buffer, message_len, 0, STRING_MULTIBYTE (dirname));
       SAFE_FREE ();
     }
@@ -4513,12 +4525,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,