1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985, 1986, 1992 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 #define min(a, b) ((a) < (b) ? (a) : (b))
73 /* if system does not have symbolic links, it does not have lstat.
74 In that case, use ordinary stat instead. */
80 extern Lisp_Object
Ffind_file_name_handler ();
82 Lisp_Object Vcompletion_ignored_extensions
;
84 Lisp_Object Qcompletion_ignore_case
;
86 Lisp_Object Qdirectory_files
;
87 Lisp_Object Qfile_name_completion
;
88 Lisp_Object Qfile_name_all_completions
;
89 Lisp_Object Qfile_attributes
;
91 DEFUN ("directory-files", Fdirectory_files
, Sdirectory_files
, 1, 4, 0,
92 "Return a list of names of files in DIRECTORY.\n\
93 There are three optional arguments:\n\
94 If FULL is non-nil, absolute pathnames of the files are returned.\n\
95 If MATCH is non-nil, only pathnames containing that regexp are returned.\n\
96 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
97 NOSORT is useful if you plan to sort the result yourself.")
98 (dirname
, full
, match
, nosort
)
99 Lisp_Object dirname
, full
, match
, nosort
;
103 Lisp_Object list
, name
;
106 /* If the file name has special constructs in it,
107 call the corresponding file handler. */
108 handler
= Ffind_file_name_handler (dirname
);
114 args
[1] = Qdirectory_files
;
119 return Ffuncall (6, args
);
124 CHECK_STRING (match
, 3);
126 /* MATCH might be a flawed regular expression. Rather than
127 catching and signalling our own errors, we just call
128 compile_pattern to do the work for us. */
130 compile_pattern (match
, &searchbuf
, 0,
131 buffer_defaults
.downcase_table
->contents
);
133 compile_pattern (match
, &searchbuf
, 0, 0);
137 dirname
= Fexpand_file_name (dirname
, Qnil
);
138 if (!(d
= opendir (XSTRING (Fdirectory_file_name (dirname
))->data
)))
139 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
142 length
= XSTRING (dirname
)->size
;
144 /* Loop reading blocks */
147 DIRENTRY
*dp
= readdir (d
);
155 || (0 <= re_search (&searchbuf
, dp
->d_name
, len
, 0, len
, 0)))
159 int index
= XSTRING (dirname
)->size
;
160 int total
= len
+ index
;
163 || XSTRING (dirname
)->data
[length
- 1] != '/')
167 name
= make_uninit_string (total
);
168 bcopy (XSTRING (dirname
)->data
, XSTRING (name
)->data
,
172 || XSTRING (dirname
)->data
[length
- 1] != '/')
173 XSTRING (name
)->data
[index
++] = '/';
175 bcopy (dp
->d_name
, XSTRING (name
)->data
+ index
, len
);
178 name
= make_string (dp
->d_name
, len
);
179 list
= Fcons (name
, list
);
186 return Fsort (Fnreverse (list
), Qstring_lessp
);
189 Lisp_Object
file_name_completion ();
191 DEFUN ("file-name-completion", Ffile_name_completion
, Sfile_name_completion
,
193 "Complete file name FILE in directory DIR.\n\
194 Returns the longest string\n\
195 common to all filenames in DIR that start with FILE.\n\
196 If there is only one and FILE matches it exactly, returns t.\n\
197 Returns nil if DIR contains no name starting with FILE.")
199 Lisp_Object file
, dirname
;
202 /* Don't waste time trying to complete a null string.
203 Besides, this case happens when user is being asked for
204 a directory name and has supplied one ending in a /.
205 We would not want to add anything in that case
206 even if there are some unique characters in that directory. */
207 if (XTYPE (file
) == Lisp_String
&& XSTRING (file
)->size
== 0)
210 /* If the file name has special constructs in it,
211 call the corresponding file handler. */
212 handler
= Ffind_file_name_handler (dirname
);
214 return call3 (handler
, Qfile_name_completion
, file
, dirname
);
216 return file_name_completion (file
, dirname
, 0, 0);
219 DEFUN ("file-name-all-completions", Ffile_name_all_completions
,
220 Sfile_name_all_completions
, 2, 2, 0,
221 "Return a list of all completions of file name FILE in directory DIR.\n\
222 These are all file names in directory DIR which begin with FILE.")
224 Lisp_Object file
, dirname
;
228 /* If the file name has special constructs in it,
229 call the corresponding file handler. */
230 handler
= Ffind_file_name_handler (dirname
);
232 return call3 (handler
, Qfile_name_all_completions
, file
, dirname
);
234 return file_name_completion (file
, dirname
, 1, 0);
238 file_name_completion (file
, dirname
, all_flag
, ver_flag
)
239 Lisp_Object file
, dirname
;
240 int all_flag
, ver_flag
;
244 int bestmatchsize
, skip
;
245 register int compare
, matchsize
;
246 unsigned char *p1
, *p2
;
248 Lisp_Object bestmatch
, tem
, elt
, name
;
252 int count
= specpdl_ptr
- specpdl
;
254 extern DIRENTRY
* readdirver ();
256 DIRENTRY
*((* readfunc
) ());
258 /* Filename completion on VMS ignores case, since VMS filesys does. */
259 specbind (Qcompletion_ignore_case
, Qt
);
263 readfunc
= readdirver
;
264 file
= Fupcase (file
);
266 CHECK_STRING (file
, 0);
269 dirname
= Fexpand_file_name (dirname
, Qnil
);
272 /* With passcount = 0, ignore files that end in an ignored extension.
273 If nothing found then try again with passcount = 1, don't ignore them.
274 If looking for all completions, start with passcount = 1,
275 so always take even the ignored ones.
277 ** It would not actually be helpful to the user to ignore any possible
278 completions when making a list of them.** */
280 for (passcount
= !!all_flag
; NILP (bestmatch
) && passcount
< 2; passcount
++)
282 if (!(d
= opendir (XSTRING (Fdirectory_file_name (dirname
))->data
)))
283 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
285 /* Loop reading blocks */
286 /* (att3b compiler bug requires do a null comparison this way) */
293 dp
= (*readfunc
) (d
);
301 if (!NILP (Vquit_flag
) && NILP (Vinhibit_quit
))
304 || len
< XSTRING (file
)->size
305 || 0 <= scmp (dp
->d_name
, XSTRING (file
)->data
,
306 XSTRING (file
)->size
))
309 if (file_name_completion_stat (dirname
, dp
, &st
) < 0)
312 directoryp
= ((st
.st_mode
& S_IFMT
) == S_IFDIR
);
316 /* Compare extensions-to-be-ignored against end of this file name */
317 /* if name is not an exact match against specified string */
318 if (!passcount
&& len
> XSTRING (file
)->size
)
319 /* and exit this for loop if a match is found */
320 for (tem
= Vcompletion_ignored_extensions
;
321 CONSP (tem
); tem
= XCONS (tem
)->cdr
)
323 elt
= XCONS (tem
)->car
;
324 if (XTYPE (elt
) != Lisp_String
) continue;
325 skip
= len
- XSTRING (elt
)->size
;
326 if (skip
< 0) continue;
328 if (0 <= scmp (dp
->d_name
+ skip
,
330 XSTRING (elt
)->size
))
336 /* Unless an ignored-extensions match was found,
337 process this name as a completion */
338 if (passcount
|| !CONSP (tem
))
340 /* Update computation of how much all possible completions match */
344 if (all_flag
|| NILP (bestmatch
))
346 /* This is a possible completion */
349 /* This completion is a directory; make it end with '/' */
350 name
= Ffile_name_as_directory (make_string (dp
->d_name
, len
));
353 name
= make_string (dp
->d_name
, len
);
356 bestmatch
= Fcons (name
, bestmatch
);
361 bestmatchsize
= XSTRING (name
)->size
;
366 compare
= min (bestmatchsize
, len
);
367 p1
= XSTRING (bestmatch
)->data
;
368 p2
= (unsigned char *) dp
->d_name
;
369 matchsize
= scmp(p1
, p2
, compare
);
372 /* If this dirname all matches,
373 see if implicit following slash does too. */
375 && compare
== matchsize
376 && bestmatchsize
> matchsize
377 && p1
[matchsize
] == '/')
379 bestmatchsize
= min (matchsize
, bestmatchsize
);
386 unbind_to (count
, Qnil
);
388 if (all_flag
|| NILP (bestmatch
))
390 if (matchcount
== 1 && bestmatchsize
== XSTRING (file
)->size
)
392 return Fsubstring (bestmatch
, make_number (0), make_number (bestmatchsize
));
396 return Fsignal (Qquit
, Qnil
);
399 file_name_completion_stat (dirname
, dp
, st_addr
)
402 struct stat
*st_addr
;
404 int len
= NAMLEN (dp
);
405 int pos
= XSTRING (dirname
)->size
;
406 char *fullname
= (char *) alloca (len
+ pos
+ 2);
408 bcopy (XSTRING (dirname
)->data
, fullname
, pos
);
410 if (fullname
[pos
- 1] != '/')
411 fullname
[pos
++] = '/';
414 bcopy (dp
->d_name
, fullname
+ pos
, len
);
415 fullname
[pos
+ len
] = 0;
417 return stat (fullname
, st_addr
);
422 DEFUN ("file-name-all-versions", Ffile_name_all_versions
,
423 Sfile_name_all_versions
, 2, 2, 0,
424 "Return a list of all versions of file name FILE in directory DIR.")
426 Lisp_Object file
, dirname
;
428 return file_name_completion (file
, dirname
, 1, 1);
431 DEFUN ("file-version-limit", Ffile_version_limit
, Sfile_version_limit
, 1, 1, 0,
432 "Return the maximum number of versions allowed for FILE.\n\
433 Returns nil if the file cannot be opened or if there is no version limit.")
435 Lisp_Object filename
;
440 struct XABFHC xabfhc
;
443 filename
= Fexpand_file_name (filename
, Qnil
);
445 xabfhc
= cc$rms_xabfhc
;
446 fab
.fab$l_fna
= XSTRING (filename
)->data
;
447 fab
.fab$b_fns
= strlen (fab
.fab$l_fna
);
448 fab
.fab$l_xab
= (char *) &xabfhc
;
449 status
= sys$
open (&fab
, 0, 0);
450 if (status
!= RMS$_NORMAL
) /* Probably non-existent file */
452 sys$
close (&fab
, 0, 0);
453 if (xabfhc
.xab$w_verlimit
== 32767)
454 return Qnil
; /* No version limit */
456 return make_number (xabfhc
.xab$w_verlimit
);
465 return Fcons (make_number (time
>> 16),
466 Fcons (make_number (time
& 0177777), Qnil
));
469 DEFUN ("file-attributes", Ffile_attributes
, Sfile_attributes
, 1, 1, 0,
470 "Return a list of attributes of file FILENAME.\n\
471 Value is nil if specified file cannot be opened.\n\
472 Otherwise, list elements are:\n\
473 0. t for directory, string (name linked to) for symbolic link, or nil.\n\
474 1. Number of links to file.\n\
477 4. Last access time, as a list of two integers.\n\
478 First integer has high-order 16 bits of time, second has low 16 bits.\n\
479 5. Last modification time, likewise.\n\
480 6. Last status change time, likewise.\n\
482 8. File modes, as a string of ten letters or dashes as in ls -l.\n\
483 9. t iff file's gid would change if file were deleted and recreated.\n\
485 11. Device number.\n\
487 If file does not exist, returns nil.")
489 Lisp_Object filename
;
491 Lisp_Object values
[12];
498 filename
= Fexpand_file_name (filename
, Qnil
);
500 /* If the file name has special constructs in it,
501 call the corresponding file handler. */
502 handler
= Ffind_file_name_handler (filename
);
504 return call2 (handler
, Qfile_attributes
, filename
);
506 if (lstat (XSTRING (filename
)->data
, &s
) < 0)
509 switch (s
.st_mode
& S_IFMT
)
512 values
[0] = Qnil
; break;
514 values
[0] = Qt
; break;
517 values
[0] = Ffile_symlink_p (filename
); break;
520 values
[1] = make_number (s
.st_nlink
);
521 values
[2] = make_number (s
.st_uid
);
522 values
[3] = make_number (s
.st_gid
);
523 values
[4] = make_time (s
.st_atime
);
524 values
[5] = make_time (s
.st_mtime
);
525 values
[6] = make_time (s
.st_ctime
);
526 /* perhaps we should set this to most-positive-fixnum if it is too large? */
527 values
[7] = make_number (s
.st_size
);
528 filemodestring (&s
, modes
);
529 values
[8] = make_string (modes
, 10);
530 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
531 #define BSD4_2 /* A new meaning to the term `backwards compatability' */
533 #ifdef BSD4_2 /* file gid will be dir gid */
534 dirname
= Ffile_name_directory (filename
);
535 if (! NILP (dirname
) && stat (XSTRING (dirname
)->data
, &sdir
) == 0)
536 values
[9] = (sdir
.st_gid
!= s
.st_gid
) ? Qt
: Qnil
;
537 else /* if we can't tell, assume worst */
539 #else /* file gid will be egid */
540 values
[9] = (s
.st_gid
!= getegid ()) ? Qt
: Qnil
;
541 #endif /* BSD4_2 (or BSD4_3) */
543 #undef BSD4_2 /* ok, you can look again without throwing up */
545 values
[10] = make_number (s
.st_ino
);
546 values
[11] = make_number (s
.st_dev
);
547 return Flist (sizeof(values
) / sizeof(values
[0]), values
);
552 Qdirectory_files
= intern ("directory-files");
553 Qfile_name_completion
= intern ("file-name-completion");
554 Qfile_name_all_completions
= intern ("file-name-all-completions");
555 Qfile_attributes
= intern ("file-attributes");
557 defsubr (&Sdirectory_files
);
558 defsubr (&Sfile_name_completion
);
560 defsubr (&Sfile_name_all_versions
);
561 defsubr (&Sfile_version_limit
);
563 defsubr (&Sfile_name_all_completions
);
564 defsubr (&Sfile_attributes
);
567 Qcompletion_ignore_case
= intern ("completion-ignore-case");
568 staticpro (&Qcompletion_ignore_case
);
571 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions
,
572 "*Completion ignores filenames ending in any string in this list.\n\
573 This variable does not affect lists of possible completions,\n\
574 but does affect the commands that actually do completions.");
575 Vcompletion_ignored_extensions
= Qnil
;