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