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) && bufp && !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 (!NILP(result_type) || 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 For compatibility with XEmacs' NOSORT argument to this function,
638 RESULT-TYPE can also be any non-nil value. In that case it will
639 return an unsorted list. (http://issues.sxemacs.org/show_bug.cgi?id=163)
641 Optional argument FILES-ONLY can be one of:
642 - t to return only files and symlinks in DIRECTORY
643 - nil (default) to return all entries (files, symlinks, and
644 subdirectories) in DIRECTORY
645 - subdir to return only subdirectories -- but *NOT* symlinks to
646 directories -- in DIRECTORY
648 (directory, full, match, result_type, files_only))
651 Lisp_Object result = Qnil;
652 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
653 struct dfr_options_s opts = {
655 .fullp = !NILP(full),
658 GCPRO6(directory, full, match, result_type, files_only, result);
660 directory = directory_files_canonicalise_dn(directory);
662 /* If the file name has special constructs in it,
663 call the corresponding file handler. */
664 handler = Ffind_file_name_handler(directory, Qdirectory_files);
665 if (!NILP(handler)) {
667 return call6(handler, Qdirectory_files,
668 directory, full, match, result_type, files_only);
671 result = directory_files_magic(directory, match,
672 files_only, /* bloom filter */Qnil,
676 return directory_files_resultify(result, result_type);
679 DEFUN("directory-files-recur", Fdirectory_files_recur, 1, 8, 0, /*
680 Like `directory-files' but recursive and much faster.
681 Args are DIRECTORY &optional FULL MATCH RESULT_TYPE FILES-ONLY MAXDEPTH
682 SYMLINK_IS_FILE BLOOM_FILTER
684 If FULL is non-nil, absolute pathnames of the files are returned.
686 If MATCH is non-nil, it may be a string indicating a regular
687 expression which pathnames must meet in order to be returned.
688 Moreover, a predicate function can be specified which is called with
689 one argument, the pathname in question. On non-nil return value,
690 the pathname is considered in the final result, otherwise it is
693 Optional argument RESULT-TYPE can be one of:
694 - sorted-list (default) to return a list, sorted in alphabetically
696 - desc-sorted-list to return a list, sorted in alphabetically
698 - list to return an unsorted list
699 - dllist to return an unsorted dllist
700 The two latter types can be useful if you plan to sort the result
701 yourself, or want to feed the result to further processing.
703 Optional argument FILES-ONLY can be one of:
704 - t to return only files and symlinks in DIRECTORY
705 - nil (default) to return all entries (files, symlinks, and
706 subdirectories) in DIRECTORY
707 - subdir to return only subdirectories -- but *NOT* symlinks to
708 directories -- in DIRECTORY
710 Optional argument MAXDEPTH \(a positive integer\) specifies the
711 maximal recursion depth, use 0 to emulate old `directory-files'.
713 Optional argument SYMLINK-IS-FILE specifies whether symlinks
714 should be resolved \(which is the default behaviour\) or whether
715 they are treated as ordinary files \(non-nil\), in the latter
716 case symlinks to directories are not recurred.
718 Optional argument BLOOM-FILTER specifies a bloom filter where
719 to put results in addition to the ordinary result list.
721 (directory, full, match, result_type, files_only, maxdepth,
722 symlink_is_file, bloom_filter))
724 (int nargs, Lisp_Object *args))
727 Lisp_Object handler = Qnil, result = Qnil;
728 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
729 /* just a convenience array for gc pro'ing */
730 Lisp_Object args[8] = {
731 directory, match, result_type, files_only,
732 symlink_is_file, bloom_filter, handler, result};
734 struct dfr_options_s opts = {
736 .fullp = !NILP(full),
737 .symlink_file_p = !NILP(symlink_is_file),
741 /* argument checks */
742 CHECK_STRING(directory);
746 if (!NILP(maxdepth)) {
747 CHECK_NATNUM(maxdepth);
748 opts.maxdepth = XUINT(maxdepth);
751 GCPROn(args, countof(args));
753 directory = directory_files_canonicalise_dn(directory);
755 /* If the file name has special constructs in it,
756 call the corresponding file handler. */
757 handler = Ffind_file_name_handler(directory, Qdirectory_files_recur);
758 if (!NILP(handler)) {
761 res = call9(handler, Qdirectory_files_recur,
762 directory, full, match, result_type, files_only,
763 maxdepth, symlink_is_file, bloom_filter);
768 result = directory_files_magic(directory, match,
769 files_only, bloom_filter,
771 /* convert to final result type */
772 result = directory_files_resultify(result, result_type);
778 static Lisp_Object file_name_completion(Lisp_Object file,
779 Lisp_Object directory,
780 int all_flag, int ver_flag);
782 DEFUN("file-name-completion", Ffile_name_completion, 2, 2, 0, /*
783 Complete file name PARTIAL-FILENAME in directory DIRECTORY.
784 Return the longest prefix common to all file names in DIRECTORY
785 that start with PARTIAL-FILENAME.
786 If there is only one and PARTIAL-FILENAME matches it exactly, return t.
787 Return nil if DIRECTORY contains no name starting with PARTIAL-FILENAME.
789 File names which end with any member of `completion-ignored-extensions'
790 are not considered as possible completions for PARTIAL-FILENAME unless
791 there is no other possible completion. `completion-ignored-extensions'
792 is not applied to the names of directories.
794 (partial_filename, directory))
796 /* This function can GC. GC checked 1996.04.06. */
799 /* If the directory name has special constructs in it,
800 call the corresponding file handler. */
801 handler = Ffind_file_name_handler(directory, Qfile_name_completion);
803 return call3(handler, Qfile_name_completion, partial_filename,
806 /* If the file name has special constructs in it,
807 call the corresponding file handler. */
809 Ffind_file_name_handler(partial_filename, Qfile_name_completion);
811 return call3(handler, Qfile_name_completion, partial_filename,
814 return file_name_completion(partial_filename, directory, 0, 0);
817 DEFUN("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
818 Return a list of all completions of PARTIAL-FILENAME in DIRECTORY.
819 These are all file names in DIRECTORY which begin with PARTIAL-FILENAME.
821 (partial_filename, directory))
823 /* This function can GC. GC checked 1997.06.04. */
828 directory = Fexpand_file_name(directory, Qnil);
829 /* If the file name has special constructs in it,
830 call the corresponding file handler. */
832 Ffind_file_name_handler(directory, Qfile_name_all_completions);
835 return call3(handler, Qfile_name_all_completions,
836 partial_filename, directory);
838 return file_name_completion(partial_filename, directory, 1, 0);
842 file_name_completion_stat(Lisp_Object directory, DIRENTRY * dp,
843 struct stat *st_addr)
845 Bytecount len = NAMLEN(dp);
846 Bytecount pos = XSTRING_LENGTH(directory);
848 char *fullname = (char *)alloca(len + pos + 2);
850 memcpy(fullname, XSTRING_DATA(directory), pos);
851 if (!IS_DIRECTORY_SEP(fullname[pos - 1]))
852 fullname[pos++] = DIRECTORY_SEP;
854 memcpy(fullname + pos, dp->d_name, len);
855 fullname[pos + len] = 0;
858 /* We want to return success if a link points to a nonexistent file,
859 but we want to return the status for what the link points to,
860 in case it is a directory. */
861 value = lstat(fullname, st_addr);
862 if (S_ISLNK(st_addr->st_mode))
863 (void)sxemacs_stat(fullname, st_addr);
865 value = sxemacs_stat(fullname, st_addr);
870 static Lisp_Object file_name_completion_unwind(Lisp_Object locative)
873 Lisp_Object obj = XCAR(locative);
876 d = (DIR *) get_opaque_ptr(obj);
878 free_opaque_ptr(obj);
880 free_cons(XCONS(locative));
885 file_name_completion(Lisp_Object file, Lisp_Object directory, int all_flag,
888 /* This function can GC */
891 Lisp_Object bestmatch = Qnil;
892 Charcount bestmatchsize = 0;
895 int speccount = specpdl_depth();
896 Charcount file_name_length;
897 Lisp_Object locative;
898 struct gcpro gcpro1, gcpro2, gcpro3;
900 GCPRO3(file, directory, bestmatch);
904 #ifdef FILE_SYSTEM_CASE
905 file = FILE_SYSTEM_CASE(file);
907 directory = Fexpand_file_name(directory, Qnil);
908 file_name_length = XSTRING_CHAR_LENGTH(file);
910 /* With passcount = 0, ignore files that end in an ignored extension.
911 If nothing found then try again with passcount = 1, don't ignore them.
912 If looking for all completions, start with passcount = 1,
913 so always take even the ignored ones.
915 ** It would not actually be helpful to the user to ignore any possible
916 completions when making a list of them.** */
918 /* We cannot use close_directory_unwind() because we change the
919 directory. The old code used to just avoid signaling errors, and
920 call closedir, but it was wrong, because it made sane handling of
921 QUIT impossible and, besides, various utility functions like
922 regexp_ignore_completion_p can signal errors. */
923 locative = noseeum_cons(Qnil, Qnil);
924 record_unwind_protect(file_name_completion_unwind, locative);
926 for (passcount = !!all_flag; NILP(bestmatch) && passcount < 2;
928 Lisp_Object tmp_dfn = Fdirectory_file_name(directory);
929 d = opendir((char *)XSTRING_DATA(tmp_dfn));
931 report_file_error("Opening directory",
934 XCAR(locative) = make_opaque_ptr((void *)d);
936 /* Loop reading blocks */
940 /* scmp() works in characters, not bytes, so we have to compute
944 int ignored_extension_p = 0;
951 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
952 d_name = (Bufbyte *) dp->d_name;
954 cclen = bytecount_to_charcount(d_name, len);
958 if (!DIRENTRY_NONEMPTY(dp)
959 || cclen < file_name_length
960 || 0 <= scmp(d_name, XSTRING_DATA(file),
964 if (file_name_completion_stat(directory, dp, &st) < 0)
967 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
969 /* "." and ".." are never interesting as completions, but are
970 actually in the way in a directory containing only one file. */
972 && TRIVIAL_DIRECTORY_ENTRY(dp->d_name))
975 /* Compare extensions-to-be-ignored against end of this file name */
976 /* if name is not an exact match against specified string. */
977 if (!passcount && cclen > file_name_length) {
979 /* and exit this for loop if a match is found */
980 EXTERNAL_LIST_LOOP(tem,
981 Vcompletion_ignored_extensions)
983 Lisp_Object elt = XCAR(tem);
990 XSTRING_CHAR_LENGTH(elt);
1000 ignored_extension_p = 1;
1007 /* If an ignored-extensions match was found,
1008 don't process this name as a completion. */
1009 if (!passcount && ignored_extension_p)
1013 && regexp_ignore_completion_p(d_name, Qnil, 0,
1017 /* Update computation of how much all possible completions match */
1020 if (all_flag || NILP(bestmatch)) {
1021 Lisp_Object name = Qnil;
1022 struct gcpro ngcpro1;
1024 /* This is a possible completion */
1025 name = make_string(d_name, len);
1026 if (directoryp) /* Completion is a directory; end it with '/' */
1027 name = Ffile_name_as_directory(name);
1029 bestmatch = Fcons(name, bestmatch);
1033 XSTRING_CHAR_LENGTH(name);
1037 Charcount compare = min(bestmatchsize, cclen);
1038 Bufbyte *p1 = XSTRING_DATA(bestmatch);
1039 Bufbyte *p2 = d_name;
1040 Charcount matchsize = scmp(p1, p2, compare);
1043 matchsize = compare;
1044 if (completion_ignore_case) {
1045 /* If this is an exact match except for case,
1046 use it as the best match rather than one that is not
1047 an exact match. This way, we get the case pattern
1048 of the actual match. */
1049 if ((matchsize == cclen
1050 && matchsize + !!directoryp
1051 < XSTRING_CHAR_LENGTH(bestmatch))
1053 /* If there is no exact match ignoring case,
1054 prefer a match that does not change the case
1056 (((matchsize == cclen)
1058 (matchsize + !!directoryp
1060 XSTRING_CHAR_LENGTH(bestmatch)))
1061 /* If there is more than one exact match aside from
1062 case, and one of them is exact including case,
1066 file_name_length, 0)
1072 make_string(d_name, len);
1075 Ffile_name_as_directory
1080 /* If this directory all matches,
1081 see if implicit following slash does too. */
1083 && compare == matchsize
1084 && bestmatchsize > matchsize
1086 IS_ANY_SEP(charptr_emchar_n(p1, matchsize)))
1088 bestmatchsize = matchsize;
1092 free_opaque_ptr(XCAR(locative));
1093 XCAR(locative) = Qnil;
1096 unbind_to(speccount, Qnil);
1100 if (all_flag || NILP(bestmatch))
1102 if (matchcount == 1 && bestmatchsize == file_name_length)
1104 return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1107 static Lisp_Object user_name_completion(Lisp_Object user,
1108 int all_flag, int *uniq);
1110 DEFUN("user-name-completion", Fuser_name_completion, 1, 1, 0, /*
1111 Complete user name from PARTIAL-USERNAME.
1112 Return the longest prefix common to all user names starting with
1113 PARTIAL-USERNAME. If there is only one and PARTIAL-USERNAME matches
1114 it exactly, returns t. Return nil if there is no user name starting
1115 with PARTIAL-USERNAME.
1119 return user_name_completion(partial_username, 0, NULL);
1122 DEFUN("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /*
1123 Complete user name from PARTIAL-USERNAME.
1125 This function is identical to `user-name-completion', except that
1126 the cons of the completion and an indication of whether the
1127 completion was unique is returned.
1129 The car of the returned value is the longest prefix common to all user
1130 names that start with PARTIAL-USERNAME. If there is only one and
1131 PARTIAL-USERNAME matches it exactly, the car is t. The car is nil if
1132 there is no user name starting with PARTIAL-USERNAME. The cdr of the
1133 result is non-nil if and only if the completion returned in the car
1139 Lisp_Object completed =
1140 user_name_completion(partial_username, 0, &uniq);
1141 return Fcons(completed, uniq ? Qt : Qnil);
1144 DEFUN("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
1145 Return a list of all user name completions from PARTIAL-USERNAME.
1146 These are all the user names which begin with PARTIAL-USERNAME.
1150 return user_name_completion(partial_username, 1, NULL);
1159 struct user_name *user_names;
1162 EMACS_TIME last_rebuild_time;
1164 static struct user_cache user_cache;
1166 static void free_user_cache(struct user_cache *cache)
1169 for (i = 0; i < cache->length; i++)
1170 xfree(cache->user_names[i].ptr);
1171 xfree(cache->user_names);
1175 static Lisp_Object user_name_completion_unwind(Lisp_Object cache_incomplete_p)
1178 speed_up_interrupts();
1180 if (!NILP(XCAR(cache_incomplete_p)))
1181 free_user_cache(&user_cache);
1183 free_cons(XCONS(cache_incomplete_p));
1188 #define USER_CACHE_TTL (24*60*60) /* Time to live: 1 day, in seconds */
1191 user_name_completion(Lisp_Object user, int all_flag, int *uniq)
1193 /* This function can GC */
1195 Lisp_Object bestmatch = Qnil;
1196 Charcount bestmatchsize = 0;
1197 Charcount user_name_length;
1200 struct gcpro gcpro1, gcpro2;
1202 GCPRO2(user, bestmatch);
1206 user_name_length = XSTRING_CHAR_LENGTH(user);
1208 /* Cache user name lookups because it tends to be quite slow.
1209 * Rebuild the cache occasionally to catch changes */
1211 if (user_cache.user_names &&
1212 (EMACS_SECS(t) - EMACS_SECS(user_cache.last_rebuild_time)
1214 free_user_cache(&user_cache);
1216 if (!user_cache.user_names) {
1218 Lisp_Object cache_incomplete_p = noseeum_cons(Qt, Qnil);
1219 int speccount = specpdl_depth();
1221 slow_down_interrupts();
1223 record_unwind_protect(user_name_completion_unwind,
1224 cache_incomplete_p);
1225 while ((pwd = getpwent())) {
1227 DO_REALLOC(user_cache.user_names, user_cache.size,
1228 user_cache.length + 1, struct user_name);
1229 TO_INTERNAL_FORMAT(C_STRING, pwd->pw_name,
1232 user_names[user_cache.length].ptr,
1233 user_cache.user_names[user_cache.
1236 user_cache.length++;
1238 XCAR(cache_incomplete_p) = Qnil;
1239 unbind_to(speccount, Qnil);
1241 EMACS_GET_TIME(user_cache.last_rebuild_time);
1244 for (i = 0; i < user_cache.length; i++) {
1245 Bufbyte *u_name = user_cache.user_names[i].ptr;
1246 Bytecount len = user_cache.user_names[i].len;
1247 /* scmp() works in chars, not bytes, so we have to compute this: */
1248 Charcount cclen = bytecount_to_charcount(u_name, len);
1252 if (cclen < user_name_length
1253 || 0 <= scmp_1(u_name, XSTRING_DATA(user), user_name_length,
1257 matchcount++; /* count matching completions */
1259 if (all_flag || NILP(bestmatch)) {
1260 Lisp_Object name = Qnil;
1261 struct gcpro ngcpro1;
1263 /* This is a possible completion */
1264 name = make_string(u_name, len);
1266 bestmatch = Fcons(name, bestmatch);
1269 bestmatchsize = XSTRING_CHAR_LENGTH(name);
1273 Charcount compare = min(bestmatchsize, cclen);
1274 Bufbyte *p1 = XSTRING_DATA(bestmatch);
1275 Bufbyte *p2 = u_name;
1276 Charcount matchsize = scmp_1(p1, p2, compare, 0);
1279 matchsize = compare;
1281 bestmatchsize = matchsize;
1288 *uniq = (matchcount == 1);
1290 if (all_flag || NILP(bestmatch))
1292 if (matchcount == 1 && bestmatchsize == user_name_length)
1294 return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1297 Lisp_Object make_directory_hash_table(const char *path)
1300 if ((d = opendir(path))) {
1303 make_lisp_hash_table(20, HASH_TABLE_NON_WEAK,
1306 while ((dp = readdir(d))) {
1307 Bytecount len = NAMLEN(dp);
1308 if (DIRENTRY_NONEMPTY(dp))
1309 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
1310 Fputhash(make_string
1311 ((Bufbyte *) dp->d_name, len), Qt,
1321 /* ... never used ... should use list2 directly anyway ... */
1322 /* NOTE: This function can never return a negative value. */
1323 Lisp_Object wasteful_word_to_lisp(unsigned int item)
1325 /* Compatibility: in other versions, file-attributes returns a LIST
1326 of two 16 bit integers... */
1327 Lisp_Object cons = word_to_lisp(item);
1328 XCDR(cons) = Fcons(XCDR(cons), Qnil);
1333 DEFUN("file-attributes", Ffile_attributes, 1, 1, 0, /*
1334 Return a list of attributes of file FILENAME.
1335 Value is nil if specified file cannot be opened.
1336 Otherwise, list elements are:
1337 0. t for directory, string (name linked to) for symbolic link, or nil.
1338 1. Number of links to file.
1341 4. Last access time, as a list of two integers.
1342 First integer has high-order 16 bits of time, second has low 16 bits.
1343 5. Last modification time, likewise.
1344 6. Last status change time, likewise.
1345 7. Size in bytes. (-1, if number is out of range).
1346 8. File modes, as a string of ten letters or dashes as in ls -l.
1347 9. t iff file's gid would change if file were deleted and recreated.
1351 If file does not exist, returns nil.
1355 /* This function can GC. GC checked 1997.06.04. */
1356 Lisp_Object values[12];
1357 #if defined (BSD4_2) || defined (BSD4_3) || \
1358 !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1359 Lisp_Object directory = Qnil;
1360 #endif /* BSD4_2 || BSD4_3 || !BDWGC */
1363 Lisp_Object handler;
1364 struct gcpro gcpro1, gcpro2;
1366 GCPRO2(filename, directory);
1367 filename = Fexpand_file_name(filename, Qnil);
1369 /* If the file name has special constructs in it,
1370 call the corresponding file handler. */
1371 handler = Ffind_file_name_handler(filename, Qfile_attributes);
1372 if (!NILP(handler)) {
1374 return call2(handler, Qfile_attributes, filename);
1377 if (lstat((char *)XSTRING_DATA(filename), &s) < 0) {
1382 directory = Ffile_name_directory(filename);
1385 switch (s.st_mode & S_IFMT) {
1394 values[0] = Ffile_symlink_p(filename);
1398 values[1] = make_int(s.st_nlink);
1399 values[2] = make_int(s.st_uid);
1400 values[3] = make_int(s.st_gid);
1401 values[4] = make_time(s.st_atime);
1402 values[5] = make_time(s.st_mtime);
1403 values[6] = make_time(s.st_ctime);
1404 values[7] = make_int((EMACS_INT) s.st_size);
1405 /* If the size is out of range, give back -1. */
1406 /* #### Fix when Emacs gets bignums! */
1407 if (XINT(values[7]) != s.st_size)
1408 values[7] = make_int(-1);
1409 filemodestring(&s, modes);
1410 values[8] = make_string((Bufbyte *) modes, 10);
1411 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
1415 if (!NILP(directory)
1416 && sxemacs_stat((char *)XSTRING_DATA(directory), &sdir) == 0)
1417 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
1418 else /* if we can't tell, assume worst */
1421 #else /* file gid will be egid */
1422 values[9] = (s.st_gid != getegid())? Qt : Qnil;
1423 #endif /* BSD4_2 or BSD4_3 */
1424 values[10] = make_int(s.st_ino);
1425 values[11] = make_int(s.st_dev);
1427 return Flist(countof(values), values);
1431 /************************************************************************/
1432 /* initialization */
1433 /************************************************************************/
1435 void syms_of_dired(void)
1437 defsymbol(&Qdirectory_files, "directory-files");
1438 defsymbol(&Qdirectory_files_recur, "directory-files-recur");
1439 defsymbol(&Qfile_name_completion, "file-name-completion");
1440 defsymbol(&Qfile_name_all_completions, "file-name-all-completions");
1441 defsymbol(&Qfile_attributes, "file-attributes");
1443 defsymbol(&Qcompanion_bf, "companion-bf");
1444 defsymbol(&Qsorted_list, "sorted-list");
1445 defsymbol(&Qdesc_sorted_list, "desc-sorted-list");
1446 defsymbol(&Qunsorted_list, "unsorted-list");
1448 DEFSUBR(Fdirectory_files);
1449 DEFSUBR(Fdirectory_files_recur);
1450 DEFSUBR(Ffile_name_completion);
1451 DEFSUBR(Ffile_name_all_completions);
1452 DEFSUBR(Fuser_name_completion);
1453 DEFSUBR(Fuser_name_completion_1);
1454 DEFSUBR(Fuser_name_all_completions);
1455 DEFSUBR(Ffile_attributes);
1458 void vars_of_dired(void)
1460 DEFVAR_LISP("completion-ignored-extensions", &Vcompletion_ignored_extensions /*
1461 *Completion ignores filenames ending in any string in this list.
1462 This variable does not affect lists of possible completions,
1463 but does affect the commands that actually do completions.
1464 It is used by the function `file-name-completion'.
1466 Vcompletion_ignored_extensions = Qnil;
1468 DEFVAR_LISP("directory-files-no-trivial-p",
1469 &Vdirectory_files_no_trivial_p /*
1470 Determine whether to _not_ add the trivial directory entries
1472 ATTENTION: This variable is definitely NOT for users.
1473 For easy temporary circumvention use a let binding.
1475 Vdirectory_files_no_trivial_p = Qnil;