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 realpath(file, result);
140 fname_as_directory(Lisp_Object fname)
142 if (XSTRING_LENGTH(fname) > 0)
143 return Ffile_name_as_directory(fname);
149 pathname_matches_p(Lisp_Object pathname, Lisp_Object match,
150 struct re_pattern_buffer *bufp)
157 if (STRINGP(match)) {
158 mstr = (char*)XSTRING_DATA(pathname);
159 mlen = XSTRING_LENGTH(pathname);
160 if (re_search(bufp, mstr, mlen, 0, mlen, 0) < 0)
163 speccount2 = specpdl_depth();
164 record_unwind_protect(restore_gc_inhibit,
165 make_int(gc_currently_forbidden));
166 gc_currently_forbidden = 1;
167 if (NILP(call1_trapping_errors(
168 "Error in match function",
173 restore_match_data();
174 unbind_to(speccount2, Qnil);
181 static Lisp_Object close_directory_unwind(Lisp_Object unwind_obj)
183 DIR *d = (DIR *) get_opaque_ptr(unwind_obj);
185 free_opaque_ptr(unwind_obj);
191 dfr_inner(dirent_t *res,
192 Lisp_Object fulldir, Lisp_Object dir, Lisp_Object compbf,
193 dfr_options_t opts, Lisp_Object files_only,
194 unsigned int curdepth, dired_stack_t ds, Lisp_Object match,
195 struct re_pattern_buffer *bufp, Lisp_Object result,
196 Lisp_Object bloom_filter)
198 /* this function can GC */
201 Lisp_Object name = Qnil;
202 Lisp_Object fullname = Qnil;
203 Lisp_Object resname = Qnil;
206 char *statnam = NULL;
207 struct gcpro gcpro1, gcpro2, gcpro3;
209 GCPRO3(name, fullname, resname);
211 if (!DIRENTRY_NONEMPTY(res) ||
212 (TRIVIAL_DIRECTORY_ENTRY(res->d_name) &&
213 !(NILP(Vdirectory_files_no_trivial_p) && opts->maxdepth == 0))) {
219 resname = make_ext_string(res->d_name, len, Qfile_name);
221 FAST_CONCAT(fullname, fulldir, resname);
222 FAST_CONCAT(name, dir, resname);
224 /* we want full file names? */
231 /* check if we have to recur, i.e. if res was a
232 directory, otherwise we assume name to be a
233 file and cons it to the result */
234 #if defined(_DIRENT_HAVE_D_TYPE) && USE_D_TYPE
235 if (res->d_type == DT_DIR) {
237 } else if (res->d_type == DT_LNK && !opts->symlink_file_p) {
238 char *canon_name = NULL;
240 statnam = (char*)XSTRING_DATA(fullname);
242 /* ugly things may happen when a link
243 * points back to a directory in our recurring
244 * area, ln -s . foo is a candidate
245 * now, we canonicalise the filename, i.e.
246 * resolve all symlinks and afterwards we
247 * store it to our companion bloom filter
249 canon_name = CANONICALISE_FILENAME(statnam);
251 /* now, recycle full name */
252 fullname = make_ext_string(
253 canon_name, strlen(canon_name), Qfile_name);
254 fullname = fname_as_directory(fullname);
256 /* now stat statnam */
257 if (sxemacs_stat(statnam, &st) == 0 &&
258 (st.st_mode & S_IFMT) == S_IFDIR &&
260 !(bloom_owns_p(XBLOOM(compbf), fullname))) {
268 #else /* defined(_DIRENT_HAVE_D_TYPE) && USE_D_TYPE */
269 statnam = (char*)XSTRING_DATA(fullname);
270 if (sxemacs_stat(statnam, &st) == 0 &&
271 (st.st_mode & S_IFMT) == S_IFDIR) {
272 char *canon_name = NULL;
274 /* ugly things may happen when a link
275 * points back to a directory in our recurring
276 * area, ln -s . foo is a candidate
277 * now, we canonicalise the filename, i.e.
278 * resolve all symlinks and afterwards we
279 * store it to our companion bloom filter
280 * The ugly things are even worse than in the
281 * case of D_TYPE, since we !always! have to
282 * check against the bloom filter.
284 canon_name = CANONICALISE_FILENAME(statnam);
286 /* now, recycle full name */
287 fullname = make_ext_string(
288 canon_name, strlen(canon_name),
290 fullname = fname_as_directory(fullname);
292 /* now stat statnam */
293 if (sxemacs_stat(statnam, &st) == 0 &&
294 (st.st_mode & S_IFMT) == S_IFDIR &&
295 /* does the bloom know about the dir? */
297 !(bloom_owns_p(XBLOOM(compbf), fullname))) {
305 #endif /* defined(_DIRENT_HAVE_D_TYPE) && USE_D_TYPE */
307 /* argh, here is a design flaw!
308 these operations are not commutable, and it's a
309 hard-coded how `match' is interpreted.
310 * There are two possibilites:
311 * (1) check pathname against `match'
312 if nil, do not process further
313 if a directory, recur
314 if non-nil, add to result according to files_only
315 * (2) if a directory, recur
316 check pathname against `match'
317 if nil, do not add to result
318 if non-nil, add to result according to files_only
320 * Hm, I think I'd choose the latter variant, it is
321 not that performant, but it avoids two problems:
323 - With the former variant it is NOT possible to have
324 the trivial filenames on the result list, since a
325 match against "^[.]$" would exclude everything, while
326 actually it was likely meant to _solely_ exclude "."
328 - Furthermore, we _MUST_ traverse in preorder,
329 otherwise there is the possibility that pathnames are
330 on the file list already which turn out later to be
332 * Anyone wants to help brainstorming?
335 /* check if we put it on the list of matches */
336 if (NILP(files_only)) {
338 } else if (EQ(files_only, Qt) && !dir_p) {
340 } else if (!EQ(files_only, Qt) && dir_p) {
346 if (curdepth >= opts->maxdepth) {
351 dired_stack_item_t dsi;
352 dsi = xnew_and_zero(struct dired_stack_item_s);
354 dsi->depth = 1+curdepth;
355 dired_stack_push(ds, dsi);
359 if (!NILP(match) && !pathname_matches_p(name, match, bufp)) {
365 dllist_append(XDLLIST(result), (void*)resname);
366 /* add the result to the companion bloom-f */
367 /* hm, for large trees this yields a bf which
368 owns everything :( ... we need far better and
369 faster bloom techniques for it -hroptatyr */
370 if (!NILP(bloom_filter)) {
371 bloom_add(XBLOOM(bloom_filter), resname);
380 dfr_outer(Lisp_Object directory, dirent_t *ent,
381 Lisp_Object compbf, dfr_options_t opts,
382 Lisp_Object files_only, dired_stack_t ds, Lisp_Object match,
383 struct re_pattern_buffer *bufp, Lisp_Object result,
384 Lisp_Object bloom_filter)
386 dired_stack_item_t dir_dpt = dired_stack_pop(ds);
387 Lisp_Object dir = dir_dpt->dir;
388 unsigned int dpt = dir_dpt->depth;
389 Lisp_Object fulldir = Fexpand_file_name(dir, directory);
391 dirent_t *res = NULL;
392 struct gcpro gcpro1, gcpro2;
394 GCPRO2(dir, fulldir);
398 dir = fname_as_directory(dir);
399 fulldir = fname_as_directory(fulldir);
401 /* add the full directory name to the companion bloom filter */
403 bloom_add(XBLOOM(compbf), fulldir);
405 /* external format conversion is done in the encapsulation of
406 * opendir in sysdep.c
408 d = opendir((char*)XSTRING_DATA(fulldir));
410 /* why should we want this? I think spitting a warning
416 report_file_error("Opening directory", list1(fulldir));
421 warn_when_safe(Qfile, Qwarning,
422 "Opening directory `%s' failed",
423 (char*)XSTRING_DATA(fulldir));
429 record_unwind_protect(close_directory_unwind,
430 make_opaque_ptr((void *)d));
432 while (DFR_READDIR(d, ent, &res) == 0 && res != NULL) {
433 dfr_inner(res, fulldir, dir,
435 files_only, dpt, ds, match, bufp,
436 result, bloom_filter);
443 dired_stack_mark(Lisp_Object obj)
445 dired_stack_t ds = get_dynacat(obj);
446 WITH_DLLIST_TRAVERSE(
448 dired_stack_item_t dsi = dllist_item;
449 mark_object(dsi->dir));
455 dired_stack_fini(Lisp_Object obj)
457 dired_stack_t ds = get_dynacat(obj);
458 free_dired_stack(ds);
464 directory_files_magic(Lisp_Object directory, Lisp_Object match,
465 Lisp_Object files_only, Lisp_Object bloom_filter,
468 /* This function can GC */
469 Lisp_Object result = wrap_dllist(make_dllist());
470 Lisp_Object lds = Qnil;
471 dired_stack_t ds = NULL;
472 dired_stack_item_t ds_item = NULL;
473 /* this is a companion bloom filter,
474 * we register processed directories in here and hence avoid
475 * processing an entry twice */
476 Lisp_Object compbf = Qnil;
477 int speccount = specpdl_depth();
479 struct re_pattern_buffer *bufp = NULL;
481 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
483 ds = new_dired_stack();
484 lds = make_dynacat(ds);
485 set_dynacat_marker(lds, dired_stack_mark);
486 set_dynacat_finaliser(lds, (dynacat_finaliser_f)dired_stack_fini);
487 GCPRO5(directory, result, compbf, bloom_filter, lds);
490 /* SXEmacs: this should come after Ffile_name_as_directory() to avoid
491 potential regexp cache smashage. It comes before the opendir()
492 because it might signal an error. */
494 if (STRINGP(match)) {
496 /* MATCH might be a flawed regular expression. Rather
497 than catching and signalling our own errors, we just
498 call compile_pattern to do the work for us. */
499 bufp = compile_pattern(match, 0, Qnil, 0, ERROR_ME);
500 /* Now *bufp is the compiled form of MATCH; don't call
501 anything which might compile a new regexp until we
502 are done with the loop! */
504 } else if (!NILP(Ffunctionp(match))) {
507 return wrong_type_argument(Qstringp, match);
511 regex_match_object = Qnil;
512 regex_emacs_buffer = current_buffer;
515 if (opts->maxdepth > 0) {
516 compbf = make_bloom(8192, 8);
519 /* set up the directories queue */
520 ds_item = xnew_and_zero(struct dired_stack_item_s);
521 ds_item->dir = make_string((Bufbyte*)"", 0);
523 dired_stack_push(ds, ds_item);
525 /* alloc the directory entry pointer */
527 dirent_t _ent, *ent = &_ent;
530 memset(ent, 0, sizeof(dirent_t));
532 while (dired_stack_size(ds) > 0) {
533 dfr_outer(directory, ent, compbf,
534 opts, files_only, ds, match,
535 bufp, result, bloom_filter);
536 /* This will close the dir */
537 unbind_to(speccount, Qnil);
542 /* save the companion bloom filter */
543 Fput(result, Qcompanion_bf, compbf);
550 directory_files_canonicalise_dn(Lisp_Object directory)
555 /* expand the directory argument and canonicalise */
556 directory = Fexpand_file_name(directory, Qnil);
557 directory = fname_as_directory(directory);
559 RETURN_UNGCPRO(directory);
563 directory_files_resultify(Lisp_Object result, Lisp_Object result_type)
565 /* This function can GC */
566 Lisp_Object final_result = Qnil;
567 struct gcpro gcpro1, gcpro2, gcpro3;
568 GCPRO3(result, result_type, final_result);
570 /* see if the user requested a dllist */
571 if (EQ(result_type, Qdllist)) {
572 final_result = result;
573 } else if (NILP(result_type) || EQ(result_type, Qsorted_list)) {
574 final_result = Fdllist_to_list_reversed(result);
575 final_result = Fsort(final_result, Qstring_lessp);
576 } else if (EQ(result_type, Qdesc_sorted_list)) {
577 final_result = Fdllist_to_list(result);
578 final_result = Fsort(final_result, Qstring_greaterp);
579 } else if (EQ(result_type, Qt) || EQ(result_type, Qlist)) {
580 final_result = Fdllist_to_list(result);
588 call9(Lisp_Object fn,
589 Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2,
590 Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5,
591 Lisp_Object arg6, Lisp_Object arg7, Lisp_Object arg8)
593 /* This function can GC */
595 Lisp_Object res, args[10] = {fn, arg0, arg1, arg2, arg3,
596 arg4, arg5, arg6, arg7, arg8};
598 GCPROn(args, countof(args));
599 res = Ffuncall(10, args);
606 EXFUN(Fdirectory_files_recur, 8);
608 DEFUN("directory-files", Fdirectory_files, 1, 5, 0, /*
609 Return a list of names of files in DIRECTORY.
610 Args are DIRECTORY &optional FULL MATCH RESULT-TYPE FILES_ONLY.
612 There are four optional arguments:
613 If FULL is non-nil, absolute pathnames of the files are returned.
615 If MATCH is non-nil, it may be a string indicating a regular
616 expression which pathnames must meet in order to be returned.
617 Moreover, a predicate function can be specified which is called with
618 one argument, the pathname in question. On non-nil return value,
619 the pathname is considered in the final result, otherwise it is
622 Optional argument RESULT-TYPE can be one of:
623 - sorted-list (default) to return a list, sorted in alphabetically
625 - desc-sorted-list to return a list, sorted in alphabetically
627 - list to return an unsorted list
628 - dllist to return an unsorted dllist
629 The two latter types can be useful if you plan to sort the result
630 yourself, or want to feed the result to further processing.
632 Optional argument FILES-ONLY can be one of:
633 - t to return only files and symlinks in DIRECTORY
634 - nil (default) to return all entries (files, symlinks, and
635 subdirectories) in DIRECTORY
636 - subdir to return only subdirectories -- but *NOT* symlinks to
637 directories -- in DIRECTORY
639 (directory, full, match, result_type, files_only))
642 Lisp_Object result = Qnil;
643 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
644 struct dfr_options_s opts = {
646 .fullp = !NILP(full),
649 GCPRO6(directory, full, match, result_type, files_only, result);
651 directory = directory_files_canonicalise_dn(directory);
653 /* If the file name has special constructs in it,
654 call the corresponding file handler. */
655 handler = Ffind_file_name_handler(directory, Qdirectory_files);
656 if (!NILP(handler)) {
658 return call6(handler, Qdirectory_files,
659 directory, full, match, result_type, files_only);
662 result = directory_files_magic(directory, match,
663 files_only, /* bloom filter */Qnil,
667 return directory_files_resultify(result, result_type);
670 DEFUN("directory-files-recur", Fdirectory_files_recur, 1, 8, 0, /*
671 Like `directory-files' but recursive and much faster.
672 Args are DIRECTORY &optional FULL MATCH RESULT_TYPE FILES-ONLY MAXDEPTH
673 SYMLINK_IS_FILE BLOOM_FILTER
675 If FULL is non-nil, absolute pathnames of the files are returned.
677 If MATCH is non-nil, it may be a string indicating a regular
678 expression which pathnames must meet in order to be returned.
679 Moreover, a predicate function can be specified which is called with
680 one argument, the pathname in question. On non-nil return value,
681 the pathname is considered in the final result, otherwise it is
684 Optional argument RESULT-TYPE can be one of:
685 - sorted-list (default) to return a list, sorted in alphabetically
687 - desc-sorted-list to return a list, sorted in alphabetically
689 - list to return an unsorted list
690 - dllist to return an unsorted dllist
691 The two latter types can be useful if you plan to sort the result
692 yourself, or want to feed the result to further processing.
694 Optional argument FILES-ONLY can be one of:
695 - t to return only files and symlinks in DIRECTORY
696 - nil (default) to return all entries (files, symlinks, and
697 subdirectories) in DIRECTORY
698 - subdir to return only subdirectories -- but *NOT* symlinks to
699 directories -- in DIRECTORY
701 Optional argument MAXDEPTH \(a positive integer\) specifies the
702 maximal recursion depth, use 0 to emulate old `directory-files'.
704 Optional argument SYMLINK-IS-FILE specifies whether symlinks
705 should be resolved \(which is the default behaviour\) or whether
706 they are treated as ordinary files \(non-nil\), in the latter
707 case symlinks to directories are not recurred.
709 Optional argument BLOOM-FILTER specifies a bloom filter where
710 to put results in addition to the ordinary result list.
712 (directory, full, match, result_type, files_only, maxdepth,
713 symlink_is_file, bloom_filter))
715 (int nargs, Lisp_Object *args))
718 Lisp_Object handler = Qnil, result = Qnil;
719 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
720 /* just a convenience array for gc pro'ing */
721 Lisp_Object args[8] = {
722 directory, match, result_type, files_only,
723 symlink_is_file, bloom_filter, handler, result};
725 struct dfr_options_s opts = {
727 .fullp = !NILP(full),
728 .symlink_file_p = !NILP(symlink_is_file),
732 /* argument checks */
733 CHECK_STRING(directory);
737 if (!NILP(maxdepth)) {
738 CHECK_NATNUM(maxdepth);
739 opts.maxdepth = XUINT(maxdepth);
742 GCPROn(args, countof(args));
744 directory = directory_files_canonicalise_dn(directory);
746 /* If the file name has special constructs in it,
747 call the corresponding file handler. */
748 handler = Ffind_file_name_handler(directory, Qdirectory_files_recur);
749 if (!NILP(handler)) {
752 res = call9(handler, Qdirectory_files_recur,
753 directory, full, match, result_type, files_only,
754 maxdepth, symlink_is_file, bloom_filter);
759 result = directory_files_magic(directory, match,
760 files_only, bloom_filter,
762 /* convert to final result type */
763 result = directory_files_resultify(result, result_type);
769 static Lisp_Object file_name_completion(Lisp_Object file,
770 Lisp_Object directory,
771 int all_flag, int ver_flag);
773 DEFUN("file-name-completion", Ffile_name_completion, 2, 2, 0, /*
774 Complete file name PARTIAL-FILENAME in directory DIRECTORY.
775 Return the longest prefix common to all file names in DIRECTORY
776 that start with PARTIAL-FILENAME.
777 If there is only one and PARTIAL-FILENAME matches it exactly, return t.
778 Return nil if DIRECTORY contains no name starting with PARTIAL-FILENAME.
780 File names which end with any member of `completion-ignored-extensions'
781 are not considered as possible completions for PARTIAL-FILENAME unless
782 there is no other possible completion. `completion-ignored-extensions'
783 is not applied to the names of directories.
785 (partial_filename, directory))
787 /* This function can GC. GC checked 1996.04.06. */
790 /* If the directory name has special constructs in it,
791 call the corresponding file handler. */
792 handler = Ffind_file_name_handler(directory, Qfile_name_completion);
794 return call3(handler, Qfile_name_completion, partial_filename,
797 /* If the file name has special constructs in it,
798 call the corresponding file handler. */
800 Ffind_file_name_handler(partial_filename, Qfile_name_completion);
802 return call3(handler, Qfile_name_completion, partial_filename,
805 return file_name_completion(partial_filename, directory, 0, 0);
808 DEFUN("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
809 Return a list of all completions of PARTIAL-FILENAME in DIRECTORY.
810 These are all file names in DIRECTORY which begin with PARTIAL-FILENAME.
812 (partial_filename, directory))
814 /* This function can GC. GC checked 1997.06.04. */
819 directory = Fexpand_file_name(directory, Qnil);
820 /* If the file name has special constructs in it,
821 call the corresponding file handler. */
823 Ffind_file_name_handler(directory, Qfile_name_all_completions);
826 return call3(handler, Qfile_name_all_completions,
827 partial_filename, directory);
829 return file_name_completion(partial_filename, directory, 1, 0);
833 file_name_completion_stat(Lisp_Object directory, DIRENTRY * dp,
834 struct stat *st_addr)
836 Bytecount len = NAMLEN(dp);
837 Bytecount pos = XSTRING_LENGTH(directory);
839 char *fullname = (char *)alloca(len + pos + 2);
841 memcpy(fullname, XSTRING_DATA(directory), pos);
842 if (!IS_DIRECTORY_SEP(fullname[pos - 1]))
843 fullname[pos++] = DIRECTORY_SEP;
845 memcpy(fullname + pos, dp->d_name, len);
846 fullname[pos + len] = 0;
849 /* We want to return success if a link points to a nonexistent file,
850 but we want to return the status for what the link points to,
851 in case it is a directory. */
852 value = lstat(fullname, st_addr);
853 if (S_ISLNK(st_addr->st_mode))
854 (void)sxemacs_stat(fullname, st_addr);
856 value = sxemacs_stat(fullname, st_addr);
861 static Lisp_Object file_name_completion_unwind(Lisp_Object locative)
864 Lisp_Object obj = XCAR(locative);
867 d = (DIR *) get_opaque_ptr(obj);
869 free_opaque_ptr(obj);
871 free_cons(XCONS(locative));
876 file_name_completion(Lisp_Object file, Lisp_Object directory, int all_flag,
879 /* This function can GC */
882 Lisp_Object bestmatch = Qnil;
883 Charcount bestmatchsize = 0;
886 int speccount = specpdl_depth();
887 Charcount file_name_length;
888 Lisp_Object locative;
889 struct gcpro gcpro1, gcpro2, gcpro3;
891 GCPRO3(file, directory, bestmatch);
895 #ifdef FILE_SYSTEM_CASE
896 file = FILE_SYSTEM_CASE(file);
898 directory = Fexpand_file_name(directory, Qnil);
899 file_name_length = XSTRING_CHAR_LENGTH(file);
901 /* With passcount = 0, ignore files that end in an ignored extension.
902 If nothing found then try again with passcount = 1, don't ignore them.
903 If looking for all completions, start with passcount = 1,
904 so always take even the ignored ones.
906 ** It would not actually be helpful to the user to ignore any possible
907 completions when making a list of them.** */
909 /* We cannot use close_directory_unwind() because we change the
910 directory. The old code used to just avoid signaling errors, and
911 call closedir, but it was wrong, because it made sane handling of
912 QUIT impossible and, besides, various utility functions like
913 regexp_ignore_completion_p can signal errors. */
914 locative = noseeum_cons(Qnil, Qnil);
915 record_unwind_protect(file_name_completion_unwind, locative);
917 for (passcount = !!all_flag; NILP(bestmatch) && passcount < 2;
919 Lisp_Object tmp_dfn = Fdirectory_file_name(directory);
920 d = opendir((char *)XSTRING_DATA(tmp_dfn));
922 report_file_error("Opening directory",
925 XCAR(locative) = make_opaque_ptr((void *)d);
927 /* Loop reading blocks */
931 /* scmp() works in characters, not bytes, so we have to compute
935 int ignored_extension_p = 0;
942 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
943 d_name = (Bufbyte *) dp->d_name;
945 cclen = bytecount_to_charcount(d_name, len);
949 if (!DIRENTRY_NONEMPTY(dp)
950 || cclen < file_name_length
951 || 0 <= scmp(d_name, XSTRING_DATA(file),
955 if (file_name_completion_stat(directory, dp, &st) < 0)
958 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
960 /* "." and ".." are never interesting as completions, but are
961 actually in the way in a directory containing only one file. */
963 && TRIVIAL_DIRECTORY_ENTRY(dp->d_name))
966 /* Compare extensions-to-be-ignored against end of this file name */
967 /* if name is not an exact match against specified string. */
968 if (!passcount && cclen > file_name_length) {
970 /* and exit this for loop if a match is found */
971 EXTERNAL_LIST_LOOP(tem,
972 Vcompletion_ignored_extensions)
974 Lisp_Object elt = XCAR(tem);
981 XSTRING_CHAR_LENGTH(elt);
991 ignored_extension_p = 1;
998 /* If an ignored-extensions match was found,
999 don't process this name as a completion. */
1000 if (!passcount && ignored_extension_p)
1004 && regexp_ignore_completion_p(d_name, Qnil, 0,
1008 /* Update computation of how much all possible completions match */
1011 if (all_flag || NILP(bestmatch)) {
1012 Lisp_Object name = Qnil;
1013 struct gcpro ngcpro1;
1015 /* This is a possible completion */
1016 name = make_string(d_name, len);
1017 if (directoryp) /* Completion is a directory; end it with '/' */
1018 name = Ffile_name_as_directory(name);
1020 bestmatch = Fcons(name, bestmatch);
1024 XSTRING_CHAR_LENGTH(name);
1028 Charcount compare = min(bestmatchsize, cclen);
1029 Bufbyte *p1 = XSTRING_DATA(bestmatch);
1030 Bufbyte *p2 = d_name;
1031 Charcount matchsize = scmp(p1, p2, compare);
1034 matchsize = compare;
1035 if (completion_ignore_case) {
1036 /* If this is an exact match except for case,
1037 use it as the best match rather than one that is not
1038 an exact match. This way, we get the case pattern
1039 of the actual match. */
1040 if ((matchsize == cclen
1041 && matchsize + !!directoryp
1042 < XSTRING_CHAR_LENGTH(bestmatch))
1044 /* If there is no exact match ignoring case,
1045 prefer a match that does not change the case
1047 (((matchsize == cclen)
1049 (matchsize + !!directoryp
1051 XSTRING_CHAR_LENGTH(bestmatch)))
1052 /* If there is more than one exact match aside from
1053 case, and one of them is exact including case,
1057 file_name_length, 0)
1063 make_string(d_name, len);
1066 Ffile_name_as_directory
1071 /* If this directory all matches,
1072 see if implicit following slash does too. */
1074 && compare == matchsize
1075 && bestmatchsize > matchsize
1077 IS_ANY_SEP(charptr_emchar_n(p1, matchsize)))
1079 bestmatchsize = matchsize;
1083 free_opaque_ptr(XCAR(locative));
1084 XCAR(locative) = Qnil;
1087 unbind_to(speccount, Qnil);
1091 if (all_flag || NILP(bestmatch))
1093 if (matchcount == 1 && bestmatchsize == file_name_length)
1095 return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1098 static Lisp_Object user_name_completion(Lisp_Object user,
1099 int all_flag, int *uniq);
1101 DEFUN("user-name-completion", Fuser_name_completion, 1, 1, 0, /*
1102 Complete user name from PARTIAL-USERNAME.
1103 Return the longest prefix common to all user names starting with
1104 PARTIAL-USERNAME. If there is only one and PARTIAL-USERNAME matches
1105 it exactly, returns t. Return nil if there is no user name starting
1106 with PARTIAL-USERNAME.
1110 return user_name_completion(partial_username, 0, NULL);
1113 DEFUN("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /*
1114 Complete user name from PARTIAL-USERNAME.
1116 This function is identical to `user-name-completion', except that
1117 the cons of the completion and an indication of whether the
1118 completion was unique is returned.
1120 The car of the returned value is the longest prefix common to all user
1121 names that start with PARTIAL-USERNAME. If there is only one and
1122 PARTIAL-USERNAME matches it exactly, the car is t. The car is nil if
1123 there is no user name starting with PARTIAL-USERNAME. The cdr of the
1124 result is non-nil if and only if the completion returned in the car
1130 Lisp_Object completed =
1131 user_name_completion(partial_username, 0, &uniq);
1132 return Fcons(completed, uniq ? Qt : Qnil);
1135 DEFUN("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
1136 Return a list of all user name completions from PARTIAL-USERNAME.
1137 These are all the user names which begin with PARTIAL-USERNAME.
1141 return user_name_completion(partial_username, 1, NULL);
1150 struct user_name *user_names;
1153 EMACS_TIME last_rebuild_time;
1155 static struct user_cache user_cache;
1157 static void free_user_cache(struct user_cache *cache)
1160 for (i = 0; i < cache->length; i++)
1161 xfree(cache->user_names[i].ptr);
1162 xfree(cache->user_names);
1166 static Lisp_Object user_name_completion_unwind(Lisp_Object cache_incomplete_p)
1169 speed_up_interrupts();
1171 if (!NILP(XCAR(cache_incomplete_p)))
1172 free_user_cache(&user_cache);
1174 free_cons(XCONS(cache_incomplete_p));
1179 #define USER_CACHE_TTL (24*60*60) /* Time to live: 1 day, in seconds */
1182 user_name_completion(Lisp_Object user, int all_flag, int *uniq)
1184 /* This function can GC */
1186 Lisp_Object bestmatch = Qnil;
1187 Charcount bestmatchsize = 0;
1188 Charcount user_name_length;
1191 struct gcpro gcpro1, gcpro2;
1193 GCPRO2(user, bestmatch);
1197 user_name_length = XSTRING_CHAR_LENGTH(user);
1199 /* Cache user name lookups because it tends to be quite slow.
1200 * Rebuild the cache occasionally to catch changes */
1202 if (user_cache.user_names &&
1203 (EMACS_SECS(t) - EMACS_SECS(user_cache.last_rebuild_time)
1205 free_user_cache(&user_cache);
1207 if (!user_cache.user_names) {
1209 Lisp_Object cache_incomplete_p = noseeum_cons(Qt, Qnil);
1210 int speccount = specpdl_depth();
1212 slow_down_interrupts();
1214 record_unwind_protect(user_name_completion_unwind,
1215 cache_incomplete_p);
1216 while ((pwd = getpwent())) {
1218 DO_REALLOC(user_cache.user_names, user_cache.size,
1219 user_cache.length + 1, struct user_name);
1220 TO_INTERNAL_FORMAT(C_STRING, pwd->pw_name,
1223 user_names[user_cache.length].ptr,
1224 user_cache.user_names[user_cache.
1227 user_cache.length++;
1229 XCAR(cache_incomplete_p) = Qnil;
1230 unbind_to(speccount, Qnil);
1232 EMACS_GET_TIME(user_cache.last_rebuild_time);
1235 for (i = 0; i < user_cache.length; i++) {
1236 Bufbyte *u_name = user_cache.user_names[i].ptr;
1237 Bytecount len = user_cache.user_names[i].len;
1238 /* scmp() works in chars, not bytes, so we have to compute this: */
1239 Charcount cclen = bytecount_to_charcount(u_name, len);
1243 if (cclen < user_name_length
1244 || 0 <= scmp_1(u_name, XSTRING_DATA(user), user_name_length,
1248 matchcount++; /* count matching completions */
1250 if (all_flag || NILP(bestmatch)) {
1251 Lisp_Object name = Qnil;
1252 struct gcpro ngcpro1;
1254 /* This is a possible completion */
1255 name = make_string(u_name, len);
1257 bestmatch = Fcons(name, bestmatch);
1260 bestmatchsize = XSTRING_CHAR_LENGTH(name);
1264 Charcount compare = min(bestmatchsize, cclen);
1265 Bufbyte *p1 = XSTRING_DATA(bestmatch);
1266 Bufbyte *p2 = u_name;
1267 Charcount matchsize = scmp_1(p1, p2, compare, 0);
1270 matchsize = compare;
1272 bestmatchsize = matchsize;
1279 *uniq = (matchcount == 1);
1281 if (all_flag || NILP(bestmatch))
1283 if (matchcount == 1 && bestmatchsize == user_name_length)
1285 return Fsubstring(bestmatch, Qzero, make_int(bestmatchsize));
1288 Lisp_Object make_directory_hash_table(const char *path)
1291 if ((d = opendir(path))) {
1294 make_lisp_hash_table(20, HASH_TABLE_NON_WEAK,
1297 while ((dp = readdir(d))) {
1298 Bytecount len = NAMLEN(dp);
1299 if (DIRENTRY_NONEMPTY(dp))
1300 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
1301 Fputhash(make_string
1302 ((Bufbyte *) dp->d_name, len), Qt,
1312 /* ... never used ... should use list2 directly anyway ... */
1313 /* NOTE: This function can never return a negative value. */
1314 Lisp_Object wasteful_word_to_lisp(unsigned int item)
1316 /* Compatibility: in other versions, file-attributes returns a LIST
1317 of two 16 bit integers... */
1318 Lisp_Object cons = word_to_lisp(item);
1319 XCDR(cons) = Fcons(XCDR(cons), Qnil);
1324 DEFUN("file-attributes", Ffile_attributes, 1, 1, 0, /*
1325 Return a list of attributes of file FILENAME.
1326 Value is nil if specified file cannot be opened.
1327 Otherwise, list elements are:
1328 0. t for directory, string (name linked to) for symbolic link, or nil.
1329 1. Number of links to file.
1332 4. Last access time, as a list of two integers.
1333 First integer has high-order 16 bits of time, second has low 16 bits.
1334 5. Last modification time, likewise.
1335 6. Last status change time, likewise.
1336 7. Size in bytes. (-1, if number is out of range).
1337 8. File modes, as a string of ten letters or dashes as in ls -l.
1338 9. t iff file's gid would change if file were deleted and recreated.
1342 If file does not exist, returns nil.
1346 /* This function can GC. GC checked 1997.06.04. */
1347 Lisp_Object values[12];
1348 #if defined (BSD4_2) || defined (BSD4_3) || \
1349 !defined HAVE_BDWGC || !defined EF_USE_BDWGC
1350 Lisp_Object directory = Qnil;
1351 #endif /* BSD4_2 || BSD4_3 || !BDWGC */
1354 Lisp_Object handler;
1355 struct gcpro gcpro1, gcpro2;
1357 GCPRO2(filename, directory);
1358 filename = Fexpand_file_name(filename, Qnil);
1360 /* If the file name has special constructs in it,
1361 call the corresponding file handler. */
1362 handler = Ffind_file_name_handler(filename, Qfile_attributes);
1363 if (!NILP(handler)) {
1365 return call2(handler, Qfile_attributes, filename);
1368 if (lstat((char *)XSTRING_DATA(filename), &s) < 0) {
1373 directory = Ffile_name_directory(filename);
1376 switch (s.st_mode & S_IFMT) {
1385 values[0] = Ffile_symlink_p(filename);
1389 values[1] = make_int(s.st_nlink);
1390 values[2] = make_int(s.st_uid);
1391 values[3] = make_int(s.st_gid);
1392 values[4] = make_time(s.st_atime);
1393 values[5] = make_time(s.st_mtime);
1394 values[6] = make_time(s.st_ctime);
1395 values[7] = make_int((EMACS_INT) s.st_size);
1396 /* If the size is out of range, give back -1. */
1397 /* #### Fix when Emacs gets bignums! */
1398 if (XINT(values[7]) != s.st_size)
1399 values[7] = make_int(-1);
1400 filemodestring(&s, modes);
1401 values[8] = make_string((Bufbyte *) modes, 10);
1402 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
1406 if (!NILP(directory)
1407 && sxemacs_stat((char *)XSTRING_DATA(directory), &sdir) == 0)
1408 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
1409 else /* if we can't tell, assume worst */
1412 #else /* file gid will be egid */
1413 values[9] = (s.st_gid != getegid())? Qt : Qnil;
1414 #endif /* BSD4_2 or BSD4_3 */
1415 values[10] = make_int(s.st_ino);
1416 values[11] = make_int(s.st_dev);
1418 return Flist(countof(values), values);
1422 /************************************************************************/
1423 /* initialization */
1424 /************************************************************************/
1426 void syms_of_dired(void)
1428 defsymbol(&Qdirectory_files, "directory-files");
1429 defsymbol(&Qdirectory_files_recur, "directory-files-recur");
1430 defsymbol(&Qfile_name_completion, "file-name-completion");
1431 defsymbol(&Qfile_name_all_completions, "file-name-all-completions");
1432 defsymbol(&Qfile_attributes, "file-attributes");
1434 defsymbol(&Qcompanion_bf, "companion-bf");
1435 defsymbol(&Qsorted_list, "sorted-list");
1436 defsymbol(&Qdesc_sorted_list, "desc-sorted-list");
1437 defsymbol(&Qunsorted_list, "unsorted-list");
1439 DEFSUBR(Fdirectory_files);
1440 DEFSUBR(Fdirectory_files_recur);
1441 DEFSUBR(Ffile_name_completion);
1442 DEFSUBR(Ffile_name_all_completions);
1443 DEFSUBR(Fuser_name_completion);
1444 DEFSUBR(Fuser_name_completion_1);
1445 DEFSUBR(Fuser_name_all_completions);
1446 DEFSUBR(Ffile_attributes);
1449 void vars_of_dired(void)
1451 DEFVAR_LISP("completion-ignored-extensions", &Vcompletion_ignored_extensions /*
1452 *Completion ignores filenames ending in any string in this list.
1453 This variable does not affect lists of possible completions,
1454 but does affect the commands that actually do completions.
1455 It is used by the function `file-name-completion'.
1457 Vcompletion_ignored_extensions = Qnil;
1459 DEFVAR_LISP("directory-files-no-trivial-p",
1460 &Vdirectory_files_no_trivial_p /*
1461 Determine whether to _not_ add the trivial directory entries
1463 ATTENTION: This variable is definitely NOT for users.
1464 For easy temporary circumvention use a let binding.
1466 Vdirectory_files_no_trivial_p = Qnil;