1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985, 1986 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>
27 #ifdef SYSV_SYSTEM_DIR
30 #define DIRENTRY struct dirent
31 #define NAMLEN(p) strlen (p->d_name)
35 #ifdef NONSYSTEM_DIR_LIBRARY
37 #else /* not NONSYSTEM_DIR_LIBRARY */
39 #endif /* not NONSYSTEM_DIR_LIBRARY */
41 #define DIRENTRY struct direct
42 #define NAMLEN(p) p->d_namlen
44 extern DIR *opendir ();
45 extern struct direct
*readdir ();
55 #define min(a, b) ((a) < (b) ? (a) : (b))
57 /* if system does not have symbolic links, it does not have lstat.
58 In that case, use ordinary stat instead. */
64 Lisp_Object Vcompletion_ignored_extensions
;
66 Lisp_Object Qcompletion_ignore_case
;
68 Lisp_Object Qdirectory_files
;
69 Lisp_Object Qfile_name_completion
;
70 Lisp_Object Qfile_name_all_completions
;
71 Lisp_Object Qfile_attributes
;
73 DEFUN ("directory-files", Fdirectory_files
, Sdirectory_files
, 1, 4, 0,
74 "Return a list of names of files in DIRECTORY.\n\
75 There are three optional arguments:\n\
76 If FULL is non-nil, absolute pathnames of the files are returned.\n\
77 If MATCH is non-nil, only pathnames containing that regexp are returned.\n\
78 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
79 NOSORT is useful if you plan to sort the result yourself.")
80 (dirname
, full
, match
, nosort
)
81 Lisp_Object dirname
, full
, match
, nosort
;
85 Lisp_Object list
, name
;
88 /* If the file name has special constructs in it,
89 call the corresponding file handler. */
90 handler
= find_file_handler (dirname
);
96 args
[1] = Qdirectory_files
;
101 return Ffuncall (6, args
);
106 CHECK_STRING (match
, 3);
108 /* MATCH might be a flawed regular expression. Rather than
109 catching and signalling our own errors, we just call
110 compile_pattern to do the work for us. */
112 compile_pattern (match
, &searchbuf
, 0
113 buffer_defaults
.downcase_table
->contents
);
115 compile_pattern (match
, &searchbuf
, 0, 0);
119 dirname
= Fexpand_file_name (dirname
, Qnil
);
120 if (!(d
= opendir (XSTRING (Fdirectory_file_name (dirname
))->data
)))
121 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
124 length
= XSTRING (dirname
)->size
;
126 /* Loop reading blocks */
129 DIRENTRY
*dp
= readdir (d
);
137 || (0 <= re_search (&searchbuf
, dp
->d_name
, len
, 0, len
, 0)))
141 int index
= XSTRING (dirname
)->size
;
142 int total
= len
+ index
;
145 || XSTRING (dirname
)->data
[length
- 1] != '/')
149 name
= make_uninit_string (total
);
150 bcopy (XSTRING (dirname
)->data
, XSTRING (name
)->data
,
154 || XSTRING (dirname
)->data
[length
- 1] != '/')
155 XSTRING (name
)->data
[index
++] = '/';
157 bcopy (dp
->d_name
, XSTRING (name
)->data
+ index
, len
);
160 name
= make_string (dp
->d_name
, len
);
161 list
= Fcons (name
, list
);
168 return Fsort (Fnreverse (list
), Qstring_lessp
);
171 Lisp_Object
file_name_completion ();
173 DEFUN ("file-name-completion", Ffile_name_completion
, Sfile_name_completion
,
175 "Complete file name FILE in directory DIR.\n\
176 Returns the longest string\n\
177 common to all filenames in DIR that start with FILE.\n\
178 If there is only one and FILE matches it exactly, returns t.\n\
179 Returns nil if DIR contains no name starting with FILE.")
181 Lisp_Object file
, dirname
;
184 /* Don't waste time trying to complete a null string.
185 Besides, this case happens when user is being asked for
186 a directory name and has supplied one ending in a /.
187 We would not want to add anything in that case
188 even if there are some unique characters in that directory. */
189 if (XTYPE (file
) == Lisp_String
&& XSTRING (file
)->size
== 0)
192 /* If the file name has special constructs in it,
193 call the corresponding file handler. */
194 handler
= find_file_handler (dirname
);
196 return call3 (handler
, Qfile_name_completion
, file
, dirname
);
198 return file_name_completion (file
, dirname
, 0, 0);
201 DEFUN ("file-name-all-completions", Ffile_name_all_completions
,
202 Sfile_name_all_completions
, 2, 2, 0,
203 "Return a list of all completions of file name FILE in directory DIR.\n\
204 These are all file names in directory DIR which begin with FILE.")
206 Lisp_Object file
, dirname
;
210 /* If the file name has special constructs in it,
211 call the corresponding file handler. */
212 handler
= find_file_handler (dirname
);
214 return call3 (handler
, Qfile_name_all_completions
, file
, dirname
);
216 return file_name_completion (file
, dirname
, 1, 0);
221 DEFUN ("file-name-all-versions", Ffile_name_all_versions
,
222 Sfile_name_all_versions
, 2, 2, 0,
223 "Return a list of all versions of file name FILE in directory DIR.")
225 Lisp_Object file
, dirname
;
227 return file_name_completion (file
, dirname
, 1, 1);
233 file_name_completion (file
, dirname
, all_flag
, ver_flag
)
234 Lisp_Object file
, dirname
;
235 int all_flag
, ver_flag
;
239 int bestmatchsize
, skip
;
240 register int compare
, matchsize
;
241 unsigned char *p1
, *p2
;
243 Lisp_Object bestmatch
, tem
, elt
, name
;
247 int count
= specpdl_ptr
- specpdl
;
249 extern DIRENTRY
* readdirver ();
251 DIRENTRY
*((* readfunc
) ());
253 /* Filename completion on VMS ignores case, since VMS filesys does. */
254 specbind (Qcompletion_ignore_case
, Qt
);
258 readfunc
= readdirver
;
259 file
= Fupcase (file
);
261 CHECK_STRING (file
, 0);
264 dirname
= Fexpand_file_name (dirname
, Qnil
);
267 /* With passcount = 0, ignore files that end in an ignored extension.
268 If nothing found then try again with passcount = 1, don't ignore them.
269 If looking for all completions, start with passcount = 1,
270 so always take even the ignored ones.
272 ** It would not actually be helpful to the user to ignore any possible
273 completions when making a list of them.** */
275 for (passcount
= !!all_flag
; NILP (bestmatch
) && passcount
< 2; passcount
++)
277 if (!(d
= opendir (XSTRING (Fdirectory_file_name (dirname
))->data
)))
278 report_file_error ("Opening directory", Fcons (dirname
, Qnil
));
280 /* Loop reading blocks */
281 /* (att3b compiler bug requires do a null comparison this way) */
288 dp
= (*readfunc
) (d
);
296 if (!NILP (Vquit_flag
) && NILP (Vinhibit_quit
))
299 || len
< XSTRING (file
)->size
300 || 0 <= scmp (dp
->d_name
, XSTRING (file
)->data
,
301 XSTRING (file
)->size
))
304 if (file_name_completion_stat (dirname
, dp
, &st
) < 0)
307 directoryp
= ((st
.st_mode
& S_IFMT
) == S_IFDIR
);
311 /* Compare extensions-to-be-ignored against end of this file name */
312 /* if name is not an exact match against specified string */
313 if (!passcount
&& len
> XSTRING (file
)->size
)
314 /* and exit this for loop if a match is found */
315 for (tem
= Vcompletion_ignored_extensions
;
316 CONSP (tem
); tem
= XCONS (tem
)->cdr
)
318 elt
= XCONS (tem
)->car
;
319 if (XTYPE (elt
) != Lisp_String
) continue;
320 skip
= len
- XSTRING (elt
)->size
;
321 if (skip
< 0) continue;
323 if (0 <= scmp (dp
->d_name
+ skip
,
325 XSTRING (elt
)->size
))
331 /* Unless an ignored-extensions match was found,
332 process this name as a completion */
333 if (passcount
|| !CONSP (tem
))
335 /* Update computation of how much all possible completions match */
339 if (all_flag
|| NILP (bestmatch
))
341 /* This is a possible completion */
344 /* This completion is a directory; make it end with '/' */
345 name
= Ffile_name_as_directory (make_string (dp
->d_name
, len
));
348 name
= make_string (dp
->d_name
, len
);
351 bestmatch
= Fcons (name
, bestmatch
);
356 bestmatchsize
= XSTRING (name
)->size
;
361 compare
= min (bestmatchsize
, len
);
362 p1
= XSTRING (bestmatch
)->data
;
363 p2
= (unsigned char *) dp
->d_name
;
364 matchsize
= scmp(p1
, p2
, compare
);
367 /* If this dirname all matches,
368 see if implicit following slash does too. */
370 && compare
== matchsize
371 && bestmatchsize
> matchsize
372 && p1
[matchsize
] == '/')
374 bestmatchsize
= min (matchsize
, bestmatchsize
);
381 unbind_to (count
, Qnil
);
383 if (all_flag
|| NILP (bestmatch
))
385 if (matchcount
== 1 && bestmatchsize
== XSTRING (file
)->size
)
387 return Fsubstring (bestmatch
, make_number (0), make_number (bestmatchsize
));
391 return Fsignal (Qquit
, Qnil
);
394 file_name_completion_stat (dirname
, dp
, st_addr
)
397 struct stat
*st_addr
;
399 int len
= NAMLEN (dp
);
400 int pos
= XSTRING (dirname
)->size
;
401 char *fullname
= (char *) alloca (len
+ pos
+ 2);
403 bcopy (XSTRING (dirname
)->data
, fullname
, pos
);
405 if (fullname
[pos
- 1] != '/')
406 fullname
[pos
++] = '/';
409 bcopy (dp
->d_name
, fullname
+ pos
, len
);
410 fullname
[pos
+ len
] = 0;
412 return stat (fullname
, st_addr
);
419 return Fcons (make_number (time
>> 16),
420 Fcons (make_number (time
& 0177777), Qnil
));
423 DEFUN ("file-attributes", Ffile_attributes
, Sfile_attributes
, 1, 1, 0,
424 "Return a list of attributes of file FILENAME.\n\
425 Value is nil if specified file cannot be opened.\n\
426 Otherwise, list elements are:\n\
427 0. t for directory, string (name linked to) for symbolic link, or nil.\n\
428 1. Number of links to file.\n\
431 4. Last access time, as a list of two integers.\n\
432 First integer has high-order 16 bits of time, second has low 16 bits.\n\
433 5. Last modification time, likewise.\n\
434 6. Last status change time, likewise.\n\
436 8. File modes, as a string of ten letters or dashes as in ls -l.\n\
437 9. t iff file's gid would change if file were deleted and recreated.\n\
439 11. Device number.\n\
441 If file does not exists, returns nil.")
443 Lisp_Object filename
;
445 Lisp_Object values
[12];
452 filename
= Fexpand_file_name (filename
, Qnil
);
454 /* If the file name has special constructs in it,
455 call the corresponding file handler. */
456 handler
= find_file_handler (filename
);
458 return call2 (handler
, Qfile_attributes
, filename
);
460 if (lstat (XSTRING (filename
)->data
, &s
) < 0)
463 switch (s
.st_mode
& S_IFMT
)
466 values
[0] = Qnil
; break;
468 values
[0] = Qt
; break;
471 values
[0] = Ffile_symlink_p (filename
); break;
474 values
[1] = make_number (s
.st_nlink
);
475 values
[2] = make_number (s
.st_uid
);
476 values
[3] = make_number (s
.st_gid
);
477 values
[4] = make_time (s
.st_atime
);
478 values
[5] = make_time (s
.st_mtime
);
479 values
[6] = make_time (s
.st_ctime
);
480 /* perhaps we should set this to most-positive-fixnum if it is too large? */
481 values
[7] = make_number (s
.st_size
);
482 filemodestring (&s
, modes
);
483 values
[8] = make_string (modes
, 10);
484 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
485 #define BSD4_2 /* A new meaning to the term `backwards compatability' */
487 #ifdef BSD4_2 /* file gid will be dir gid */
488 dirname
= Ffile_name_directory (filename
);
489 if (dirname
!= Qnil
&& stat (XSTRING (dirname
)->data
, &sdir
) == 0)
490 values
[9] = (sdir
.st_gid
!= s
.st_gid
) ? Qt
: Qnil
;
491 else /* if we can't tell, assume worst */
493 #else /* file gid will be egid */
494 values
[9] = (s
.st_gid
!= getegid ()) ? Qt
: Qnil
;
495 #endif /* BSD4_2 (or BSD4_3) */
497 #undef BSD4_2 /* ok, you can look again without throwing up */
499 values
[10] = make_number (s
.st_ino
);
500 values
[11] = make_number (s
.st_dev
);
501 return Flist (sizeof(values
) / sizeof(values
[0]), values
);
506 Qdirectory_files
= intern ("directory-files");
507 Qfile_name_completion
= intern ("file-name-completion");
508 Qfile_name_all_completions
= intern ("file-name-all-completions");
509 Qfile_attributes
= intern ("file-attributes");
511 defsubr (&Sdirectory_files
);
512 defsubr (&Sfile_name_completion
);
514 defsubr (&Sfile_name_all_versions
);
516 defsubr (&Sfile_name_all_completions
);
517 defsubr (&Sfile_attributes
);
520 Qcompletion_ignore_case
= intern ("completion-ignore-case");
521 staticpro (&Qcompletion_ignore_case
);
524 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions
,
525 "*Completion ignores filenames ending in any string in this list.\n\
526 This variable does not affect lists of possible completions,\n\
527 but does affect the commands that actually do completions.");
528 Vcompletion_ignored_extensions
= Qnil
;