cgit.sxemacs.org Git - sxemacs/blob - src/dired.c

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