(Info-complete-menu-item): Revert change of 2003-06-03.
[emacs.git] / src / dired.c
blobbf2a0e4e02076c9e5f105daccbc8f5f28dca4baf
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 dirfilename = Fdirectory_file_name (directory);
158 if (!NILP (match))
160 CHECK_STRING (match);
162 /* MATCH might be a flawed regular expression. Rather than
163 catching and signaling our own errors, we just call
164 compile_pattern to do the work for us. */
165 /* Pass 1 for the MULTIBYTE arg
166 because we do make multibyte strings if the contents warrant. */
167 #ifdef VMS
168 bufp = compile_pattern (match, 0,
169 buffer_defaults.downcase_table, 0, 1);
170 #else
171 bufp = compile_pattern (match, 0, Qnil, 0, 1);
172 #endif
175 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
176 run_pre_post_conversion_on_str which calls Lisp directly and
177 indirectly. */
178 dirfilename = ENCODE_FILE (dirfilename);
179 encoded_directory = ENCODE_FILE (directory);
181 /* Now *bufp is the compiled form of MATCH; don't call anything
182 which might compile a new regexp until we're done with the loop! */
184 /* Do this opendir after anything which might signal an error; if
185 an error is signaled while the directory stream is open, we
186 have to make sure it gets closed, and setting up an
187 unwind_protect to do so would be a pain. */
188 retry:
190 d = opendir (SDATA (dirfilename));
191 if (d == NULL)
192 report_file_error ("Opening directory", Fcons (directory, Qnil));
194 /* Unfortunately, we can now invoke expand-file-name and
195 file-attributes on filenames, both of which can throw, so we must
196 do a proper unwind-protect. */
197 record_unwind_protect (directory_files_internal_unwind,
198 Fcons (make_number (((unsigned long) d) >> 16),
199 make_number (((unsigned long) d) & 0xffff)));
201 directory_nbytes = SBYTES (directory);
202 re_match_object = Qt;
204 /* Decide whether we need to add a directory separator. */
205 #ifndef VMS
206 if (directory_nbytes == 0
207 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
208 needsep = 1;
209 #endif /* not VMS */
211 /* Loop reading blocks until EOF or error. */
212 for (;;)
214 errno = 0;
215 dp = readdir (d);
217 #ifdef EAGAIN
218 if (dp == NULL && errno == EAGAIN)
219 continue;
220 #endif
222 if (dp == NULL)
223 break;
225 if (DIRENTRY_NONEMPTY (dp))
227 int len;
228 int wanted = 0;
229 Lisp_Object name, finalname;
230 struct gcpro gcpro1, gcpro2;
232 len = NAMLEN (dp);
233 name = finalname = make_unibyte_string (dp->d_name, len);
234 GCPRO2 (finalname, name);
236 /* Note: ENCODE_FILE can GC; it should protect its argument,
237 though. */
238 name = DECODE_FILE (name);
239 len = SBYTES (name);
241 /* Now that we have unwind_protect in place, we might as well
242 allow matching to be interrupted. */
243 immediate_quit = 1;
244 QUIT;
246 if (NILP (match)
247 || (0 <= re_search (bufp, SDATA (name), len, 0, len, 0)))
248 wanted = 1;
250 immediate_quit = 0;
252 if (wanted)
254 if (!NILP (full))
256 Lisp_Object fullname;
257 int nbytes = len + directory_nbytes + needsep;
258 int nchars;
260 fullname = make_uninit_multibyte_string (nbytes, nbytes);
261 bcopy (SDATA (directory), SDATA (fullname),
262 directory_nbytes);
264 if (needsep)
265 SSET (fullname, directory_nbytes, DIRECTORY_SEP);
267 bcopy (SDATA (name),
268 SDATA (fullname) + directory_nbytes + needsep,
269 len);
271 nchars = chars_in_text (SDATA (fullname), nbytes);
273 /* Some bug somewhere. */
274 if (nchars > nbytes)
275 abort ();
277 STRING_SET_CHARS (fullname, nchars);
278 if (nchars == nbytes)
279 STRING_SET_UNIBYTE (fullname);
281 finalname = fullname;
283 else
284 finalname = name;
286 if (attrs)
288 /* Construct an expanded filename for the directory entry.
289 Use the decoded names for input to Ffile_attributes. */
290 Lisp_Object decoded_fullname, fileattrs;
291 struct gcpro gcpro1, gcpro2;
293 decoded_fullname = fileattrs = Qnil;
294 GCPRO2 (decoded_fullname, fileattrs);
296 /* Both Fexpand_file_name and Ffile_attributes can GC. */
297 decoded_fullname = Fexpand_file_name (name, directory);
298 fileattrs = Ffile_attributes (decoded_fullname);
300 list = Fcons (Fcons (finalname, fileattrs), list);
301 UNGCPRO;
303 else
304 list = Fcons (finalname, list);
307 UNGCPRO;
311 retry_p = 0;
312 #ifdef EINTR
313 retry_p |= errno == EINTR;
314 #endif
316 closedir (d);
318 /* Discard the unwind protect. */
319 specpdl_ptr = specpdl + count;
321 if (retry_p)
323 list = Qnil;
324 goto retry;
327 if (NILP (nosort))
328 list = Fsort (Fnreverse (list),
329 attrs ? Qfile_attributes_lessp : Qstring_lessp);
331 RETURN_UNGCPRO (list);
335 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
336 doc: /* Return a list of names of files in DIRECTORY.
337 There are three optional arguments:
338 If FULL is non-nil, return absolute file names. Otherwise return names
339 that are relative to the specified directory.
340 If MATCH is non-nil, mention only file names that match the regexp MATCH.
341 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
342 NOSORT is useful if you plan to sort the result yourself. */)
343 (directory, full, match, nosort)
344 Lisp_Object directory, full, match, nosort;
346 Lisp_Object handler;
347 directory = Fexpand_file_name (directory, Qnil);
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;
381 directory = Fexpand_file_name (directory, Qnil);
383 /* If the file name has special constructs in it,
384 call the corresponding file handler. */
385 handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
386 if (!NILP (handler))
388 Lisp_Object args[6];
390 args[0] = handler;
391 args[1] = Qdirectory_files_and_attributes;
392 args[2] = directory;
393 args[3] = full;
394 args[4] = match;
395 args[5] = nosort;
396 return Ffuncall (6, args);
399 return directory_files_internal (directory, full, match, nosort, 1);
403 Lisp_Object file_name_completion ();
405 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
406 2, 2, 0,
407 doc: /* Complete file name FILE in directory DIRECTORY.
408 Returns the longest string
409 common to all file names in DIRECTORY that start with FILE.
410 If there is only one and FILE matches it exactly, returns t.
411 Returns nil if DIR contains no name starting with FILE.
413 This function ignores some of the possible completions as
414 determined by the variable `completion-ignored-extensions', which see. */)
415 (file, directory)
416 Lisp_Object file, directory;
418 Lisp_Object handler;
420 /* If the directory name has special constructs in it,
421 call the corresponding file handler. */
422 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
423 if (!NILP (handler))
424 return call3 (handler, Qfile_name_completion, file, directory);
426 /* If the file name has special constructs in it,
427 call the corresponding file handler. */
428 handler = Ffind_file_name_handler (file, Qfile_name_completion);
429 if (!NILP (handler))
430 return call3 (handler, Qfile_name_completion, file, directory);
432 return file_name_completion (file, directory, 0, 0);
435 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
436 Sfile_name_all_completions, 2, 2, 0,
437 doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
438 These are all file names in directory DIRECTORY which begin with FILE. */)
439 (file, directory)
440 Lisp_Object file, directory;
442 Lisp_Object handler;
444 /* If the directory name has special constructs in it,
445 call the corresponding file handler. */
446 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
447 if (!NILP (handler))
448 return call3 (handler, Qfile_name_all_completions, file, directory);
450 /* If the file name has special constructs in it,
451 call the corresponding file handler. */
452 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
453 if (!NILP (handler))
454 return call3 (handler, Qfile_name_all_completions, file, directory);
456 return file_name_completion (file, directory, 1, 0);
459 static int file_name_completion_stat ();
461 Lisp_Object
462 file_name_completion (file, dirname, all_flag, ver_flag)
463 Lisp_Object file, dirname;
464 int all_flag, ver_flag;
466 DIR *d;
467 int bestmatchsize = 0, skip;
468 register int compare, matchsize;
469 unsigned char *p1, *p2;
470 int matchcount = 0;
471 Lisp_Object bestmatch, tem, elt, name;
472 Lisp_Object encoded_file;
473 Lisp_Object encoded_dir;
474 struct stat st;
475 int directoryp;
476 int passcount;
477 int count = SPECPDL_INDEX ();
478 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
480 elt = Qnil;
482 #ifdef VMS
483 extern DIRENTRY * readdirver ();
485 DIRENTRY *((* readfunc) ());
487 /* Filename completion on VMS ignores case, since VMS filesys does. */
488 specbind (Qcompletion_ignore_case, Qt);
490 readfunc = readdir;
491 if (ver_flag)
492 readfunc = readdirver;
493 file = Fupcase (file);
494 #else /* not VMS */
495 CHECK_STRING (file);
496 #endif /* not VMS */
498 #ifdef FILE_SYSTEM_CASE
499 file = FILE_SYSTEM_CASE (file);
500 #endif
501 bestmatch = Qnil;
502 encoded_file = encoded_dir = Qnil;
503 GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
504 dirname = Fexpand_file_name (dirname, Qnil);
506 /* Do completion on the encoded file name
507 because the other names in the directory are (we presume)
508 encoded likewise. We decode the completed string at the end. */
509 encoded_file = ENCODE_FILE (file);
511 encoded_dir = ENCODE_FILE (dirname);
513 /* With passcount = 0, ignore files that end in an ignored extension.
514 If nothing found then try again with passcount = 1, don't ignore them.
515 If looking for all completions, start with passcount = 1,
516 so always take even the ignored ones.
518 ** It would not actually be helpful to the user to ignore any possible
519 completions when making a list of them.** */
521 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
523 int inner_count = SPECPDL_INDEX ();
525 d = opendir (SDATA (Fdirectory_file_name (encoded_dir)));
526 if (!d)
527 report_file_error ("Opening directory", Fcons (dirname, Qnil));
529 record_unwind_protect (directory_files_internal_unwind,
530 Fcons (make_number (((unsigned long) d) >> 16),
531 make_number (((unsigned long) d) & 0xffff)));
533 /* Loop reading blocks */
534 /* (att3b compiler bug requires do a null comparison this way) */
535 while (1)
537 DIRENTRY *dp;
538 int len;
540 #ifdef VMS
541 dp = (*readfunc) (d);
542 #else
543 dp = readdir (d);
544 #endif
545 if (!dp) break;
547 len = NAMLEN (dp);
549 QUIT;
550 if (! DIRENTRY_NONEMPTY (dp)
551 || len < SCHARS (encoded_file)
552 || 0 <= scmp (dp->d_name, SDATA (encoded_file),
553 SCHARS (encoded_file)))
554 continue;
556 if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
557 continue;
559 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
560 tem = Qnil;
561 if (directoryp)
563 #ifndef TRIVIAL_DIRECTORY_ENTRY
564 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
565 #endif
566 /* "." and ".." are never interesting as completions, but are
567 actually in the way in a directory contains only one file. */
568 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
569 continue;
570 if (!passcount && len > SCHARS (encoded_file))
571 /* Ignore directories if they match an element of
572 completion-ignored-extensions which ends in a slash. */
573 for (tem = Vcompletion_ignored_extensions;
574 CONSP (tem); tem = XCDR (tem))
576 int elt_len;
578 elt = XCAR (tem);
579 if (!STRINGP (elt))
580 continue;
581 /* Need to encode ELT, since scmp compares unibyte
582 strings only. */
583 elt = ENCODE_FILE (elt);
584 elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
585 if (elt_len <= 0)
586 continue;
587 p1 = SDATA (elt);
588 if (p1[elt_len] != '/')
589 continue;
590 skip = len - elt_len;
591 if (skip < 0)
592 continue;
594 if (0 <= scmp (dp->d_name + skip, p1, elt_len))
595 continue;
596 break;
599 else
601 /* Compare extensions-to-be-ignored against end of this file name */
602 /* if name is not an exact match against specified string */
603 if (!passcount && len > SCHARS (encoded_file))
604 /* and exit this for loop if a match is found */
605 for (tem = Vcompletion_ignored_extensions;
606 CONSP (tem); tem = XCDR (tem))
608 elt = XCAR (tem);
609 if (!STRINGP (elt)) continue;
610 /* Need to encode ELT, since scmp compares unibyte
611 strings only. */
612 elt = ENCODE_FILE (elt);
613 skip = len - SCHARS (elt);
614 if (skip < 0) continue;
616 if (0 <= scmp (dp->d_name + skip,
617 SDATA (elt),
618 SCHARS (elt)))
619 continue;
620 break;
624 /* If an ignored-extensions match was found,
625 don't process this name as a completion. */
626 if (!passcount && CONSP (tem))
627 continue;
629 if (!passcount)
631 Lisp_Object regexps;
632 Lisp_Object zero;
633 XSETFASTINT (zero, 0);
635 /* Ignore this element if it fails to match all the regexps. */
636 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
637 regexps = XCDR (regexps))
639 tem = Fstring_match (XCAR (regexps),
640 make_string (dp->d_name, len), zero);
641 if (NILP (tem))
642 break;
644 if (CONSP (regexps))
645 continue;
648 /* Update computation of how much all possible completions match */
650 matchcount++;
652 if (all_flag || NILP (bestmatch))
654 /* This is a possible completion */
655 if (directoryp)
657 /* This completion is a directory; make it end with '/' */
658 name = Ffile_name_as_directory (make_string (dp->d_name, len));
660 else
661 name = make_string (dp->d_name, len);
662 if (all_flag)
664 name = DECODE_FILE (name);
665 bestmatch = Fcons (name, bestmatch);
667 else
669 bestmatch = name;
670 bestmatchsize = SCHARS (name);
673 else
675 compare = min (bestmatchsize, len);
676 p1 = SDATA (bestmatch);
677 p2 = (unsigned char *) dp->d_name;
678 matchsize = scmp(p1, p2, compare);
679 if (matchsize < 0)
680 matchsize = compare;
681 if (completion_ignore_case)
683 /* If this is an exact match except for case,
684 use it as the best match rather than one that is not
685 an exact match. This way, we get the case pattern
686 of the actual match. */
687 /* This tests that the current file is an exact match
688 but BESTMATCH is not (it is too long). */
689 if ((matchsize == len
690 && matchsize + !!directoryp
691 < SCHARS (bestmatch))
693 /* If there is no exact match ignoring case,
694 prefer a match that does not change the case
695 of the input. */
696 /* If there is more than one exact match aside from
697 case, and one of them is exact including case,
698 prefer that one. */
699 /* This == checks that, of current file and BESTMATCH,
700 either both or neither are exact. */
701 (((matchsize == len)
703 (matchsize + !!directoryp
704 == SCHARS (bestmatch)))
705 && !bcmp (p2, SDATA (encoded_file), SCHARS (encoded_file))
706 && bcmp (p1, SDATA (encoded_file), SCHARS (encoded_file))))
708 bestmatch = make_string (dp->d_name, len);
709 if (directoryp)
710 bestmatch = Ffile_name_as_directory (bestmatch);
714 /* If this dirname all matches, see if implicit following
715 slash does too. */
716 if (directoryp
717 && compare == matchsize
718 && bestmatchsize > matchsize
719 && IS_ANY_SEP (p1[matchsize]))
720 matchsize++;
721 bestmatchsize = matchsize;
724 /* This closes the directory. */
725 bestmatch = unbind_to (inner_count, bestmatch);
728 UNGCPRO;
729 bestmatch = unbind_to (count, bestmatch);
731 if (all_flag || NILP (bestmatch))
733 if (STRINGP (bestmatch))
734 bestmatch = DECODE_FILE (bestmatch);
735 return bestmatch;
737 if (matchcount == 1 && bestmatchsize == SCHARS (file))
738 return Qt;
739 bestmatch = Fsubstring (bestmatch, make_number (0),
740 make_number (bestmatchsize));
741 /* Now that we got the right initial segment of BESTMATCH,
742 decode it from the coding system in use. */
743 bestmatch = DECODE_FILE (bestmatch);
744 return bestmatch;
747 /* Compare exactly LEN chars of strings at S1 and S2,
748 ignoring case if appropriate.
749 Return -1 if strings match,
750 else number of chars that match at the beginning. */
752 static int
753 scmp (s1, s2, len)
754 register unsigned char *s1, *s2;
755 int len;
757 register int l = len;
759 if (completion_ignore_case)
761 while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++))
762 l--;
764 else
766 while (l && *s1++ == *s2++)
767 l--;
769 if (l == 0)
770 return -1;
771 else
772 return len - l;
775 static int
776 file_name_completion_stat (dirname, dp, st_addr)
777 Lisp_Object dirname;
778 DIRENTRY *dp;
779 struct stat *st_addr;
781 int len = NAMLEN (dp);
782 int pos = SCHARS (dirname);
783 int value;
784 char *fullname = (char *) alloca (len + pos + 2);
786 #ifdef MSDOS
787 #if __DJGPP__ > 1
788 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
789 but aren't required here. Avoid computing the following fields:
790 st_inode, st_size and st_nlink for directories, and the execute bits
791 in st_mode for non-directory files with non-standard extensions. */
793 unsigned short save_djstat_flags = _djstat_flags;
795 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
796 #endif /* __DJGPP__ > 1 */
797 #endif /* MSDOS */
799 bcopy (SDATA (dirname), fullname, pos);
800 #ifndef VMS
801 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
802 fullname[pos++] = DIRECTORY_SEP;
803 #endif
805 bcopy (dp->d_name, fullname + pos, len);
806 fullname[pos + len] = 0;
808 #ifdef S_IFLNK
809 /* We want to return success if a link points to a nonexistent file,
810 but we want to return the status for what the link points to,
811 in case it is a directory. */
812 value = lstat (fullname, st_addr);
813 stat (fullname, st_addr);
814 return value;
815 #else
816 value = stat (fullname, st_addr);
817 #ifdef MSDOS
818 #if __DJGPP__ > 1
819 _djstat_flags = save_djstat_flags;
820 #endif /* __DJGPP__ > 1 */
821 #endif /* MSDOS */
822 return value;
823 #endif /* S_IFLNK */
826 #ifdef VMS
828 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
829 Sfile_name_all_versions, 2, 2, 0,
830 doc: /* Return a list of all versions of file name FILE in directory DIRECTORY. */)
831 (file, directory)
832 Lisp_Object file, directory;
834 return file_name_completion (file, directory, 1, 1);
837 DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
838 doc: /* Return the maximum number of versions allowed for FILE.
839 Returns nil if the file cannot be opened or if there is no version limit. */)
840 (filename)
841 Lisp_Object filename;
843 Lisp_Object retval;
844 struct FAB fab;
845 struct RAB rab;
846 struct XABFHC xabfhc;
847 int status;
849 filename = Fexpand_file_name (filename, Qnil);
850 fab = cc$rms_fab;
851 xabfhc = cc$rms_xabfhc;
852 fab.fab$l_fna = SDATA (filename);
853 fab.fab$b_fns = strlen (fab.fab$l_fna);
854 fab.fab$l_xab = (char *) &xabfhc;
855 status = sys$open (&fab, 0, 0);
856 if (status != RMS$_NORMAL) /* Probably non-existent file */
857 return Qnil;
858 sys$close (&fab, 0, 0);
859 if (xabfhc.xab$w_verlimit == 32767)
860 return Qnil; /* No version limit */
861 else
862 return make_number (xabfhc.xab$w_verlimit);
865 #endif /* VMS */
867 Lisp_Object
868 make_time (time)
869 time_t time;
871 return Fcons (make_number (time >> 16),
872 Fcons (make_number (time & 0177777), Qnil));
875 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
876 doc: /* Return a list of attributes of file FILENAME.
877 Value is nil if specified file cannot be opened.
878 Otherwise, list elements are:
879 0. t for directory, string (name linked to) for symbolic link, or nil.
880 1. Number of links to file.
881 2. File uid.
882 3. File gid.
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.
897 If file does not exist, returns nil. */)
898 (filename)
899 Lisp_Object filename;
901 Lisp_Object values[12];
902 Lisp_Object encoded;
903 struct stat s;
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 return call2 (handler, Qfile_attributes, filename);
919 encoded = ENCODE_FILE (filename);
921 if (lstat (SDATA (encoded), &s) < 0)
922 return Qnil;
924 switch (s.st_mode & S_IFMT)
926 default:
927 values[0] = Qnil; break;
928 case S_IFDIR:
929 values[0] = Qt; break;
930 #ifdef S_IFLNK
931 case S_IFLNK:
932 values[0] = Ffile_symlink_p (filename); break;
933 #endif
935 values[1] = make_number (s.st_nlink);
936 values[2] = make_number (s.st_uid);
937 values[3] = make_number (s.st_gid);
938 values[4] = make_time (s.st_atime);
939 values[5] = make_time (s.st_mtime);
940 values[6] = make_time (s.st_ctime);
941 values[7] = make_number (s.st_size);
942 /* If the size is out of range for an integer, return a float. */
943 if (XINT (values[7]) != s.st_size)
944 values[7] = make_float ((double)s.st_size);
945 /* If the size is negative, and its type is long, convert it back to
946 positive. */
947 if (s.st_size < 0 && sizeof (s.st_size) == sizeof (long))
948 values[7] = make_float ((double) ((unsigned long) s.st_size));
950 filemodestring (&s, modes);
951 values[8] = make_string (modes, 10);
952 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
953 dirname = Ffile_name_directory (filename);
954 if (! NILP (dirname))
955 encoded = ENCODE_FILE (dirname);
956 if (! NILP (dirname) && stat (SDATA (encoded), &sdir) == 0)
957 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
958 else /* if we can't tell, assume worst */
959 values[9] = Qt;
960 #else /* file gid will be egid */
961 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
962 #endif /* BSD4_2 (or BSD4_3) */
963 if (FIXNUM_OVERFLOW_P (s.st_ino))
964 /* To allow inode numbers larger than VALBITS, separate the bottom
965 16 bits. */
966 values[10] = Fcons (make_number (s.st_ino >> 16),
967 make_number (s.st_ino & 0xffff));
968 else
969 /* But keep the most common cases as integers. */
970 values[10] = make_number (s.st_ino);
972 /* Likewise for device. */
973 if (FIXNUM_OVERFLOW_P (s.st_dev))
974 values[11] = Fcons (make_number (s.st_dev >> 16),
975 make_number (s.st_dev & 0xffff));
976 else
977 values[11] = make_number (s.st_dev);
979 return Flist (sizeof(values) / sizeof(values[0]), values);
982 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
983 doc: /* Return t if first arg file attributes list is less than second.
984 Comparison is in lexicographic order and case is significant. */)
985 (f1, f2)
986 Lisp_Object f1, f2;
988 return Fstring_lessp (Fcar (f1), Fcar (f2));
991 void
992 syms_of_dired ()
994 Qdirectory_files = intern ("directory-files");
995 Qdirectory_files_and_attributes = intern ("directory-files-and-attributes");
996 Qfile_name_completion = intern ("file-name-completion");
997 Qfile_name_all_completions = intern ("file-name-all-completions");
998 Qfile_attributes = intern ("file-attributes");
999 Qfile_attributes_lessp = intern ("file-attributes-lessp");
1001 staticpro (&Qdirectory_files);
1002 staticpro (&Qdirectory_files_and_attributes);
1003 staticpro (&Qfile_name_completion);
1004 staticpro (&Qfile_name_all_completions);
1005 staticpro (&Qfile_attributes);
1006 staticpro (&Qfile_attributes_lessp);
1008 defsubr (&Sdirectory_files);
1009 defsubr (&Sdirectory_files_and_attributes);
1010 defsubr (&Sfile_name_completion);
1011 #ifdef VMS
1012 defsubr (&Sfile_name_all_versions);
1013 defsubr (&Sfile_version_limit);
1014 #endif /* VMS */
1015 defsubr (&Sfile_name_all_completions);
1016 defsubr (&Sfile_attributes);
1017 defsubr (&Sfile_attributes_lessp);
1019 #ifdef VMS
1020 Qcompletion_ignore_case = intern ("completion-ignore-case");
1021 staticpro (&Qcompletion_ignore_case);
1022 #endif /* VMS */
1024 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
1025 doc: /* *Completion ignores filenames ending in any string in this list.
1026 Directories are ignored if they match any string in this list which
1027 ends in a slash.
1028 This variable does not affect lists of possible completions,
1029 but does affect the commands that actually do completions. */);
1030 Vcompletion_ignored_extensions = Qnil;