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         GCPRO6(directory, full, match, result_type, files_only, result);
 652
 653         directory = directory_files_canonicalise_dn(directory);
 654
 655         /* If the file name has special constructs in it,
 656            call the corresponding file handler.  */
 657         handler = Ffind_file_name_handler(directory, Qdirectory_files);
 658         if (!NILP(handler)) {
 659                 UNGCPRO;
 660                 return call6(handler, Qdirectory_files,
 661                              directory, full, match, result_type, files_only);
 662         }
 663
 664         result = directory_files_magic(directory, match,
 665                                        files_only, /* bloom filter */Qnil,
 666                                        &opts);
 667
 668         UNGCPRO;
 669         return directory_files_resultify(result, result_type);
 670 }
 671
 672 DEFUN("directory-files-recur", Fdirectory_files_recur, 1, 8, 0, /*
 673 Like `directory-files' but recursive and much faster.
 674 Args are DIRECTORY &optional FULL MATCH RESULT_TYPE FILES-ONLY MAXDEPTH
 675 SYMLINK_IS_FILE BLOOM_FILTER
 676
 677 If FULL is non-nil, absolute pathnames of the files are returned.
 678
 679 If MATCH is non-nil, it may be a string indicating a regular
 680 expression which pathnames must meet in order to be returned.
 681 Moreover, a predicate function can be specified which is called with
 682 one argument, the pathname in question.  On non-nil return value,
 683 the pathname is considered in the final result, otherwise it is
 684 ignored.
 685
 686 Optional argument RESULT-TYPE can be one of:
 687 - sorted-list (default)  to return a list, sorted in alphabetically
 688   ascending order
 689 - desc-sorted-list  to return a list, sorted in alphabetically
 690   descending order
 691 - list  to return an unsorted list
 692 - dllist  to return an unsorted dllist
 693 The two latter types can be useful if you plan to sort the result
 694 yourself, or want to feed the result to further processing.
 695
 696 Optional argument FILES-ONLY can be one of:
 697 - t  to return only files and symlinks in DIRECTORY
 698 - nil (default)  to return all entries (files, symlinks, and
 699   subdirectories) in DIRECTORY
 700 - subdir  to return only subdirectories -- but *NOT* symlinks to
 701   directories -- in DIRECTORY
 702
 703 Optional argument MAXDEPTH \(a positive integer\) specifies the
 704 maximal recursion depth, use 0 to emulate old `directory-files'.
 705
 706 Optional argument SYMLINK-IS-FILE specifies whether symlinks
 707 should be resolved \(which is the default behaviour\) or whether
 708 they are treated as ordinary files \(non-nil\), in the latter
 709 case symlinks to directories are not recurred.
 710
 711 Optional argument BLOOM-FILTER specifies a bloom filter where
 712 to put results in addition to the ordinary result list.
 713 */
 714       (directory, full, match, result_type, files_only, maxdepth,
 715        symlink_is_file, bloom_filter))
 716 #if 0
 717       (int nargs, Lisp_Object *args))
 718 #endif
 719 {
 720         Lisp_Object handler = Qnil, result = Qnil;
 721 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
 722         /* just a convenience array for gc pro'ing */
 723         Lisp_Object args[8] = {
 724                 directory, match, result_type, files_only,
 725                 symlink_is_file, bloom_filter, handler, result};
 726 #endif  /* !BDWGC */
 727         struct dfr_options_s opts = {
 728                 .maxdepth = 64,
 729                 .fullp = !NILP(full),
 730                 .symlink_file_p = !NILP(symlink_is_file),
 731         };
 732         struct gcpro gcpro1;
 733
 734         /* argument checks */
 735         CHECK_STRING(directory);
 736         if (!NILP(match)) {
 737                 CHECK_STRING(match);
 738         }
 739         if (!NILP(maxdepth)) {
 740                 CHECK_NATNUM(maxdepth);
 741                 opts.maxdepth = XUINT(maxdepth);
 742         }
 743
 744         GCPROn(args, countof(args));
 745
 746         directory = directory_files_canonicalise_dn(directory);
 747
 748         /* If the file name has special constructs in it,
 749            call the corresponding file handler.  */
 750         handler = Ffind_file_name_handler(directory, Qdirectory_files_recur);
 751         if (!NILP(handler)) {
 752                 Lisp_Object res;
 753
 754                 res = call9(handler, Qdirectory_files_recur,
 755                             directory, full, match, result_type, files_only,
 756                             maxdepth, symlink_is_file, bloom_filter);
 757                 UNGCPRO;
 758                 return res;
 759         }
 760
 761         result = directory_files_magic(directory, match,
 762                                        files_only, bloom_filter,
 763                                        &opts);
 764         /* convert to final result type */
 765         result = directory_files_resultify(result, result_type);
 766         UNGCPRO;
 767         return result;
 768 }
 769
 770 \f
 771 static Lisp_Object file_name_completion(Lisp_Object file,
 772                                         Lisp_Object directory,
 773                                         int all_flag, int ver_flag);
 774
 775 DEFUN("file-name-completion", Ffile_name_completion, 2, 2, 0,   /*
 776 Complete file name PARTIAL-FILENAME in directory DIRECTORY.
 777 Return the longest prefix common to all file names in DIRECTORY
 778 that start with PARTIAL-FILENAME.
 779 If there is only one and PARTIAL-FILENAME matches it exactly, return t.
 780 Return nil if DIRECTORY contains no name starting with PARTIAL-FILENAME.
 781
 782 File names which end with any member of `completion-ignored-extensions'
 783 are not considered as possible completions for PARTIAL-FILENAME unless
 784 there is no other possible completion. `completion-ignored-extensions'
 785 is not applied to the names of directories.
 786 */
 787       (partial_filename, directory))
 788 {
 789         /* This function can GC.  GC checked 1996.04.06. */
 790         Lisp_Object handler;
 791
 792         /* If the directory name has special constructs in it,
 793            call the corresponding file handler.  */
 794         handler = Ffind_file_name_handler(directory, Qfile_name_completion);
 795         if (!NILP(handler))
 796                 return call3(handler, Qfile_name_completion, partial_filename,
 797                              directory);
 798
 799         /* If the file name has special constructs in it,
 800            call the corresponding file handler.  */
 801         handler =
 802             Ffind_file_name_handler(partial_filename, Qfile_name_completion);
 803         if (!NILP(handler))
 804                 return call3(handler, Qfile_name_completion, partial_filename,
 805                              directory);
 806
 807         return file_name_completion(partial_filename, directory, 0, 0);
 808 }
 809
 810 DEFUN("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
 811 Return a list of all completions of PARTIAL-FILENAME in DIRECTORY.
 812 These are all file names in DIRECTORY which begin with PARTIAL-FILENAME.
 813 */
 814       (partial_filename, directory))
 815 {
 816         /* This function can GC. GC checked 1997.06.04. */
 817         Lisp_Object handler;
 818         struct gcpro gcpro1;
 819
 820         GCPRO1(directory);
 821         directory = Fexpand_file_name(directory, Qnil);
 822         /* If the file name has special constructs in it,
 823            call the corresponding file handler.  */
 824         handler =
 825             Ffind_file_name_handler(directory, Qfile_name_all_completions);
 826         UNGCPRO;
 827         if (!NILP(handler))
 828                 return call3(handler, Qfile_name_all_completions,
 829                              partial_filename, directory);
 830
 831         return file_name_completion(partial_filename, directory, 1, 0);
 832 }
 833
 834 static int
 835 file_name_completion_stat(Lisp_Object directory, DIRENTRY * dp,
 836                           struct stat *st_addr)
 837 {
 838         Bytecount len = NAMLEN(dp);
 839         Bytecount pos = XSTRING_LENGTH(directory);
 840         int value;
 841         char *fullname = (char *)alloca(len + pos + 2);
 842
 843         memcpy(fullname, XSTRING_DATA(directory), pos);
 844         if (!IS_DIRECTORY_SEP(fullname[pos - 1]))
 845                 fullname[pos++] = DIRECTORY_SEP;
 846
 847         memcpy(fullname + pos, dp->d_name, len);
 848         fullname[pos + len] = 0;
 849
 850 #ifdef S_IFLNK
 851         /* We want to return success if a link points to a nonexistent file,
 852            but we want to return the status for what the link points to,
 853            in case it is a directory.  */
 854         value = lstat(fullname, st_addr);
 855         if (S_ISLNK(st_addr->st_mode))
 856                 (void)sxemacs_stat(fullname, st_addr);
 857 #else
 858         value = sxemacs_stat(fullname, st_addr);
 859 #endif
 860         return value;
 861 }
 862
 863 static Lisp_Object file_name_completion_unwind(Lisp_Object locative)
 864 {
 865         DIR *d;
 866         Lisp_Object obj = XCAR(locative);
 867
 868         if (!NILP(obj)) {
 869                 d = (DIR *) get_opaque_ptr(obj);
 870                 closedir(d);
 871                 free_opaque_ptr(obj);
 872         }
 873         free_cons(XCONS(locative));
 874         return Qnil;
 875 }
 876
 877 static Lisp_Object
 878 file_name_completion(Lisp_Object file, Lisp_Object directory, int all_flag,
 879                      int ver_flag)
 880 {
 881         /* This function can GC */
 882         DIR *d = 0;
 883         int matchcount = 0;
 884         Lisp_Object bestmatch = Qnil;
 885         Charcount bestmatchsize = 0;
 886         struct stat st;
 887         int passcount;
 888         int speccount = specpdl_depth();
 889         Charcount file_name_length;
 890         Lisp_Object locative;
 891         struct gcpro gcpro1, gcpro2, gcpro3;
 892
 893         GCPRO3(file, directory, bestmatch);
 894
 895         CHECK_STRING(file);
 896
 897 #ifdef FILE_SYSTEM_CASE
 898         file = FILE_SYSTEM_CASE(file);
 899 #endif
 900         directory = Fexpand_file_name(directory, Qnil);
 901         file_name_length = XSTRING_CHAR_LENGTH(file);
 902
 903         /* With passcount = 0, ignore files that end in an ignored extension.
 904            If nothing found then try again with passcount = 1, don't ignore them.
 905            If looking for all completions, start with passcount = 1,
 906            so always take even the ignored ones.
 907
 908            ** It would not actually be helpful to the user to ignore any possible
 909            completions when making a list of them.**  */
 910
 911         /* We cannot use close_directory_unwind() because we change the
 912            directory.  The old code used to just avoid signaling errors, and
 913            call closedir, but it was wrong, because it made sane handling of
 914            QUIT impossible and, besides, various utility functions like
 915            regexp_ignore_completion_p can signal errors.  */
 916         locative = noseeum_cons(Qnil, Qnil);
 917         record_unwind_protect(file_name_completion_unwind, locative);
 918
 919         for (passcount = !!all_flag; NILP(bestmatch) && passcount < 2;
 920              passcount++) {
 921                 Lisp_Object tmp_dfn = Fdirectory_file_name(directory);
 922                 d = opendir((char *)XSTRING_DATA(tmp_dfn));
 923                 if (!d) {
 924                         report_file_error("Opening directory",
 925                                           list1(directory));
 926                 }
 927                 XCAR(locative) = make_opaque_ptr((void *)d);
 928
 929                 /* Loop reading blocks */
 930                 while (1) {
 931                         DIRENTRY *dp;
 932                         Bytecount len;
 933                         /* scmp() works in characters, not bytes, so we have to compute
 934                            this value: */
 935                         Charcount cclen;
 936                         int directoryp;
 937                         int ignored_extension_p = 0;
 938                         Bufbyte *d_name;
 939
 940                         dp = readdir(d);
 941                         if (!dp)
 942                                 break;
 943
 944                         /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates.  */
 945                         d_name = (Bufbyte *) dp->d_name;
 946                         len = NAMLEN(dp);
 947                         cclen = bytecount_to_charcount(d_name, len);
 948
 949                         QUIT;
 950
 951                         if (!DIRENTRY_NONEMPTY(dp)
 952                             || cclen < file_name_length
 953                             || 0 <= scmp(d_name, XSTRING_DATA(file),
 954                                          file_name_length))
 955                                 continue;
 956
 957                         if (file_name_completion_stat(directory, dp, &st) < 0)
 958                                 continue;
 959
 960                         directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
 961                         if (directoryp) {
 962                                 /* "." and ".." are never interesting as completions, but are
 963                                    actually in the way in a directory containing only one file.  */
 964                                 if (!passcount
 965                                     && TRIVIAL_DIRECTORY_ENTRY(dp->d_name))
 966                                         continue;
 967                         } else {
 968                                 /* Compare extensions-to-be-ignored against end of this file name */
 969                                 /* if name is not an exact match against specified string.  */
 970                                 if (!passcount && cclen > file_name_length) {
 971                                         Lisp_Object tem;
 972                                         /* and exit this for loop if a match is found */
 973                                         EXTERNAL_LIST_LOOP(tem,
 974                                                            Vcompletion_ignored_extensions)
 975                                         {
 976                                                 Lisp_Object elt = XCAR(tem);
 977                                                 Charcount skip;
 978
 979                                                 CHECK_STRING(elt);
 980
 981                                                 skip =
 982                                                     cclen -
 983                                                     XSTRING_CHAR_LENGTH(elt);
 984                                                 if (skip < 0)
 985                                                         continue;
 986
 987                                                 if (0 >
 988                                                     scmp(charptr_n_addr
 989                                                          (d_name, skip),
 990                                                          XSTRING_DATA(elt),
 991                                                          XSTRING_CHAR_LENGTH
 992                                                          (elt))) {
 993                                                         ignored_extension_p = 1;
 994                                                         break;
 995                                                 }
 996                                         }
 997                                 }
 998                         }
 999
1000                         /* If an ignored-extensions match was found,
1001                            don't process this name as a completion.  */
1002                         if (!passcount && ignored_extension_p)
1003                                 continue;
1004
1005                         if (!passcount
1006                             && regexp_ignore_completion_p(d_name, Qnil, 0,
1007                                                           cclen))
1008                                 continue;
1009
1010                         /* Update computation of how much all possible completions match */
1011                         matchcount++;
1012
1013                         if (all_flag || NILP(bestmatch)) {
1014                                 Lisp_Object name = Qnil;
1015                                 struct gcpro ngcpro1;
1016                                 NGCPRO1(name);
1017                                 /* This is a possible completion */
1018                                 name = make_string(d_name, len);
1019                                 if (directoryp) /* Completion is a directory; end it with '/' */
1020                                         name = Ffile_name_as_directory(name);
1021                                 if (all_flag) {
1022                                         bestmatch = Fcons(name, bestmatch);
1023                                 } else {
1024                                         bestmatch = name;
1025                                         bestmatchsize =
1026                                             XSTRING_CHAR_LENGTH(name);
1027                                 }
1028                                 NUNGCPRO;
1029                         } else {
1030                                 Charcount compare = min(bestmatchsize, cclen);
1031                                 Bufbyte *p1 = XSTRING_DATA(bestmatch);
1032                                 Bufbyte *p2 = d_name;
1033                                 Charcount matchsize = scmp(p1, p2, compare);
1034
1035                                 if (matchsize < 0)
1036                                         matchsize = compare;
1037                                 if (completion_ignore_case) {
1038                                         /* If this is an exact match except for case,
1039                                            use it as the best match rather than one that is not
1040                                            an exact match.  This way, we get the case pattern
1041                                            of the actual match.  */
1042                                         if ((matchsize == cclen
1043                                              && matchsize + !!directoryp
1044                                              < XSTRING_CHAR_LENGTH(bestmatch))
1045                                             ||
1046                                             /* If there is no exact match ignoring case,
1047                                                prefer a match that does not change the case
1048                                                of the input.  */
1049                                             (((matchsize == cclen)
1050                                               ==
1051                                               (matchsize + !!directoryp
1052                                                ==
1053                                                XSTRING_CHAR_LENGTH(bestmatch)))
1054                                              /* If there is more than one exact match aside from
1055                                                 case, and one of them is exact including case,
1056                                                 prefer that one.  */
1057                                              && 0 > scmp_1(p2,
1058                                                            XSTRING_DATA(file),
1059                                                            file_name_length, 0)
1060                                              && 0 <= scmp_1(p1,
1061                                                             XSTRING_DATA(file),
1062                                                             file_name_length,
1063                                                             0))) {
1064                                                 bestmatch =
1065                                                     make_string(d_name, len);
1066                                                 if (directoryp)
1067                                                         bestmatch =
1068                                                             Ffile_name_as_directory
1069                                                             (bestmatch);
1070                                         }
1071                                 }
1072
1073                                 /* If this directory all matches,
1074                                    see if implicit following slash does too.  */
1075                                 if (directoryp
1076                                     && compare == matchsize
1077                                     && bestmatchsize > matchsize
1078                                     &&
1079                                     IS_ANY_SEP(charptr_emchar_n(p1, matchsize)))
1080                                         matchsize++;
1081                                 bestmatchsize = matchsize;
1082                         }
1083                 }
1084                 closedir(d);
1085                 free_opaque_ptr(XCAR(locative));
1086                 XCAR(locative) = Qnil;
1087         }
1088
1089         unbind_to(speccount, Qnil);
1090
1091         UNGCPRO;
1092
1093         if (all_flag || NILP(bestmatch))
1094                 return bestmatch;
1095         if (matchcount == 1 && bestmatchsize == file_name_length)
1096                 return Qt;
1097         return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1098 }
1099 \f
1100 static Lisp_Object user_name_completion(Lisp_Object user,
1101                                         int all_flag, int *uniq);
1102
1103 DEFUN("user-name-completion", Fuser_name_completion, 1, 1, 0,   /*
1104 Complete user name from PARTIAL-USERNAME.
1105 Return the longest prefix common to all user names starting with
1106 PARTIAL-USERNAME.  If there is only one and PARTIAL-USERNAME matches
1107 it exactly, returns t.  Return nil if there is no user name starting
1108 with PARTIAL-USERNAME.
1109 */
1110       (partial_username))
1111 {
1112         return user_name_completion(partial_username, 0, NULL);
1113 }
1114
1115 DEFUN("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0,       /*
1116 Complete user name from PARTIAL-USERNAME.
1117
1118 This function is identical to `user-name-completion', except that
1119 the cons of the completion and an indication of whether the
1120 completion was unique is returned.
1121
1122 The car of the returned value is the longest prefix common to all user
1123 names that start with PARTIAL-USERNAME.  If there is only one and
1124 PARTIAL-USERNAME matches it exactly, the car is t.  The car is nil if
1125 there is no user name starting with PARTIAL-USERNAME.  The cdr of the
1126 result is non-nil if and only if the completion returned in the car
1127 was unique.
1128 */
1129       (partial_username))
1130 {
1131         int uniq;
1132         Lisp_Object completed =
1133             user_name_completion(partial_username, 0, &uniq);
1134         return Fcons(completed, uniq ? Qt : Qnil);
1135 }
1136
1137 DEFUN("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
1138 Return a list of all user name completions from PARTIAL-USERNAME.
1139 These are all the user names which begin with PARTIAL-USERNAME.
1140 */
1141       (partial_username))
1142 {
1143         return user_name_completion(partial_username, 1, NULL);
1144 }
1145
1146 struct user_name {
1147         Bufbyte *ptr;
1148         size_t len;
1149 };
1150
1151 struct user_cache {
1152         struct user_name *user_names;
1153         int length;
1154         int size;
1155         EMACS_TIME last_rebuild_time;
1156 };
1157 static struct user_cache user_cache;
1158
1159 static void free_user_cache(struct user_cache *cache)
1160 {
1161         int i;
1162         for (i = 0; i < cache->length; i++)
1163                 xfree(cache->user_names[i].ptr);
1164         xfree(cache->user_names);
1165         xzero(*cache);
1166 }
1167
1168 static Lisp_Object user_name_completion_unwind(Lisp_Object cache_incomplete_p)
1169 {
1170         endpwent();
1171         speed_up_interrupts();
1172
1173         if (!NILP(XCAR(cache_incomplete_p)))
1174                 free_user_cache(&user_cache);
1175
1176         free_cons(XCONS(cache_incomplete_p));
1177
1178         return Qnil;
1179 }
1180
1181 #define  USER_CACHE_TTL  (24*60*60)     /* Time to live: 1 day, in seconds */
1182
1183 static Lisp_Object
1184 user_name_completion(Lisp_Object user, int all_flag, int *uniq)
1185 {
1186         /* This function can GC */
1187         int matchcount = 0;
1188         Lisp_Object bestmatch = Qnil;
1189         Charcount bestmatchsize = 0;
1190         Charcount user_name_length;
1191         EMACS_TIME t;
1192         int i;
1193         struct gcpro gcpro1, gcpro2;
1194
1195         GCPRO2(user, bestmatch);
1196
1197         CHECK_STRING(user);
1198
1199         user_name_length = XSTRING_CHAR_LENGTH(user);
1200
1201         /* Cache user name lookups because it tends to be quite slow.
1202          * Rebuild the cache occasionally to catch changes */
1203         EMACS_GET_TIME(t);
1204         if (user_cache.user_names &&
1205             (EMACS_SECS(t) - EMACS_SECS(user_cache.last_rebuild_time)
1206              > USER_CACHE_TTL))
1207                 free_user_cache(&user_cache);
1208
1209         if (!user_cache.user_names) {
1210                 struct passwd *pwd;
1211                 Lisp_Object cache_incomplete_p = noseeum_cons(Qt, Qnil);
1212                 int speccount = specpdl_depth();
1213
1214                 slow_down_interrupts();
1215                 setpwent();
1216                 record_unwind_protect(user_name_completion_unwind,
1217                                       cache_incomplete_p);
1218                 while ((pwd = getpwent())) {
1219                         QUIT;
1220                         DO_REALLOC(user_cache.user_names, user_cache.size,
1221                                    user_cache.length + 1, struct user_name);
1222                         TO_INTERNAL_FORMAT(C_STRING, pwd->pw_name,
1223                                            MALLOC,
1224                                            (user_cache.
1225                                             user_names[user_cache.length].ptr,
1226                                             user_cache.user_names[user_cache.
1227                                                                   length].len),
1228                                            Qnative);
1229                         user_cache.length++;
1230                 }
1231                 XCAR(cache_incomplete_p) = Qnil;
1232                 unbind_to(speccount, Qnil);
1233
1234                 EMACS_GET_TIME(user_cache.last_rebuild_time);
1235         }
1236
1237         for (i = 0; i < user_cache.length; i++) {
1238                 Bufbyte *u_name = user_cache.user_names[i].ptr;
1239                 Bytecount len = user_cache.user_names[i].len;
1240                 /* scmp() works in chars, not bytes, so we have to compute this: */
1241                 Charcount cclen = bytecount_to_charcount(u_name, len);
1242
1243                 QUIT;
1244
1245                 if (cclen < user_name_length
1246                     || 0 <= scmp_1(u_name, XSTRING_DATA(user), user_name_length,
1247                                    0))
1248                         continue;
1249
1250                 matchcount++;   /* count matching completions */
1251
1252                 if (all_flag || NILP(bestmatch)) {
1253                         Lisp_Object name = Qnil;
1254                         struct gcpro ngcpro1;
1255                         NGCPRO1(name);
1256                         /* This is a possible completion */
1257                         name = make_string(u_name, len);
1258                         if (all_flag) {
1259                                 bestmatch = Fcons(name, bestmatch);
1260                         } else {
1261                                 bestmatch = name;
1262                                 bestmatchsize = XSTRING_CHAR_LENGTH(name);
1263                         }
1264                         NUNGCPRO;
1265                 } else {
1266                         Charcount compare = min(bestmatchsize, cclen);
1267                         Bufbyte *p1 = XSTRING_DATA(bestmatch);
1268                         Bufbyte *p2 = u_name;
1269                         Charcount matchsize = scmp_1(p1, p2, compare, 0);
1270
1271                         if (matchsize < 0)
1272                                 matchsize = compare;
1273
1274                         bestmatchsize = matchsize;
1275                 }
1276         }
1277
1278         UNGCPRO;
1279
1280         if (uniq)
1281                 *uniq = (matchcount == 1);
1282
1283         if (all_flag || NILP(bestmatch))
1284                 return bestmatch;
1285         if (matchcount == 1 && bestmatchsize == user_name_length)
1286                 return Qt;
1287         return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1288 }
1289 \f
1290 Lisp_Object make_directory_hash_table(const char *path)
1291 {
1292         DIR *d;
1293         if ((d = opendir(path))) {
1294                 DIRENTRY *dp;
1295                 Lisp_Object hash =
1296                     make_lisp_hash_table(20, HASH_TABLE_NON_WEAK,
1297                                          HASH_TABLE_EQUAL);
1298
1299                 while ((dp = readdir(d))) {
1300                         Bytecount len = NAMLEN(dp);
1301                         if (DIRENTRY_NONEMPTY(dp))
1302                                 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates.  */
1303                                 Fputhash(make_string
1304                                          ((Bufbyte *) dp->d_name, len), Qt,
1305                                          hash);
1306                 }
1307                 closedir(d);
1308                 return hash;
1309         } else
1310                 return Qnil;
1311 }
1312 \f
1313 #if 0
1314 /* ... never used ... should use list2 directly anyway ... */
1315 /* NOTE: This function can never return a negative value. */
1316 Lisp_Object wasteful_word_to_lisp(unsigned int item)
1317 {
1318         /* Compatibility: in other versions, file-attributes returns a LIST
1319            of two 16 bit integers... */
1320         Lisp_Object cons = word_to_lisp(item);
1321         XCDR(cons) = Fcons(XCDR(cons), Qnil);
1322         return cons;
1323 }
1324 #endif
1325
1326 DEFUN("file-attributes", Ffile_attributes, 1, 1, 0,     /*
1327 Return a list of attributes of file FILENAME.
1328 Value is nil if specified file cannot be opened.
1329 Otherwise, list elements are:
1330 0. t for directory, string (name linked to) for symbolic link, or nil.
1331 1. Number of links to file.
1332 2. File uid.
1333 3. File gid.
1334 4. Last access time, as a list of two integers.
1335 First integer has high-order 16 bits of time, second has low 16 bits.
1336 5. Last modification time, likewise.
1337 6. Last status change time, likewise.
1338 7. Size in bytes. (-1, if number is out of range).
1339 8. File modes, as a string of ten letters or dashes as in ls -l.
1340 9. t iff file's gid would change if file were deleted and recreated.
1341 10. inode number.
1342 11. Device number.
1343
1344 If file does not exist, returns nil.
1345 */
1346       (filename))
1347 {
1348         /* This function can GC. GC checked 1997.06.04. */
1349         Lisp_Object values[12];
1350 #if defined (BSD4_2) || defined (BSD4_3) ||     \
1351         !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1352         Lisp_Object directory = Qnil;
1353 #endif  /* BSD4_2 || BSD4_3 || !BDWGC */
1354         struct stat s;
1355         char modes[10];
1356         Lisp_Object handler;
1357         struct gcpro gcpro1, gcpro2;
1358
1359         GCPRO2(filename, directory);
1360         filename = Fexpand_file_name(filename, Qnil);
1361
1362         /* If the file name has special constructs in it,
1363            call the corresponding file handler.  */
1364         handler = Ffind_file_name_handler(filename, Qfile_attributes);
1365         if (!NILP(handler)) {
1366                 UNGCPRO;
1367                 return call2(handler, Qfile_attributes, filename);
1368         }
1369
1370         if (lstat((char *)XSTRING_DATA(filename), &s) < 0) {
1371                 UNGCPRO;
1372                 return Qnil;
1373         }
1374 #ifdef BSD4_2
1375         directory = Ffile_name_directory(filename);
1376 #endif
1377
1378         switch (s.st_mode & S_IFMT) {
1379         default:
1380                 values[0] = Qnil;
1381                 break;
1382         case S_IFDIR:
1383                 values[0] = Qt;
1384                 break;
1385 #ifdef S_IFLNK
1386         case S_IFLNK:
1387                 values[0] = Ffile_symlink_p(filename);
1388                 break;
1389 #endif
1390         }
1391         values[1] = make_int(s.st_nlink);
1392         values[2] = make_int(s.st_uid);
1393         values[3] = make_int(s.st_gid);
1394         values[4] = make_time(s.st_atime);
1395         values[5] = make_time(s.st_mtime);
1396         values[6] = make_time(s.st_ctime);
1397         values[7] = make_int((EMACS_INT) s.st_size);
1398         /* If the size is out of range, give back -1.  */
1399         /* #### Fix when Emacs gets bignums! */
1400         if (XINT(values[7]) != s.st_size)
1401                 values[7] = make_int(-1);
1402         filemodestring(&s, modes);
1403         values[8] = make_string((Bufbyte *) modes, 10);
1404 #if defined (BSD4_2) || defined (BSD4_3)        /* file gid will be dir gid */
1405         {
1406                 struct stat sdir;
1407
1408                 if (!NILP(directory)
1409                     && sxemacs_stat((char *)XSTRING_DATA(directory), &sdir) == 0)
1410                         values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
1411                 else            /* if we can't tell, assume worst */
1412                         values[9] = Qt;
1413         }
1414 #else                           /* file gid will be egid */
1415         values[9] = (s.st_gid != getegid())? Qt : Qnil;
1416 #endif                          /* BSD4_2 or BSD4_3 */
1417         values[10] = make_int(s.st_ino);
1418         values[11] = make_int(s.st_dev);
1419         UNGCPRO;
1420         return Flist(countof(values), values);
1421 }
1422
1423 \f
1424 /************************************************************************/
1425 /*                            initialization                            */
1426 /************************************************************************/
1427
1428 void syms_of_dired(void)
1429 {
1430         defsymbol(&Qdirectory_files, "directory-files");
1431         defsymbol(&Qdirectory_files_recur, "directory-files-recur");
1432         defsymbol(&Qfile_name_completion, "file-name-completion");
1433         defsymbol(&Qfile_name_all_completions, "file-name-all-completions");
1434         defsymbol(&Qfile_attributes, "file-attributes");
1435
1436         defsymbol(&Qcompanion_bf, "companion-bf");
1437         defsymbol(&Qsorted_list, "sorted-list");
1438         defsymbol(&Qdesc_sorted_list, "desc-sorted-list");
1439         defsymbol(&Qunsorted_list, "unsorted-list");
1440
1441         DEFSUBR(Fdirectory_files);
1442         DEFSUBR(Fdirectory_files_recur);
1443         DEFSUBR(Ffile_name_completion);
1444         DEFSUBR(Ffile_name_all_completions);
1445         DEFSUBR(Fuser_name_completion);
1446         DEFSUBR(Fuser_name_completion_1);
1447         DEFSUBR(Fuser_name_all_completions);
1448         DEFSUBR(Ffile_attributes);
1449 }
1450
1451 void vars_of_dired(void)
1452 {
1453         DEFVAR_LISP("completion-ignored-extensions", &Vcompletion_ignored_extensions    /*
1454 *Completion ignores filenames ending in any string in this list.
1455 This variable does not affect lists of possible completions,
1456 but does affect the commands that actually do completions.
1457 It is used by the function `file-name-completion'.
1458                                                                                          */ );
1459         Vcompletion_ignored_extensions = Qnil;
1460
1461         DEFVAR_LISP("directory-files-no-trivial-p",
1462                     &Vdirectory_files_no_trivial_p      /*
1463 Determine whether to _not_ add the trivial directory entries
1464 `.' and `..'.
1465 ATTENTION: This variable is definitely NOT for users.
1466 For easy temporary circumvention use a let binding.
1467                                                         */ );
1468         Vdirectory_files_no_trivial_p = Qnil;
1469 }