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. */
34 Lisp_Object Vcompletion_ignored_extensions;
35 Lisp_Object Qdirectory_files;
36 Lisp_Object Qfile_name_completion;
37 Lisp_Object Qfile_name_all_completions;
38 Lisp_Object Qfile_attributes;
41 close_directory_unwind (Lisp_Object unwind_obj)
43 DIR *d = (DIR *)get_opaque_ptr (unwind_obj);
45 free_opaque_ptr (unwind_obj);
49 DEFUN ("directory-files", Fdirectory_files, 1, 5, 0, /*
50 Return a list of names of files in DIRECTORY.
51 There are four optional arguments:
52 If FULL is non-nil, absolute pathnames of the files are returned.
53 If MATCH is non-nil, only pathnames containing that regexp are returned.
54 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
55 NOSORT is useful if you plan to sort the result yourself.
56 If FILES-ONLY is the symbol t, then only the "files" in the directory
57 will be returned; subdirectories will be excluded. If FILES-ONLY is not
58 nil and not t, then only the subdirectories will be returned. Otherwise,
59 if FILES-ONLY is nil (the default) then both files and subdirectories will
62 (dirname, full, match, nosort, files_only))
64 /* This function can GC */
66 Lisp_Object list = Qnil;
69 struct re_pattern_buffer *bufp = NULL;
70 int speccount = specpdl_depth ();
71 char *statbuf, *statbuf_tail;
73 struct gcpro gcpro1, gcpro2;
74 GCPRO2 (dirname, list);
76 /* If the file name has special constructs in it,
77 call the corresponding file handler. */
78 handler = Ffind_file_name_handler (dirname, Qdirectory_files);
82 if (!NILP (files_only))
83 return call6 (handler, Qdirectory_files, dirname, full, match, nosort,
86 return call5 (handler, Qdirectory_files, dirname, full, match,
90 /* #### why do we do Fexpand_file_name after file handlers here,
91 but earlier everywhere else? */
92 dirname = Fexpand_file_name (dirname, Qnil);
93 dirname = Ffile_name_as_directory (dirname);
94 dirnamelen = XSTRING_LENGTH (dirname);
96 statbuf = (char *)alloca (dirnamelen + MAXNAMLEN + 1);
97 memcpy (statbuf, XSTRING_DATA (dirname), dirnamelen);
98 statbuf_tail = statbuf + dirnamelen;
100 /* XEmacs: this should come after Ffile_name_as_directory() to avoid
101 potential regexp cache smashage. It comes before the opendir()
102 because it might signal an error. */
105 CHECK_STRING (match);
107 /* MATCH might be a flawed regular expression. Rather than
108 catching and signalling our own errors, we just call
109 compile_pattern to do the work for us. */
110 bufp = compile_pattern (match, 0, 0, 0, ERROR_ME);
113 /* Now *bufp is the compiled form of MATCH; don't call anything
114 which might compile a new regexp until we're done with the loop! */
116 /* Do this opendir after anything which might signal an error.
117 NOTE: the above comment is old; previosly, there was no
118 unwind-protection in case of error, but now there is. */
119 d = opendir ((char *) XSTRING_DATA (dirname));
121 report_file_error ("Opening directory", list1 (dirname));
123 record_unwind_protect (close_directory_unwind, make_opaque_ptr ((void *)d));
125 /* Loop reading blocks */
128 DIRENTRY *dp = readdir (d);
135 if (DIRENTRY_NONEMPTY (dp)
137 || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0))))
139 if (!NILP (files_only))
143 char *cur_statbuf = statbuf;
144 char *cur_statbuf_tail = statbuf_tail;
146 /* #### I don't think the code under `if' is necessary
147 anymore. The crashes in this function were reported
148 because MAXNAMLEN was used to remember the *whole*
149 statbuf, instead of using MAXPATHLEN. This should be
150 tested after 21.0 is released. */
152 /* We normally use the buffer created by alloca.
153 However, if the file name we get too big, we'll use a
154 malloced buffer, and free it. It is undefined how
155 stat() will react to this, but we avoid a buffer
159 cur_statbuf = (char *)xmalloc (dirnamelen + len + 1);
160 memcpy (cur_statbuf, statbuf, dirnamelen);
161 cur_statbuf_tail = cur_statbuf + dirnamelen;
163 memcpy (cur_statbuf_tail, dp->d_name, len);
164 cur_statbuf_tail[len] = 0;
166 if (stat (cur_statbuf, &st) < 0)
169 dir_p = ((st.st_mode & S_IFMT) == S_IFDIR);
171 if (cur_statbuf != statbuf)
174 if (EQ (files_only, Qt) && dir_p)
176 else if (!EQ (files_only, Qt) && !dir_p)
181 name = concat2 (dirname, make_ext_string ((Bufbyte *)dp->d_name,
182 len, FORMAT_FILENAME));
184 name = make_ext_string ((Bufbyte *)dp->d_name,
185 len, FORMAT_FILENAME);
187 list = Fcons (name, list);
190 unbind_to (speccount, Qnil); /* This will close the dir */
193 RETURN_UNGCPRO (list);
195 RETURN_UNGCPRO (Fsort (Fnreverse (list), Qstring_lessp));
198 static Lisp_Object file_name_completion (Lisp_Object file,
200 int all_flag, int ver_flag);
202 DEFUN ("file-name-completion", Ffile_name_completion, 2, 2, 0, /*
203 Complete file name FILE in directory DIR.
204 Returns the longest string common to all filenames in DIR
205 that start with FILE.
206 If there is only one and FILE matches it exactly, returns t.
207 Returns nil if DIR contains no name starting with FILE.
209 Filenames which end with any member of `completion-ignored-extensions'
210 are not considered as possible completions for FILE unless there is no
211 other possible completion. `completion-ignored-extensions' is not applied
212 to the names of directories.
216 /* This function can GC. GC checked 1996.04.06. */
219 /* If the directory name has special constructs in it,
220 call the corresponding file handler. */
221 handler = Ffind_file_name_handler (dirname, Qfile_name_completion);
223 return call3 (handler, Qfile_name_completion, file, dirname);
225 /* If the file name has special constructs in it,
226 call the corresponding file handler. */
227 handler = Ffind_file_name_handler (file, Qfile_name_completion);
229 return call3 (handler, Qfile_name_completion, file, dirname);
231 return file_name_completion (file, dirname, 0, 0);
234 DEFUN ("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
235 Return a list of all completions of file name FILE in directory DIR.
236 These are all file names in directory DIR which begin with FILE.
238 Filenames which end with any member of `completion-ignored-extensions'
239 are not considered as possible completions for FILE unless there is no
240 other possible completion. `completion-ignored-extensions' is not applied
241 to the names of directories.
245 /* This function can GC. GC checked 1997.06.04. */
250 dirname = Fexpand_file_name (dirname, Qnil);
251 /* If the file name has special constructs in it,
252 call the corresponding file handler. */
253 handler = Ffind_file_name_handler (dirname, Qfile_name_all_completions);
256 return call3 (handler, Qfile_name_all_completions, file,
259 return file_name_completion (file, dirname, 1, 0);
263 file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp,
264 struct stat *st_addr)
266 Bytecount len = NAMLEN (dp);
267 Bytecount pos = XSTRING_LENGTH (dirname);
269 char *fullname = (char *) alloca (len + pos + 2);
271 memcpy (fullname, XSTRING_DATA (dirname), pos);
272 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
273 fullname[pos++] = DIRECTORY_SEP;
275 memcpy (fullname + pos, dp->d_name, len);
276 fullname[pos + len] = 0;
279 /* We want to return success if a link points to a nonexistent file,
280 but we want to return the status for what the link points to,
281 in case it is a directory. */
282 value = lstat (fullname, st_addr);
283 if (S_ISLNK (st_addr->st_mode))
284 stat (fullname, st_addr);
286 value = stat (fullname, st_addr);
292 file_name_completion_unwind (Lisp_Object locative)
295 Lisp_Object obj = XCAR (locative);
299 d = (DIR *)get_opaque_ptr (obj);
301 free_opaque_ptr (obj);
302 free_cons (XCONS (locative));
307 file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag,
310 /* This function can GC */
313 Lisp_Object bestmatch = Qnil;
314 Charcount bestmatchsize = 0;
317 int speccount = specpdl_depth ();
318 Charcount file_name_length;
319 Lisp_Object locative;
320 struct gcpro gcpro1, gcpro2, gcpro3;
322 GCPRO3 (file, dirname, bestmatch);
327 /* Filename completion on Windows ignores case, since Windows
329 specbind (Qcompletion_ignore_case, Qt);
330 #endif /* WINDOWSNT */
332 #ifdef FILE_SYSTEM_CASE
333 file = FILE_SYSTEM_CASE (file);
335 dirname = Fexpand_file_name (dirname, Qnil);
336 file_name_length = XSTRING_CHAR_LENGTH (file);
338 /* With passcount = 0, ignore files that end in an ignored extension.
339 If nothing found then try again with passcount = 1, don't ignore them.
340 If looking for all completions, start with passcount = 1,
341 so always take even the ignored ones.
343 ** It would not actually be helpful to the user to ignore any possible
344 completions when making a list of them.** */
346 /* We cannot use close_directory_unwind() because we change the
347 directory. The old code used to just avoid signaling errors, and
348 call closedir, but it was wrong, because it made sane handling of
349 QUIT impossible and, besides, various utility functions like
350 regexp_ignore_completion_p can signal errors. */
351 locative = noseeum_cons (Qnil, Qnil);
352 record_unwind_protect (file_name_completion_unwind, locative);
354 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
356 d = opendir ((char *) XSTRING_DATA (Fdirectory_file_name (dirname)));
358 report_file_error ("Opening directory", list1 (dirname));
359 XCAR (locative) = make_opaque_ptr ((void *)d);
361 /* Loop reading blocks */
366 /* scmp() works in characters, not bytes, so we have to compute
370 int ignored_extension_p = 0;
376 /* #### This is a bad idea, because d_name can contain
377 control characters, which can make XEmacs crash. This
378 should be handled properly with FORMAT_FILENAME. */
379 d_name = (Bufbyte *) dp->d_name;
381 cclen = bytecount_to_charcount (d_name, len);
385 if (! DIRENTRY_NONEMPTY (dp)
386 || cclen < file_name_length
387 || 0 <= scmp (d_name, XSTRING_DATA (file), file_name_length))
390 if (file_name_completion_stat (dirname, dp, &st) < 0)
393 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
396 #ifndef TRIVIAL_DIRECTORY_ENTRY
397 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
399 /* "." and ".." are never interesting as completions, but are
400 actually in the way in a directory containing only one file. */
401 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
406 /* Compare extensions-to-be-ignored against end of this file name */
407 /* if name is not an exact match against specified string. */
408 if (!passcount && cclen > file_name_length)
411 /* and exit this for loop if a match is found */
412 EXTERNAL_LIST_LOOP (tem, Vcompletion_ignored_extensions)
414 Lisp_Object elt = XCAR (tem);
419 skip = cclen - XSTRING_CHAR_LENGTH (elt);
420 if (skip < 0) continue;
422 if (0 > scmp (charptr_n_addr (d_name, skip),
424 XSTRING_CHAR_LENGTH (elt)))
426 ignored_extension_p = 1;
433 /* If an ignored-extensions match was found,
434 don't process this name as a completion. */
435 if (!passcount && ignored_extension_p)
438 if (!passcount && regexp_ignore_completion_p (d_name, Qnil, 0, cclen))
441 /* Update computation of how much all possible completions match */
444 if (all_flag || NILP (bestmatch))
446 Lisp_Object name = Qnil;
447 struct gcpro ngcpro1;
449 /* This is a possible completion */
450 name = make_string (d_name, len);
451 if (directoryp) /* Completion is a directory; end it with '/' */
452 name = Ffile_name_as_directory (name);
455 bestmatch = Fcons (name, bestmatch);
460 bestmatchsize = XSTRING_CHAR_LENGTH (name);
466 Charcount compare = min (bestmatchsize, cclen);
467 Bufbyte *p1 = XSTRING_DATA (bestmatch);
468 Bufbyte *p2 = d_name;
469 Charcount matchsize = scmp (p1, p2, compare);
473 if (completion_ignore_case)
475 /* If this is an exact match except for case,
476 use it as the best match rather than one that is not
477 an exact match. This way, we get the case pattern
478 of the actual match. */
479 if ((matchsize == cclen
480 && matchsize + !!directoryp
481 < XSTRING_CHAR_LENGTH (bestmatch))
483 /* If there is no exact match ignoring case,
484 prefer a match that does not change the case
486 (((matchsize == cclen)
488 (matchsize + !!directoryp
489 == XSTRING_CHAR_LENGTH (bestmatch)))
490 /* If there is more than one exact match aside from
491 case, and one of them is exact including case,
493 && 0 > scmp_1 (p2, XSTRING_DATA (file),
495 && 0 <= scmp_1 (p1, XSTRING_DATA (file),
496 file_name_length, 0)))
498 bestmatch = make_string (d_name, len);
500 bestmatch = Ffile_name_as_directory (bestmatch);
504 /* If this dirname all matches,
505 see if implicit following slash does too. */
507 && compare == matchsize
508 && bestmatchsize > matchsize
509 && IS_ANY_SEP (charptr_emchar_n (p1, matchsize)))
511 bestmatchsize = matchsize;
515 free_opaque_ptr (XCAR (locative));
516 XCAR (locative) = Qnil;
519 unbind_to (speccount, Qnil);
523 if (all_flag || NILP (bestmatch))
525 if (matchcount == 1 && bestmatchsize == file_name_length)
527 return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
532 make_directory_hash_table (CONST char *path)
535 Lisp_Object hash = make_lisp_hashtable (100, HASHTABLE_NONWEAK,
537 if ((d = opendir (path)))
541 while ((dp = readdir (d)))
543 Bytecount len = NAMLEN (dp);
544 if (DIRENTRY_NONEMPTY (dp))
545 Fputhash (make_ext_string ((Bufbyte *) dp->d_name, len,
546 FORMAT_FILENAME), Qt, hash);
554 wasteful_word_to_lisp (unsigned int item)
556 /* Compatibility: in other versions, file-attributes returns a LIST
557 of two 16 bit integers... */
558 Lisp_Object cons = word_to_lisp (item);
559 XCDR (cons) = Fcons (XCDR (cons), Qnil);
563 DEFUN ("file-attributes", Ffile_attributes, 1, 1, 0, /*
564 Return a list of attributes of file FILENAME.
565 Value is nil if specified file cannot be opened.
566 Otherwise, list elements are:
567 0. t for directory, string (name linked to) for symbolic link, or nil.
568 1. Number of links to file.
571 4. Last access time, as a list of two integers.
572 First integer has high-order 16 bits of time, second has low 16 bits.
573 5. Last modification time, likewise.
574 6. Last status change time, likewise.
575 7. Size in bytes. (-1, if number is out of range).
576 8. File modes, as a string of ten letters or dashes as in ls -l.
577 9. t iff file's gid would change if file were deleted and recreated.
581 If file does not exist, returns nil.
585 /* This function can GC. GC checked 1997.06.04. */
586 Lisp_Object values[12];
587 Lisp_Object dirname = Qnil;
591 struct gcpro gcpro1, gcpro2;
593 GCPRO2 (filename, dirname);
594 filename = Fexpand_file_name (filename, Qnil);
596 /* If the file name has special constructs in it,
597 call the corresponding file handler. */
598 handler = Ffind_file_name_handler (filename, Qfile_attributes);
602 return call2 (handler, Qfile_attributes, filename);
605 if (lstat ((char *) XSTRING_DATA (filename), &s) < 0)
612 dirname = Ffile_name_directory (filename);
617 char *tmpnam = (char *) XSTRING_DATA (Ffile_name_nondirectory (filename));
618 int l = strlen (tmpnam);
621 && S_ISREG (s.st_mode)
622 && (stricmp (&tmpnam[l - 4], ".com") == 0 ||
623 stricmp (&tmpnam[l - 4], ".exe") == 0 ||
624 stricmp (&tmpnam[l - 4], ".bat") == 0))
626 s.st_mode |= S_IEXEC;
631 switch (s.st_mode & S_IFMT)
641 values[0] = Ffile_symlink_p (filename);
645 values[1] = make_int (s.st_nlink);
646 values[2] = make_int (s.st_uid);
647 values[3] = make_int (s.st_gid);
648 values[4] = wasteful_word_to_lisp (s.st_atime);
649 values[5] = wasteful_word_to_lisp (s.st_mtime);
650 values[6] = wasteful_word_to_lisp (s.st_ctime);
651 values[7] = make_int ((EMACS_INT) s.st_size);
652 /* If the size is out of range, give back -1. */
653 /* #### Fix when Emacs gets bignums! */
654 if (XINT (values[7]) != s.st_size)
655 values[7] = make_int (-1);
656 filemodestring (&s, modes);
657 values[8] = make_string ((Bufbyte *) modes, 10);
658 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
662 if (!NILP (dirname) && stat ((char *) XSTRING_DATA (dirname), &sdir) == 0)
663 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
664 else /* if we can't tell, assume worst */
667 #else /* file gid will be egid */
668 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
669 #endif /* BSD4_2 or BSD4_3 */
670 values[10] = make_int (s.st_ino);
671 values[11] = make_int (s.st_dev);
673 return Flist (countof (values), values);
677 /************************************************************************/
679 /************************************************************************/
684 defsymbol (&Qdirectory_files, "directory-files");
685 defsymbol (&Qfile_name_completion, "file-name-completion");
686 defsymbol (&Qfile_name_all_completions, "file-name-all-completions");
687 defsymbol (&Qfile_attributes, "file-attributes");
689 DEFSUBR (Fdirectory_files);
690 DEFSUBR (Ffile_name_completion);
691 DEFSUBR (Ffile_name_all_completions);
692 DEFSUBR (Ffile_attributes);
698 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions /*
699 *Completion ignores filenames ending in any string in this list.
700 This variable does not affect lists of possible completions,
701 but does affect the commands that actually do completions.
702 It is used by the functions `file-name-completion' and
703 `file-name-all-completions'.
705 Vcompletion_ignored_extensions = Qnil;