1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985, 1986, 1993 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. */
22 #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
Ffind_file_name_handler ();
98 Lisp_Object Vcompletion_ignored_extensions
;
100 Lisp_Object Qcompletion_ignore_case
;
102 Lisp_Object Qdirectory_files
;
103 Lisp_Object Qfile_name_completion
;
104 Lisp_Object Qfile_name_all_completions
;
105 Lisp_Object Qfile_attributes
;
107 DEFUN ("directory-files", Fdirectory_files
, Sdirectory_files
, 1, 4, 0,
108 "Return a list of names of files in DIRECTORY.\n\
109 There are three optional arguments:\n\
110 If FULL is non-nil, absolute pathnames of the files are returned.\n\
111 If MATCH is non-nil, only pathnames containing that regexp are returned.\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 (dirname
, full
, match
, nosort
)
115 Lisp_Object dirname
, full
, match
, nosort
;
119 Lisp_Object list
, name
, dirfilename
;
122 /* If the file name has special constructs in it,
123 call the corresponding file handler. */
124 handler
= Ffind_file_name_handler (dirname
);
130 args
[1] = Qdirectory_files
;
135 return Ffuncall (6, args
);
139 struct gcpro gcpro1
, gcpro2
;
141 /* Because of file name handlers, these functions might call
142 Ffuncall, and cause a GC. */
144 dirname
= Fexpand_file_name (dirname
, Qnil
);
146 GCPRO2 (match
, dirname
);
147 dirfilename
= Fdirectory_file_name (dirname
);
153 CHECK_STRING (match
, 3);
155 /* MATCH might be a flawed regular expression. Rather than
156 catching and signalling our own errors, we just call
157 compile_pattern to do the work for us. */
159 compile_pattern (match
, &searchbuf
, 0,
160 buffer_defaults
.downcase_table
->contents
);
162 compile_pattern (match
, &searchbuf
, 0, 0);
166 /* Now searchbuf is the compiled form of MATCH; don't call anything
167 which might compile a new regexp until we're done with the loop! */
169 /* Do this opendir after anything which might signal an error; if
170 an error is signalled while the directory stream is open, we
171 have to make sure it gets closed, and setting up an
172 unwind_protect to do so would be a pain. */
173 d
= opendir (XSTRING (dirfilename
)->data
);
175 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
178 length
= XSTRING (dirname
)->size
;
180 /* Loop reading blocks */
183 DIRENTRY
*dp
= readdir (d
);
188 if (DIRENTRY_NONEMPTY (dp
))
191 || (0 <= re_search (&searchbuf
, dp
->d_name
, len
, 0, len
, 0)))
195 int index
= XSTRING (dirname
)->size
;
196 int total
= len
+ index
;
199 || XSTRING (dirname
)->data
[length
- 1] != '/')
203 name
= make_uninit_string (total
);
204 bcopy (XSTRING (dirname
)->data
, XSTRING (name
)->data
,
208 || XSTRING (dirname
)->data
[length
- 1] != '/')
209 XSTRING (name
)->data
[index
++] = '/';
211 bcopy (dp
->d_name
, XSTRING (name
)->data
+ index
, 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
;
238 /* Don't waste time trying to complete a null string.
239 Besides, this case happens when user is being asked for
240 a directory name and has supplied one ending in a /.
241 We would not want to add anything in that case
242 even if there are some unique characters in that directory. */
243 if (XTYPE (file
) == Lisp_String
&& XSTRING (file
)->size
== 0)
246 /* If the file name has special constructs in it,
247 call the corresponding file handler. */
248 handler
= Ffind_file_name_handler (dirname
);
250 return call3 (handler
, Qfile_name_completion
, file
, dirname
);
252 return file_name_completion (file
, dirname
, 0, 0);
255 DEFUN ("file-name-all-completions", Ffile_name_all_completions
,
256 Sfile_name_all_completions
, 2, 2, 0,
257 "Return a list of all completions of file name FILE in directory DIR.\n\
258 These are all file names in directory DIR which begin with FILE.")
260 Lisp_Object file
, dirname
;
264 /* If the file name has special constructs in it,
265 call the corresponding file handler. */
266 handler
= Ffind_file_name_handler (dirname
);
268 return call3 (handler
, Qfile_name_all_completions
, file
, dirname
);
270 return file_name_completion (file
, dirname
, 1, 0);
274 file_name_completion (file
, dirname
, all_flag
, ver_flag
)
275 Lisp_Object file
, dirname
;
276 int all_flag
, ver_flag
;
280 int bestmatchsize
, skip
;
281 register int compare
, matchsize
;
282 unsigned char *p1
, *p2
;
284 Lisp_Object bestmatch
, tem
, elt
, name
;
288 int count
= specpdl_ptr
- specpdl
;
289 struct gcpro gcpro1
, gcpro2
, gcpro3
;
292 extern DIRENTRY
* readdirver ();
294 DIRENTRY
*((* readfunc
) ());
296 /* Filename completion on VMS ignores case, since VMS filesys does. */
297 specbind (Qcompletion_ignore_case
, Qt
);
301 readfunc
= readdirver
;
302 file
= Fupcase (file
);
304 CHECK_STRING (file
, 0);
307 #ifdef FILE_SYSTEM_CASE
308 file
= FILE_SYSTEM_CASE (file
);
312 GCPRO3 (file
, dirname
, bestmatch
);
313 dirname
= Fexpand_file_name (dirname
, Qnil
);
315 /* With passcount = 0, ignore files that end in an ignored extension.
316 If nothing found then try again with passcount = 1, don't ignore them.
317 If looking for all completions, start with passcount = 1,
318 so always take even the ignored ones.
320 ** It would not actually be helpful to the user to ignore any possible
321 completions when making a list of them.** */
323 for (passcount
= !!all_flag
; NILP (bestmatch
) && passcount
< 2; passcount
++)
325 if (!(d
= opendir (XSTRING (Fdirectory_file_name (dirname
))->data
)))
326 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
328 /* Loop reading blocks */
329 /* (att3b compiler bug requires do a null comparison this way) */
336 dp
= (*readfunc
) (d
);
344 if (!NILP (Vquit_flag
) && NILP (Vinhibit_quit
))
346 if (! DIRENTRY_NONEMPTY (dp
)
347 || len
< XSTRING (file
)->size
348 || 0 <= scmp (dp
->d_name
, XSTRING (file
)->data
,
349 XSTRING (file
)->size
))
352 if (file_name_completion_stat (dirname
, dp
, &st
) < 0)
355 directoryp
= ((st
.st_mode
& S_IFMT
) == S_IFDIR
);
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 (XTYPE (elt
) != Lisp_String
) 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 /* Unless an ignored-extensions match was found,
380 process this name as a completion */
381 if (passcount
|| !CONSP (tem
))
383 /* Update computation of how much all possible completions match */
387 if (all_flag
|| NILP (bestmatch
))
389 /* This is a possible completion */
392 /* This completion is a directory; make it end with '/' */
393 name
= Ffile_name_as_directory (make_string (dp
->d_name
, len
));
396 name
= make_string (dp
->d_name
, len
);
399 bestmatch
= Fcons (name
, bestmatch
);
404 bestmatchsize
= XSTRING (name
)->size
;
409 compare
= min (bestmatchsize
, len
);
410 p1
= XSTRING (bestmatch
)->data
;
411 p2
= (unsigned char *) dp
->d_name
;
412 matchsize
= scmp(p1
, p2
, compare
);
415 if (completion_ignore_case
)
417 /* If this is an exact match except for case,
418 use it as the best match rather than one that is not
419 an exact match. This way, we get the case pattern
420 of the actual match. */
421 if ((matchsize
== len
422 && matchsize
+ !!directoryp
423 < XSTRING (bestmatch
)->size
)
425 /* If there is no exact match ignoring case,
426 prefer a match that does not change the case
430 (matchsize
+ !!directoryp
431 == XSTRING (bestmatch
)->size
))
432 /* If there is more than one exact match aside from
433 case, and one of them is exact including case,
435 && !bcmp (p2
, XSTRING (file
)->data
, XSTRING (file
)->size
)
436 && bcmp (p1
, XSTRING (file
)->data
, XSTRING (file
)->size
)))
438 bestmatch
= make_string (dp
->d_name
, len
);
440 bestmatch
= Ffile_name_as_directory (bestmatch
);
444 /* If this dirname all matches, see if implicit following
447 && compare
== matchsize
448 && bestmatchsize
> matchsize
449 && p1
[matchsize
] == '/')
451 bestmatchsize
= matchsize
;
459 bestmatch
= unbind_to (count
, bestmatch
);
461 if (all_flag
|| NILP (bestmatch
))
463 if (matchcount
== 1 && bestmatchsize
== XSTRING (file
)->size
)
465 return Fsubstring (bestmatch
, make_number (0), make_number (bestmatchsize
));
469 return Fsignal (Qquit
, Qnil
);
472 file_name_completion_stat (dirname
, dp
, st_addr
)
475 struct stat
*st_addr
;
477 int len
= NAMLEN (dp
);
478 int pos
= XSTRING (dirname
)->size
;
479 char *fullname
= (char *) alloca (len
+ pos
+ 2);
481 bcopy (XSTRING (dirname
)->data
, fullname
, pos
);
483 if (fullname
[pos
- 1] != '/')
484 fullname
[pos
++] = '/';
487 bcopy (dp
->d_name
, fullname
+ pos
, len
);
488 fullname
[pos
+ len
] = 0;
491 return lstat (fullname
, st_addr
);
493 return stat (fullname
, st_addr
);
499 DEFUN ("file-name-all-versions", Ffile_name_all_versions
,
500 Sfile_name_all_versions
, 2, 2, 0,
501 "Return a list of all versions of file name FILE in directory DIR.")
503 Lisp_Object file
, dirname
;
505 return file_name_completion (file
, dirname
, 1, 1);
508 DEFUN ("file-version-limit", Ffile_version_limit
, Sfile_version_limit
, 1, 1, 0,
509 "Return the maximum number of versions allowed for FILE.\n\
510 Returns nil if the file cannot be opened or if there is no version limit.")
512 Lisp_Object filename
;
517 struct XABFHC xabfhc
;
520 filename
= Fexpand_file_name (filename
, Qnil
);
522 xabfhc
= cc$rms_xabfhc
;
523 fab
.fab$l_fna
= XSTRING (filename
)->data
;
524 fab
.fab$b_fns
= strlen (fab
.fab$l_fna
);
525 fab
.fab$l_xab
= (char *) &xabfhc
;
526 status
= sys$
open (&fab
, 0, 0);
527 if (status
!= RMS$_NORMAL
) /* Probably non-existent file */
529 sys$
close (&fab
, 0, 0);
530 if (xabfhc
.xab$w_verlimit
== 32767)
531 return Qnil
; /* No version limit */
533 return make_number (xabfhc
.xab$w_verlimit
);
542 return Fcons (make_number (time
>> 16),
543 Fcons (make_number (time
& 0177777), Qnil
));
546 DEFUN ("file-attributes", Ffile_attributes
, Sfile_attributes
, 1, 1, 0,
547 "Return a list of attributes of file FILENAME.\n\
548 Value is nil if specified file cannot be opened.\n\
549 Otherwise, list elements are:\n\
550 0. t for directory, string (name linked to) for symbolic link, or nil.\n\
551 1. Number of links to file.\n\
554 4. Last access time, as a list of two integers.\n\
555 First integer has high-order 16 bits of time, second has low 16 bits.\n\
556 5. Last modification time, likewise.\n\
557 6. Last status change time, likewise.\n\
558 7. Size in bytes (-1, if number is out of range).\n\
559 8. File modes, as a string of ten letters or dashes as in ls -l.\n\
560 9. t iff file's gid would change if file were deleted and recreated.\n\
562 11. Device number.\n\
564 If file does not exist, returns nil.")
566 Lisp_Object filename
;
568 Lisp_Object values
[12];
575 filename
= Fexpand_file_name (filename
, Qnil
);
577 /* If the file name has special constructs in it,
578 call the corresponding file handler. */
579 handler
= Ffind_file_name_handler (filename
);
581 return call2 (handler
, Qfile_attributes
, filename
);
583 if (lstat (XSTRING (filename
)->data
, &s
) < 0)
588 char *tmpnam
= XSTRING (Ffile_name_nondirectory (filename
))->data
;
589 int l
= strlen (tmpnam
);
592 && S_ISREG (s
.st_mode
)
593 && (stricmp (&tmpnam
[l
- 4], ".com") == 0
594 || stricmp (&tmpnam
[l
- 4], ".exe") == 0
595 || stricmp (&tmpnam
[l
- 4], ".bat") == 0))
597 s
.st_mode
|= S_IEXEC
;
602 switch (s
.st_mode
& S_IFMT
)
605 values
[0] = Qnil
; break;
607 values
[0] = Qt
; break;
610 values
[0] = Ffile_symlink_p (filename
); break;
613 values
[1] = make_number (s
.st_nlink
);
614 values
[2] = make_number (s
.st_uid
);
615 values
[3] = make_number (s
.st_gid
);
616 values
[4] = make_time (s
.st_atime
);
617 values
[5] = make_time (s
.st_mtime
);
618 values
[6] = make_time (s
.st_ctime
);
619 values
[7] = make_number (s
.st_size
);
620 /* If the size is out of range, give back -1. */
621 if (XINT (values
[7]) != s
.st_size
)
622 XSETINT (values
[7], -1);
623 filemodestring (&s
, modes
);
624 values
[8] = make_string (modes
, 10);
625 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
626 #define BSD4_2 /* A new meaning to the term `backwards compatibility' */
628 #ifdef BSD4_2 /* file gid will be dir gid */
629 dirname
= Ffile_name_directory (filename
);
630 if (! NILP (dirname
) && stat (XSTRING (dirname
)->data
, &sdir
) == 0)
631 values
[9] = (sdir
.st_gid
!= s
.st_gid
) ? Qt
: Qnil
;
632 else /* if we can't tell, assume worst */
634 #else /* file gid will be egid */
635 values
[9] = (s
.st_gid
!= getegid ()) ? Qt
: Qnil
;
636 #endif /* BSD4_2 (or BSD4_3) */
638 #undef BSD4_2 /* ok, you can look again without throwing up */
640 values
[10] = make_number (s
.st_ino
);
641 values
[11] = make_number (s
.st_dev
);
642 return Flist (sizeof(values
) / sizeof(values
[0]), values
);
647 Qdirectory_files
= intern ("directory-files");
648 Qfile_name_completion
= intern ("file-name-completion");
649 Qfile_name_all_completions
= intern ("file-name-all-completions");
650 Qfile_attributes
= intern ("file-attributes");
652 defsubr (&Sdirectory_files
);
653 defsubr (&Sfile_name_completion
);
655 defsubr (&Sfile_name_all_versions
);
656 defsubr (&Sfile_version_limit
);
658 defsubr (&Sfile_name_all_completions
);
659 defsubr (&Sfile_attributes
);
662 Qcompletion_ignore_case
= intern ("completion-ignore-case");
663 staticpro (&Qcompletion_ignore_case
);
666 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions
,
667 "*Completion ignores filenames ending in any string in this list.\n\
668 This variable does not affect lists of possible completions,\n\
669 but does affect the commands that actually do completions.");
670 Vcompletion_ignored_extensions
= Qnil
;