src/dired.c

   1  /* Lisp functions for making directory listings.
   2    Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
   3
   4 This file is part of XEmacs.
   5
   6 XEmacs is free software; you can redistribute it and/or modify it
   7 under the terms of the GNU General Public License as published by the
   8 Free Software Foundation; either version 2, or (at your option) any
   9 later version.
  10
  11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with XEmacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21 /* Synched up with: FSF 19.30. */
  22
  23 #include <config.h>
  24 #include "lisp.h"
  25
  26 #include "sysfile.h"
  27 #include "sysdir.h"
  28 #include "systime.h"
  29 #include "sysdep.h"
  30 #include "syspwd.h"
  31 #include "buffer.h"
  32 #include "commands.h"
  33 #include "elhash.h"
  34 #include "regex.h"
  35 #include "opaque.h"
  36 #include "syntax.h"
  37
  38 Lisp_Object Vcompletion_ignored_extensions;
  39 Lisp_Object Qdirectory_files;
  40 Lisp_Object Qfile_name_completion;
  41 Lisp_Object Qfile_name_all_completions;
  42 Lisp_Object Qfile_attributes;
  43 \f
  44 static Lisp_Object
  45 close_directory_unwind (Lisp_Object unwind_obj)
  46 {
  47   DIR *d = (DIR *)get_opaque_ptr (unwind_obj);
  48   closedir (d);
  49   free_opaque_ptr (unwind_obj);
  50   return Qnil;
  51 }
  52
  53 DEFUN ("directory-files", Fdirectory_files, 1, 5, 0, /*
  54 Return a list of names of files in DIRECTORY.
  55 There are four optional arguments:
  56 If FULL is non-nil, absolute pathnames of the files are returned.
  57 If MATCH is non-nil, only pathnames containing that regexp are returned.
  58 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
  59  NOSORT is useful if you plan to sort the result yourself.
  60 If FILES-ONLY is the symbol t, then only the "files" in the directory
  61  will be returned; subdirectories will be excluded.  If FILES-ONLY is not
  62  nil and not t, then only the subdirectories will be returned.  Otherwise,
  63  if FILES-ONLY is nil (the default) then both files and subdirectories will
  64  be returned.
  65 */
  66        (directory, full, match, nosort, files_only))
  67 {
  68   /* This function can GC */
  69   DIR *d;
  70   Lisp_Object list = Qnil;
  71   Bytecount directorylen;
  72   Lisp_Object handler;
  73   struct re_pattern_buffer *bufp = NULL;
  74   int speccount = specpdl_depth ();
  75   char *statbuf, *statbuf_tail;
  76
  77   struct gcpro gcpro1, gcpro2;
  78   GCPRO2 (directory, list);
  79
  80   /* If the file name has special constructs in it,
  81      call the corresponding file handler.  */
  82   handler = Ffind_file_name_handler (directory, Qdirectory_files);
  83   if (!NILP (handler))
  84     {
  85       UNGCPRO;
  86       if (!NILP (files_only))
  87         return call6 (handler, Qdirectory_files, directory, full, match,
  88                       nosort, files_only);
  89       else
  90         return call5 (handler, Qdirectory_files, directory, full, match,
  91                       nosort);
  92     }
  93
  94   /* #### why do we do Fexpand_file_name after file handlers here,
  95      but earlier everywhere else? */
  96   directory = Fexpand_file_name (directory, Qnil);
  97   directory = Ffile_name_as_directory (directory);
  98   directorylen = XSTRING_LENGTH (directory);
  99
 100   statbuf = (char *)alloca (directorylen + MAXNAMLEN + 1);
 101   memcpy (statbuf, XSTRING_DATA (directory), directorylen);
 102   statbuf_tail = statbuf + directorylen;
 103
 104   /* XEmacs: this should come after Ffile_name_as_directory() to avoid
 105      potential regexp cache smashage.  It comes before the opendir()
 106      because it might signal an error.  */
 107   if (!NILP (match))
 108     {
 109       CHECK_STRING (match);
 110
 111       /* MATCH might be a flawed regular expression.  Rather than
 112          catching and signalling our own errors, we just call
 113          compile_pattern to do the work for us.  */
 114       bufp = compile_pattern (match, 0, Qnil, 0, ERROR_ME);
 115     }
 116
 117   /* Now *bufp is the compiled form of MATCH; don't call anything
 118      which might compile a new regexp until we're done with the loop!  */
 119
 120   /* Do this opendir after anything which might signal an error.
 121      NOTE: the above comment is old; previously, there was no
 122      unwind-protection in case of error, but now there is.  */
 123   d = opendir ((char *) XSTRING_DATA (directory));
 124   if (!d)
 125     report_file_error ("Opening directory", list1 (directory));
 126
 127   /* #### In Matt's code, this was Qt.  Why? */
 128   regex_match_object = Qnil;
 129   regex_emacs_buffer = current_buffer;
 130
 131   record_unwind_protect (close_directory_unwind, make_opaque_ptr ((void *)d));
 132
 133   /* Loop reading blocks */
 134   while (1)
 135     {
 136       DIRENTRY *dp = readdir (d);
 137       int len;
 138
 139       if (!dp)
 140         break;
 141       len = NAMLEN (dp);
 142       if (DIRENTRY_NONEMPTY (dp)
 143           && (NILP (match)
 144               || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0))))
 145         {
 146           if (!NILP (files_only))
 147             {
 148               struct stat st;
 149               int dir_p = 0;
 150
 151               memcpy (statbuf_tail, dp->d_name, len);
 152               statbuf_tail[len] = 0;
 153
 154               if (xemacs_stat (statbuf, &st) == 0
 155                   && (st.st_mode & S_IFMT) == S_IFDIR)
 156                 dir_p = 1;
 157
 158               if (EQ (files_only, Qt) && dir_p)
 159                 continue;
 160               else if (!EQ (files_only, Qt) && !dir_p)
 161                 continue;
 162             }
 163
 164           {
 165             Lisp_Object name =
 166               make_string ((Bufbyte *)dp->d_name, len);
 167             if (!NILP (full))
 168               name = concat2 (directory, name);
 169
 170             list = Fcons (name, list);
 171           }
 172         }
 173     }
 174   unbind_to (speccount, Qnil);  /* This will close the dir */
 175
 176   if (NILP (nosort))
 177     list = Fsort (Fnreverse (list), Qstring_lessp);
 178
 179   RETURN_UNGCPRO (list);
 180 }
 181 \f
 182 static Lisp_Object file_name_completion (Lisp_Object file,
 183                                          Lisp_Object directory,
 184                                          int all_flag, int ver_flag);
 185
 186 DEFUN ("file-name-completion", Ffile_name_completion, 2, 2, 0, /*
 187 Complete file name PARTIAL-FILENAME in directory DIRECTORY.
 188 Return the longest prefix common to all file names in DIRECTORY
 189 that start with PARTIAL-FILENAME.
 190 If there is only one and PARTIAL-FILENAME matches it exactly, return t.
 191 Return nil if DIRECTORY contains no name starting with PARTIAL-FILENAME.
 192
 193 File names which end with any member of `completion-ignored-extensions'
 194 are not considered as possible completions for PARTIAL-FILENAME unless
 195 there is no other possible completion. `completion-ignored-extensions'
 196 is not applied to the names of directories.
 197 */
 198        (partial_filename, directory))
 199 {
 200   /* This function can GC.  GC checked 1996.04.06. */
 201   Lisp_Object handler;
 202
 203   /* If the directory name has special constructs in it,
 204      call the corresponding file handler.  */
 205   handler = Ffind_file_name_handler (directory, Qfile_name_completion);
 206   if (!NILP (handler))
 207     return call3 (handler, Qfile_name_completion, partial_filename, directory);
 208
 209   /* If the file name has special constructs in it,
 210      call the corresponding file handler.  */
 211   handler = Ffind_file_name_handler (partial_filename, Qfile_name_completion);
 212   if (!NILP (handler))
 213     return call3 (handler, Qfile_name_completion, partial_filename, directory);
 214
 215   return file_name_completion (partial_filename, directory, 0, 0);
 216 }
 217
 218 DEFUN ("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
 219 Return a list of all completions of PARTIAL-FILENAME in DIRECTORY.
 220 These are all file names in DIRECTORY which begin with PARTIAL-FILENAME.
 221 */
 222        (partial_filename, directory))
 223 {
 224   /* This function can GC. GC checked 1997.06.04. */
 225   Lisp_Object handler;
 226   struct gcpro gcpro1;
 227
 228   GCPRO1 (directory);
 229   directory = Fexpand_file_name (directory, Qnil);
 230   /* If the file name has special constructs in it,
 231      call the corresponding file handler.  */
 232   handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
 233   UNGCPRO;
 234   if (!NILP (handler))
 235     return call3 (handler, Qfile_name_all_completions, partial_filename,
 236                   directory);
 237
 238   return file_name_completion (partial_filename, directory, 1, 0);
 239 }
 240
 241 static int
 242 file_name_completion_stat (Lisp_Object directory, DIRENTRY *dp,
 243                            struct stat *st_addr)
 244 {
 245   Bytecount len = NAMLEN (dp);
 246   Bytecount pos = XSTRING_LENGTH (directory);
 247   int value;
 248   char *fullname = (char *) alloca (len + pos + 2);
 249
 250   memcpy (fullname, XSTRING_DATA (directory), pos);
 251   if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
 252     fullname[pos++] = DIRECTORY_SEP;
 253
 254   memcpy (fullname + pos, dp->d_name, len);
 255   fullname[pos + len] = 0;
 256
 257 #ifdef S_IFLNK
 258   /* We want to return success if a link points to a nonexistent file,
 259      but we want to return the status for what the link points to,
 260      in case it is a directory.  */
 261   value = lstat (fullname, st_addr);
 262   if (S_ISLNK (st_addr->st_mode))
 263     xemacs_stat (fullname, st_addr);
 264 #else
 265   value = xemacs_stat (fullname, st_addr);
 266 #endif
 267   return value;
 268 }
 269
 270 static Lisp_Object
 271 file_name_completion_unwind (Lisp_Object locative)
 272 {
 273   DIR *d;
 274   Lisp_Object obj = XCAR (locative);
 275
 276   if (!NILP (obj))
 277     {
 278       d = (DIR *)get_opaque_ptr (obj);
 279       closedir (d);
 280       free_opaque_ptr (obj);
 281     }
 282   free_cons (XCONS (locative));
 283   return Qnil;
 284 }
 285
 286 static Lisp_Object
 287 file_name_completion (Lisp_Object file, Lisp_Object directory, int all_flag,
 288                       int ver_flag)
 289 {
 290   /* This function can GC */
 291   DIR *d = 0;
 292   int matchcount = 0;
 293   Lisp_Object bestmatch = Qnil;
 294   Charcount bestmatchsize = 0;
 295   struct stat st;
 296   int passcount;
 297   int speccount = specpdl_depth ();
 298   Charcount file_name_length;
 299   Lisp_Object locative;
 300   struct gcpro gcpro1, gcpro2, gcpro3;
 301
 302   GCPRO3 (file, directory, bestmatch);
 303
 304   CHECK_STRING (file);
 305
 306 #ifdef WIN32_NATIVE
 307   /* Filename completion on Windows ignores case, since Windows
 308      filesystems do.  */
 309   specbind (Qcompletion_ignore_case, Qt);
 310 #endif /* WIN32_NATIVE */
 311
 312 #ifdef FILE_SYSTEM_CASE
 313   file = FILE_SYSTEM_CASE (file);
 314 #endif
 315   directory = Fexpand_file_name (directory, Qnil);
 316   file_name_length = XSTRING_CHAR_LENGTH (file);
 317
 318   /* With passcount = 0, ignore files that end in an ignored extension.
 319      If nothing found then try again with passcount = 1, don't ignore them.
 320      If looking for all completions, start with passcount = 1,
 321      so always take even the ignored ones.
 322
 323      ** It would not actually be helpful to the user to ignore any possible
 324      completions when making a list of them.**  */
 325
 326   /* We cannot use close_directory_unwind() because we change the
 327      directory.  The old code used to just avoid signaling errors, and
 328      call closedir, but it was wrong, because it made sane handling of
 329      QUIT impossible and, besides, various utility functions like
 330      regexp_ignore_completion_p can signal errors.  */
 331   locative = noseeum_cons (Qnil, Qnil);
 332   record_unwind_protect (file_name_completion_unwind, locative);
 333
 334   for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
 335     {
 336       d = opendir ((char *) XSTRING_DATA (Fdirectory_file_name (directory)));
 337       if (!d)
 338         report_file_error ("Opening directory", list1 (directory));
 339       XCAR (locative) = make_opaque_ptr ((void *)d);
 340
 341       /* Loop reading blocks */
 342       while (1)
 343         {
 344           DIRENTRY *dp;
 345           Bytecount len;
 346           /* scmp() works in characters, not bytes, so we have to compute
 347              this value: */
 348           Charcount cclen;
 349           int directoryp;
 350           int ignored_extension_p = 0;
 351           Bufbyte *d_name;
 352
 353           dp = readdir (d);
 354           if (!dp) break;
 355
 356           /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates.  */
 357           d_name = (Bufbyte *) dp->d_name;
 358           len = NAMLEN (dp);
 359           cclen = bytecount_to_charcount (d_name, len);
 360
 361           QUIT;
 362
 363           if (! DIRENTRY_NONEMPTY (dp)
 364               || cclen < file_name_length
 365               || 0 <= scmp (d_name, XSTRING_DATA (file), file_name_length))
 366             continue;
 367
 368           if (file_name_completion_stat (directory, dp, &st) < 0)
 369             continue;
 370
 371           directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
 372           if (directoryp)
 373             {
 374 #ifndef TRIVIAL_DIRECTORY_ENTRY
 375 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
 376 #endif
 377               /* "." and ".." are never interesting as completions, but are
 378                  actually in the way in a directory containing only one file.  */
 379               if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
 380                 continue;
 381             }
 382           else
 383             {
 384               /* Compare extensions-to-be-ignored against end of this file name */
 385               /* if name is not an exact match against specified string.  */
 386               if (!passcount && cclen > file_name_length)
 387                 {
 388                   Lisp_Object tem;
 389                   /* and exit this for loop if a match is found */
 390                   EXTERNAL_LIST_LOOP (tem, Vcompletion_ignored_extensions)
 391                     {
 392                       Lisp_Object elt = XCAR (tem);
 393                       Charcount skip;
 394
 395                       CHECK_STRING (elt);
 396
 397                       skip = cclen - XSTRING_CHAR_LENGTH (elt);
 398                       if (skip < 0) continue;
 399
 400                       if (0 > scmp (charptr_n_addr (d_name, skip),
 401                                     XSTRING_DATA (elt),
 402                                     XSTRING_CHAR_LENGTH (elt)))
 403                         {
 404                           ignored_extension_p = 1;
 405                           break;
 406                         }
 407                     }
 408                 }
 409             }
 410
 411           /* If an ignored-extensions match was found,
 412              don't process this name as a completion.  */
 413           if (!passcount && ignored_extension_p)
 414             continue;
 415
 416           if (!passcount && regexp_ignore_completion_p (d_name, Qnil, 0, cclen))
 417             continue;
 418
 419           /* Update computation of how much all possible completions match */
 420           matchcount++;
 421
 422           if (all_flag || NILP (bestmatch))
 423             {
 424               Lisp_Object name = Qnil;
 425               struct gcpro ngcpro1;
 426               NGCPRO1 (name);
 427               /* This is a possible completion */
 428               name = make_string (d_name, len);
 429               if (directoryp) /* Completion is a directory; end it with '/' */
 430                 name = Ffile_name_as_directory (name);
 431               if (all_flag)
 432                 {
 433                   bestmatch = Fcons (name, bestmatch);
 434                 }
 435               else
 436                 {
 437                   bestmatch = name;
 438                   bestmatchsize = XSTRING_CHAR_LENGTH (name);
 439                 }
 440               NUNGCPRO;
 441             }
 442           else
 443             {
 444               Charcount compare = min (bestmatchsize, cclen);
 445               Bufbyte *p1 = XSTRING_DATA (bestmatch);
 446               Bufbyte *p2 = d_name;
 447               Charcount matchsize = scmp (p1, p2, compare);
 448
 449               if (matchsize < 0)
 450                 matchsize = compare;
 451               if (completion_ignore_case)
 452                 {
 453                   /* If this is an exact match except for case,
 454                      use it as the best match rather than one that is not
 455                      an exact match.  This way, we get the case pattern
 456                      of the actual match.  */
 457                   if ((matchsize == cclen
 458                        && matchsize + !!directoryp
 459                        < XSTRING_CHAR_LENGTH (bestmatch))
 460                       ||
 461                       /* If there is no exact match ignoring case,
 462                          prefer a match that does not change the case
 463                          of the input.  */
 464                       (((matchsize == cclen)
 465                         ==
 466                         (matchsize + !!directoryp
 467                          == XSTRING_CHAR_LENGTH (bestmatch)))
 468                        /* If there is more than one exact match aside from
 469                           case, and one of them is exact including case,
 470                           prefer that one.  */
 471                        && 0 > scmp_1 (p2, XSTRING_DATA (file),
 472                                       file_name_length, 0)
 473                        && 0 <= scmp_1 (p1, XSTRING_DATA (file),
 474                                        file_name_length, 0)))
 475                     {
 476                       bestmatch = make_string (d_name, len);
 477                       if (directoryp)
 478                         bestmatch = Ffile_name_as_directory (bestmatch);
 479                     }
 480                 }
 481
 482               /* If this directory all matches,
 483                  see if implicit following slash does too.  */
 484               if (directoryp
 485                   && compare == matchsize
 486                   && bestmatchsize > matchsize
 487                   && IS_ANY_SEP (charptr_emchar_n (p1, matchsize)))
 488                 matchsize++;
 489               bestmatchsize = matchsize;
 490             }
 491         }
 492       closedir (d);
 493       free_opaque_ptr (XCAR (locative));
 494       XCAR (locative) = Qnil;
 495     }
 496
 497   unbind_to (speccount, Qnil);
 498
 499   UNGCPRO;
 500
 501   if (all_flag || NILP (bestmatch))
 502     return bestmatch;
 503   if (matchcount == 1 && bestmatchsize == file_name_length)
 504     return Qt;
 505   return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
 506 }
 507
 508 \f
 509
 510 /* The *pwent() functions do not exist on NT.  #### The NT equivalent
 511    is NetUserEnum(), and rewriting to use it is not hard.*/
 512 #ifndef  WIN32_NATIVE
 513
 514 static Lisp_Object user_name_completion (Lisp_Object user,
 515                                          int all_flag,
 516                                          int *uniq);
 517
 518 DEFUN ("user-name-completion", Fuser_name_completion, 1, 1, 0, /*
 519 Complete user name from PARTIAL-USERNAME.
 520 Return the longest prefix common to all user names starting with
 521 PARTIAL-USERNAME.  If there is only one and PARTIAL-USERNAME matches
 522 it exactly, returns t.  Return nil if there is no user name starting
 523 with PARTIAL-USERNAME.
 524 */
 525        (partial_username))
 526 {
 527   return user_name_completion (partial_username, 0, NULL);
 528 }
 529
 530 DEFUN ("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /*
 531 Complete user name from PARTIAL-USERNAME.
 532
 533 This function is identical to `user-name-completion', except that
 534 the cons of the completion and an indication of whether the
 535 completion was unique is returned.
 536
 537 The car of the returned value is the longest prefix common to all user
 538 names that start with PARTIAL-USERNAME.  If there is only one and
 539 PARTIAL-USERNAME matches it exactly, the car is t.  The car is nil if
 540 there is no user name starting with PARTIAL-USERNAME.  The cdr of the
 541 result is non-nil if and only if the completion returned in the car
 542 was unique.
 543 */
 544        (partial_username))
 545 {
 546   int uniq;
 547   Lisp_Object completed = user_name_completion (partial_username, 0, &uniq);
 548   return Fcons (completed, uniq ? Qt : Qnil);
 549 }
 550
 551 DEFUN ("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
 552 Return a list of all user name completions from PARTIAL-USERNAME.
 553 These are all the user names which begin with PARTIAL-USERNAME.
 554 */
 555        (partial_username))
 556 {
 557   return user_name_completion (partial_username, 1, NULL);
 558 }
 559
 560 struct user_name
 561 {
 562   Bufbyte *ptr;
 563   size_t len;
 564 };
 565
 566 struct user_cache
 567 {
 568   struct user_name *user_names;
 569   int length;
 570   int size;
 571   EMACS_TIME last_rebuild_time;
 572 };
 573 static struct user_cache user_cache;
 574
 575 static void
 576 free_user_cache (struct user_cache *cache)
 577 {
 578   int i;
 579   for (i = 0; i < cache->length; i++)
 580     xfree (cache->user_names[i].ptr);
 581   xfree (cache->user_names);
 582   xzero (*cache);
 583 }
 584
 585 static Lisp_Object
 586 user_name_completion_unwind (Lisp_Object cache_incomplete_p)
 587 {
 588   endpwent ();
 589   speed_up_interrupts ();
 590
 591   if (! NILP (XCAR (cache_incomplete_p)))
 592     free_user_cache (&user_cache);
 593
 594   free_cons (XCONS (cache_incomplete_p));
 595
 596   return Qnil;
 597 }
 598
 599 #define  USER_CACHE_TTL  (24*60*60)  /* Time to live: 1 day, in seconds */
 600
 601 static Lisp_Object
 602 user_name_completion (Lisp_Object user, int all_flag, int *uniq)
 603 {
 604   /* This function can GC */
 605   int matchcount = 0;
 606   Lisp_Object bestmatch = Qnil;
 607   Charcount bestmatchsize = 0;
 608   Charcount user_name_length;
 609   EMACS_TIME t;
 610   int i;
 611   struct gcpro gcpro1, gcpro2;
 612
 613   GCPRO2 (user, bestmatch);
 614
 615   CHECK_STRING (user);
 616
 617   user_name_length = XSTRING_CHAR_LENGTH (user);
 618
 619   /* Cache user name lookups because it tends to be quite slow.
 620    * Rebuild the cache occasionally to catch changes */
 621   EMACS_GET_TIME (t);
 622   if (user_cache.user_names &&
 623       (EMACS_SECS (t) - EMACS_SECS (user_cache.last_rebuild_time)
 624        > USER_CACHE_TTL))
 625     free_user_cache (&user_cache);
 626
 627   if (!user_cache.user_names)
 628     {
 629       struct passwd *pwd;
 630       Lisp_Object cache_incomplete_p = noseeum_cons (Qt, Qnil);
 631       int speccount = specpdl_depth ();
 632
 633       slow_down_interrupts ();
 634       setpwent ();
 635       record_unwind_protect (user_name_completion_unwind, cache_incomplete_p);
 636       while ((pwd = getpwent ()))
 637         {
 638           QUIT;
 639           DO_REALLOC (user_cache.user_names, user_cache.size,
 640                       user_cache.length + 1, struct user_name);
 641           TO_INTERNAL_FORMAT (C_STRING, pwd->pw_name,
 642                               MALLOC,
 643                               (user_cache.user_names[user_cache.length].ptr,
 644                                user_cache.user_names[user_cache.length].len),
 645                               Qnative);
 646           user_cache.length++;
 647         }
 648       XCAR (cache_incomplete_p) = Qnil;
 649       unbind_to (speccount, Qnil);
 650
 651       EMACS_GET_TIME (user_cache.last_rebuild_time);
 652     }
 653
 654   for (i = 0; i < user_cache.length; i++)
 655     {
 656       Bufbyte *u_name = user_cache.user_names[i].ptr;
 657       Bytecount len   = user_cache.user_names[i].len;
 658       /* scmp() works in chars, not bytes, so we have to compute this: */
 659       Charcount cclen = bytecount_to_charcount (u_name, len);
 660
 661       QUIT;
 662
 663       if (cclen < user_name_length
 664           || 0 <= scmp_1 (u_name, XSTRING_DATA (user), user_name_length, 0))
 665         continue;
 666
 667       matchcount++;    /* count matching completions */
 668
 669       if (all_flag || NILP (bestmatch))
 670         {
 671           Lisp_Object name = Qnil;
 672           struct gcpro ngcpro1;
 673           NGCPRO1 (name);
 674           /* This is a possible completion */
 675           name = make_string (u_name, len);
 676           if (all_flag)
 677             {
 678               bestmatch = Fcons (name, bestmatch);
 679             }
 680           else
 681             {
 682               bestmatch = name;
 683               bestmatchsize = XSTRING_CHAR_LENGTH (name);
 684             }
 685           NUNGCPRO;
 686         }
 687       else
 688         {
 689           Charcount compare = min (bestmatchsize, cclen);
 690           Bufbyte *p1 = XSTRING_DATA (bestmatch);
 691           Bufbyte *p2 = u_name;
 692           Charcount matchsize = scmp_1 (p1, p2, compare, 0);
 693
 694           if (matchsize < 0)
 695             matchsize = compare;
 696
 697           bestmatchsize = matchsize;
 698         }
 699     }
 700
 701   UNGCPRO;
 702
 703   if (uniq)
 704     *uniq = (matchcount == 1);
 705
 706   if (all_flag || NILP (bestmatch))
 707     return bestmatch;
 708   if (matchcount == 1 && bestmatchsize == user_name_length)
 709     return Qt;
 710   return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
 711 }
 712 #endif   /* ! defined WIN32_NATIVE */
 713
 714 \f
 715 Lisp_Object
 716 make_directory_hash_table (const char *path)
 717 {
 718   DIR *d;
 719   if ((d = opendir (path)))
 720     {
 721       DIRENTRY *dp;
 722       Lisp_Object hash =
 723         make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
 724
 725       while ((dp = readdir (d)))
 726         {
 727           Bytecount len = NAMLEN (dp);
 728           if (DIRENTRY_NONEMPTY (dp))
 729             /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates.  */
 730             Fputhash (make_string ((Bufbyte *) dp->d_name, len), Qt, hash);
 731         }
 732       closedir (d);
 733       return hash;
 734     }
 735   else
 736     return Qnil;
 737 }
 738 \f
 739 #if 0
 740 /* ... never used ... should use list2 directly anyway ... */
 741 /* NOTE: This function can never return a negative value. */
 742 Lisp_Object
 743 wasteful_word_to_lisp (unsigned int item)
 744 {
 745   /* Compatibility: in other versions, file-attributes returns a LIST
 746      of two 16 bit integers... */
 747   Lisp_Object cons = word_to_lisp (item);
 748   XCDR (cons) = Fcons (XCDR (cons), Qnil);
 749   return cons;
 750 }
 751 #endif
 752
 753 DEFUN ("file-attributes", Ffile_attributes, 1, 1, 0, /*
 754 Return a list of attributes of file FILENAME.
 755 Value is nil if specified file cannot be opened.
 756 Otherwise, list elements are:
 757  0. t for directory, string (name linked to) for symbolic link, or nil.
 758  1. Number of links to file.
 759  2. File uid.
 760  3. File gid.
 761  4. Last access time, as a list of two integers.
 762   First integer has high-order 16 bits of time, second has low 16 bits.
 763  5. Last modification time, likewise.
 764  6. Last status change time, likewise.
 765  7. Size in bytes. (-1, if number is out of range).
 766  8. File modes, as a string of ten letters or dashes as in ls -l.
 767  9. t iff file's gid would change if file were deleted and recreated.
 768 10. inode number.
 769 11. Device number.
 770
 771 If file does not exist, returns nil.
 772 */
 773        (filename))
 774 {
 775   /* This function can GC. GC checked 1997.06.04. */
 776   Lisp_Object values[12];
 777   Lisp_Object directory = Qnil;
 778   struct stat s;
 779   char modes[10];
 780   Lisp_Object handler;
 781   struct gcpro gcpro1, gcpro2;
 782
 783   GCPRO2 (filename, directory);
 784   filename = Fexpand_file_name (filename, Qnil);
 785
 786   /* If the file name has special constructs in it,
 787      call the corresponding file handler.  */
 788   handler = Ffind_file_name_handler (filename, Qfile_attributes);
 789   if (!NILP (handler))
 790     {
 791       UNGCPRO;
 792       return call2 (handler, Qfile_attributes, filename);
 793     }
 794
 795   if (lstat ((char *) XSTRING_DATA (filename), &s) < 0)
 796     {
 797       UNGCPRO;
 798       return Qnil;
 799     }
 800
 801 #ifdef BSD4_2
 802   directory = Ffile_name_directory (filename);
 803 #endif
 804
 805 #if 0 /* #### shouldn't this apply to WIN32_NATIVE and maybe CYGWIN? */
 806   {
 807     char *tmpnam = (char *) XSTRING_DATA (Ffile_name_nondirectory (filename));
 808     int l = strlen (tmpnam);
 809
 810     if (l >= 5
 811         && S_ISREG (s.st_mode)
 812         && (stricmp (&tmpnam[l - 4], ".com") == 0 ||
 813             stricmp (&tmpnam[l - 4], ".exe") == 0 ||
 814             stricmp (&tmpnam[l - 4], ".bat") == 0))
 815       {
 816         s.st_mode |= S_IEXEC;
 817       }
 818   }
 819 #endif
 820
 821   switch (s.st_mode & S_IFMT)
 822     {
 823     default:
 824       values[0] = Qnil;
 825       break;
 826     case S_IFDIR:
 827       values[0] = Qt;
 828       break;
 829 #ifdef S_IFLNK
 830     case S_IFLNK:
 831       values[0] = Ffile_symlink_p (filename);
 832       break;
 833 #endif
 834     }
 835   values[1] = make_int (s.st_nlink);
 836   values[2] = make_int (s.st_uid);
 837   values[3] = make_int (s.st_gid);
 838   values[4] = make_time (s.st_atime);
 839   values[5] = make_time (s.st_mtime);
 840   values[6] = make_time (s.st_ctime);
 841   values[7] = make_int ((EMACS_INT) s.st_size);
 842   /* If the size is out of range, give back -1.  */
 843   /* #### Fix when Emacs gets bignums! */
 844   if (XINT (values[7]) != s.st_size)
 845     values[7] = make_int (-1);
 846   filemodestring (&s, modes);
 847   values[8] = make_string ((Bufbyte *) modes, 10);
 848 #if defined (BSD4_2) || defined (BSD4_3)        /* file gid will be dir gid */
 849   {
 850     struct stat sdir;
 851
 852     if (!NILP (directory) && xemacs_stat ((char *) XSTRING_DATA (directory), &sdir) == 0)
 853       values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
 854     else                        /* if we can't tell, assume worst */
 855       values[9] = Qt;
 856   }
 857 #else                           /* file gid will be egid */
 858   values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
 859 #endif  /* BSD4_2 or BSD4_3 */
 860   values[10] = make_int (s.st_ino);
 861   values[11] = make_int (s.st_dev);
 862   UNGCPRO;
 863   return Flist (countof (values), values);
 864 }
 865
 866 \f
 867 /************************************************************************/
 868 /*                            initialization                            */
 869 /************************************************************************/
 870
 871 void
 872 syms_of_dired (void)
 873 {
 874   defsymbol (&Qdirectory_files, "directory-files");
 875   defsymbol (&Qfile_name_completion, "file-name-completion");
 876   defsymbol (&Qfile_name_all_completions, "file-name-all-completions");
 877   defsymbol (&Qfile_attributes, "file-attributes");
 878
 879   DEFSUBR (Fdirectory_files);
 880   DEFSUBR (Ffile_name_completion);
 881   DEFSUBR (Ffile_name_all_completions);
 882 #ifndef  WIN32_NATIVE
 883   DEFSUBR (Fuser_name_completion);
 884   DEFSUBR (Fuser_name_completion_1);
 885   DEFSUBR (Fuser_name_all_completions);
 886 #endif
 887   DEFSUBR (Ffile_attributes);
 888 }
 889
 890 void
 891 vars_of_dired (void)
 892 {
 893   DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions /*
 894 *Completion ignores filenames ending in any string in this list.
 895 This variable does not affect lists of possible completions,
 896 but does affect the commands that actually do completions.
 897 It is used by the function `file-name-completion'.
 898 */ );
 899   Vcompletion_ignored_extensions = Qnil;
 900 }