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 /* #### In Matt's code, this was Qt. Why? */
128 regex_match_object = Qnil;
129 regex_emacs_buffer = current_buffer;
131 record_unwind_protect (close_directory_unwind, make_opaque_ptr ((void *)d));
133 /* Loop reading blocks */
136 DIRENTRY *dp = readdir (d);
142 if (DIRENTRY_NONEMPTY (dp)
144 || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0))))
146 if (!NILP (files_only))
151 memcpy (statbuf_tail, dp->d_name, len);
152 statbuf_tail[len] = 0;
154 if (xemacs_stat (statbuf, &st) == 0
155 && (st.st_mode & S_IFMT) == S_IFDIR)
158 if (EQ (files_only, Qt) && dir_p)
160 else if (!EQ (files_only, Qt) && !dir_p)
166 make_string ((Bufbyte *)dp->d_name, len);
168 name = concat2 (directory, name);
170 list = Fcons (name, list);
174 unbind_to (speccount, Qnil); /* This will close the dir */
177 list = Fsort (Fnreverse (list), Qstring_lessp);
179 RETURN_UNGCPRO (list);
182 static Lisp_Object file_name_completion (Lisp_Object file,
183 Lisp_Object directory,
184 int all_flag, int ver_flag);
186 DEFUN ("file-name-completion", Ffile_name_completion, 2, 2, 0, /*
187 Complete file name PARTIAL-FILENAME in directory DIRECTORY.
188 Return the longest prefix common to all file names in DIRECTORY
189 that start with PARTIAL-FILENAME.
190 If there is only one and PARTIAL-FILENAME matches it exactly, return t.
191 Return nil if DIRECTORY contains no name starting with PARTIAL-FILENAME.
193 File names which end with any member of `completion-ignored-extensions'
194 are not considered as possible completions for PARTIAL-FILENAME unless
195 there is no other possible completion. `completion-ignored-extensions'
196 is not applied to the names of directories.
198 (partial_filename, directory))
200 /* This function can GC. GC checked 1996.04.06. */
203 /* If the directory name has special constructs in it,
204 call the corresponding file handler. */
205 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
207 return call3 (handler, Qfile_name_completion, partial_filename, directory);
209 /* If the file name has special constructs in it,
210 call the corresponding file handler. */
211 handler = Ffind_file_name_handler (partial_filename, Qfile_name_completion);
213 return call3 (handler, Qfile_name_completion, partial_filename, directory);
215 return file_name_completion (partial_filename, directory, 0, 0);
218 DEFUN ("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
219 Return a list of all completions of PARTIAL-FILENAME in DIRECTORY.
220 These are all file names in DIRECTORY which begin with PARTIAL-FILENAME.
222 (partial_filename, directory))
224 /* This function can GC. GC checked 1997.06.04. */
229 directory = Fexpand_file_name (directory, Qnil);
230 /* If the file name has special constructs in it,
231 call the corresponding file handler. */
232 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
235 return call3 (handler, Qfile_name_all_completions, partial_filename,
238 return file_name_completion (partial_filename, directory, 1, 0);
242 file_name_completion_stat (Lisp_Object directory, DIRENTRY *dp,
243 struct stat *st_addr)
245 Bytecount len = NAMLEN (dp);
246 Bytecount pos = XSTRING_LENGTH (directory);
248 char *fullname = (char *) alloca (len + pos + 2);
250 memcpy (fullname, XSTRING_DATA (directory), pos);
251 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
252 fullname[pos++] = DIRECTORY_SEP;
254 memcpy (fullname + pos, dp->d_name, len);
255 fullname[pos + len] = 0;
258 /* We want to return success if a link points to a nonexistent file,
259 but we want to return the status for what the link points to,
260 in case it is a directory. */
261 value = lstat (fullname, st_addr);
262 if (S_ISLNK (st_addr->st_mode))
263 xemacs_stat (fullname, st_addr);
265 value = xemacs_stat (fullname, st_addr);
271 file_name_completion_unwind (Lisp_Object locative)
274 Lisp_Object obj = XCAR (locative);
278 d = (DIR *)get_opaque_ptr (obj);
280 free_opaque_ptr (obj);
282 free_cons (XCONS (locative));
287 file_name_completion (Lisp_Object file, Lisp_Object directory, int all_flag,
290 /* This function can GC */
293 Lisp_Object bestmatch = Qnil;
294 Charcount bestmatchsize = 0;
297 int speccount = specpdl_depth ();
298 Charcount file_name_length;
299 Lisp_Object locative;
300 struct gcpro gcpro1, gcpro2, gcpro3;
302 GCPRO3 (file, directory, bestmatch);
307 /* Filename completion on Windows ignores case, since Windows
309 specbind (Qcompletion_ignore_case, Qt);
310 #endif /* WIN32_NATIVE */
312 #ifdef FILE_SYSTEM_CASE
313 file = FILE_SYSTEM_CASE (file);
315 directory = Fexpand_file_name (directory, Qnil);
316 file_name_length = XSTRING_CHAR_LENGTH (file);
318 /* With passcount = 0, ignore files that end in an ignored extension.
319 If nothing found then try again with passcount = 1, don't ignore them.
320 If looking for all completions, start with passcount = 1,
321 so always take even the ignored ones.
323 ** It would not actually be helpful to the user to ignore any possible
324 completions when making a list of them.** */
326 /* We cannot use close_directory_unwind() because we change the
327 directory. The old code used to just avoid signaling errors, and
328 call closedir, but it was wrong, because it made sane handling of
329 QUIT impossible and, besides, various utility functions like
330 regexp_ignore_completion_p can signal errors. */
331 locative = noseeum_cons (Qnil, Qnil);
332 record_unwind_protect (file_name_completion_unwind, locative);
334 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
336 d = opendir ((char *) XSTRING_DATA (Fdirectory_file_name (directory)));
338 report_file_error ("Opening directory", list1 (directory));
339 XCAR (locative) = make_opaque_ptr ((void *)d);
341 /* Loop reading blocks */
346 /* scmp() works in characters, not bytes, so we have to compute
350 int ignored_extension_p = 0;
356 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
357 d_name = (Bufbyte *) dp->d_name;
359 cclen = bytecount_to_charcount (d_name, len);
363 if (! DIRENTRY_NONEMPTY (dp)
364 || cclen < file_name_length
365 || 0 <= scmp (d_name, XSTRING_DATA (file), file_name_length))
368 if (file_name_completion_stat (directory, dp, &st) < 0)
371 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
374 #ifndef TRIVIAL_DIRECTORY_ENTRY
375 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
377 /* "." and ".." are never interesting as completions, but are
378 actually in the way in a directory containing only one file. */
379 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
384 /* Compare extensions-to-be-ignored against end of this file name */
385 /* if name is not an exact match against specified string. */
386 if (!passcount && cclen > file_name_length)
389 /* and exit this for loop if a match is found */
390 EXTERNAL_LIST_LOOP (tem, Vcompletion_ignored_extensions)
392 Lisp_Object elt = XCAR (tem);
397 skip = cclen - XSTRING_CHAR_LENGTH (elt);
398 if (skip < 0) continue;
400 if (0 > scmp (charptr_n_addr (d_name, skip),
402 XSTRING_CHAR_LENGTH (elt)))
404 ignored_extension_p = 1;
411 /* If an ignored-extensions match was found,
412 don't process this name as a completion. */
413 if (!passcount && ignored_extension_p)
416 if (!passcount && regexp_ignore_completion_p (d_name, Qnil, 0, cclen))
419 /* Update computation of how much all possible completions match */
422 if (all_flag || NILP (bestmatch))
424 Lisp_Object name = Qnil;
425 struct gcpro ngcpro1;
427 /* This is a possible completion */
428 name = make_string (d_name, len);
429 if (directoryp) /* Completion is a directory; end it with '/' */
430 name = Ffile_name_as_directory (name);
433 bestmatch = Fcons (name, bestmatch);
438 bestmatchsize = XSTRING_CHAR_LENGTH (name);
444 Charcount compare = min (bestmatchsize, cclen);
445 Bufbyte *p1 = XSTRING_DATA (bestmatch);
446 Bufbyte *p2 = d_name;
447 Charcount matchsize = scmp (p1, p2, compare);
451 if (completion_ignore_case)
453 /* If this is an exact match except for case,
454 use it as the best match rather than one that is not
455 an exact match. This way, we get the case pattern
456 of the actual match. */
457 if ((matchsize == cclen
458 && matchsize + !!directoryp
459 < XSTRING_CHAR_LENGTH (bestmatch))
461 /* If there is no exact match ignoring case,
462 prefer a match that does not change the case
464 (((matchsize == cclen)
466 (matchsize + !!directoryp
467 == XSTRING_CHAR_LENGTH (bestmatch)))
468 /* If there is more than one exact match aside from
469 case, and one of them is exact including case,
471 && 0 > scmp_1 (p2, XSTRING_DATA (file),
473 && 0 <= scmp_1 (p1, XSTRING_DATA (file),
474 file_name_length, 0)))
476 bestmatch = make_string (d_name, len);
478 bestmatch = Ffile_name_as_directory (bestmatch);
482 /* If this directory all matches,
483 see if implicit following slash does too. */
485 && compare == matchsize
486 && bestmatchsize > matchsize
487 && IS_ANY_SEP (charptr_emchar_n (p1, matchsize)))
489 bestmatchsize = matchsize;
493 free_opaque_ptr (XCAR (locative));
494 XCAR (locative) = Qnil;
497 unbind_to (speccount, Qnil);
501 if (all_flag || NILP (bestmatch))
503 if (matchcount == 1 && bestmatchsize == file_name_length)
505 return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
510 /* The *pwent() functions do not exist on NT. #### The NT equivalent
511 is NetUserEnum(), and rewriting to use it is not hard.*/
514 static Lisp_Object user_name_completion (Lisp_Object user,
518 DEFUN ("user-name-completion", Fuser_name_completion, 1, 1, 0, /*
519 Complete user name from PARTIAL-USERNAME.
520 Return the longest prefix common to all user names starting with
521 PARTIAL-USERNAME. If there is only one and PARTIAL-USERNAME matches
522 it exactly, returns t. Return nil if there is no user name starting
523 with PARTIAL-USERNAME.
527 return user_name_completion (partial_username, 0, NULL);
530 DEFUN ("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /*
531 Complete user name from PARTIAL-USERNAME.
533 This function is identical to `user-name-completion', except that
534 the cons of the completion and an indication of whether the
535 completion was unique is returned.
537 The car of the returned value is the longest prefix common to all user
538 names that start with PARTIAL-USERNAME. If there is only one and
539 PARTIAL-USERNAME matches it exactly, the car is t. The car is nil if
540 there is no user name starting with PARTIAL-USERNAME. The cdr of the
541 result is non-nil if and only if the completion returned in the car
547 Lisp_Object completed = user_name_completion (partial_username, 0, &uniq);
548 return Fcons (completed, uniq ? Qt : Qnil);
551 DEFUN ("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
552 Return a list of all user name completions from PARTIAL-USERNAME.
553 These are all the user names which begin with PARTIAL-USERNAME.
557 return user_name_completion (partial_username, 1, NULL);
568 struct user_name *user_names;
571 EMACS_TIME last_rebuild_time;
573 static struct user_cache user_cache;
576 free_user_cache (struct user_cache *cache)
579 for (i = 0; i < cache->length; i++)
580 xfree (cache->user_names[i].ptr);
581 xfree (cache->user_names);
586 user_name_completion_unwind (Lisp_Object cache_incomplete_p)
589 speed_up_interrupts ();
591 if (! NILP (XCAR (cache_incomplete_p)))
592 free_user_cache (&user_cache);
594 free_cons (XCONS (cache_incomplete_p));
599 #define USER_CACHE_TTL (24*60*60) /* Time to live: 1 day, in seconds */
602 user_name_completion (Lisp_Object user, int all_flag, int *uniq)
604 /* This function can GC */
606 Lisp_Object bestmatch = Qnil;
607 Charcount bestmatchsize = 0;
608 Charcount user_name_length;
611 struct gcpro gcpro1, gcpro2;
613 GCPRO2 (user, bestmatch);
617 user_name_length = XSTRING_CHAR_LENGTH (user);
619 /* Cache user name lookups because it tends to be quite slow.
620 * Rebuild the cache occasionally to catch changes */
622 if (user_cache.user_names &&
623 (EMACS_SECS (t) - EMACS_SECS (user_cache.last_rebuild_time)
625 free_user_cache (&user_cache);
627 if (!user_cache.user_names)
630 Lisp_Object cache_incomplete_p = noseeum_cons (Qt, Qnil);
631 int speccount = specpdl_depth ();
633 slow_down_interrupts ();
635 record_unwind_protect (user_name_completion_unwind, cache_incomplete_p);
636 while ((pwd = getpwent ()))
639 DO_REALLOC (user_cache.user_names, user_cache.size,
640 user_cache.length + 1, struct user_name);
641 TO_INTERNAL_FORMAT (C_STRING, pwd->pw_name,
643 (user_cache.user_names[user_cache.length].ptr,
644 user_cache.user_names[user_cache.length].len),
648 XCAR (cache_incomplete_p) = Qnil;
649 unbind_to (speccount, Qnil);
651 EMACS_GET_TIME (user_cache.last_rebuild_time);
654 for (i = 0; i < user_cache.length; i++)
656 Bufbyte *u_name = user_cache.user_names[i].ptr;
657 Bytecount len = user_cache.user_names[i].len;
658 /* scmp() works in chars, not bytes, so we have to compute this: */
659 Charcount cclen = bytecount_to_charcount (u_name, len);
663 if (cclen < user_name_length
664 || 0 <= scmp_1 (u_name, XSTRING_DATA (user), user_name_length, 0))
667 matchcount++; /* count matching completions */
669 if (all_flag || NILP (bestmatch))
671 Lisp_Object name = Qnil;
672 struct gcpro ngcpro1;
674 /* This is a possible completion */
675 name = make_string (u_name, len);
678 bestmatch = Fcons (name, bestmatch);
683 bestmatchsize = XSTRING_CHAR_LENGTH (name);
689 Charcount compare = min (bestmatchsize, cclen);
690 Bufbyte *p1 = XSTRING_DATA (bestmatch);
691 Bufbyte *p2 = u_name;
692 Charcount matchsize = scmp_1 (p1, p2, compare, 0);
697 bestmatchsize = matchsize;
704 *uniq = (matchcount == 1);
706 if (all_flag || NILP (bestmatch))
708 if (matchcount == 1 && bestmatchsize == user_name_length)
710 return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
712 #endif /* ! defined WIN32_NATIVE */
716 make_directory_hash_table (const char *path)
719 if ((d = opendir (path)))
723 make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
725 while ((dp = readdir (d)))
727 Bytecount len = NAMLEN (dp);
728 if (DIRENTRY_NONEMPTY (dp))
729 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
730 Fputhash (make_string ((Bufbyte *) dp->d_name, len), Qt, hash);
740 /* ... never used ... should use list2 directly anyway ... */
741 /* NOTE: This function can never return a negative value. */
743 wasteful_word_to_lisp (unsigned int item)
745 /* Compatibility: in other versions, file-attributes returns a LIST
746 of two 16 bit integers... */
747 Lisp_Object cons = word_to_lisp (item);
748 XCDR (cons) = Fcons (XCDR (cons), Qnil);
753 DEFUN ("file-attributes", Ffile_attributes, 1, 1, 0, /*
754 Return a list of attributes of file FILENAME.
755 Value is nil if specified file cannot be opened.
756 Otherwise, list elements are:
757 0. t for directory, string (name linked to) for symbolic link, or nil.
758 1. Number of links to file.
761 4. Last access time, as a list of two integers.
762 First integer has high-order 16 bits of time, second has low 16 bits.
763 5. Last modification time, likewise.
764 6. Last status change time, likewise.
765 7. Size in bytes. (-1, if number is out of range).
766 8. File modes, as a string of ten letters or dashes as in ls -l.
767 9. t iff file's gid would change if file were deleted and recreated.
771 If file does not exist, returns nil.
775 /* This function can GC. GC checked 1997.06.04. */
776 Lisp_Object values[12];
777 Lisp_Object directory = Qnil;
781 struct gcpro gcpro1, gcpro2;
783 GCPRO2 (filename, directory);
784 filename = Fexpand_file_name (filename, Qnil);
786 /* If the file name has special constructs in it,
787 call the corresponding file handler. */
788 handler = Ffind_file_name_handler (filename, Qfile_attributes);
792 return call2 (handler, Qfile_attributes, filename);
795 if (lstat ((char *) XSTRING_DATA (filename), &s) < 0)
802 directory = Ffile_name_directory (filename);
805 #if 0 /* #### shouldn't this apply to WIN32_NATIVE and maybe CYGWIN? */
807 char *tmpnam = (char *) XSTRING_DATA (Ffile_name_nondirectory (filename));
808 int l = strlen (tmpnam);
811 && S_ISREG (s.st_mode)
812 && (stricmp (&tmpnam[l - 4], ".com") == 0 ||
813 stricmp (&tmpnam[l - 4], ".exe") == 0 ||
814 stricmp (&tmpnam[l - 4], ".bat") == 0))
816 s.st_mode |= S_IEXEC;
821 switch (s.st_mode & S_IFMT)
831 values[0] = Ffile_symlink_p (filename);
835 values[1] = make_int (s.st_nlink);
836 values[2] = make_int (s.st_uid);
837 values[3] = make_int (s.st_gid);
838 values[4] = make_time (s.st_atime);
839 values[5] = make_time (s.st_mtime);
840 values[6] = make_time (s.st_ctime);
841 values[7] = make_int ((EMACS_INT) s.st_size);
842 /* If the size is out of range, give back -1. */
843 /* #### Fix when Emacs gets bignums! */
844 if (XINT (values[7]) != s.st_size)
845 values[7] = make_int (-1);
846 filemodestring (&s, modes);
847 values[8] = make_string ((Bufbyte *) modes, 10);
848 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
852 if (!NILP (directory) && xemacs_stat ((char *) XSTRING_DATA (directory), &sdir) == 0)
853 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
854 else /* if we can't tell, assume worst */
857 #else /* file gid will be egid */
858 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
859 #endif /* BSD4_2 or BSD4_3 */
860 values[10] = make_int (s.st_ino);
861 values[11] = make_int (s.st_dev);
863 return Flist (countof (values), values);
867 /************************************************************************/
869 /************************************************************************/
874 defsymbol (&Qdirectory_files, "directory-files");
875 defsymbol (&Qfile_name_completion, "file-name-completion");
876 defsymbol (&Qfile_name_all_completions, "file-name-all-completions");
877 defsymbol (&Qfile_attributes, "file-attributes");
879 DEFSUBR (Fdirectory_files);
880 DEFSUBR (Ffile_name_completion);
881 DEFSUBR (Ffile_name_all_completions);
883 DEFSUBR (Fuser_name_completion);
884 DEFSUBR (Fuser_name_completion_1);
885 DEFSUBR (Fuser_name_all_completions);
887 DEFSUBR (Ffile_attributes);
893 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions /*
894 *Completion ignores filenames ending in any string in this list.
895 This variable does not affect lists of possible completions,
896 but does affect the commands that actually do completions.
897 It is used by the function `file-name-completion'.
899 Vcompletion_ignored_extensions = Qnil;