1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985, 1986, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs 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 2, or (at your option)
11 GNU Emacs 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 GNU Emacs; 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. */
25 #include <sys/types.h>
34 /* The d_nameln member of a struct dirent includes the '\0' character
35 on some systems, but not on others. What's worse, you can't tell
36 at compile-time which one it will be, since it really depends on
37 the sort of system providing the filesystem you're reading from,
38 not the system you are running on. Paul Eggert
39 <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
40 SunOS 4.1.2 host, reading a directory that is remote-mounted from a
41 Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
43 Since applying strlen to the name always works, we'll just do that. */
44 #define NAMLEN(p) strlen (p->d_name)
46 #ifdef SYSV_SYSTEM_DIR
49 #define DIRENTRY struct dirent
51 #else /* not SYSV_SYSTEM_DIR */
53 #ifdef NONSYSTEM_DIR_LIBRARY
55 #else /* not NONSYSTEM_DIR_LIBRARY */
61 #endif /* not NONSYSTEM_DIR_LIBRARY */
64 #define DIRENTRY struct direct
66 extern DIR *opendir ();
67 extern struct direct
*readdir ();
69 #endif /* not MSDOS */
70 #endif /* not SYSV_SYSTEM_DIR */
73 #define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
75 #define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
84 /* Returns a search buffer, with a fastmap allocated and ready to go. */
85 extern struct re_pattern_buffer
*compile_pattern ();
87 #define min(a, b) ((a) < (b) ? (a) : (b))
89 /* if system does not have symbolic links, it does not have lstat.
90 In that case, use ordinary stat instead. */
96 extern int completion_ignore_case
;
97 extern Lisp_Object Vcompletion_regexp_list
;
99 Lisp_Object Vcompletion_ignored_extensions
;
100 Lisp_Object Qcompletion_ignore_case
;
101 Lisp_Object Qdirectory_files
;
102 Lisp_Object Qfile_name_completion
;
103 Lisp_Object Qfile_name_all_completions
;
104 Lisp_Object Qfile_attributes
;
106 DEFUN ("directory-files", Fdirectory_files
, Sdirectory_files
, 1, 4, 0,
107 "Return a list of names of files in DIRECTORY.\n\
108 There are three optional arguments:\n\
109 If FULL is non-nil, return absolute file names. Otherwise return names\n\
110 that are relative to the specified directory.\n\
111 If MATCH is non-nil, mention only file names that match the regexp MATCH.\n\
112 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
113 NOSORT is useful if you plan to sort the result yourself.")
114 (directory
, full
, match
, nosort
)
115 Lisp_Object directory
, full
, match
, nosort
;
119 Lisp_Object list
, name
, dirfilename
;
121 struct re_pattern_buffer
*bufp
;
123 /* If the file name has special constructs in it,
124 call the corresponding file handler. */
125 handler
= Ffind_file_name_handler (directory
, Qdirectory_files
);
131 args
[1] = Qdirectory_files
;
136 return Ffuncall (6, args
);
140 struct gcpro gcpro1
, gcpro2
;
142 /* Because of file name handlers, these functions might call
143 Ffuncall, and cause a GC. */
145 directory
= Fexpand_file_name (directory
, Qnil
);
147 GCPRO2 (match
, directory
);
148 dirfilename
= Fdirectory_file_name (directory
);
154 CHECK_STRING (match
, 3);
156 /* MATCH might be a flawed regular expression. Rather than
157 catching and signaling our own errors, we just call
158 compile_pattern to do the work for us. */
160 bufp
= compile_pattern (match
, 0,
161 buffer_defaults
.downcase_table
->contents
, 0);
163 bufp
= compile_pattern (match
, 0, 0, 0);
167 /* Now *bufp is the compiled form of MATCH; don't call anything
168 which might compile a new regexp until we're done with the loop! */
170 /* Do this opendir after anything which might signal an error; if
171 an error is signaled while the directory stream is open, we
172 have to make sure it gets closed, and setting up an
173 unwind_protect to do so would be a pain. */
174 d
= opendir (XSTRING (dirfilename
)->data
);
176 report_file_error ("Opening directory", Fcons (directory
, Qnil
));
179 dirnamelen
= XSTRING (directory
)->size
;
181 /* Loop reading blocks */
184 DIRENTRY
*dp
= readdir (d
);
189 if (DIRENTRY_NONEMPTY (dp
))
192 || (0 <= re_search (bufp
, dp
->d_name
, len
, 0, len
, 0)))
196 int afterdirindex
= dirnamelen
;
197 int total
= len
+ dirnamelen
;
200 /* Decide whether we need to add a directory separator. */
203 || !IS_ANY_SEP (XSTRING (directory
)->data
[dirnamelen
- 1]))
207 name
= make_uninit_string (total
+ needsep
);
208 bcopy (XSTRING (directory
)->data
, XSTRING (name
)->data
,
211 XSTRING (name
)->data
[afterdirindex
++] = DIRECTORY_SEP
;
213 XSTRING (name
)->data
+ afterdirindex
, len
);
216 name
= make_string (dp
->d_name
, len
);
217 list
= Fcons (name
, list
);
224 return Fsort (Fnreverse (list
), Qstring_lessp
);
227 Lisp_Object
file_name_completion ();
229 DEFUN ("file-name-completion", Ffile_name_completion
, Sfile_name_completion
,
231 "Complete file name FILE in directory DIRECTORY.\n\
232 Returns the longest string\n\
233 common to all file names in DIRECTORY that start with FILE.\n\
234 If there is only one and FILE matches it exactly, returns t.\n\
235 Returns nil if DIR contains no name starting with FILE.")
237 Lisp_Object file
, directory
;
241 /* If the directory name has special constructs in it,
242 call the corresponding file handler. */
243 handler
= Ffind_file_name_handler (directory
, Qfile_name_completion
);
245 return call3 (handler
, Qfile_name_completion
, file
, directory
);
247 /* If the file name has special constructs in it,
248 call the corresponding file handler. */
249 handler
= Ffind_file_name_handler (file
, Qfile_name_completion
);
251 return call3 (handler
, Qfile_name_completion
, file
, directory
);
253 return file_name_completion (file
, directory
, 0, 0);
256 DEFUN ("file-name-all-completions", Ffile_name_all_completions
,
257 Sfile_name_all_completions
, 2, 2, 0,
258 "Return a list of all completions of file name FILE in directory DIRECTORY.\n\
259 These are all file names in directory DIRECTORY which begin with FILE.")
261 Lisp_Object file
, directory
;
265 /* If the directory name has special constructs in it,
266 call the corresponding file handler. */
267 handler
= Ffind_file_name_handler (directory
, Qfile_name_all_completions
);
269 return call3 (handler
, Qfile_name_all_completions
, file
, directory
);
271 /* If the file name has special constructs in it,
272 call the corresponding file handler. */
273 handler
= Ffind_file_name_handler (file
, Qfile_name_all_completions
);
275 return call3 (handler
, Qfile_name_all_completions
, file
, directory
);
277 return file_name_completion (file
, directory
, 1, 0);
281 file_name_completion (file
, dirname
, all_flag
, ver_flag
)
282 Lisp_Object file
, dirname
;
283 int all_flag
, ver_flag
;
287 int bestmatchsize
, skip
;
288 register int compare
, matchsize
;
289 unsigned char *p1
, *p2
;
291 Lisp_Object bestmatch
, tem
, elt
, name
;
295 int count
= specpdl_ptr
- specpdl
;
296 struct gcpro gcpro1
, gcpro2
, gcpro3
;
300 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
301 but aren't required here. Avoid computing the following fields:
302 st_inode, st_size and st_nlink for directories, and the execute bits
303 in st_mode for non-directory files with non-standard extensions. */
305 unsigned short save_djstat_flags
= _djstat_flags
;
307 _djstat_flags
= _STAT_INODE
| _STAT_EXEC_MAGIC
| _STAT_DIRSIZE
;
312 extern DIRENTRY
* readdirver ();
314 DIRENTRY
*((* readfunc
) ());
316 /* Filename completion on VMS ignores case, since VMS filesys does. */
317 specbind (Qcompletion_ignore_case
, Qt
);
321 readfunc
= readdirver
;
322 file
= Fupcase (file
);
324 CHECK_STRING (file
, 0);
327 #ifdef FILE_SYSTEM_CASE
328 file
= FILE_SYSTEM_CASE (file
);
331 GCPRO3 (file
, dirname
, bestmatch
);
332 dirname
= Fexpand_file_name (dirname
, Qnil
);
334 /* With passcount = 0, ignore files that end in an ignored extension.
335 If nothing found then try again with passcount = 1, don't ignore them.
336 If looking for all completions, start with passcount = 1,
337 so always take even the ignored ones.
339 ** It would not actually be helpful to the user to ignore any possible
340 completions when making a list of them.** */
342 for (passcount
= !!all_flag
; NILP (bestmatch
) && passcount
< 2; passcount
++)
344 if (!(d
= opendir (XSTRING (Fdirectory_file_name (dirname
))->data
)))
345 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
347 /* Loop reading blocks */
348 /* (att3b compiler bug requires do a null comparison this way) */
355 dp
= (*readfunc
) (d
);
363 if (!NILP (Vquit_flag
) && NILP (Vinhibit_quit
))
365 if (! DIRENTRY_NONEMPTY (dp
)
366 || len
< XSTRING (file
)->size
367 || 0 <= scmp (dp
->d_name
, XSTRING (file
)->data
,
368 XSTRING (file
)->size
))
371 if (file_name_completion_stat (dirname
, dp
, &st
) < 0)
374 directoryp
= ((st
.st_mode
& S_IFMT
) == S_IFDIR
);
378 #ifndef TRIVIAL_DIRECTORY_ENTRY
379 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
381 /* "." and ".." are never interesting as completions, but are
382 actually in the way in a directory contains only one file. */
383 if (!passcount
&& TRIVIAL_DIRECTORY_ENTRY (dp
->d_name
))
388 /* Compare extensions-to-be-ignored against end of this file name */
389 /* if name is not an exact match against specified string */
390 if (!passcount
&& len
> XSTRING (file
)->size
)
391 /* and exit this for loop if a match is found */
392 for (tem
= Vcompletion_ignored_extensions
;
393 CONSP (tem
); tem
= XCONS (tem
)->cdr
)
395 elt
= XCONS (tem
)->car
;
396 if (!STRINGP (elt
)) continue;
397 skip
= len
- XSTRING (elt
)->size
;
398 if (skip
< 0) continue;
400 if (0 <= scmp (dp
->d_name
+ skip
,
402 XSTRING (elt
)->size
))
408 /* If an ignored-extensions match was found,
409 don't process this name as a completion. */
410 if (!passcount
&& CONSP (tem
))
417 XSETFASTINT (zero
, 0);
419 /* Ignore this element if it fails to match all the regexps. */
420 for (regexps
= Vcompletion_regexp_list
; CONSP (regexps
);
421 regexps
= XCONS (regexps
)->cdr
)
423 tem
= Fstring_match (XCONS (regexps
)->car
, elt
, zero
);
431 /* Update computation of how much all possible completions match */
435 if (all_flag
|| NILP (bestmatch
))
437 /* This is a possible completion */
440 /* This completion is a directory; make it end with '/' */
441 name
= Ffile_name_as_directory (make_string (dp
->d_name
, len
));
444 name
= make_string (dp
->d_name
, len
);
447 bestmatch
= Fcons (name
, bestmatch
);
452 bestmatchsize
= XSTRING (name
)->size
;
457 compare
= min (bestmatchsize
, len
);
458 p1
= XSTRING (bestmatch
)->data
;
459 p2
= (unsigned char *) dp
->d_name
;
460 matchsize
= scmp(p1
, p2
, compare
);
463 if (completion_ignore_case
)
465 /* If this is an exact match except for case,
466 use it as the best match rather than one that is not
467 an exact match. This way, we get the case pattern
468 of the actual match. */
469 /* This tests that the current file is an exact match
470 but BESTMATCH is not (it is too long). */
471 if ((matchsize
== len
472 && matchsize
+ !!directoryp
473 < XSTRING (bestmatch
)->size
)
475 /* If there is no exact match ignoring case,
476 prefer a match that does not change the case
478 /* If there is more than one exact match aside from
479 case, and one of them is exact including case,
481 /* This == checks that, of current file and BESTMATCH,
482 either both or neither are exact. */
485 (matchsize
+ !!directoryp
486 == XSTRING (bestmatch
)->size
))
487 && !bcmp (p2
, XSTRING (file
)->data
, XSTRING (file
)->size
)
488 && bcmp (p1
, XSTRING (file
)->data
, XSTRING (file
)->size
)))
490 bestmatch
= make_string (dp
->d_name
, len
);
492 bestmatch
= Ffile_name_as_directory (bestmatch
);
496 /* If this dirname all matches, see if implicit following
499 && compare
== matchsize
500 && bestmatchsize
> matchsize
501 && IS_ANY_SEP (p1
[matchsize
]))
503 bestmatchsize
= matchsize
;
510 bestmatch
= unbind_to (count
, bestmatch
);
514 _djstat_flags
= save_djstat_flags
;
518 if (all_flag
|| NILP (bestmatch
))
520 if (matchcount
== 1 && bestmatchsize
== XSTRING (file
)->size
)
522 return Fsubstring (bestmatch
, make_number (0), make_number (bestmatchsize
));
526 return Fsignal (Qquit
, Qnil
);
529 file_name_completion_stat (dirname
, dp
, st_addr
)
532 struct stat
*st_addr
;
534 int len
= NAMLEN (dp
);
535 int pos
= XSTRING (dirname
)->size
;
537 char *fullname
= (char *) alloca (len
+ pos
+ 2);
539 bcopy (XSTRING (dirname
)->data
, fullname
, pos
);
541 if (!IS_DIRECTORY_SEP (fullname
[pos
- 1]))
542 fullname
[pos
++] = DIRECTORY_SEP
;
545 bcopy (dp
->d_name
, fullname
+ pos
, len
);
546 fullname
[pos
+ len
] = 0;
549 /* We want to return success if a link points to a nonexistent file,
550 but we want to return the status for what the link points to,
551 in case it is a directory. */
552 value
= lstat (fullname
, st_addr
);
553 stat (fullname
, st_addr
);
556 return stat (fullname
, st_addr
);
562 DEFUN ("file-name-all-versions", Ffile_name_all_versions
,
563 Sfile_name_all_versions
, 2, 2, 0,
564 "Return a list of all versions of file name FILE in directory DIRECTORY.")
566 Lisp_Object file
, directory
;
568 return file_name_completion (file
, directory
, 1, 1);
571 DEFUN ("file-version-limit", Ffile_version_limit
, Sfile_version_limit
, 1, 1, 0,
572 "Return the maximum number of versions allowed for FILE.\n\
573 Returns nil if the file cannot be opened or if there is no version limit.")
575 Lisp_Object filename
;
580 struct XABFHC xabfhc
;
583 filename
= Fexpand_file_name (filename
, Qnil
);
585 xabfhc
= cc$rms_xabfhc
;
586 fab
.fab$l_fna
= XSTRING (filename
)->data
;
587 fab
.fab$b_fns
= strlen (fab
.fab$l_fna
);
588 fab
.fab$l_xab
= (char *) &xabfhc
;
589 status
= sys$
open (&fab
, 0, 0);
590 if (status
!= RMS$_NORMAL
) /* Probably non-existent file */
592 sys$
close (&fab
, 0, 0);
593 if (xabfhc
.xab$w_verlimit
== 32767)
594 return Qnil
; /* No version limit */
596 return make_number (xabfhc
.xab$w_verlimit
);
605 return Fcons (make_number (time
>> 16),
606 Fcons (make_number (time
& 0177777), Qnil
));
609 DEFUN ("file-attributes", Ffile_attributes
, Sfile_attributes
, 1, 1, 0,
610 "Return a list of attributes of file FILENAME.\n\
611 Value is nil if specified file cannot be opened.\n\
612 Otherwise, list elements are:\n\
613 0. t for directory, string (name linked to) for symbolic link, or nil.\n\
614 1. Number of links to file.\n\
617 4. Last access time, as a list of two integers.\n\
618 First integer has high-order 16 bits of time, second has low 16 bits.\n\
619 5. Last modification time, likewise.\n\
620 6. Last status change time, likewise.\n\
621 7. Size in bytes (-1, if number is out of range).\n\
622 8. File modes, as a string of ten letters or dashes as in ls -l.\n\
623 9. t iff file's gid would change if file were deleted and recreated.\n\
625 11. Device number.\n\
627 If file does not exist, returns nil.")
629 Lisp_Object filename
;
631 Lisp_Object values
[12];
638 filename
= Fexpand_file_name (filename
, Qnil
);
640 /* If the file name has special constructs in it,
641 call the corresponding file handler. */
642 handler
= Ffind_file_name_handler (filename
, Qfile_attributes
);
644 return call2 (handler
, Qfile_attributes
, filename
);
646 if (lstat (XSTRING (filename
)->data
, &s
) < 0)
649 switch (s
.st_mode
& S_IFMT
)
652 values
[0] = Qnil
; break;
654 values
[0] = Qt
; break;
657 values
[0] = Ffile_symlink_p (filename
); break;
660 values
[1] = make_number (s
.st_nlink
);
661 values
[2] = make_number (s
.st_uid
);
662 values
[3] = make_number (s
.st_gid
);
663 values
[4] = make_time (s
.st_atime
);
664 values
[5] = make_time (s
.st_mtime
);
665 values
[6] = make_time (s
.st_ctime
);
666 values
[7] = make_number ((int) s
.st_size
);
667 /* If the size is out of range, give back -1. */
668 if (XINT (values
[7]) != s
.st_size
)
669 XSETINT (values
[7], -1);
670 filemodestring (&s
, modes
);
671 values
[8] = make_string (modes
, 10);
672 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
673 #define BSD4_2 /* A new meaning to the term `backwards compatibility' */
675 #ifdef BSD4_2 /* file gid will be dir gid */
676 dirname
= Ffile_name_directory (filename
);
677 if (! NILP (dirname
) && stat (XSTRING (dirname
)->data
, &sdir
) == 0)
678 values
[9] = (sdir
.st_gid
!= s
.st_gid
) ? Qt
: Qnil
;
679 else /* if we can't tell, assume worst */
681 #else /* file gid will be egid */
682 values
[9] = (s
.st_gid
!= getegid ()) ? Qt
: Qnil
;
683 #endif /* BSD4_2 (or BSD4_3) */
685 #undef BSD4_2 /* ok, you can look again without throwing up */
687 values
[10] = make_number (s
.st_ino
);
688 values
[11] = make_number (s
.st_dev
);
689 return Flist (sizeof(values
) / sizeof(values
[0]), values
);
694 Qdirectory_files
= intern ("directory-files");
695 Qfile_name_completion
= intern ("file-name-completion");
696 Qfile_name_all_completions
= intern ("file-name-all-completions");
697 Qfile_attributes
= intern ("file-attributes");
699 defsubr (&Sdirectory_files
);
700 defsubr (&Sfile_name_completion
);
702 defsubr (&Sfile_name_all_versions
);
703 defsubr (&Sfile_version_limit
);
705 defsubr (&Sfile_name_all_completions
);
706 defsubr (&Sfile_attributes
);
709 Qcompletion_ignore_case
= intern ("completion-ignore-case");
710 staticpro (&Qcompletion_ignore_case
);
713 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions
,
714 "*Completion ignores filenames ending in any string in this list.\n\
715 This variable does not affect lists of possible completions,\n\
716 but does affect the commands that actually do completions.");
717 Vcompletion_ignored_extensions
= Qnil
;