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