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 && !opts->symlink_file_p) {
278 char *canon_name = NULL;
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.
290 canon_name = CANONICALISE_FILENAME(statnam);
293 /* now, recycle full name */
294 fullname = make_ext_string(
295 canon_name, strlen(canon_name),
298 fullname = fname_as_directory(fullname);
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? */
305 !(bloom_owns_p(XBLOOM(compbf), fullname))) {
315 #endif /* defined(_DIRENT_HAVE_D_TYPE) && USE_D_TYPE */
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
330 * Hm, I think I'd choose the latter variant, it is
331 not that performant, but it avoids two problems:
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 "."
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
342 * Anyone wants to help brainstorming?
345 /* check if we put it on the list of matches */
346 if (NILP(files_only)) {
348 } else if (EQ(files_only, Qt) && !dir_p) {
350 } else if (!EQ(files_only, Qt) && dir_p) {
356 if (curdepth >= opts->maxdepth) {
361 dired_stack_item_t dsi;
362 dsi = xnew_and_zero(struct dired_stack_item_s);
364 dsi->depth = 1+curdepth;
365 dired_stack_push(ds, dsi);
368 if (result_p && !NILP(match)
369 && !pathname_matches_p((opts->matchfullp?fullname:name),
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);
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)
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);
401 dirent_t *res = NULL;
402 struct gcpro gcpro1, gcpro2;
404 GCPRO2(dir, fulldir);
408 dir = fname_as_directory(dir);
409 fulldir = fname_as_directory(fulldir);
411 /* add the full directory name to the companion bloom filter */
413 bloom_add(XBLOOM(compbf), fulldir);
415 /* external format conversion is done in the encapsulation of
416 * opendir in sysdep.c
418 d = opendir((char*)XSTRING_DATA(fulldir));
420 /* why should we want this? I think spitting a warning
426 report_file_error("Opening directory", list1(fulldir));
431 warn_when_safe(Qfile, Qwarning,
432 "Opening directory `%s' failed",
433 (char*)XSTRING_DATA(fulldir));
439 record_unwind_protect(close_directory_unwind,
440 make_opaque_ptr((void *)d));
442 while (DFR_READDIR(d, ent, &res) == 0 && res != NULL) {
443 dfr_inner(res, fulldir, dir,
445 files_only, dpt, ds, match, bufp,
446 result, bloom_filter);
453 dired_stack_mark(Lisp_Object obj)
455 dired_stack_t ds = get_dynacat(obj);
456 WITH_DLLIST_TRAVERSE(
458 dired_stack_item_t dsi = dllist_item;
459 mark_object(dsi->dir));
465 dired_stack_fini(Lisp_Object obj)
467 dired_stack_t ds = get_dynacat(obj);
468 free_dired_stack(ds);
474 directory_files_magic(Lisp_Object directory, Lisp_Object match,
475 Lisp_Object files_only, Lisp_Object bloom_filter,
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;
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);
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. */
501 if (STRINGP(match)) {
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! */
511 } else if (!NILP(Ffunctionp(match))) {
514 return wrong_type_argument(Qstringp, match);
518 regex_match_object = Qnil;
519 regex_emacs_buffer = current_buffer;
521 if (opts->maxdepth > 0) {
522 compbf = make_bloom(8192, 8);
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);
529 dired_stack_push(ds, ds_item);
531 /* alloc the directory entry pointer */
533 dirent_t _ent, *ent = &_ent;
536 memset(ent, 0, sizeof(dirent_t));
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);
548 /* save the companion bloom filter */
549 Fput(result, Qcompanion_bf, compbf);
556 directory_files_canonicalise_dn(Lisp_Object directory)
561 /* expand the directory argument and canonicalise */
562 directory = Fexpand_file_name(directory, Qnil);
563 directory = fname_as_directory(directory);
565 RETURN_UNGCPRO(directory);
569 directory_files_resultify(Lisp_Object result, Lisp_Object result_type)
571 /* This function can GC */
572 Lisp_Object final_result = Qnil;
573 struct gcpro gcpro1, gcpro2, gcpro3;
574 GCPRO3(result, result_type, final_result);
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);
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)
599 /* This function can GC */
601 Lisp_Object res, args[10] = {fn, arg0, arg1, arg2, arg3,
602 arg4, arg5, arg6, arg7, arg8};
604 GCPROn(args, countof(args));
605 res = Ffuncall(10, args);
612 EXFUN(Fdirectory_files_recur, 8);
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
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 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.
659 Optional argument BLOOM-FILTER specifies a bloom filter where
660 to put results in addition to the ordinary result list.
662 (directory, full, match, result_type, files_only,
663 symlink_is_file, bloom_filter))
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};
673 struct dfr_options_s opts = {
675 .fullp = !NILP(full),
676 .symlink_file_p = !NILP(symlink_is_file),
677 .matchfullp = EQ(full,Qmatch_full),
681 /* argument checks */
682 CHECK_STRING(directory);
684 GCPROn(args, countof(args));
686 directory = directory_files_canonicalise_dn(directory);
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)) {
693 return call8(handler, Qdirectory_files,
694 directory, full, match, result_type, files_only,
695 symlink_is_file, bloom_filter);
698 result = directory_files_magic(directory, match,
699 files_only, bloom_filter,
703 return directory_files_resultify(result, result_type);
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
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.
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
724 Optional argument RESULT-TYPE can be one of:
725 - sorted-list (default) to return a list, sorted in alphabetically
727 - desc-sorted-list to return a list, sorted in alphabetically
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.
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
741 Optional argument MAXDEPTH \(a positive integer\) specifies the
742 maximal recursion depth, use 0 to emulate old `directory-files'.
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.
749 Optional argument BLOOM-FILTER specifies a bloom filter where
750 to put results in addition to the ordinary result list.
752 (directory, full, match, result_type, files_only, maxdepth,
753 symlink_is_file, bloom_filter))
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};
762 struct dfr_options_s opts = {
764 .fullp = !NILP(full),
765 .symlink_file_p = !NILP(symlink_is_file),
766 .matchfullp = EQ(full, Qmatch_full),
770 /* argument checks */
771 CHECK_STRING(directory);
772 if (!NILP(maxdepth)) {
773 CHECK_NATNUM(maxdepth);
774 opts.maxdepth = XUINT(maxdepth);
777 GCPROn(args, countof(args));
779 directory = directory_files_canonicalise_dn(directory);
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)) {
787 res = call9(handler, Qdirectory_files_recur,
788 directory, full, match, result_type, files_only,
789 maxdepth, symlink_is_file, bloom_filter);
794 result = directory_files_magic(directory, match,
795 files_only, bloom_filter,
797 /* convert to final result type */
798 result = directory_files_resultify(result, result_type);
804 static Lisp_Object file_name_completion(Lisp_Object file,
805 Lisp_Object directory,
806 int all_flag, int ver_flag);
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.
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.
820 (partial_filename, directory))
822 /* This function can GC. GC checked 1996.04.06. */
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);
829 return call3(handler, Qfile_name_completion, partial_filename,
832 /* If the file name has special constructs in it,
833 call the corresponding file handler. */
835 Ffind_file_name_handler(partial_filename, Qfile_name_completion);
837 return call3(handler, Qfile_name_completion, partial_filename,
840 return file_name_completion(partial_filename, directory, 0, 0);
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.
847 (partial_filename, directory))
849 /* This function can GC. GC checked 1997.06.04. */
854 directory = Fexpand_file_name(directory, Qnil);
855 /* If the file name has special constructs in it,
856 call the corresponding file handler. */
858 Ffind_file_name_handler(directory, Qfile_name_all_completions);
861 return call3(handler, Qfile_name_all_completions,
862 partial_filename, directory);
864 return file_name_completion(partial_filename, directory, 1, 0);
868 file_name_completion_stat(Lisp_Object directory, DIRENTRY * dp,
869 struct stat *st_addr)
871 Bytecount len = NAMLEN(dp);
872 Bytecount pos = XSTRING_LENGTH(directory);
874 char *fullname = (char *)alloca(len + pos + 2);
876 memcpy(fullname, XSTRING_DATA(directory), pos);
877 if (!IS_DIRECTORY_SEP(fullname[pos - 1]))
878 fullname[pos++] = DIRECTORY_SEP;
880 memcpy(fullname + pos, dp->d_name, len);
881 fullname[pos + len] = 0;
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);
891 value = sxemacs_stat(fullname, st_addr);
896 static Lisp_Object file_name_completion_unwind(Lisp_Object locative)
899 Lisp_Object obj = XCAR(locative);
902 d = (DIR *) get_opaque_ptr(obj);
904 free_opaque_ptr(obj);
906 free_cons(XCONS(locative));
911 file_name_completion(Lisp_Object file, Lisp_Object directory, int all_flag,
914 /* This function can GC */
917 Lisp_Object bestmatch = Qnil;
918 Charcount bestmatchsize = 0;
921 int speccount = specpdl_depth();
922 Charcount file_name_length;
923 Lisp_Object locative;
924 struct gcpro gcpro1, gcpro2, gcpro3;
926 GCPRO3(file, directory, bestmatch);
930 #ifdef FILE_SYSTEM_CASE
931 file = FILE_SYSTEM_CASE(file);
933 directory = Fexpand_file_name(directory, Qnil);
934 file_name_length = XSTRING_CHAR_LENGTH(file);
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.
941 ** It would not actually be helpful to the user to ignore any possible
942 completions when making a list of them.** */
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);
952 for (passcount = !!all_flag; NILP(bestmatch) && passcount < 2;
954 Lisp_Object tmp_dfn = Fdirectory_file_name(directory);
955 d = opendir((char *)XSTRING_DATA(tmp_dfn));
957 report_file_error("Opening directory",
960 XCAR(locative) = make_opaque_ptr((void *)d);
962 /* Loop reading blocks */
966 /* scmp() works in characters, not bytes, so we have to compute
970 int ignored_extension_p = 0;
977 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
978 d_name = (Bufbyte *) dp->d_name;
980 cclen = bytecount_to_charcount(d_name, len);
984 if (!DIRENTRY_NONEMPTY(dp)
985 || cclen < file_name_length
986 || 0 <= scmp(d_name, XSTRING_DATA(file),
990 if (file_name_completion_stat(directory, dp, &st) < 0)
993 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
995 /* "." and ".." are never interesting as completions, but are
996 actually in the way in a directory containing only one file. */
998 && TRIVIAL_DIRECTORY_ENTRY(dp->d_name))
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) {
1005 /* and exit this for loop if a match is found */
1006 EXTERNAL_LIST_LOOP(tem,
1007 Vcompletion_ignored_extensions)
1009 Lisp_Object elt = XCAR(tem);
1016 XSTRING_CHAR_LENGTH(elt);
1026 ignored_extension_p = 1;
1033 /* If an ignored-extensions match was found,
1034 don't process this name as a completion. */
1035 if (!passcount && ignored_extension_p)
1039 && regexp_ignore_completion_p(d_name, Qnil, 0,
1043 /* Update computation of how much all possible completions match */
1046 if (all_flag || NILP(bestmatch)) {
1047 Lisp_Object name = Qnil;
1048 struct gcpro ngcpro1;
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);
1055 bestmatch = Fcons(name, bestmatch);
1059 XSTRING_CHAR_LENGTH(name);
1063 Charcount compare = min(bestmatchsize, cclen);
1064 Bufbyte *p1 = XSTRING_DATA(bestmatch);
1065 Bufbyte *p2 = d_name;
1066 Charcount matchsize = scmp(p1, p2, compare);
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))
1079 /* If there is no exact match ignoring case,
1080 prefer a match that does not change the case
1082 (((matchsize == cclen)
1084 (matchsize + !!directoryp
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,
1092 file_name_length, 0)
1098 make_string(d_name, len);
1101 Ffile_name_as_directory
1106 /* If this directory all matches,
1107 see if implicit following slash does too. */
1109 && compare == matchsize
1110 && bestmatchsize > matchsize
1112 IS_ANY_SEP(charptr_emchar_n(p1, matchsize)))
1114 bestmatchsize = matchsize;
1118 free_opaque_ptr(XCAR(locative));
1119 XCAR(locative) = Qnil;
1122 unbind_to(speccount, Qnil);
1126 if (all_flag || NILP(bestmatch))
1128 if (matchcount == 1 && bestmatchsize == file_name_length)
1130 return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1133 static Lisp_Object user_name_completion(Lisp_Object user,
1134 int all_flag, int *uniq);
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.
1145 return user_name_completion(partial_username, 0, NULL);
1148 DEFUN("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /*
1149 Complete user name from PARTIAL-USERNAME.
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.
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
1165 Lisp_Object completed =
1166 user_name_completion(partial_username, 0, &uniq);
1167 return Fcons(completed, uniq ? Qt : Qnil);
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.
1176 return user_name_completion(partial_username, 1, NULL);
1185 struct user_name *user_names;
1188 EMACS_TIME last_rebuild_time;
1190 static struct user_cache user_cache;
1192 static void free_user_cache(struct user_cache *cache)
1195 for (i = 0; i < cache->length; i++)
1196 xfree(cache->user_names[i].ptr);
1197 xfree(cache->user_names);
1201 static Lisp_Object user_name_completion_unwind(Lisp_Object cache_incomplete_p)
1204 speed_up_interrupts();
1206 if (!NILP(XCAR(cache_incomplete_p)))
1207 free_user_cache(&user_cache);
1209 free_cons(XCONS(cache_incomplete_p));
1214 #define USER_CACHE_TTL (24*60*60) /* Time to live: 1 day, in seconds */
1217 user_name_completion(Lisp_Object user, int all_flag, int *uniq)
1219 /* This function can GC */
1221 Lisp_Object bestmatch = Qnil;
1222 Charcount bestmatchsize = 0;
1223 Charcount user_name_length;
1226 struct gcpro gcpro1, gcpro2;
1228 GCPRO2(user, bestmatch);
1232 user_name_length = XSTRING_CHAR_LENGTH(user);
1234 /* Cache user name lookups because it tends to be quite slow.
1235 * Rebuild the cache occasionally to catch changes */
1237 if (user_cache.user_names &&
1238 (EMACS_SECS(t) - EMACS_SECS(user_cache.last_rebuild_time)
1240 free_user_cache(&user_cache);
1242 if (!user_cache.user_names) {
1244 Lisp_Object cache_incomplete_p = noseeum_cons(Qt, Qnil);
1245 int speccount = specpdl_depth();
1247 slow_down_interrupts();
1249 record_unwind_protect(user_name_completion_unwind,
1250 cache_incomplete_p);
1251 while ((pwd = getpwent())) {
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,
1258 user_names[user_cache.length].ptr,
1259 user_cache.user_names[user_cache.
1262 user_cache.length++;
1264 XCAR(cache_incomplete_p) = Qnil;
1265 unbind_to(speccount, Qnil);
1267 EMACS_GET_TIME(user_cache.last_rebuild_time);
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);
1278 if (cclen < user_name_length
1279 || 0 <= scmp_1(u_name, XSTRING_DATA(user), user_name_length,
1283 matchcount++; /* count matching completions */
1285 if (all_flag || NILP(bestmatch)) {
1286 Lisp_Object name = Qnil;
1287 struct gcpro ngcpro1;
1289 /* This is a possible completion */
1290 name = make_string(u_name, len);
1292 bestmatch = Fcons(name, bestmatch);
1295 bestmatchsize = XSTRING_CHAR_LENGTH(name);
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);
1305 matchsize = compare;
1307 bestmatchsize = matchsize;
1314 *uniq = (matchcount == 1);
1316 if (all_flag || NILP(bestmatch))
1318 if (matchcount == 1 && bestmatchsize == user_name_length)
1320 return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1323 Lisp_Object make_directory_hash_table(const char *path)
1326 if ((d = opendir(path))) {
1329 make_lisp_hash_table(20, HASH_TABLE_NON_WEAK,
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,
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)
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);
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.
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.
1377 If file does not exist, returns nil.
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 */
1389 Lisp_Object handler;
1390 struct gcpro gcpro1, gcpro2;
1392 GCPRO2(filename, directory);
1393 filename = Fexpand_file_name(filename, Qnil);
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)) {
1400 return call2(handler, Qfile_attributes, filename);
1403 if (lstat((char *)XSTRING_DATA(filename), &s) < 0) {
1408 directory = Ffile_name_directory(filename);
1411 switch (s.st_mode & S_IFMT) {
1420 values[0] = Ffile_symlink_p(filename);
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 */
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 */
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);
1453 return Flist(countof(values), values);
1457 /************************************************************************/
1458 /* initialization */
1459 /************************************************************************/
1461 void syms_of_dired(void)
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");
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");
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);
1485 void vars_of_dired(void)
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'.
1493 Vcompletion_ignored_extensions = Qnil;
1495 DEFVAR_LISP("directory-files-no-trivial-p",
1496 &Vdirectory_files_no_trivial_p /*
1497 Determine whether to _not_ add the trivial directory entries
1499 ATTENTION: This variable is definitely NOT for users.
1500 For easy temporary circumvention use a let binding.
1502 Vdirectory_files_no_trivial_p = Qnil;