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)
85 /* Returns a search buffer, with a fastmap allocated and ready to go. */
86 extern struct re_pattern_buffer
*compile_pattern ();
88 #define min(a, b) ((a) < (b) ? (a) : (b))
90 /* if system does not have symbolic links, it does not have lstat.
91 In that case, use ordinary stat instead. */
97 extern int completion_ignore_case
;
98 extern Lisp_Object Vcompletion_regexp_list
;
99 extern Lisp_Object Vfile_name_coding_system
, Vdefault_file_name_coding_system
;
101 Lisp_Object Vcompletion_ignored_extensions
;
102 Lisp_Object Qcompletion_ignore_case
;
103 Lisp_Object Qdirectory_files
;
104 Lisp_Object Qfile_name_completion
;
105 Lisp_Object Qfile_name_all_completions
;
106 Lisp_Object Qfile_attributes
;
108 DEFUN ("directory-files", Fdirectory_files
, Sdirectory_files
, 1, 4, 0,
109 "Return a list of names of files in DIRECTORY.\n\
110 There are three optional arguments:\n\
111 If FULL is non-nil, return absolute file names. Otherwise return names\n\
112 that are relative to the specified directory.\n\
113 If MATCH is non-nil, mention only file names that match the regexp MATCH.\n\
114 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
115 NOSORT is useful if you plan to sort the result yourself.")
116 (directory
, full
, match
, nosort
)
117 Lisp_Object directory
, full
, match
, nosort
;
121 Lisp_Object list
, name
, dirfilename
;
122 Lisp_Object encoded_directory
;
124 struct re_pattern_buffer
*bufp
;
126 /* If the file name has special constructs in it,
127 call the corresponding file handler. */
128 handler
= Ffind_file_name_handler (directory
, Qdirectory_files
);
134 args
[1] = Qdirectory_files
;
139 return Ffuncall (6, args
);
143 struct gcpro gcpro1
, gcpro2
;
145 /* Because of file name handlers, these functions might call
146 Ffuncall, and cause a GC. */
148 directory
= Fexpand_file_name (directory
, Qnil
);
150 GCPRO2 (match
, directory
);
151 dirfilename
= Fdirectory_file_name (directory
);
157 CHECK_STRING (match
, 3);
159 /* MATCH might be a flawed regular expression. Rather than
160 catching and signaling our own errors, we just call
161 compile_pattern to do the work for us. */
162 /* Pass 1 for the MULTIBYTE arg
163 because we do make multibyte strings if the contents warrant. */
165 bufp
= compile_pattern (match
, 0,
166 buffer_defaults
.downcase_table
, 0, 1);
168 bufp
= compile_pattern (match
, 0, Qnil
, 0, 1);
172 dirfilename
= ENCODE_FILE (dirfilename
);
174 encoded_directory
= ENCODE_FILE (directory
);
176 /* Now *bufp is the compiled form of MATCH; don't call anything
177 which might compile a new regexp until we're done with the loop! */
179 /* Do this opendir after anything which might signal an error; if
180 an error is signaled while the directory stream is open, we
181 have to make sure it gets closed, and setting up an
182 unwind_protect to do so would be a pain. */
183 d
= opendir (XSTRING (dirfilename
)->data
);
185 report_file_error ("Opening directory", Fcons (directory
, Qnil
));
188 dirnamelen
= XSTRING (encoded_directory
)->size
;
189 re_match_object
= Qt
;
191 /* Loop reading blocks */
194 DIRENTRY
*dp
= readdir (d
);
199 if (DIRENTRY_NONEMPTY (dp
))
202 || (0 <= re_search (bufp
, dp
->d_name
, len
, 0, len
, 0)))
206 int afterdirindex
= dirnamelen
;
207 int total
= len
+ dirnamelen
;
211 /* Decide whether we need to add a directory separator. */
214 || !IS_ANY_SEP (XSTRING (encoded_directory
)->data
[dirnamelen
- 1]))
218 name
= make_uninit_string (total
+ needsep
);
219 bcopy (XSTRING (encoded_directory
)->data
, XSTRING (name
)->data
,
222 XSTRING (name
)->data
[afterdirindex
++] = DIRECTORY_SEP
;
224 XSTRING (name
)->data
+ afterdirindex
, len
);
225 nchars
= chars_in_text (dp
->d_name
,
226 afterdirindex
+ len
);
227 XSTRING (name
)->size
= nchars
;
228 if (nchars
== STRING_BYTES (XSTRING (name
)))
229 SET_STRING_BYTES (XSTRING (name
), -1);
232 name
= make_string (dp
->d_name
, len
);
233 name
= DECODE_FILE (name
);
234 list
= Fcons (name
, list
);
241 return Fsort (Fnreverse (list
), Qstring_lessp
);
244 Lisp_Object
file_name_completion ();
246 DEFUN ("file-name-completion", Ffile_name_completion
, Sfile_name_completion
,
248 "Complete file name FILE in directory DIRECTORY.\n\
249 Returns the longest string\n\
250 common to all file names in DIRECTORY that start with FILE.\n\
251 If there is only one and FILE matches it exactly, returns t.\n\
252 Returns nil if DIR contains no name starting with FILE.")
254 Lisp_Object file
, directory
;
258 /* If the directory name has special constructs in it,
259 call the corresponding file handler. */
260 handler
= Ffind_file_name_handler (directory
, Qfile_name_completion
);
262 return call3 (handler
, Qfile_name_completion
, file
, directory
);
264 /* If the file name has special constructs in it,
265 call the corresponding file handler. */
266 handler
= Ffind_file_name_handler (file
, Qfile_name_completion
);
268 return call3 (handler
, Qfile_name_completion
, file
, directory
);
270 return file_name_completion (file
, directory
, 0, 0);
273 DEFUN ("file-name-all-completions", Ffile_name_all_completions
,
274 Sfile_name_all_completions
, 2, 2, 0,
275 "Return a list of all completions of file name FILE in directory DIRECTORY.\n\
276 These are all file names in directory DIRECTORY which begin with FILE.")
278 Lisp_Object file
, directory
;
282 /* If the directory name has special constructs in it,
283 call the corresponding file handler. */
284 handler
= Ffind_file_name_handler (directory
, Qfile_name_all_completions
);
286 return call3 (handler
, Qfile_name_all_completions
, file
, directory
);
288 /* If the file name has special constructs in it,
289 call the corresponding file handler. */
290 handler
= Ffind_file_name_handler (file
, Qfile_name_all_completions
);
292 return call3 (handler
, Qfile_name_all_completions
, file
, directory
);
294 return file_name_completion (file
, directory
, 1, 0);
298 file_name_completion (file
, dirname
, all_flag
, ver_flag
)
299 Lisp_Object file
, dirname
;
300 int all_flag
, ver_flag
;
304 int bestmatchsize
, skip
;
305 register int compare
, matchsize
;
306 unsigned char *p1
, *p2
;
308 Lisp_Object bestmatch
, tem
, elt
, name
;
309 Lisp_Object encoded_file
;
310 Lisp_Object encoded_dir
;
314 int count
= specpdl_ptr
- specpdl
;
315 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
318 extern DIRENTRY
* readdirver ();
320 DIRENTRY
*((* readfunc
) ());
322 /* Filename completion on VMS ignores case, since VMS filesys does. */
323 specbind (Qcompletion_ignore_case
, Qt
);
327 readfunc
= readdirver
;
328 file
= Fupcase (file
);
330 CHECK_STRING (file
, 0);
333 #ifdef FILE_SYSTEM_CASE
334 file
= FILE_SYSTEM_CASE (file
);
337 encoded_file
= encoded_dir
= Qnil
;
338 GCPRO5 (file
, dirname
, bestmatch
, encoded_file
, encoded_dir
);
339 dirname
= Fexpand_file_name (dirname
, Qnil
);
341 /* Do completion on the encoded file name
342 because the other names in the directory are (we presume)
343 encoded likewise. We decode the completed string at the end. */
344 encoded_file
= ENCODE_FILE (file
);
346 encoded_dir
= ENCODE_FILE (dirname
);
348 /* With passcount = 0, ignore files that end in an ignored extension.
349 If nothing found then try again with passcount = 1, don't ignore them.
350 If looking for all completions, start with passcount = 1,
351 so always take even the ignored ones.
353 ** It would not actually be helpful to the user to ignore any possible
354 completions when making a list of them.** */
356 for (passcount
= !!all_flag
; NILP (bestmatch
) && passcount
< 2; passcount
++)
358 d
= opendir (XSTRING (Fdirectory_file_name (encoded_dir
))->data
);
360 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
362 /* Loop reading blocks */
363 /* (att3b compiler bug requires do a null comparison this way) */
370 dp
= (*readfunc
) (d
);
378 if (!NILP (Vquit_flag
) && NILP (Vinhibit_quit
))
380 if (! DIRENTRY_NONEMPTY (dp
)
381 || len
< XSTRING (encoded_file
)->size
382 || 0 <= scmp (dp
->d_name
, XSTRING (encoded_file
)->data
,
383 XSTRING (encoded_file
)->size
))
386 if (file_name_completion_stat (encoded_dir
, dp
, &st
) < 0)
389 directoryp
= ((st
.st_mode
& S_IFMT
) == S_IFDIR
);
393 #ifndef TRIVIAL_DIRECTORY_ENTRY
394 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
396 /* "." and ".." are never interesting as completions, but are
397 actually in the way in a directory contains only one file. */
398 if (!passcount
&& TRIVIAL_DIRECTORY_ENTRY (dp
->d_name
))
403 /* Compare extensions-to-be-ignored against end of this file name */
404 /* if name is not an exact match against specified string */
405 if (!passcount
&& len
> XSTRING (encoded_file
)->size
)
406 /* and exit this for loop if a match is found */
407 for (tem
= Vcompletion_ignored_extensions
;
408 CONSP (tem
); tem
= XCONS (tem
)->cdr
)
410 elt
= XCONS (tem
)->car
;
411 if (!STRINGP (elt
)) continue;
412 skip
= len
- XSTRING (elt
)->size
;
413 if (skip
< 0) continue;
415 if (0 <= scmp (dp
->d_name
+ skip
,
417 XSTRING (elt
)->size
))
423 /* If an ignored-extensions match was found,
424 don't process this name as a completion. */
425 if (!passcount
&& CONSP (tem
))
432 XSETFASTINT (zero
, 0);
434 /* Ignore this element if it fails to match all the regexps. */
435 for (regexps
= Vcompletion_regexp_list
; CONSP (regexps
);
436 regexps
= XCONS (regexps
)->cdr
)
438 tem
= Fstring_match (XCONS (regexps
)->car
, elt
, zero
);
446 /* Update computation of how much all possible completions match */
450 if (all_flag
|| NILP (bestmatch
))
452 /* This is a possible completion */
455 /* This completion is a directory; make it end with '/' */
456 name
= Ffile_name_as_directory (make_string (dp
->d_name
, len
));
459 name
= make_string (dp
->d_name
, len
);
462 name
= DECODE_FILE (name
);
463 bestmatch
= Fcons (name
, bestmatch
);
468 bestmatchsize
= XSTRING (name
)->size
;
473 compare
= min (bestmatchsize
, len
);
474 p1
= XSTRING (bestmatch
)->data
;
475 p2
= (unsigned char *) dp
->d_name
;
476 matchsize
= scmp(p1
, p2
, compare
);
479 if (completion_ignore_case
)
481 /* If this is an exact match except for case,
482 use it as the best match rather than one that is not
483 an exact match. This way, we get the case pattern
484 of the actual match. */
485 /* This tests that the current file is an exact match
486 but BESTMATCH is not (it is too long). */
487 if ((matchsize
== len
488 && matchsize
+ !!directoryp
489 < XSTRING (bestmatch
)->size
)
491 /* If there is no exact match ignoring case,
492 prefer a match that does not change the case
494 /* If there is more than one exact match aside from
495 case, and one of them is exact including case,
497 /* This == checks that, of current file and BESTMATCH,
498 either both or neither are exact. */
501 (matchsize
+ !!directoryp
502 == XSTRING (bestmatch
)->size
))
503 && !bcmp (p2
, XSTRING (encoded_file
)->data
, XSTRING (encoded_file
)->size
)
504 && bcmp (p1
, XSTRING (encoded_file
)->data
, XSTRING (encoded_file
)->size
)))
506 bestmatch
= make_string (dp
->d_name
, len
);
508 bestmatch
= Ffile_name_as_directory (bestmatch
);
512 /* If this dirname all matches, see if implicit following
515 && compare
== matchsize
516 && bestmatchsize
> matchsize
517 && IS_ANY_SEP (p1
[matchsize
]))
519 bestmatchsize
= matchsize
;
526 bestmatch
= unbind_to (count
, bestmatch
);
528 if (all_flag
|| NILP (bestmatch
))
530 if (STRINGP (bestmatch
))
531 bestmatch
= DECODE_FILE (bestmatch
);
534 if (matchcount
== 1 && bestmatchsize
== XSTRING (file
)->size
)
536 bestmatch
= Fsubstring (bestmatch
, make_number (0),
537 make_number (bestmatchsize
));
538 /* Now that we got the right initial segment of BESTMATCH,
539 decode it from the coding system in use. */
540 bestmatch
= DECODE_FILE (bestmatch
);
546 return Fsignal (Qquit
, Qnil
);
549 file_name_completion_stat (dirname
, dp
, st_addr
)
552 struct stat
*st_addr
;
554 int len
= NAMLEN (dp
);
555 int pos
= XSTRING (dirname
)->size
;
557 char *fullname
= (char *) alloca (len
+ pos
+ 2);
561 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
562 but aren't required here. Avoid computing the following fields:
563 st_inode, st_size and st_nlink for directories, and the execute bits
564 in st_mode for non-directory files with non-standard extensions. */
566 unsigned short save_djstat_flags
= _djstat_flags
;
568 _djstat_flags
= _STAT_INODE
| _STAT_EXEC_MAGIC
| _STAT_DIRSIZE
;
569 #endif /* __DJGPP__ > 1 */
572 bcopy (XSTRING (dirname
)->data
, fullname
, pos
);
574 if (!IS_DIRECTORY_SEP (fullname
[pos
- 1]))
575 fullname
[pos
++] = DIRECTORY_SEP
;
578 bcopy (dp
->d_name
, fullname
+ pos
, len
);
579 fullname
[pos
+ len
] = 0;
582 /* We want to return success if a link points to a nonexistent file,
583 but we want to return the status for what the link points to,
584 in case it is a directory. */
585 value
= lstat (fullname
, st_addr
);
586 stat (fullname
, st_addr
);
589 value
= stat (fullname
, st_addr
);
592 _djstat_flags
= save_djstat_flags
;
593 #endif /* __DJGPP__ > 1 */
601 DEFUN ("file-name-all-versions", Ffile_name_all_versions
,
602 Sfile_name_all_versions
, 2, 2, 0,
603 "Return a list of all versions of file name FILE in directory DIRECTORY.")
605 Lisp_Object file
, directory
;
607 return file_name_completion (file
, directory
, 1, 1);
610 DEFUN ("file-version-limit", Ffile_version_limit
, Sfile_version_limit
, 1, 1, 0,
611 "Return the maximum number of versions allowed for FILE.\n\
612 Returns nil if the file cannot be opened or if there is no version limit.")
614 Lisp_Object filename
;
619 struct XABFHC xabfhc
;
622 filename
= Fexpand_file_name (filename
, Qnil
);
624 xabfhc
= cc$rms_xabfhc
;
625 fab
.fab$l_fna
= XSTRING (filename
)->data
;
626 fab
.fab$b_fns
= strlen (fab
.fab$l_fna
);
627 fab
.fab$l_xab
= (char *) &xabfhc
;
628 status
= sys$
open (&fab
, 0, 0);
629 if (status
!= RMS$_NORMAL
) /* Probably non-existent file */
631 sys$
close (&fab
, 0, 0);
632 if (xabfhc
.xab$w_verlimit
== 32767)
633 return Qnil
; /* No version limit */
635 return make_number (xabfhc
.xab$w_verlimit
);
644 return Fcons (make_number (time
>> 16),
645 Fcons (make_number (time
& 0177777), Qnil
));
648 DEFUN ("file-attributes", Ffile_attributes
, Sfile_attributes
, 1, 1, 0,
649 "Return a list of attributes of file FILENAME.\n\
650 Value is nil if specified file cannot be opened.\n\
651 Otherwise, list elements are:\n\
652 0. t for directory, string (name linked to) for symbolic link, or nil.\n\
653 1. Number of links to file.\n\
656 4. Last access time, as a list of two integers.\n\
657 First integer has high-order 16 bits of time, second has low 16 bits.\n\
658 5. Last modification time, likewise.\n\
659 6. Last status change time, likewise.\n\
660 7. Size in bytes (-1, if number is out of range).\n\
661 8. File modes, as a string of ten letters or dashes as in ls -l.\n\
662 9. t iff file's gid would change if file were deleted and recreated.\n\
664 11. Device number.\n\
666 If file does not exist, returns nil.")
668 Lisp_Object filename
;
670 Lisp_Object values
[12];
678 filename
= Fexpand_file_name (filename
, Qnil
);
680 /* If the file name has special constructs in it,
681 call the corresponding file handler. */
682 handler
= Ffind_file_name_handler (filename
, Qfile_attributes
);
684 return call2 (handler
, Qfile_attributes
, filename
);
686 encoded
= ENCODE_FILE (filename
);
688 if (lstat (XSTRING (encoded
)->data
, &s
) < 0)
691 switch (s
.st_mode
& S_IFMT
)
694 values
[0] = Qnil
; break;
696 values
[0] = Qt
; break;
699 values
[0] = Ffile_symlink_p (filename
); break;
702 values
[1] = make_number (s
.st_nlink
);
703 values
[2] = make_number (s
.st_uid
);
704 values
[3] = make_number (s
.st_gid
);
705 values
[4] = make_time (s
.st_atime
);
706 values
[5] = make_time (s
.st_mtime
);
707 values
[6] = make_time (s
.st_ctime
);
708 values
[7] = make_number ((int) s
.st_size
);
709 /* If the size is out of range, give back -1. */
710 if (XINT (values
[7]) != s
.st_size
)
711 XSETINT (values
[7], -1);
712 filemodestring (&s
, modes
);
713 values
[8] = make_string (modes
, 10);
714 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
715 #define BSD4_2 /* A new meaning to the term `backwards compatibility' */
717 #ifdef BSD4_2 /* file gid will be dir gid */
718 dirname
= Ffile_name_directory (filename
);
719 if (! NILP (dirname
))
720 encoded
= ENCODE_FILE (dirname
);
721 if (! NILP (dirname
) && stat (XSTRING (encoded
)->data
, &sdir
) == 0)
722 values
[9] = (sdir
.st_gid
!= s
.st_gid
) ? Qt
: Qnil
;
723 else /* if we can't tell, assume worst */
725 #else /* file gid will be egid */
726 values
[9] = (s
.st_gid
!= getegid ()) ? Qt
: Qnil
;
727 #endif /* BSD4_2 (or BSD4_3) */
729 #undef BSD4_2 /* ok, you can look again without throwing up */
731 /* Cast -1 to avoid warning if int is not as wide as VALBITS. */
732 if (s
.st_ino
& (((EMACS_INT
) (-1)) << VALBITS
))
733 /* To allow inode numbers larger than VALBITS, separate the bottom
735 values
[10] = Fcons (make_number (s
.st_ino
>> 16),
736 make_number (s
.st_ino
& 0xffff));
738 /* But keep the most common cases as integers. */
739 values
[10] = make_number (s
.st_ino
);
740 values
[11] = make_number (s
.st_dev
);
741 return Flist (sizeof(values
) / sizeof(values
[0]), values
);
746 Qdirectory_files
= intern ("directory-files");
747 Qfile_name_completion
= intern ("file-name-completion");
748 Qfile_name_all_completions
= intern ("file-name-all-completions");
749 Qfile_attributes
= intern ("file-attributes");
751 staticpro (&Qdirectory_files
);
752 staticpro (&Qfile_name_completion
);
753 staticpro (&Qfile_name_all_completions
);
754 staticpro (&Qfile_attributes
);
756 defsubr (&Sdirectory_files
);
757 defsubr (&Sfile_name_completion
);
759 defsubr (&Sfile_name_all_versions
);
760 defsubr (&Sfile_version_limit
);
762 defsubr (&Sfile_name_all_completions
);
763 defsubr (&Sfile_attributes
);
766 Qcompletion_ignore_case
= intern ("completion-ignore-case");
767 staticpro (&Qcompletion_ignore_case
);
770 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions
,
771 "*Completion ignores filenames ending in any string in this list.\n\
772 This variable does not affect lists of possible completions,\n\
773 but does affect the commands that actually do completions.");
774 Vcompletion_ignored_extensions
= Qnil
;