1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of SXEmacs
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.
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.
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/>. */
20 /* Synched up with: FSF 19.30. */
41 #include "mule/file-coding.h"
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;
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;
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 *);
66 #define CANONICALISE_FILENAME(f) canonicalize_file_name(f)
68 #else /* !defined(HAVE_CANONICALIZE_FILE_NAME) */
70 static char *dired_realpath(const char *);
71 #define CANONICALISE_FILENAME(f) dired_realpath(f)
72 #endif /* defined(HAVE_CANONICALIZE_FILE_NAME) */
74 #ifndef TRIVIAL_DIRECTORY_ENTRY
75 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
79 /* this variant is much too slow */
80 #define FAST_CONCAT(tgt, s1, s2) tgt = concat2(s1, s2);
83 #define FAST_CONCAT(tgt, s1, s2) \
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)); \
92 /* some more declarations */
93 typedef struct dired_stack_item_s *dired_stack_item_t;
94 typedef struct dfr_options_s *dfr_options_t;
96 struct dired_stack_item_s {
101 struct dfr_options_s {
102 long unsigned int maxdepth;
104 _Bool symlink_file_p:1;
108 static Lisp_Object fname_as_directory(Lisp_Object);
109 static int pathname_matches_p(Lisp_Object, Lisp_Object,
110 struct re_pattern_buffer*);
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)
120 #if defined(HAVE_LARGEFILE)
121 #define dirent_t struct dirent64
122 #define DFR_READDIR readdir64_r
124 #define dirent_t struct dirent
125 #define DFR_READDIR readdir_r
128 #if !defined(HAVE_CANONICALIZE_FILE_NAME)
130 dired_realpath(const char *file)
132 char *result = xmalloc_atomic(4096);
134 if ( xrealpath(file, result) == NULL ) {
143 fname_as_directory(Lisp_Object fname)
145 if (XSTRING_LENGTH(fname) > 0)
146 return Ffile_name_as_directory(fname);
152 pathname_matches_p(Lisp_Object pathname, Lisp_Object match,
153 struct re_pattern_buffer *bufp)
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)
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",
176 restore_match_data();
177 unbind_to(speccount2, Qnil);
184 static Lisp_Object close_directory_unwind(Lisp_Object unwind_obj)
186 DIR *d = (DIR *) get_opaque_ptr(unwind_obj);
188 free_opaque_ptr(unwind_obj);
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)
201 /* this function can GC */
204 Lisp_Object name = Qnil;
205 Lisp_Object fullname = Qnil;
206 Lisp_Object resname = Qnil;
209 char *statnam = NULL;
210 struct gcpro gcpro1, gcpro2, gcpro3;
212 GCPRO3(name, fullname, resname);
214 if (!DIRENTRY_NONEMPTY(res) ||
215 (TRIVIAL_DIRECTORY_ENTRY(res->d_name) &&
216 !(NILP(Vdirectory_files_no_trivial_p) && opts->maxdepth == 0))) {
222 resname = make_ext_string(res->d_name, len, Qfile_name);
224 FAST_CONCAT(fullname, fulldir, resname);
225 FAST_CONCAT(name, dir, resname);
227 /* we want full file names? */
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) {
240 } else if (res->d_type == DT_LNK && !opts->symlink_file_p) {
241 char *canon_name = NULL;
243 statnam = (char*)XSTRING_DATA(fullname);
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
252 canon_name = CANONICALISE_FILENAME(statnam);
254 /* now, recycle full name */
255 fullname = make_ext_string(
256 canon_name, strlen(canon_name), Qfile_name);
258 fullname = fname_as_directory(fullname);
260 /* now stat statnam */
261 if (sxemacs_stat(statnam, &st) == 0 &&
262 (st.st_mode & S_IFMT) == S_IFDIR &&
264 !(bloom_owns_p(XBLOOM(compbf), fullname))) {
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) {
277 } else if ((st.st_mode & S_IFMT) == S_IFLNK
278 && !opts->symlink_file_p) {
279 char *canon_name = NULL;
281 /* ugly things may happen when a link
282 * points back to a directory in our recurring
283 * area, ln -s . foo is a candidate
284 * now, we canonicalise the filename, i.e.
285 * resolve all symlinks and afterwards we
286 * store it to our companion bloom filter
287 * The ugly things are even worse than in the
288 * case of D_TYPE, since we !always! have to
289 * check against the bloom filter.
291 canon_name = CANONICALISE_FILENAME(statnam);
294 /* now, recycle full name */
295 fullname = make_ext_string(
296 canon_name, strlen(canon_name),
299 fullname = fname_as_directory(fullname);
301 /* now stat statnam */
302 if (sxemacs_stat(statnam, &st) == 0 &&
303 (st.st_mode & S_IFMT) == S_IFDIR &&
304 /* does the bloom know about the dir? */
306 !(bloom_owns_p(XBLOOM(compbf), fullname))) {
316 #endif /* defined(_DIRENT_HAVE_D_TYPE) && USE_D_TYPE */
318 /* argh, here is a design flaw!
319 these operations are not commutable, and it's a
320 hard-coded how `match' is interpreted.
321 * There are two possibilites:
322 * (1) check pathname against `match'
323 if nil, do not process further
324 if a directory, recur
325 if non-nil, add to result according to files_only
326 * (2) if a directory, recur
327 check pathname against `match'
328 if nil, do not add to result
329 if non-nil, add to result according to files_only
331 * Hm, I think I'd choose the latter variant, it is
332 not that performant, but it avoids two problems:
334 - With the former variant it is NOT possible to have
335 the trivial filenames on the result list, since a
336 match against "^[.]$" would exclude everything, while
337 actually it was likely meant to _solely_ exclude "."
339 - Furthermore, we _MUST_ traverse in preorder,
340 otherwise there is the possibility that pathnames are
341 on the file list already which turn out later to be
343 * Anyone wants to help brainstorming?
346 /* check if we put it on the list of matches */
347 if (NILP(files_only)) {
349 } else if (EQ(files_only, Qt) && !dir_p) {
351 } else if (!EQ(files_only, Qt) && dir_p) {
357 if (curdepth >= opts->maxdepth) {
362 dired_stack_item_t dsi;
363 dsi = xnew_and_zero(struct dired_stack_item_s);
365 dsi->depth = 1+curdepth;
366 dired_stack_push(ds, dsi);
369 if (result_p && !NILP(match)
370 && !pathname_matches_p((opts->matchfullp?fullname:name),
376 dllist_append(XDLLIST(result), (void*)resname);
377 /* add the result to the companion bloom-f */
378 /* hm, for large trees this yields a bf which
379 owns everything :( ... we need far better and
380 faster bloom techniques for it -hroptatyr */
381 if (!NILP(bloom_filter)) {
382 bloom_add(XBLOOM(bloom_filter), resname);
391 dfr_outer(Lisp_Object directory, dirent_t *ent,
392 Lisp_Object compbf, dfr_options_t opts,
393 Lisp_Object files_only, dired_stack_t ds, Lisp_Object match,
394 struct re_pattern_buffer *bufp, Lisp_Object result,
395 Lisp_Object bloom_filter)
397 dired_stack_item_t dir_dpt = dired_stack_pop(ds);
398 Lisp_Object dir = dir_dpt->dir;
399 unsigned int dpt = dir_dpt->depth;
400 Lisp_Object fulldir = Fexpand_file_name(dir, directory);
402 dirent_t *res = NULL;
403 struct gcpro gcpro1, gcpro2;
405 GCPRO2(dir, fulldir);
409 dir = fname_as_directory(dir);
410 fulldir = fname_as_directory(fulldir);
412 /* add the full directory name to the companion bloom filter */
414 bloom_add(XBLOOM(compbf), fulldir);
416 /* external format conversion is done in the encapsulation of
417 * opendir in sysdep.c
419 d = opendir((char*)XSTRING_DATA(fulldir));
421 /* why should we want this? I think spitting a warning
427 report_file_error("Opening directory", list1(fulldir));
432 warn_when_safe(Qfile, Qwarning,
433 "Opening directory `%s' failed",
434 (char*)XSTRING_DATA(fulldir));
440 record_unwind_protect(close_directory_unwind,
441 make_opaque_ptr((void *)d));
443 while (DFR_READDIR(d, ent, &res) == 0 && res != NULL) {
444 dfr_inner(res, fulldir, dir,
446 files_only, dpt, ds, match, bufp,
447 result, bloom_filter);
454 dired_stack_mark(Lisp_Object obj)
456 dired_stack_t ds = get_dynacat(obj);
457 WITH_DLLIST_TRAVERSE(
459 dired_stack_item_t dsi = dllist_item;
460 mark_object(dsi->dir));
466 dired_stack_fini(Lisp_Object obj)
468 dired_stack_t ds = get_dynacat(obj);
469 free_dired_stack(ds);
475 directory_files_magic(Lisp_Object directory, Lisp_Object match,
476 Lisp_Object files_only, Lisp_Object bloom_filter,
479 /* This function can GC */
480 Lisp_Object result = wrap_dllist(make_dllist());
481 Lisp_Object lds = Qnil;
482 dired_stack_t ds = NULL;
483 dired_stack_item_t ds_item = NULL;
484 /* this is a companion bloom filter,
485 * we register processed directories in here and hence avoid
486 * processing an entry twice */
487 Lisp_Object compbf = Qnil;
488 int speccount = specpdl_depth();
489 struct re_pattern_buffer *bufp = NULL;
490 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
492 ds = new_dired_stack();
493 lds = make_dynacat(ds);
494 set_dynacat_marker(lds, dired_stack_mark);
495 set_dynacat_finaliser(lds, (dynacat_finaliser_f)dired_stack_fini);
496 GCPRO5(directory, result, compbf, bloom_filter, lds);
498 /* SXEmacs: this should come after Ffile_name_as_directory() to avoid
499 potential regexp cache smashage. It comes before the opendir()
500 because it might signal an error. */
502 if (STRINGP(match)) {
504 /* MATCH might be a flawed regular expression. Rather
505 than catching and signalling our own errors, we just
506 call compile_pattern to do the work for us. */
507 bufp = compile_pattern(match, 0, Qnil, 0, ERROR_ME);
508 /* Now *bufp is the compiled form of MATCH; don't call
509 anything which might compile a new regexp until we
510 are done with the loop! */
512 } else if (!NILP(Ffunctionp(match))) {
515 return wrong_type_argument(Qstringp, match);
519 regex_match_object = Qnil;
520 regex_emacs_buffer = current_buffer;
522 if (opts->maxdepth > 0) {
523 compbf = make_bloom(8192, 8);
526 /* set up the directories queue */
527 ds_item = xnew_and_zero(struct dired_stack_item_s);
528 ds_item->dir = make_string((Bufbyte*)"", 0);
530 dired_stack_push(ds, ds_item);
532 /* alloc the directory entry pointer */
534 dirent_t _ent, *ent = &_ent;
537 memset(ent, 0, sizeof(dirent_t));
539 while (dired_stack_size(ds) > 0) {
540 dfr_outer(directory, ent, compbf,
541 opts, files_only, ds, match,
542 bufp, result, bloom_filter);
543 /* This will close the dir */
544 unbind_to(speccount, Qnil);
549 /* save the companion bloom filter */
550 Fput(result, Qcompanion_bf, compbf);
557 directory_files_canonicalise_dn(Lisp_Object directory)
562 /* expand the directory argument and canonicalise */
563 directory = Fexpand_file_name(directory, Qnil);
564 directory = fname_as_directory(directory);
566 RETURN_UNGCPRO(directory);
570 directory_files_resultify(Lisp_Object result, Lisp_Object result_type)
572 /* This function can GC */
573 Lisp_Object final_result = Qnil;
574 struct gcpro gcpro1, gcpro2, gcpro3;
575 GCPRO3(result, result_type, final_result);
577 /* see if the user requested a dllist */
578 if (EQ(result_type, Qdllist)) {
579 final_result = result;
580 } else if (NILP(result_type) || EQ(result_type, Qsorted_list)) {
581 final_result = Fdllist_to_list_reversed(result);
582 final_result = Fsort(final_result, Qstring_lessp);
583 } else if (EQ(result_type, Qdesc_sorted_list)) {
584 final_result = Fdllist_to_list(result);
585 final_result = Fsort(final_result, Qstring_greaterp);
586 } else if (!NILP(result_type) || EQ(result_type, Qlist)) {
587 final_result = Fdllist_to_list(result);
595 call9(Lisp_Object fn,
596 Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
597 Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5,
598 Lisp_Object arg6, Lisp_Object arg7, Lisp_Object arg8)
600 /* This function can GC */
602 Lisp_Object res, args[10] = {fn, arg0, arg1, arg2, arg3,
603 arg4, arg5, arg6, arg7, arg8};
605 GCPROn(args, countof(args));
606 res = Ffuncall(10, args);
613 EXFUN(Fdirectory_files_recur, 8);
615 DEFUN("directory-files", Fdirectory_files, 1, 5, 0, /*
616 Return a list of names of files in DIRECTORY.
617 Args are DIRECTORY &optional FULL MATCH RESULT-TYPE FILES_ONLY
619 There are four optional arguments:
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.
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
633 Optional argument RESULT-TYPE can be one of:
634 - sorted-list (default) to return a list, sorted in alphabetically
636 - desc-sorted-list to return a list, sorted in alphabetically
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.
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)
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
654 (directory, full, match, result_type, files_only))
656 Lisp_Object handler = Qnil;
657 Lisp_Object result = Qnil;
658 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
659 /* just a convenience array for gc pro'ing */
660 Lisp_Object args[6] = {
661 directory, match, result_type, files_only,
664 struct dfr_options_s opts = {
666 .fullp = !NILP(full),
668 .matchfullp = EQ(full,Qmatch_full),
672 /* argument checks */
673 CHECK_STRING(directory);
675 GCPROn(args, countof(args));
677 directory = directory_files_canonicalise_dn(directory);
679 /* If the file name has special constructs in it,
680 call the corresponding file handler. */
681 handler = Ffind_file_name_handler(directory, Qdirectory_files);
682 if (!NILP(handler)) {
684 return call6(handler, Qdirectory_files,
685 directory, full, match, result_type, files_only);
688 result = directory_files_magic(directory, match,
689 files_only, Qnil /* bloom_filter */,
693 return directory_files_resultify(result, result_type);
696 DEFUN("directory-files-recur", Fdirectory_files_recur, 1, 8, 0, /*
697 Like `directory-files' but recursive and much faster.
698 Args are DIRECTORY &optional FULL MATCH RESULT_TYPE FILES-ONLY MAXDEPTH
699 SYMLINK_IS_FILE BLOOM_FILTER
702 - t to return absolute pathnames of the files.
703 - match-full to return and match on absolute pathnames of the files.
704 - nil to return relative filenames.
706 If MATCH is non-nil, it may be a string indicating a regular
707 expression which pathnames must meet in order to be returned.
708 Moreover, a predicate function can be specified which is called with
709 one argument, the pathname in question. On non-nil return value, the
710 pathname is considered in the final result, otherwise it is ignored.
711 Note that FULL affects whether the match is done on the filename of
714 Optional argument RESULT-TYPE can be one of:
715 - sorted-list (default) to return a list, sorted in alphabetically
717 - desc-sorted-list to return a list, sorted in alphabetically
719 - list to return an unsorted list
720 - dllist to return an unsorted dllist
721 The two latter types can be useful if you plan to sort the result
722 yourself, or want to feed the result to further processing.
724 Optional argument FILES-ONLY can be one of:
725 - t to return only files and symlinks in DIRECTORY
726 - nil (default) to return all entries (files, symlinks, and
727 subdirectories) in DIRECTORY
728 - subdir to return only subdirectories -- but *NOT* symlinks to
729 directories -- in DIRECTORY
731 Optional argument MAXDEPTH \(a positive integer\) specifies the
732 maximal recursion depth, use 0 to emulate old `directory-files'.
734 Optional argument SYMLINK-IS-FILE specifies whether symlinks
735 should be resolved \(which is the default behaviour\) or whether
736 they are treated as ordinary files \(non-nil\), in the latter
737 case symlinks to directories are not recurred.
739 Optional argument BLOOM-FILTER specifies a bloom filter where
740 to put results in addition to the ordinary result list.
742 (directory, full, match, result_type, files_only, maxdepth,
743 symlink_is_file, bloom_filter))
745 Lisp_Object handler = Qnil, result = Qnil;
746 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
747 /* just a convenience array for gc pro'ing */
748 Lisp_Object args[8] = {
749 directory, match, result_type, files_only,
750 symlink_is_file, bloom_filter, handler, result};
752 struct dfr_options_s opts = {
754 .fullp = !NILP(full),
755 .symlink_file_p = !NILP(symlink_is_file),
756 .matchfullp = EQ(full, Qmatch_full),
760 /* argument checks */
761 CHECK_STRING(directory);
762 if (!NILP(maxdepth)) {
763 CHECK_NATNUM(maxdepth);
764 opts.maxdepth = XUINT(maxdepth);
767 GCPROn(args, countof(args));
769 directory = directory_files_canonicalise_dn(directory);
771 /* If the file name has special constructs in it,
772 call the corresponding file handler. */
773 handler = Ffind_file_name_handler(directory, Qdirectory_files_recur);
774 if (!NILP(handler)) {
777 res = call9(handler, Qdirectory_files_recur,
778 directory, full, match, result_type, files_only,
779 maxdepth, symlink_is_file, bloom_filter);
784 result = directory_files_magic(directory, match,
785 files_only, bloom_filter,
787 /* convert to final result type */
788 result = directory_files_resultify(result, result_type);
794 static Lisp_Object file_name_completion(Lisp_Object file,
795 Lisp_Object directory,
796 int all_flag, int ver_flag);
798 DEFUN("file-name-completion", Ffile_name_completion, 2, 2, 0, /*
799 Complete file name PARTIAL-FILENAME in directory DIRECTORY.
800 Return the longest prefix common to all file names in DIRECTORY
801 that start with PARTIAL-FILENAME.
802 If there is only one and PARTIAL-FILENAME matches it exactly, return t.
803 Return nil if DIRECTORY contains no name starting with PARTIAL-FILENAME.
805 File names which end with any member of `completion-ignored-extensions'
806 are not considered as possible completions for PARTIAL-FILENAME unless
807 there is no other possible completion. `completion-ignored-extensions'
808 is not applied to the names of directories.
810 (partial_filename, directory))
812 /* This function can GC. GC checked 1996.04.06. */
815 /* If the directory name has special constructs in it,
816 call the corresponding file handler. */
817 handler = Ffind_file_name_handler(directory, Qfile_name_completion);
819 return call3(handler, Qfile_name_completion, partial_filename,
822 /* If the file name has special constructs in it,
823 call the corresponding file handler. */
825 Ffind_file_name_handler(partial_filename, Qfile_name_completion);
827 return call3(handler, Qfile_name_completion, partial_filename,
830 return file_name_completion(partial_filename, directory, 0, 0);
833 DEFUN("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
834 Return a list of all completions of PARTIAL-FILENAME in DIRECTORY.
835 These are all file names in DIRECTORY which begin with PARTIAL-FILENAME.
837 (partial_filename, directory))
839 /* This function can GC. GC checked 1997.06.04. */
844 directory = Fexpand_file_name(directory, Qnil);
845 /* If the file name has special constructs in it,
846 call the corresponding file handler. */
848 Ffind_file_name_handler(directory, Qfile_name_all_completions);
851 return call3(handler, Qfile_name_all_completions,
852 partial_filename, directory);
854 return file_name_completion(partial_filename, directory, 1, 0);
858 file_name_completion_stat(Lisp_Object directory, DIRENTRY * dp,
859 struct stat *st_addr)
861 Bytecount len = NAMLEN(dp);
862 Bytecount pos = XSTRING_LENGTH(directory);
864 char *fullname = (char *)alloca(len + pos + 2);
866 memcpy(fullname, XSTRING_DATA(directory), pos);
867 if (!IS_DIRECTORY_SEP(fullname[pos - 1]))
868 fullname[pos++] = DIRECTORY_SEP;
870 memcpy(fullname + pos, dp->d_name, len);
871 fullname[pos + len] = 0;
874 /* We want to return success if a link points to a nonexistent file,
875 but we want to return the status for what the link points to,
876 in case it is a directory. */
877 value = lstat(fullname, st_addr);
878 if (S_ISLNK(st_addr->st_mode))
879 (void)sxemacs_stat(fullname, st_addr);
881 value = sxemacs_stat(fullname, st_addr);
886 static Lisp_Object file_name_completion_unwind(Lisp_Object locative)
889 Lisp_Object obj = XCAR(locative);
892 d = (DIR *) get_opaque_ptr(obj);
894 free_opaque_ptr(obj);
896 free_cons(XCONS(locative));
901 file_name_completion(Lisp_Object file, Lisp_Object directory, int all_flag,
904 /* This function can GC */
907 Lisp_Object bestmatch = Qnil;
908 Charcount bestmatchsize = 0;
911 int speccount = specpdl_depth();
912 Charcount file_name_length;
913 Lisp_Object locative;
914 struct gcpro gcpro1, gcpro2, gcpro3;
916 GCPRO3(file, directory, bestmatch);
920 #ifdef FILE_SYSTEM_CASE
921 file = FILE_SYSTEM_CASE(file);
923 directory = Fexpand_file_name(directory, Qnil);
924 file_name_length = XSTRING_CHAR_LENGTH(file);
926 /* With passcount = 0, ignore files that end in an ignored extension.
927 If nothing found then try again with passcount = 1, don't ignore them.
928 If looking for all completions, start with passcount = 1,
929 so always take even the ignored ones.
931 ** It would not actually be helpful to the user to ignore any possible
932 completions when making a list of them.** */
934 /* We cannot use close_directory_unwind() because we change the
935 directory. The old code used to just avoid signaling errors, and
936 call closedir, but it was wrong, because it made sane handling of
937 QUIT impossible and, besides, various utility functions like
938 regexp_ignore_completion_p can signal errors. */
939 locative = noseeum_cons(Qnil, Qnil);
940 record_unwind_protect(file_name_completion_unwind, locative);
942 for (passcount = !!all_flag; NILP(bestmatch) && passcount < 2;
944 Lisp_Object tmp_dfn = Fdirectory_file_name(directory);
945 d = opendir((char *)XSTRING_DATA(tmp_dfn));
947 report_file_error("Opening directory",
950 XCAR(locative) = make_opaque_ptr((void *)d);
952 /* Loop reading blocks */
956 /* scmp() works in characters, not bytes, so we have to compute
960 int ignored_extension_p = 0;
967 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
968 d_name = (Bufbyte *) dp->d_name;
970 cclen = bytecount_to_charcount(d_name, len);
974 if (!DIRENTRY_NONEMPTY(dp)
975 || cclen < file_name_length
976 || 0 <= scmp(d_name, XSTRING_DATA(file),
980 if (file_name_completion_stat(directory, dp, &st) < 0)
983 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
985 /* "." and ".." are never interesting as completions, but are
986 actually in the way in a directory containing only one file. */
988 && TRIVIAL_DIRECTORY_ENTRY(dp->d_name))
991 /* Compare extensions-to-be-ignored against end of this file name */
992 /* if name is not an exact match against specified string. */
993 if (!passcount && cclen > file_name_length) {
995 /* and exit this for loop if a match is found */
996 EXTERNAL_LIST_LOOP(tem,
997 Vcompletion_ignored_extensions)
999 Lisp_Object elt = XCAR(tem);
1006 XSTRING_CHAR_LENGTH(elt);
1016 ignored_extension_p = 1;
1023 /* If an ignored-extensions match was found,
1024 don't process this name as a completion. */
1025 if (!passcount && ignored_extension_p)
1029 && regexp_ignore_completion_p(d_name, Qnil, 0,
1033 /* Update computation of how much all possible completions match */
1036 if (all_flag || NILP(bestmatch)) {
1037 Lisp_Object name = Qnil;
1038 struct gcpro ngcpro1;
1040 /* This is a possible completion */
1041 name = make_string(d_name, len);
1042 if (directoryp) /* Completion is a directory; end it with '/' */
1043 name = Ffile_name_as_directory(name);
1045 bestmatch = Fcons(name, bestmatch);
1049 XSTRING_CHAR_LENGTH(name);
1053 Charcount compare = min(bestmatchsize, cclen);
1054 Bufbyte *p1 = XSTRING_DATA(bestmatch);
1055 Bufbyte *p2 = d_name;
1056 Charcount matchsize = scmp(p1, p2, compare);
1059 matchsize = compare;
1060 if (completion_ignore_case) {
1061 /* If this is an exact match except for case,
1062 use it as the best match rather than one that is not
1063 an exact match. This way, we get the case pattern
1064 of the actual match. */
1065 if ((matchsize == cclen
1066 && matchsize + !!directoryp
1067 < XSTRING_CHAR_LENGTH(bestmatch))
1069 /* If there is no exact match ignoring case,
1070 prefer a match that does not change the case
1072 (((matchsize == cclen)
1074 (matchsize + !!directoryp
1076 XSTRING_CHAR_LENGTH(bestmatch)))
1077 /* If there is more than one exact match aside from
1078 case, and one of them is exact including case,
1082 file_name_length, 0)
1088 make_string(d_name, len);
1091 Ffile_name_as_directory
1096 /* If this directory all matches,
1097 see if implicit following slash does too. */
1099 && compare == matchsize
1100 && bestmatchsize > matchsize
1102 IS_ANY_SEP(charptr_emchar_n(p1, matchsize)))
1104 bestmatchsize = matchsize;
1108 free_opaque_ptr(XCAR(locative));
1109 XCAR(locative) = Qnil;
1112 unbind_to(speccount, Qnil);
1116 if (all_flag || NILP(bestmatch))
1118 if (matchcount == 1 && bestmatchsize == file_name_length)
1120 return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1123 static Lisp_Object user_name_completion(Lisp_Object user,
1124 int all_flag, int *uniq);
1126 DEFUN("user-name-completion", Fuser_name_completion, 1, 1, 0, /*
1127 Complete user name from PARTIAL-USERNAME.
1128 Return the longest prefix common to all user names starting with
1129 PARTIAL-USERNAME. If there is only one and PARTIAL-USERNAME matches
1130 it exactly, returns t. Return nil if there is no user name starting
1131 with PARTIAL-USERNAME.
1135 return user_name_completion(partial_username, 0, NULL);
1138 DEFUN("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /*
1139 Complete user name from PARTIAL-USERNAME.
1141 This function is identical to `user-name-completion', except that
1142 the cons of the completion and an indication of whether the
1143 completion was unique is returned.
1145 The car of the returned value is the longest prefix common to all user
1146 names that start with PARTIAL-USERNAME. If there is only one and
1147 PARTIAL-USERNAME matches it exactly, the car is t. The car is nil if
1148 there is no user name starting with PARTIAL-USERNAME. The cdr of the
1149 result is non-nil if and only if the completion returned in the car
1155 Lisp_Object completed =
1156 user_name_completion(partial_username, 0, &uniq);
1157 return Fcons(completed, uniq ? Qt : Qnil);
1160 DEFUN("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
1161 Return a list of all user name completions from PARTIAL-USERNAME.
1162 These are all the user names which begin with PARTIAL-USERNAME.
1166 return user_name_completion(partial_username, 1, NULL);
1175 struct user_name *user_names;
1178 EMACS_TIME last_rebuild_time;
1180 static struct user_cache user_cache;
1182 static void free_user_cache(struct user_cache *cache)
1185 for (i = 0; i < cache->length; i++)
1186 xfree(cache->user_names[i].ptr);
1187 xfree(cache->user_names);
1191 static Lisp_Object user_name_completion_unwind(Lisp_Object cache_incomplete_p)
1194 speed_up_interrupts();
1196 if (!NILP(XCAR(cache_incomplete_p)))
1197 free_user_cache(&user_cache);
1199 free_cons(XCONS(cache_incomplete_p));
1204 #define USER_CACHE_TTL (24*60*60) /* Time to live: 1 day, in seconds */
1207 user_name_completion(Lisp_Object user, int all_flag, int *uniq)
1209 /* This function can GC */
1211 Lisp_Object bestmatch = Qnil;
1212 Charcount bestmatchsize = 0;
1213 Charcount user_name_length;
1216 struct gcpro gcpro1, gcpro2;
1218 GCPRO2(user, bestmatch);
1222 user_name_length = XSTRING_CHAR_LENGTH(user);
1224 /* Cache user name lookups because it tends to be quite slow.
1225 * Rebuild the cache occasionally to catch changes */
1227 if (user_cache.user_names &&
1228 (EMACS_SECS(t) - EMACS_SECS(user_cache.last_rebuild_time)
1230 free_user_cache(&user_cache);
1232 if (!user_cache.user_names) {
1234 Lisp_Object cache_incomplete_p = noseeum_cons(Qt, Qnil);
1235 int speccount = specpdl_depth();
1237 slow_down_interrupts();
1239 record_unwind_protect(user_name_completion_unwind,
1240 cache_incomplete_p);
1241 while ((pwd = getpwent())) {
1243 DO_REALLOC(user_cache.user_names, user_cache.size,
1244 user_cache.length + 1, struct user_name);
1245 TO_INTERNAL_FORMAT(C_STRING, pwd->pw_name,
1248 user_names[user_cache.length].ptr,
1249 user_cache.user_names[user_cache.
1252 user_cache.length++;
1254 XCAR(cache_incomplete_p) = Qnil;
1255 unbind_to(speccount, Qnil);
1257 EMACS_GET_TIME(user_cache.last_rebuild_time);
1260 for (i = 0; i < user_cache.length; i++) {
1261 Bufbyte *u_name = user_cache.user_names[i].ptr;
1262 Bytecount len = user_cache.user_names[i].len;
1263 /* scmp() works in chars, not bytes, so we have to compute this: */
1264 Charcount cclen = bytecount_to_charcount(u_name, len);
1268 if (cclen < user_name_length
1269 || 0 <= scmp_1(u_name, XSTRING_DATA(user), user_name_length,
1273 matchcount++; /* count matching completions */
1275 if (all_flag || NILP(bestmatch)) {
1276 Lisp_Object name = Qnil;
1277 struct gcpro ngcpro1;
1279 /* This is a possible completion */
1280 name = make_string(u_name, len);
1282 bestmatch = Fcons(name, bestmatch);
1285 bestmatchsize = XSTRING_CHAR_LENGTH(name);
1289 Charcount compare = min(bestmatchsize, cclen);
1290 Bufbyte *p1 = XSTRING_DATA(bestmatch);
1291 Bufbyte *p2 = u_name;
1292 Charcount matchsize = scmp_1(p1, p2, compare, 0);
1295 matchsize = compare;
1297 bestmatchsize = matchsize;
1304 *uniq = (matchcount == 1);
1306 if (all_flag || NILP(bestmatch))
1308 if (matchcount == 1 && bestmatchsize == user_name_length)
1310 return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1313 Lisp_Object make_directory_hash_table(const char *path)
1316 if ((d = opendir(path))) {
1319 make_lisp_hash_table(20, HASH_TABLE_NON_WEAK,
1322 while ((dp = readdir(d))) {
1323 Bytecount len = NAMLEN(dp);
1324 if (DIRENTRY_NONEMPTY(dp))
1325 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
1326 Fputhash(make_string
1327 ((Bufbyte *) dp->d_name, len), Qt,
1337 /* ... never used ... should use list2 directly anyway ... */
1338 /* NOTE: This function can never return a negative value. */
1339 Lisp_Object wasteful_word_to_lisp(unsigned int item)
1341 /* Compatibility: in other versions, file-attributes returns a LIST
1342 of two 16 bit integers... */
1343 Lisp_Object cons = word_to_lisp(item);
1344 XCDR(cons) = Fcons(XCDR(cons), Qnil);
1349 DEFUN("file-attributes", Ffile_attributes, 1, 1, 0, /*
1350 Return a list of attributes of file FILENAME.
1351 Value is nil if specified file cannot be opened.
1352 Otherwise, list elements are:
1353 0. t for directory, string (name linked to) for symbolic link, or nil.
1354 1. Number of links to file.
1357 4. Last access time, as a list of two integers.
1358 First integer has high-order 16 bits of time, second has low 16 bits.
1359 5. Last modification time, likewise.
1360 6. Last status change time, likewise.
1361 7. Size in bytes. (-1, if number is out of range).
1362 8. File modes, as a string of ten letters or dashes as in ls -l.
1363 9. t iff file's gid would change if file were deleted and recreated.
1367 If file does not exist, returns nil.
1371 /* This function can GC. GC checked 1997.06.04. */
1372 Lisp_Object values[12];
1373 #if defined (BSD4_2) || defined (BSD4_3) || \
1374 !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1375 Lisp_Object directory = Qnil;
1376 #endif /* BSD4_2 || BSD4_3 || !BDWGC */
1379 Lisp_Object handler;
1380 struct gcpro gcpro1, gcpro2;
1382 GCPRO2(filename, directory);
1383 filename = Fexpand_file_name(filename, Qnil);
1385 /* If the file name has special constructs in it,
1386 call the corresponding file handler. */
1387 handler = Ffind_file_name_handler(filename, Qfile_attributes);
1388 if (!NILP(handler)) {
1390 return call2(handler, Qfile_attributes, filename);
1393 if (lstat((char *)XSTRING_DATA(filename), &s) < 0) {
1398 directory = Ffile_name_directory(filename);
1401 switch (s.st_mode & S_IFMT) {
1410 values[0] = Ffile_symlink_p(filename);
1414 values[1] = make_int(s.st_nlink);
1415 values[2] = make_int(s.st_uid);
1416 values[3] = make_int(s.st_gid);
1417 values[4] = make_time(s.st_atime);
1418 values[5] = make_time(s.st_mtime);
1419 values[6] = make_time(s.st_ctime);
1420 values[7] = make_int((EMACS_INT) s.st_size);
1421 /* If the size is out of range, give back -1. */
1422 /* #### Fix when Emacs gets bignums! */
1423 if (XINT(values[7]) != s.st_size)
1424 values[7] = make_int(-1);
1425 filemodestring(&s, modes);
1426 values[8] = make_string((Bufbyte *) modes, 10);
1427 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
1431 if (!NILP(directory)
1432 && sxemacs_stat((char *)XSTRING_DATA(directory), &sdir) == 0)
1433 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
1434 else /* if we can't tell, assume worst */
1437 #else /* file gid will be egid */
1438 values[9] = (s.st_gid != getegid())? Qt : Qnil;
1439 #endif /* BSD4_2 or BSD4_3 */
1440 values[10] = make_int(s.st_ino);
1441 values[11] = make_int(s.st_dev);
1443 return Flist(countof(values), values);
1447 /************************************************************************/
1448 /* initialization */
1449 /************************************************************************/
1451 void syms_of_dired(void)
1453 defsymbol(&Qdirectory_files, "directory-files");
1454 defsymbol(&Qdirectory_files_recur, "directory-files-recur");
1455 defsymbol(&Qfile_name_completion, "file-name-completion");
1456 defsymbol(&Qfile_name_all_completions, "file-name-all-completions");
1457 defsymbol(&Qfile_attributes, "file-attributes");
1459 defsymbol(&Qcompanion_bf, "companion-bf");
1460 defsymbol(&Qsorted_list, "sorted-list");
1461 defsymbol(&Qdesc_sorted_list, "desc-sorted-list");
1462 defsymbol(&Qunsorted_list, "unsorted-list");
1463 defsymbol(&Qmatch_full, "match-full");
1465 DEFSUBR(Fdirectory_files);
1466 DEFSUBR(Fdirectory_files_recur);
1467 DEFSUBR(Ffile_name_completion);
1468 DEFSUBR(Ffile_name_all_completions);
1469 DEFSUBR(Fuser_name_completion);
1470 DEFSUBR(Fuser_name_completion_1);
1471 DEFSUBR(Fuser_name_all_completions);
1472 DEFSUBR(Ffile_attributes);
1475 void vars_of_dired(void)
1477 DEFVAR_LISP("completion-ignored-extensions",
1478 &Vcompletion_ignored_extensions /*
1479 *Completion ignores filenames ending in any string in this list.
1480 This variable does not affect lists of possible completions,
1481 but does affect the commands that actually do completions.
1482 It is used by the function `file-name-completion'.
1484 Vcompletion_ignored_extensions = Qnil;
1486 DEFVAR_LISP("directory-files-no-trivial-p",
1487 &Vdirectory_files_no_trivial_p /*
1488 Determine whether to _not_ add the trivial directory entries
1490 ATTENTION: This variable is definitely NOT for users.
1491 For easy temporary circumvention use a let binding.
1493 Vdirectory_files_no_trivial_p = Qnil;