*** empty log message ***
[emacs.git] / src / dired.c
blobe833ceb216bdce411cc3542678f53d09feca7f26
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001, 2004
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 #ifdef VMS
30 #include "vms-pwd.h"
31 #else
32 #include <pwd.h>
33 #include <grp.h>
34 #endif
36 #include "systime.h"
37 #include <errno.h>
39 #ifdef VMS
40 #include <string.h>
41 #include <rms.h>
42 #include <rmsdef.h>
43 #endif
45 #ifdef HAVE_UNISTD_H
46 #include <unistd.h>
47 #endif
49 /* The d_nameln member of a struct dirent includes the '\0' character
50 on some systems, but not on others. What's worse, you can't tell
51 at compile-time which one it will be, since it really depends on
52 the sort of system providing the filesystem you're reading from,
53 not the system you are running on. Paul Eggert
54 <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
55 SunOS 4.1.2 host, reading a directory that is remote-mounted from a
56 Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
58 Since applying strlen to the name always works, we'll just do that. */
59 #define NAMLEN(p) strlen (p->d_name)
61 #ifdef SYSV_SYSTEM_DIR
63 #include <dirent.h>
64 #define DIRENTRY struct dirent
66 #else /* not SYSV_SYSTEM_DIR */
68 #ifdef NONSYSTEM_DIR_LIBRARY
69 #include "ndir.h"
70 #else /* not NONSYSTEM_DIR_LIBRARY */
71 #ifdef MSDOS
72 #include <dirent.h>
73 #else
74 #include <sys/dir.h>
75 #endif
76 #endif /* not NONSYSTEM_DIR_LIBRARY */
78 #include <sys/stat.h>
80 #ifndef MSDOS
81 #define DIRENTRY struct direct
83 extern DIR *opendir ();
84 extern struct direct *readdir ();
86 #endif /* not MSDOS */
87 #endif /* not SYSV_SYSTEM_DIR */
89 #ifdef MSDOS
90 #define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
91 #else
92 #define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
93 #endif
95 #include "lisp.h"
96 #include "buffer.h"
97 #include "commands.h"
98 #include "charset.h"
99 #include "coding.h"
100 #include "regex.h"
102 /* Returns a search buffer, with a fastmap allocated and ready to go. */
103 extern struct re_pattern_buffer *compile_pattern ();
105 /* From filemode.c. Can't go in Lisp.h because of `stat'. */
106 extern void filemodestring P_ ((struct stat *, char *));
108 /* if system does not have symbolic links, it does not have lstat.
109 In that case, use ordinary stat instead. */
111 #ifndef S_IFLNK
112 #define lstat stat
113 #endif
115 extern int completion_ignore_case;
116 extern Lisp_Object Vcompletion_regexp_list;
117 extern Lisp_Object Vfile_name_coding_system, Vdefault_file_name_coding_system;
119 Lisp_Object Vcompletion_ignored_extensions;
120 Lisp_Object Qcompletion_ignore_case;
121 Lisp_Object Qdirectory_files;
122 Lisp_Object Qdirectory_files_and_attributes;
123 Lisp_Object Qfile_name_completion;
124 Lisp_Object Qfile_name_all_completions;
125 Lisp_Object Qfile_attributes;
126 Lisp_Object Qfile_attributes_lessp;
128 static int scmp P_ ((unsigned char *, unsigned char *, int));
131 Lisp_Object
132 directory_files_internal_unwind (dh)
133 Lisp_Object dh;
135 DIR *d = (DIR *) ((XINT (XCAR (dh)) << 16) + XINT (XCDR (dh)));
136 closedir (d);
137 return Qnil;
140 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
141 When ATTRS is zero, return a list of directory filenames; when
142 non-zero, return a list of directory filenames and their attributes.
143 In the latter case, ID_FORMAT is passed to Ffile_attributes. */
145 Lisp_Object
146 directory_files_internal (directory, full, match, nosort, attrs, id_format)
147 Lisp_Object directory, full, match, nosort;
148 int attrs;
149 Lisp_Object id_format;
151 DIR *d;
152 int directory_nbytes;
153 Lisp_Object list, dirfilename, encoded_directory;
154 struct re_pattern_buffer *bufp = NULL;
155 int needsep = 0;
156 int count = SPECPDL_INDEX ();
157 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
158 DIRENTRY *dp;
159 int retry_p;
161 /* Because of file name handlers, these functions might call
162 Ffuncall, and cause a GC. */
163 list = encoded_directory = dirfilename = Qnil;
164 GCPRO5 (match, directory, list, dirfilename, encoded_directory);
165 dirfilename = Fdirectory_file_name (directory);
167 if (!NILP (match))
169 CHECK_STRING (match);
171 /* MATCH might be a flawed regular expression. Rather than
172 catching and signaling our own errors, we just call
173 compile_pattern to do the work for us. */
174 /* Pass 1 for the MULTIBYTE arg
175 because we do make multibyte strings if the contents warrant. */
176 #ifdef VMS
177 bufp = compile_pattern (match, 0,
178 buffer_defaults.downcase_table, 0, 1);
179 #else
180 bufp = compile_pattern (match, 0, Qnil, 0, 1);
181 #endif
184 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
185 run_pre_post_conversion_on_str which calls Lisp directly and
186 indirectly. */
187 dirfilename = ENCODE_FILE (dirfilename);
188 encoded_directory = ENCODE_FILE (directory);
190 /* Now *bufp is the compiled form of MATCH; don't call anything
191 which might compile a new regexp until we're done with the loop! */
193 /* Do this opendir after anything which might signal an error; if
194 an error is signaled while the directory stream is open, we
195 have to make sure it gets closed, and setting up an
196 unwind_protect to do so would be a pain. */
197 retry:
199 d = opendir (SDATA (dirfilename));
200 if (d == NULL)
201 report_file_error ("Opening directory", Fcons (directory, Qnil));
203 /* Unfortunately, we can now invoke expand-file-name and
204 file-attributes on filenames, both of which can throw, so we must
205 do a proper unwind-protect. */
206 record_unwind_protect (directory_files_internal_unwind,
207 Fcons (make_number (((unsigned long) d) >> 16),
208 make_number (((unsigned long) d) & 0xffff)));
210 directory_nbytes = SBYTES (directory);
211 re_match_object = Qt;
213 /* Decide whether we need to add a directory separator. */
214 #ifndef VMS
215 if (directory_nbytes == 0
216 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
217 needsep = 1;
218 #endif /* not VMS */
220 /* Loop reading blocks until EOF or error. */
221 for (;;)
223 errno = 0;
224 dp = readdir (d);
226 #ifdef EAGAIN
227 if (dp == NULL && errno == EAGAIN)
228 continue;
229 #endif
231 if (dp == NULL)
232 break;
234 if (DIRENTRY_NONEMPTY (dp))
236 int len;
237 int wanted = 0;
238 Lisp_Object name, finalname;
239 struct gcpro gcpro1, gcpro2;
241 len = NAMLEN (dp);
242 name = finalname = make_unibyte_string (dp->d_name, len);
243 GCPRO2 (finalname, name);
245 /* Note: ENCODE_FILE can GC; it should protect its argument,
246 though. */
247 name = DECODE_FILE (name);
248 len = SBYTES (name);
250 /* Now that we have unwind_protect in place, we might as well
251 allow matching to be interrupted. */
252 immediate_quit = 1;
253 QUIT;
255 if (NILP (match)
256 || (0 <= re_search (bufp, SDATA (name), len, 0, len, 0)))
257 wanted = 1;
259 immediate_quit = 0;
261 if (wanted)
263 if (!NILP (full))
265 Lisp_Object fullname;
266 int nbytes = len + directory_nbytes + needsep;
267 int nchars;
269 fullname = make_uninit_multibyte_string (nbytes, nbytes);
270 bcopy (SDATA (directory), SDATA (fullname),
271 directory_nbytes);
273 if (needsep)
274 SSET (fullname, directory_nbytes, DIRECTORY_SEP);
276 bcopy (SDATA (name),
277 SDATA (fullname) + directory_nbytes + needsep,
278 len);
280 nchars = chars_in_text (SDATA (fullname), nbytes);
282 /* Some bug somewhere. */
283 if (nchars > nbytes)
284 abort ();
286 STRING_SET_CHARS (fullname, nchars);
287 if (nchars == nbytes)
288 STRING_SET_UNIBYTE (fullname);
290 finalname = fullname;
292 else
293 finalname = name;
295 if (attrs)
297 /* Construct an expanded filename for the directory entry.
298 Use the decoded names for input to Ffile_attributes. */
299 Lisp_Object decoded_fullname, fileattrs;
300 struct gcpro gcpro1, gcpro2;
302 decoded_fullname = fileattrs = Qnil;
303 GCPRO2 (decoded_fullname, fileattrs);
305 /* Both Fexpand_file_name and Ffile_attributes can GC. */
306 decoded_fullname = Fexpand_file_name (name, directory);
307 fileattrs = Ffile_attributes (decoded_fullname, id_format);
309 list = Fcons (Fcons (finalname, fileattrs), list);
310 UNGCPRO;
312 else
313 list = Fcons (finalname, list);
316 UNGCPRO;
320 retry_p = 0;
321 #ifdef EINTR
322 retry_p |= errno == EINTR;
323 #endif
325 closedir (d);
327 /* Discard the unwind protect. */
328 specpdl_ptr = specpdl + count;
330 if (retry_p)
332 list = Qnil;
333 goto retry;
336 if (NILP (nosort))
337 list = Fsort (Fnreverse (list),
338 attrs ? Qfile_attributes_lessp : Qstring_lessp);
340 RETURN_UNGCPRO (list);
344 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
345 doc: /* Return a list of names of files in DIRECTORY.
346 There are three optional arguments:
347 If FULL is non-nil, return absolute file names. Otherwise return names
348 that are relative to the specified directory.
349 If MATCH is non-nil, mention only file names that match the regexp MATCH.
350 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
351 NOSORT is useful if you plan to sort the result yourself. */)
352 (directory, full, match, nosort)
353 Lisp_Object directory, full, match, nosort;
355 Lisp_Object handler;
356 directory = Fexpand_file_name (directory, Qnil);
358 /* If the file name has special constructs in it,
359 call the corresponding file handler. */
360 handler = Ffind_file_name_handler (directory, Qdirectory_files);
361 if (!NILP (handler))
362 return call5 (handler, Qdirectory_files, directory,
363 full, match, nosort);
365 return directory_files_internal (directory, full, match, nosort, 0, Qnil);
368 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
369 Sdirectory_files_and_attributes, 1, 5, 0,
370 doc: /* Return a list of names of files and their attributes in DIRECTORY.
371 There are four 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 ID-FORMAT specifies the preferred format of attributes uid and gid, see
378 `file-attributes' for further documentation. */)
379 (directory, full, match, nosort, id_format)
380 Lisp_Object directory, full, match, nosort, id_format;
382 Lisp_Object handler;
383 directory = Fexpand_file_name (directory, Qnil);
385 /* If the file name has special constructs in it,
386 call the corresponding file handler. */
387 handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
388 if (!NILP (handler))
389 return call6 (handler, Qdirectory_files_and_attributes,
390 directory, full, match, nosort, id_format);
392 return directory_files_internal (directory, full, match, nosort, 1, id_format);
396 Lisp_Object file_name_completion ();
398 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
399 2, 2, 0,
400 doc: /* Complete file name FILE in directory DIRECTORY.
401 Returns the longest string
402 common to all file names in DIRECTORY that start with FILE.
403 If there is only one and FILE matches it exactly, returns t.
404 Returns nil if DIR contains no name starting with FILE.
406 This function ignores some of the possible completions as
407 determined by the variable `completion-ignored-extensions', which see. */)
408 (file, directory)
409 Lisp_Object file, directory;
411 Lisp_Object handler;
413 /* If the directory name has special constructs in it,
414 call the corresponding file handler. */
415 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
416 if (!NILP (handler))
417 return call3 (handler, Qfile_name_completion, file, directory);
419 /* If the file name has special constructs in it,
420 call the corresponding file handler. */
421 handler = Ffind_file_name_handler (file, Qfile_name_completion);
422 if (!NILP (handler))
423 return call3 (handler, Qfile_name_completion, file, directory);
425 return file_name_completion (file, directory, 0, 0);
428 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
429 Sfile_name_all_completions, 2, 2, 0,
430 doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
431 These are all file names in directory DIRECTORY which begin with FILE. */)
432 (file, directory)
433 Lisp_Object file, directory;
435 Lisp_Object handler;
437 /* If the directory name has special constructs in it,
438 call the corresponding file handler. */
439 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
440 if (!NILP (handler))
441 return call3 (handler, Qfile_name_all_completions, file, directory);
443 /* If the file name has special constructs in it,
444 call the corresponding file handler. */
445 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
446 if (!NILP (handler))
447 return call3 (handler, Qfile_name_all_completions, file, directory);
449 return file_name_completion (file, directory, 1, 0);
452 static int file_name_completion_stat ();
454 Lisp_Object
455 file_name_completion (file, dirname, all_flag, ver_flag)
456 Lisp_Object file, dirname;
457 int all_flag, ver_flag;
459 DIR *d;
460 int bestmatchsize = 0, skip;
461 register int compare, matchsize;
462 unsigned char *p1, *p2;
463 int matchcount = 0;
464 Lisp_Object bestmatch, tem, elt, name;
465 Lisp_Object encoded_file;
466 Lisp_Object encoded_dir;
467 struct stat st;
468 int directoryp;
469 int passcount;
470 int count = SPECPDL_INDEX ();
471 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
473 elt = Qnil;
475 #ifdef VMS
476 extern DIRENTRY * readdirver ();
478 DIRENTRY *((* readfunc) ());
480 /* Filename completion on VMS ignores case, since VMS filesys does. */
481 specbind (Qcompletion_ignore_case, Qt);
483 readfunc = readdir;
484 if (ver_flag)
485 readfunc = readdirver;
486 file = Fupcase (file);
487 #else /* not VMS */
488 CHECK_STRING (file);
489 #endif /* not VMS */
491 #ifdef FILE_SYSTEM_CASE
492 file = FILE_SYSTEM_CASE (file);
493 #endif
494 bestmatch = Qnil;
495 encoded_file = encoded_dir = Qnil;
496 GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
497 dirname = Fexpand_file_name (dirname, Qnil);
499 /* Do completion on the encoded file name
500 because the other names in the directory are (we presume)
501 encoded likewise. We decode the completed string at the end. */
502 encoded_file = ENCODE_FILE (file);
504 encoded_dir = ENCODE_FILE (dirname);
506 /* With passcount = 0, ignore files that end in an ignored extension.
507 If nothing found then try again with passcount = 1, don't ignore them.
508 If looking for all completions, start with passcount = 1,
509 so always take even the ignored ones.
511 ** It would not actually be helpful to the user to ignore any possible
512 completions when making a list of them.** */
514 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
516 int inner_count = SPECPDL_INDEX ();
518 d = opendir (SDATA (Fdirectory_file_name (encoded_dir)));
519 if (!d)
520 report_file_error ("Opening directory", Fcons (dirname, Qnil));
522 record_unwind_protect (directory_files_internal_unwind,
523 Fcons (make_number (((unsigned long) d) >> 16),
524 make_number (((unsigned long) d) & 0xffff)));
526 /* Loop reading blocks */
527 /* (att3b compiler bug requires do a null comparison this way) */
528 while (1)
530 DIRENTRY *dp;
531 int len;
533 #ifdef VMS
534 dp = (*readfunc) (d);
535 #else
536 dp = readdir (d);
537 #endif
538 if (!dp) break;
540 len = NAMLEN (dp);
542 QUIT;
543 if (! DIRENTRY_NONEMPTY (dp)
544 || len < SCHARS (encoded_file)
545 || 0 <= scmp (dp->d_name, SDATA (encoded_file),
546 SCHARS (encoded_file)))
547 continue;
549 if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
550 continue;
552 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
553 tem = Qnil;
554 if (directoryp)
556 #ifndef TRIVIAL_DIRECTORY_ENTRY
557 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
558 #endif
559 /* "." and ".." are never interesting as completions, but are
560 actually in the way in a directory contains only one file. */
561 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
562 continue;
563 if (!passcount && len > SCHARS (encoded_file))
564 /* Ignore directories if they match an element of
565 completion-ignored-extensions which ends in a slash. */
566 for (tem = Vcompletion_ignored_extensions;
567 CONSP (tem); tem = XCDR (tem))
569 int elt_len;
571 elt = XCAR (tem);
572 if (!STRINGP (elt))
573 continue;
574 /* Need to encode ELT, since scmp compares unibyte
575 strings only. */
576 elt = ENCODE_FILE (elt);
577 elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
578 if (elt_len <= 0)
579 continue;
580 p1 = SDATA (elt);
581 if (p1[elt_len] != '/')
582 continue;
583 skip = len - elt_len;
584 if (skip < 0)
585 continue;
587 if (0 <= scmp (dp->d_name + skip, p1, elt_len))
588 continue;
589 break;
592 else
594 /* Compare extensions-to-be-ignored against end of this file name */
595 /* if name is not an exact match against specified string */
596 if (!passcount && len > SCHARS (encoded_file))
597 /* and exit this for loop if a match is found */
598 for (tem = Vcompletion_ignored_extensions;
599 CONSP (tem); tem = XCDR (tem))
601 elt = XCAR (tem);
602 if (!STRINGP (elt)) continue;
603 /* Need to encode ELT, since scmp compares unibyte
604 strings only. */
605 elt = ENCODE_FILE (elt);
606 skip = len - SCHARS (elt);
607 if (skip < 0) continue;
609 if (0 <= scmp (dp->d_name + skip,
610 SDATA (elt),
611 SCHARS (elt)))
612 continue;
613 break;
617 /* If an ignored-extensions match was found,
618 don't process this name as a completion. */
619 if (!passcount && CONSP (tem))
620 continue;
622 if (!passcount)
624 Lisp_Object regexps;
625 Lisp_Object zero;
626 XSETFASTINT (zero, 0);
628 /* Ignore this element if it fails to match all the regexps. */
629 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
630 regexps = XCDR (regexps))
632 tem = Fstring_match (XCAR (regexps),
633 make_string (dp->d_name, len), zero);
634 if (NILP (tem))
635 break;
637 if (CONSP (regexps))
638 continue;
641 /* Update computation of how much all possible completions match */
643 matchcount++;
645 if (all_flag || NILP (bestmatch))
647 /* This is a possible completion */
648 if (directoryp)
650 /* This completion is a directory; make it end with '/' */
651 name = Ffile_name_as_directory (make_string (dp->d_name, len));
653 else
654 name = make_string (dp->d_name, len);
655 if (all_flag)
657 name = DECODE_FILE (name);
658 bestmatch = Fcons (name, bestmatch);
660 else
662 bestmatch = name;
663 bestmatchsize = SCHARS (name);
666 else
668 compare = min (bestmatchsize, len);
669 p1 = SDATA (bestmatch);
670 p2 = (unsigned char *) dp->d_name;
671 matchsize = scmp(p1, p2, compare);
672 if (matchsize < 0)
673 matchsize = compare;
674 if (completion_ignore_case)
676 /* If this is an exact match except for case,
677 use it as the best match rather than one that is not
678 an exact match. This way, we get the case pattern
679 of the actual match. */
680 /* This tests that the current file is an exact match
681 but BESTMATCH is not (it is too long). */
682 if ((matchsize == len
683 && matchsize + !!directoryp
684 < SCHARS (bestmatch))
686 /* If there is no exact match ignoring case,
687 prefer a match that does not change the case
688 of the input. */
689 /* If there is more than one exact match aside from
690 case, and one of them is exact including case,
691 prefer that one. */
692 /* This == checks that, of current file and BESTMATCH,
693 either both or neither are exact. */
694 (((matchsize == len)
696 (matchsize + !!directoryp
697 == SCHARS (bestmatch)))
698 && !bcmp (p2, SDATA (encoded_file), SCHARS (encoded_file))
699 && bcmp (p1, SDATA (encoded_file), SCHARS (encoded_file))))
701 bestmatch = make_string (dp->d_name, len);
702 if (directoryp)
703 bestmatch = Ffile_name_as_directory (bestmatch);
707 /* If this dirname all matches, see if implicit following
708 slash does too. */
709 if (directoryp
710 && compare == matchsize
711 && bestmatchsize > matchsize
712 && IS_ANY_SEP (p1[matchsize]))
713 matchsize++;
714 bestmatchsize = matchsize;
717 /* This closes the directory. */
718 bestmatch = unbind_to (inner_count, bestmatch);
721 UNGCPRO;
722 bestmatch = unbind_to (count, bestmatch);
724 if (all_flag || NILP (bestmatch))
726 if (STRINGP (bestmatch))
727 bestmatch = DECODE_FILE (bestmatch);
728 return bestmatch;
730 if (matchcount == 1 && bestmatchsize == SCHARS (file))
731 return Qt;
732 bestmatch = Fsubstring (bestmatch, make_number (0),
733 make_number (bestmatchsize));
734 /* Now that we got the right initial segment of BESTMATCH,
735 decode it from the coding system in use. */
736 bestmatch = DECODE_FILE (bestmatch);
737 return bestmatch;
740 /* Compare exactly LEN chars of strings at S1 and S2,
741 ignoring case if appropriate.
742 Return -1 if strings match,
743 else number of chars that match at the beginning. */
745 static int
746 scmp (s1, s2, len)
747 register unsigned char *s1, *s2;
748 int len;
750 register int l = len;
752 if (completion_ignore_case)
754 while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++))
755 l--;
757 else
759 while (l && *s1++ == *s2++)
760 l--;
762 if (l == 0)
763 return -1;
764 else
765 return len - l;
768 static int
769 file_name_completion_stat (dirname, dp, st_addr)
770 Lisp_Object dirname;
771 DIRENTRY *dp;
772 struct stat *st_addr;
774 int len = NAMLEN (dp);
775 int pos = SCHARS (dirname);
776 int value;
777 char *fullname = (char *) alloca (len + pos + 2);
779 #ifdef MSDOS
780 #if __DJGPP__ > 1
781 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
782 but aren't required here. Avoid computing the following fields:
783 st_inode, st_size and st_nlink for directories, and the execute bits
784 in st_mode for non-directory files with non-standard extensions. */
786 unsigned short save_djstat_flags = _djstat_flags;
788 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
789 #endif /* __DJGPP__ > 1 */
790 #endif /* MSDOS */
792 bcopy (SDATA (dirname), fullname, pos);
793 #ifndef VMS
794 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
795 fullname[pos++] = DIRECTORY_SEP;
796 #endif
798 bcopy (dp->d_name, fullname + pos, len);
799 fullname[pos + len] = 0;
801 #ifdef S_IFLNK
802 /* We want to return success if a link points to a nonexistent file,
803 but we want to return the status for what the link points to,
804 in case it is a directory. */
805 value = lstat (fullname, st_addr);
806 stat (fullname, st_addr);
807 return value;
808 #else
809 value = stat (fullname, st_addr);
810 #ifdef MSDOS
811 #if __DJGPP__ > 1
812 _djstat_flags = save_djstat_flags;
813 #endif /* __DJGPP__ > 1 */
814 #endif /* MSDOS */
815 return value;
816 #endif /* S_IFLNK */
819 #ifdef VMS
821 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
822 Sfile_name_all_versions, 2, 2, 0,
823 doc: /* Return a list of all versions of file name FILE in directory DIRECTORY. */)
824 (file, directory)
825 Lisp_Object file, directory;
827 return file_name_completion (file, directory, 1, 1);
830 DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
831 doc: /* Return the maximum number of versions allowed for FILE.
832 Returns nil if the file cannot be opened or if there is no version limit. */)
833 (filename)
834 Lisp_Object filename;
836 Lisp_Object retval;
837 struct FAB fab;
838 struct RAB rab;
839 struct XABFHC xabfhc;
840 int status;
842 filename = Fexpand_file_name (filename, Qnil);
843 fab = cc$rms_fab;
844 xabfhc = cc$rms_xabfhc;
845 fab.fab$l_fna = SDATA (filename);
846 fab.fab$b_fns = strlen (fab.fab$l_fna);
847 fab.fab$l_xab = (char *) &xabfhc;
848 status = sys$open (&fab, 0, 0);
849 if (status != RMS$_NORMAL) /* Probably non-existent file */
850 return Qnil;
851 sys$close (&fab, 0, 0);
852 if (xabfhc.xab$w_verlimit == 32767)
853 return Qnil; /* No version limit */
854 else
855 return make_number (xabfhc.xab$w_verlimit);
858 #endif /* VMS */
860 Lisp_Object
861 make_time (time)
862 time_t time;
864 return Fcons (make_number (time >> 16),
865 Fcons (make_number (time & 0177777), Qnil));
868 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
869 doc: /* Return a list of attributes of file FILENAME.
870 Value is nil if specified file cannot be opened.
872 ID-FORMAT specifies the preferred format of attributes uid and gid (see
873 below) - valid values are 'string and 'integer. The latter is the default,
874 but we plan to change that, so you should specify a non-nil value for
875 ID-FORMAT if you use the returned uid or gid.
877 Elements of the attribute list 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 as a string or an integer. If a string value cannot be
881 looked up, the integer value is returned.
882 3. File gid, likewise.
883 4. Last access time, as a list of two integers.
884 First integer has high-order 16 bits of time, second has low 16 bits.
885 5. Last modification time, likewise.
886 6. Last status change time, likewise.
887 7. Size in bytes.
888 This is a floating point number if the size is too large for an integer.
889 8. File modes, as a string of ten letters or dashes as in ls -l.
890 9. t iff file's gid would change if file were deleted and recreated.
891 10. inode number. If inode number is larger than the Emacs integer,
892 this is a cons cell containing two integers: first the high part,
893 then the low 16 bits.
894 11. Device number. If it is larger than the Emacs integer, this is
895 a cons cell, similar to the inode number. */)
896 (filename, id_format)
897 Lisp_Object filename, id_format;
899 Lisp_Object values[12];
900 Lisp_Object encoded;
901 struct stat s;
902 struct passwd *pw;
903 struct group *gr;
904 #if defined (BSD4_2) || defined (BSD4_3)
905 Lisp_Object dirname;
906 struct stat sdir;
907 #endif
908 char modes[10];
909 Lisp_Object handler;
911 filename = Fexpand_file_name (filename, Qnil);
913 /* If the file name has special constructs in it,
914 call the corresponding file handler. */
915 handler = Ffind_file_name_handler (filename, Qfile_attributes);
916 if (!NILP (handler))
917 { /* Only pass the extra arg if it is used to help backward compatibility
918 with old file handlers which do not implement the new arg. --Stef */
919 if (NILP (id_format))
920 return call2 (handler, Qfile_attributes, filename);
921 else
922 return call3 (handler, Qfile_attributes, filename, id_format);
925 encoded = ENCODE_FILE (filename);
927 if (lstat (SDATA (encoded), &s) < 0)
928 return Qnil;
930 switch (s.st_mode & S_IFMT)
932 default:
933 values[0] = Qnil; break;
934 case S_IFDIR:
935 values[0] = Qt; break;
936 #ifdef S_IFLNK
937 case S_IFLNK:
938 values[0] = Ffile_symlink_p (filename); break;
939 #endif
941 values[1] = make_number (s.st_nlink);
942 if (NILP (id_format) || EQ (id_format, Qinteger))
944 values[2] = make_number (s.st_uid);
945 values[3] = make_number (s.st_gid);
947 else
949 pw = (struct passwd *) getpwuid (s.st_uid);
950 values[2] = (pw ? build_string (pw->pw_name) : make_number (s.st_uid));
951 gr = (struct group *) getgrgid (s.st_gid);
952 values[3] = (gr ? build_string (gr->gr_name) : make_number (s.st_gid));
954 values[4] = make_time (s.st_atime);
955 values[5] = make_time (s.st_mtime);
956 values[6] = make_time (s.st_ctime);
957 values[7] = make_number (s.st_size);
958 /* If the size is out of range for an integer, return a float. */
959 if (XINT (values[7]) != s.st_size)
960 values[7] = make_float ((double)s.st_size);
961 /* If the size is negative, and its type is long, convert it back to
962 positive. */
963 if (s.st_size < 0 && sizeof (s.st_size) == sizeof (long))
964 values[7] = make_float ((double) ((unsigned long) s.st_size));
966 filemodestring (&s, modes);
967 values[8] = make_string (modes, 10);
968 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
969 dirname = Ffile_name_directory (filename);
970 if (! NILP (dirname))
971 encoded = ENCODE_FILE (dirname);
972 if (! NILP (dirname) && stat (SDATA (encoded), &sdir) == 0)
973 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
974 else /* if we can't tell, assume worst */
975 values[9] = Qt;
976 #else /* file gid will be egid */
977 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
978 #endif /* BSD4_2 (or BSD4_3) */
979 if (FIXNUM_OVERFLOW_P (s.st_ino))
980 /* To allow inode numbers larger than VALBITS, separate the bottom
981 16 bits. */
982 values[10] = Fcons (make_number (s.st_ino >> 16),
983 make_number (s.st_ino & 0xffff));
984 else
985 /* But keep the most common cases as integers. */
986 values[10] = make_number (s.st_ino);
988 /* Likewise for device. */
989 if (FIXNUM_OVERFLOW_P (s.st_dev))
990 values[11] = Fcons (make_number (s.st_dev >> 16),
991 make_number (s.st_dev & 0xffff));
992 else
993 values[11] = make_number (s.st_dev);
995 return Flist (sizeof(values) / sizeof(values[0]), values);
998 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
999 doc: /* Return t if first arg file attributes list is less than second.
1000 Comparison is in lexicographic order and case is significant. */)
1001 (f1, f2)
1002 Lisp_Object f1, f2;
1004 return Fstring_lessp (Fcar (f1), Fcar (f2));
1007 void
1008 syms_of_dired ()
1010 Qdirectory_files = intern ("directory-files");
1011 Qdirectory_files_and_attributes = intern ("directory-files-and-attributes");
1012 Qfile_name_completion = intern ("file-name-completion");
1013 Qfile_name_all_completions = intern ("file-name-all-completions");
1014 Qfile_attributes = intern ("file-attributes");
1015 Qfile_attributes_lessp = intern ("file-attributes-lessp");
1017 staticpro (&Qdirectory_files);
1018 staticpro (&Qdirectory_files_and_attributes);
1019 staticpro (&Qfile_name_completion);
1020 staticpro (&Qfile_name_all_completions);
1021 staticpro (&Qfile_attributes);
1022 staticpro (&Qfile_attributes_lessp);
1024 defsubr (&Sdirectory_files);
1025 defsubr (&Sdirectory_files_and_attributes);
1026 defsubr (&Sfile_name_completion);
1027 #ifdef VMS
1028 defsubr (&Sfile_name_all_versions);
1029 defsubr (&Sfile_version_limit);
1030 #endif /* VMS */
1031 defsubr (&Sfile_name_all_completions);
1032 defsubr (&Sfile_attributes);
1033 defsubr (&Sfile_attributes_lessp);
1035 #ifdef VMS
1036 Qcompletion_ignore_case = intern ("completion-ignore-case");
1037 staticpro (&Qcompletion_ignore_case);
1038 #endif /* VMS */
1040 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
1041 doc: /* *Completion ignores filenames ending in any string in this list.
1042 Directories are ignored if they match any string in this list which
1043 ends in a slash.
1044 This variable does not affect lists of possible completions,
1045 but does affect the commands that actually do completions. */);
1046 Vcompletion_ignored_extensions = Qnil;
1049 /* arch-tag: 1ac8deca-4d8f-4d41-ade9-089154d98c03
1050 (do not change this comment) */