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"
45 #define USE_MATCH_ARG 1
47 Lisp_Object Vcompletion_ignored_extensions;
48 Lisp_Object Vdirectory_files_no_trivial_p;
49 Lisp_Object Qdirectory_files;
50 Lisp_Object Qdirectory_files_recur;
51 Lisp_Object Qfile_name_completion;
52 Lisp_Object Qfile_name_all_completions;
53 Lisp_Object Qfile_attributes;
55 Lisp_Object Qcompanion_bf;
56 Lisp_Object Qsorted_list, Qdesc_sorted_list, Qunsorted_list;
57 Lisp_Object Qnoncyclic_directory, Qcyclic_directory;
58 Lisp_Object Qsymlink, Qalive_symlink, Qdead_symlink;
59 Lisp_Object Qwhiteout;
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;
107 static Lisp_Object fname_as_directory(Lisp_Object);
108 static int pathname_matches_p(Lisp_Object, Lisp_Object,
109 struct re_pattern_buffer*);
111 #define dired_stack_t dllist_t
112 #define new_dired_stack() make_noseeum_dllist()
113 #define free_dired_stack(ds) free_noseeum_dllist(ds)
114 #define dired_stack_pop(ds) (dired_stack_item_t)dllist_pop_car(ds)
115 #define dired_stack_push(ds, p) dllist_append(ds, p)
116 #define dired_stack_size(ds) dllist_size(ds)
119 #if defined(HAVE_LARGEFILE)
120 #define dirent_t struct dirent64
121 #define DFR_READDIR readdir64_r
123 #define dirent_t struct dirent
124 #define DFR_READDIR readdir_r
127 #if !defined(HAVE_CANONICALIZE_FILE_NAME)
129 dired_realpath(const char *file)
131 char *result = xmalloc_atomic(4096);
133 if ( realpath(file, result) == NULL ) {
142 fname_as_directory(Lisp_Object fname)
144 if (XSTRING_LENGTH(fname) > 0)
145 return Ffile_name_as_directory(fname);
151 pathname_matches_p(Lisp_Object pathname, Lisp_Object match,
152 struct re_pattern_buffer *bufp)
159 if (STRINGP(match)) {
160 mstr = (char*)XSTRING_DATA(pathname);
161 mlen = XSTRING_LENGTH(pathname);
162 if (re_search(bufp, mstr, mlen, 0, mlen, 0) < 0)
165 speccount2 = specpdl_depth();
166 record_unwind_protect(restore_gc_inhibit,
167 make_int(gc_currently_forbidden));
168 gc_currently_forbidden = 1;
169 if (NILP(call1_trapping_errors(
170 "Error in match function",
175 restore_match_data();
176 unbind_to(speccount2, Qnil);
183 static Lisp_Object close_directory_unwind(Lisp_Object unwind_obj)
185 DIR *d = (DIR *) get_opaque_ptr(unwind_obj);
187 free_opaque_ptr(unwind_obj);
193 dfr_inner(dirent_t *res,
194 Lisp_Object fulldir, Lisp_Object dir, Lisp_Object compbf,
195 dfr_options_t opts, Lisp_Object files_only,
196 unsigned int curdepth, dired_stack_t ds, Lisp_Object match,
197 struct re_pattern_buffer *bufp, Lisp_Object result,
198 Lisp_Object bloom_filter)
200 /* this function can GC */
203 Lisp_Object name = Qnil;
204 Lisp_Object fullname = Qnil;
205 Lisp_Object resname = Qnil;
208 char *statnam = NULL;
209 struct gcpro gcpro1, gcpro2, gcpro3;
211 GCPRO3(name, fullname, resname);
213 if (!DIRENTRY_NONEMPTY(res) ||
214 (TRIVIAL_DIRECTORY_ENTRY(res->d_name) &&
215 !(NILP(Vdirectory_files_no_trivial_p) && opts->maxdepth == 0))) {
221 resname = make_ext_string(res->d_name, len, Qfile_name);
223 FAST_CONCAT(fullname, fulldir, resname);
224 FAST_CONCAT(name, dir, resname);
226 /* we want full file names? */
233 /* check if we have to recur, i.e. if res was a
234 directory, otherwise we assume name to be a
235 file and cons it to the result */
236 #if defined(_DIRENT_HAVE_D_TYPE) && USE_D_TYPE
237 if (res->d_type == DT_DIR) {
239 } else if (res->d_type == DT_LNK && !opts->symlink_file_p) {
240 char *canon_name = NULL;
242 statnam = (char*)XSTRING_DATA(fullname);
244 /* ugly things may happen when a link
245 * points back to a directory in our recurring
246 * area, ln -s . foo is a candidate
247 * now, we canonicalise the filename, i.e.
248 * resolve all symlinks and afterwards we
249 * store it to our companion bloom filter
251 canon_name = CANONICALISE_FILENAME(statnam);
253 /* now, recycle full name */
254 fullname = make_ext_string(
255 canon_name, strlen(canon_name), Qfile_name);
257 fullname = fname_as_directory(fullname);
259 /* now stat statnam */
260 if (sxemacs_stat(statnam, &st) == 0 &&
261 (st.st_mode & S_IFMT) == S_IFDIR &&
263 !(bloom_owns_p(XBLOOM(compbf), fullname))) {
271 #else /* defined(_DIRENT_HAVE_D_TYPE) && USE_D_TYPE */
272 statnam = (char*)XSTRING_DATA(fullname);
273 if (sxemacs_stat(statnam, &st) == 0 &&
274 (st.st_mode & S_IFMT) == S_IFDIR) {
275 char *canon_name = NULL;
277 /* ugly things may happen when a link
278 * points back to a directory in our recurring
279 * area, ln -s . foo is a candidate
280 * now, we canonicalise the filename, i.e.
281 * resolve all symlinks and afterwards we
282 * store it to our companion bloom filter
283 * The ugly things are even worse than in the
284 * case of D_TYPE, since we !always! have to
285 * check against the bloom filter.
287 canon_name = CANONICALISE_FILENAME(statnam);
290 /* now, recycle full name */
291 fullname = make_ext_string(
292 canon_name, strlen(canon_name),
295 fullname = fname_as_directory(fullname);
297 /* now stat statnam */
298 if (sxemacs_stat(statnam, &st) == 0 &&
299 (st.st_mode & S_IFMT) == S_IFDIR &&
300 /* does the bloom know about the dir? */
302 !(bloom_owns_p(XBLOOM(compbf), fullname))) {
310 #endif /* defined(_DIRENT_HAVE_D_TYPE) && USE_D_TYPE */
312 /* argh, here is a design flaw!
313 these operations are not commutable, and it's a
314 hard-coded how `match' is interpreted.
315 * There are two possibilites:
316 * (1) check pathname against `match'
317 if nil, do not process further
318 if a directory, recur
319 if non-nil, add to result according to files_only
320 * (2) if a directory, recur
321 check pathname against `match'
322 if nil, do not add to result
323 if non-nil, add to result according to files_only
325 * Hm, I think I'd choose the latter variant, it is
326 not that performant, but it avoids two problems:
328 - With the former variant it is NOT possible to have
329 the trivial filenames on the result list, since a
330 match against "^[.]$" would exclude everything, while
331 actually it was likely meant to _solely_ exclude "."
333 - Furthermore, we _MUST_ traverse in preorder,
334 otherwise there is the possibility that pathnames are
335 on the file list already which turn out later to be
337 * Anyone wants to help brainstorming?
340 /* check if we put it on the list of matches */
341 if (NILP(files_only)) {
343 } else if (EQ(files_only, Qt) && !dir_p) {
345 } else if (!EQ(files_only, Qt) && dir_p) {
351 if (curdepth >= opts->maxdepth) {
356 dired_stack_item_t dsi;
357 dsi = xnew_and_zero(struct dired_stack_item_s);
359 dsi->depth = 1+curdepth;
360 dired_stack_push(ds, dsi);
364 if (!NILP(match) && !pathname_matches_p(name, match, bufp)) {
370 dllist_append(XDLLIST(result), (void*)resname);
371 /* add the result to the companion bloom-f */
372 /* hm, for large trees this yields a bf which
373 owns everything :( ... we need far better and
374 faster bloom techniques for it -hroptatyr */
375 if (!NILP(bloom_filter)) {
376 bloom_add(XBLOOM(bloom_filter), resname);
385 dfr_outer(Lisp_Object directory, dirent_t *ent,
386 Lisp_Object compbf, dfr_options_t opts,
387 Lisp_Object files_only, dired_stack_t ds, Lisp_Object match,
388 struct re_pattern_buffer *bufp, Lisp_Object result,
389 Lisp_Object bloom_filter)
391 dired_stack_item_t dir_dpt = dired_stack_pop(ds);
392 Lisp_Object dir = dir_dpt->dir;
393 unsigned int dpt = dir_dpt->depth;
394 Lisp_Object fulldir = Fexpand_file_name(dir, directory);
396 dirent_t *res = NULL;
397 struct gcpro gcpro1, gcpro2;
399 GCPRO2(dir, fulldir);
403 dir = fname_as_directory(dir);
404 fulldir = fname_as_directory(fulldir);
406 /* add the full directory name to the companion bloom filter */
408 bloom_add(XBLOOM(compbf), fulldir);
410 /* external format conversion is done in the encapsulation of
411 * opendir in sysdep.c
413 d = opendir((char*)XSTRING_DATA(fulldir));
415 /* why should we want this? I think spitting a warning
421 report_file_error("Opening directory", list1(fulldir));
426 warn_when_safe(Qfile, Qwarning,
427 "Opening directory `%s' failed",
428 (char*)XSTRING_DATA(fulldir));
434 record_unwind_protect(close_directory_unwind,
435 make_opaque_ptr((void *)d));
437 while (DFR_READDIR(d, ent, &res) == 0 && res != NULL) {
438 dfr_inner(res, fulldir, dir,
440 files_only, dpt, ds, match, bufp,
441 result, bloom_filter);
448 dired_stack_mark(Lisp_Object obj)
450 dired_stack_t ds = get_dynacat(obj);
451 WITH_DLLIST_TRAVERSE(
453 dired_stack_item_t dsi = dllist_item;
454 mark_object(dsi->dir));
460 dired_stack_fini(Lisp_Object obj)
462 dired_stack_t ds = get_dynacat(obj);
463 free_dired_stack(ds);
469 directory_files_magic(Lisp_Object directory, Lisp_Object match,
470 Lisp_Object files_only, Lisp_Object bloom_filter,
473 /* This function can GC */
474 Lisp_Object result = wrap_dllist(make_dllist());
475 Lisp_Object lds = Qnil;
476 dired_stack_t ds = NULL;
477 dired_stack_item_t ds_item = NULL;
478 /* this is a companion bloom filter,
479 * we register processed directories in here and hence avoid
480 * processing an entry twice */
481 Lisp_Object compbf = Qnil;
482 int speccount = specpdl_depth();
484 struct re_pattern_buffer *bufp = NULL;
486 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
488 ds = new_dired_stack();
489 lds = make_dynacat(ds);
490 set_dynacat_marker(lds, dired_stack_mark);
491 set_dynacat_finaliser(lds, (dynacat_finaliser_f)dired_stack_fini);
492 GCPRO5(directory, result, compbf, bloom_filter, lds);
495 /* SXEmacs: this should come after Ffile_name_as_directory() to avoid
496 potential regexp cache smashage. It comes before the opendir()
497 because it might signal an error. */
499 if (STRINGP(match)) {
501 /* MATCH might be a flawed regular expression. Rather
502 than catching and signalling our own errors, we just
503 call compile_pattern to do the work for us. */
504 bufp = compile_pattern(match, 0, Qnil, 0, ERROR_ME);
505 /* Now *bufp is the compiled form of MATCH; don't call
506 anything which might compile a new regexp until we
507 are done with the loop! */
509 } else if (!NILP(Ffunctionp(match))) {
512 return wrong_type_argument(Qstringp, match);
516 regex_match_object = Qnil;
517 regex_emacs_buffer = current_buffer;
520 if (opts->maxdepth > 0) {
521 compbf = make_bloom(8192, 8);
524 /* set up the directories queue */
525 ds_item = xnew_and_zero(struct dired_stack_item_s);
526 ds_item->dir = make_string((Bufbyte*)"", 0);
528 dired_stack_push(ds, ds_item);
530 /* alloc the directory entry pointer */
532 dirent_t _ent, *ent = &_ent;
535 memset(ent, 0, sizeof(dirent_t));
537 while (dired_stack_size(ds) > 0) {
538 dfr_outer(directory, ent, compbf,
539 opts, files_only, ds, match,
540 bufp, result, bloom_filter);
541 /* This will close the dir */
542 unbind_to(speccount, Qnil);
547 /* save the companion bloom filter */
548 Fput(result, Qcompanion_bf, compbf);
555 directory_files_canonicalise_dn(Lisp_Object directory)
560 /* expand the directory argument and canonicalise */
561 directory = Fexpand_file_name(directory, Qnil);
562 directory = fname_as_directory(directory);
564 RETURN_UNGCPRO(directory);
568 directory_files_resultify(Lisp_Object result, Lisp_Object result_type)
570 /* This function can GC */
571 Lisp_Object final_result = Qnil;
572 struct gcpro gcpro1, gcpro2, gcpro3;
573 GCPRO3(result, result_type, final_result);
575 /* see if the user requested a dllist */
576 if (EQ(result_type, Qdllist)) {
577 final_result = result;
578 } else if (NILP(result_type) || EQ(result_type, Qsorted_list)) {
579 final_result = Fdllist_to_list_reversed(result);
580 final_result = Fsort(final_result, Qstring_lessp);
581 } else if (EQ(result_type, Qdesc_sorted_list)) {
582 final_result = Fdllist_to_list(result);
583 final_result = Fsort(final_result, Qstring_greaterp);
584 } else if (EQ(result_type, Qt) || EQ(result_type, Qlist)) {
585 final_result = Fdllist_to_list(result);
593 call9(Lisp_Object fn,
594 Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
595 Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5,
596 Lisp_Object arg6, Lisp_Object arg7, Lisp_Object arg8)
598 /* This function can GC */
600 Lisp_Object res, args[10] = {fn, arg0, arg1, arg2, arg3,
601 arg4, arg5, arg6, arg7, arg8};
603 GCPROn(args, countof(args));
604 res = Ffuncall(10, args);
611 EXFUN(Fdirectory_files_recur, 8);
613 DEFUN("directory-files", Fdirectory_files, 1, 5, 0, /*
614 Return a list of names of files in DIRECTORY.
615 Args are DIRECTORY &optional FULL MATCH RESULT-TYPE FILES_ONLY.
617 There are four optional arguments:
618 If FULL is non-nil, absolute pathnames of the files are returned.
620 If MATCH is non-nil, it may be a string indicating a regular
621 expression which pathnames must meet in order to be returned.
622 Moreover, a predicate function can be specified which is called with
623 one argument, the pathname in question. On non-nil return value,
624 the pathname is considered in the final result, otherwise it is
627 Optional argument RESULT-TYPE can be one of:
628 - sorted-list (default) to return a list, sorted in alphabetically
630 - desc-sorted-list to return a list, sorted in alphabetically
632 - list to return an unsorted list
633 - dllist to return an unsorted dllist
634 The two latter types can be useful if you plan to sort the result
635 yourself, or want to feed the result to further processing.
637 Optional argument FILES-ONLY can be one of:
638 - t to return only files and symlinks in DIRECTORY
639 - nil (default) to return all entries (files, symlinks, and
640 subdirectories) in DIRECTORY
641 - subdir to return only subdirectories -- but *NOT* symlinks to
642 directories -- in DIRECTORY
644 (directory, full, match, result_type, files_only))
647 Lisp_Object result = Qnil;
648 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
649 struct dfr_options_s opts = {
651 .fullp = !NILP(full),
654 GCPRO6(directory, full, match, result_type, files_only, result);
656 directory = directory_files_canonicalise_dn(directory);
658 /* If the file name has special constructs in it,
659 call the corresponding file handler. */
660 handler = Ffind_file_name_handler(directory, Qdirectory_files);
661 if (!NILP(handler)) {
663 return call6(handler, Qdirectory_files,
664 directory, full, match, result_type, files_only);
667 result = directory_files_magic(directory, match,
668 files_only, /* bloom filter */Qnil,
672 return directory_files_resultify(result, result_type);
675 DEFUN("directory-files-recur", Fdirectory_files_recur, 1, 8, 0, /*
676 Like `directory-files' but recursive and much faster.
677 Args are DIRECTORY &optional FULL MATCH RESULT_TYPE FILES-ONLY MAXDEPTH
678 SYMLINK_IS_FILE BLOOM_FILTER
680 If FULL is non-nil, absolute pathnames of the files are returned.
682 If MATCH is non-nil, it may be a string indicating a regular
683 expression which pathnames must meet in order to be returned.
684 Moreover, a predicate function can be specified which is called with
685 one argument, the pathname in question. On non-nil return value,
686 the pathname is considered in the final result, otherwise it is
689 Optional argument RESULT-TYPE can be one of:
690 - sorted-list (default) to return a list, sorted in alphabetically
692 - desc-sorted-list to return a list, sorted in alphabetically
694 - list to return an unsorted list
695 - dllist to return an unsorted dllist
696 The two latter types can be useful if you plan to sort the result
697 yourself, or want to feed the result to further processing.
699 Optional argument FILES-ONLY can be one of:
700 - t to return only files and symlinks in DIRECTORY
701 - nil (default) to return all entries (files, symlinks, and
702 subdirectories) in DIRECTORY
703 - subdir to return only subdirectories -- but *NOT* symlinks to
704 directories -- in DIRECTORY
706 Optional argument MAXDEPTH \(a positive integer\) specifies the
707 maximal recursion depth, use 0 to emulate old `directory-files'.
709 Optional argument SYMLINK-IS-FILE specifies whether symlinks
710 should be resolved \(which is the default behaviour\) or whether
711 they are treated as ordinary files \(non-nil\), in the latter
712 case symlinks to directories are not recurred.
714 Optional argument BLOOM-FILTER specifies a bloom filter where
715 to put results in addition to the ordinary result list.
717 (directory, full, match, result_type, files_only, maxdepth,
718 symlink_is_file, bloom_filter))
720 (int nargs, Lisp_Object *args))
723 Lisp_Object handler = Qnil, result = Qnil;
724 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
725 /* just a convenience array for gc pro'ing */
726 Lisp_Object args[8] = {
727 directory, match, result_type, files_only,
728 symlink_is_file, bloom_filter, handler, result};
730 struct dfr_options_s opts = {
732 .fullp = !NILP(full),
733 .symlink_file_p = !NILP(symlink_is_file),
737 /* argument checks */
738 CHECK_STRING(directory);
742 if (!NILP(maxdepth)) {
743 CHECK_NATNUM(maxdepth);
744 opts.maxdepth = XUINT(maxdepth);
747 GCPROn(args, countof(args));
749 directory = directory_files_canonicalise_dn(directory);
751 /* If the file name has special constructs in it,
752 call the corresponding file handler. */
753 handler = Ffind_file_name_handler(directory, Qdirectory_files_recur);
754 if (!NILP(handler)) {
757 res = call9(handler, Qdirectory_files_recur,
758 directory, full, match, result_type, files_only,
759 maxdepth, symlink_is_file, bloom_filter);
764 result = directory_files_magic(directory, match,
765 files_only, bloom_filter,
767 /* convert to final result type */
768 result = directory_files_resultify(result, result_type);
774 static Lisp_Object file_name_completion(Lisp_Object file,
775 Lisp_Object directory,
776 int all_flag, int ver_flag);
778 DEFUN("file-name-completion", Ffile_name_completion, 2, 2, 0, /*
779 Complete file name PARTIAL-FILENAME in directory DIRECTORY.
780 Return the longest prefix common to all file names in DIRECTORY
781 that start with PARTIAL-FILENAME.
782 If there is only one and PARTIAL-FILENAME matches it exactly, return t.
783 Return nil if DIRECTORY contains no name starting with PARTIAL-FILENAME.
785 File names which end with any member of `completion-ignored-extensions'
786 are not considered as possible completions for PARTIAL-FILENAME unless
787 there is no other possible completion. `completion-ignored-extensions'
788 is not applied to the names of directories.
790 (partial_filename, directory))
792 /* This function can GC. GC checked 1996.04.06. */
795 /* If the directory name has special constructs in it,
796 call the corresponding file handler. */
797 handler = Ffind_file_name_handler(directory, Qfile_name_completion);
799 return call3(handler, Qfile_name_completion, partial_filename,
802 /* If the file name has special constructs in it,
803 call the corresponding file handler. */
805 Ffind_file_name_handler(partial_filename, Qfile_name_completion);
807 return call3(handler, Qfile_name_completion, partial_filename,
810 return file_name_completion(partial_filename, directory, 0, 0);
813 DEFUN("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
814 Return a list of all completions of PARTIAL-FILENAME in DIRECTORY.
815 These are all file names in DIRECTORY which begin with PARTIAL-FILENAME.
817 (partial_filename, directory))
819 /* This function can GC. GC checked 1997.06.04. */
824 directory = Fexpand_file_name(directory, Qnil);
825 /* If the file name has special constructs in it,
826 call the corresponding file handler. */
828 Ffind_file_name_handler(directory, Qfile_name_all_completions);
831 return call3(handler, Qfile_name_all_completions,
832 partial_filename, directory);
834 return file_name_completion(partial_filename, directory, 1, 0);
838 file_name_completion_stat(Lisp_Object directory, DIRENTRY * dp,
839 struct stat *st_addr)
841 Bytecount len = NAMLEN(dp);
842 Bytecount pos = XSTRING_LENGTH(directory);
844 char *fullname = (char *)alloca(len + pos + 2);
846 memcpy(fullname, XSTRING_DATA(directory), pos);
847 if (!IS_DIRECTORY_SEP(fullname[pos - 1]))
848 fullname[pos++] = DIRECTORY_SEP;
850 memcpy(fullname + pos, dp->d_name, len);
851 fullname[pos + len] = 0;
854 /* We want to return success if a link points to a nonexistent file,
855 but we want to return the status for what the link points to,
856 in case it is a directory. */
857 value = lstat(fullname, st_addr);
858 if (S_ISLNK(st_addr->st_mode))
859 (void)sxemacs_stat(fullname, st_addr);
861 value = sxemacs_stat(fullname, st_addr);
866 static Lisp_Object file_name_completion_unwind(Lisp_Object locative)
869 Lisp_Object obj = XCAR(locative);
872 d = (DIR *) get_opaque_ptr(obj);
874 free_opaque_ptr(obj);
876 free_cons(XCONS(locative));
881 file_name_completion(Lisp_Object file, Lisp_Object directory, int all_flag,
884 /* This function can GC */
887 Lisp_Object bestmatch = Qnil;
888 Charcount bestmatchsize = 0;
891 int speccount = specpdl_depth();
892 Charcount file_name_length;
893 Lisp_Object locative;
894 struct gcpro gcpro1, gcpro2, gcpro3;
896 GCPRO3(file, directory, bestmatch);
900 #ifdef FILE_SYSTEM_CASE
901 file = FILE_SYSTEM_CASE(file);
903 directory = Fexpand_file_name(directory, Qnil);
904 file_name_length = XSTRING_CHAR_LENGTH(file);
906 /* With passcount = 0, ignore files that end in an ignored extension.
907 If nothing found then try again with passcount = 1, don't ignore them.
908 If looking for all completions, start with passcount = 1,
909 so always take even the ignored ones.
911 ** It would not actually be helpful to the user to ignore any possible
912 completions when making a list of them.** */
914 /* We cannot use close_directory_unwind() because we change the
915 directory. The old code used to just avoid signaling errors, and
916 call closedir, but it was wrong, because it made sane handling of
917 QUIT impossible and, besides, various utility functions like
918 regexp_ignore_completion_p can signal errors. */
919 locative = noseeum_cons(Qnil, Qnil);
920 record_unwind_protect(file_name_completion_unwind, locative);
922 for (passcount = !!all_flag; NILP(bestmatch) && passcount < 2;
924 Lisp_Object tmp_dfn = Fdirectory_file_name(directory);
925 d = opendir((char *)XSTRING_DATA(tmp_dfn));
927 report_file_error("Opening directory",
930 XCAR(locative) = make_opaque_ptr((void *)d);
932 /* Loop reading blocks */
936 /* scmp() works in characters, not bytes, so we have to compute
940 int ignored_extension_p = 0;
947 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
948 d_name = (Bufbyte *) dp->d_name;
950 cclen = bytecount_to_charcount(d_name, len);
954 if (!DIRENTRY_NONEMPTY(dp)
955 || cclen < file_name_length
956 || 0 <= scmp(d_name, XSTRING_DATA(file),
960 if (file_name_completion_stat(directory, dp, &st) < 0)
963 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
965 /* "." and ".." are never interesting as completions, but are
966 actually in the way in a directory containing only one file. */
968 && TRIVIAL_DIRECTORY_ENTRY(dp->d_name))
971 /* Compare extensions-to-be-ignored against end of this file name */
972 /* if name is not an exact match against specified string. */
973 if (!passcount && cclen > file_name_length) {
975 /* and exit this for loop if a match is found */
976 EXTERNAL_LIST_LOOP(tem,
977 Vcompletion_ignored_extensions)
979 Lisp_Object elt = XCAR(tem);
986 XSTRING_CHAR_LENGTH(elt);
996 ignored_extension_p = 1;
1003 /* If an ignored-extensions match was found,
1004 don't process this name as a completion. */
1005 if (!passcount && ignored_extension_p)
1009 && regexp_ignore_completion_p(d_name, Qnil, 0,
1013 /* Update computation of how much all possible completions match */
1016 if (all_flag || NILP(bestmatch)) {
1017 Lisp_Object name = Qnil;
1018 struct gcpro ngcpro1;
1020 /* This is a possible completion */
1021 name = make_string(d_name, len);
1022 if (directoryp) /* Completion is a directory; end it with '/' */
1023 name = Ffile_name_as_directory(name);
1025 bestmatch = Fcons(name, bestmatch);
1029 XSTRING_CHAR_LENGTH(name);
1033 Charcount compare = min(bestmatchsize, cclen);
1034 Bufbyte *p1 = XSTRING_DATA(bestmatch);
1035 Bufbyte *p2 = d_name;
1036 Charcount matchsize = scmp(p1, p2, compare);
1039 matchsize = compare;
1040 if (completion_ignore_case) {
1041 /* If this is an exact match except for case,
1042 use it as the best match rather than one that is not
1043 an exact match. This way, we get the case pattern
1044 of the actual match. */
1045 if ((matchsize == cclen
1046 && matchsize + !!directoryp
1047 < XSTRING_CHAR_LENGTH(bestmatch))
1049 /* If there is no exact match ignoring case,
1050 prefer a match that does not change the case
1052 (((matchsize == cclen)
1054 (matchsize + !!directoryp
1056 XSTRING_CHAR_LENGTH(bestmatch)))
1057 /* If there is more than one exact match aside from
1058 case, and one of them is exact including case,
1062 file_name_length, 0)
1068 make_string(d_name, len);
1071 Ffile_name_as_directory
1076 /* If this directory all matches,
1077 see if implicit following slash does too. */
1079 && compare == matchsize
1080 && bestmatchsize > matchsize
1082 IS_ANY_SEP(charptr_emchar_n(p1, matchsize)))
1084 bestmatchsize = matchsize;
1088 free_opaque_ptr(XCAR(locative));
1089 XCAR(locative) = Qnil;
1092 unbind_to(speccount, Qnil);
1096 if (all_flag || NILP(bestmatch))
1098 if (matchcount == 1 && bestmatchsize == file_name_length)
1100 return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1103 static Lisp_Object user_name_completion(Lisp_Object user,
1104 int all_flag, int *uniq);
1106 DEFUN("user-name-completion", Fuser_name_completion, 1, 1, 0, /*
1107 Complete user name from PARTIAL-USERNAME.
1108 Return the longest prefix common to all user names starting with
1109 PARTIAL-USERNAME. If there is only one and PARTIAL-USERNAME matches
1110 it exactly, returns t. Return nil if there is no user name starting
1111 with PARTIAL-USERNAME.
1115 return user_name_completion(partial_username, 0, NULL);
1118 DEFUN("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /*
1119 Complete user name from PARTIAL-USERNAME.
1121 This function is identical to `user-name-completion', except that
1122 the cons of the completion and an indication of whether the
1123 completion was unique is returned.
1125 The car of the returned value is the longest prefix common to all user
1126 names that start with PARTIAL-USERNAME. If there is only one and
1127 PARTIAL-USERNAME matches it exactly, the car is t. The car is nil if
1128 there is no user name starting with PARTIAL-USERNAME. The cdr of the
1129 result is non-nil if and only if the completion returned in the car
1135 Lisp_Object completed =
1136 user_name_completion(partial_username, 0, &uniq);
1137 return Fcons(completed, uniq ? Qt : Qnil);
1140 DEFUN("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
1141 Return a list of all user name completions from PARTIAL-USERNAME.
1142 These are all the user names which begin with PARTIAL-USERNAME.
1146 return user_name_completion(partial_username, 1, NULL);
1155 struct user_name *user_names;
1158 EMACS_TIME last_rebuild_time;
1160 static struct user_cache user_cache;
1162 static void free_user_cache(struct user_cache *cache)
1165 for (i = 0; i < cache->length; i++)
1166 xfree(cache->user_names[i].ptr);
1167 xfree(cache->user_names);
1171 static Lisp_Object user_name_completion_unwind(Lisp_Object cache_incomplete_p)
1174 speed_up_interrupts();
1176 if (!NILP(XCAR(cache_incomplete_p)))
1177 free_user_cache(&user_cache);
1179 free_cons(XCONS(cache_incomplete_p));
1184 #define USER_CACHE_TTL (24*60*60) /* Time to live: 1 day, in seconds */
1187 user_name_completion(Lisp_Object user, int all_flag, int *uniq)
1189 /* This function can GC */
1191 Lisp_Object bestmatch = Qnil;
1192 Charcount bestmatchsize = 0;
1193 Charcount user_name_length;
1196 struct gcpro gcpro1, gcpro2;
1198 GCPRO2(user, bestmatch);
1202 user_name_length = XSTRING_CHAR_LENGTH(user);
1204 /* Cache user name lookups because it tends to be quite slow.
1205 * Rebuild the cache occasionally to catch changes */
1207 if (user_cache.user_names &&
1208 (EMACS_SECS(t) - EMACS_SECS(user_cache.last_rebuild_time)
1210 free_user_cache(&user_cache);
1212 if (!user_cache.user_names) {
1214 Lisp_Object cache_incomplete_p = noseeum_cons(Qt, Qnil);
1215 int speccount = specpdl_depth();
1217 slow_down_interrupts();
1219 record_unwind_protect(user_name_completion_unwind,
1220 cache_incomplete_p);
1221 while ((pwd = getpwent())) {
1223 DO_REALLOC(user_cache.user_names, user_cache.size,
1224 user_cache.length + 1, struct user_name);
1225 TO_INTERNAL_FORMAT(C_STRING, pwd->pw_name,
1228 user_names[user_cache.length].ptr,
1229 user_cache.user_names[user_cache.
1232 user_cache.length++;
1234 XCAR(cache_incomplete_p) = Qnil;
1235 unbind_to(speccount, Qnil);
1237 EMACS_GET_TIME(user_cache.last_rebuild_time);
1240 for (i = 0; i < user_cache.length; i++) {
1241 Bufbyte *u_name = user_cache.user_names[i].ptr;
1242 Bytecount len = user_cache.user_names[i].len;
1243 /* scmp() works in chars, not bytes, so we have to compute this: */
1244 Charcount cclen = bytecount_to_charcount(u_name, len);
1248 if (cclen < user_name_length
1249 || 0 <= scmp_1(u_name, XSTRING_DATA(user), user_name_length,
1253 matchcount++; /* count matching completions */
1255 if (all_flag || NILP(bestmatch)) {
1256 Lisp_Object name = Qnil;
1257 struct gcpro ngcpro1;
1259 /* This is a possible completion */
1260 name = make_string(u_name, len);
1262 bestmatch = Fcons(name, bestmatch);
1265 bestmatchsize = XSTRING_CHAR_LENGTH(name);
1269 Charcount compare = min(bestmatchsize, cclen);
1270 Bufbyte *p1 = XSTRING_DATA(bestmatch);
1271 Bufbyte *p2 = u_name;
1272 Charcount matchsize = scmp_1(p1, p2, compare, 0);
1275 matchsize = compare;
1277 bestmatchsize = matchsize;
1284 *uniq = (matchcount == 1);
1286 if (all_flag || NILP(bestmatch))
1288 if (matchcount == 1 && bestmatchsize == user_name_length)
1290 return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1293 Lisp_Object make_directory_hash_table(const char *path)
1296 if ((d = opendir(path))) {
1299 make_lisp_hash_table(20, HASH_TABLE_NON_WEAK,
1302 while ((dp = readdir(d))) {
1303 Bytecount len = NAMLEN(dp);
1304 if (DIRENTRY_NONEMPTY(dp))
1305 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
1306 Fputhash(make_string
1307 ((Bufbyte *) dp->d_name, len), Qt,
1317 /* ... never used ... should use list2 directly anyway ... */
1318 /* NOTE: This function can never return a negative value. */
1319 Lisp_Object wasteful_word_to_lisp(unsigned int item)
1321 /* Compatibility: in other versions, file-attributes returns a LIST
1322 of two 16 bit integers... */
1323 Lisp_Object cons = word_to_lisp(item);
1324 XCDR(cons) = Fcons(XCDR(cons), Qnil);
1329 DEFUN("file-attributes", Ffile_attributes, 1, 1, 0, /*
1330 Return a list of attributes of file FILENAME.
1331 Value is nil if specified file cannot be opened.
1332 Otherwise, list elements are:
1333 0. t for directory, string (name linked to) for symbolic link, or nil.
1334 1. Number of links to file.
1337 4. Last access time, as a list of two integers.
1338 First integer has high-order 16 bits of time, second has low 16 bits.
1339 5. Last modification time, likewise.
1340 6. Last status change time, likewise.
1341 7. Size in bytes. (-1, if number is out of range).
1342 8. File modes, as a string of ten letters or dashes as in ls -l.
1343 9. t iff file's gid would change if file were deleted and recreated.
1347 If file does not exist, returns nil.
1351 /* This function can GC. GC checked 1997.06.04. */
1352 Lisp_Object values[12];
1353 #if defined (BSD4_2) || defined (BSD4_3) || \
1354 !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1355 Lisp_Object directory = Qnil;
1356 #endif /* BSD4_2 || BSD4_3 || !BDWGC */
1359 Lisp_Object handler;
1360 struct gcpro gcpro1, gcpro2;
1362 GCPRO2(filename, directory);
1363 filename = Fexpand_file_name(filename, Qnil);
1365 /* If the file name has special constructs in it,
1366 call the corresponding file handler. */
1367 handler = Ffind_file_name_handler(filename, Qfile_attributes);
1368 if (!NILP(handler)) {
1370 return call2(handler, Qfile_attributes, filename);
1373 if (lstat((char *)XSTRING_DATA(filename), &s) < 0) {
1378 directory = Ffile_name_directory(filename);
1381 switch (s.st_mode & S_IFMT) {
1390 values[0] = Ffile_symlink_p(filename);
1394 values[1] = make_int(s.st_nlink);
1395 values[2] = make_int(s.st_uid);
1396 values[3] = make_int(s.st_gid);
1397 values[4] = make_time(s.st_atime);
1398 values[5] = make_time(s.st_mtime);
1399 values[6] = make_time(s.st_ctime);
1400 values[7] = make_int((EMACS_INT) s.st_size);
1401 /* If the size is out of range, give back -1. */
1402 /* #### Fix when Emacs gets bignums! */
1403 if (XINT(values[7]) != s.st_size)
1404 values[7] = make_int(-1);
1405 filemodestring(&s, modes);
1406 values[8] = make_string((Bufbyte *) modes, 10);
1407 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
1411 if (!NILP(directory)
1412 && sxemacs_stat((char *)XSTRING_DATA(directory), &sdir) == 0)
1413 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
1414 else /* if we can't tell, assume worst */
1417 #else /* file gid will be egid */
1418 values[9] = (s.st_gid != getegid())? Qt : Qnil;
1419 #endif /* BSD4_2 or BSD4_3 */
1420 values[10] = make_int(s.st_ino);
1421 values[11] = make_int(s.st_dev);
1423 return Flist(countof(values), values);
1427 /************************************************************************/
1428 /* initialization */
1429 /************************************************************************/
1431 void syms_of_dired(void)
1433 defsymbol(&Qdirectory_files, "directory-files");
1434 defsymbol(&Qdirectory_files_recur, "directory-files-recur");
1435 defsymbol(&Qfile_name_completion, "file-name-completion");
1436 defsymbol(&Qfile_name_all_completions, "file-name-all-completions");
1437 defsymbol(&Qfile_attributes, "file-attributes");
1439 defsymbol(&Qcompanion_bf, "companion-bf");
1440 defsymbol(&Qsorted_list, "sorted-list");
1441 defsymbol(&Qdesc_sorted_list, "desc-sorted-list");
1442 defsymbol(&Qunsorted_list, "unsorted-list");
1444 DEFSUBR(Fdirectory_files);
1445 DEFSUBR(Fdirectory_files_recur);
1446 DEFSUBR(Ffile_name_completion);
1447 DEFSUBR(Ffile_name_all_completions);
1448 DEFSUBR(Fuser_name_completion);
1449 DEFSUBR(Fuser_name_completion_1);
1450 DEFSUBR(Fuser_name_all_completions);
1451 DEFSUBR(Ffile_attributes);
1454 void vars_of_dired(void)
1456 DEFVAR_LISP("completion-ignored-extensions", &Vcompletion_ignored_extensions /*
1457 *Completion ignores filenames ending in any string in this list.
1458 This variable does not affect lists of possible completions,
1459 but does affect the commands that actually do completions.
1460 It is used by the function `file-name-completion'.
1462 Vcompletion_ignored_extensions = Qnil;
1464 DEFVAR_LISP("directory-files-no-trivial-p",
1465 &Vdirectory_files_no_trivial_p /*
1466 Determine whether to _not_ add the trivial directory entries
1468 ATTENTION: This variable is definitely NOT for users.
1469 For easy temporary circumvention use a let binding.
1471 Vdirectory_files_no_trivial_p = Qnil;