* progmodes/compile.el (compilation-mode-hook)

[bpt/emacs.git] / src / dired.c

diff --git a/src/dired.c b/src/dired.c
index 3530b74..ed0571f 100644 (file)
--- a/src/dired.c
+++ b/src/dired.c
@@ -1,5 +1,6 @@
 /* Lisp functions for making directory listings.
 /* Lisp functions for making directory listings.

-   Copyright (C) 1985-1986, 1993-1994, 1999-2012 Free Software Foundation, Inc.
+   Copyright (C) 1985-1986, 1993-1994, 1999-2013 Free Software
+   Foundation, Inc.

 
 This file is part of GNU Emacs.
 
 
 This file is part of GNU Emacs.
 


@@ -29,6 +30,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <grp.h>
 
 #include <errno.h>
 #include <grp.h>
 
 #include <errno.h>

+#include <fcntl.h>

 #include <unistd.h>
 
 #include <dirent.h>
 #include <unistd.h>
 
 #include <dirent.h>


@@ -53,6 +55,7 @@ static Lisp_Object Qfile_attributes;
 static Lisp_Object Qfile_attributes_lessp;
 
 static ptrdiff_t scmp (const char *, const char *, ptrdiff_t);
 static Lisp_Object Qfile_attributes_lessp;
 
 static ptrdiff_t scmp (const char *, const char *, ptrdiff_t);

+static Lisp_Object file_attributes (int, char const *, Lisp_Object);

 \f
 /* Return the number of bytes in DP's name.  */
 static ptrdiff_t
 \f
 /* Return the number of bytes in DP's name.  */
 static ptrdiff_t


@@ -65,6 +68,44 @@ dirent_namelen (struct dirent *dp)
 #endif
 }
 
 #endif
 }
 

+static DIR *
+open_directory (char const *name, int *fdp)
+{
+  DIR *d;
+  int fd, opendir_errno;
+
+  block_input ();
+
+#ifdef DOS_NT
+  /* Directories cannot be opened.  The emulation assumes that any
+     file descriptor other than AT_FDCWD corresponds to the most
+     recently opened directory.  This hack is good enough for Emacs.  */
+  fd = 0;
+  d = opendir (name);
+  opendir_errno = errno;
+#else
+  fd = emacs_open (name, O_RDONLY | O_DIRECTORY, 0);
+  if (fd < 0)
+    {
+      opendir_errno = errno;
+      d = 0;
+    }
+  else
+    {
+      d = fdopendir (fd);
+      opendir_errno = errno;
+      if (! d)
+       close (fd);
+    }
+#endif
+
+  unblock_input ();
+
+  *fdp = fd;
+  errno = opendir_errno;
+  return d;
+}
+

 #ifdef WINDOWSNT
 Lisp_Object
 directory_files_internal_w32_unwind (Lisp_Object arg)
 #ifdef WINDOWSNT
 Lisp_Object
 directory_files_internal_w32_unwind (Lisp_Object arg)


@@ -77,7 +118,7 @@ directory_files_internal_w32_unwind (Lisp_Object arg)
 static Lisp_Object
 directory_files_internal_unwind (Lisp_Object dh)
 {
 static Lisp_Object
 directory_files_internal_unwind (Lisp_Object dh)
 {

-  DIR *d = (DIR *) XSAVE_VALUE (dh)->pointer;
+  DIR *d = XSAVE_POINTER (dh, 0);

   block_input ();
   closedir (d);
   unblock_input ();
   block_input ();
   closedir (d);
   unblock_input ();


@@ -95,6 +136,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
                          Lisp_Object id_format)
 {
   DIR *d;
                          Lisp_Object id_format)
 {
   DIR *d;

+  int fd;

   ptrdiff_t directory_nbytes;
   Lisp_Object list, dirfilename, encoded_directory;
   struct re_pattern_buffer *bufp = NULL;
   ptrdiff_t directory_nbytes;
   Lisp_Object list, dirfilename, encoded_directory;
   struct re_pattern_buffer *bufp = NULL;


@@ -141,9 +183,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
   /* Now *bufp is the compiled form of MATCH; don't call anything
      which might compile a new regexp until we're done with the loop!  */
 
   /* Now *bufp is the compiled form of MATCH; don't call anything
      which might compile a new regexp until we're done with the loop!  */
 

-  block_input ();
-  d = opendir (SSDATA (dirfilename));
-  unblock_input ();
+  d = open_directory (SSDATA (dirfilename), &fd);

   if (d == NULL)
     report_file_error ("Opening directory", Fcons (directory, Qnil));
 
   if (d == NULL)
     report_file_error ("Opening directory", Fcons (directory, Qnil));
 


@@ -151,7 +191,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
      file-attributes on filenames, both of which can throw, so we must
      do a proper unwind-protect.  */
   record_unwind_protect (directory_files_internal_unwind,
      file-attributes on filenames, both of which can throw, so we must
      do a proper unwind-protect.  */
   record_unwind_protect (directory_files_internal_unwind,

-                        make_save_value (d, 0));
+                        make_save_pointer (d));

 
 #ifdef WINDOWSNT
   if (attrs)
 
 #ifdef WINDOWSNT
   if (attrs)


@@ -193,19 +233,15 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
 
       errno = 0;
       dp = readdir (d);
 
       errno = 0;
       dp = readdir (d);

-
-      if (dp == NULL && (0
-#ifdef EAGAIN
-                        || errno == EAGAIN
-#endif
-#ifdef EINTR
-                        || errno == EINTR
-#endif
-                        ))
-       { QUIT; continue; }
-
-      if (dp == NULL)
-       break;
+      if (!dp)
+       {
+         if (errno == EAGAIN || errno == EINTR)
+           {
+             QUIT;
+             continue;
+           }
+         break;
+       }

 
       len = dirent_namelen (dp);
       name = finalname = make_unibyte_string (dp->d_name, len);
 
       len = dirent_namelen (dp);
       name = finalname = make_unibyte_string (dp->d_name, len);


@@ -262,20 +298,9 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
 
          if (attrs)
            {
 
          if (attrs)
            {

-             /* Construct an expanded filename for the directory entry.
-                Use the decoded names for input to Ffile_attributes.  */
-             Lisp_Object decoded_fullname, fileattrs;
-             struct gcpro gcpro1, gcpro2;
-
-             decoded_fullname = fileattrs = Qnil;
-             GCPRO2 (decoded_fullname, fileattrs);
-
-             /* Both Fexpand_file_name and Ffile_attributes can GC.  */
-             decoded_fullname = Fexpand_file_name (name, directory);
-             fileattrs = Ffile_attributes (decoded_fullname, id_format);
-
+             Lisp_Object fileattrs
+               = file_attributes (fd, dp->d_name, id_format);

              list = Fcons (Fcons (finalname, fileattrs), list);
              list = Fcons (Fcons (finalname, fileattrs), list);

-             UNGCPRO;

            }
          else
            list = Fcons (finalname, list);
            }
          else
            list = Fcons (finalname, list);


@@ -416,8 +441,7 @@ These are all file names in directory DIRECTORY which begin with FILE.  */)
   return file_name_completion (file, directory, 1, Qnil);
 }
 
   return file_name_completion (file, directory, 1, Qnil);
 }
 

-static int file_name_completion_stat (Lisp_Object dirname, struct dirent *dp,
-                                     struct stat *st_addr);
+static int file_name_completion_stat (int, struct dirent *, struct stat *);

 static Lisp_Object Qdefault_directory;
 
 static Lisp_Object
 static Lisp_Object Qdefault_directory;
 
 static Lisp_Object


@@ -425,6 +449,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
                      Lisp_Object predicate)
 {
   DIR *d;
                      Lisp_Object predicate)
 {
   DIR *d;

+  int fd;

   ptrdiff_t bestmatchsize = 0;
   int matchcount = 0;
   /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
   ptrdiff_t bestmatchsize = 0;
   int matchcount = 0;
   /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.


@@ -461,14 +486,12 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
 
   encoded_dir = ENCODE_FILE (dirname);
 
 
   encoded_dir = ENCODE_FILE (dirname);
 

-  block_input ();
-  d = opendir (SSDATA (Fdirectory_file_name (encoded_dir)));
-  unblock_input ();
+  d = open_directory (SSDATA (Fdirectory_file_name (encoded_dir)), &fd);

   if (!d)
     report_file_error ("Opening directory", Fcons (dirname, Qnil));
 
   record_unwind_protect (directory_files_internal_unwind,
   if (!d)
     report_file_error ("Opening directory", Fcons (dirname, Qnil));
 
   record_unwind_protect (directory_files_internal_unwind,

-                        make_save_value (d, 0));
+                        make_save_pointer (d));

 
   /* Loop reading blocks */
   /* (att3b compiler bug requires do a null comparison this way) */
 
   /* Loop reading blocks */
   /* (att3b compiler bug requires do a null comparison this way) */


@@ -480,17 +503,15 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
 
       errno = 0;
       dp = readdir (d);
 
       errno = 0;
       dp = readdir (d);

-      if (dp == NULL && (0
-# ifdef EAGAIN
-                        || errno == EAGAIN
-# endif
-# ifdef EINTR
-                        || errno == EINTR
-# endif
-                        ))
-       { QUIT; continue; }
-
-      if (!dp) break;
+      if (!dp)
+       {
+         if (errno == EAGAIN || errno == EINTR)
+           {
+             QUIT;
+             continue;
+           }
+         break;
+       }

 
       len = dirent_namelen (dp);
 
 
       len = dirent_namelen (dp);
 


@@ -500,7 +521,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
                        SCHARS (encoded_file)))
        continue;
 
                        SCHARS (encoded_file)))
        continue;
 

-      if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
+      if (file_name_completion_stat (fd, dp, &st) < 0)

        continue;
 
       directoryp = S_ISDIR (st.st_mode) != 0;
        continue;
 
       directoryp = S_ISDIR (st.st_mode) != 0;


@@ -677,10 +698,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
                                name, zero,
                                make_number (compare),
                                completion_ignore_case ? Qt : Qnil);
                                name, zero,
                                make_number (compare),
                                completion_ignore_case ? Qt : Qnil);

-         ptrdiff_t matchsize
-           = (EQ (cmp, Qt)     ? compare
-              : XINT (cmp) < 0 ? - XINT (cmp) - 1
-              :                  XINT (cmp) - 1);
+         ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XINT (cmp)) - 1;

 
          if (completion_ignore_case)
            {
 
          if (completion_ignore_case)
            {


@@ -780,14 +798,9 @@ scmp (const char *s1, const char *s2, ptrdiff_t len)
 }
 
 static int
 }
 
 static int

-file_name_completion_stat (Lisp_Object dirname, struct dirent *dp,
-                          struct stat *st_addr)
+file_name_completion_stat (int fd, struct dirent *dp, struct stat *st_addr)

 {
 {

-  ptrdiff_t len = dirent_namelen (dp);
-  ptrdiff_t pos = SCHARS (dirname);

   int value;
   int value;

-  USE_SAFE_ALLOCA;
-  char *fullname = SAFE_ALLOCA (len + pos + 2);

 
 #ifdef MSDOS
   /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
 
 #ifdef MSDOS
   /* Some fields of struct stat are *very* expensive to compute on MS-DOS,


@@ -800,23 +813,15 @@ file_name_completion_stat (Lisp_Object dirname, struct dirent *dp,
   _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
 #endif /* MSDOS */
 
   _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
 #endif /* MSDOS */
 

-  memcpy (fullname, SDATA (dirname), pos);
-  if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
-    fullname[pos++] = DIRECTORY_SEP;
-
-  memcpy (fullname + pos, dp->d_name, len);
-  fullname[pos + len] = 0;
-

   /* We want to return success if a link points to a nonexistent file,
      but we want to return the status for what the link points to,
      in case it is a directory.  */
   /* We want to return success if a link points to a nonexistent file,
      but we want to return the status for what the link points to,
      in case it is a directory.  */

-  value = lstat (fullname, st_addr);
+  value = fstatat (fd, dp->d_name, st_addr, AT_SYMLINK_NOFOLLOW);

   if (value == 0 && S_ISLNK (st_addr->st_mode))
   if (value == 0 && S_ISLNK (st_addr->st_mode))

-    stat (fullname, st_addr);
+    fstatat (fd, dp->d_name, st_addr, 0);

 #ifdef MSDOS
   _djstat_flags = save_djstat_flags;
 #endif /* MSDOS */
 #ifdef MSDOS
   _djstat_flags = save_djstat_flags;
 #endif /* MSDOS */

-  SAFE_FREE ();

   return value;
 }
 \f
   return value;
 }
 \f


@@ -826,7 +831,7 @@ stat_uname (struct stat *st)
 #ifdef WINDOWSNT
   return st->st_uname;
 #else
 #ifdef WINDOWSNT
   return st->st_uname;
 #else

-  struct passwd *pw = (struct passwd *) getpwuid (st->st_uid);
+  struct passwd *pw = getpwuid (st->st_uid);

 
   if (pw)
     return pw->pw_name;
 
   if (pw)
     return pw->pw_name;


@@ -841,7 +846,7 @@ stat_gname (struct stat *st)
 #ifdef WINDOWSNT
   return st->st_gname;
 #else
 #ifdef WINDOWSNT
   return st->st_gname;
 #else

-  struct group *gr = (struct group *) getgrgid (st->st_gid);
+  struct group *gr = getgrgid (st->st_gid);

 
   if (gr)
     return gr->gr_name;
 
   if (gr)
     return gr->gr_name;


@@ -875,7 +880,7 @@ Elements of the attribute list are:
  7. Size in bytes.
   This is a floating point number if the size is too large for an integer.
  8. File modes, as a string of ten letters or dashes as in ls -l.
  7. Size in bytes.
   This is a floating point number if the size is too large for an integer.
  8. File modes, as a string of ten letters or dashes as in ls -l.

- 9. t if file's gid would change if file were deleted and recreated.
+ 9. An unspecified value, present only for backward compatibility.

 10. inode number.  If it is larger than what an Emacs integer can hold,
   this is of the form (HIGH . LOW): first the high bits, then the low 16 bits.
   If even HIGH is too large for an Emacs integer, this is instead of the form
 10. inode number.  If it is larger than what an Emacs integer can hold,
   this is of the form (HIGH . LOW): first the high bits, then the low 16 bits.
   If even HIGH is too large for an Emacs integer, this is instead of the form


@@ -894,21 +899,8 @@ On some FAT-based filesystems, only the date of last access is recorded,
 so last access time will always be midnight of that day.  */)
   (Lisp_Object filename, Lisp_Object id_format)
 {
 so last access time will always be midnight of that day.  */)
   (Lisp_Object filename, Lisp_Object id_format)
 {

-  Lisp_Object values[12];

   Lisp_Object encoded;
   Lisp_Object encoded;

-  struct stat s;
-#ifdef BSD4_2
-  Lisp_Object dirname;
-  struct stat sdir;
-#endif /* BSD4_2 */
-
-  /* An array to hold the mode string generated by filemodestring,
-     including its terminating space and null byte.  */
-  char modes[sizeof "-rwxr-xr-x "];
-

   Lisp_Object handler;
   Lisp_Object handler;

-  struct gcpro gcpro1;
-  char *uname = NULL, *gname = NULL;

 
   filename = Fexpand_file_name (filename, Qnil);
 
 
   filename = Fexpand_file_name (filename, Qnil);
 


@@ -924,14 +916,41 @@ so last access time will always be midnight of that day.  */)
        return call3 (handler, Qfile_attributes, filename, id_format);
     }
 
        return call3 (handler, Qfile_attributes, filename, id_format);
     }
 

-  GCPRO1 (filename);

   encoded = ENCODE_FILE (filename);
   encoded = ENCODE_FILE (filename);

-  UNGCPRO;
+  return file_attributes (AT_FDCWD, SSDATA (encoded), id_format);
+}
+
+static Lisp_Object
+file_attributes (int fd, char const *name, Lisp_Object id_format)
+{
+  Lisp_Object values[12];
+  struct stat s;
+  int lstat_result;
+
+  /* An array to hold the mode string generated by filemodestring,
+     including its terminating space and null byte.  */
+  char modes[sizeof "-rwxr-xr-x "];
+
+  char *uname = NULL, *gname = NULL;
+
+#ifdef WINDOWSNT
+  /* We usually don't request accurate owner and group info, because
+     it can be very expensive on Windows to get that, and most callers
+     of 'lstat' don't need that.  But here we do want that information
+     to be accurate.  */
+  w32_stat_get_owner_group = 1;
+#endif
+
+  lstat_result = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW);
+
+#ifdef WINDOWSNT
+  w32_stat_get_owner_group = 0;
+#endif

 
 

-  if (lstat (SSDATA (encoded), &s) < 0)
+  if (lstat_result < 0)

     return Qnil;
 
     return Qnil;
 

-  values[0] = (S_ISLNK (s.st_mode) ? Ffile_symlink_p (filename)
+  values[0] = (S_ISLNK (s.st_mode) ? emacs_readlinkat (fd, name)

               : S_ISDIR (s.st_mode) ? Qt : Qnil);
   values[1] = make_number (s.st_nlink);
 
               : S_ISDIR (s.st_mode) ? Qt : Qnil);
   values[1] = make_number (s.st_nlink);
 


@@ -965,17 +984,7 @@ so last access time will always be midnight of that day.  */)
 
   filemodestring (&s, modes);
   values[8] = make_string (modes, 10);
 
   filemodestring (&s, modes);
   values[8] = make_string (modes, 10);

-#ifdef BSD4_2 /* file gid will be dir gid */
-  dirname = Ffile_name_directory (filename);
-  if (! NILP (dirname))
-    encoded = ENCODE_FILE (dirname);
-  if (! NILP (dirname) && stat (SDATA (encoded), &sdir) == 0)
-    values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
-  else                                 /* if we can't tell, assume worst */
-    values[9] = Qt;
-#else                                  /* file gid will be egid */
-  values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
-#endif /* not BSD4_2 */
+  values[9] = Qt;

   values[10] = INTEGER_TO_CONS (s.st_ino);
   values[11] = INTEGER_TO_CONS (s.st_dev);
 
   values[10] = INTEGER_TO_CONS (s.st_ino);
   values[11] = INTEGER_TO_CONS (s.st_dev);