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 #ifdef SYSV_SYSTEM_DIR
36 #define DIRENTRY struct dirent
37 #define NAMLEN(p) strlen (p->d_name)
41 #ifdef NONSYSTEM_DIR_LIBRARY
43 #else /* not NONSYSTEM_DIR_LIBRARY */
45 #endif /* not NONSYSTEM_DIR_LIBRARY */
47 #define DIRENTRY struct direct
48 #define NAMLEN(p) p->d_namlen
50 extern DIR *opendir ();
51 extern struct direct
*readdir ();
61 #define min(a, b) ((a) < (b) ? (a) : (b))
63 /* if system does not have symbolic links, it does not have lstat.
64 In that case, use ordinary stat instead. */
70 extern Lisp_Object
Ffind_file_name_handler ();
72 Lisp_Object Vcompletion_ignored_extensions
;
74 Lisp_Object Qcompletion_ignore_case
;
76 Lisp_Object Qdirectory_files
;
77 Lisp_Object Qfile_name_completion
;
78 Lisp_Object Qfile_name_all_completions
;
79 Lisp_Object Qfile_attributes
;
81 DEFUN ("directory-files", Fdirectory_files
, Sdirectory_files
, 1, 4, 0,
82 "Return a list of names of files in DIRECTORY.\n\
83 There are three optional arguments:\n\
84 If FULL is non-nil, absolute pathnames of the files are returned.\n\
85 If MATCH is non-nil, only pathnames containing that regexp are returned.\n\
86 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
87 NOSORT is useful if you plan to sort the result yourself.")
88 (dirname
, full
, match
, nosort
)
89 Lisp_Object dirname
, full
, match
, nosort
;
93 Lisp_Object list
, name
;
96 /* If the file name has special constructs in it,
97 call the corresponding file handler. */
98 handler
= Ffind_file_name_handler (dirname
);
104 args
[1] = Qdirectory_files
;
109 return Ffuncall (6, args
);
114 CHECK_STRING (match
, 3);
116 /* MATCH might be a flawed regular expression. Rather than
117 catching and signalling our own errors, we just call
118 compile_pattern to do the work for us. */
120 compile_pattern (match
, &searchbuf
, 0,
121 buffer_defaults
.downcase_table
->contents
);
123 compile_pattern (match
, &searchbuf
, 0, 0);
127 dirname
= Fexpand_file_name (dirname
, Qnil
);
128 if (!(d
= opendir (XSTRING (Fdirectory_file_name (dirname
))->data
)))
129 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
132 length
= XSTRING (dirname
)->size
;
134 /* Loop reading blocks */
137 DIRENTRY
*dp
= readdir (d
);
145 || (0 <= re_search (&searchbuf
, dp
->d_name
, len
, 0, len
, 0)))
149 int index
= XSTRING (dirname
)->size
;
150 int total
= len
+ index
;
153 || XSTRING (dirname
)->data
[length
- 1] != '/')
157 name
= make_uninit_string (total
);
158 bcopy (XSTRING (dirname
)->data
, XSTRING (name
)->data
,
162 || XSTRING (dirname
)->data
[length
- 1] != '/')
163 XSTRING (name
)->data
[index
++] = '/';
165 bcopy (dp
->d_name
, XSTRING (name
)->data
+ index
, len
);
168 name
= make_string (dp
->d_name
, len
);
169 list
= Fcons (name
, list
);
176 return Fsort (Fnreverse (list
), Qstring_lessp
);
179 Lisp_Object
file_name_completion ();
181 DEFUN ("file-name-completion", Ffile_name_completion
, Sfile_name_completion
,
183 "Complete file name FILE in directory DIR.\n\
184 Returns the longest string\n\
185 common to all filenames in DIR that start with FILE.\n\
186 If there is only one and FILE matches it exactly, returns t.\n\
187 Returns nil if DIR contains no name starting with FILE.")
189 Lisp_Object file
, dirname
;
192 /* Don't waste time trying to complete a null string.
193 Besides, this case happens when user is being asked for
194 a directory name and has supplied one ending in a /.
195 We would not want to add anything in that case
196 even if there are some unique characters in that directory. */
197 if (XTYPE (file
) == Lisp_String
&& XSTRING (file
)->size
== 0)
200 /* If the file name has special constructs in it,
201 call the corresponding file handler. */
202 handler
= Ffind_file_name_handler (dirname
);
204 return call3 (handler
, Qfile_name_completion
, file
, dirname
);
206 return file_name_completion (file
, dirname
, 0, 0);
209 DEFUN ("file-name-all-completions", Ffile_name_all_completions
,
210 Sfile_name_all_completions
, 2, 2, 0,
211 "Return a list of all completions of file name FILE in directory DIR.\n\
212 These are all file names in directory DIR which begin with FILE.")
214 Lisp_Object file
, dirname
;
218 /* If the file name has special constructs in it,
219 call the corresponding file handler. */
220 handler
= Ffind_file_name_handler (dirname
);
222 return call3 (handler
, Qfile_name_all_completions
, file
, dirname
);
224 return file_name_completion (file
, dirname
, 1, 0);
228 file_name_completion (file
, dirname
, all_flag
, ver_flag
)
229 Lisp_Object file
, dirname
;
230 int all_flag
, ver_flag
;
234 int bestmatchsize
, skip
;
235 register int compare
, matchsize
;
236 unsigned char *p1
, *p2
;
238 Lisp_Object bestmatch
, tem
, elt
, name
;
242 int count
= specpdl_ptr
- specpdl
;
244 extern DIRENTRY
* readdirver ();
246 DIRENTRY
*((* readfunc
) ());
248 /* Filename completion on VMS ignores case, since VMS filesys does. */
249 specbind (Qcompletion_ignore_case
, Qt
);
253 readfunc
= readdirver
;
254 file
= Fupcase (file
);
256 CHECK_STRING (file
, 0);
259 dirname
= Fexpand_file_name (dirname
, Qnil
);
262 /* With passcount = 0, ignore files that end in an ignored extension.
263 If nothing found then try again with passcount = 1, don't ignore them.
264 If looking for all completions, start with passcount = 1,
265 so always take even the ignored ones.
267 ** It would not actually be helpful to the user to ignore any possible
268 completions when making a list of them.** */
270 for (passcount
= !!all_flag
; NILP (bestmatch
) && passcount
< 2; passcount
++)
272 if (!(d
= opendir (XSTRING (Fdirectory_file_name (dirname
))->data
)))
273 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
275 /* Loop reading blocks */
276 /* (att3b compiler bug requires do a null comparison this way) */
283 dp
= (*readfunc
) (d
);
291 if (!NILP (Vquit_flag
) && NILP (Vinhibit_quit
))
294 || len
< XSTRING (file
)->size
295 || 0 <= scmp (dp
->d_name
, XSTRING (file
)->data
,
296 XSTRING (file
)->size
))
299 if (file_name_completion_stat (dirname
, dp
, &st
) < 0)
302 directoryp
= ((st
.st_mode
& S_IFMT
) == S_IFDIR
);
306 /* Compare extensions-to-be-ignored against end of this file name */
307 /* if name is not an exact match against specified string */
308 if (!passcount
&& len
> XSTRING (file
)->size
)
309 /* and exit this for loop if a match is found */
310 for (tem
= Vcompletion_ignored_extensions
;
311 CONSP (tem
); tem
= XCONS (tem
)->cdr
)
313 elt
= XCONS (tem
)->car
;
314 if (XTYPE (elt
) != Lisp_String
) continue;
315 skip
= len
- XSTRING (elt
)->size
;
316 if (skip
< 0) continue;
318 if (0 <= scmp (dp
->d_name
+ skip
,
320 XSTRING (elt
)->size
))
326 /* Unless an ignored-extensions match was found,
327 process this name as a completion */
328 if (passcount
|| !CONSP (tem
))
330 /* Update computation of how much all possible completions match */
334 if (all_flag
|| NILP (bestmatch
))
336 /* This is a possible completion */
339 /* This completion is a directory; make it end with '/' */
340 name
= Ffile_name_as_directory (make_string (dp
->d_name
, len
));
343 name
= make_string (dp
->d_name
, len
);
346 bestmatch
= Fcons (name
, bestmatch
);
351 bestmatchsize
= XSTRING (name
)->size
;
356 compare
= min (bestmatchsize
, len
);
357 p1
= XSTRING (bestmatch
)->data
;
358 p2
= (unsigned char *) dp
->d_name
;
359 matchsize
= scmp(p1
, p2
, compare
);
362 /* If this dirname all matches,
363 see if implicit following slash does too. */
365 && compare
== matchsize
366 && bestmatchsize
> matchsize
367 && p1
[matchsize
] == '/')
369 bestmatchsize
= min (matchsize
, bestmatchsize
);
376 unbind_to (count
, Qnil
);
378 if (all_flag
|| NILP (bestmatch
))
380 if (matchcount
== 1 && bestmatchsize
== XSTRING (file
)->size
)
382 return Fsubstring (bestmatch
, make_number (0), make_number (bestmatchsize
));
386 return Fsignal (Qquit
, Qnil
);
389 file_name_completion_stat (dirname
, dp
, st_addr
)
392 struct stat
*st_addr
;
394 int len
= NAMLEN (dp
);
395 int pos
= XSTRING (dirname
)->size
;
396 char *fullname
= (char *) alloca (len
+ pos
+ 2);
398 bcopy (XSTRING (dirname
)->data
, fullname
, pos
);
400 if (fullname
[pos
- 1] != '/')
401 fullname
[pos
++] = '/';
404 bcopy (dp
->d_name
, fullname
+ pos
, len
);
405 fullname
[pos
+ len
] = 0;
407 return stat (fullname
, st_addr
);
412 DEFUN ("file-name-all-versions", Ffile_name_all_versions
,
413 Sfile_name_all_versions
, 2, 2, 0,
414 "Return a list of all versions of file name FILE in directory DIR.")
416 Lisp_Object file
, dirname
;
418 return file_name_completion (file
, dirname
, 1, 1);
421 DEFUN ("file-version-limit", Ffile_version_limit
, Sfile_version_limit
, 1, 1, 0,
422 "Return the maximum number of versions allowed for FILE.\n\
423 Returns nil if the file cannot be opened or if there is no version limit.")
425 Lisp_Object filename
;
430 struct XABFHC xabfhc
;
433 filename
= Fexpand_file_name (filename
, Qnil
);
435 xabfhc
= cc$rms_xabfhc
;
436 fab
.fab$l_fna
= XSTRING (filename
)->data
;
437 fab
.fab$b_fns
= strlen (fab
.fab$l_fna
);
438 fab
.fab$l_xab
= (char *) &xabfhc
;
439 status
= sys$
open (&fab
, 0, 0);
440 if (status
!= RMS$_NORMAL
) /* Probably non-existent file */
442 sys$
close (&fab
, 0, 0);
443 if (xabfhc
.xab$w_verlimit
== 32767)
444 return Qnil
; /* No version limit */
446 return make_number (xabfhc
.xab$w_verlimit
);
455 return Fcons (make_number (time
>> 16),
456 Fcons (make_number (time
& 0177777), Qnil
));
459 DEFUN ("file-attributes", Ffile_attributes
, Sfile_attributes
, 1, 1, 0,
460 "Return a list of attributes of file FILENAME.\n\
461 Value is nil if specified file cannot be opened.\n\
462 Otherwise, list elements are:\n\
463 0. t for directory, string (name linked to) for symbolic link, or nil.\n\
464 1. Number of links to file.\n\
467 4. Last access time, as a list of two integers.\n\
468 First integer has high-order 16 bits of time, second has low 16 bits.\n\
469 5. Last modification time, likewise.\n\
470 6. Last status change time, likewise.\n\
472 8. File modes, as a string of ten letters or dashes as in ls -l.\n\
473 9. t iff file's gid would change if file were deleted and recreated.\n\
475 11. Device number.\n\
477 If file does not exist, returns nil.")
479 Lisp_Object filename
;
481 Lisp_Object values
[12];
488 filename
= Fexpand_file_name (filename
, Qnil
);
490 /* If the file name has special constructs in it,
491 call the corresponding file handler. */
492 handler
= Ffind_file_name_handler (filename
);
494 return call2 (handler
, Qfile_attributes
, filename
);
496 if (lstat (XSTRING (filename
)->data
, &s
) < 0)
499 switch (s
.st_mode
& S_IFMT
)
502 values
[0] = Qnil
; break;
504 values
[0] = Qt
; break;
507 values
[0] = Ffile_symlink_p (filename
); break;
510 values
[1] = make_number (s
.st_nlink
);
511 values
[2] = make_number (s
.st_uid
);
512 values
[3] = make_number (s
.st_gid
);
513 values
[4] = make_time (s
.st_atime
);
514 values
[5] = make_time (s
.st_mtime
);
515 values
[6] = make_time (s
.st_ctime
);
516 /* perhaps we should set this to most-positive-fixnum if it is too large? */
517 values
[7] = make_number (s
.st_size
);
518 filemodestring (&s
, modes
);
519 values
[8] = make_string (modes
, 10);
520 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
521 #define BSD4_2 /* A new meaning to the term `backwards compatability' */
523 #ifdef BSD4_2 /* file gid will be dir gid */
524 dirname
= Ffile_name_directory (filename
);
525 if (! NILP (dirname
) && stat (XSTRING (dirname
)->data
, &sdir
) == 0)
526 values
[9] = (sdir
.st_gid
!= s
.st_gid
) ? Qt
: Qnil
;
527 else /* if we can't tell, assume worst */
529 #else /* file gid will be egid */
530 values
[9] = (s
.st_gid
!= getegid ()) ? Qt
: Qnil
;
531 #endif /* BSD4_2 (or BSD4_3) */
533 #undef BSD4_2 /* ok, you can look again without throwing up */
535 values
[10] = make_number (s
.st_ino
);
536 values
[11] = make_number (s
.st_dev
);
537 return Flist (sizeof(values
) / sizeof(values
[0]), values
);
542 Qdirectory_files
= intern ("directory-files");
543 Qfile_name_completion
= intern ("file-name-completion");
544 Qfile_name_all_completions
= intern ("file-name-all-completions");
545 Qfile_attributes
= intern ("file-attributes");
547 defsubr (&Sdirectory_files
);
548 defsubr (&Sfile_name_completion
);
550 defsubr (&Sfile_name_all_versions
);
551 defsubr (&Sfile_version_limit
);
553 defsubr (&Sfile_name_all_completions
);
554 defsubr (&Sfile_attributes
);
557 Qcompletion_ignore_case
= intern ("completion-ignore-case");
558 staticpro (&Qcompletion_ignore_case
);
561 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions
,
562 "*Completion ignores filenames ending in any string in this list.\n\
563 This variable does not affect lists of possible completions,\n\
564 but does affect the commands that actually do completions.");
565 Vcompletion_ignored_extensions
= Qnil
;