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, 7, 0, /*
616 Return a list of names of files in DIRECTORY.
617 Args are DIRECTORY &optional FULL MATCH RESULT-TYPE FILES_ONLY
618 SYMLINK_IS_FILE BLOOM_FILTER
620 There are four optional arguments:
622 - t to return absolute pathnames of the files.
623 - match-full to return and match on absolute pathnames of the files.
624 - nil to return relative filenames.
626 If MATCH is non-nil, it may be a string indicating a regular
627 expression which pathnames must meet in order to be returned.
628 Moreover, a predicate function can be specified which is called with
629 one argument, the pathname in question. On non-nil return value, the
630 pathname is considered in the final result, otherwise it is ignored.
631 Note that FULL affects whether the match is done on the filename of
634 Optional argument RESULT-TYPE can be one of:
635 - sorted-list (default) to return a list, sorted in alphabetically
637 - desc-sorted-list to return a list, sorted in alphabetically
639 - list to return an unsorted list
640 - dllist to return an unsorted dllist
641 The two latter types can be useful if you plan to sort the result
642 yourself, or want to feed the result to further processing.
644 For compatibility with XEmacs' NOSORT argument to this function,
645 RESULT-TYPE can also be any non-nil value. In that case it will
646 return an unsorted list. (https://issues.sxemacs.org/show_bug.cgi?id=163)
648 Optional argument FILES-ONLY can be one of:
649 - t to return only files and symlinks in DIRECTORY
650 - nil (default) to return all entries (files, symlinks, and
651 subdirectories) in DIRECTORY
652 - subdir to return only subdirectories -- but *NOT* symlinks to
653 directories -- in DIRECTORY
655 Optional argument SYMLINK-IS-FILE specifies whether symlinks
656 should be resolved \(which is the default behaviour\) or whether
657 they are treated as ordinary files \(non-nil\), in the latter
658 case symlinks to directories are not recurred.
660 Optional argument BLOOM-FILTER specifies a bloom filter where
661 to put results in addition to the ordinary result list.
663 (directory, full, match, result_type, files_only,
664 symlink_is_file, bloom_filter))
666 Lisp_Object handler = Qnil;
667 Lisp_Object result = Qnil;
668 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
669 /* just a convenience array for gc pro'ing */
670 Lisp_Object args[8] = {
671 directory, match, result_type, files_only,
672 symlink_is_file, bloom_filter, handler, result};
674 struct dfr_options_s opts = {
676 .fullp = !NILP(full),
677 .symlink_file_p = !NILP(symlink_is_file),
678 .matchfullp = EQ(full,Qmatch_full),
682 /* argument checks */
683 CHECK_STRING(directory);
685 GCPROn(args, countof(args));
687 directory = directory_files_canonicalise_dn(directory);
689 /* If the file name has special constructs in it,
690 call the corresponding file handler. */
691 handler = Ffind_file_name_handler(directory, Qdirectory_files);
692 if (!NILP(handler)) {
694 return call8(handler, Qdirectory_files,
695 directory, full, match, result_type, files_only,
696 symlink_is_file, bloom_filter);
699 result = directory_files_magic(directory, match,
700 files_only, bloom_filter,
704 return directory_files_resultify(result, result_type);
707 DEFUN("directory-files-recur", Fdirectory_files_recur, 1, 8, 0, /*
708 Like `directory-files' but recursive and much faster.
709 Args are DIRECTORY &optional FULL MATCH RESULT_TYPE FILES-ONLY MAXDEPTH
710 SYMLINK_IS_FILE BLOOM_FILTER
713 - t to return absolute pathnames of the files.
714 - match-full to return and match on absolute pathnames of the files.
715 - nil to return relative filenames.
717 If MATCH is non-nil, it may be a string indicating a regular
718 expression which pathnames must meet in order to be returned.
719 Moreover, a predicate function can be specified which is called with
720 one argument, the pathname in question. On non-nil return value, the
721 pathname is considered in the final result, otherwise it is ignored.
722 Note that FULL affects whether the match is done on the filename of
725 Optional argument RESULT-TYPE can be one of:
726 - sorted-list (default) to return a list, sorted in alphabetically
728 - desc-sorted-list to return a list, sorted in alphabetically
730 - list to return an unsorted list
731 - dllist to return an unsorted dllist
732 The two latter types can be useful if you plan to sort the result
733 yourself, or want to feed the result to further processing.
735 Optional argument FILES-ONLY can be one of:
736 - t to return only files and symlinks in DIRECTORY
737 - nil (default) to return all entries (files, symlinks, and
738 subdirectories) in DIRECTORY
739 - subdir to return only subdirectories -- but *NOT* symlinks to
740 directories -- in DIRECTORY
742 Optional argument MAXDEPTH \(a positive integer\) specifies the
743 maximal recursion depth, use 0 to emulate old `directory-files'.
745 Optional argument SYMLINK-IS-FILE specifies whether symlinks
746 should be resolved \(which is the default behaviour\) or whether
747 they are treated as ordinary files \(non-nil\), in the latter
748 case symlinks to directories are not recurred.
750 Optional argument BLOOM-FILTER specifies a bloom filter where
751 to put results in addition to the ordinary result list.
753 (directory, full, match, result_type, files_only, maxdepth,
754 symlink_is_file, bloom_filter))
756 Lisp_Object handler = Qnil, result = Qnil;
757 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
758 /* just a convenience array for gc pro'ing */
759 Lisp_Object args[8] = {
760 directory, match, result_type, files_only,
761 symlink_is_file, bloom_filter, handler, result};
763 struct dfr_options_s opts = {
765 .fullp = !NILP(full),
766 .symlink_file_p = !NILP(symlink_is_file),
767 .matchfullp = EQ(full, Qmatch_full),
771 /* argument checks */
772 CHECK_STRING(directory);
773 if (!NILP(maxdepth)) {
774 CHECK_NATNUM(maxdepth);
775 opts.maxdepth = XUINT(maxdepth);
778 GCPROn(args, countof(args));
780 directory = directory_files_canonicalise_dn(directory);
782 /* If the file name has special constructs in it,
783 call the corresponding file handler. */
784 handler = Ffind_file_name_handler(directory, Qdirectory_files_recur);
785 if (!NILP(handler)) {
788 res = call9(handler, Qdirectory_files_recur,
789 directory, full, match, result_type, files_only,
790 maxdepth, symlink_is_file, bloom_filter);
795 result = directory_files_magic(directory, match,
796 files_only, bloom_filter,
798 /* convert to final result type */
799 result = directory_files_resultify(result, result_type);
805 static Lisp_Object file_name_completion(Lisp_Object file,
806 Lisp_Object directory,
807 int all_flag, int ver_flag);
809 DEFUN("file-name-completion", Ffile_name_completion, 2, 2, 0, /*
810 Complete file name PARTIAL-FILENAME in directory DIRECTORY.
811 Return the longest prefix common to all file names in DIRECTORY
812 that start with PARTIAL-FILENAME.
813 If there is only one and PARTIAL-FILENAME matches it exactly, return t.
814 Return nil if DIRECTORY contains no name starting with PARTIAL-FILENAME.
816 File names which end with any member of `completion-ignored-extensions'
817 are not considered as possible completions for PARTIAL-FILENAME unless
818 there is no other possible completion. `completion-ignored-extensions'
819 is not applied to the names of directories.
821 (partial_filename, directory))
823 /* This function can GC. GC checked 1996.04.06. */
826 /* If the directory name has special constructs in it,
827 call the corresponding file handler. */
828 handler = Ffind_file_name_handler(directory, Qfile_name_completion);
830 return call3(handler, Qfile_name_completion, partial_filename,
833 /* If the file name has special constructs in it,
834 call the corresponding file handler. */
836 Ffind_file_name_handler(partial_filename, Qfile_name_completion);
838 return call3(handler, Qfile_name_completion, partial_filename,
841 return file_name_completion(partial_filename, directory, 0, 0);
844 DEFUN("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
845 Return a list of all completions of PARTIAL-FILENAME in DIRECTORY.
846 These are all file names in DIRECTORY which begin with PARTIAL-FILENAME.
848 (partial_filename, directory))
850 /* This function can GC. GC checked 1997.06.04. */
855 directory = Fexpand_file_name(directory, Qnil);
856 /* If the file name has special constructs in it,
857 call the corresponding file handler. */
859 Ffind_file_name_handler(directory, Qfile_name_all_completions);
862 return call3(handler, Qfile_name_all_completions,
863 partial_filename, directory);
865 return file_name_completion(partial_filename, directory, 1, 0);
869 file_name_completion_stat(Lisp_Object directory, DIRENTRY * dp,
870 struct stat *st_addr)
872 Bytecount len = NAMLEN(dp);
873 Bytecount pos = XSTRING_LENGTH(directory);
875 char *fullname = (char *)alloca(len + pos + 2);
877 memcpy(fullname, XSTRING_DATA(directory), pos);
878 if (!IS_DIRECTORY_SEP(fullname[pos - 1]))
879 fullname[pos++] = DIRECTORY_SEP;
881 memcpy(fullname + pos, dp->d_name, len);
882 fullname[pos + len] = 0;
885 /* We want to return success if a link points to a nonexistent file,
886 but we want to return the status for what the link points to,
887 in case it is a directory. */
888 value = lstat(fullname, st_addr);
889 if (S_ISLNK(st_addr->st_mode))
890 (void)sxemacs_stat(fullname, st_addr);
892 value = sxemacs_stat(fullname, st_addr);
897 static Lisp_Object file_name_completion_unwind(Lisp_Object locative)
900 Lisp_Object obj = XCAR(locative);
903 d = (DIR *) get_opaque_ptr(obj);
905 free_opaque_ptr(obj);
907 free_cons(XCONS(locative));
912 file_name_completion(Lisp_Object file, Lisp_Object directory, int all_flag,
915 /* This function can GC */
918 Lisp_Object bestmatch = Qnil;
919 Charcount bestmatchsize = 0;
922 int speccount = specpdl_depth();
923 Charcount file_name_length;
924 Lisp_Object locative;
925 struct gcpro gcpro1, gcpro2, gcpro3;
927 GCPRO3(file, directory, bestmatch);
931 #ifdef FILE_SYSTEM_CASE
932 file = FILE_SYSTEM_CASE(file);
934 directory = Fexpand_file_name(directory, Qnil);
935 file_name_length = XSTRING_CHAR_LENGTH(file);
937 /* With passcount = 0, ignore files that end in an ignored extension.
938 If nothing found then try again with passcount = 1, don't ignore them.
939 If looking for all completions, start with passcount = 1,
940 so always take even the ignored ones.
942 ** It would not actually be helpful to the user to ignore any possible
943 completions when making a list of them.** */
945 /* We cannot use close_directory_unwind() because we change the
946 directory. The old code used to just avoid signaling errors, and
947 call closedir, but it was wrong, because it made sane handling of
948 QUIT impossible and, besides, various utility functions like
949 regexp_ignore_completion_p can signal errors. */
950 locative = noseeum_cons(Qnil, Qnil);
951 record_unwind_protect(file_name_completion_unwind, locative);
953 for (passcount = !!all_flag; NILP(bestmatch) && passcount < 2;
955 Lisp_Object tmp_dfn = Fdirectory_file_name(directory);
956 d = opendir((char *)XSTRING_DATA(tmp_dfn));
958 report_file_error("Opening directory",
961 XCAR(locative) = make_opaque_ptr((void *)d);
963 /* Loop reading blocks */
967 /* scmp() works in characters, not bytes, so we have to compute
971 int ignored_extension_p = 0;
978 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
979 d_name = (Bufbyte *) dp->d_name;
981 cclen = bytecount_to_charcount(d_name, len);
985 if (!DIRENTRY_NONEMPTY(dp)
986 || cclen < file_name_length
987 || 0 <= scmp(d_name, XSTRING_DATA(file),
991 if (file_name_completion_stat(directory, dp, &st) < 0)
994 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
996 /* "." and ".." are never interesting as completions, but are
997 actually in the way in a directory containing only one file. */
999 && TRIVIAL_DIRECTORY_ENTRY(dp->d_name))
1002 /* Compare extensions-to-be-ignored against end of this file name */
1003 /* if name is not an exact match against specified string. */
1004 if (!passcount && cclen > file_name_length) {
1006 /* and exit this for loop if a match is found */
1007 EXTERNAL_LIST_LOOP(tem,
1008 Vcompletion_ignored_extensions)
1010 Lisp_Object elt = XCAR(tem);
1017 XSTRING_CHAR_LENGTH(elt);
1027 ignored_extension_p = 1;
1034 /* If an ignored-extensions match was found,
1035 don't process this name as a completion. */
1036 if (!passcount && ignored_extension_p)
1040 && regexp_ignore_completion_p(d_name, Qnil, 0,
1044 /* Update computation of how much all possible completions match */
1047 if (all_flag || NILP(bestmatch)) {
1048 Lisp_Object name = Qnil;
1049 struct gcpro ngcpro1;
1051 /* This is a possible completion */
1052 name = make_string(d_name, len);
1053 if (directoryp) /* Completion is a directory; end it with '/' */
1054 name = Ffile_name_as_directory(name);
1056 bestmatch = Fcons(name, bestmatch);
1060 XSTRING_CHAR_LENGTH(name);
1064 Charcount compare = min(bestmatchsize, cclen);
1065 Bufbyte *p1 = XSTRING_DATA(bestmatch);
1066 Bufbyte *p2 = d_name;
1067 Charcount matchsize = scmp(p1, p2, compare);
1070 matchsize = compare;
1071 if (completion_ignore_case) {
1072 /* If this is an exact match except for case,
1073 use it as the best match rather than one that is not
1074 an exact match. This way, we get the case pattern
1075 of the actual match. */
1076 if ((matchsize == cclen
1077 && matchsize + !!directoryp
1078 < XSTRING_CHAR_LENGTH(bestmatch))
1080 /* If there is no exact match ignoring case,
1081 prefer a match that does not change the case
1083 (((matchsize == cclen)
1085 (matchsize + !!directoryp
1087 XSTRING_CHAR_LENGTH(bestmatch)))
1088 /* If there is more than one exact match aside from
1089 case, and one of them is exact including case,
1093 file_name_length, 0)
1099 make_string(d_name, len);
1102 Ffile_name_as_directory
1107 /* If this directory all matches,
1108 see if implicit following slash does too. */
1110 && compare == matchsize
1111 && bestmatchsize > matchsize
1113 IS_ANY_SEP(charptr_emchar_n(p1, matchsize)))
1115 bestmatchsize = matchsize;
1119 free_opaque_ptr(XCAR(locative));
1120 XCAR(locative) = Qnil;
1123 unbind_to(speccount, Qnil);
1127 if (all_flag || NILP(bestmatch))
1129 if (matchcount == 1 && bestmatchsize == file_name_length)
1131 return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1134 static Lisp_Object user_name_completion(Lisp_Object user,
1135 int all_flag, int *uniq);
1137 DEFUN("user-name-completion", Fuser_name_completion, 1, 1, 0, /*
1138 Complete user name from PARTIAL-USERNAME.
1139 Return the longest prefix common to all user names starting with
1140 PARTIAL-USERNAME. If there is only one and PARTIAL-USERNAME matches
1141 it exactly, returns t. Return nil if there is no user name starting
1142 with PARTIAL-USERNAME.
1146 return user_name_completion(partial_username, 0, NULL);
1149 DEFUN("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /*
1150 Complete user name from PARTIAL-USERNAME.
1152 This function is identical to `user-name-completion', except that
1153 the cons of the completion and an indication of whether the
1154 completion was unique is returned.
1156 The car of the returned value is the longest prefix common to all user
1157 names that start with PARTIAL-USERNAME. If there is only one and
1158 PARTIAL-USERNAME matches it exactly, the car is t. The car is nil if
1159 there is no user name starting with PARTIAL-USERNAME. The cdr of the
1160 result is non-nil if and only if the completion returned in the car
1166 Lisp_Object completed =
1167 user_name_completion(partial_username, 0, &uniq);
1168 return Fcons(completed, uniq ? Qt : Qnil);
1171 DEFUN("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
1172 Return a list of all user name completions from PARTIAL-USERNAME.
1173 These are all the user names which begin with PARTIAL-USERNAME.
1177 return user_name_completion(partial_username, 1, NULL);
1186 struct user_name *user_names;
1189 EMACS_TIME last_rebuild_time;
1191 static struct user_cache user_cache;
1193 static void free_user_cache(struct user_cache *cache)
1196 for (i = 0; i < cache->length; i++)
1197 xfree(cache->user_names[i].ptr);
1198 xfree(cache->user_names);
1202 static Lisp_Object user_name_completion_unwind(Lisp_Object cache_incomplete_p)
1205 speed_up_interrupts();
1207 if (!NILP(XCAR(cache_incomplete_p)))
1208 free_user_cache(&user_cache);
1210 free_cons(XCONS(cache_incomplete_p));
1215 #define USER_CACHE_TTL (24*60*60) /* Time to live: 1 day, in seconds */
1218 user_name_completion(Lisp_Object user, int all_flag, int *uniq)
1220 /* This function can GC */
1222 Lisp_Object bestmatch = Qnil;
1223 Charcount bestmatchsize = 0;
1224 Charcount user_name_length;
1227 struct gcpro gcpro1, gcpro2;
1229 GCPRO2(user, bestmatch);
1233 user_name_length = XSTRING_CHAR_LENGTH(user);
1235 /* Cache user name lookups because it tends to be quite slow.
1236 * Rebuild the cache occasionally to catch changes */
1238 if (user_cache.user_names &&
1239 (EMACS_SECS(t) - EMACS_SECS(user_cache.last_rebuild_time)
1241 free_user_cache(&user_cache);
1243 if (!user_cache.user_names) {
1245 Lisp_Object cache_incomplete_p = noseeum_cons(Qt, Qnil);
1246 int speccount = specpdl_depth();
1248 slow_down_interrupts();
1250 record_unwind_protect(user_name_completion_unwind,
1251 cache_incomplete_p);
1252 while ((pwd = getpwent())) {
1254 DO_REALLOC(user_cache.user_names, user_cache.size,
1255 user_cache.length + 1, struct user_name);
1256 TO_INTERNAL_FORMAT(C_STRING, pwd->pw_name,
1259 user_names[user_cache.length].ptr,
1260 user_cache.user_names[user_cache.
1263 user_cache.length++;
1265 XCAR(cache_incomplete_p) = Qnil;
1266 unbind_to(speccount, Qnil);
1268 EMACS_GET_TIME(user_cache.last_rebuild_time);
1271 for (i = 0; i < user_cache.length; i++) {
1272 Bufbyte *u_name = user_cache.user_names[i].ptr;
1273 Bytecount len = user_cache.user_names[i].len;
1274 /* scmp() works in chars, not bytes, so we have to compute this: */
1275 Charcount cclen = bytecount_to_charcount(u_name, len);
1279 if (cclen < user_name_length
1280 || 0 <= scmp_1(u_name, XSTRING_DATA(user), user_name_length,
1284 matchcount++; /* count matching completions */
1286 if (all_flag || NILP(bestmatch)) {
1287 Lisp_Object name = Qnil;
1288 struct gcpro ngcpro1;
1290 /* This is a possible completion */
1291 name = make_string(u_name, len);
1293 bestmatch = Fcons(name, bestmatch);
1296 bestmatchsize = XSTRING_CHAR_LENGTH(name);
1300 Charcount compare = min(bestmatchsize, cclen);
1301 Bufbyte *p1 = XSTRING_DATA(bestmatch);
1302 Bufbyte *p2 = u_name;
1303 Charcount matchsize = scmp_1(p1, p2, compare, 0);
1306 matchsize = compare;
1308 bestmatchsize = matchsize;
1315 *uniq = (matchcount == 1);
1317 if (all_flag || NILP(bestmatch))
1319 if (matchcount == 1 && bestmatchsize == user_name_length)
1321 return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1324 Lisp_Object make_directory_hash_table(const char *path)
1327 if ((d = opendir(path))) {
1330 make_lisp_hash_table(20, HASH_TABLE_NON_WEAK,
1333 while ((dp = readdir(d))) {
1334 Bytecount len = NAMLEN(dp);
1335 if (DIRENTRY_NONEMPTY(dp))
1336 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
1337 Fputhash(make_string
1338 ((Bufbyte *) dp->d_name, len), Qt,
1348 /* ... never used ... should use list2 directly anyway ... */
1349 /* NOTE: This function can never return a negative value. */
1350 Lisp_Object wasteful_word_to_lisp(unsigned int item)
1352 /* Compatibility: in other versions, file-attributes returns a LIST
1353 of two 16 bit integers... */
1354 Lisp_Object cons = word_to_lisp(item);
1355 XCDR(cons) = Fcons(XCDR(cons), Qnil);
1360 DEFUN("file-attributes", Ffile_attributes, 1, 1, 0, /*
1361 Return a list of attributes of file FILENAME.
1362 Value is nil if specified file cannot be opened.
1363 Otherwise, list elements are:
1364 0. t for directory, string (name linked to) for symbolic link, or nil.
1365 1. Number of links to file.
1368 4. Last access time, as a list of two integers.
1369 First integer has high-order 16 bits of time, second has low 16 bits.
1370 5. Last modification time, likewise.
1371 6. Last status change time, likewise.
1372 7. Size in bytes. (-1, if number is out of range).
1373 8. File modes, as a string of ten letters or dashes as in ls -l.
1374 9. t iff file's gid would change if file were deleted and recreated.
1378 If file does not exist, returns nil.
1382 /* This function can GC. GC checked 1997.06.04. */
1383 Lisp_Object values[12];
1384 #if defined (BSD4_2) || defined (BSD4_3) || \
1385 !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1386 Lisp_Object directory = Qnil;
1387 #endif /* BSD4_2 || BSD4_3 || !BDWGC */
1390 Lisp_Object handler;
1391 struct gcpro gcpro1, gcpro2;
1393 GCPRO2(filename, directory);
1394 filename = Fexpand_file_name(filename, Qnil);
1396 /* If the file name has special constructs in it,
1397 call the corresponding file handler. */
1398 handler = Ffind_file_name_handler(filename, Qfile_attributes);
1399 if (!NILP(handler)) {
1401 return call2(handler, Qfile_attributes, filename);
1404 if (lstat((char *)XSTRING_DATA(filename), &s) < 0) {
1409 directory = Ffile_name_directory(filename);
1412 switch (s.st_mode & S_IFMT) {
1421 values[0] = Ffile_symlink_p(filename);
1425 values[1] = make_int(s.st_nlink);
1426 values[2] = make_int(s.st_uid);
1427 values[3] = make_int(s.st_gid);
1428 values[4] = make_time(s.st_atime);
1429 values[5] = make_time(s.st_mtime);
1430 values[6] = make_time(s.st_ctime);
1431 values[7] = make_int((EMACS_INT) s.st_size);
1432 /* If the size is out of range, give back -1. */
1433 /* #### Fix when Emacs gets bignums! */
1434 if (XINT(values[7]) != s.st_size)
1435 values[7] = make_int(-1);
1436 filemodestring(&s, modes);
1437 values[8] = make_string((Bufbyte *) modes, 10);
1438 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
1442 if (!NILP(directory)
1443 && sxemacs_stat((char *)XSTRING_DATA(directory), &sdir) == 0)
1444 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
1445 else /* if we can't tell, assume worst */
1448 #else /* file gid will be egid */
1449 values[9] = (s.st_gid != getegid())? Qt : Qnil;
1450 #endif /* BSD4_2 or BSD4_3 */
1451 values[10] = make_int(s.st_ino);
1452 values[11] = make_int(s.st_dev);
1454 return Flist(countof(values), values);
1458 /************************************************************************/
1459 /* initialization */
1460 /************************************************************************/
1462 void syms_of_dired(void)
1464 defsymbol(&Qdirectory_files, "directory-files");
1465 defsymbol(&Qdirectory_files_recur, "directory-files-recur");
1466 defsymbol(&Qfile_name_completion, "file-name-completion");
1467 defsymbol(&Qfile_name_all_completions, "file-name-all-completions");
1468 defsymbol(&Qfile_attributes, "file-attributes");
1470 defsymbol(&Qcompanion_bf, "companion-bf");
1471 defsymbol(&Qsorted_list, "sorted-list");
1472 defsymbol(&Qdesc_sorted_list, "desc-sorted-list");
1473 defsymbol(&Qunsorted_list, "unsorted-list");
1474 defsymbol(&Qmatch_full, "match-full");
1476 DEFSUBR(Fdirectory_files);
1477 DEFSUBR(Fdirectory_files_recur);
1478 DEFSUBR(Ffile_name_completion);
1479 DEFSUBR(Ffile_name_all_completions);
1480 DEFSUBR(Fuser_name_completion);
1481 DEFSUBR(Fuser_name_completion_1);
1482 DEFSUBR(Fuser_name_all_completions);
1483 DEFSUBR(Ffile_attributes);
1486 void vars_of_dired(void)
1488 DEFVAR_LISP("completion-ignored-extensions",
1489 &Vcompletion_ignored_extensions /*
1490 *Completion ignores filenames ending in any string in this list.
1491 This variable does not affect lists of possible completions,
1492 but does affect the commands that actually do completions.
1493 It is used by the function `file-name-completion'.
1495 Vcompletion_ignored_extensions = Qnil;
1497 DEFVAR_LISP("directory-files-no-trivial-p",
1498 &Vdirectory_files_no_trivial_p /*
1499 Determine whether to _not_ add the trivial directory entries
1501 ATTENTION: This variable is definitely NOT for users.
1502 For easy temporary circumvention use a let binding.
1504 Vdirectory_files_no_trivial_p = Qnil;