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
52 #ifdef NONSYSTEM_DIR_LIBRARY
54 #else /* not NONSYSTEM_DIR_LIBRARY */
56 #endif /* not NONSYSTEM_DIR_LIBRARY */
58 #define DIRENTRY struct direct
60 extern DIR *opendir ();
61 extern struct direct
*readdir ();
71 /* A search buffer, with a fastmap allocated and ready to go. */
72 extern struct re_pattern_buffer searchbuf
;
74 #define min(a, b) ((a) < (b) ? (a) : (b))
76 /* if system does not have symbolic links, it does not have lstat.
77 In that case, use ordinary stat instead. */
83 extern int completion_ignore_case
;
84 extern Lisp_Object
Ffind_file_name_handler ();
86 Lisp_Object Vcompletion_ignored_extensions
;
88 Lisp_Object Qcompletion_ignore_case
;
90 Lisp_Object Qdirectory_files
;
91 Lisp_Object Qfile_name_completion
;
92 Lisp_Object Qfile_name_all_completions
;
93 Lisp_Object Qfile_attributes
;
95 DEFUN ("directory-files", Fdirectory_files
, Sdirectory_files
, 1, 4, 0,
96 "Return a list of names of files in DIRECTORY.\n\
97 There are three optional arguments:\n\
98 If FULL is non-nil, absolute pathnames of the files are returned.\n\
99 If MATCH is non-nil, only pathnames containing that regexp are returned.\n\
100 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
101 NOSORT is useful if you plan to sort the result yourself.")
102 (dirname
, full
, match
, nosort
)
103 Lisp_Object dirname
, full
, match
, nosort
;
107 Lisp_Object list
, name
, dirfilename
;
110 /* If the file name has special constructs in it,
111 call the corresponding file handler. */
112 handler
= Ffind_file_name_handler (dirname
);
118 args
[1] = Qdirectory_files
;
123 return Ffuncall (6, args
);
127 struct gcpro gcpro1
, gcpro2
;
129 /* Because of file name handlers, these functions might call
130 Ffuncall, and cause a GC. */
132 dirname
= Fexpand_file_name (dirname
, Qnil
);
134 GCPRO2 (match
, dirname
);
135 dirfilename
= Fdirectory_file_name (dirname
);
141 CHECK_STRING (match
, 3);
143 /* MATCH might be a flawed regular expression. Rather than
144 catching and signalling our own errors, we just call
145 compile_pattern to do the work for us. */
147 compile_pattern (match
, &searchbuf
, 0,
148 buffer_defaults
.downcase_table
->contents
);
150 compile_pattern (match
, &searchbuf
, 0, 0);
154 /* Now searchbuf is the compiled form of MATCH; don't call anything
155 which might compile a new regexp until we're done with the loop! */
157 /* Do this opendir after anything which might signal an error; if
158 an error is signalled while the directory stream is open, we
159 have to make sure it gets closed, and setting up an
160 unwind_protect to do so would be a pain. */
161 d
= opendir (XSTRING (dirfilename
)->data
);
163 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
166 length
= XSTRING (dirname
)->size
;
168 /* Loop reading blocks */
171 DIRENTRY
*dp
= readdir (d
);
179 || (0 <= re_search (&searchbuf
, dp
->d_name
, len
, 0, len
, 0)))
183 int index
= XSTRING (dirname
)->size
;
184 int total
= len
+ index
;
187 || XSTRING (dirname
)->data
[length
- 1] != '/')
191 name
= make_uninit_string (total
);
192 bcopy (XSTRING (dirname
)->data
, XSTRING (name
)->data
,
196 || XSTRING (dirname
)->data
[length
- 1] != '/')
197 XSTRING (name
)->data
[index
++] = '/';
199 bcopy (dp
->d_name
, XSTRING (name
)->data
+ index
, len
);
202 name
= make_string (dp
->d_name
, len
);
203 list
= Fcons (name
, list
);
210 return Fsort (Fnreverse (list
), Qstring_lessp
);
213 Lisp_Object
file_name_completion ();
215 DEFUN ("file-name-completion", Ffile_name_completion
, Sfile_name_completion
,
217 "Complete file name FILE in directory DIR.\n\
218 Returns the longest string\n\
219 common to all filenames in DIR that start with FILE.\n\
220 If there is only one and FILE matches it exactly, returns t.\n\
221 Returns nil if DIR contains no name starting with FILE.")
223 Lisp_Object file
, dirname
;
226 /* Don't waste time trying to complete a null string.
227 Besides, this case happens when user is being asked for
228 a directory name and has supplied one ending in a /.
229 We would not want to add anything in that case
230 even if there are some unique characters in that directory. */
231 if (XTYPE (file
) == Lisp_String
&& XSTRING (file
)->size
== 0)
234 /* If the file name has special constructs in it,
235 call the corresponding file handler. */
236 handler
= Ffind_file_name_handler (dirname
);
238 return call3 (handler
, Qfile_name_completion
, file
, dirname
);
240 return file_name_completion (file
, dirname
, 0, 0);
243 DEFUN ("file-name-all-completions", Ffile_name_all_completions
,
244 Sfile_name_all_completions
, 2, 2, 0,
245 "Return a list of all completions of file name FILE in directory DIR.\n\
246 These are all file names in directory DIR which begin with FILE.")
248 Lisp_Object file
, dirname
;
252 /* If the file name has special constructs in it,
253 call the corresponding file handler. */
254 handler
= Ffind_file_name_handler (dirname
);
256 return call3 (handler
, Qfile_name_all_completions
, file
, dirname
);
258 return file_name_completion (file
, dirname
, 1, 0);
262 file_name_completion (file
, dirname
, all_flag
, ver_flag
)
263 Lisp_Object file
, dirname
;
264 int all_flag
, ver_flag
;
268 int bestmatchsize
, skip
;
269 register int compare
, matchsize
;
270 unsigned char *p1
, *p2
;
272 Lisp_Object bestmatch
, tem
, elt
, name
;
276 int count
= specpdl_ptr
- specpdl
;
278 extern DIRENTRY
* readdirver ();
280 DIRENTRY
*((* readfunc
) ());
282 /* Filename completion on VMS ignores case, since VMS filesys does. */
283 specbind (Qcompletion_ignore_case
, Qt
);
287 readfunc
= readdirver
;
288 file
= Fupcase (file
);
290 CHECK_STRING (file
, 0);
293 dirname
= Fexpand_file_name (dirname
, Qnil
);
296 /* With passcount = 0, ignore files that end in an ignored extension.
297 If nothing found then try again with passcount = 1, don't ignore them.
298 If looking for all completions, start with passcount = 1,
299 so always take even the ignored ones.
301 ** It would not actually be helpful to the user to ignore any possible
302 completions when making a list of them.** */
304 for (passcount
= !!all_flag
; NILP (bestmatch
) && passcount
< 2; passcount
++)
306 if (!(d
= opendir (XSTRING (Fdirectory_file_name (dirname
))->data
)))
307 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
309 /* Loop reading blocks */
310 /* (att3b compiler bug requires do a null comparison this way) */
317 dp
= (*readfunc
) (d
);
325 if (!NILP (Vquit_flag
) && NILP (Vinhibit_quit
))
328 || len
< XSTRING (file
)->size
329 || 0 <= scmp (dp
->d_name
, XSTRING (file
)->data
,
330 XSTRING (file
)->size
))
333 if (file_name_completion_stat (dirname
, dp
, &st
) < 0)
336 directoryp
= ((st
.st_mode
& S_IFMT
) == S_IFDIR
);
340 /* Compare extensions-to-be-ignored against end of this file name */
341 /* if name is not an exact match against specified string */
342 if (!passcount
&& len
> XSTRING (file
)->size
)
343 /* and exit this for loop if a match is found */
344 for (tem
= Vcompletion_ignored_extensions
;
345 CONSP (tem
); tem
= XCONS (tem
)->cdr
)
347 elt
= XCONS (tem
)->car
;
348 if (XTYPE (elt
) != Lisp_String
) continue;
349 skip
= len
- XSTRING (elt
)->size
;
350 if (skip
< 0) continue;
352 if (0 <= scmp (dp
->d_name
+ skip
,
354 XSTRING (elt
)->size
))
360 /* Unless an ignored-extensions match was found,
361 process this name as a completion */
362 if (passcount
|| !CONSP (tem
))
364 /* Update computation of how much all possible completions match */
368 if (all_flag
|| NILP (bestmatch
))
370 /* This is a possible completion */
373 /* This completion is a directory; make it end with '/' */
374 name
= Ffile_name_as_directory (make_string (dp
->d_name
, len
));
377 name
= make_string (dp
->d_name
, len
);
380 bestmatch
= Fcons (name
, bestmatch
);
385 bestmatchsize
= XSTRING (name
)->size
;
390 compare
= min (bestmatchsize
, len
);
391 p1
= XSTRING (bestmatch
)->data
;
392 p2
= (unsigned char *) dp
->d_name
;
393 matchsize
= scmp(p1
, p2
, compare
);
396 if (completion_ignore_case
)
398 /* If this is an exact match except for case,
399 use it as the best match rather than one that is not
400 an exact match. This way, we get the case pattern
401 of the actual match. */
402 if ((matchsize
== len
403 && matchsize
+ !!directoryp
404 < XSTRING (bestmatch
)->size
)
406 /* If there is no exact match ignoring case,
407 prefer a match that does not change the case
411 (matchsize
+ !!directoryp
412 == XSTRING (bestmatch
)->size
))
413 /* If there is more than one exact match aside from
414 case, and one of them is exact including case,
416 && !bcmp (p2
, XSTRING (file
)->data
, XSTRING (file
)->size
)
417 && bcmp (p1
, XSTRING (file
)->data
, XSTRING (file
)->size
)))
419 bestmatch
= make_string (dp
->d_name
, len
);
421 bestmatch
= Ffile_name_as_directory (bestmatch
);
425 /* If this dirname all matches, see if implicit following
428 && compare
== matchsize
429 && bestmatchsize
> matchsize
430 && p1
[matchsize
] == '/')
432 bestmatchsize
= matchsize
;
439 unbind_to (count
, Qnil
);
441 if (all_flag
|| NILP (bestmatch
))
443 if (matchcount
== 1 && bestmatchsize
== XSTRING (file
)->size
)
445 return Fsubstring (bestmatch
, make_number (0), make_number (bestmatchsize
));
449 return Fsignal (Qquit
, Qnil
);
452 file_name_completion_stat (dirname
, dp
, st_addr
)
455 struct stat
*st_addr
;
457 int len
= NAMLEN (dp
);
458 int pos
= XSTRING (dirname
)->size
;
459 char *fullname
= (char *) alloca (len
+ pos
+ 2);
461 bcopy (XSTRING (dirname
)->data
, fullname
, pos
);
463 if (fullname
[pos
- 1] != '/')
464 fullname
[pos
++] = '/';
467 bcopy (dp
->d_name
, fullname
+ pos
, len
);
468 fullname
[pos
+ len
] = 0;
470 return stat (fullname
, st_addr
);
475 DEFUN ("file-name-all-versions", Ffile_name_all_versions
,
476 Sfile_name_all_versions
, 2, 2, 0,
477 "Return a list of all versions of file name FILE in directory DIR.")
479 Lisp_Object file
, dirname
;
481 return file_name_completion (file
, dirname
, 1, 1);
484 DEFUN ("file-version-limit", Ffile_version_limit
, Sfile_version_limit
, 1, 1, 0,
485 "Return the maximum number of versions allowed for FILE.\n\
486 Returns nil if the file cannot be opened or if there is no version limit.")
488 Lisp_Object filename
;
493 struct XABFHC xabfhc
;
496 filename
= Fexpand_file_name (filename
, Qnil
);
498 xabfhc
= cc$rms_xabfhc
;
499 fab
.fab$l_fna
= XSTRING (filename
)->data
;
500 fab
.fab$b_fns
= strlen (fab
.fab$l_fna
);
501 fab
.fab$l_xab
= (char *) &xabfhc
;
502 status
= sys$
open (&fab
, 0, 0);
503 if (status
!= RMS$_NORMAL
) /* Probably non-existent file */
505 sys$
close (&fab
, 0, 0);
506 if (xabfhc
.xab$w_verlimit
== 32767)
507 return Qnil
; /* No version limit */
509 return make_number (xabfhc
.xab$w_verlimit
);
518 return Fcons (make_number (time
>> 16),
519 Fcons (make_number (time
& 0177777), Qnil
));
522 DEFUN ("file-attributes", Ffile_attributes
, Sfile_attributes
, 1, 1, 0,
523 "Return a list of attributes of file FILENAME.\n\
524 Value is nil if specified file cannot be opened.\n\
525 Otherwise, list elements are:\n\
526 0. t for directory, string (name linked to) for symbolic link, or nil.\n\
527 1. Number of links to file.\n\
530 4. Last access time, as a list of two integers.\n\
531 First integer has high-order 16 bits of time, second has low 16 bits.\n\
532 5. Last modification time, likewise.\n\
533 6. Last status change time, likewise.\n\
534 7. Size in bytes (-1, if number is out of range).\n\
535 8. File modes, as a string of ten letters or dashes as in ls -l.\n\
536 9. t iff file's gid would change if file were deleted and recreated.\n\
538 11. Device number.\n\
540 If file does not exist, returns nil.")
542 Lisp_Object filename
;
544 Lisp_Object values
[12];
551 filename
= Fexpand_file_name (filename
, Qnil
);
553 /* If the file name has special constructs in it,
554 call the corresponding file handler. */
555 handler
= Ffind_file_name_handler (filename
);
557 return call2 (handler
, Qfile_attributes
, filename
);
559 if (lstat (XSTRING (filename
)->data
, &s
) < 0)
562 switch (s
.st_mode
& S_IFMT
)
565 values
[0] = Qnil
; break;
567 values
[0] = Qt
; break;
570 values
[0] = Ffile_symlink_p (filename
); break;
573 values
[1] = make_number (s
.st_nlink
);
574 values
[2] = make_number (s
.st_uid
);
575 values
[3] = make_number (s
.st_gid
);
576 values
[4] = make_time (s
.st_atime
);
577 values
[5] = make_time (s
.st_mtime
);
578 values
[6] = make_time (s
.st_ctime
);
579 values
[7] = make_number (s
.st_size
);
580 /* If the size is out of range, give back -1. */
581 if (XINT (values
[7]) != s
.st_size
)
582 XSETINT (values
[7], -1);
583 filemodestring (&s
, modes
);
584 values
[8] = make_string (modes
, 10);
585 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
586 #define BSD4_2 /* A new meaning to the term `backwards compatibility' */
588 #ifdef BSD4_2 /* file gid will be dir gid */
589 dirname
= Ffile_name_directory (filename
);
590 if (! NILP (dirname
) && stat (XSTRING (dirname
)->data
, &sdir
) == 0)
591 values
[9] = (sdir
.st_gid
!= s
.st_gid
) ? Qt
: Qnil
;
592 else /* if we can't tell, assume worst */
594 #else /* file gid will be egid */
595 values
[9] = (s
.st_gid
!= getegid ()) ? Qt
: Qnil
;
596 #endif /* BSD4_2 (or BSD4_3) */
598 #undef BSD4_2 /* ok, you can look again without throwing up */
600 values
[10] = make_number (s
.st_ino
);
601 values
[11] = make_number (s
.st_dev
);
602 return Flist (sizeof(values
) / sizeof(values
[0]), values
);
607 Qdirectory_files
= intern ("directory-files");
608 Qfile_name_completion
= intern ("file-name-completion");
609 Qfile_name_all_completions
= intern ("file-name-all-completions");
610 Qfile_attributes
= intern ("file-attributes");
612 defsubr (&Sdirectory_files
);
613 defsubr (&Sfile_name_completion
);
615 defsubr (&Sfile_name_all_versions
);
616 defsubr (&Sfile_version_limit
);
618 defsubr (&Sfile_name_all_completions
);
619 defsubr (&Sfile_attributes
);
622 Qcompletion_ignore_case
= intern ("completion-ignore-case");
623 staticpro (&Qcompletion_ignore_case
);
626 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions
,
627 "*Completion ignores filenames ending in any string in this list.\n\
628 This variable does not affect lists of possible completions,\n\
629 but does affect the commands that actually do completions.");
630 Vcompletion_ignored_extensions
= Qnil
;