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

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