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 1, 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 /* A search buffer, with a fastmap allocated and ready to go. */
84 extern struct re_pattern_buffer searchbuf
;
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
;
120 /* If the file name has special constructs in it,
121 call the corresponding file handler. */
122 handler
= Ffind_file_name_handler (dirname
, Qdirectory_files
);
128 args
[1] = Qdirectory_files
;
133 return Ffuncall (6, args
);
137 struct gcpro gcpro1
, gcpro2
;
139 /* Because of file name handlers, these functions might call
140 Ffuncall, and cause a GC. */
142 dirname
= Fexpand_file_name (dirname
, Qnil
);
144 GCPRO2 (match
, dirname
);
145 dirfilename
= Fdirectory_file_name (dirname
);
151 CHECK_STRING (match
, 3);
153 /* MATCH might be a flawed regular expression. Rather than
154 catching and signalling our own errors, we just call
155 compile_pattern to do the work for us. */
157 compile_pattern (match
, &searchbuf
, 0,
158 buffer_defaults
.downcase_table
->contents
);
160 compile_pattern (match
, &searchbuf
, 0, 0);
164 /* Now searchbuf is the compiled form of MATCH; don't call anything
165 which might compile a new regexp until we're done with the loop! */
167 /* Do this opendir after anything which might signal an error; if
168 an error is signalled while the directory stream is open, we
169 have to make sure it gets closed, and setting up an
170 unwind_protect to do so would be a pain. */
171 d
= opendir (XSTRING (dirfilename
)->data
);
173 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
176 length
= XSTRING (dirname
)->size
;
178 /* Loop reading blocks */
181 DIRENTRY
*dp
= readdir (d
);
186 if (DIRENTRY_NONEMPTY (dp
))
189 || (0 <= re_search (&searchbuf
, dp
->d_name
, len
, 0, len
, 0)))
193 int index
= XSTRING (dirname
)->size
;
194 int total
= len
+ index
;
197 || XSTRING (dirname
)->data
[length
- 1] != '/')
201 name
= make_uninit_string (total
);
202 bcopy (XSTRING (dirname
)->data
, XSTRING (name
)->data
,
206 || XSTRING (dirname
)->data
[length
- 1] != '/')
207 XSTRING (name
)->data
[index
++] = '/';
209 bcopy (dp
->d_name
, XSTRING (name
)->data
+ index
, len
);
212 name
= make_string (dp
->d_name
, len
);
213 list
= Fcons (name
, list
);
220 return Fsort (Fnreverse (list
), Qstring_lessp
);
223 Lisp_Object
file_name_completion ();
225 DEFUN ("file-name-completion", Ffile_name_completion
, Sfile_name_completion
,
227 "Complete file name FILE in directory DIR.\n\
228 Returns the longest string\n\
229 common to all filenames in DIR that start with FILE.\n\
230 If there is only one and FILE matches it exactly, returns t.\n\
231 Returns nil if DIR contains no name starting with FILE.")
233 Lisp_Object file
, dirname
;
237 /* If the file name has special constructs in it,
238 call the corresponding file handler. */
239 handler
= Ffind_file_name_handler (dirname
, Qfile_name_completion
);
241 return call3 (handler
, Qfile_name_completion
, file
, dirname
);
243 return file_name_completion (file
, dirname
, 0, 0);
246 DEFUN ("file-name-all-completions", Ffile_name_all_completions
,
247 Sfile_name_all_completions
, 2, 2, 0,
248 "Return a list of all completions of file name FILE in directory DIR.\n\
249 These are all file names in directory DIR which begin with FILE.")
251 Lisp_Object file
, dirname
;
255 /* If the file name has special constructs in it,
256 call the corresponding file handler. */
257 handler
= Ffind_file_name_handler (dirname
, Qfile_name_all_completions
);
259 return call3 (handler
, Qfile_name_all_completions
, file
, dirname
);
261 return file_name_completion (file
, dirname
, 1, 0);
265 file_name_completion (file
, dirname
, all_flag
, ver_flag
)
266 Lisp_Object file
, dirname
;
267 int all_flag
, ver_flag
;
271 int bestmatchsize
, skip
;
272 register int compare
, matchsize
;
273 unsigned char *p1
, *p2
;
275 Lisp_Object bestmatch
, tem
, elt
, name
;
279 int count
= specpdl_ptr
- specpdl
;
280 struct gcpro gcpro1
, gcpro2
, gcpro3
;
283 extern DIRENTRY
* readdirver ();
285 DIRENTRY
*((* readfunc
) ());
287 /* Filename completion on VMS ignores case, since VMS filesys does. */
288 specbind (Qcompletion_ignore_case
, Qt
);
292 readfunc
= readdirver
;
293 file
= Fupcase (file
);
295 CHECK_STRING (file
, 0);
298 #ifdef FILE_SYSTEM_CASE
299 file
= FILE_SYSTEM_CASE (file
);
302 GCPRO3 (file
, dirname
, bestmatch
);
303 dirname
= Fexpand_file_name (dirname
, Qnil
);
305 /* With passcount = 0, ignore files that end in an ignored extension.
306 If nothing found then try again with passcount = 1, don't ignore them.
307 If looking for all completions, start with passcount = 1,
308 so always take even the ignored ones.
310 ** It would not actually be helpful to the user to ignore any possible
311 completions when making a list of them.** */
313 for (passcount
= !!all_flag
; NILP (bestmatch
) && passcount
< 2; passcount
++)
315 if (!(d
= opendir (XSTRING (Fdirectory_file_name (dirname
))->data
)))
316 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
318 /* Loop reading blocks */
319 /* (att3b compiler bug requires do a null comparison this way) */
326 dp
= (*readfunc
) (d
);
334 if (!NILP (Vquit_flag
) && NILP (Vinhibit_quit
))
336 if (! DIRENTRY_NONEMPTY (dp
)
337 || len
< XSTRING (file
)->size
338 || 0 <= scmp (dp
->d_name
, XSTRING (file
)->data
,
339 XSTRING (file
)->size
))
342 if (file_name_completion_stat (dirname
, dp
, &st
) < 0)
345 directoryp
= ((st
.st_mode
& S_IFMT
) == S_IFDIR
);
349 #ifndef TRIVIAL_DIRECTORY_ENTRY
350 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
352 /* "." and ".." are never interesting as completions, but are
353 actually in the way in a directory contains only one file. */
354 if (!passcount
&& TRIVIAL_DIRECTORY_ENTRY (dp
->d_name
))
359 /* Compare extensions-to-be-ignored against end of this file name */
360 /* if name is not an exact match against specified string */
361 if (!passcount
&& len
> XSTRING (file
)->size
)
362 /* and exit this for loop if a match is found */
363 for (tem
= Vcompletion_ignored_extensions
;
364 CONSP (tem
); tem
= XCONS (tem
)->cdr
)
366 elt
= XCONS (tem
)->car
;
367 if (!STRINGP (elt
)) continue;
368 skip
= len
- XSTRING (elt
)->size
;
369 if (skip
< 0) continue;
371 if (0 <= scmp (dp
->d_name
+ skip
,
373 XSTRING (elt
)->size
))
379 /* If an ignored-extensions match was found,
380 don't process this name as a completion. */
381 if (!passcount
&& CONSP (tem
))
388 XSETFASTINT (zero
, 0);
390 /* Ignore this element if it fails to match all the regexps. */
391 for (regexps
= Vcompletion_regexp_list
; CONSP (regexps
);
392 regexps
= XCONS (regexps
)->cdr
)
394 tem
= Fstring_match (XCONS (regexps
)->car
, elt
, zero
);
402 /* Update computation of how much all possible completions match */
406 if (all_flag
|| NILP (bestmatch
))
408 /* This is a possible completion */
411 /* This completion is a directory; make it end with '/' */
412 name
= Ffile_name_as_directory (make_string (dp
->d_name
, len
));
415 name
= make_string (dp
->d_name
, len
);
418 bestmatch
= Fcons (name
, bestmatch
);
423 bestmatchsize
= XSTRING (name
)->size
;
428 compare
= min (bestmatchsize
, len
);
429 p1
= XSTRING (bestmatch
)->data
;
430 p2
= (unsigned char *) dp
->d_name
;
431 matchsize
= scmp(p1
, p2
, compare
);
434 if (completion_ignore_case
)
436 /* If this is an exact match except for case,
437 use it as the best match rather than one that is not
438 an exact match. This way, we get the case pattern
439 of the actual match. */
440 if ((matchsize
== len
441 && matchsize
+ !!directoryp
442 < XSTRING (bestmatch
)->size
)
444 /* If there is no exact match ignoring case,
445 prefer a match that does not change the case
449 (matchsize
+ !!directoryp
450 == XSTRING (bestmatch
)->size
))
451 /* If there is more than one exact match aside from
452 case, and one of them is exact including case,
454 && !bcmp (p2
, XSTRING (file
)->data
, XSTRING (file
)->size
)
455 && bcmp (p1
, XSTRING (file
)->data
, XSTRING (file
)->size
)))
457 bestmatch
= make_string (dp
->d_name
, len
);
459 bestmatch
= Ffile_name_as_directory (bestmatch
);
463 /* If this dirname all matches, see if implicit following
466 && compare
== matchsize
467 && bestmatchsize
> matchsize
468 && p1
[matchsize
] == '/')
470 bestmatchsize
= matchsize
;
477 bestmatch
= unbind_to (count
, bestmatch
);
479 if (all_flag
|| NILP (bestmatch
))
481 if (matchcount
== 1 && bestmatchsize
== XSTRING (file
)->size
)
483 return Fsubstring (bestmatch
, make_number (0), make_number (bestmatchsize
));
487 return Fsignal (Qquit
, Qnil
);
490 file_name_completion_stat (dirname
, dp
, st_addr
)
493 struct stat
*st_addr
;
495 int len
= NAMLEN (dp
);
496 int pos
= XSTRING (dirname
)->size
;
498 char *fullname
= (char *) alloca (len
+ pos
+ 2);
500 bcopy (XSTRING (dirname
)->data
, fullname
, pos
);
502 if (fullname
[pos
- 1] != '/')
503 fullname
[pos
++] = '/';
506 bcopy (dp
->d_name
, fullname
+ pos
, len
);
507 fullname
[pos
+ len
] = 0;
510 /* We want to return success if a link points to a nonexistent file,
511 but we want to return the status for what the link points to,
512 in case it is a directory. */
513 value
= lstat (fullname
, st_addr
);
514 stat (fullname
, st_addr
);
517 return stat (fullname
, st_addr
);
523 DEFUN ("file-name-all-versions", Ffile_name_all_versions
,
524 Sfile_name_all_versions
, 2, 2, 0,
525 "Return a list of all versions of file name FILE in directory DIR.")
527 Lisp_Object file
, dirname
;
529 return file_name_completion (file
, dirname
, 1, 1);
532 DEFUN ("file-version-limit", Ffile_version_limit
, Sfile_version_limit
, 1, 1, 0,
533 "Return the maximum number of versions allowed for FILE.\n\
534 Returns nil if the file cannot be opened or if there is no version limit.")
536 Lisp_Object filename
;
541 struct XABFHC xabfhc
;
544 filename
= Fexpand_file_name (filename
, Qnil
);
546 xabfhc
= cc$rms_xabfhc
;
547 fab
.fab$l_fna
= XSTRING (filename
)->data
;
548 fab
.fab$b_fns
= strlen (fab
.fab$l_fna
);
549 fab
.fab$l_xab
= (char *) &xabfhc
;
550 status
= sys$
open (&fab
, 0, 0);
551 if (status
!= RMS$_NORMAL
) /* Probably non-existent file */
553 sys$
close (&fab
, 0, 0);
554 if (xabfhc
.xab$w_verlimit
== 32767)
555 return Qnil
; /* No version limit */
557 return make_number (xabfhc
.xab$w_verlimit
);
566 return Fcons (make_number (time
>> 16),
567 Fcons (make_number (time
& 0177777), Qnil
));
570 DEFUN ("file-attributes", Ffile_attributes
, Sfile_attributes
, 1, 1, 0,
571 "Return a list of attributes of file FILENAME.\n\
572 Value is nil if specified file cannot be opened.\n\
573 Otherwise, list elements are:\n\
574 0. t for directory, string (name linked to) for symbolic link, or nil.\n\
575 1. Number of links to file.\n\
578 4. Last access time, as a list of two integers.\n\
579 First integer has high-order 16 bits of time, second has low 16 bits.\n\
580 5. Last modification time, likewise.\n\
581 6. Last status change time, likewise.\n\
582 7. Size in bytes (-1, if number is out of range).\n\
583 8. File modes, as a string of ten letters or dashes as in ls -l.\n\
584 9. t iff file's gid would change if file were deleted and recreated.\n\
586 11. Device number.\n\
588 If file does not exist, returns nil.")
590 Lisp_Object filename
;
592 Lisp_Object values
[12];
599 filename
= Fexpand_file_name (filename
, Qnil
);
601 /* If the file name has special constructs in it,
602 call the corresponding file handler. */
603 handler
= Ffind_file_name_handler (filename
, Qfile_attributes
);
605 return call2 (handler
, Qfile_attributes
, filename
);
607 if (lstat (XSTRING (filename
)->data
, &s
) < 0)
612 char *tmpnam
= XSTRING (Ffile_name_nondirectory (filename
))->data
;
613 int l
= strlen (tmpnam
);
616 && S_ISREG (s
.st_mode
)
617 && (stricmp (&tmpnam
[l
- 4], ".com") == 0
618 || stricmp (&tmpnam
[l
- 4], ".exe") == 0
619 || stricmp (&tmpnam
[l
- 4], ".bat") == 0))
621 s
.st_mode
|= S_IEXEC
;
626 switch (s
.st_mode
& S_IFMT
)
629 values
[0] = Qnil
; break;
631 values
[0] = Qt
; break;
634 values
[0] = Ffile_symlink_p (filename
); break;
637 values
[1] = make_number (s
.st_nlink
);
638 values
[2] = make_number (s
.st_uid
);
639 values
[3] = make_number (s
.st_gid
);
640 values
[4] = make_time (s
.st_atime
);
641 values
[5] = make_time (s
.st_mtime
);
642 values
[6] = make_time (s
.st_ctime
);
643 values
[7] = make_number ((int) s
.st_size
);
644 /* If the size is out of range, give back -1. */
645 if (XINT (values
[7]) != s
.st_size
)
646 XSETINT (values
[7], -1);
647 filemodestring (&s
, modes
);
648 values
[8] = make_string (modes
, 10);
649 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
650 #define BSD4_2 /* A new meaning to the term `backwards compatibility' */
652 #ifdef BSD4_2 /* file gid will be dir gid */
653 dirname
= Ffile_name_directory (filename
);
654 if (! NILP (dirname
) && stat (XSTRING (dirname
)->data
, &sdir
) == 0)
655 values
[9] = (sdir
.st_gid
!= s
.st_gid
) ? Qt
: Qnil
;
656 else /* if we can't tell, assume worst */
658 #else /* file gid will be egid */
659 values
[9] = (s
.st_gid
!= getegid ()) ? Qt
: Qnil
;
660 #endif /* BSD4_2 (or BSD4_3) */
662 #undef BSD4_2 /* ok, you can look again without throwing up */
664 values
[10] = make_number (s
.st_ino
);
665 values
[11] = make_number (s
.st_dev
);
666 return Flist (sizeof(values
) / sizeof(values
[0]), values
);
671 Qdirectory_files
= intern ("directory-files");
672 Qfile_name_completion
= intern ("file-name-completion");
673 Qfile_name_all_completions
= intern ("file-name-all-completions");
674 Qfile_attributes
= intern ("file-attributes");
676 defsubr (&Sdirectory_files
);
677 defsubr (&Sfile_name_completion
);
679 defsubr (&Sfile_name_all_versions
);
680 defsubr (&Sfile_version_limit
);
682 defsubr (&Sfile_name_all_completions
);
683 defsubr (&Sfile_attributes
);
686 Qcompletion_ignore_case
= intern ("completion-ignore-case");
687 staticpro (&Qcompletion_ignore_case
);
690 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions
,
691 "*Completion ignores filenames ending in any string in this list.\n\
692 This variable does not affect lists of possible completions,\n\
693 but does affect the commands that actually do completions.");
694 Vcompletion_ignored_extensions
= Qnil
;