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