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