Docstring typo.
[emacs.git] / src / dired.c
blob54f96ba82f1f96a6fd26d67df7b3fd1f35847b3d
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
23 #include <config.h>
25 #include <stdio.h>
26 #include <sys/types.h>
27 #include <sys/stat.h>
29 #include "systime.h"
30 #include <errno.h>
32 #ifdef VMS
33 #include <string.h>
34 #include <rms.h>
35 #include <rmsdef.h>
36 #endif
38 #ifdef HAVE_UNISTD_H
39 #include <unistd.h>
40 #endif
42 /* The d_nameln member of a struct dirent includes the '\0' character
43 on some systems, but not on others. What's worse, you can't tell
44 at compile-time which one it will be, since it really depends on
45 the sort of system providing the filesystem you're reading from,
46 not the system you are running on. Paul Eggert
47 <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
48 SunOS 4.1.2 host, reading a directory that is remote-mounted from a
49 Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
51 Since applying strlen to the name always works, we'll just do that. */
52 #define NAMLEN(p) strlen (p->d_name)
54 #ifdef SYSV_SYSTEM_DIR
56 #include <dirent.h>
57 #define DIRENTRY struct dirent
59 #else /* not SYSV_SYSTEM_DIR */
61 #ifdef NONSYSTEM_DIR_LIBRARY
62 #include "ndir.h"
63 #else /* not NONSYSTEM_DIR_LIBRARY */
64 #ifdef MSDOS
65 #include <dirent.h>
66 #else
67 #include <sys/dir.h>
68 #endif
69 #endif /* not NONSYSTEM_DIR_LIBRARY */
71 #include <sys/stat.h>
73 #ifndef MSDOS
74 #define DIRENTRY struct direct
76 extern DIR *opendir ();
77 extern struct direct *readdir ();
79 #endif /* not MSDOS */
80 #endif /* not SYSV_SYSTEM_DIR */
82 #ifdef MSDOS
83 #define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
84 #else
85 #define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
86 #endif
88 #include "lisp.h"
89 #include "buffer.h"
90 #include "commands.h"
91 #include "charset.h"
92 #include "coding.h"
93 #include "regex.h"
95 /* Returns a search buffer, with a fastmap allocated and ready to go. */
96 extern struct re_pattern_buffer *compile_pattern ();
98 /* From filemode.c. Can't go in Lisp.h because of `stat'. */
99 extern void filemodestring P_ ((struct stat *, char *));
101 /* if system does not have symbolic links, it does not have lstat.
102 In that case, use ordinary stat instead. */
104 #ifndef S_IFLNK
105 #define lstat stat
106 #endif
108 extern int completion_ignore_case;
109 extern Lisp_Object Vcompletion_regexp_list;
110 extern Lisp_Object Vfile_name_coding_system, Vdefault_file_name_coding_system;
112 Lisp_Object Vcompletion_ignored_extensions;
113 Lisp_Object Qcompletion_ignore_case;
114 Lisp_Object Qdirectory_files;
115 Lisp_Object Qdirectory_files_and_attributes;
116 Lisp_Object Qfile_name_completion;
117 Lisp_Object Qfile_name_all_completions;
118 Lisp_Object Qfile_attributes;
119 Lisp_Object Qfile_attributes_lessp;
121 static int scmp P_ ((unsigned char *, unsigned char *, int));
124 Lisp_Object
125 directory_files_internal_unwind (dh)
126 Lisp_Object dh;
128 DIR *d = (DIR *) ((XINT (XCAR (dh)) << 16) + XINT (XCDR (dh)));
129 closedir (d);
130 return Qnil;
133 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
134 When ATTRS is zero, return a list of directory filenames; when
135 non-zero, return a list of directory filenames and their attributes. */
137 Lisp_Object
138 directory_files_internal (directory, full, match, nosort, attrs)
139 Lisp_Object directory, full, match, nosort;
140 int attrs;
142 DIR *d;
143 int directory_nbytes;
144 Lisp_Object list, dirfilename, encoded_directory;
145 struct re_pattern_buffer *bufp = NULL;
146 int needsep = 0;
147 int count = SPECPDL_INDEX ();
148 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
149 DIRENTRY *dp;
150 int retry_p;
152 /* Because of file name handlers, these functions might call
153 Ffuncall, and cause a GC. */
154 list = encoded_directory = dirfilename = Qnil;
155 GCPRO5 (match, directory, list, dirfilename, encoded_directory);
156 directory = Fexpand_file_name (directory, Qnil);
157 dirfilename = Fdirectory_file_name (directory);
159 if (!NILP (match))
161 CHECK_STRING (match);
163 /* MATCH might be a flawed regular expression. Rather than
164 catching and signaling our own errors, we just call
165 compile_pattern to do the work for us. */
166 /* Pass 1 for the MULTIBYTE arg
167 because we do make multibyte strings if the contents warrant. */
168 #ifdef VMS
169 bufp = compile_pattern (match, 0,
170 buffer_defaults.downcase_table, 0, 1);
171 #else
172 bufp = compile_pattern (match, 0, Qnil, 0, 1);
173 #endif
176 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
177 run_pre_post_conversion_on_str which calls Lisp directly and
178 indirectly. */
179 dirfilename = ENCODE_FILE (dirfilename);
180 encoded_directory = ENCODE_FILE (directory);
182 /* Now *bufp is the compiled form of MATCH; don't call anything
183 which might compile a new regexp until we're done with the loop! */
185 /* Do this opendir after anything which might signal an error; if
186 an error is signaled while the directory stream is open, we
187 have to make sure it gets closed, and setting up an
188 unwind_protect to do so would be a pain. */
189 retry:
191 d = opendir (SDATA (dirfilename));
192 if (d == NULL)
193 report_file_error ("Opening directory", Fcons (directory, Qnil));
195 /* Unfortunately, we can now invoke expand-file-name and
196 file-attributes on filenames, both of which can throw, so we must
197 do a proper unwind-protect. */
198 record_unwind_protect (directory_files_internal_unwind,
199 Fcons (make_number (((unsigned long) d) >> 16),
200 make_number (((unsigned long) d) & 0xffff)));
202 directory_nbytes = SBYTES (directory);
203 re_match_object = Qt;
205 /* Decide whether we need to add a directory separator. */
206 #ifndef VMS
207 if (directory_nbytes == 0
208 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
209 needsep = 1;
210 #endif /* not VMS */
212 /* Loop reading blocks until EOF or error. */
213 for (;;)
215 errno = 0;
216 dp = readdir (d);
218 #ifdef EAGAIN
219 if (dp == NULL && errno == EAGAIN)
220 continue;
221 #endif
223 if (dp == NULL)
224 break;
226 if (DIRENTRY_NONEMPTY (dp))
228 int len;
229 int wanted = 0;
230 Lisp_Object name, finalname;
231 struct gcpro gcpro1, gcpro2;
233 len = NAMLEN (dp);
234 name = finalname = make_unibyte_string (dp->d_name, len);
235 GCPRO2 (finalname, name);
237 /* Note: ENCODE_FILE can GC; it should protect its argument,
238 though. */
239 name = DECODE_FILE (name);
240 len = SBYTES (name);
242 /* Now that we have unwind_protect in place, we might as well
243 allow matching to be interrupted. */
244 immediate_quit = 1;
245 QUIT;
247 if (NILP (match)
248 || (0 <= re_search (bufp, SDATA (name), len, 0, len, 0)))
249 wanted = 1;
251 immediate_quit = 0;
253 if (wanted)
255 if (!NILP (full))
257 Lisp_Object fullname;
258 int nbytes = len + directory_nbytes + needsep;
259 int nchars;
261 fullname = make_uninit_multibyte_string (nbytes, nbytes);
262 bcopy (SDATA (directory), SDATA (fullname),
263 directory_nbytes);
265 if (needsep)
266 SSET (fullname, directory_nbytes, DIRECTORY_SEP);
268 bcopy (SDATA (name),
269 SDATA (fullname) + directory_nbytes + needsep,
270 len);
272 nchars = chars_in_text (SDATA (fullname), nbytes);
274 /* Some bug somewhere. */
275 if (nchars > nbytes)
276 abort ();
278 STRING_SET_CHARS (fullname, nchars);
279 if (nchars == nbytes)
280 STRING_SET_UNIBYTE (fullname);
282 finalname = fullname;
284 else
285 finalname = name;
287 if (attrs)
289 /* Construct an expanded filename for the directory entry.
290 Use the decoded names for input to Ffile_attributes. */
291 Lisp_Object decoded_fullname, fileattrs;
292 struct gcpro gcpro1, gcpro2;
294 decoded_fullname = fileattrs = Qnil;
295 GCPRO2 (decoded_fullname, fileattrs);
297 /* Both Fexpand_file_name and Ffile_attributes can GC. */
298 decoded_fullname = Fexpand_file_name (name, directory);
299 fileattrs = Ffile_attributes (decoded_fullname);
301 list = Fcons (Fcons (finalname, fileattrs), list);
302 UNGCPRO;
304 else
305 list = Fcons (finalname, list);
308 UNGCPRO;
312 retry_p = 0;
313 #ifdef EINTR
314 retry_p |= errno == EINTR;
315 #endif
317 closedir (d);
319 /* Discard the unwind protect. */
320 specpdl_ptr = specpdl + count;
322 if (retry_p)
324 list = Qnil;
325 goto retry;
328 if (NILP (nosort))
329 list = Fsort (Fnreverse (list),
330 attrs ? Qfile_attributes_lessp : Qstring_lessp);
332 RETURN_UNGCPRO (list);
336 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
337 doc: /* Return a list of names of files in DIRECTORY.
338 There are three optional arguments:
339 If FULL is non-nil, return absolute file names. Otherwise return names
340 that are relative to the specified directory.
341 If MATCH is non-nil, mention only file names that match the regexp MATCH.
342 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
343 NOSORT is useful if you plan to sort the result yourself. */)
344 (directory, full, match, nosort)
345 Lisp_Object directory, full, match, nosort;
347 Lisp_Object handler;
349 /* If the file name has special constructs in it,
350 call the corresponding file handler. */
351 handler = Ffind_file_name_handler (directory, Qdirectory_files);
352 if (!NILP (handler))
354 Lisp_Object args[6];
356 args[0] = handler;
357 args[1] = Qdirectory_files;
358 args[2] = directory;
359 args[3] = full;
360 args[4] = match;
361 args[5] = nosort;
362 return Ffuncall (6, args);
365 return directory_files_internal (directory, full, match, nosort, 0);
368 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
369 Sdirectory_files_and_attributes, 1, 4, 0,
370 doc: /* Return a list of names of files and their attributes in DIRECTORY.
371 There are three optional arguments:
372 If FULL is non-nil, return absolute file names. Otherwise return names
373 that are relative to the specified directory.
374 If MATCH is non-nil, mention only file names that match the regexp MATCH.
375 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
376 NOSORT is useful if you plan to sort the result yourself. */)
377 (directory, full, match, nosort)
378 Lisp_Object directory, full, match, nosort;
380 Lisp_Object handler;
382 /* If the file name has special constructs in it,
383 call the corresponding file handler. */
384 handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
385 if (!NILP (handler))
387 Lisp_Object args[6];
389 args[0] = handler;
390 args[1] = Qdirectory_files_and_attributes;
391 args[2] = directory;
392 args[3] = full;
393 args[4] = match;
394 args[5] = nosort;
395 return Ffuncall (6, args);
398 return directory_files_internal (directory, full, match, nosort, 1);
402 Lisp_Object file_name_completion ();
404 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
405 2, 2, 0,
406 doc: /* Complete file name FILE in directory DIRECTORY.
407 Returns the longest string
408 common to all file names in DIRECTORY that start with FILE.
409 If there is only one and FILE matches it exactly, returns t.
410 Returns nil if DIR contains no name starting with FILE.
412 This function ignores some of the possible completions as
413 determined by the variable `completion-ignored-extensions', which see. */)
414 (file, directory)
415 Lisp_Object file, directory;
417 Lisp_Object handler;
419 /* If the directory name has special constructs in it,
420 call the corresponding file handler. */
421 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
422 if (!NILP (handler))
423 return call3 (handler, Qfile_name_completion, file, directory);
425 /* If the file name has special constructs in it,
426 call the corresponding file handler. */
427 handler = Ffind_file_name_handler (file, Qfile_name_completion);
428 if (!NILP (handler))
429 return call3 (handler, Qfile_name_completion, file, directory);
431 return file_name_completion (file, directory, 0, 0);
434 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
435 Sfile_name_all_completions, 2, 2, 0,
436 doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
437 These are all file names in directory DIRECTORY which begin with FILE. */)
438 (file, directory)
439 Lisp_Object file, directory;
441 Lisp_Object handler;
443 /* If the directory name has special constructs in it,
444 call the corresponding file handler. */
445 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
446 if (!NILP (handler))
447 return call3 (handler, Qfile_name_all_completions, file, directory);
449 /* If the file name has special constructs in it,
450 call the corresponding file handler. */
451 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
452 if (!NILP (handler))
453 return call3 (handler, Qfile_name_all_completions, file, directory);
455 return file_name_completion (file, directory, 1, 0);
458 static int file_name_completion_stat ();
460 Lisp_Object
461 file_name_completion (file, dirname, all_flag, ver_flag)
462 Lisp_Object file, dirname;
463 int all_flag, ver_flag;
465 DIR *d;
466 int bestmatchsize = 0, skip;
467 register int compare, matchsize;
468 unsigned char *p1, *p2;
469 int matchcount = 0;
470 Lisp_Object bestmatch, tem, elt, name;
471 Lisp_Object encoded_file;
472 Lisp_Object encoded_dir;
473 struct stat st;
474 int directoryp;
475 int passcount;
476 int count = SPECPDL_INDEX ();
477 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
479 elt = Qnil;
481 #ifdef VMS
482 extern DIRENTRY * readdirver ();
484 DIRENTRY *((* readfunc) ());
486 /* Filename completion on VMS ignores case, since VMS filesys does. */
487 specbind (Qcompletion_ignore_case, Qt);
489 readfunc = readdir;
490 if (ver_flag)
491 readfunc = readdirver;
492 file = Fupcase (file);
493 #else /* not VMS */
494 CHECK_STRING (file);
495 #endif /* not VMS */
497 #ifdef FILE_SYSTEM_CASE
498 file = FILE_SYSTEM_CASE (file);
499 #endif
500 bestmatch = Qnil;
501 encoded_file = encoded_dir = Qnil;
502 GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
503 dirname = Fexpand_file_name (dirname, Qnil);
505 /* Do completion on the encoded file name
506 because the other names in the directory are (we presume)
507 encoded likewise. We decode the completed string at the end. */
508 encoded_file = ENCODE_FILE (file);
510 encoded_dir = ENCODE_FILE (dirname);
512 /* With passcount = 0, ignore files that end in an ignored extension.
513 If nothing found then try again with passcount = 1, don't ignore them.
514 If looking for all completions, start with passcount = 1,
515 so always take even the ignored ones.
517 ** It would not actually be helpful to the user to ignore any possible
518 completions when making a list of them.** */
520 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
522 int inner_count = SPECPDL_INDEX ();
524 d = opendir (SDATA (Fdirectory_file_name (encoded_dir)));
525 if (!d)
526 report_file_error ("Opening directory", Fcons (dirname, Qnil));
528 record_unwind_protect (directory_files_internal_unwind,
529 Fcons (make_number (((unsigned long) d) >> 16),
530 make_number (((unsigned long) d) & 0xffff)));
532 /* Loop reading blocks */
533 /* (att3b compiler bug requires do a null comparison this way) */
534 while (1)
536 DIRENTRY *dp;
537 int len;
539 #ifdef VMS
540 dp = (*readfunc) (d);
541 #else
542 dp = readdir (d);
543 #endif
544 if (!dp) break;
546 len = NAMLEN (dp);
548 QUIT;
549 if (! DIRENTRY_NONEMPTY (dp)
550 || len < SCHARS (encoded_file)
551 || 0 <= scmp (dp->d_name, SDATA (encoded_file),
552 SCHARS (encoded_file)))
553 continue;
555 if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
556 continue;
558 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
559 tem = Qnil;
560 if (directoryp)
562 #ifndef TRIVIAL_DIRECTORY_ENTRY
563 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
564 #endif
565 /* "." and ".." are never interesting as completions, but are
566 actually in the way in a directory contains only one file. */
567 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
568 continue;
569 if (!passcount && len > SCHARS (encoded_file))
570 /* Ignore directories if they match an element of
571 completion-ignored-extensions which ends in a slash. */
572 for (tem = Vcompletion_ignored_extensions;
573 CONSP (tem); tem = XCDR (tem))
575 int elt_len;
577 elt = XCAR (tem);
578 if (!STRINGP (elt))
579 continue;
580 /* Need to encode ELT, since scmp compares unibyte
581 strings only. */
582 elt = ENCODE_FILE (elt);
583 elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
584 if (elt_len <= 0)
585 continue;
586 p1 = SDATA (elt);
587 if (p1[elt_len] != '/')
588 continue;
589 skip = len - elt_len;
590 if (skip < 0)
591 continue;
593 if (0 <= scmp (dp->d_name + skip, p1, elt_len))
594 continue;
595 break;
598 else
600 /* Compare extensions-to-be-ignored against end of this file name */
601 /* if name is not an exact match against specified string */
602 if (!passcount && len > SCHARS (encoded_file))
603 /* and exit this for loop if a match is found */
604 for (tem = Vcompletion_ignored_extensions;
605 CONSP (tem); tem = XCDR (tem))
607 elt = XCAR (tem);
608 if (!STRINGP (elt)) continue;
609 /* Need to encode ELT, since scmp compares unibyte
610 strings only. */
611 elt = ENCODE_FILE (elt);
612 skip = len - SCHARS (elt);
613 if (skip < 0) continue;
615 if (0 <= scmp (dp->d_name + skip,
616 SDATA (elt),
617 SCHARS (elt)))
618 continue;
619 break;
623 /* If an ignored-extensions match was found,
624 don't process this name as a completion. */
625 if (!passcount && CONSP (tem))
626 continue;
628 if (!passcount)
630 Lisp_Object regexps;
631 Lisp_Object zero;
632 XSETFASTINT (zero, 0);
634 /* Ignore this element if it fails to match all the regexps. */
635 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
636 regexps = XCDR (regexps))
638 tem = Fstring_match (XCAR (regexps),
639 make_string (dp->d_name, len), zero);
640 if (NILP (tem))
641 break;
643 if (CONSP (regexps))
644 continue;
647 /* Update computation of how much all possible completions match */
649 matchcount++;
651 if (all_flag || NILP (bestmatch))
653 /* This is a possible completion */
654 if (directoryp)
656 /* This completion is a directory; make it end with '/' */
657 name = Ffile_name_as_directory (make_string (dp->d_name, len));
659 else
660 name = make_string (dp->d_name, len);
661 if (all_flag)
663 name = DECODE_FILE (name);
664 bestmatch = Fcons (name, bestmatch);
666 else
668 bestmatch = name;
669 bestmatchsize = SCHARS (name);
672 else
674 compare = min (bestmatchsize, len);
675 p1 = SDATA (bestmatch);
676 p2 = (unsigned char *) dp->d_name;
677 matchsize = scmp(p1, p2, compare);
678 if (matchsize < 0)
679 matchsize = compare;
680 if (completion_ignore_case)
682 /* If this is an exact match except for case,
683 use it as the best match rather than one that is not
684 an exact match. This way, we get the case pattern
685 of the actual match. */
686 /* This tests that the current file is an exact match
687 but BESTMATCH is not (it is too long). */
688 if ((matchsize == len
689 && matchsize + !!directoryp
690 < SCHARS (bestmatch))
692 /* If there is no exact match ignoring case,
693 prefer a match that does not change the case
694 of the input. */
695 /* If there is more than one exact match aside from
696 case, and one of them is exact including case,
697 prefer that one. */
698 /* This == checks that, of current file and BESTMATCH,
699 either both or neither are exact. */
700 (((matchsize == len)
702 (matchsize + !!directoryp
703 == SCHARS (bestmatch)))
704 && !bcmp (p2, SDATA (encoded_file), SCHARS (encoded_file))
705 && bcmp (p1, SDATA (encoded_file), SCHARS (encoded_file))))
707 bestmatch = make_string (dp->d_name, len);
708 if (directoryp)
709 bestmatch = Ffile_name_as_directory (bestmatch);
713 /* If this dirname all matches, see if implicit following
714 slash does too. */
715 if (directoryp
716 && compare == matchsize
717 && bestmatchsize > matchsize
718 && IS_ANY_SEP (p1[matchsize]))
719 matchsize++;
720 bestmatchsize = matchsize;
723 /* This closes the directory. */
724 bestmatch = unbind_to (inner_count, bestmatch);
727 UNGCPRO;
728 bestmatch = unbind_to (count, bestmatch);
730 if (all_flag || NILP (bestmatch))
732 if (STRINGP (bestmatch))
733 bestmatch = DECODE_FILE (bestmatch);
734 return bestmatch;
736 if (matchcount == 1 && bestmatchsize == SCHARS (file))
737 return Qt;
738 bestmatch = Fsubstring (bestmatch, make_number (0),
739 make_number (bestmatchsize));
740 /* Now that we got the right initial segment of BESTMATCH,
741 decode it from the coding system in use. */
742 bestmatch = DECODE_FILE (bestmatch);
743 return bestmatch;
746 /* Compare exactly LEN chars of strings at S1 and S2,
747 ignoring case if appropriate.
748 Return -1 if strings match,
749 else number of chars that match at the beginning. */
751 static int
752 scmp (s1, s2, len)
753 register unsigned char *s1, *s2;
754 int len;
756 register int l = len;
758 if (completion_ignore_case)
760 while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++))
761 l--;
763 else
765 while (l && *s1++ == *s2++)
766 l--;
768 if (l == 0)
769 return -1;
770 else
771 return len - l;
774 static int
775 file_name_completion_stat (dirname, dp, st_addr)
776 Lisp_Object dirname;
777 DIRENTRY *dp;
778 struct stat *st_addr;
780 int len = NAMLEN (dp);
781 int pos = SCHARS (dirname);
782 int value;
783 char *fullname = (char *) alloca (len + pos + 2);
785 #ifdef MSDOS
786 #if __DJGPP__ > 1
787 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
788 but aren't required here. Avoid computing the following fields:
789 st_inode, st_size and st_nlink for directories, and the execute bits
790 in st_mode for non-directory files with non-standard extensions. */
792 unsigned short save_djstat_flags = _djstat_flags;
794 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
795 #endif /* __DJGPP__ > 1 */
796 #endif /* MSDOS */
798 bcopy (SDATA (dirname), fullname, pos);
799 #ifndef VMS
800 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
801 fullname[pos++] = DIRECTORY_SEP;
802 #endif
804 bcopy (dp->d_name, fullname + pos, len);
805 fullname[pos + len] = 0;
807 #ifdef S_IFLNK
808 /* We want to return success if a link points to a nonexistent file,
809 but we want to return the status for what the link points to,
810 in case it is a directory. */
811 value = lstat (fullname, st_addr);
812 stat (fullname, st_addr);
813 return value;
814 #else
815 value = stat (fullname, st_addr);
816 #ifdef MSDOS
817 #if __DJGPP__ > 1
818 _djstat_flags = save_djstat_flags;
819 #endif /* __DJGPP__ > 1 */
820 #endif /* MSDOS */
821 return value;
822 #endif /* S_IFLNK */
825 #ifdef VMS
827 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
828 Sfile_name_all_versions, 2, 2, 0,
829 doc: /* Return a list of all versions of file name FILE in directory DIRECTORY. */)
830 (file, directory)
831 Lisp_Object file, directory;
833 return file_name_completion (file, directory, 1, 1);
836 DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
837 doc: /* Return the maximum number of versions allowed for FILE.
838 Returns nil if the file cannot be opened or if there is no version limit. */)
839 (filename)
840 Lisp_Object filename;
842 Lisp_Object retval;
843 struct FAB fab;
844 struct RAB rab;
845 struct XABFHC xabfhc;
846 int status;
848 filename = Fexpand_file_name (filename, Qnil);
849 fab = cc$rms_fab;
850 xabfhc = cc$rms_xabfhc;
851 fab.fab$l_fna = SDATA (filename);
852 fab.fab$b_fns = strlen (fab.fab$l_fna);
853 fab.fab$l_xab = (char *) &xabfhc;
854 status = sys$open (&fab, 0, 0);
855 if (status != RMS$_NORMAL) /* Probably non-existent file */
856 return Qnil;
857 sys$close (&fab, 0, 0);
858 if (xabfhc.xab$w_verlimit == 32767)
859 return Qnil; /* No version limit */
860 else
861 return make_number (xabfhc.xab$w_verlimit);
864 #endif /* VMS */
866 Lisp_Object
867 make_time (time)
868 time_t time;
870 return Fcons (make_number (time >> 16),
871 Fcons (make_number (time & 0177777), Qnil));
874 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
875 doc: /* Return a list of attributes of file FILENAME.
876 Value is nil if specified file cannot be opened.
877 Otherwise, list elements are:
878 0. t for directory, string (name linked to) for symbolic link, or nil.
879 1. Number of links to file.
880 2. File uid.
881 3. File gid.
882 4. Last access time, as a list of two integers.
883 First integer has high-order 16 bits of time, second has low 16 bits.
884 5. Last modification time, likewise.
885 6. Last status change time, likewise.
886 7. Size in bytes.
887 This is a floating point number if the size is too large for an integer.
888 8. File modes, as a string of ten letters or dashes as in ls -l.
889 9. t iff file's gid would change if file were deleted and recreated.
890 10. inode number. If inode number is larger than the Emacs integer,
891 this is a cons cell containing two integers: first the high part,
892 then the low 16 bits.
893 11. Device number. If it is larger than the Emacs integer, this is
894 a cons cell, similar to the inode number.
896 If file does not exist, returns nil. */)
897 (filename)
898 Lisp_Object filename;
900 Lisp_Object values[12];
901 Lisp_Object encoded;
902 struct stat s;
903 #if defined (BSD4_2) || defined (BSD4_3)
904 Lisp_Object dirname;
905 struct stat sdir;
906 #endif
907 char modes[10];
908 Lisp_Object handler;
910 filename = Fexpand_file_name (filename, Qnil);
912 /* If the file name has special constructs in it,
913 call the corresponding file handler. */
914 handler = Ffind_file_name_handler (filename, Qfile_attributes);
915 if (!NILP (handler))
916 return call2 (handler, Qfile_attributes, filename);
918 encoded = ENCODE_FILE (filename);
920 if (lstat (SDATA (encoded), &s) < 0)
921 return Qnil;
923 switch (s.st_mode & S_IFMT)
925 default:
926 values[0] = Qnil; break;
927 case S_IFDIR:
928 values[0] = Qt; break;
929 #ifdef S_IFLNK
930 case S_IFLNK:
931 values[0] = Ffile_symlink_p (filename); break;
932 #endif
934 values[1] = make_number (s.st_nlink);
935 values[2] = make_number (s.st_uid);
936 values[3] = make_number (s.st_gid);
937 values[4] = make_time (s.st_atime);
938 values[5] = make_time (s.st_mtime);
939 values[6] = make_time (s.st_ctime);
940 values[7] = make_number (s.st_size);
941 /* If the size is out of range for an integer, return a float. */
942 if (XINT (values[7]) != s.st_size)
943 values[7] = make_float ((double)s.st_size);
944 /* If the size is negative, and its type is long, convert it back to
945 positive. */
946 if (s.st_size < 0 && sizeof (s.st_size) == sizeof (long))
947 values[7] = make_float ((double) ((unsigned long) s.st_size));
949 filemodestring (&s, modes);
950 values[8] = make_string (modes, 10);
951 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
952 dirname = Ffile_name_directory (filename);
953 if (! NILP (dirname))
954 encoded = ENCODE_FILE (dirname);
955 if (! NILP (dirname) && stat (SDATA (encoded), &sdir) == 0)
956 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
957 else /* if we can't tell, assume worst */
958 values[9] = Qt;
959 #else /* file gid will be egid */
960 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
961 #endif /* BSD4_2 (or BSD4_3) */
962 if (FIXNUM_OVERFLOW_P (s.st_ino))
963 /* To allow inode numbers larger than VALBITS, separate the bottom
964 16 bits. */
965 values[10] = Fcons (make_number (s.st_ino >> 16),
966 make_number (s.st_ino & 0xffff));
967 else
968 /* But keep the most common cases as integers. */
969 values[10] = make_number (s.st_ino);
971 /* Likewise for device. */
972 if (FIXNUM_OVERFLOW_P (s.st_dev))
973 values[11] = Fcons (make_number (s.st_dev >> 16),
974 make_number (s.st_dev & 0xffff));
975 else
976 values[11] = make_number (s.st_dev);
978 return Flist (sizeof(values) / sizeof(values[0]), values);
981 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
982 doc: /* Return t if first arg file attributes list is less than second.
983 Comparison is in lexicographic order and case is significant. */)
984 (f1, f2)
985 Lisp_Object f1, f2;
987 return Fstring_lessp (Fcar (f1), Fcar (f2));
990 void
991 syms_of_dired ()
993 Qdirectory_files = intern ("directory-files");
994 Qdirectory_files_and_attributes = intern ("directory-files-and-attributes");
995 Qfile_name_completion = intern ("file-name-completion");
996 Qfile_name_all_completions = intern ("file-name-all-completions");
997 Qfile_attributes = intern ("file-attributes");
998 Qfile_attributes_lessp = intern ("file-attributes-lessp");
1000 staticpro (&Qdirectory_files);
1001 staticpro (&Qdirectory_files_and_attributes);
1002 staticpro (&Qfile_name_completion);
1003 staticpro (&Qfile_name_all_completions);
1004 staticpro (&Qfile_attributes);
1005 staticpro (&Qfile_attributes_lessp);
1007 defsubr (&Sdirectory_files);
1008 defsubr (&Sdirectory_files_and_attributes);
1009 defsubr (&Sfile_name_completion);
1010 #ifdef VMS
1011 defsubr (&Sfile_name_all_versions);
1012 defsubr (&Sfile_version_limit);
1013 #endif /* VMS */
1014 defsubr (&Sfile_name_all_completions);
1015 defsubr (&Sfile_attributes);
1016 defsubr (&Sfile_attributes_lessp);
1018 #ifdef VMS
1019 Qcompletion_ignore_case = intern ("completion-ignore-case");
1020 staticpro (&Qcompletion_ignore_case);
1021 #endif /* VMS */
1023 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
1024 doc: /* *Completion ignores filenames ending in any string in this list.
1025 Directories are ignored if they match any string in this list which
1026 ends in a slash.
1027 This variable does not affect lists of possible completions,
1028 but does affect the commands that actually do completions. */);
1029 Vcompletion_ignored_extensions = Qnil;