git.chise.org Git - chise/xemacs-chise.git.1/blob - 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
  37 Lisp_Object Vcompletion_ignored_extensions;
  38 Lisp_Object Qdirectory_files;
  39 Lisp_Object Qfile_name_completion;
  40 Lisp_Object Qfile_name_all_completions;
  41 Lisp_Object Qfile_attributes;
  42 \f
  43 static Lisp_Object
  44 close_directory_unwind (Lisp_Object unwind_obj)
  45 {
  46   DIR *d = (DIR *)get_opaque_ptr (unwind_obj);
  47   closedir (d);
  48   free_opaque_ptr (unwind_obj);
  49   return Qnil;
  50 }
  51
  52 DEFUN ("directory-files", Fdirectory_files, 1, 5, 0, /*
  53 Return a list of names of files in DIRECTORY.
  54 There are four optional arguments:
  55 If FULL is non-nil, absolute pathnames of the files are returned.
  56 If MATCH is non-nil, only pathnames containing that regexp are returned.
  57 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
  58  NOSORT is useful if you plan to sort the result yourself.
  59 If FILES-ONLY is the symbol t, then only the "files" in the directory
  60  will be returned; subdirectories will be excluded.  If FILES-ONLY is not
  61  nil and not t, then only the subdirectories will be returned.  Otherwise,
  62  if FILES-ONLY is nil (the default) then both files and subdirectories will
  63  be returned.
  64 */
  65        (directory, full, match, nosort, files_only))
  66 {
  67   /* This function can GC */
  68   DIR *d;
  69   Lisp_Object list = Qnil;
  70   Bytecount directorylen;
  71   Lisp_Object handler;
  72   struct re_pattern_buffer *bufp = NULL;
  73   int speccount = specpdl_depth ();
  74   char *statbuf, *statbuf_tail;
  75
  76   struct gcpro gcpro1, gcpro2;
  77   GCPRO2 (directory, list);
  78
  79   /* If the file name has special constructs in it,
  80      call the corresponding file handler.  */
  81   handler = Ffind_file_name_handler (directory, Qdirectory_files);
  82   if (!NILP (handler))
  83     {
  84       UNGCPRO;
  85       if (!NILP (files_only))
  86         return call6 (handler, Qdirectory_files, directory, full, match,
  87                       nosort, files_only);
  88       else
  89         return call5 (handler, Qdirectory_files, directory, full, match,
  90                       nosort);
  91     }
  92
  93   /* #### why do we do Fexpand_file_name after file handlers here,
  94      but earlier everywhere else? */
  95   directory = Fexpand_file_name (directory, Qnil);
  96   directory = Ffile_name_as_directory (directory);
  97   directorylen = XSTRING_LENGTH (directory);
  98
  99   statbuf = (char *)alloca (directorylen + MAXNAMLEN + 1);
 100   memcpy (statbuf, XSTRING_DATA (directory), directorylen);
 101   statbuf_tail = statbuf + directorylen;
 102
 103   /* XEmacs: this should come after Ffile_name_as_directory() to avoid
 104      potential regexp cache smashage.  It comes before the opendir()
 105      because it might signal an error.  */
 106   if (!NILP (match))
 107     {
 108       CHECK_STRING (match);
 109
 110       /* MATCH might be a flawed regular expression.  Rather than
 111          catching and signalling our own errors, we just call
 112          compile_pattern to do the work for us.  */
 113       bufp = compile_pattern (match, 0, 0, 0, ERROR_ME);
 114     }
 115
 116   /* Now *bufp is the compiled form of MATCH; don't call anything
 117      which might compile a new regexp until we're done with the loop!  */
 118
 119   /* Do this opendir after anything which might signal an error.
 120      NOTE: the above comment is old; previously, there was no
 121      unwind-protection in case of error, but now there is.  */
 122   d = opendir ((char *) XSTRING_DATA (directory));
 123   if (!d)
 124     report_file_error ("Opening directory", list1 (directory));
 125
 126   record_unwind_protect (close_directory_unwind, make_opaque_ptr ((void *)d));
 127
 128   /* Loop reading blocks */
 129   while (1)
 130     {
 131       DIRENTRY *dp = readdir (d);
 132       int len;
 133
 134       if (!dp)
 135         break;
 136       len = NAMLEN (dp);
 137       if (DIRENTRY_NONEMPTY (dp)
 138           && (NILP (match)
 139               || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0))))
 140         {
 141           if (!NILP (files_only))
 142             {
 143               struct stat st;
 144               int dir_p = 0;
 145
 146               memcpy (statbuf_tail, dp->d_name, len);
 147               statbuf_tail[len] = 0;
 148
 149               if (stat (statbuf, &st) == 0
 150                   && (st.st_mode & S_IFMT) == S_IFDIR)
 151                 dir_p = 1;
 152
 153               if (EQ (files_only, Qt) && dir_p)
 154                 continue;
 155               else if (!EQ (files_only, Qt) && !dir_p)
 156                 continue;
 157             }
 158
 159           {
 160             Lisp_Object name =
 161               make_string ((Bufbyte *)dp->d_name, len);
 162             if (!NILP (full))
 163               name = concat2 (directory, name);
 164
 165             list = Fcons (name, list);
 166           }
 167         }
 168     }
 169   unbind_to (speccount, Qnil);  /* This will close the dir */
 170
 171   if (NILP (nosort))
 172     list = Fsort (Fnreverse (list), Qstring_lessp);
 173
 174   RETURN_UNGCPRO (list);
 175 }
 176 \f
 177 static Lisp_Object file_name_completion (Lisp_Object file,
 178                                          Lisp_Object directory,
 179                                          int all_flag, int ver_flag);
 180
 181 DEFUN ("file-name-completion", Ffile_name_completion, 2, 2, 0, /*
 182 Complete file name FILE in directory DIRECTORY.
 183 Returns the longest string common to all filenames in DIRECTORY
 184 that start with FILE.
 185 If there is only one and FILE matches it exactly, returns t.
 186 Returns nil if DIRECTORY contains no name starting with FILE.
 187
 188 Filenames which end with any member of `completion-ignored-extensions'
 189 are not considered as possible completions for FILE unless there is no
 190 other possible completion.  `completion-ignored-extensions' is not applied
 191 to the names of directories.
 192 */
 193        (file, directory))
 194 {
 195   /* This function can GC.  GC checked 1996.04.06. */
 196   Lisp_Object handler;
 197
 198   /* If the directory name has special constructs in it,
 199      call the corresponding file handler.  */
 200   handler = Ffind_file_name_handler (directory, Qfile_name_completion);
 201   if (!NILP (handler))
 202     return call3 (handler, Qfile_name_completion, file, directory);
 203
 204   /* If the file name has special constructs in it,
 205      call the corresponding file handler.  */
 206   handler = Ffind_file_name_handler (file, Qfile_name_completion);
 207   if (!NILP (handler))
 208     return call3 (handler, Qfile_name_completion, file, directory);
 209
 210   return file_name_completion (file, directory, 0, 0);
 211 }
 212
 213 DEFUN ("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
 214 Return a list of all completions of file name FILE in directory DIRECTORY.
 215 These are all file names in directory DIRECTORY which begin with FILE.
 216
 217 File names which end with any member of `completion-ignored-extensions'
 218 are not considered as possible completions for FILE unless there is no
 219 other possible completion.  `completion-ignored-extensions' is not applied
 220 to the names of directories.
 221 */
 222        (file, 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, file,
 236                   directory);
 237
 238   return file_name_completion (file, 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     stat (fullname, st_addr);
 264 #else
 265   value = 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 */
 511 #ifndef  WIN32_NATIVE
 512
 513 static Lisp_Object user_name_completion (Lisp_Object user,
 514                                          int all_flag,
 515                                          int *uniq);
 516
 517 DEFUN ("user-name-completion", Fuser_name_completion, 1, 1, 0, /*
 518 Complete user name USER.
 519
 520 Returns the longest string common to all user names that start
 521 with USER.  If there is only one and USER matches it exactly,
 522 returns t.  Returns nil if there is no user name starting with USER.
 523 */
 524        (user))
 525 {
 526   return user_name_completion (user, 0, NULL);
 527 }
 528
 529 DEFUN ("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /*
 530 Complete user name USER.
 531
 532 This function is identical to `user-name-completion', except that
 533 the cons of the completion and an indication of whether the
 534 completion was unique is returned.
 535
 536 The car of the returned value is the longest string common to all
 537 user names that start with USER.  If there is only one and USER
 538 matches it exactly, the car is t.  The car is nil if there is no
 539 user name starting with USER.  The cdr of the result is non-nil
 540 if and only if the completion returned in the car was unique.
 541 */
 542        (user))
 543 {
 544   int uniq;
 545   Lisp_Object completed = user_name_completion (user, 0, &uniq);
 546   return Fcons (completed, uniq ? Qt : Qnil);
 547 }
 548
 549 DEFUN ("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
 550 Return a list of all completions of user name USER.
 551 These are all user names which begin with USER.
 552 */
 553        (user))
 554 {
 555   return user_name_completion (user, 1, NULL);
 556 }
 557
 558 struct user_name
 559 {
 560   Bufbyte *ptr;
 561   size_t len;
 562 };
 563
 564 struct user_cache
 565 {
 566   struct user_name *user_names;
 567   int length;
 568   int size;
 569   EMACS_TIME last_rebuild_time;
 570 };
 571 static struct user_cache user_cache;
 572
 573 static void
 574 free_user_cache (struct user_cache *cache)
 575 {
 576   int i;
 577   for (i = 0; i < cache->length; i++)
 578     xfree (cache->user_names[i].ptr);
 579   xfree (cache->user_names);
 580   xzero (*cache);
 581 }
 582
 583 static Lisp_Object
 584 user_name_completion_unwind (Lisp_Object cache_incomplete_p)
 585 {
 586   endpwent ();
 587   speed_up_interrupts ();
 588
 589   if (! NILP (XCAR (cache_incomplete_p)))
 590     free_user_cache (&user_cache);
 591
 592   free_cons (XCONS (cache_incomplete_p));
 593
 594   return Qnil;
 595 }
 596
 597 #define  USER_CACHE_TTL  (24*60*60)  /* Time to live: 1 day, in seconds */
 598
 599 static Lisp_Object
 600 user_name_completion (Lisp_Object user, int all_flag, int *uniq)
 601 {
 602   /* This function can GC */
 603   int matchcount = 0;
 604   Lisp_Object bestmatch = Qnil;
 605   Charcount bestmatchsize = 0;
 606   Charcount user_name_length;
 607   EMACS_TIME t;
 608   int i;
 609   struct gcpro gcpro1, gcpro2;
 610
 611   GCPRO2 (user, bestmatch);
 612
 613   CHECK_STRING (user);
 614
 615   user_name_length = XSTRING_CHAR_LENGTH (user);
 616
 617   /* Cache user name lookups because it tends to be quite slow.
 618    * Rebuild the cache occasionally to catch changes */
 619   EMACS_GET_TIME (t);
 620   if (user_cache.user_names &&
 621       (EMACS_SECS (t) - EMACS_SECS (user_cache.last_rebuild_time)
 622        > USER_CACHE_TTL))
 623     free_user_cache (&user_cache);
 624
 625   if (!user_cache.user_names)
 626     {
 627       struct passwd *pwd;
 628       Lisp_Object cache_incomplete_p = noseeum_cons (Qt, Qnil);
 629       int speccount = specpdl_depth ();
 630
 631       slow_down_interrupts ();
 632       setpwent ();
 633       record_unwind_protect (user_name_completion_unwind, cache_incomplete_p);
 634       while ((pwd = getpwent ()))
 635         {
 636           QUIT;
 637           DO_REALLOC (user_cache.user_names, user_cache.size,
 638                       user_cache.length + 1, struct user_name);
 639           TO_INTERNAL_FORMAT (C_STRING, pwd->pw_name,
 640                               MALLOC,
 641                               (user_cache.user_names[user_cache.length].ptr,
 642                                user_cache.user_names[user_cache.length].len),
 643                               Qnative);
 644           user_cache.length++;
 645         }
 646       XCAR (cache_incomplete_p) = Qnil;
 647       unbind_to (speccount, Qnil);
 648
 649       EMACS_GET_TIME (user_cache.last_rebuild_time);
 650     }
 651
 652   for (i = 0; i < user_cache.length; i++)
 653     {
 654       Bufbyte *u_name = user_cache.user_names[i].ptr;
 655       Bytecount len   = user_cache.user_names[i].len;
 656       /* scmp() works in chars, not bytes, so we have to compute this: */
 657       Charcount cclen = bytecount_to_charcount (u_name, len);
 658
 659       QUIT;
 660
 661       if (cclen < user_name_length
 662           || 0 <= scmp_1 (u_name, XSTRING_DATA (user), user_name_length, 0))
 663         continue;
 664
 665       matchcount++;    /* count matching completions */
 666
 667       if (all_flag || NILP (bestmatch))
 668         {
 669           Lisp_Object name = Qnil;
 670           struct gcpro ngcpro1;
 671           NGCPRO1 (name);
 672           /* This is a possible completion */
 673           name = make_string (u_name, len);
 674           if (all_flag)
 675             {
 676               bestmatch = Fcons (name, bestmatch);
 677             }
 678           else
 679             {
 680               bestmatch = name;
 681               bestmatchsize = XSTRING_CHAR_LENGTH (name);
 682             }
 683           NUNGCPRO;
 684         }
 685       else
 686         {
 687           Charcount compare = min (bestmatchsize, cclen);
 688           Bufbyte *p1 = XSTRING_DATA (bestmatch);
 689           Bufbyte *p2 = u_name;
 690           Charcount matchsize = scmp_1 (p1, p2, compare, 0);
 691
 692           if (matchsize < 0)
 693             matchsize = compare;
 694
 695           bestmatchsize = matchsize;
 696         }
 697     }
 698
 699   UNGCPRO;
 700
 701   if (uniq)
 702     *uniq = (matchcount == 1);
 703
 704   if (all_flag || NILP (bestmatch))
 705     return bestmatch;
 706   if (matchcount == 1 && bestmatchsize == user_name_length)
 707     return Qt;
 708   return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
 709 }
 710 #endif   /* ! defined WIN32_NATIVE */
 711
 712 \f
 713 Lisp_Object
 714 make_directory_hash_table (const char *path)
 715 {
 716   DIR *d;
 717   if ((d = opendir (path)))
 718     {
 719       DIRENTRY *dp;
 720       Lisp_Object hash =
 721         make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
 722
 723       while ((dp = readdir (d)))
 724         {
 725           Bytecount len = NAMLEN (dp);
 726           if (DIRENTRY_NONEMPTY (dp))
 727             /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates.  */
 728             Fputhash (make_string ((Bufbyte *) dp->d_name, len), Qt, hash);
 729         }
 730       closedir (d);
 731       return hash;
 732     }
 733   else
 734     return Qnil;
 735 }
 736 \f
 737 Lisp_Object
 738 wasteful_word_to_lisp (unsigned int item)
 739 {
 740   /* Compatibility: in other versions, file-attributes returns a LIST
 741      of two 16 bit integers... */
 742   Lisp_Object cons = word_to_lisp (item);
 743   XCDR (cons) = Fcons (XCDR (cons), Qnil);
 744   return cons;
 745 }
 746
 747 DEFUN ("file-attributes", Ffile_attributes, 1, 1, 0, /*
 748 Return a list of attributes of file FILENAME.
 749 Value is nil if specified file cannot be opened.
 750 Otherwise, list elements are:
 751  0. t for directory, string (name linked to) for symbolic link, or nil.
 752  1. Number of links to file.
 753  2. File uid.
 754  3. File gid.
 755  4. Last access time, as a list of two integers.
 756   First integer has high-order 16 bits of time, second has low 16 bits.
 757  5. Last modification time, likewise.
 758  6. Last status change time, likewise.
 759  7. Size in bytes. (-1, if number is out of range).
 760  8. File modes, as a string of ten letters or dashes as in ls -l.
 761  9. t iff file's gid would change if file were deleted and recreated.
 762 10. inode number.
 763 11. Device number.
 764
 765 If file does not exist, returns nil.
 766 */
 767        (filename))
 768 {
 769   /* This function can GC. GC checked 1997.06.04. */
 770   Lisp_Object values[12];
 771   Lisp_Object directory = Qnil;
 772   struct stat s;
 773   char modes[10];
 774   Lisp_Object handler;
 775   struct gcpro gcpro1, gcpro2;
 776
 777   GCPRO2 (filename, directory);
 778   filename = Fexpand_file_name (filename, Qnil);
 779
 780   /* If the file name has special constructs in it,
 781      call the corresponding file handler.  */
 782   handler = Ffind_file_name_handler (filename, Qfile_attributes);
 783   if (!NILP (handler))
 784     {
 785       UNGCPRO;
 786       return call2 (handler, Qfile_attributes, filename);
 787     }
 788
 789   if (lstat ((char *) XSTRING_DATA (filename), &s) < 0)
 790     {
 791       UNGCPRO;
 792       return Qnil;
 793     }
 794
 795 #ifdef BSD4_2
 796   directory = Ffile_name_directory (filename);
 797 #endif
 798
 799 #if 0 /* #### shouldn't this apply to WIN32_NATIVE and maybe CYGWIN? */
 800   {
 801     char *tmpnam = (char *) XSTRING_DATA (Ffile_name_nondirectory (filename));
 802     int l = strlen (tmpnam);
 803
 804     if (l >= 5
 805         && S_ISREG (s.st_mode)
 806         && (stricmp (&tmpnam[l - 4], ".com") == 0 ||
 807             stricmp (&tmpnam[l - 4], ".exe") == 0 ||
 808             stricmp (&tmpnam[l - 4], ".bat") == 0))
 809       {
 810         s.st_mode |= S_IEXEC;
 811       }
 812   }
 813 #endif
 814
 815   switch (s.st_mode & S_IFMT)
 816     {
 817     default:
 818       values[0] = Qnil;
 819       break;
 820     case S_IFDIR:
 821       values[0] = Qt;
 822       break;
 823 #ifdef S_IFLNK
 824     case S_IFLNK:
 825       values[0] = Ffile_symlink_p (filename);
 826       break;
 827 #endif
 828     }
 829   values[1] = make_int (s.st_nlink);
 830   values[2] = make_int (s.st_uid);
 831   values[3] = make_int (s.st_gid);
 832   values[4] = wasteful_word_to_lisp (s.st_atime);
 833   values[5] = wasteful_word_to_lisp (s.st_mtime);
 834   values[6] = wasteful_word_to_lisp (s.st_ctime);
 835   values[7] = make_int ((EMACS_INT) s.st_size);
 836   /* If the size is out of range, give back -1.  */
 837   /* #### Fix when Emacs gets bignums! */
 838   if (XINT (values[7]) != s.st_size)
 839     values[7] = make_int (-1);
 840   filemodestring (&s, modes);
 841   values[8] = make_string ((Bufbyte *) modes, 10);
 842 #if defined (BSD4_2) || defined (BSD4_3)        /* file gid will be dir gid */
 843   {
 844     struct stat sdir;
 845
 846     if (!NILP (directory) && stat ((char *) XSTRING_DATA (directory), &sdir) == 0)
 847       values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
 848     else                        /* if we can't tell, assume worst */
 849       values[9] = Qt;
 850   }
 851 #else                           /* file gid will be egid */
 852   values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
 853 #endif  /* BSD4_2 or BSD4_3 */
 854   values[10] = make_int (s.st_ino);
 855   values[11] = make_int (s.st_dev);
 856   UNGCPRO;
 857   return Flist (countof (values), values);
 858 }
 859
 860 \f
 861 /************************************************************************/
 862 /*                            initialization                            */
 863 /************************************************************************/
 864
 865 void
 866 syms_of_dired (void)
 867 {
 868   defsymbol (&Qdirectory_files, "directory-files");
 869   defsymbol (&Qfile_name_completion, "file-name-completion");
 870   defsymbol (&Qfile_name_all_completions, "file-name-all-completions");
 871   defsymbol (&Qfile_attributes, "file-attributes");
 872
 873   DEFSUBR (Fdirectory_files);
 874   DEFSUBR (Ffile_name_completion);
 875   DEFSUBR (Ffile_name_all_completions);
 876 #ifndef  WIN32_NATIVE
 877   DEFSUBR (Fuser_name_completion);
 878   DEFSUBR (Fuser_name_completion_1);
 879   DEFSUBR (Fuser_name_all_completions);
 880 #endif
 881   DEFSUBR (Ffile_attributes);
 882 }
 883
 884 void
 885 vars_of_dired (void)
 886 {
 887   DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions /*
 888 *Completion ignores filenames ending in any string in this list.
 889 This variable does not affect lists of possible completions,
 890 but does affect the commands that actually do completions.
 891 It is used by the functions `file-name-completion' and
 892 `file-name-all-completions'.
 893 */ );
 894   Vcompletion_ignored_extensions = Qnil;
 895 }