Merge from emacs--devo--0
[bpt/emacs.git] / src / dired.c
index 5d187a3..c471fb9 100644 (file)
@@ -1,12 +1,12 @@
 /* Lisp functions for making directory listings.
    Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001, 2002, 2003,
-                 2004, 2005, 2006 Free Software Foundation, Inc.
+                 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
 GNU Emacs is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
 any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
@@ -396,17 +396,20 @@ ID-FORMAT specifies the preferred format of attributes uid and gid, see
 Lisp_Object file_name_completion ();
 
 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
-       2, 2, 0,
+       2, 3, 0,
        doc: /* Complete file name FILE in directory DIRECTORY.
 Returns the longest string
 common to all file names in DIRECTORY that start with FILE.
 If there is only one and FILE matches it exactly, returns t.
 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.  */)
-     (file, directory)
-     Lisp_Object file, directory;
+     (file, directory, predicate)
+     Lisp_Object file, directory, predicate;
 {
   Lisp_Object handler;
 
@@ -414,15 +417,15 @@ determined by the variable `completion-ignored-extensions', which see.  */)
      call the corresponding file handler.  */
   handler = Ffind_file_name_handler (directory, Qfile_name_completion);
   if (!NILP (handler))
-    return call3 (handler, Qfile_name_completion, file, directory);
+    return call4 (handler, Qfile_name_completion, file, directory, predicate);
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
   handler = Ffind_file_name_handler (file, Qfile_name_completion);
   if (!NILP (handler))
-    return call3 (handler, Qfile_name_completion, file, directory);
+    return call4 (handler, Qfile_name_completion, file, directory, predicate);
 
-  return file_name_completion (file, directory, 0, 0);
+  return file_name_completion (file, directory, 0, 0, predicate);
 }
 
 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
@@ -446,21 +449,25 @@ These are all file names in directory DIRECTORY which begin with FILE.  */)
   if (!NILP (handler))
     return call3 (handler, Qfile_name_all_completions, file, directory);
 
-  return file_name_completion (file, directory, 1, 0);
+  return file_name_completion (file, directory, 1, 0, Qnil);
 }
 
 static int file_name_completion_stat ();
 
 Lisp_Object
-file_name_completion (file, dirname, all_flag, ver_flag)
+file_name_completion (file, dirname, all_flag, ver_flag, predicate)
      Lisp_Object file, dirname;
      int all_flag, ver_flag;
+     Lisp_Object predicate;
 {
   DIR *d;
   int bestmatchsize = 0, skip;
   register int compare, matchsize;
   unsigned char *p1, *p2;
   int matchcount = 0;
+  /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
+     If ALL_FLAG is 0, BESTMATCH is either nil
+     or the best match so far, not decoded.  */
   Lisp_Object bestmatch, tem, elt, name;
   Lisp_Object encoded_file;
   Lisp_Object encoded_dir;
@@ -568,8 +575,8 @@ file_name_completion (file, dirname, all_flag, ver_flag)
 #ifndef TRIVIAL_DIRECTORY_ENTRY
 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
 #endif
-             /* "." and ".." are never interesting as completions, but are
-                actually in the way in a directory contains only one file.  */
+             /* "." and ".." are never interesting as completions, and are
+                actually in the way in a directory with only one file.  */
              if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
                continue;
              if (!passcount && len > SCHARS (encoded_file))
@@ -650,37 +657,52 @@ file_name_completion (file, dirname, all_flag, ver_flag)
                continue;
            }
 
-         /* Update computation of how much all possible completions match */
+         /* This is a possible completion */
+         if (directoryp)
+           {
+             /* This completion is a directory; make it end with '/' */
+             name = Ffile_name_as_directory (make_string (dp->d_name, len));
+           }
+         else
+           name = make_string (dp->d_name, len);
+
+         /* Test the predicate, if any.  */
+
+         if (!NILP (predicate))
+           {
+             Lisp_Object decoded;
+             Lisp_Object val;
+             struct gcpro gcpro1;
+
+             GCPRO1 (name);
+             decoded = Fexpand_file_name (DECODE_FILE (name), dirname);
+             val = call1 (predicate, decoded);
+             UNGCPRO;
+
+             if (NILP (val))
+               continue;
+           }
+
+         /* Suitably record this match.  */
 
          matchcount++;
 
-         if (all_flag || NILP (bestmatch))
+         if (all_flag)
            {
-             /* This is a possible completion */
-             if (directoryp)
-               {
-                 /* This completion is a directory; make it end with '/' */
-                 name = Ffile_name_as_directory (make_string (dp->d_name, len));
-               }
-             else
-               name = make_string (dp->d_name, len);
-             if (all_flag)
-               {
-                 name = DECODE_FILE (name);
-                 bestmatch = Fcons (name, bestmatch);
-               }
-             else
-               {
-                 bestmatch = name;
-                 bestmatchsize = SCHARS (name);
-               }
+             name = DECODE_FILE (name);
+             bestmatch = Fcons (name, bestmatch);
+           }
+         else if (NILP (bestmatch))
+           {
+             bestmatch = name;
+             bestmatchsize = SCHARS (name);
            }
          else
            {
              compare = min (bestmatchsize, len);
              p1 = SDATA (bestmatch);
              p2 = (unsigned char *) dp->d_name;
-             matchsize = scmp(p1, p2, compare);
+             matchsize = scmp (p1, p2, compare);
              if (matchsize < 0)
                matchsize = compare;
              if (completion_ignore_case)
@@ -709,11 +731,7 @@ file_name_completion (file, dirname, all_flag, ver_flag)
                         == SCHARS (bestmatch)))
                       && !bcmp (p2, SDATA (encoded_file), SCHARS (encoded_file))
                       && bcmp (p1, SDATA (encoded_file), SCHARS (encoded_file))))
-                   {
-                     bestmatch = make_string (dp->d_name, len);
-                     if (directoryp)
-                       bestmatch = Ffile_name_as_directory (bestmatch);
-                   }
+                   bestmatch = name;
                }
 
              /* If this dirname all matches, see if implicit following
@@ -836,7 +854,7 @@ DEFUN ("file-name-all-versions", Ffile_name_all_versions,
      (file, directory)
      Lisp_Object file, directory;
 {
-  return file_name_completion (file, directory, 1, 1);
+  return file_name_completion (file, directory, 1, 1, Qnil);
 }
 
 DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
@@ -920,6 +938,7 @@ Elements of the attribute list are:
   char modes[10];
   Lisp_Object handler;
   struct gcpro gcpro1;
+  EMACS_INT uid, gid, ino;
 
   filename = Fexpand_file_name (filename, Qnil);
 
@@ -954,18 +973,26 @@ Elements of the attribute list are:
 #endif
     }
   values[1] = make_number (s.st_nlink);
+  /* When make_fixnum_or_float is called below with types that are
+     shorter than an int (e.g., `short'), GCC whines about comparison
+     being always false due to limited range of data type.  Fix by
+     copying s.st_uid and s.st_gid into int variables.  */
+  uid = s.st_uid;
+  gid = s.st_gid;
   if (NILP (id_format) || EQ (id_format, Qinteger))
     {
-      values[2] = make_number (s.st_uid);
-      values[3] = make_number (s.st_gid);
+      values[2] = make_fixnum_or_float (uid);
+      values[3] = make_fixnum_or_float (gid);
     }
   else
     {
       BLOCK_INPUT;
-      pw = (struct passwd *) getpwuid (s.st_uid);
-      values[2] = (pw ? build_string (pw->pw_name) : make_number (s.st_uid));
-      gr = (struct group *) getgrgid (s.st_gid);
-      values[3] = (gr ? build_string (gr->gr_name) : make_number (s.st_gid));
+      pw = (struct passwd *) getpwuid (uid);
+      values[2] = (pw ? build_string (pw->pw_name)
+                  : make_fixnum_or_float (uid));
+      gr = (struct group *) getgrgid (gid);
+      values[3] = (gr ? build_string (gr->gr_name)
+                  : make_fixnum_or_float (gid));
       UNBLOCK_INPUT;
     }
   values[4] = make_time (s.st_atime);
@@ -987,20 +1014,22 @@ Elements of the attribute list are:
   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;
+    values[9] = (sdir.st_gid != 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;
+  values[9] = (gid != getegid ()) ? Qt : Qnil;
 #endif /* BSD4_2 (or BSD4_3) */
-  if (FIXNUM_OVERFLOW_P (s.st_ino))
+  /* Shut up GCC warnings in FIXNUM_OVERFLOW_P below.  */
+  ino = s.st_ino;
+  if (FIXNUM_OVERFLOW_P (ino))
     /* To allow inode numbers larger than VALBITS, separate the bottom
        16 bits.  */
-    values[10] = Fcons (make_number (s.st_ino >> 16),
-                       make_number (s.st_ino & 0xffff));
+    values[10] = Fcons (make_number (ino >> 16),
+                       make_number (ino & 0xffff));
   else
     /* But keep the most common cases as integers.  */
-    values[10] = make_number (s.st_ino);
+    values[10] = make_number (ino);
 
   /* Likewise for device.  */
   if (FIXNUM_OVERFLOW_P (s.st_dev))