]> code.delx.au - gnu-emacs/blobdiff - src/dired.c
Update copyright year to 2016
[gnu-emacs] / src / dired.c
index 9026c5678ef4ecbc01fb270e8b69c67ae3afdbc6..97fefaefffd1e3255702c239b01ce069458c5bb9 100644 (file)
@@ -1,5 +1,5 @@
 /* Lisp functions for making directory listings.
-   Copyright (C) 1985-1986, 1993-1994, 1999-2015 Free Software
+   Copyright (C) 1985-1986, 1993-1994, 1999-2016 Free Software
    Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -39,10 +39,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #include "lisp.h"
 #include "systime.h"
-#include "character.h"
 #include "buffer.h"
-#include "commands.h"
-#include "charset.h"
 #include "coding.h"
 #include "regex.h"
 #include "blockinput.h"
@@ -66,8 +63,9 @@ dirent_namelen (struct dirent *dp)
 }
 
 static DIR *
-open_directory (char const *name, int *fdp)
+open_directory (Lisp_Object dirname, int *fdp)
 {
+  char *name = SSDATA (dirname);
   DIR *d;
   int fd, opendir_errno;
 
@@ -98,8 +96,9 @@ open_directory (char const *name, int *fdp)
 
   unblock_input ();
 
+  if (!d)
+    report_file_errno ("Opening directory", dirname, opendir_errno);
   *fdp = fd;
-  errno = opendir_errno;
   return d;
 }
 
@@ -120,6 +119,35 @@ directory_files_internal_unwind (void *dh)
   unblock_input ();
 }
 
+/* Return the next directory entry from DIR; DIR's name is DIRNAME.
+   If there are no more directory entries, return a null pointer.
+   Signal any unrecoverable errors.  */
+
+static struct dirent *
+read_dirent (DIR *dir, Lisp_Object dirname)
+{
+  while (true)
+    {
+      errno = 0;
+      struct dirent *dp = readdir (dir);
+      if (dp || errno == 0)
+       return dp;
+      if (! (errno == EAGAIN || errno == EINTR))
+       {
+#ifdef WINDOWSNT
+         /* The MS-Windows implementation of 'opendir' doesn't
+            actually open a directory until the first call to
+            'readdir'.  If 'readdir' fails to open the directory, it
+            sets errno to ENOENT or EACCES, see w32.c.  */
+         if (errno == ENOENT || errno == EACCES)
+           report_file_error ("Opening directory", dirname);
+#endif
+         report_file_error ("Reading directory", dirname);
+       }
+      QUIT;
+    }
+}
+
 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
    If not ATTRS, return a list of directory filenames;
    if ATTRS, return a list of directory filenames and their attributes.
@@ -130,29 +158,22 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
                          Lisp_Object match, Lisp_Object nosort, bool attrs,
                          Lisp_Object id_format)
 {
-  DIR *d;
-  int fd;
   ptrdiff_t directory_nbytes;
   Lisp_Object list, dirfilename, encoded_directory;
   struct re_pattern_buffer *bufp = NULL;
   bool needsep = 0;
   ptrdiff_t count = SPECPDL_INDEX ();
-  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-  struct dirent *dp;
 #ifdef WINDOWSNT
   Lisp_Object w32_save = Qnil;
 #endif
 
   /* Don't let the compiler optimize away all copies of DIRECTORY,
-     which would break GC; see Bug#16986.  Although this is required
-     only in the common case where GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS,
-     it shouldn't break anything in the other cases.  */
+     which would break GC; see Bug#16986.  */
   Lisp_Object volatile directory_volatile = directory;
 
   /* Because of file name handlers, these functions might call
      Ffuncall, and cause a GC.  */
   list = encoded_directory = dirfilename = Qnil;
-  GCPRO5 (match, directory, list, dirfilename, encoded_directory);
   dirfilename = Fdirectory_file_name (directory);
 
   if (!NILP (match))
@@ -176,17 +197,14 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
   /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
      run_pre_post_conversion_on_str which calls Lisp directly and
      indirectly.  */
-  if (STRING_MULTIBYTE (dirfilename))
-    dirfilename = ENCODE_FILE (dirfilename);
-  encoded_directory = (STRING_MULTIBYTE (directory)
-                      ? ENCODE_FILE (directory) : directory);
+  dirfilename = ENCODE_FILE (dirfilename);
+  encoded_directory = ENCODE_FILE (directory);
 
   /* 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!  */
 
-  d = open_directory (SSDATA (dirfilename), &fd);
-  if (d == NULL)
-    report_file_error ("Opening directory", directory);
+  int fd;
+  DIR *d = open_directory (dirfilename, &fd);
 
   /* Unfortunately, we can now invoke expand-file-name and
      file-attributes on filenames, both of which can throw, so we must
@@ -223,29 +241,12 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
       || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
     needsep = 1;
 
-  /* Loop reading blocks until EOF or error.  */
-  for (;;)
+  /* Loop reading directory entries.  */
+  for (struct dirent *dp; (dp = read_dirent (d, directory)); )
     {
-      ptrdiff_t len;
-      bool wanted = 0;
-      Lisp_Object name, finalname;
-      struct gcpro gcpro1, gcpro2;
-
-      errno = 0;
-      dp = readdir (d);
-      if (!dp)
-       {
-         if (errno == EAGAIN || errno == EINTR)
-           {
-             QUIT;
-             continue;
-           }
-         break;
-       }
-
-      len = dirent_namelen (dp);
-      name = finalname = make_unibyte_string (dp->d_name, len);
-      GCPRO2 (finalname, name);
+      ptrdiff_t len = dirent_namelen (dp);
+      Lisp_Object name = make_unibyte_string (dp->d_name, len);
+      Lisp_Object finalname = name;
 
       /* Note: DECODE_FILE can GC; it should protect its argument,
         though.  */
@@ -257,9 +258,8 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
       immediate_quit = 1;
       QUIT;
 
-      if (NILP (match)
-         || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0)
-       wanted = 1;
+      bool wanted = (NILP (match)
+                    || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0);
 
       immediate_quit = 0;
 
@@ -305,8 +305,6 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
          else
            list = Fcons (finalname, list);
        }
-
-      UNGCPRO;
     }
 
   block_input ();
@@ -325,7 +323,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
                  attrs ? Qfile_attributes_lessp : Qstring_lessp);
 
   (void) directory_volatile;
-  RETURN_UNGCPRO (list);
+  return list;
 }
 
 
@@ -396,8 +394,10 @@ Returns nil if DIRECTORY contains no name starting with FILE.
 If PREDICATE is non-nil, call PREDICATE with each possible
 completion (in absolute form) and ignore it if PREDICATE returns nil.
 
-This function ignores some of the possible completions as
-determined by the variable `completion-ignored-extensions', which see.  */)
+This function ignores some of the possible completions as determined
+by the variables `completion-regexp-list' and
+`completion-ignored-extensions', which see.  `completion-regexp-list'
+is matched against file and directory names relative to DIRECTORY.  */)
   (Lisp_Object file, Lisp_Object directory, Lisp_Object predicate)
 {
   Lisp_Object handler;
@@ -421,7 +421,12 @@ determined by the variable `completion-ignored-extensions', which see.  */)
 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
        Sfile_name_all_completions, 2, 2, 0,
        doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
-These are all file names in directory DIRECTORY which begin with FILE.  */)
+These are all file names in directory DIRECTORY which begin with FILE.
+
+This function ignores some of the possible completions as determined
+by the variables `completion-regexp-list' and
+`completion-ignored-extensions', which see.  `completion-regexp-list'
+is matched against file and directory names relative to DIRECTORY.  */)
   (Lisp_Object file, Lisp_Object directory)
 {
   Lisp_Object handler;
@@ -448,8 +453,6 @@ static Lisp_Object
 file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
                      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.
@@ -464,8 +467,8 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
      well as "." and "..".  Until shown otherwise, assume we can't exclude
      anything.  */
   bool includeall = 1;
+  bool check_decoded = false;
   ptrdiff_t count = SPECPDL_INDEX ();
-  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 
   elt = Qnil;
 
@@ -473,7 +476,6 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
 
   bestmatch = Qnil;
   encoded_file = encoded_dir = Qnil;
-  GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
   specbind (Qdefault_directory, dirname);
 
   /* Do completion on the encoded file name
@@ -482,37 +484,39 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
   /* Actually, this is not quite true any more: we do most of the completion
      work with decoded file names, but we still do some filtering based
      on the encoded file name.  */
-  encoded_file = STRING_MULTIBYTE (file) ? ENCODE_FILE (file) : file;
-
+  encoded_file = ENCODE_FILE (file);
   encoded_dir = ENCODE_FILE (Fdirectory_file_name (dirname));
 
-  d = open_directory (SSDATA (encoded_dir), &fd);
-  if (!d)
-    report_file_error ("Opening directory", dirname);
-
-  record_unwind_protect_ptr (directory_files_internal_unwind, d);
-
-  /* Loop reading blocks */
-  /* (att3b compiler bug requires do a null comparison this way) */
-  while (1)
+  Lisp_Object file_encoding = Vfile_name_coding_system;
+  if (NILP (Vfile_name_coding_system))
+    file_encoding = Vdefault_file_name_coding_system;
+  /* If the file-name encoding decomposes characters, as we do for
+     HFS+ filesystems, we need to make an additional comparison of
+     decoded names in order to filter false positives, such as "a"
+     falsely matching "a-ring".  */
+  if (!NILP (file_encoding)
+      && !NILP (Fplist_get (Fcoding_system_plist (file_encoding),
+                           Qdecomposed_characters)))
     {
-      struct dirent *dp;
-      ptrdiff_t len;
-      bool canexclude = 0;
-
-      errno = 0;
-      dp = readdir (d);
-      if (!dp)
+      check_decoded = true;
+      if (STRING_MULTIBYTE (file))
        {
-         if (errno == EAGAIN || errno == EINTR)
-           {
-             QUIT;
-             continue;
-           }
-         break;
+         /* Recompute FILE to make sure any decomposed characters in
+            it are re-composed by the post-read-conversion.
+            Otherwise, any decomposed characters will be rejected by
+            the additional check below.  */
+         file = DECODE_FILE (encoded_file);
        }
+    }
+  int fd;
+  DIR *d = open_directory (encoded_dir, &fd);
+  record_unwind_protect_ptr (directory_files_internal_unwind, d);
 
-      len = dirent_namelen (dp);
+  /* Loop reading directory entries.  */
+  for (struct dirent *dp; (dp = read_dirent (d, dirname)); )
+    {
+      ptrdiff_t len = dirent_namelen (dp);
+      bool canexclude = 0;
 
       QUIT;
       if (len < SCHARS (encoded_file)
@@ -653,16 +657,23 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
        name = Ffile_name_as_directory (name);
 
       /* Test the predicate, if any.  */
-      if (!NILP (predicate))
-       {
-         Lisp_Object val;
-         struct gcpro gcpro1;
+      if (!NILP (predicate) && NILP (call1 (predicate, name)))
+       continue;
 
-         GCPRO1 (name);
-         val = call1 (predicate, name);
-         UNGCPRO;
+      /* Reject entries where the encoded strings match, but the
+         decoded don't.  For example, "a" should not match "a-ring" on
+         file systems that store decomposed characters. */
+      Lisp_Object zero = make_number (0);
 
-         if (NILP (val))
+      if (check_decoded && SCHARS (file) <= SCHARS (name))
+       {
+         /* FIXME: This is a copy of the code below.  */
+         ptrdiff_t compare = SCHARS (file);
+         Lisp_Object cmp
+           = Fcompare_strings (name, zero, make_number (compare),
+                               file, zero, make_number (compare),
+                               completion_ignore_case ? Qt : Qnil);
+         if (!EQ (cmp, Qt))
            continue;
        }
 
@@ -679,14 +690,11 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
        }
       else
        {
-         Lisp_Object zero = make_number (0);
          /* FIXME: This is a copy of the code in Ftry_completion.  */
          ptrdiff_t compare = min (bestmatchsize, SCHARS (name));
          Lisp_Object cmp
-           = Fcompare_strings (bestmatch, zero,
-                               make_number (compare),
-                               name, zero,
-                               make_number (compare),
+           = Fcompare_strings (bestmatch, zero, make_number (compare),
+                               name, zero, make_number (compare),
                                completion_ignore_case ? Qt : Qnil);
          ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XINT (cmp)) - 1;
 
@@ -744,7 +752,6 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
        }
     }
 
-  UNGCPRO;
   /* This closes the directory.  */
   bestmatch = unbind_to (count, bestmatch);
 
@@ -850,7 +857,7 @@ DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
 Value is nil if specified file cannot be opened.
 
 ID-FORMAT specifies the preferred format of attributes uid and gid (see
-below) - valid values are 'string and 'integer.  The latter is the
+below) - valid values are `string' and `integer'.  The latter is the
 default, but we plan to change that, so you should specify a non-nil value
 for ID-FORMAT if you use the returned uid or gid.
 
@@ -916,7 +923,6 @@ so last access time will always be midnight of that day.  */)
 static Lisp_Object
 file_attributes (int fd, char const *name, Lisp_Object id_format)
 {
-  Lisp_Object values[12];
   struct stat s;
   int lstat_result;
 
@@ -943,10 +949,6 @@ file_attributes (int fd, char const *name, Lisp_Object id_format)
   if (lstat_result < 0)
     return Qnil;
 
-  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);
-
   if (!(NILP (id_format) || EQ (id_format, Qinteger)))
     {
       block_input ();
@@ -954,34 +956,35 @@ file_attributes (int fd, char const *name, Lisp_Object id_format)
       gname = stat_gname (&s);
       unblock_input ();
     }
-  if (uname)
-    values[2] = DECODE_SYSTEM (build_unibyte_string (uname));
-  else
-    values[2] = make_fixnum_or_float (s.st_uid);
-  if (gname)
-    values[3] = DECODE_SYSTEM (build_unibyte_string (gname));
-  else
-    values[3] = make_fixnum_or_float (s.st_gid);
-
-  values[4] = make_lisp_time (get_stat_atime (&s));
-  values[5] = make_lisp_time (get_stat_mtime (&s));
-  values[6] = make_lisp_time (get_stat_ctime (&s));
-
-  /* If the file size is a 4-byte type, assume that files of sizes in
-     the 2-4 GiB range wrap around to negative values, as this is a
-     common bug on older 32-bit platforms.  */
-  if (sizeof (s.st_size) == 4)
-    values[7] = make_fixnum_or_float (s.st_size & 0xffffffffu);
-  else
-    values[7] = make_fixnum_or_float (s.st_size);
 
   filemodestring (&s, modes);
-  values[8] = make_string (modes, 10);
-  values[9] = Qt;
-  values[10] = INTEGER_TO_CONS (s.st_ino);
-  values[11] = INTEGER_TO_CONS (s.st_dev);
 
-  return Flist (ARRAYELTS (values), values);
+  return CALLN (Flist,
+               (S_ISLNK (s.st_mode) ? emacs_readlinkat (fd, name)
+                : S_ISDIR (s.st_mode) ? Qt : Qnil),
+               make_number (s.st_nlink),
+               (uname
+                ? DECODE_SYSTEM (build_unibyte_string (uname))
+                : make_fixnum_or_float (s.st_uid)),
+               (gname
+                ? DECODE_SYSTEM (build_unibyte_string (gname))
+                : make_fixnum_or_float (s.st_gid)),
+               make_lisp_time (get_stat_atime (&s)),
+               make_lisp_time (get_stat_mtime (&s)),
+               make_lisp_time (get_stat_ctime (&s)),
+
+               /* If the file size is a 4-byte type, assume that
+                  files of sizes in the 2-4 GiB range wrap around to
+                  negative values, as this is a common bug on older
+                  32-bit platforms.  */
+               make_fixnum_or_float (sizeof (s.st_size) == 4
+                                     ? s.st_size & 0xffffffffu
+                                     : s.st_size),
+
+               make_string (modes, 10),
+               Qt,
+               INTEGER_TO_CONS (s.st_ino),
+               INTEGER_TO_CONS (s.st_dev));
 }
 
 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
@@ -1041,6 +1044,7 @@ syms_of_dired (void)
   DEFSYM (Qfile_attributes, "file-attributes");
   DEFSYM (Qfile_attributes_lessp, "file-attributes-lessp");
   DEFSYM (Qdefault_directory, "default-directory");
+  DEFSYM (Qdecomposed_characters, "decomposed-characters");
 
   defsubr (&Sdirectory_files);
   defsubr (&Sdirectory_files_and_attributes);