cgit.sxemacs.org Git - sxemacs/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 SXEmacs
   5
   6 SXEmacs is free software: you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation, either version 3 of the License, or
   9 (at your option) any later version.
  10
  11 SXEmacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  18
  19
  20 /* Synched up with: FSF 19.30. */
  21
  22 #include <config.h>
  23 #include "lisp.h"
  24
  25 #include "sysfile.h"
  26 #include "sysdir.h"
  27 #include "systime.h"
  28 #include "sysdep.h"
  29 #include "syspwd.h"
  30 #include "buffer.h"
  31 #include "commands.h"
  32 #include "elhash.h"
  33 #include "regex.h"
  34 #include "opaque.h"
  35 #include "syntax.h"
  36 #include "dllist.h"
  37 #include "bloom.h"
  38 #include "dynacat.h"
  39
  40 #ifdef FILE_CODING
  41 #include "mule/file-coding.h"
  42 #endif
  43
  44 #define USE_D_TYPE 1
  45
  46 Lisp_Object Vcompletion_ignored_extensions;
  47 Lisp_Object Vdirectory_files_no_trivial_p;
  48 Lisp_Object Qdirectory_files;
  49 Lisp_Object Qdirectory_files_recur;
  50 Lisp_Object Qfile_name_completion;
  51 Lisp_Object Qfile_name_all_completions;
  52 Lisp_Object Qfile_attributes;
  53
  54 Lisp_Object Qcompanion_bf;
  55 Lisp_Object Qsorted_list, Qdesc_sorted_list, Qunsorted_list;
  56 Lisp_Object Qnoncyclic_directory, Qcyclic_directory;
  57 Lisp_Object Qsymlink, Qalive_symlink, Qdead_symlink;
  58 Lisp_Object Qwhiteout;
  59
  60 /* On GNU libc systems the declaration is only visible with _GNU_SOURCE.  */
  61 #if defined(HAVE_CANONICALIZE_FILE_NAME)
  62 #  if defined(NEED_DECLARATION_CANONICALIZE_FILE_NAME)
  63 extern char *canonicalize_file_name(const char *);
  64 #  endif
  65 #define CANONICALISE_FILENAME(f)        canonicalize_file_name(f)
  66
  67 #else  /* !defined(HAVE_CANONICALIZE_FILE_NAME) */
  68
  69 static char *dired_realpath(const char *);
  70 #define CANONICALISE_FILENAME(f)        dired_realpath(f)
  71 #endif  /* defined(HAVE_CANONICALIZE_FILE_NAME) */
  72
  73 #ifndef TRIVIAL_DIRECTORY_ENTRY
  74 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
  75 #endif
  76
  77 #if 0
  78         /* this variant is much too slow */
  79 #define FAST_CONCAT(tgt, s1, s2)        tgt = concat2(s1, s2);
  80
  81 #else  /* !0 */
  82 #define FAST_CONCAT(tgt, s1, s2)        \
  83 {                                       \
  84         tgt = make_uninit_string(XSTRING_LENGTH(s1)+XSTRING_LENGTH(s2));  \
  85         memcpy(XSTRING_DATA(tgt), XSTRING_DATA(s1), XSTRING_LENGTH(s1));  \
  86         memcpy(XSTRING_DATA(tgt)+XSTRING_LENGTH(s1),                      \
  87                XSTRING_DATA(s2), XSTRING_LENGTH(s2));                     \
  88 } while (0);
  89 #endif  /* 0 */
  90
  91 /* some more declarations */
  92 typedef struct dired_stack_item_s *dired_stack_item_t;
  93 typedef struct dfr_options_s *dfr_options_t;
  94
  95 struct dired_stack_item_s {
  96         Lisp_Object dir;
  97         unsigned int depth;
  98 };
  99
 100 struct dfr_options_s {
 101         long unsigned int maxdepth;
 102         _Bool fullp:1;
 103         _Bool symlink_file_p:1;
 104 };
 105
 106 static Lisp_Object fname_as_directory(Lisp_Object);
 107 static int pathname_matches_p(Lisp_Object, Lisp_Object,
 108                               struct re_pattern_buffer*);
 109
 110 #define dired_stack_t           dllist_t
 111 #define new_dired_stack()       make_noseeum_dllist()
 112 #define free_dired_stack(ds)    free_noseeum_dllist(ds)
 113 #define dired_stack_pop(ds)     (dired_stack_item_t)dllist_pop_car(ds)
 114 #define dired_stack_push(ds, p) dllist_append(ds, p)
 115 #define dired_stack_size(ds)    dllist_size(ds)
 116
 117 \f
 118 #if defined(HAVE_LARGEFILE)
 119 #define dirent_t        struct dirent64
 120 #define DFR_READDIR     readdir64_r
 121 #else
 122 #define dirent_t        struct dirent
 123 #define DFR_READDIR     readdir_r
 124 #endif
 125
 126 #if !defined(HAVE_CANONICALIZE_FILE_NAME)
 127 static char *
 128 dired_realpath(const char *file)
 129 {
 130         char *result = xmalloc_atomic(4096);
 131
 132         if ( xrealpath(file, result) == NULL ) {
 133                 xfree(result);
 134                 result = NULL;
 135         }
 136         return result;
 137 }
 138 #endif
 139
 140 static Lisp_Object
 141 fname_as_directory(Lisp_Object fname)
 142 {
 143         if (XSTRING_LENGTH(fname) > 0)
 144                 return Ffile_name_as_directory(fname);
 145         else
 146                 return fname;
 147 }
 148
 149 static int
 150 pathname_matches_p(Lisp_Object pathname, Lisp_Object match,
 151                    struct re_pattern_buffer *bufp)
 152 {
 153         int speccount2;
 154         char *mstr = NULL;
 155         int mlen = 0;
 156         int result = 1;
 157
 158         if (STRINGP(match)) {
 159                 mstr = (char*)XSTRING_DATA(pathname);
 160                 mlen = XSTRING_LENGTH(pathname);
 161                 if (re_search(bufp, mstr, mlen, 0, mlen, 0) < 0)
 162                         result = 0;
 163         } else {
 164                 speccount2 = specpdl_depth();
 165                 record_unwind_protect(restore_gc_inhibit,
 166                                       make_int(gc_currently_forbidden));
 167                 gc_currently_forbidden = 1;
 168                 if (NILP(call1_trapping_errors(
 169                                  "Error in match function",
 170                                  match, pathname)))
 171                         result = 0;
 172
 173                 /* clean up */
 174                 restore_match_data();
 175                 unbind_to(speccount2, Qnil);
 176         }
 177
 178         return result;
 179 }
 180
 181 \f
 182 static Lisp_Object close_directory_unwind(Lisp_Object unwind_obj)
 183 {
 184         DIR *d = (DIR *) get_opaque_ptr(unwind_obj);
 185         closedir(d);
 186         free_opaque_ptr(unwind_obj);
 187         return Qnil;
 188 }
 189
 190 \f
 191 static void
 192 dfr_inner(dirent_t *res,
 193           Lisp_Object fulldir, Lisp_Object dir, Lisp_Object compbf,
 194           dfr_options_t opts, Lisp_Object files_only,
 195           unsigned int curdepth, dired_stack_t ds, Lisp_Object match,
 196           struct re_pattern_buffer *bufp, Lisp_Object result,
 197           Lisp_Object bloom_filter)
 198 {
 199         /* this function can GC */
 200         int dir_p = 0;
 201         int result_p = 0;
 202         Lisp_Object name = Qnil;
 203         Lisp_Object fullname = Qnil;
 204         Lisp_Object resname = Qnil;
 205         int len;
 206         struct stat st;
 207         char *statnam = NULL;
 208         struct gcpro gcpro1, gcpro2, gcpro3;
 209
 210         GCPRO3(name, fullname, resname);
 211
 212         if (!DIRENTRY_NONEMPTY(res) ||
 213             (TRIVIAL_DIRECTORY_ENTRY(res->d_name) &&
 214              !(NILP(Vdirectory_files_no_trivial_p) && opts->maxdepth == 0))) {
 215                 UNGCPRO;
 216                 return;
 217         }
 218
 219         len = NAMLEN(res);
 220         resname = make_ext_string(res->d_name, len, Qfile_name);
 221
 222         FAST_CONCAT(fullname, fulldir, resname);
 223         FAST_CONCAT(name, dir, resname);
 224
 225         /* we want full file names? */
 226         if (opts->fullp) {
 227                 resname = fullname;
 228         } else {
 229                 resname = name;
 230         }
 231
 232         /* check if we have to recur, i.e. if res was a
 233            directory, otherwise we assume name to be a
 234            file and cons it to the result */
 235 #if defined(_DIRENT_HAVE_D_TYPE) && USE_D_TYPE
 236         if (res->d_type == DT_DIR) {
 237                 dir_p = 1;
 238         } else if (res->d_type == DT_LNK && !opts->symlink_file_p) {
 239                 char *canon_name = NULL;
 240
 241                 statnam = (char*)XSTRING_DATA(fullname);
 242
 243                 /* ugly things may happen when a link
 244                  * points back to a directory in our recurring
 245                  * area, ln -s . foo  is a candidate
 246                  * now, we canonicalise the filename, i.e.
 247                  * resolve all symlinks and afterwards we
 248                  * store it to our companion bloom filter
 249                  */
 250                 canon_name = CANONICALISE_FILENAME(statnam);
 251                 if (canon_name) {
 252                         /* now, recycle full name */
 253                         fullname = make_ext_string(
 254                                 canon_name, strlen(canon_name), Qfile_name);
 255                 }
 256                 fullname = fname_as_directory(fullname);
 257
 258                 /* now stat statnam */
 259                 if (sxemacs_stat(statnam, &st) == 0 &&
 260                     (st.st_mode & S_IFMT) == S_IFDIR &&
 261                     !NILP(compbf) &&
 262                     !(bloom_owns_p(XBLOOM(compbf), fullname))) {
 263                         dir_p = 1;
 264                 }
 265
 266                 if (canon_name) {
 267                         xfree(canon_name);
 268                 }
 269         }
 270 #else  /* defined(_DIRENT_HAVE_D_TYPE) && USE_D_TYPE */
 271         statnam = (char*)XSTRING_DATA(fullname);
 272         if (sxemacs_stat(statnam, &st) == 0 &&
 273             (st.st_mode & S_IFMT) == S_IFDIR) {
 274                 char *canon_name = NULL;
 275
 276                 /* ugly things may happen when a link
 277                  * points back to a directory in our recurring
 278                  * area, ln -s . foo  is a candidate
 279                  * now, we canonicalise the filename, i.e.
 280                  * resolve all symlinks and afterwards we
 281                  * store it to our companion bloom filter
 282                  * The ugly things are even worse than in the
 283                  * case of D_TYPE, since we !always! have to
 284                  * check against the bloom filter.
 285                  */
 286                 canon_name = CANONICALISE_FILENAME(statnam);
 287
 288                 if (canon_name) {
 289                         /* now, recycle full name */
 290                         fullname = make_ext_string(
 291                                 canon_name, strlen(canon_name),
 292                                 Qfile_name);
 293                 }
 294                 fullname = fname_as_directory(fullname);
 295
 296                 /* now stat statnam */
 297                 if (sxemacs_stat(statnam, &st) == 0 &&
 298                     (st.st_mode & S_IFMT) == S_IFDIR &&
 299                     /* does the bloom know about the dir? */
 300                     !NILP(compbf) &&
 301                     !(bloom_owns_p(XBLOOM(compbf), fullname))) {
 302                         dir_p = 1;
 303                 }
 304
 305                 if (canon_name) {
 306                         xfree(canon_name);
 307                 }
 308         }
 309 #endif /* defined(_DIRENT_HAVE_D_TYPE) && USE_D_TYPE */
 310
 311         /* argh, here is a design flaw!
 312            these operations are not commutable, and it's a
 313            hard-coded how `match' is interpreted.
 314            * There are two possibilites:
 315            * (1) check pathname against `match'
 316            if nil, do not process further
 317            if a directory, recur
 318            if non-nil, add to result according to files_only
 319            * (2) if a directory, recur
 320            check pathname against `match'
 321            if nil, do not add to result
 322            if non-nil, add to result according to files_only
 323            *
 324            * Hm, I think I'd choose the latter variant, it is
 325            not that performant, but it avoids two problems:
 326
 327            - With the former variant it is NOT possible to have
 328            the trivial filenames on the result list, since a
 329            match against "^[.]$" would exclude everything, while
 330            actually it was likely meant to _solely_ exclude "."
 331            from the result list
 332            - Furthermore, we _MUST_ traverse in preorder,
 333            otherwise there is the possibility that pathnames are
 334            on the file list already which turn out later to be
 335            excluded
 336            * Anyone wants to help brainstorming?
 337            */
 338
 339         /* check if we put it on the list of matches */
 340         if (NILP(files_only)) {
 341                 result_p = 1;
 342         } else if (EQ(files_only, Qt) && !dir_p) {
 343                 result_p = 1;
 344         } else if (!EQ(files_only, Qt) && dir_p) {
 345                 result_p = 1;
 346         } else {
 347                 result_p = 0;
 348         }
 349
 350         if (curdepth >= opts->maxdepth) {
 351                 dir_p = 0;
 352         }
 353
 354         if (dir_p) {
 355                 dired_stack_item_t dsi;
 356                 dsi = xnew_and_zero(struct dired_stack_item_s);
 357                 dsi->dir = name;
 358                 dsi->depth = 1+curdepth;
 359                 dired_stack_push(ds, dsi);
 360         }
 361
 362         if (result_p && !NILP(match) && !pathname_matches_p(name, match, bufp)) {
 363                 result_p = 0;
 364         }
 365
 366         if (result_p) {
 367                 dllist_append(XDLLIST(result), (void*)resname);
 368                 /* add the result to the companion bloom-f */
 369                 /* hm, for large trees this yields a bf which
 370                    owns everything :( ... we need far better and
 371                    faster bloom techniques for it -hroptatyr */
 372                 if (!NILP(bloom_filter)) {
 373                         bloom_add(XBLOOM(bloom_filter), resname);
 374                 }
 375         }
 376
 377         UNGCPRO;
 378         return;
 379 }
 380
 381 static void
 382 dfr_outer(Lisp_Object directory, dirent_t *ent,
 383           Lisp_Object compbf, dfr_options_t opts,
 384           Lisp_Object files_only, dired_stack_t ds, Lisp_Object match,
 385           struct re_pattern_buffer *bufp, Lisp_Object result,
 386           Lisp_Object bloom_filter)
 387 {
 388         dired_stack_item_t dir_dpt = dired_stack_pop(ds);
 389         Lisp_Object dir = dir_dpt->dir;
 390         unsigned int dpt = dir_dpt->depth;
 391         Lisp_Object fulldir = Fexpand_file_name(dir, directory);
 392         DIR *d = NULL;
 393         dirent_t *res = NULL;
 394         struct gcpro gcpro1, gcpro2;
 395
 396         GCPRO2(dir, fulldir);
 397
 398         xfree(dir_dpt);
 399
 400         dir = fname_as_directory(dir);
 401         fulldir = fname_as_directory(fulldir);
 402
 403         /* add the full directory name to the companion bloom filter */
 404         if (!NILP(compbf))
 405                 bloom_add(XBLOOM(compbf), fulldir);
 406
 407         /* external format conversion is done in the encapsulation of
 408          * opendir in sysdep.c
 409          */
 410         d = opendir((char*)XSTRING_DATA(fulldir));
 411 #if 0
 412         /* why should we want this? I think spitting a warning
 413          * should suffice
 414          * -hroptatyr
 415          */
 416         if (!d) {
 417                 xfree(ent);
 418                 report_file_error("Opening directory", list1(fulldir));
 419                 return Qnil;
 420         }
 421 #else
 422         if (!d) {
 423                 warn_when_safe(Qfile, Qwarning,
 424                                "Opening directory `%s' failed",
 425                                (char*)XSTRING_DATA(fulldir));
 426                 UNGCPRO;
 427                 return;
 428         }
 429 #endif
 430
 431         record_unwind_protect(close_directory_unwind,
 432                               make_opaque_ptr((void *)d));
 433
 434         while (DFR_READDIR(d, ent, &res) == 0 && res != NULL) {
 435                 dfr_inner(res, fulldir, dir,
 436                           compbf, opts,
 437                           files_only, dpt, ds, match, bufp,
 438                           result, bloom_filter);
 439         }
 440
 441         UNGCPRO;
 442 }
 443
 444 static void
 445 dired_stack_mark(Lisp_Object obj)
 446 {
 447         dired_stack_t ds = get_dynacat(obj);
 448         WITH_DLLIST_TRAVERSE(
 449                 ds,
 450                 dired_stack_item_t dsi = dllist_item;
 451                 mark_object(dsi->dir));
 452         return;
 453 }
 454
 455 #if 1
 456 static void
 457 dired_stack_fini(Lisp_Object obj)
 458 {
 459         dired_stack_t ds = get_dynacat(obj);
 460         free_dired_stack(ds);
 461         return;
 462 }
 463 #endif
 464
 465 static Lisp_Object
 466 directory_files_magic(Lisp_Object directory, Lisp_Object match,
 467                       Lisp_Object files_only, Lisp_Object bloom_filter,
 468                       dfr_options_t opts)
 469 {
 470         /* This function can GC */
 471         Lisp_Object result = wrap_dllist(make_dllist());
 472         Lisp_Object lds = Qnil;
 473         dired_stack_t ds = NULL;
 474         dired_stack_item_t ds_item = NULL;
 475         /* this is a companion bloom filter,
 476          * we register processed directories in here and hence avoid
 477          * processing an entry twice */
 478         Lisp_Object compbf = Qnil;
 479         int speccount = specpdl_depth();
 480         struct re_pattern_buffer *bufp = NULL;
 481         struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 482
 483         ds = new_dired_stack();
 484         lds = make_dynacat(ds);
 485         set_dynacat_marker(lds, dired_stack_mark);
 486         set_dynacat_finaliser(lds, (dynacat_finaliser_f)dired_stack_fini);
 487         GCPRO5(directory, result, compbf, bloom_filter, lds);
 488
 489         /* SXEmacs: this should come after Ffile_name_as_directory() to avoid
 490            potential regexp cache smashage.  It comes before the opendir()
 491            because it might signal an error.  */
 492         if (!NILP(match)) {
 493                 if (STRINGP(match)) {
 494
 495                         /* MATCH might be a flawed regular expression.  Rather
 496                            than catching and signalling our own errors, we just
 497                            call compile_pattern to do the work for us.  */
 498                         bufp = compile_pattern(match, 0, Qnil, 0, ERROR_ME);
 499                         /* Now *bufp is the compiled form of MATCH; don't call
 500                            anything which might compile a new regexp until we
 501                            are done with the loop!  */
 502
 503                 } else if (!NILP(Ffunctionp(match))) {
 504                         ;
 505                 } else {
 506                         return wrong_type_argument(Qstringp, match);
 507                 }
 508         }
 509
 510         regex_match_object = Qnil;
 511         regex_emacs_buffer = current_buffer;
 512
 513         if (opts->maxdepth > 0) {
 514                 compbf = make_bloom(8192, 8);
 515         }
 516
 517         /* set up the directories queue */
 518         ds_item = xnew_and_zero(struct dired_stack_item_s);
 519         ds_item->dir = make_string((Bufbyte*)"", 0);
 520         ds_item->depth = 0;
 521         dired_stack_push(ds, ds_item);
 522
 523         /* alloc the directory entry pointer */
 524         {
 525                 dirent_t _ent, *ent = &_ent;
 526
 527                 /* clean sweep */
 528                 memset(ent, 0, sizeof(dirent_t));
 529
 530                 while (dired_stack_size(ds) > 0) {
 531                         dfr_outer(directory, ent, compbf,
 532                                   opts, files_only, ds, match,
 533                                   bufp, result, bloom_filter);
 534                         /* This will close the dir */
 535                         unbind_to(speccount, Qnil);
 536                         QUIT;
 537                 }
 538         }
 539
 540         /* save the companion bloom filter */
 541         Fput(result, Qcompanion_bf, compbf);
 542
 543         UNGCPRO;
 544         return result;
 545 }
 546
 547 static Lisp_Object
 548 directory_files_canonicalise_dn(Lisp_Object directory)
 549 {
 550         struct gcpro gcpro1;
 551         GCPRO1(directory);
 552
 553         /* expand the directory argument and canonicalise */
 554         directory = Fexpand_file_name(directory, Qnil);
 555         directory = fname_as_directory(directory);
 556
 557         RETURN_UNGCPRO(directory);
 558 }
 559
 560 static Lisp_Object
 561 directory_files_resultify(Lisp_Object result, Lisp_Object result_type)
 562 {
 563         /* This function can GC */
 564         Lisp_Object final_result = Qnil;
 565         struct gcpro gcpro1, gcpro2, gcpro3;
 566         GCPRO3(result, result_type, final_result);
 567
 568         /* see if the user requested a dllist */
 569         if (EQ(result_type, Qdllist)) {
 570                 final_result = result;
 571         } else if (NILP(result_type) || EQ(result_type, Qsorted_list)) {
 572                 final_result = Fdllist_to_list_reversed(result);
 573                 final_result = Fsort(final_result, Qstring_lessp);
 574         } else if (EQ(result_type, Qdesc_sorted_list)) {
 575                 final_result = Fdllist_to_list(result);
 576                 final_result = Fsort(final_result, Qstring_greaterp);
 577         } else if (!NILP(result_type) || EQ(result_type, Qlist)) {
 578                 final_result = Fdllist_to_list(result);
 579         }
 580
 581         UNGCPRO;
 582         return final_result;
 583 }
 584
 585 static Lisp_Object
 586 call9(Lisp_Object fn,
 587       Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
 588       Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5,
 589       Lisp_Object arg6, Lisp_Object arg7, Lisp_Object arg8)
 590 {
 591         /* This function can GC */
 592         struct gcpro gcpro1;
 593         Lisp_Object res, args[10] = {fn, arg0, arg1, arg2, arg3,
 594                                      arg4, arg5, arg6, arg7, arg8};
 595
 596         GCPROn(args, countof(args));
 597         res = Ffuncall(10, args);
 598
 599         UNGCPRO;
 600         return res;
 601 }
 602
 603 \f
 604 EXFUN(Fdirectory_files_recur, 8);
 605
 606 DEFUN("directory-files", Fdirectory_files, 1, 5, 0,     /*
 607 Return a list of names of files in DIRECTORY.
 608 Args are DIRECTORY &optional FULL MATCH RESULT-TYPE FILES_ONLY.
 609
 610 There are four optional arguments:
 611 If FULL is non-nil, absolute pathnames of the files are returned.
 612
 613 If MATCH is non-nil, it may be a string indicating a regular
 614 expression which pathnames must meet in order to be returned.
 615 Moreover, a predicate function can be specified which is called with
 616 one argument, the pathname in question.  On non-nil return value,
 617 the pathname is considered in the final result, otherwise it is
 618 ignored.
 619
 620 Optional argument RESULT-TYPE can be one of:
 621 - sorted-list (default)  to return a list, sorted in alphabetically
 622   ascending order
 623 - desc-sorted-list  to return a list, sorted in alphabetically
 624   descending order
 625 - list  to return an unsorted list
 626 - dllist  to return an unsorted dllist
 627 The two latter types can be useful if you plan to sort the result
 628 yourself, or want to feed the result to further processing.
 629
 630 For compatibility with XEmacs' NOSORT argument to this function,
 631 RESULT-TYPE can also be any non-nil value.  In that case it will
 632 return an unsorted list. (https://issues.sxemacs.org/show_bug.cgi?id=163)
 633
 634 Optional argument FILES-ONLY can be one of:
 635 - t  to return only files and symlinks in DIRECTORY
 636 - nil (default)  to return all entries (files, symlinks, and
 637   subdirectories) in DIRECTORY
 638 - subdir  to return only subdirectories -- but *NOT* symlinks to
 639   directories -- in DIRECTORY
 640 */
 641       (directory, full, match, result_type, files_only))
 642 {
 643         Lisp_Object handler;
 644         Lisp_Object result = Qnil;
 645         struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
 646         struct dfr_options_s opts = {
 647                 .maxdepth = 0,
 648                 .fullp = !NILP(full),
 649                 .symlink_file_p = 0,
 650         };
 651
 652         /* argument checks */
 653         CHECK_STRING(directory);
 654
 655         GCPRO6(directory, full, match, result_type, files_only, result);
 656
 657         directory = directory_files_canonicalise_dn(directory);
 658
 659         /* If the file name has special constructs in it,
 660            call the corresponding file handler.  */
 661         handler = Ffind_file_name_handler(directory, Qdirectory_files);
 662         if (!NILP(handler)) {
 663                 UNGCPRO;
 664                 return call6(handler, Qdirectory_files,
 665                              directory, full, match, result_type, files_only);
 666         }
 667
 668         result = directory_files_magic(directory, match,
 669                                        files_only, /* bloom filter */Qnil,
 670                                        &opts);
 671
 672         UNGCPRO;
 673         return directory_files_resultify(result, result_type);
 674 }
 675
 676 DEFUN("directory-files-recur", Fdirectory_files_recur, 1, 8, 0, /*
 677 Like `directory-files' but recursive and much faster.
 678 Args are DIRECTORY &optional FULL MATCH RESULT_TYPE FILES-ONLY MAXDEPTH
 679 SYMLINK_IS_FILE BLOOM_FILTER
 680
 681 If FULL is non-nil, absolute pathnames of the files are returned.
 682
 683 If MATCH is non-nil, it may be a string indicating a regular
 684 expression which pathnames must meet in order to be returned.
 685 Moreover, a predicate function can be specified which is called with
 686 one argument, the pathname in question.  On non-nil return value,
 687 the pathname is considered in the final result, otherwise it is
 688 ignored.
 689
 690 Optional argument RESULT-TYPE can be one of:
 691 - sorted-list (default)  to return a list, sorted in alphabetically
 692   ascending order
 693 - desc-sorted-list  to return a list, sorted in alphabetically
 694   descending order
 695 - list  to return an unsorted list
 696 - dllist  to return an unsorted dllist
 697 The two latter types can be useful if you plan to sort the result
 698 yourself, or want to feed the result to further processing.
 699
 700 Optional argument FILES-ONLY can be one of:
 701 - t  to return only files and symlinks in DIRECTORY
 702 - nil (default)  to return all entries (files, symlinks, and
 703   subdirectories) in DIRECTORY
 704 - subdir  to return only subdirectories -- but *NOT* symlinks to
 705   directories -- in DIRECTORY
 706
 707 Optional argument MAXDEPTH \(a positive integer\) specifies the
 708 maximal recursion depth, use 0 to emulate old `directory-files'.
 709
 710 Optional argument SYMLINK-IS-FILE specifies whether symlinks
 711 should be resolved \(which is the default behaviour\) or whether
 712 they are treated as ordinary files \(non-nil\), in the latter
 713 case symlinks to directories are not recurred.
 714
 715 Optional argument BLOOM-FILTER specifies a bloom filter where
 716 to put results in addition to the ordinary result list.
 717 */
 718       (directory, full, match, result_type, files_only, maxdepth,
 719        symlink_is_file, bloom_filter))
 720 {
 721         Lisp_Object handler = Qnil, result = Qnil;
 722 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
 723         /* just a convenience array for gc pro'ing */
 724         Lisp_Object args[8] = {
 725                 directory, match, result_type, files_only,
 726                 symlink_is_file, bloom_filter, handler, result};
 727 #endif  /* !BDWGC */
 728         struct dfr_options_s opts = {
 729                 .maxdepth = 64,
 730                 .fullp = !NILP(full),
 731                 .symlink_file_p = !NILP(symlink_is_file),
 732         };
 733         struct gcpro gcpro1;
 734
 735         /* argument checks */
 736         CHECK_STRING(directory);
 737         if (!NILP(maxdepth)) {
 738                 CHECK_NATNUM(maxdepth);
 739                 opts.maxdepth = XUINT(maxdepth);
 740         }
 741
 742         GCPROn(args, countof(args));
 743
 744         directory = directory_files_canonicalise_dn(directory);
 745
 746         /* If the file name has special constructs in it,
 747            call the corresponding file handler.  */
 748         handler = Ffind_file_name_handler(directory, Qdirectory_files_recur);
 749         if (!NILP(handler)) {
 750                 Lisp_Object res;
 751
 752                 res = call9(handler, Qdirectory_files_recur,
 753                             directory, full, match, result_type, files_only,
 754                             maxdepth, symlink_is_file, bloom_filter);
 755                 UNGCPRO;
 756                 return res;
 757         }
 758
 759         result = directory_files_magic(directory, match,
 760                                        files_only, bloom_filter,
 761                                        &opts);
 762         /* convert to final result type */
 763         result = directory_files_resultify(result, result_type);
 764         UNGCPRO;
 765         return result;
 766 }
 767
 768 \f
 769 static Lisp_Object file_name_completion(Lisp_Object file,
 770                                         Lisp_Object directory,
 771                                         int all_flag, int ver_flag);
 772
 773 DEFUN("file-name-completion", Ffile_name_completion, 2, 2, 0,   /*
 774 Complete file name PARTIAL-FILENAME in directory DIRECTORY.
 775 Return the longest prefix common to all file names in DIRECTORY
 776 that start with PARTIAL-FILENAME.
 777 If there is only one and PARTIAL-FILENAME matches it exactly, return t.
 778 Return nil if DIRECTORY contains no name starting with PARTIAL-FILENAME.
 779
 780 File names which end with any member of `completion-ignored-extensions'
 781 are not considered as possible completions for PARTIAL-FILENAME unless
 782 there is no other possible completion. `completion-ignored-extensions'
 783 is not applied to the names of directories.
 784 */
 785       (partial_filename, directory))
 786 {
 787         /* This function can GC.  GC checked 1996.04.06. */
 788         Lisp_Object handler;
 789
 790         /* If the directory name has special constructs in it,
 791            call the corresponding file handler.  */
 792         handler = Ffind_file_name_handler(directory, Qfile_name_completion);
 793         if (!NILP(handler))
 794                 return call3(handler, Qfile_name_completion, partial_filename,
 795                              directory);
 796
 797         /* If the file name has special constructs in it,
 798            call the corresponding file handler.  */
 799         handler =
 800             Ffind_file_name_handler(partial_filename, Qfile_name_completion);
 801         if (!NILP(handler))
 802                 return call3(handler, Qfile_name_completion, partial_filename,
 803                              directory);
 804
 805         return file_name_completion(partial_filename, directory, 0, 0);
 806 }
 807
 808 DEFUN("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
 809 Return a list of all completions of PARTIAL-FILENAME in DIRECTORY.
 810 These are all file names in DIRECTORY which begin with PARTIAL-FILENAME.
 811 */
 812       (partial_filename, directory))
 813 {
 814         /* This function can GC. GC checked 1997.06.04. */
 815         Lisp_Object handler;
 816         struct gcpro gcpro1;
 817
 818         GCPRO1(directory);
 819         directory = Fexpand_file_name(directory, Qnil);
 820         /* If the file name has special constructs in it,
 821            call the corresponding file handler.  */
 822         handler =
 823             Ffind_file_name_handler(directory, Qfile_name_all_completions);
 824         UNGCPRO;
 825         if (!NILP(handler))
 826                 return call3(handler, Qfile_name_all_completions,
 827                              partial_filename, directory);
 828
 829         return file_name_completion(partial_filename, directory, 1, 0);
 830 }
 831
 832 static int
 833 file_name_completion_stat(Lisp_Object directory, DIRENTRY * dp,
 834                           struct stat *st_addr)
 835 {
 836         Bytecount len = NAMLEN(dp);
 837         Bytecount pos = XSTRING_LENGTH(directory);
 838         int value;
 839         char *fullname = (char *)alloca(len + pos + 2);
 840
 841         memcpy(fullname, XSTRING_DATA(directory), pos);
 842         if (!IS_DIRECTORY_SEP(fullname[pos - 1]))
 843                 fullname[pos++] = DIRECTORY_SEP;
 844
 845         memcpy(fullname + pos, dp->d_name, len);
 846         fullname[pos + len] = 0;
 847
 848 #ifdef S_IFLNK
 849         /* We want to return success if a link points to a nonexistent file,
 850            but we want to return the status for what the link points to,
 851            in case it is a directory.  */
 852         value = lstat(fullname, st_addr);
 853         if (S_ISLNK(st_addr->st_mode))
 854                 (void)sxemacs_stat(fullname, st_addr);
 855 #else
 856         value = sxemacs_stat(fullname, st_addr);
 857 #endif
 858         return value;
 859 }
 860
 861 static Lisp_Object file_name_completion_unwind(Lisp_Object locative)
 862 {
 863         DIR *d;
 864         Lisp_Object obj = XCAR(locative);
 865
 866         if (!NILP(obj)) {
 867                 d = (DIR *) get_opaque_ptr(obj);
 868                 closedir(d);
 869                 free_opaque_ptr(obj);
 870         }
 871         free_cons(XCONS(locative));
 872         return Qnil;
 873 }
 874
 875 static Lisp_Object
 876 file_name_completion(Lisp_Object file, Lisp_Object directory, int all_flag,
 877                      int ver_flag)
 878 {
 879         /* This function can GC */
 880         DIR *d = 0;
 881         int matchcount = 0;
 882         Lisp_Object bestmatch = Qnil;
 883         Charcount bestmatchsize = 0;
 884         struct stat st;
 885         int passcount;
 886         int speccount = specpdl_depth();
 887         Charcount file_name_length;
 888         Lisp_Object locative;
 889         struct gcpro gcpro1, gcpro2, gcpro3;
 890
 891         GCPRO3(file, directory, bestmatch);
 892
 893         CHECK_STRING(file);
 894
 895 #ifdef FILE_SYSTEM_CASE
 896         file = FILE_SYSTEM_CASE(file);
 897 #endif
 898         directory = Fexpand_file_name(directory, Qnil);
 899         file_name_length = XSTRING_CHAR_LENGTH(file);
 900
 901         /* With passcount = 0, ignore files that end in an ignored extension.
 902            If nothing found then try again with passcount = 1, don't ignore them.
 903            If looking for all completions, start with passcount = 1,
 904            so always take even the ignored ones.
 905
 906            ** It would not actually be helpful to the user to ignore any possible
 907            completions when making a list of them.**  */
 908
 909         /* We cannot use close_directory_unwind() because we change the
 910            directory.  The old code used to just avoid signaling errors, and
 911            call closedir, but it was wrong, because it made sane handling of
 912            QUIT impossible and, besides, various utility functions like
 913            regexp_ignore_completion_p can signal errors.  */
 914         locative = noseeum_cons(Qnil, Qnil);
 915         record_unwind_protect(file_name_completion_unwind, locative);
 916
 917         for (passcount = !!all_flag; NILP(bestmatch) && passcount < 2;
 918              passcount++) {
 919                 Lisp_Object tmp_dfn = Fdirectory_file_name(directory);
 920                 d = opendir((char *)XSTRING_DATA(tmp_dfn));
 921                 if (!d) {
 922                         report_file_error("Opening directory",
 923                                           list1(directory));
 924                 }
 925                 XCAR(locative) = make_opaque_ptr((void *)d);
 926
 927                 /* Loop reading blocks */
 928                 while (1) {
 929                         DIRENTRY *dp;
 930                         Bytecount len;
 931                         /* scmp() works in characters, not bytes, so we have to compute
 932                            this value: */
 933                         Charcount cclen;
 934                         int directoryp;
 935                         int ignored_extension_p = 0;
 936                         Bufbyte *d_name;
 937
 938                         dp = readdir(d);
 939                         if (!dp)
 940                                 break;
 941
 942                         /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates.  */
 943                         d_name = (Bufbyte *) dp->d_name;
 944                         len = NAMLEN(dp);
 945                         cclen = bytecount_to_charcount(d_name, len);
 946
 947                         QUIT;
 948
 949                         if (!DIRENTRY_NONEMPTY(dp)
 950                             || cclen < file_name_length
 951                             || 0 <= scmp(d_name, XSTRING_DATA(file),
 952                                          file_name_length))
 953                                 continue;
 954
 955                         if (file_name_completion_stat(directory, dp, &st) < 0)
 956                                 continue;
 957
 958                         directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
 959                         if (directoryp) {
 960                                 /* "." and ".." are never interesting as completions, but are
 961                                    actually in the way in a directory containing only one file.  */
 962                                 if (!passcount
 963                                     && TRIVIAL_DIRECTORY_ENTRY(dp->d_name))
 964                                         continue;
 965                         } else {
 966                                 /* Compare extensions-to-be-ignored against end of this file name */
 967                                 /* if name is not an exact match against specified string.  */
 968                                 if (!passcount && cclen > file_name_length) {
 969                                         Lisp_Object tem;
 970                                         /* and exit this for loop if a match is found */
 971                                         EXTERNAL_LIST_LOOP(tem,
 972                                                            Vcompletion_ignored_extensions)
 973                                         {
 974                                                 Lisp_Object elt = XCAR(tem);
 975                                                 Charcount skip;
 976
 977                                                 CHECK_STRING(elt);
 978
 979                                                 skip =
 980                                                     cclen -
 981                                                     XSTRING_CHAR_LENGTH(elt);
 982                                                 if (skip < 0)
 983                                                         continue;
 984
 985                                                 if (0 >
 986                                                     scmp(charptr_n_addr
 987                                                          (d_name, skip),
 988                                                          XSTRING_DATA(elt),
 989                                                          XSTRING_CHAR_LENGTH
 990                                                          (elt))) {
 991                                                         ignored_extension_p = 1;
 992                                                         break;
 993                                                 }
 994                                         }
 995                                 }
 996                         }
 997
 998                         /* If an ignored-extensions match was found,
 999                            don't process this name as a completion.  */
1000                         if (!passcount && ignored_extension_p)
1001                                 continue;
1002
1003                         if (!passcount
1004                             && regexp_ignore_completion_p(d_name, Qnil, 0,
1005                                                           cclen))
1006                                 continue;
1007
1008                         /* Update computation of how much all possible completions match */
1009                         matchcount++;
1010
1011                         if (all_flag || NILP(bestmatch)) {
1012                                 Lisp_Object name = Qnil;
1013                                 struct gcpro ngcpro1;
1014                                 NGCPRO1(name);
1015                                 /* This is a possible completion */
1016                                 name = make_string(d_name, len);
1017                                 if (directoryp) /* Completion is a directory; end it with '/' */
1018                                         name = Ffile_name_as_directory(name);
1019                                 if (all_flag) {
1020                                         bestmatch = Fcons(name, bestmatch);
1021                                 } else {
1022                                         bestmatch = name;
1023                                         bestmatchsize =
1024                                             XSTRING_CHAR_LENGTH(name);
1025                                 }
1026                                 NUNGCPRO;
1027                         } else {
1028                                 Charcount compare = min(bestmatchsize, cclen);
1029                                 Bufbyte *p1 = XSTRING_DATA(bestmatch);
1030                                 Bufbyte *p2 = d_name;
1031                                 Charcount matchsize = scmp(p1, p2, compare);
1032
1033                                 if (matchsize < 0)
1034                                         matchsize = compare;
1035                                 if (completion_ignore_case) {
1036                                         /* If this is an exact match except for case,
1037                                            use it as the best match rather than one that is not
1038                                            an exact match.  This way, we get the case pattern
1039                                            of the actual match.  */
1040                                         if ((matchsize == cclen
1041                                              && matchsize + !!directoryp
1042                                              < XSTRING_CHAR_LENGTH(bestmatch))
1043                                             ||
1044                                             /* If there is no exact match ignoring case,
1045                                                prefer a match that does not change the case
1046                                                of the input.  */
1047                                             (((matchsize == cclen)
1048                                               ==
1049                                               (matchsize + !!directoryp
1050                                                ==
1051                                                XSTRING_CHAR_LENGTH(bestmatch)))
1052                                              /* If there is more than one exact match aside from
1053                                                 case, and one of them is exact including case,
1054                                                 prefer that one.  */
1055                                              && 0 > scmp_1(p2,
1056                                                            XSTRING_DATA(file),
1057                                                            file_name_length, 0)
1058                                              && 0 <= scmp_1(p1,
1059                                                             XSTRING_DATA(file),
1060                                                             file_name_length,
1061                                                             0))) {
1062                                                 bestmatch =
1063                                                     make_string(d_name, len);
1064                                                 if (directoryp)
1065                                                         bestmatch =
1066                                                             Ffile_name_as_directory
1067                                                             (bestmatch);
1068                                         }
1069                                 }
1070
1071                                 /* If this directory all matches,
1072                                    see if implicit following slash does too.  */
1073                                 if (directoryp
1074                                     && compare == matchsize
1075                                     && bestmatchsize > matchsize
1076                                     &&
1077                                     IS_ANY_SEP(charptr_emchar_n(p1, matchsize)))
1078                                         matchsize++;
1079                                 bestmatchsize = matchsize;
1080                         }
1081                 }
1082                 closedir(d);
1083                 free_opaque_ptr(XCAR(locative));
1084                 XCAR(locative) = Qnil;
1085         }
1086
1087         unbind_to(speccount, Qnil);
1088
1089         UNGCPRO;
1090
1091         if (all_flag || NILP(bestmatch))
1092                 return bestmatch;
1093         if (matchcount == 1 && bestmatchsize == file_name_length)
1094                 return Qt;
1095         return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1096 }
1097 \f
1098 static Lisp_Object user_name_completion(Lisp_Object user,
1099                                         int all_flag, int *uniq);
1100
1101 DEFUN("user-name-completion", Fuser_name_completion, 1, 1, 0,   /*
1102 Complete user name from PARTIAL-USERNAME.
1103 Return the longest prefix common to all user names starting with
1104 PARTIAL-USERNAME.  If there is only one and PARTIAL-USERNAME matches
1105 it exactly, returns t.  Return nil if there is no user name starting
1106 with PARTIAL-USERNAME.
1107 */
1108       (partial_username))
1109 {
1110         return user_name_completion(partial_username, 0, NULL);
1111 }
1112
1113 DEFUN("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0,       /*
1114 Complete user name from PARTIAL-USERNAME.
1115
1116 This function is identical to `user-name-completion', except that
1117 the cons of the completion and an indication of whether the
1118 completion was unique is returned.
1119
1120 The car of the returned value is the longest prefix common to all user
1121 names that start with PARTIAL-USERNAME.  If there is only one and
1122 PARTIAL-USERNAME matches it exactly, the car is t.  The car is nil if
1123 there is no user name starting with PARTIAL-USERNAME.  The cdr of the
1124 result is non-nil if and only if the completion returned in the car
1125 was unique.
1126 */
1127       (partial_username))
1128 {
1129         int uniq;
1130         Lisp_Object completed =
1131             user_name_completion(partial_username, 0, &uniq);
1132         return Fcons(completed, uniq ? Qt : Qnil);
1133 }
1134
1135 DEFUN("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
1136 Return a list of all user name completions from PARTIAL-USERNAME.
1137 These are all the user names which begin with PARTIAL-USERNAME.
1138 */
1139       (partial_username))
1140 {
1141         return user_name_completion(partial_username, 1, NULL);
1142 }
1143
1144 struct user_name {
1145         Bufbyte *ptr;
1146         size_t len;
1147 };
1148
1149 struct user_cache {
1150         struct user_name *user_names;
1151         int length;
1152         int size;
1153         EMACS_TIME last_rebuild_time;
1154 };
1155 static struct user_cache user_cache;
1156
1157 static void free_user_cache(struct user_cache *cache)
1158 {
1159         int i;
1160         for (i = 0; i < cache->length; i++)
1161                 xfree(cache->user_names[i].ptr);
1162         xfree(cache->user_names);
1163         xzero(*cache);
1164 }
1165
1166 static Lisp_Object user_name_completion_unwind(Lisp_Object cache_incomplete_p)
1167 {
1168         endpwent();
1169         speed_up_interrupts();
1170
1171         if (!NILP(XCAR(cache_incomplete_p)))
1172                 free_user_cache(&user_cache);
1173
1174         free_cons(XCONS(cache_incomplete_p));
1175
1176         return Qnil;
1177 }
1178
1179 #define  USER_CACHE_TTL  (24*60*60)     /* Time to live: 1 day, in seconds */
1180
1181 static Lisp_Object
1182 user_name_completion(Lisp_Object user, int all_flag, int *uniq)
1183 {
1184         /* This function can GC */
1185         int matchcount = 0;
1186         Lisp_Object bestmatch = Qnil;
1187         Charcount bestmatchsize = 0;
1188         Charcount user_name_length;
1189         EMACS_TIME t;
1190         int i;
1191         struct gcpro gcpro1, gcpro2;
1192
1193         GCPRO2(user, bestmatch);
1194
1195         CHECK_STRING(user);
1196
1197         user_name_length = XSTRING_CHAR_LENGTH(user);
1198
1199         /* Cache user name lookups because it tends to be quite slow.
1200          * Rebuild the cache occasionally to catch changes */
1201         EMACS_GET_TIME(t);
1202         if (user_cache.user_names &&
1203             (EMACS_SECS(t) - EMACS_SECS(user_cache.last_rebuild_time)
1204              > USER_CACHE_TTL))
1205                 free_user_cache(&user_cache);
1206
1207         if (!user_cache.user_names) {
1208                 struct passwd *pwd;
1209                 Lisp_Object cache_incomplete_p = noseeum_cons(Qt, Qnil);
1210                 int speccount = specpdl_depth();
1211
1212                 slow_down_interrupts();
1213                 setpwent();
1214                 record_unwind_protect(user_name_completion_unwind,
1215                                       cache_incomplete_p);
1216                 while ((pwd = getpwent())) {
1217                         QUIT;
1218                         DO_REALLOC(user_cache.user_names, user_cache.size,
1219                                    user_cache.length + 1, struct user_name);
1220                         TO_INTERNAL_FORMAT(C_STRING, pwd->pw_name,
1221                                            MALLOC,
1222                                            (user_cache.
1223                                             user_names[user_cache.length].ptr,
1224                                             user_cache.user_names[user_cache.
1225                                                                   length].len),
1226                                            Qnative);
1227                         user_cache.length++;
1228                 }
1229                 XCAR(cache_incomplete_p) = Qnil;
1230                 unbind_to(speccount, Qnil);
1231
1232                 EMACS_GET_TIME(user_cache.last_rebuild_time);
1233         }
1234
1235         for (i = 0; i < user_cache.length; i++) {
1236                 Bufbyte *u_name = user_cache.user_names[i].ptr;
1237                 Bytecount len = user_cache.user_names[i].len;
1238                 /* scmp() works in chars, not bytes, so we have to compute this: */
1239                 Charcount cclen = bytecount_to_charcount(u_name, len);
1240
1241                 QUIT;
1242
1243                 if (cclen < user_name_length
1244                     || 0 <= scmp_1(u_name, XSTRING_DATA(user), user_name_length,
1245                                    0))
1246                         continue;
1247
1248                 matchcount++;   /* count matching completions */
1249
1250                 if (all_flag || NILP(bestmatch)) {
1251                         Lisp_Object name = Qnil;
1252                         struct gcpro ngcpro1;
1253                         NGCPRO1(name);
1254                         /* This is a possible completion */
1255                         name = make_string(u_name, len);
1256                         if (all_flag) {
1257                                 bestmatch = Fcons(name, bestmatch);
1258                         } else {
1259                                 bestmatch = name;
1260                                 bestmatchsize = XSTRING_CHAR_LENGTH(name);
1261                         }
1262                         NUNGCPRO;
1263                 } else {
1264                         Charcount compare = min(bestmatchsize, cclen);
1265                         Bufbyte *p1 = XSTRING_DATA(bestmatch);
1266                         Bufbyte *p2 = u_name;
1267                         Charcount matchsize = scmp_1(p1, p2, compare, 0);
1268
1269                         if (matchsize < 0)
1270                                 matchsize = compare;
1271
1272                         bestmatchsize = matchsize;
1273                 }
1274         }
1275
1276         UNGCPRO;
1277
1278         if (uniq)
1279                 *uniq = (matchcount == 1);
1280
1281         if (all_flag || NILP(bestmatch))
1282                 return bestmatch;
1283         if (matchcount == 1 && bestmatchsize == user_name_length)
1284                 return Qt;
1285         return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1286 }
1287 \f
1288 Lisp_Object make_directory_hash_table(const char *path)
1289 {
1290         DIR *d;
1291         if ((d = opendir(path))) {
1292                 DIRENTRY *dp;
1293                 Lisp_Object hash =
1294                     make_lisp_hash_table(20, HASH_TABLE_NON_WEAK,
1295                                          HASH_TABLE_EQUAL);
1296
1297                 while ((dp = readdir(d))) {
1298                         Bytecount len = NAMLEN(dp);
1299                         if (DIRENTRY_NONEMPTY(dp))
1300                                 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates.  */
1301                                 Fputhash(make_string
1302                                          ((Bufbyte *) dp->d_name, len), Qt,
1303                                          hash);
1304                 }
1305                 closedir(d);
1306                 return hash;
1307         } else
1308                 return Qnil;
1309 }
1310 \f
1311 #if 0
1312 /* ... never used ... should use list2 directly anyway ... */
1313 /* NOTE: This function can never return a negative value. */
1314 Lisp_Object wasteful_word_to_lisp(unsigned int item)
1315 {
1316         /* Compatibility: in other versions, file-attributes returns a LIST
1317            of two 16 bit integers... */
1318         Lisp_Object cons = word_to_lisp(item);
1319         XCDR(cons) = Fcons(XCDR(cons), Qnil);
1320         return cons;
1321 }
1322 #endif
1323
1324 DEFUN("file-attributes", Ffile_attributes, 1, 1, 0,     /*
1325 Return a list of attributes of file FILENAME.
1326 Value is nil if specified file cannot be opened.
1327 Otherwise, list elements are:
1328 0. t for directory, string (name linked to) for symbolic link, or nil.
1329 1. Number of links to file.
1330 2. File uid.
1331 3. File gid.
1332 4. Last access time, as a list of two integers.
1333 First integer has high-order 16 bits of time, second has low 16 bits.
1334 5. Last modification time, likewise.
1335 6. Last status change time, likewise.
1336 7. Size in bytes. (-1, if number is out of range).
1337 8. File modes, as a string of ten letters or dashes as in ls -l.
1338 9. t iff file's gid would change if file were deleted and recreated.
1339 10. inode number.
1340 11. Device number.
1341
1342 If file does not exist, returns nil.
1343 */
1344       (filename))
1345 {
1346         /* This function can GC. GC checked 1997.06.04. */
1347         Lisp_Object values[12];
1348 #if defined (BSD4_2) || defined (BSD4_3) ||     \
1349         !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1350         Lisp_Object directory = Qnil;
1351 #endif  /* BSD4_2 || BSD4_3 || !BDWGC */
1352         struct stat s;
1353         char modes[10];
1354         Lisp_Object handler;
1355         struct gcpro gcpro1, gcpro2;
1356
1357         GCPRO2(filename, directory);
1358         filename = Fexpand_file_name(filename, Qnil);
1359
1360         /* If the file name has special constructs in it,
1361            call the corresponding file handler.  */
1362         handler = Ffind_file_name_handler(filename, Qfile_attributes);
1363         if (!NILP(handler)) {
1364                 UNGCPRO;
1365                 return call2(handler, Qfile_attributes, filename);
1366         }
1367
1368         if (lstat((char *)XSTRING_DATA(filename), &s) < 0) {
1369                 UNGCPRO;
1370                 return Qnil;
1371         }
1372 #ifdef BSD4_2
1373         directory = Ffile_name_directory(filename);
1374 #endif
1375
1376         switch (s.st_mode & S_IFMT) {
1377         default:
1378                 values[0] = Qnil;
1379                 break;
1380         case S_IFDIR:
1381                 values[0] = Qt;
1382                 break;
1383 #ifdef S_IFLNK
1384         case S_IFLNK:
1385                 values[0] = Ffile_symlink_p(filename);
1386                 break;
1387 #endif
1388         }
1389         values[1] = make_int(s.st_nlink);
1390         values[2] = make_int(s.st_uid);
1391         values[3] = make_int(s.st_gid);
1392         values[4] = make_time(s.st_atime);
1393         values[5] = make_time(s.st_mtime);
1394         values[6] = make_time(s.st_ctime);
1395         values[7] = make_int((EMACS_INT) s.st_size);
1396         /* If the size is out of range, give back -1.  */
1397         /* #### Fix when Emacs gets bignums! */
1398         if (XINT(values[7]) != s.st_size)
1399                 values[7] = make_int(-1);
1400         filemodestring(&s, modes);
1401         values[8] = make_string((Bufbyte *) modes, 10);
1402 #if defined (BSD4_2) || defined (BSD4_3)        /* file gid will be dir gid */
1403         {
1404                 struct stat sdir;
1405
1406                 if (!NILP(directory)
1407                     && sxemacs_stat((char *)XSTRING_DATA(directory), &sdir) == 0)
1408                         values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
1409                 else            /* if we can't tell, assume worst */
1410                         values[9] = Qt;
1411         }
1412 #else                           /* file gid will be egid */
1413         values[9] = (s.st_gid != getegid())? Qt : Qnil;
1414 #endif                          /* BSD4_2 or BSD4_3 */
1415         values[10] = make_int(s.st_ino);
1416         values[11] = make_int(s.st_dev);
1417         UNGCPRO;
1418         return Flist(countof(values), values);
1419 }
1420
1421 \f
1422 /************************************************************************/
1423 /*                            initialization                            */
1424 /************************************************************************/
1425
1426 void syms_of_dired(void)
1427 {
1428         defsymbol(&Qdirectory_files, "directory-files");
1429         defsymbol(&Qdirectory_files_recur, "directory-files-recur");
1430         defsymbol(&Qfile_name_completion, "file-name-completion");
1431         defsymbol(&Qfile_name_all_completions, "file-name-all-completions");
1432         defsymbol(&Qfile_attributes, "file-attributes");
1433
1434         defsymbol(&Qcompanion_bf, "companion-bf");
1435         defsymbol(&Qsorted_list, "sorted-list");
1436         defsymbol(&Qdesc_sorted_list, "desc-sorted-list");
1437         defsymbol(&Qunsorted_list, "unsorted-list");
1438
1439         DEFSUBR(Fdirectory_files);
1440         DEFSUBR(Fdirectory_files_recur);
1441         DEFSUBR(Ffile_name_completion);
1442         DEFSUBR(Ffile_name_all_completions);
1443         DEFSUBR(Fuser_name_completion);
1444         DEFSUBR(Fuser_name_completion_1);
1445         DEFSUBR(Fuser_name_all_completions);
1446         DEFSUBR(Ffile_attributes);
1447 }
1448
1449 void vars_of_dired(void)
1450 {
1451         DEFVAR_LISP("completion-ignored-extensions", &Vcompletion_ignored_extensions    /*
1452 *Completion ignores filenames ending in any string in this list.
1453 This variable does not affect lists of possible completions,
1454 but does affect the commands that actually do completions.
1455 It is used by the function `file-name-completion'.
1456                                                                                          */ );
1457         Vcompletion_ignored_extensions = Qnil;
1458
1459         DEFVAR_LISP("directory-files-no-trivial-p",
1460                     &Vdirectory_files_no_trivial_p      /*
1461 Determine whether to _not_ add the trivial directory entries
1462 `.' and `..'.
1463 ATTENTION: This variable is definitely NOT for users.
1464 For easy temporary circumvention use a let binding.
1465                                                         */ );
1466         Vdirectory_files_no_trivial_p = Qnil;
1467 }