XEmacs 21.2.28 "Hermes".
[chise/xemacs-chise.git.1] / src / dired.c
index b8c35f2..b7077e3 100644 (file)
@@ -30,6 +30,9 @@ Boston, MA 02111-1307, USA.  */
 #include "opaque.h"
 #include "sysfile.h"
 #include "sysdir.h"
+#include "systime.h"
+#include "sysdep.h"
+#include "syspwd.h"
 
 Lisp_Object Vcompletion_ignored_extensions;
 Lisp_Object Qdirectory_files;
@@ -59,43 +62,43 @@ If FILES-ONLY is the symbol t, then only the "files" in the directory
  if FILES-ONLY is nil (the default) then both files and subdirectories will
  be returned.
 */
-       (dirname, full, match, nosort, files_only))
+       (directory, full, match, nosort, files_only))
 {
   /* This function can GC */
   DIR *d;
   Lisp_Object list = Qnil;
-  Bytecount dirnamelen;
+  Bytecount directorylen;
   Lisp_Object handler;
   struct re_pattern_buffer *bufp = NULL;
   int speccount = specpdl_depth ();
   char *statbuf, *statbuf_tail;
 
   struct gcpro gcpro1, gcpro2;
-  GCPRO2 (dirname, list);
+  GCPRO2 (directory, list);
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
-  handler = Ffind_file_name_handler (dirname, Qdirectory_files);
+  handler = Ffind_file_name_handler (directory, Qdirectory_files);
   if (!NILP (handler))
     {
       UNGCPRO;
       if (!NILP (files_only))
-       return call6 (handler, Qdirectory_files, dirname, full, match, nosort,
-                     files_only);
+       return call6 (handler, Qdirectory_files, directory, full, match,
+                     nosort, files_only);
       else
-       return call5 (handler, Qdirectory_files, dirname, full, match,
+       return call5 (handler, Qdirectory_files, directory, full, match,
                      nosort);
     }
 
   /* #### why do we do Fexpand_file_name after file handlers here,
      but earlier everywhere else? */
-  dirname = Fexpand_file_name (dirname, Qnil);
-  dirname = Ffile_name_as_directory (dirname);
-  dirnamelen = XSTRING_LENGTH (dirname);
+  directory = Fexpand_file_name (directory, Qnil);
+  directory = Ffile_name_as_directory (directory);
+  directorylen = XSTRING_LENGTH (directory);
 
-  statbuf = (char *)alloca (dirnamelen + MAXNAMLEN + 1);
-  memcpy (statbuf, XSTRING_DATA (dirname), dirnamelen);
-  statbuf_tail = statbuf + dirnamelen;
+  statbuf = (char *)alloca (directorylen + MAXNAMLEN + 1);
+  memcpy (statbuf, XSTRING_DATA (directory), directorylen);
+  statbuf_tail = statbuf + directorylen;
 
   /* XEmacs: this should come after Ffile_name_as_directory() to avoid
      potential regexp cache smashage.  It comes before the opendir()
@@ -114,11 +117,11 @@ If FILES-ONLY is the symbol t, then only the "files" in the directory
      which might compile a new regexp until we're done with the loop!  */
 
   /* Do this opendir after anything which might signal an error.
-     NOTE: the above comment is old; previosly, there was no
+     NOTE: the above comment is old; previously, there was no
      unwind-protection in case of error, but now there is.  */
-  d = opendir ((char *) XSTRING_DATA (dirname));
+  d = opendir ((char *) XSTRING_DATA (directory));
   if (!d)
-    report_file_error ("Opening directory", list1 (dirname));
+    report_file_error ("Opening directory", list1 (directory));
 
   record_unwind_protect (close_directory_unwind, make_opaque_ptr ((void *)d));
 
@@ -126,7 +129,6 @@ If FILES-ONLY is the symbol t, then only the "files" in the directory
   while (1)
     {
       DIRENTRY *dp = readdir (d);
-      Lisp_Object name;
       int len;
 
       if (!dp)
@@ -138,38 +140,15 @@ If FILES-ONLY is the symbol t, then only the "files" in the directory
        {
          if (!NILP (files_only))
            {
-             int dir_p;
              struct stat st;
-             char *cur_statbuf = statbuf;
-             char *cur_statbuf_tail = statbuf_tail;
-
-             /* #### I don't think the code under `if' is necessary
-                anymore.  The crashes in this function were reported
-                because MAXNAMLEN was used to remember the *whole*
-                statbuf, instead of using MAXPATHLEN.  This should be
-                tested after 21.0 is released.  */
-
-             /* We normally use the buffer created by alloca.
-                However, if the file name we get too big, we'll use a
-                malloced buffer, and free it.  It is undefined how
-                stat() will react to this, but we avoid a buffer
-                overrun.  */
-             if (len > MAXNAMLEN)
-               {
-                 cur_statbuf = (char *)xmalloc (dirnamelen + len + 1);
-                 memcpy (cur_statbuf, statbuf, dirnamelen);
-                 cur_statbuf_tail = cur_statbuf + dirnamelen;
-               }
-             memcpy (cur_statbuf_tail, dp->d_name, len);
-             cur_statbuf_tail[len] = 0;
+             int dir_p = 0;
 
-             if (stat (cur_statbuf, &st) < 0)
-               dir_p = 0;
-             else
-               dir_p = ((st.st_mode & S_IFMT) == S_IFDIR);
+             memcpy (statbuf_tail, dp->d_name, len);
+             statbuf_tail[len] = 0;
 
-             if (cur_statbuf != statbuf)
-               xfree (cur_statbuf);
+             if (stat (statbuf, &st) == 0
+                 && (st.st_mode & S_IFMT) == S_IFDIR)
+               dir_p = 1;
 
              if (EQ (files_only, Qt) && dir_p)
                continue;
@@ -177,98 +156,98 @@ If FILES-ONLY is the symbol t, then only the "files" in the directory
                continue;
            }
 
-         if (!NILP (full))
-           name = concat2 (dirname, make_ext_string ((Bufbyte *)dp->d_name,
-                                                     len, FORMAT_FILENAME));
-         else
-           name = make_ext_string ((Bufbyte *)dp->d_name,
-                                   len, FORMAT_FILENAME);
+         {
+           Lisp_Object name =
+             make_string ((Bufbyte *)dp->d_name, len);
+           if (!NILP (full))
+             name = concat2 (directory, name);
 
-         list = Fcons (name, list);
+           list = Fcons (name, list);
+         }
        }
     }
   unbind_to (speccount, Qnil); /* This will close the dir */
 
-  if (!NILP (nosort))
-    RETURN_UNGCPRO (list);
-  else
-    RETURN_UNGCPRO (Fsort (Fnreverse (list), Qstring_lessp));
+  if (NILP (nosort))
+    list = Fsort (Fnreverse (list), Qstring_lessp);
+
+  RETURN_UNGCPRO (list);
 }
 \f
 static Lisp_Object file_name_completion (Lisp_Object file,
-                                         Lisp_Object dirname,
+                                         Lisp_Object directory,
                                          int all_flag, int ver_flag);
 
 DEFUN ("file-name-completion", Ffile_name_completion, 2, 2, 0, /*
-Complete file name FILE in directory DIR.
-Returns the longest string common to all filenames in DIR
+Complete file name FILE in directory DIRECTORY.
+Returns the longest string common to all filenames in DIRECTORY
 that start with FILE.
 If there is only one and FILE matches it exactly, returns t.
-Returns nil if DIR contains no name starting with FILE.
+Returns nil if DIRECTORY contains no name starting with FILE.
 
 Filenames which end with any member of `completion-ignored-extensions'
 are not considered as possible completions for FILE unless there is no
 other possible completion.  `completion-ignored-extensions' is not applied
 to the names of directories.
 */
-       (file, dirname))
+       (file, directory))
 {
   /* This function can GC.  GC checked 1996.04.06. */
   Lisp_Object handler;
 
   /* If the directory name has special constructs in it,
      call the corresponding file handler.  */
-  handler = Ffind_file_name_handler (dirname, Qfile_name_completion);
+  handler = Ffind_file_name_handler (directory, Qfile_name_completion);
   if (!NILP (handler))
-    return call3 (handler, Qfile_name_completion, file, dirname);
+    return call3 (handler, Qfile_name_completion, file, directory);
 
   /* 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, dirname);
+    return call3 (handler, Qfile_name_completion, file, directory);
 
-  return file_name_completion (file, dirname, 0, 0);
+  return file_name_completion (file, directory, 0, 0);
 }
 
 DEFUN ("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
-Return a list of all completions of file name FILE in directory DIR.
-These are all file names in directory DIR which begin with FILE.
+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.
 
-Filenames which end with any member of `completion-ignored-extensions'
+File names which end with any member of `completion-ignored-extensions'
 are not considered as possible completions for FILE unless there is no
 other possible completion.  `completion-ignored-extensions' is not applied
 to the names of directories.
 */
-       (file, dirname))
+       (file, directory))
 {
   /* This function can GC. GC checked 1997.06.04. */
   Lisp_Object handler;
   struct gcpro gcpro1;
 
-  GCPRO1 (dirname);
-  dirname = Fexpand_file_name (dirname, Qnil);
+  GCPRO1 (directory);
+  directory = Fexpand_file_name (directory, Qnil);
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
-  handler = Ffind_file_name_handler (dirname, Qfile_name_all_completions);
+  handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
   UNGCPRO;
   if (!NILP (handler))
     return call3 (handler, Qfile_name_all_completions, file,
-                 dirname);
+                 directory);
 
-  return file_name_completion (file, dirname, 1, 0);
+  return file_name_completion (file, directory, 1, 0);
 }
 
 static int
-file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp,
+file_name_completion_stat (Lisp_Object directory, DIRENTRY *dp,
                           struct stat *st_addr)
 {
   Bytecount len = NAMLEN (dp);
-  Bytecount pos = XSTRING_LENGTH (dirname);
+  Bytecount pos = XSTRING_LENGTH (directory);
   int value;
   char *fullname = (char *) alloca (len + pos + 2);
 
-  memcpy (fullname, XSTRING_DATA (dirname), pos);
+  memcpy (fullname, XSTRING_DATA (directory), pos);
   if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
     fullname[pos++] = DIRECTORY_SEP;
 
@@ -294,17 +273,18 @@ file_name_completion_unwind (Lisp_Object locative)
   DIR *d;
   Lisp_Object obj = XCAR (locative);
 
-  if (NILP (obj))
-    return Qnil;
-  d = (DIR *)get_opaque_ptr (obj);
-  closedir (d);
-  free_opaque_ptr (obj);
+  if (!NILP (obj))
+    {
+      d = (DIR *)get_opaque_ptr (obj);
+      closedir (d);
+      free_opaque_ptr (obj);
+    }
   free_cons (XCONS (locative));
   return Qnil;
 }
 
 static Lisp_Object
-file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag,
+file_name_completion (Lisp_Object file, Lisp_Object directory, int all_flag,
                      int ver_flag)
 {
   /* This function can GC */
@@ -319,7 +299,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag,
   Lisp_Object locative;
   struct gcpro gcpro1, gcpro2, gcpro3;
 
-  GCPRO3 (file, dirname, bestmatch);
+  GCPRO3 (file, directory, bestmatch);
 
   CHECK_STRING (file);
 
@@ -332,7 +312,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag,
 #ifdef FILE_SYSTEM_CASE
   file = FILE_SYSTEM_CASE (file);
 #endif
-  dirname = Fexpand_file_name (dirname, Qnil);
+  directory = Fexpand_file_name (directory, Qnil);
   file_name_length = XSTRING_CHAR_LENGTH (file);
 
   /* With passcount = 0, ignore files that end in an ignored extension.
@@ -353,9 +333,9 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag,
 
   for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
     {
-      d = opendir ((char *) XSTRING_DATA (Fdirectory_file_name (dirname)));
+      d = opendir ((char *) XSTRING_DATA (Fdirectory_file_name (directory)));
       if (!d)
-       report_file_error ("Opening directory", list1 (dirname));
+       report_file_error ("Opening directory", list1 (directory));
       XCAR (locative) = make_opaque_ptr ((void *)d);
 
       /* Loop reading blocks */
@@ -373,9 +353,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag,
          dp = readdir (d);
          if (!dp) break;
 
-         /* #### This is a bad idea, because d_name can contain
-             control characters, which can make XEmacs crash.  This
-             should be handled properly with FORMAT_FILENAME.  */
+         /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates.  */
          d_name = (Bufbyte *) dp->d_name;
          len = NAMLEN (dp);
          cclen = bytecount_to_charcount (d_name, len);
@@ -387,7 +365,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag,
              || 0 <= scmp (d_name, XSTRING_DATA (file), file_name_length))
            continue;
 
-          if (file_name_completion_stat (dirname, dp, &st) < 0)
+          if (file_name_completion_stat (directory, dp, &st) < 0)
             continue;
 
           directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
@@ -501,7 +479,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag,
                     }
                 }
 
-              /* If this dirname all matches,
+              /* If this directory all matches,
                  see if implicit following slash does too.  */
               if (directoryp
                   && compare == matchsize
@@ -528,26 +506,232 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag,
 }
 
 \f
+
+/* The *pwent() functions do not exist on NT */
+#ifndef  WINDOWSNT
+
+static Lisp_Object user_name_completion (Lisp_Object user,
+                                         int all_flag,
+                                         int *uniq);
+
+DEFUN ("user-name-completion", Fuser_name_completion, 1, 1, 0, /*
+Complete user name USER.
+
+Returns the longest string common to all user names that start
+with USER.  If there is only one and USER matches it exactly,
+returns t.  Returns nil if there is no user name starting with USER.
+*/
+       (user))
+{
+  return user_name_completion (user, 0, NULL);
+}
+
+DEFUN ("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /*
+Complete user name USER.
+
+This function is identical to `user-name-completion', except that
+the cons of the completion and an indication of whether the
+completion was unique is returned.
+
+The car of the returned value is the longest string common to all
+user names that start with USER.  If there is only one and USER
+matches it exactly, the car is t.  The car is nil if there is no
+user name starting with USER.  The cdr of the result is non-nil
+if and only if the completion returned in the car was unique.
+*/
+       (user))
+{
+  int uniq;
+  Lisp_Object completed = user_name_completion (user, 0, &uniq);
+  return Fcons (completed, uniq ? Qt : Qnil);
+}
+
+DEFUN ("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
+Return a list of all completions of user name USER.
+These are all user names which begin with USER.
+*/
+       (user))
+{
+  return user_name_completion (user, 1, NULL);
+}
+
+struct user_name
+{
+  Bufbyte *ptr;
+  size_t len;
+};
+
+struct user_cache
+{
+  struct user_name *user_names;
+  int length;
+  int size;
+  EMACS_TIME last_rebuild_time;
+};
+static struct user_cache user_cache;
+
+static void
+free_user_cache (struct user_cache *cache)
+{
+  int i;
+  for (i = 0; i < cache->length; i++)
+    xfree (cache->user_names[i].ptr);
+  xfree (cache->user_names);
+  xzero (*cache);
+}
+
+static Lisp_Object
+user_name_completion_unwind (Lisp_Object cache_incomplete_p)
+{
+  endpwent ();
+  speed_up_interrupts ();
+
+  if (! NILP (XCAR (cache_incomplete_p)))
+    free_user_cache (&user_cache);
+
+  free_cons (XCONS (cache_incomplete_p));
+
+  return Qnil;
+}
+
+#define  USER_CACHE_TTL  (24*60*60)  /* Time to live: 1 day, in seconds */
+
+static Lisp_Object
+user_name_completion (Lisp_Object user, int all_flag, int *uniq)
+{
+  /* This function can GC */
+  int matchcount = 0;
+  Lisp_Object bestmatch = Qnil;
+  Charcount bestmatchsize = 0;
+  Charcount user_name_length;
+  EMACS_TIME t;
+  int i;
+  struct gcpro gcpro1, gcpro2;
+
+  GCPRO2 (user, bestmatch);
+
+  CHECK_STRING (user);
+
+  user_name_length = XSTRING_CHAR_LENGTH (user);
+
+  /* Cache user name lookups because it tends to be quite slow.
+   * Rebuild the cache occasionally to catch changes */
+  EMACS_GET_TIME (t);
+  if (user_cache.user_names &&
+      (EMACS_SECS (t) - EMACS_SECS (user_cache.last_rebuild_time)
+       > USER_CACHE_TTL))
+    free_user_cache (&user_cache);
+
+  if (!user_cache.user_names)
+    {
+      struct passwd *pwd;
+      Lisp_Object cache_incomplete_p = noseeum_cons (Qt, Qnil);
+      int speccount = specpdl_depth ();
+
+      slow_down_interrupts ();
+      setpwent ();
+      record_unwind_protect (user_name_completion_unwind, cache_incomplete_p);
+      while ((pwd = getpwent ()))
+        {
+          QUIT;
+         DO_REALLOC (user_cache.user_names, user_cache.size,
+                     user_cache.length + 1, struct user_name);
+         TO_INTERNAL_FORMAT (C_STRING, pwd->pw_name,
+                             MALLOC,
+                             (user_cache.user_names[user_cache.length].ptr,
+                              user_cache.user_names[user_cache.length].len),
+                             Qnative);
+         user_cache.length++;
+        }
+      XCAR (cache_incomplete_p) = Qnil;
+      unbind_to (speccount, Qnil);
+
+      EMACS_GET_TIME (user_cache.last_rebuild_time);
+    }
+
+  for (i = 0; i < user_cache.length; i++)
+    {
+      Bufbyte *u_name = user_cache.user_names[i].ptr;
+      Bytecount len   = user_cache.user_names[i].len;
+      /* scmp() works in chars, not bytes, so we have to compute this: */
+      Charcount cclen = bytecount_to_charcount (u_name, len);
+
+      QUIT;
+
+      if (cclen < user_name_length
+         || 0 <= scmp_1 (u_name, XSTRING_DATA (user), user_name_length, 0))
+        continue;
+
+      matchcount++;    /* count matching completions */
+
+      if (all_flag || NILP (bestmatch))
+        {
+          Lisp_Object name = Qnil;
+          struct gcpro ngcpro1;
+          NGCPRO1 (name);
+          /* This is a possible completion */
+          name = make_string (u_name, len);
+          if (all_flag)
+            {
+              bestmatch = Fcons (name, bestmatch);
+            }
+          else
+            {
+              bestmatch = name;
+              bestmatchsize = XSTRING_CHAR_LENGTH (name);
+            }
+          NUNGCPRO;
+        }
+      else
+        {
+          Charcount compare = min (bestmatchsize, cclen);
+          Bufbyte *p1 = XSTRING_DATA (bestmatch);
+          Bufbyte *p2 = u_name;
+          Charcount matchsize = scmp_1 (p1, p2, compare, 0);
+
+          if (matchsize < 0)
+            matchsize = compare;
+
+          bestmatchsize = matchsize;
+        }
+    }
+
+  UNGCPRO;
+
+  if (uniq)
+    *uniq = (matchcount == 1);
+
+  if (all_flag || NILP (bestmatch))
+    return bestmatch;
+  if (matchcount == 1 && bestmatchsize == user_name_length)
+    return Qt;
+  return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
+}
+#endif   /* ! defined WINDOWSNT */
+
+\f
 Lisp_Object
 make_directory_hash_table (CONST char *path)
 {
   DIR *d;
-  Lisp_Object hash = make_lisp_hashtable (100, HASHTABLE_NONWEAK,
-                                         HASHTABLE_EQUAL);
   if ((d = opendir (path)))
     {
       DIRENTRY *dp;
+      Lisp_Object hash =
+       make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
 
       while ((dp = readdir (d)))
        {
          Bytecount len = NAMLEN (dp);
          if (DIRENTRY_NONEMPTY (dp))
-           Fputhash (make_ext_string ((Bufbyte *) dp->d_name, len,
-                                      FORMAT_FILENAME), Qt, hash);
+           /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates.  */
+           Fputhash (make_string ((Bufbyte *) dp->d_name, len), Qt, hash);
        }
       closedir (d);
+      return hash;
     }
-  return hash;
+  else
+    return Qnil;
 }
 \f
 Lisp_Object
@@ -584,13 +768,13 @@ If file does not exist, returns nil.
 {
   /* This function can GC. GC checked 1997.06.04. */
   Lisp_Object values[12];
-  Lisp_Object dirname = Qnil;
+  Lisp_Object directory = Qnil;
   struct stat s;
   char modes[10];
   Lisp_Object handler;
   struct gcpro gcpro1, gcpro2;
 
-  GCPRO2 (filename, dirname);
+  GCPRO2 (filename, directory);
   filename = Fexpand_file_name (filename, Qnil);
 
   /* If the file name has special constructs in it,
@@ -609,7 +793,7 @@ If file does not exist, returns nil.
     }
 
 #ifdef BSD4_2
-  dirname = Ffile_name_directory (filename);
+  directory = Ffile_name_directory (filename);
 #endif
 
 #ifdef MSDOS
@@ -659,7 +843,7 @@ If file does not exist, returns nil.
   {
     struct stat sdir;
 
-    if (!NILP (dirname) && stat ((char *) XSTRING_DATA (dirname), &sdir) == 0)
+    if (!NILP (directory) && stat ((char *) XSTRING_DATA (directory), &sdir) == 0)
       values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
     else                        /* if we can't tell, assume worst */
       values[9] = Qt;
@@ -689,6 +873,11 @@ syms_of_dired (void)
   DEFSUBR (Fdirectory_files);
   DEFSUBR (Ffile_name_completion);
   DEFSUBR (Ffile_name_all_completions);
+#ifndef  WINDOWSNT
+  DEFSUBR (Fuser_name_completion);
+  DEFSUBR (Fuser_name_completion_1);
+  DEFSUBR (Fuser_name_all_completions);
+#endif
   DEFSUBR (Ffile_attributes);
 }