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