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, 675 Mass Ave, Cambridge, MA 02139, USA. */
24 #include <sys/types.h>
33 /* The d_nameln member of a struct dirent includes the '\0' character
34 on some systems, but not on others. What's worse, you can't tell
35 at compile-time which one it will be, since it really depends on
36 the sort of system providing the filesystem you're reading from,
37 not the system you are running on. Paul Eggert
38 <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
39 SunOS 4.1.2 host, reading a directory that is remote-mounted from a
40 Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
42 Since applying strlen to the name always works, we'll just do that. */
43 #define NAMLEN(p) strlen (p->d_name)
45 #ifdef SYSV_SYSTEM_DIR
48 #define DIRENTRY struct dirent
50 #else /* not SYSV_SYSTEM_DIR */
52 #ifdef NONSYSTEM_DIR_LIBRARY
54 #else /* not NONSYSTEM_DIR_LIBRARY */
60 #endif /* not NONSYSTEM_DIR_LIBRARY */
63 #define DIRENTRY struct direct
65 extern DIR *opendir ();
66 extern struct direct
*readdir ();
68 #endif /* not MSDOS */
69 #endif /* not SYSV_SYSTEM_DIR */
72 #define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
74 #define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
83 /* Returns a search buffer, with a fastmap allocated and ready to go. */
84 extern struct re_pattern_buffer
*compile_pattern ();
86 #define min(a, b) ((a) < (b) ? (a) : (b))
88 /* if system does not have symbolic links, it does not have lstat.
89 In that case, use ordinary stat instead. */
95 extern int completion_ignore_case
;
96 extern Lisp_Object Vcompletion_regexp_list
;
98 Lisp_Object Vcompletion_ignored_extensions
;
99 Lisp_Object Qcompletion_ignore_case
;
100 Lisp_Object Qdirectory_files
;
101 Lisp_Object Qfile_name_completion
;
102 Lisp_Object Qfile_name_all_completions
;
103 Lisp_Object Qfile_attributes
;
105 DEFUN ("directory-files", Fdirectory_files
, Sdirectory_files
, 1, 4, 0,
106 "Return a list of names of files in DIRECTORY.\n\
107 There are three optional arguments:\n\
108 If FULL is non-nil, absolute pathnames of the files are returned.\n\
109 If MATCH is non-nil, only pathnames containing that regexp are returned.\n\
110 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
111 NOSORT is useful if you plan to sort the result yourself.")
112 (dirname
, full
, match
, nosort
)
113 Lisp_Object dirname
, full
, match
, nosort
;
117 Lisp_Object list
, name
, dirfilename
;
119 struct re_pattern_buffer
*bufp
;
121 /* If the file name has special constructs in it,
122 call the corresponding file handler. */
123 handler
= Ffind_file_name_handler (dirname
, Qdirectory_files
);
129 args
[1] = Qdirectory_files
;
134 return Ffuncall (6, args
);
138 struct gcpro gcpro1
, gcpro2
;
140 /* Because of file name handlers, these functions might call
141 Ffuncall, and cause a GC. */
143 dirname
= Fexpand_file_name (dirname
, Qnil
);
145 GCPRO2 (match
, dirname
);
146 dirfilename
= Fdirectory_file_name (dirname
);
152 CHECK_STRING (match
, 3);
154 /* MATCH might be a flawed regular expression. Rather than
155 catching and signalling our own errors, we just call
156 compile_pattern to do the work for us. */
158 bufp
= compile_pattern (match
, 0,
159 buffer_defaults
.downcase_table
->contents
, 0);
161 bufp
= compile_pattern (match
, 0, 0, 0);
165 /* Now *bufp is the compiled form of MATCH; don't call anything
166 which might compile a new regexp until we're done with the loop! */
168 /* Do this opendir after anything which might signal an error; if
169 an error is signalled while the directory stream is open, we
170 have to make sure it gets closed, and setting up an
171 unwind_protect to do so would be a pain. */
172 d
= opendir (XSTRING (dirfilename
)->data
);
174 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
177 dirnamelen
= XSTRING (dirname
)->size
;
179 /* Loop reading blocks */
182 DIRENTRY
*dp
= readdir (d
);
187 if (DIRENTRY_NONEMPTY (dp
))
190 || (0 <= re_search (bufp
, dp
->d_name
, len
, 0, len
, 0)))
194 int afterdirindex
= dirnamelen
;
195 int total
= len
+ dirnamelen
;
198 /* Decide whether we need to add a directory separator. */
201 || !IS_ANY_SEP (XSTRING (dirname
)->data
[dirnamelen
- 1]))
205 name
= make_uninit_string (total
+ needsep
);
206 bcopy (XSTRING (dirname
)->data
, XSTRING (name
)->data
,
209 XSTRING (name
)->data
[afterdirindex
++] = DIRECTORY_SEP
;
211 XSTRING (name
)->data
+ afterdirindex
, len
);
214 name
= make_string (dp
->d_name
, len
);
215 list
= Fcons (name
, list
);
222 return Fsort (Fnreverse (list
), Qstring_lessp
);
225 Lisp_Object
file_name_completion ();
227 DEFUN ("file-name-completion", Ffile_name_completion
, Sfile_name_completion
,
229 "Complete file name FILE in directory DIR.\n\
230 Returns the longest string\n\
231 common to all filenames in DIR that start with FILE.\n\
232 If there is only one and FILE matches it exactly, returns t.\n\
233 Returns nil if DIR contains no name starting with FILE.")
235 Lisp_Object file
, dirname
;
239 /* If the directory name has special constructs in it,
240 call the corresponding file handler. */
241 handler
= Ffind_file_name_handler (dirname
, Qfile_name_completion
);
243 return call3 (handler
, Qfile_name_completion
, file
, dirname
);
245 /* If the file name has special constructs in it,
246 call the corresponding file handler. */
247 handler
= Ffind_file_name_handler (file
, Qfile_name_completion
);
249 return call3 (handler
, Qfile_name_completion
, file
, dirname
);
251 return file_name_completion (file
, dirname
, 0, 0);
254 DEFUN ("file-name-all-completions", Ffile_name_all_completions
,
255 Sfile_name_all_completions
, 2, 2, 0,
256 "Return a list of all completions of file name FILE in directory DIR.\n\
257 These are all file names in directory DIR which begin with FILE.")
259 Lisp_Object file
, dirname
;
263 /* If the directory name has special constructs in it,
264 call the corresponding file handler. */
265 handler
= Ffind_file_name_handler (dirname
, Qfile_name_all_completions
);
267 return call3 (handler
, Qfile_name_all_completions
, file
, dirname
);
269 /* If the file name has special constructs in it,
270 call the corresponding file handler. */
271 handler
= Ffind_file_name_handler (file
, Qfile_name_all_completions
);
273 return call3 (handler
, Qfile_name_all_completions
, file
, dirname
);
275 return file_name_completion (file
, dirname
, 1, 0);
279 file_name_completion (file
, dirname
, all_flag
, ver_flag
)
280 Lisp_Object file
, dirname
;
281 int all_flag
, ver_flag
;
285 int bestmatchsize
, skip
;
286 register int compare
, matchsize
;
287 unsigned char *p1
, *p2
;
289 Lisp_Object bestmatch
, tem
, elt
, name
;
293 int count
= specpdl_ptr
- specpdl
;
294 struct gcpro gcpro1
, gcpro2
, gcpro3
;
297 extern DIRENTRY
* readdirver ();
299 DIRENTRY
*((* readfunc
) ());
301 /* Filename completion on VMS ignores case, since VMS filesys does. */
302 specbind (Qcompletion_ignore_case
, Qt
);
306 readfunc
= readdirver
;
307 file
= Fupcase (file
);
309 CHECK_STRING (file
, 0);
312 #ifdef FILE_SYSTEM_CASE
313 file
= FILE_SYSTEM_CASE (file
);
316 GCPRO3 (file
, dirname
, bestmatch
);
317 dirname
= Fexpand_file_name (dirname
, Qnil
);
319 /* With passcount = 0, ignore files that end in an ignored extension.
320 If nothing found then try again with passcount = 1, don't ignore them.
321 If looking for all completions, start with passcount = 1,
322 so always take even the ignored ones.
324 ** It would not actually be helpful to the user to ignore any possible
325 completions when making a list of them.** */
327 for (passcount
= !!all_flag
; NILP (bestmatch
) && passcount
< 2; passcount
++)
329 if (!(d
= opendir (XSTRING (Fdirectory_file_name (dirname
))->data
)))
330 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
332 /* Loop reading blocks */
333 /* (att3b compiler bug requires do a null comparison this way) */
340 dp
= (*readfunc
) (d
);
348 if (!NILP (Vquit_flag
) && NILP (Vinhibit_quit
))
350 if (! DIRENTRY_NONEMPTY (dp
)
351 || len
< XSTRING (file
)->size
352 || 0 <= scmp (dp
->d_name
, XSTRING (file
)->data
,
353 XSTRING (file
)->size
))
356 if (file_name_completion_stat (dirname
, dp
, &st
) < 0)
359 directoryp
= ((st
.st_mode
& S_IFMT
) == S_IFDIR
);
363 #ifndef TRIVIAL_DIRECTORY_ENTRY
364 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
366 /* "." and ".." are never interesting as completions, but are
367 actually in the way in a directory contains only one file. */
368 if (!passcount
&& TRIVIAL_DIRECTORY_ENTRY (dp
->d_name
))
373 /* Compare extensions-to-be-ignored against end of this file name */
374 /* if name is not an exact match against specified string */
375 if (!passcount
&& len
> XSTRING (file
)->size
)
376 /* and exit this for loop if a match is found */
377 for (tem
= Vcompletion_ignored_extensions
;
378 CONSP (tem
); tem
= XCONS (tem
)->cdr
)
380 elt
= XCONS (tem
)->car
;
381 if (!STRINGP (elt
)) continue;
382 skip
= len
- XSTRING (elt
)->size
;
383 if (skip
< 0) continue;
385 if (0 <= scmp (dp
->d_name
+ skip
,
387 XSTRING (elt
)->size
))
393 /* If an ignored-extensions match was found,
394 don't process this name as a completion. */
395 if (!passcount
&& CONSP (tem
))
402 XSETFASTINT (zero
, 0);
404 /* Ignore this element if it fails to match all the regexps. */
405 for (regexps
= Vcompletion_regexp_list
; CONSP (regexps
);
406 regexps
= XCONS (regexps
)->cdr
)
408 tem
= Fstring_match (XCONS (regexps
)->car
, elt
, zero
);
416 /* Update computation of how much all possible completions match */
420 if (all_flag
|| NILP (bestmatch
))
422 /* This is a possible completion */
425 /* This completion is a directory; make it end with '/' */
426 name
= Ffile_name_as_directory (make_string (dp
->d_name
, len
));
429 name
= make_string (dp
->d_name
, len
);
432 bestmatch
= Fcons (name
, bestmatch
);
437 bestmatchsize
= XSTRING (name
)->size
;
442 compare
= min (bestmatchsize
, len
);
443 p1
= XSTRING (bestmatch
)->data
;
444 p2
= (unsigned char *) dp
->d_name
;
445 matchsize
= scmp(p1
, p2
, compare
);
448 if (completion_ignore_case
)
450 /* If this is an exact match except for case,
451 use it as the best match rather than one that is not
452 an exact match. This way, we get the case pattern
453 of the actual match. */
454 if ((matchsize
== len
455 && matchsize
+ !!directoryp
456 < XSTRING (bestmatch
)->size
)
458 /* If there is no exact match ignoring case,
459 prefer a match that does not change the case
463 (matchsize
+ !!directoryp
464 == XSTRING (bestmatch
)->size
))
465 /* If there is more than one exact match aside from
466 case, and one of them is exact including case,
468 && !bcmp (p2
, XSTRING (file
)->data
, XSTRING (file
)->size
)
469 && bcmp (p1
, XSTRING (file
)->data
, XSTRING (file
)->size
)))
471 bestmatch
= make_string (dp
->d_name
, len
);
473 bestmatch
= Ffile_name_as_directory (bestmatch
);
477 /* If this dirname all matches, see if implicit following
480 && compare
== matchsize
481 && bestmatchsize
> matchsize
482 && IS_ANY_SEP (p1
[matchsize
]))
484 bestmatchsize
= matchsize
;
491 bestmatch
= unbind_to (count
, bestmatch
);
493 if (all_flag
|| NILP (bestmatch
))
495 if (matchcount
== 1 && bestmatchsize
== XSTRING (file
)->size
)
497 return Fsubstring (bestmatch
, make_number (0), make_number (bestmatchsize
));
501 return Fsignal (Qquit
, Qnil
);
504 file_name_completion_stat (dirname
, dp
, st_addr
)
507 struct stat
*st_addr
;
509 int len
= NAMLEN (dp
);
510 int pos
= XSTRING (dirname
)->size
;
512 char *fullname
= (char *) alloca (len
+ pos
+ 2);
514 bcopy (XSTRING (dirname
)->data
, fullname
, pos
);
516 if (!IS_DIRECTORY_SEP (fullname
[pos
- 1]))
517 fullname
[pos
++] = DIRECTORY_SEP
;
520 bcopy (dp
->d_name
, fullname
+ pos
, len
);
521 fullname
[pos
+ len
] = 0;
524 /* We want to return success if a link points to a nonexistent file,
525 but we want to return the status for what the link points to,
526 in case it is a directory. */
527 value
= lstat (fullname
, st_addr
);
528 stat (fullname
, st_addr
);
531 return stat (fullname
, st_addr
);
537 DEFUN ("file-name-all-versions", Ffile_name_all_versions
,
538 Sfile_name_all_versions
, 2, 2, 0,
539 "Return a list of all versions of file name FILE in directory DIR.")
541 Lisp_Object file
, dirname
;
543 return file_name_completion (file
, dirname
, 1, 1);
546 DEFUN ("file-version-limit", Ffile_version_limit
, Sfile_version_limit
, 1, 1, 0,
547 "Return the maximum number of versions allowed for FILE.\n\
548 Returns nil if the file cannot be opened or if there is no version limit.")
550 Lisp_Object filename
;
555 struct XABFHC xabfhc
;
558 filename
= Fexpand_file_name (filename
, Qnil
);
560 xabfhc
= cc$rms_xabfhc
;
561 fab
.fab$l_fna
= XSTRING (filename
)->data
;
562 fab
.fab$b_fns
= strlen (fab
.fab$l_fna
);
563 fab
.fab$l_xab
= (char *) &xabfhc
;
564 status
= sys$
open (&fab
, 0, 0);
565 if (status
!= RMS$_NORMAL
) /* Probably non-existent file */
567 sys$
close (&fab
, 0, 0);
568 if (xabfhc
.xab$w_verlimit
== 32767)
569 return Qnil
; /* No version limit */
571 return make_number (xabfhc
.xab$w_verlimit
);
580 return Fcons (make_number (time
>> 16),
581 Fcons (make_number (time
& 0177777), Qnil
));
584 DEFUN ("file-attributes", Ffile_attributes
, Sfile_attributes
, 1, 1, 0,
585 "Return a list of attributes of file FILENAME.\n\
586 Value is nil if specified file cannot be opened.\n\
587 Otherwise, list elements are:\n\
588 0. t for directory, string (name linked to) for symbolic link, or nil.\n\
589 1. Number of links to file.\n\
592 4. Last access time, as a list of two integers.\n\
593 First integer has high-order 16 bits of time, second has low 16 bits.\n\
594 5. Last modification time, likewise.\n\
595 6. Last status change time, likewise.\n\
596 7. Size in bytes (-1, if number is out of range).\n\
597 8. File modes, as a string of ten letters or dashes as in ls -l.\n\
598 9. t iff file's gid would change if file were deleted and recreated.\n\
600 11. Device number.\n\
602 If file does not exist, returns nil.")
604 Lisp_Object filename
;
606 Lisp_Object values
[12];
613 filename
= Fexpand_file_name (filename
, Qnil
);
615 /* If the file name has special constructs in it,
616 call the corresponding file handler. */
617 handler
= Ffind_file_name_handler (filename
, Qfile_attributes
);
619 return call2 (handler
, Qfile_attributes
, filename
);
621 if (lstat (XSTRING (filename
)->data
, &s
) < 0)
626 char *tmpnam
= XSTRING (Ffile_name_nondirectory (filename
))->data
;
627 int l
= strlen (tmpnam
);
630 && S_ISREG (s
.st_mode
)
631 && (stricmp (&tmpnam
[l
- 4], ".com") == 0
632 || stricmp (&tmpnam
[l
- 4], ".exe") == 0
633 || stricmp (&tmpnam
[l
- 4], ".bat") == 0))
635 s
.st_mode
|= S_IEXEC
;
640 switch (s
.st_mode
& S_IFMT
)
643 values
[0] = Qnil
; break;
645 values
[0] = Qt
; break;
648 values
[0] = Ffile_symlink_p (filename
); break;
651 values
[1] = make_number (s
.st_nlink
);
652 values
[2] = make_number (s
.st_uid
);
653 values
[3] = make_number (s
.st_gid
);
654 values
[4] = make_time (s
.st_atime
);
655 values
[5] = make_time (s
.st_mtime
);
656 values
[6] = make_time (s
.st_ctime
);
657 values
[7] = make_number ((int) s
.st_size
);
658 /* If the size is out of range, give back -1. */
659 if (XINT (values
[7]) != s
.st_size
)
660 XSETINT (values
[7], -1);
661 filemodestring (&s
, modes
);
662 values
[8] = make_string (modes
, 10);
663 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
664 #define BSD4_2 /* A new meaning to the term `backwards compatibility' */
666 #ifdef BSD4_2 /* file gid will be dir gid */
667 dirname
= Ffile_name_directory (filename
);
668 if (! NILP (dirname
) && stat (XSTRING (dirname
)->data
, &sdir
) == 0)
669 values
[9] = (sdir
.st_gid
!= s
.st_gid
) ? Qt
: Qnil
;
670 else /* if we can't tell, assume worst */
672 #else /* file gid will be egid */
674 values
[9] = Qnil
; /* sorry, no group IDs on NT */
675 #else /* not WINDOWSNT */
676 values
[9] = (s
.st_gid
!= getegid ()) ? Qt
: Qnil
;
677 #endif /* not WINDOWSNT */
678 #endif /* BSD4_2 (or BSD4_3) */
680 #undef BSD4_2 /* ok, you can look again without throwing up */
683 /* Fill in the inode and device values specially...see nt.c. */
684 if (!get_inode_and_device_vals (filename
, &values
[10], &values
[11])) {
687 #else /* not WINDOWSNT */
688 values
[10] = make_number (s
.st_ino
);
689 values
[11] = make_number (s
.st_dev
);
690 #endif /* not WINDOWSNT */
691 return Flist (sizeof(values
) / sizeof(values
[0]), values
);
696 Qdirectory_files
= intern ("directory-files");
697 Qfile_name_completion
= intern ("file-name-completion");
698 Qfile_name_all_completions
= intern ("file-name-all-completions");
699 Qfile_attributes
= intern ("file-attributes");
701 defsubr (&Sdirectory_files
);
702 defsubr (&Sfile_name_completion
);
704 defsubr (&Sfile_name_all_versions
);
705 defsubr (&Sfile_version_limit
);
707 defsubr (&Sfile_name_all_completions
);
708 defsubr (&Sfile_attributes
);
711 Qcompletion_ignore_case
= intern ("completion-ignore-case");
712 staticpro (&Qcompletion_ignore_case
);
715 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions
,
716 "*Completion ignores filenames ending in any string in this list.\n\
717 This variable does not affect lists of possible completions,\n\
718 but does affect the commands that actually do completions.");
719 Vcompletion_ignored_extensions
= Qnil
;