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 XEmacs.
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Synched up with: FSF 19.30. */
38 Lisp_Object Vcompletion_ignored_extensions;
39 Lisp_Object Qdirectory_files;
40 Lisp_Object Qfile_name_completion;
41 Lisp_Object Qfile_name_all_completions;
42 Lisp_Object Qfile_attributes;
45 close_directory_unwind (Lisp_Object unwind_obj)
47 DIR *d = (DIR *)get_opaque_ptr (unwind_obj);
49 free_opaque_ptr (unwind_obj);
53 DEFUN ("directory-files", Fdirectory_files, 1, 5, 0, /*
54 Return a list of names of files in DIRECTORY.
55 There are four optional arguments:
56 If FULL is non-nil, absolute pathnames of the files are returned.
57 If MATCH is non-nil, only pathnames containing that regexp are returned.
58 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
59 NOSORT is useful if you plan to sort the result yourself.
60 If FILES-ONLY is the symbol t, then only the "files" in the directory
61 will be returned; subdirectories will be excluded. If FILES-ONLY is not
62 nil and not t, then only the subdirectories will be returned. Otherwise,
63 if FILES-ONLY is nil (the default) then both files and subdirectories will
66 (directory, full, match, nosort, files_only))
68 /* This function can GC */
70 Lisp_Object list = Qnil;
71 Bytecount directorylen;
73 struct re_pattern_buffer *bufp = NULL;
74 int speccount = specpdl_depth ();
75 char *statbuf, *statbuf_tail;
77 struct gcpro gcpro1, gcpro2;
78 GCPRO2 (directory, list);
80 /* If the file name has special constructs in it,
81 call the corresponding file handler. */
82 handler = Ffind_file_name_handler (directory, Qdirectory_files);
86 if (!NILP (files_only))
87 return call6 (handler, Qdirectory_files, directory, full, match,
90 return call5 (handler, Qdirectory_files, directory, full, match,
94 /* #### why do we do Fexpand_file_name after file handlers here,
95 but earlier everywhere else? */
96 directory = Fexpand_file_name (directory, Qnil);
97 directory = Ffile_name_as_directory (directory);
98 directorylen = XSTRING_LENGTH (directory);
100 statbuf = (char *)alloca (directorylen + MAXNAMLEN + 1);
101 memcpy (statbuf, XSTRING_DATA (directory), directorylen);
102 statbuf_tail = statbuf + directorylen;
104 /* XEmacs: this should come after Ffile_name_as_directory() to avoid
105 potential regexp cache smashage. It comes before the opendir()
106 because it might signal an error. */
109 CHECK_STRING (match);
111 /* MATCH might be a flawed regular expression. Rather than
112 catching and signalling our own errors, we just call
113 compile_pattern to do the work for us. */
114 bufp = compile_pattern (match, 0, Qnil, 0, ERROR_ME);
117 /* Now *bufp is the compiled form of MATCH; don't call anything
118 which might compile a new regexp until we're done with the loop! */
120 /* Do this opendir after anything which might signal an error.
121 NOTE: the above comment is old; previously, there was no
122 unwind-protection in case of error, but now there is. */
123 d = opendir ((char *) XSTRING_DATA (directory));
125 report_file_error ("Opening directory", list1 (directory));
127 regex_match_object = Qt;
128 regex_emacs_buffer = current_buffer;
130 record_unwind_protect (close_directory_unwind, make_opaque_ptr ((void *)d));
132 /* Loop reading blocks */
135 DIRENTRY *dp = readdir (d);
141 if (DIRENTRY_NONEMPTY (dp)
143 || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0))))
145 if (!NILP (files_only))
150 memcpy (statbuf_tail, dp->d_name, len);
151 statbuf_tail[len] = 0;
153 if (xemacs_stat (statbuf, &st) == 0
154 && (st.st_mode & S_IFMT) == S_IFDIR)
157 if (EQ (files_only, Qt) && dir_p)
159 else if (!EQ (files_only, Qt) && !dir_p)
165 make_string ((Bufbyte *)dp->d_name, len);
167 name = concat2 (directory, name);
169 list = Fcons (name, list);
173 unbind_to (speccount, Qnil); /* This will close the dir */
176 list = Fsort (Fnreverse (list), Qstring_lessp);
178 RETURN_UNGCPRO (list);
181 static Lisp_Object file_name_completion (Lisp_Object file,
182 Lisp_Object directory,
183 int all_flag, int ver_flag);
185 DEFUN ("file-name-completion", Ffile_name_completion, 2, 2, 0, /*
186 Complete file name PARTIAL-FILENAME in directory DIRECTORY.
187 Return the longest prefix common to all file names in DIRECTORY
188 that start with PARTIAL-FILENAME.
189 If there is only one and PARTIAL-FILENAME matches it exactly, return t.
190 Return nil if DIRECTORY contains no name starting with PARTIAL-FILENAME.
192 File names which end with any member of `completion-ignored-extensions'
193 are not considered as possible completions for PARTIAL-FILENAME unless
194 there is no other possible completion. `completion-ignored-extensions'
195 is not applied to the names of directories.
197 (partial_filename, directory))
199 /* This function can GC. GC checked 1996.04.06. */
202 /* If the directory name has special constructs in it,
203 call the corresponding file handler. */
204 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
206 return call3 (handler, Qfile_name_completion, partial_filename, directory);
208 /* If the file name has special constructs in it,
209 call the corresponding file handler. */
210 handler = Ffind_file_name_handler (partial_filename, Qfile_name_completion);
212 return call3 (handler, Qfile_name_completion, partial_filename, directory);
214 return file_name_completion (partial_filename, directory, 0, 0);
217 DEFUN ("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
218 Return a list of all completions of PARTIAL-FILENAME in DIRECTORY.
219 These are all file names in DIRECTORY which begin with PARTIAL-FILENAME.
221 (partial_filename, directory))
223 /* This function can GC. GC checked 1997.06.04. */
228 directory = Fexpand_file_name (directory, Qnil);
229 /* If the file name has special constructs in it,
230 call the corresponding file handler. */
231 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
234 return call3 (handler, Qfile_name_all_completions, partial_filename,
237 return file_name_completion (partial_filename, directory, 1, 0);
241 file_name_completion_stat (Lisp_Object directory, DIRENTRY *dp,
242 struct stat *st_addr)
244 Bytecount len = NAMLEN (dp);
245 Bytecount pos = XSTRING_LENGTH (directory);
247 char *fullname = (char *) alloca (len + pos + 2);
249 memcpy (fullname, XSTRING_DATA (directory), pos);
250 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
251 fullname[pos++] = DIRECTORY_SEP;
253 memcpy (fullname + pos, dp->d_name, len);
254 fullname[pos + len] = 0;
257 /* We want to return success if a link points to a nonexistent file,
258 but we want to return the status for what the link points to,
259 in case it is a directory. */
260 value = lstat (fullname, st_addr);
261 if (S_ISLNK (st_addr->st_mode))
262 xemacs_stat (fullname, st_addr);
264 value = xemacs_stat (fullname, st_addr);
270 file_name_completion_unwind (Lisp_Object locative)
273 Lisp_Object obj = XCAR (locative);
277 d = (DIR *)get_opaque_ptr (obj);
279 free_opaque_ptr (obj);
281 free_cons (XCONS (locative));
286 file_name_completion (Lisp_Object file, Lisp_Object directory, int all_flag,
289 /* This function can GC */
292 Lisp_Object bestmatch = Qnil;
293 Charcount bestmatchsize = 0;
296 int speccount = specpdl_depth ();
297 Charcount file_name_length;
298 Lisp_Object locative;
299 struct gcpro gcpro1, gcpro2, gcpro3;
301 GCPRO3 (file, directory, bestmatch);
306 /* Filename completion on Windows ignores case, since Windows
308 specbind (Qcompletion_ignore_case, Qt);
309 #endif /* WIN32_NATIVE */
311 #ifdef FILE_SYSTEM_CASE
312 file = FILE_SYSTEM_CASE (file);
314 directory = Fexpand_file_name (directory, Qnil);
315 file_name_length = XSTRING_CHAR_LENGTH (file);
317 /* With passcount = 0, ignore files that end in an ignored extension.
318 If nothing found then try again with passcount = 1, don't ignore them.
319 If looking for all completions, start with passcount = 1,
320 so always take even the ignored ones.
322 ** It would not actually be helpful to the user to ignore any possible
323 completions when making a list of them.** */
325 /* We cannot use close_directory_unwind() because we change the
326 directory. The old code used to just avoid signaling errors, and
327 call closedir, but it was wrong, because it made sane handling of
328 QUIT impossible and, besides, various utility functions like
329 regexp_ignore_completion_p can signal errors. */
330 locative = noseeum_cons (Qnil, Qnil);
331 record_unwind_protect (file_name_completion_unwind, locative);
333 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
335 d = opendir ((char *) XSTRING_DATA (Fdirectory_file_name (directory)));
337 report_file_error ("Opening directory", list1 (directory));
338 XCAR (locative) = make_opaque_ptr ((void *)d);
340 /* Loop reading blocks */
345 /* scmp() works in characters, not bytes, so we have to compute
349 int ignored_extension_p = 0;
355 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
356 d_name = (Bufbyte *) dp->d_name;
358 cclen = bytecount_to_charcount (d_name, len);
362 if (! DIRENTRY_NONEMPTY (dp)
363 || cclen < file_name_length
364 || 0 <= scmp (d_name, XSTRING_DATA (file), file_name_length))
367 if (file_name_completion_stat (directory, dp, &st) < 0)
370 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
373 #ifndef TRIVIAL_DIRECTORY_ENTRY
374 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
376 /* "." and ".." are never interesting as completions, but are
377 actually in the way in a directory containing only one file. */
378 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
383 /* Compare extensions-to-be-ignored against end of this file name */
384 /* if name is not an exact match against specified string. */
385 if (!passcount && cclen > file_name_length)
388 /* and exit this for loop if a match is found */
389 EXTERNAL_LIST_LOOP (tem, Vcompletion_ignored_extensions)
391 Lisp_Object elt = XCAR (tem);
396 skip = cclen - XSTRING_CHAR_LENGTH (elt);
397 if (skip < 0) continue;
399 if (0 > scmp (charptr_n_addr (d_name, skip),
401 XSTRING_CHAR_LENGTH (elt)))
403 ignored_extension_p = 1;
410 /* If an ignored-extensions match was found,
411 don't process this name as a completion. */
412 if (!passcount && ignored_extension_p)
415 if (!passcount && regexp_ignore_completion_p (d_name, Qnil, 0, cclen))
418 /* Update computation of how much all possible completions match */
421 if (all_flag || NILP (bestmatch))
423 Lisp_Object name = Qnil;
424 struct gcpro ngcpro1;
426 /* This is a possible completion */
427 name = make_string (d_name, len);
428 if (directoryp) /* Completion is a directory; end it with '/' */
429 name = Ffile_name_as_directory (name);
432 bestmatch = Fcons (name, bestmatch);
437 bestmatchsize = XSTRING_CHAR_LENGTH (name);
443 Charcount compare = min (bestmatchsize, cclen);
444 Bufbyte *p1 = XSTRING_DATA (bestmatch);
445 Bufbyte *p2 = d_name;
446 Charcount matchsize = scmp (p1, p2, compare);
450 if (completion_ignore_case)
452 /* If this is an exact match except for case,
453 use it as the best match rather than one that is not
454 an exact match. This way, we get the case pattern
455 of the actual match. */
456 if ((matchsize == cclen
457 && matchsize + !!directoryp
458 < XSTRING_CHAR_LENGTH (bestmatch))
460 /* If there is no exact match ignoring case,
461 prefer a match that does not change the case
463 (((matchsize == cclen)
465 (matchsize + !!directoryp
466 == XSTRING_CHAR_LENGTH (bestmatch)))
467 /* If there is more than one exact match aside from
468 case, and one of them is exact including case,
470 && 0 > scmp_1 (p2, XSTRING_DATA (file),
472 && 0 <= scmp_1 (p1, XSTRING_DATA (file),
473 file_name_length, 0)))
475 bestmatch = make_string (d_name, len);
477 bestmatch = Ffile_name_as_directory (bestmatch);
481 /* If this directory all matches,
482 see if implicit following slash does too. */
484 && compare == matchsize
485 && bestmatchsize > matchsize
486 && IS_ANY_SEP (charptr_emchar_n (p1, matchsize)))
488 bestmatchsize = matchsize;
492 free_opaque_ptr (XCAR (locative));
493 XCAR (locative) = Qnil;
496 unbind_to (speccount, Qnil);
500 if (all_flag || NILP (bestmatch))
502 if (matchcount == 1 && bestmatchsize == file_name_length)
504 return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
509 /* The *pwent() functions do not exist on NT. #### The NT equivalent
510 is NetUserEnum(), and rewriting to use it is not hard.*/
513 static Lisp_Object user_name_completion (Lisp_Object user,
517 DEFUN ("user-name-completion", Fuser_name_completion, 1, 1, 0, /*
518 Complete user name from PARTIAL-USERNAME.
519 Return the longest prefix common to all user names starting with
520 PARTIAL-USERNAME. If there is only one and PARTIAL-USERNAME matches
521 it exactly, returns t. Return nil if there is no user name starting
522 with PARTIAL-USERNAME.
526 return user_name_completion (partial_username, 0, NULL);
529 DEFUN ("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /*
530 Complete user name from PARTIAL-USERNAME.
532 This function is identical to `user-name-completion', except that
533 the cons of the completion and an indication of whether the
534 completion was unique is returned.
536 The car of the returned value is the longest prefix common to all user
537 names that start with PARTIAL-USERNAME. If there is only one and
538 PARTIAL-USERNAME matches it exactly, the car is t. The car is nil if
539 there is no user name starting with PARTIAL-USERNAME. The cdr of the
540 result is non-nil if and only if the completion returned in the car
546 Lisp_Object completed = user_name_completion (partial_username, 0, &uniq);
547 return Fcons (completed, uniq ? Qt : Qnil);
550 DEFUN ("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
551 Return a list of all user name completions from PARTIAL-USERNAME.
552 These are all the user names which begin with PARTIAL-USERNAME.
556 return user_name_completion (partial_username, 1, NULL);
567 struct user_name *user_names;
570 EMACS_TIME last_rebuild_time;
572 static struct user_cache user_cache;
575 free_user_cache (struct user_cache *cache)
578 for (i = 0; i < cache->length; i++)
579 xfree (cache->user_names[i].ptr);
580 xfree (cache->user_names);
585 user_name_completion_unwind (Lisp_Object cache_incomplete_p)
588 speed_up_interrupts ();
590 if (! NILP (XCAR (cache_incomplete_p)))
591 free_user_cache (&user_cache);
593 free_cons (XCONS (cache_incomplete_p));
598 #define USER_CACHE_TTL (24*60*60) /* Time to live: 1 day, in seconds */
601 user_name_completion (Lisp_Object user, int all_flag, int *uniq)
603 /* This function can GC */
605 Lisp_Object bestmatch = Qnil;
606 Charcount bestmatchsize = 0;
607 Charcount user_name_length;
610 struct gcpro gcpro1, gcpro2;
612 GCPRO2 (user, bestmatch);
616 user_name_length = XSTRING_CHAR_LENGTH (user);
618 /* Cache user name lookups because it tends to be quite slow.
619 * Rebuild the cache occasionally to catch changes */
621 if (user_cache.user_names &&
622 (EMACS_SECS (t) - EMACS_SECS (user_cache.last_rebuild_time)
624 free_user_cache (&user_cache);
626 if (!user_cache.user_names)
629 Lisp_Object cache_incomplete_p = noseeum_cons (Qt, Qnil);
630 int speccount = specpdl_depth ();
632 slow_down_interrupts ();
634 record_unwind_protect (user_name_completion_unwind, cache_incomplete_p);
635 while ((pwd = getpwent ()))
638 DO_REALLOC (user_cache.user_names, user_cache.size,
639 user_cache.length + 1, struct user_name);
640 TO_INTERNAL_FORMAT (C_STRING, pwd->pw_name,
642 (user_cache.user_names[user_cache.length].ptr,
643 user_cache.user_names[user_cache.length].len),
647 XCAR (cache_incomplete_p) = Qnil;
648 unbind_to (speccount, Qnil);
650 EMACS_GET_TIME (user_cache.last_rebuild_time);
653 for (i = 0; i < user_cache.length; i++)
655 Bufbyte *u_name = user_cache.user_names[i].ptr;
656 Bytecount len = user_cache.user_names[i].len;
657 /* scmp() works in chars, not bytes, so we have to compute this: */
658 Charcount cclen = bytecount_to_charcount (u_name, len);
662 if (cclen < user_name_length
663 || 0 <= scmp_1 (u_name, XSTRING_DATA (user), user_name_length, 0))
666 matchcount++; /* count matching completions */
668 if (all_flag || NILP (bestmatch))
670 Lisp_Object name = Qnil;
671 struct gcpro ngcpro1;
673 /* This is a possible completion */
674 name = make_string (u_name, len);
677 bestmatch = Fcons (name, bestmatch);
682 bestmatchsize = XSTRING_CHAR_LENGTH (name);
688 Charcount compare = min (bestmatchsize, cclen);
689 Bufbyte *p1 = XSTRING_DATA (bestmatch);
690 Bufbyte *p2 = u_name;
691 Charcount matchsize = scmp_1 (p1, p2, compare, 0);
696 bestmatchsize = matchsize;
703 *uniq = (matchcount == 1);
705 if (all_flag || NILP (bestmatch))
707 if (matchcount == 1 && bestmatchsize == user_name_length)
709 return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
711 #endif /* ! defined WIN32_NATIVE */
715 make_directory_hash_table (const char *path)
718 if ((d = opendir (path)))
722 make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
724 while ((dp = readdir (d)))
726 Bytecount len = NAMLEN (dp);
727 if (DIRENTRY_NONEMPTY (dp))
728 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
729 Fputhash (make_string ((Bufbyte *) dp->d_name, len), Qt, hash);
739 /* ... never used ... should use list2 directly anyway ... */
740 /* NOTE: This function can never return a negative value. */
742 wasteful_word_to_lisp (unsigned int item)
744 /* Compatibility: in other versions, file-attributes returns a LIST
745 of two 16 bit integers... */
746 Lisp_Object cons = word_to_lisp (item);
747 XCDR (cons) = Fcons (XCDR (cons), Qnil);
752 DEFUN ("file-attributes", Ffile_attributes, 1, 1, 0, /*
753 Return a list of attributes of file FILENAME.
754 Value is nil if specified file cannot be opened.
755 Otherwise, list elements are:
756 0. t for directory, string (name linked to) for symbolic link, or nil.
757 1. Number of links to file.
760 4. Last access time, as a list of two integers.
761 First integer has high-order 16 bits of time, second has low 16 bits.
762 5. Last modification time, likewise.
763 6. Last status change time, likewise.
764 7. Size in bytes. (-1, if number is out of range).
765 8. File modes, as a string of ten letters or dashes as in ls -l.
766 9. t iff file's gid would change if file were deleted and recreated.
770 If file does not exist, returns nil.
774 /* This function can GC. GC checked 1997.06.04. */
775 Lisp_Object values[12];
776 Lisp_Object directory = Qnil;
780 struct gcpro gcpro1, gcpro2;
782 GCPRO2 (filename, directory);
783 filename = Fexpand_file_name (filename, Qnil);
785 /* If the file name has special constructs in it,
786 call the corresponding file handler. */
787 handler = Ffind_file_name_handler (filename, Qfile_attributes);
791 return call2 (handler, Qfile_attributes, filename);
794 if (lstat ((char *) XSTRING_DATA (filename), &s) < 0)
801 directory = Ffile_name_directory (filename);
804 #if 0 /* #### shouldn't this apply to WIN32_NATIVE and maybe CYGWIN? */
806 char *tmpnam = (char *) XSTRING_DATA (Ffile_name_nondirectory (filename));
807 int l = strlen (tmpnam);
810 && S_ISREG (s.st_mode)
811 && (stricmp (&tmpnam[l - 4], ".com") == 0 ||
812 stricmp (&tmpnam[l - 4], ".exe") == 0 ||
813 stricmp (&tmpnam[l - 4], ".bat") == 0))
815 s.st_mode |= S_IEXEC;
820 switch (s.st_mode & S_IFMT)
830 values[0] = Ffile_symlink_p (filename);
834 values[1] = make_int (s.st_nlink);
835 values[2] = make_int (s.st_uid);
836 values[3] = make_int (s.st_gid);
837 values[4] = make_time (s.st_atime);
838 values[5] = make_time (s.st_mtime);
839 values[6] = make_time (s.st_ctime);
840 values[7] = make_int ((EMACS_INT) s.st_size);
841 /* If the size is out of range, give back -1. */
842 /* #### Fix when Emacs gets bignums! */
843 if (XINT (values[7]) != s.st_size)
844 values[7] = make_int (-1);
845 filemodestring (&s, modes);
846 values[8] = make_string ((Bufbyte *) modes, 10);
847 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
851 if (!NILP (directory) && xemacs_stat ((char *) XSTRING_DATA (directory), &sdir) == 0)
852 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
853 else /* if we can't tell, assume worst */
856 #else /* file gid will be egid */
857 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
858 #endif /* BSD4_2 or BSD4_3 */
859 values[10] = make_int (s.st_ino);
860 values[11] = make_int (s.st_dev);
862 return Flist (countof (values), values);
866 /************************************************************************/
868 /************************************************************************/
873 defsymbol (&Qdirectory_files, "directory-files");
874 defsymbol (&Qfile_name_completion, "file-name-completion");
875 defsymbol (&Qfile_name_all_completions, "file-name-all-completions");
876 defsymbol (&Qfile_attributes, "file-attributes");
878 DEFSUBR (Fdirectory_files);
879 DEFSUBR (Ffile_name_completion);
880 DEFSUBR (Ffile_name_all_completions);
882 DEFSUBR (Fuser_name_completion);
883 DEFSUBR (Fuser_name_completion_1);
884 DEFSUBR (Fuser_name_all_completions);
886 DEFSUBR (Ffile_attributes);
892 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions /*
893 *Completion ignores filenames ending in any string in this list.
894 This variable does not affect lists of possible completions,
895 but does affect the commands that actually do completions.
896 It is used by the function `file-name-completion'.
898 Vcompletion_ignored_extensions = Qnil;