(font-lock-extend-jit-lock-region-after-change): Better comment.
[emacs.git] / src / dired.c
blob17a80a3ce4b26b6b9715e9e95ae2a24f19b81956
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006 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., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
23 #include <config.h>
25 #include <stdio.h>
26 #include <sys/types.h>
27 #include <sys/stat.h>
29 #ifdef HAVE_PWD_H
30 #include <pwd.h>
31 #endif
32 #ifndef VMS
33 #include <grp.h>
34 #endif
36 #include <errno.h>
38 #ifdef VMS
39 #include <string.h>
40 #include <rms.h>
41 #include <rmsdef.h>
42 #endif
44 #ifdef HAVE_UNISTD_H
45 #include <unistd.h>
46 #endif
48 /* The d_nameln member of a struct dirent includes the '\0' character
49 on some systems, but not on others. What's worse, you can't tell
50 at compile-time which one it will be, since it really depends on
51 the sort of system providing the filesystem you're reading from,
52 not the system you are running on. Paul Eggert
53 <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
54 SunOS 4.1.2 host, reading a directory that is remote-mounted from a
55 Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
57 Since applying strlen to the name always works, we'll just do that. */
58 #define NAMLEN(p) strlen (p->d_name)
60 #ifdef SYSV_SYSTEM_DIR
62 #include <dirent.h>
63 #define DIRENTRY struct dirent
65 #else /* not SYSV_SYSTEM_DIR */
67 #ifdef NONSYSTEM_DIR_LIBRARY
68 #include "ndir.h"
69 #else /* not NONSYSTEM_DIR_LIBRARY */
70 #ifdef MSDOS
71 #include <dirent.h>
72 #else
73 #include <sys/dir.h>
74 #endif
75 #endif /* not NONSYSTEM_DIR_LIBRARY */
77 #include <sys/stat.h>
79 #ifndef MSDOS
80 #define DIRENTRY struct direct
82 extern DIR *opendir ();
83 extern struct direct *readdir ();
85 #endif /* not MSDOS */
86 #endif /* not SYSV_SYSTEM_DIR */
88 /* Some versions of Cygwin don't have d_ino in `struct dirent'. */
89 #if defined(MSDOS) || defined(__CYGWIN__)
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 "systime.h"
97 #include "buffer.h"
98 #include "commands.h"
99 #include "charset.h"
100 #include "coding.h"
101 #include "regex.h"
102 #include "blockinput.h"
104 /* Returns a search buffer, with a fastmap allocated and ready to go. */
105 extern struct re_pattern_buffer *compile_pattern ();
107 /* From filemode.c. Can't go in Lisp.h because of `stat'. */
108 extern void filemodestring P_ ((struct stat *, char *));
110 /* if system does not have symbolic links, it does not have lstat.
111 In that case, use ordinary stat instead. */
113 #ifndef S_IFLNK
114 #define lstat stat
115 #endif
117 extern int completion_ignore_case;
118 extern Lisp_Object Vcompletion_regexp_list;
120 Lisp_Object Vcompletion_ignored_extensions;
121 Lisp_Object Qcompletion_ignore_case;
122 Lisp_Object Qdirectory_files;
123 Lisp_Object Qdirectory_files_and_attributes;
124 Lisp_Object Qfile_name_completion;
125 Lisp_Object Qfile_name_all_completions;
126 Lisp_Object Qfile_attributes;
127 Lisp_Object Qfile_attributes_lessp;
129 static int scmp P_ ((unsigned char *, unsigned char *, int));
132 Lisp_Object
133 directory_files_internal_unwind (dh)
134 Lisp_Object dh;
136 DIR *d = (DIR *) XSAVE_VALUE (dh)->pointer;
137 closedir (d);
138 return Qnil;
141 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
142 When ATTRS is zero, return a list of directory filenames; when
143 non-zero, return a list of directory filenames and their attributes.
144 In the latter case, ID_FORMAT is passed to Ffile_attributes. */
146 Lisp_Object
147 directory_files_internal (directory, full, match, nosort, attrs, id_format)
148 Lisp_Object directory, full, match, nosort;
149 int attrs;
150 Lisp_Object id_format;
152 DIR *d;
153 int directory_nbytes;
154 Lisp_Object list, dirfilename, encoded_directory;
155 struct re_pattern_buffer *bufp = NULL;
156 int needsep = 0;
157 int count = SPECPDL_INDEX ();
158 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
159 DIRENTRY *dp;
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 /* !VMS */
180 # ifdef WINDOWSNT
181 /* Windows users want case-insensitive wildcards. */
182 bufp = compile_pattern (match, 0,
183 buffer_defaults.case_canon_table, 0, 1);
184 # else /* !WINDOWSNT */
185 bufp = compile_pattern (match, 0, Qnil, 0, 1);
186 # endif /* !WINDOWSNT */
187 #endif /* !VMS */
190 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
191 run_pre_post_conversion_on_str which calls Lisp directly and
192 indirectly. */
193 dirfilename = ENCODE_FILE (dirfilename);
194 encoded_directory = ENCODE_FILE (directory);
196 /* Now *bufp is the compiled form of MATCH; don't call anything
197 which might compile a new regexp until we're done with the loop! */
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 make_save_value (d, 0));
209 directory_nbytes = SBYTES (directory);
210 re_match_object = Qt;
212 /* Decide whether we need to add a directory separator. */
213 #ifndef VMS
214 if (directory_nbytes == 0
215 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
216 needsep = 1;
217 #endif /* not VMS */
219 /* Loop reading blocks until EOF or error. */
220 for (;;)
222 errno = 0;
223 dp = readdir (d);
225 if (dp == NULL && (0
226 #ifdef EAGAIN
227 || errno == EAGAIN
228 #endif
229 #ifdef EINTR
230 || errno == EINTR
231 #endif
233 { QUIT; continue; }
235 if (dp == NULL)
236 break;
238 if (DIRENTRY_NONEMPTY (dp))
240 int len;
241 int wanted = 0;
242 Lisp_Object name, finalname;
243 struct gcpro gcpro1, gcpro2;
245 len = NAMLEN (dp);
246 name = finalname = make_unibyte_string (dp->d_name, len);
247 GCPRO2 (finalname, name);
249 /* Note: ENCODE_FILE can GC; it should protect its argument,
250 though. */
251 name = DECODE_FILE (name);
252 len = SBYTES (name);
254 /* Now that we have unwind_protect in place, we might as well
255 allow matching to be interrupted. */
256 immediate_quit = 1;
257 QUIT;
259 if (NILP (match)
260 || (0 <= re_search (bufp, SDATA (name), len, 0, len, 0)))
261 wanted = 1;
263 immediate_quit = 0;
265 if (wanted)
267 if (!NILP (full))
269 Lisp_Object fullname;
270 int nbytes = len + directory_nbytes + needsep;
271 int nchars;
273 fullname = make_uninit_multibyte_string (nbytes, nbytes);
274 bcopy (SDATA (directory), SDATA (fullname),
275 directory_nbytes);
277 if (needsep)
278 SSET (fullname, directory_nbytes, DIRECTORY_SEP);
280 bcopy (SDATA (name),
281 SDATA (fullname) + directory_nbytes + needsep,
282 len);
284 nchars = chars_in_text (SDATA (fullname), nbytes);
286 /* Some bug somewhere. */
287 if (nchars > nbytes)
288 abort ();
290 STRING_SET_CHARS (fullname, nchars);
291 if (nchars == nbytes)
292 STRING_SET_UNIBYTE (fullname);
294 finalname = fullname;
296 else
297 finalname = name;
299 if (attrs)
301 /* Construct an expanded filename for the directory entry.
302 Use the decoded names for input to Ffile_attributes. */
303 Lisp_Object decoded_fullname, fileattrs;
304 struct gcpro gcpro1, gcpro2;
306 decoded_fullname = fileattrs = Qnil;
307 GCPRO2 (decoded_fullname, fileattrs);
309 /* Both Fexpand_file_name and Ffile_attributes can GC. */
310 decoded_fullname = Fexpand_file_name (name, directory);
311 fileattrs = Ffile_attributes (decoded_fullname, id_format);
313 list = Fcons (Fcons (finalname, fileattrs), list);
314 UNGCPRO;
316 else
317 list = Fcons (finalname, list);
320 UNGCPRO;
324 closedir (d);
326 /* Discard the unwind protect. */
327 specpdl_ptr = specpdl + count;
329 if (NILP (nosort))
330 list = Fsort (Fnreverse (list),
331 attrs ? Qfile_attributes_lessp : Qstring_lessp);
333 RETURN_UNGCPRO (list);
337 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
338 doc: /* Return a list of names of files in DIRECTORY.
339 There are three optional arguments:
340 If FULL is non-nil, return absolute file names. Otherwise return names
341 that are relative to the specified directory.
342 If MATCH is non-nil, mention only file names that match the regexp MATCH.
343 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
344 NOSORT is useful if you plan to sort the result yourself. */)
345 (directory, full, match, nosort)
346 Lisp_Object directory, full, match, nosort;
348 Lisp_Object handler;
349 directory = Fexpand_file_name (directory, Qnil);
351 /* If the file name has special constructs in it,
352 call the corresponding file handler. */
353 handler = Ffind_file_name_handler (directory, Qdirectory_files);
354 if (!NILP (handler))
355 return call5 (handler, Qdirectory_files, directory,
356 full, match, nosort);
358 return directory_files_internal (directory, full, match, nosort, 0, Qnil);
361 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
362 Sdirectory_files_and_attributes, 1, 5, 0,
363 doc: /* Return a list of names of files and their attributes in DIRECTORY.
364 There are four optional arguments:
365 If FULL is non-nil, return absolute file names. Otherwise return names
366 that are relative to the specified directory.
367 If MATCH is non-nil, mention only file names that match the regexp MATCH.
368 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
369 NOSORT is useful if you plan to sort the result yourself.
370 ID-FORMAT specifies the preferred format of attributes uid and gid, see
371 `file-attributes' for further documentation. */)
372 (directory, full, match, nosort, id_format)
373 Lisp_Object directory, full, match, nosort, id_format;
375 Lisp_Object handler;
376 directory = Fexpand_file_name (directory, Qnil);
378 /* If the file name has special constructs in it,
379 call the corresponding file handler. */
380 handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
381 if (!NILP (handler))
382 return call6 (handler, Qdirectory_files_and_attributes,
383 directory, full, match, nosort, id_format);
385 return directory_files_internal (directory, full, match, nosort, 1, id_format);
389 Lisp_Object file_name_completion ();
391 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
392 2, 2, 0,
393 doc: /* Complete file name FILE in directory DIRECTORY.
394 Returns the longest string
395 common to all file names in DIRECTORY that start with FILE.
396 If there is only one and FILE matches it exactly, returns t.
397 Returns nil if DIRECTORY contains no name starting with FILE.
399 This function ignores some of the possible completions as
400 determined by the variable `completion-ignored-extensions', which see. */)
401 (file, directory)
402 Lisp_Object file, directory;
404 Lisp_Object handler;
406 /* If the directory name has special constructs in it,
407 call the corresponding file handler. */
408 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
409 if (!NILP (handler))
410 return call3 (handler, Qfile_name_completion, file, directory);
412 /* If the file name has special constructs in it,
413 call the corresponding file handler. */
414 handler = Ffind_file_name_handler (file, Qfile_name_completion);
415 if (!NILP (handler))
416 return call3 (handler, Qfile_name_completion, file, directory);
418 return file_name_completion (file, directory, 0, 0);
421 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
422 Sfile_name_all_completions, 2, 2, 0,
423 doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
424 These are all file names in directory DIRECTORY which begin with FILE. */)
425 (file, directory)
426 Lisp_Object file, directory;
428 Lisp_Object handler;
430 /* If the directory name has special constructs in it,
431 call the corresponding file handler. */
432 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
433 if (!NILP (handler))
434 return call3 (handler, Qfile_name_all_completions, file, directory);
436 /* If the file name has special constructs in it,
437 call the corresponding file handler. */
438 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
439 if (!NILP (handler))
440 return call3 (handler, Qfile_name_all_completions, file, directory);
442 return file_name_completion (file, directory, 1, 0);
445 static int file_name_completion_stat ();
447 Lisp_Object
448 file_name_completion (file, dirname, all_flag, ver_flag)
449 Lisp_Object file, dirname;
450 int all_flag, ver_flag;
452 DIR *d;
453 int bestmatchsize = 0, skip;
454 register int compare, matchsize;
455 unsigned char *p1, *p2;
456 int matchcount = 0;
457 Lisp_Object bestmatch, tem, elt, name;
458 Lisp_Object encoded_file;
459 Lisp_Object encoded_dir;
460 struct stat st;
461 int directoryp;
462 int passcount;
463 int count = SPECPDL_INDEX ();
464 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
466 elt = Qnil;
468 #ifdef VMS
469 extern DIRENTRY * readdirver ();
471 DIRENTRY *((* readfunc) ());
473 /* Filename completion on VMS ignores case, since VMS filesys does. */
474 specbind (Qcompletion_ignore_case, Qt);
476 readfunc = readdir;
477 if (ver_flag)
478 readfunc = readdirver;
479 file = Fupcase (file);
480 #else /* not VMS */
481 CHECK_STRING (file);
482 #endif /* not VMS */
484 #ifdef FILE_SYSTEM_CASE
485 file = FILE_SYSTEM_CASE (file);
486 #endif
487 bestmatch = Qnil;
488 encoded_file = encoded_dir = Qnil;
489 GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
490 dirname = Fexpand_file_name (dirname, Qnil);
492 /* Do completion on the encoded file name
493 because the other names in the directory are (we presume)
494 encoded likewise. We decode the completed string at the end. */
495 encoded_file = ENCODE_FILE (file);
497 encoded_dir = ENCODE_FILE (dirname);
499 /* With passcount = 0, ignore files that end in an ignored extension.
500 If nothing found then try again with passcount = 1, don't ignore them.
501 If looking for all completions, start with passcount = 1,
502 so always take even the ignored ones.
504 ** It would not actually be helpful to the user to ignore any possible
505 completions when making a list of them.** */
507 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
509 int inner_count = SPECPDL_INDEX ();
511 d = opendir (SDATA (Fdirectory_file_name (encoded_dir)));
512 if (!d)
513 report_file_error ("Opening directory", Fcons (dirname, Qnil));
515 record_unwind_protect (directory_files_internal_unwind,
516 make_save_value (d, 0));
518 /* Loop reading blocks */
519 /* (att3b compiler bug requires do a null comparison this way) */
520 while (1)
522 DIRENTRY *dp;
523 int len;
525 #ifdef VMS
526 dp = (*readfunc) (d);
527 #else
528 errno = 0;
529 dp = readdir (d);
530 if (dp == NULL && (0
531 # ifdef EAGAIN
532 || errno == EAGAIN
533 # endif
534 # ifdef EINTR
535 || errno == EINTR
536 # endif
538 { QUIT; continue; }
539 #endif
541 if (!dp) break;
543 len = NAMLEN (dp);
545 QUIT;
546 if (! DIRENTRY_NONEMPTY (dp)
547 || len < SCHARS (encoded_file)
548 || 0 <= scmp (dp->d_name, SDATA (encoded_file),
549 SCHARS (encoded_file)))
550 continue;
552 if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
553 continue;
555 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
556 tem = Qnil;
557 if (directoryp)
559 #ifndef TRIVIAL_DIRECTORY_ENTRY
560 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
561 #endif
562 /* "." and ".." are never interesting as completions, but are
563 actually in the way in a directory contains only one file. */
564 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
565 continue;
566 if (!passcount && len > SCHARS (encoded_file))
567 /* Ignore directories if they match an element of
568 completion-ignored-extensions which ends in a slash. */
569 for (tem = Vcompletion_ignored_extensions;
570 CONSP (tem); tem = XCDR (tem))
572 int elt_len;
574 elt = XCAR (tem);
575 if (!STRINGP (elt))
576 continue;
577 /* Need to encode ELT, since scmp compares unibyte
578 strings only. */
579 elt = ENCODE_FILE (elt);
580 elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
581 if (elt_len <= 0)
582 continue;
583 p1 = SDATA (elt);
584 if (p1[elt_len] != '/')
585 continue;
586 skip = len - elt_len;
587 if (skip < 0)
588 continue;
590 if (0 <= scmp (dp->d_name + skip, p1, elt_len))
591 continue;
592 break;
595 else
597 /* Compare extensions-to-be-ignored against end of this file name */
598 /* if name is not an exact match against specified string */
599 if (!passcount && len > SCHARS (encoded_file))
600 /* and exit this for loop if a match is found */
601 for (tem = Vcompletion_ignored_extensions;
602 CONSP (tem); tem = XCDR (tem))
604 elt = XCAR (tem);
605 if (!STRINGP (elt)) continue;
606 /* Need to encode ELT, since scmp compares unibyte
607 strings only. */
608 elt = ENCODE_FILE (elt);
609 skip = len - SCHARS (elt);
610 if (skip < 0) continue;
612 if (0 <= scmp (dp->d_name + skip,
613 SDATA (elt),
614 SCHARS (elt)))
615 continue;
616 break;
620 /* If an ignored-extensions match was found,
621 don't process this name as a completion. */
622 if (!passcount && CONSP (tem))
623 continue;
625 if (!passcount)
627 Lisp_Object regexps;
628 Lisp_Object zero;
629 XSETFASTINT (zero, 0);
631 /* Ignore this element if it fails to match all the regexps. */
632 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
633 regexps = XCDR (regexps))
635 tem = Fstring_match (XCAR (regexps),
636 make_string (dp->d_name, len), zero);
637 if (NILP (tem))
638 break;
640 if (CONSP (regexps))
641 continue;
644 /* Update computation of how much all possible completions match */
646 matchcount++;
648 if (all_flag || NILP (bestmatch))
650 /* This is a possible completion */
651 if (directoryp)
653 /* This completion is a directory; make it end with '/' */
654 name = Ffile_name_as_directory (make_string (dp->d_name, len));
656 else
657 name = make_string (dp->d_name, len);
658 if (all_flag)
660 name = DECODE_FILE (name);
661 bestmatch = Fcons (name, bestmatch);
663 else
665 bestmatch = name;
666 bestmatchsize = SCHARS (name);
669 else
671 compare = min (bestmatchsize, len);
672 p1 = SDATA (bestmatch);
673 p2 = (unsigned char *) dp->d_name;
674 matchsize = scmp(p1, p2, compare);
675 if (matchsize < 0)
676 matchsize = compare;
677 if (completion_ignore_case)
679 /* If this is an exact match except for case,
680 use it as the best match rather than one that is not
681 an exact match. This way, we get the case pattern
682 of the actual match. */
683 /* This tests that the current file is an exact match
684 but BESTMATCH is not (it is too long). */
685 if ((matchsize == len
686 && matchsize + !!directoryp
687 < SCHARS (bestmatch))
689 /* If there is no exact match ignoring case,
690 prefer a match that does not change the case
691 of the input. */
692 /* If there is more than one exact match aside from
693 case, and one of them is exact including case,
694 prefer that one. */
695 /* This == checks that, of current file and BESTMATCH,
696 either both or neither are exact. */
697 (((matchsize == len)
699 (matchsize + !!directoryp
700 == SCHARS (bestmatch)))
701 && !bcmp (p2, SDATA (encoded_file), SCHARS (encoded_file))
702 && bcmp (p1, SDATA (encoded_file), SCHARS (encoded_file))))
704 bestmatch = make_string (dp->d_name, len);
705 if (directoryp)
706 bestmatch = Ffile_name_as_directory (bestmatch);
710 /* If this dirname all matches, see if implicit following
711 slash does too. */
712 if (directoryp
713 && compare == matchsize
714 && bestmatchsize > matchsize
715 && IS_ANY_SEP (p1[matchsize]))
716 matchsize++;
717 bestmatchsize = matchsize;
720 /* This closes the directory. */
721 bestmatch = unbind_to (inner_count, bestmatch);
724 UNGCPRO;
725 bestmatch = unbind_to (count, bestmatch);
727 if (all_flag || NILP (bestmatch))
729 if (STRINGP (bestmatch))
730 bestmatch = DECODE_FILE (bestmatch);
731 return bestmatch;
733 if (matchcount == 1 && bestmatchsize == SCHARS (file))
734 return Qt;
735 bestmatch = Fsubstring (bestmatch, make_number (0),
736 make_number (bestmatchsize));
737 /* Now that we got the right initial segment of BESTMATCH,
738 decode it from the coding system in use. */
739 bestmatch = DECODE_FILE (bestmatch);
740 return bestmatch;
743 /* Compare exactly LEN chars of strings at S1 and S2,
744 ignoring case if appropriate.
745 Return -1 if strings match,
746 else number of chars that match at the beginning. */
748 static int
749 scmp (s1, s2, len)
750 register unsigned char *s1, *s2;
751 int len;
753 register int l = len;
755 if (completion_ignore_case)
757 while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++))
758 l--;
760 else
762 while (l && *s1++ == *s2++)
763 l--;
765 if (l == 0)
766 return -1;
767 else
768 return len - l;
771 static int
772 file_name_completion_stat (dirname, dp, st_addr)
773 Lisp_Object dirname;
774 DIRENTRY *dp;
775 struct stat *st_addr;
777 int len = NAMLEN (dp);
778 int pos = SCHARS (dirname);
779 int value;
780 char *fullname = (char *) alloca (len + pos + 2);
782 #ifdef MSDOS
783 #if __DJGPP__ > 1
784 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
785 but aren't required here. Avoid computing the following fields:
786 st_inode, st_size and st_nlink for directories, and the execute bits
787 in st_mode for non-directory files with non-standard extensions. */
789 unsigned short save_djstat_flags = _djstat_flags;
791 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
792 #endif /* __DJGPP__ > 1 */
793 #endif /* MSDOS */
795 bcopy (SDATA (dirname), fullname, pos);
796 #ifndef VMS
797 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
798 fullname[pos++] = DIRECTORY_SEP;
799 #endif
801 bcopy (dp->d_name, fullname + pos, len);
802 fullname[pos + len] = 0;
804 #ifdef S_IFLNK
805 /* We want to return success if a link points to a nonexistent file,
806 but we want to return the status for what the link points to,
807 in case it is a directory. */
808 value = lstat (fullname, st_addr);
809 stat (fullname, st_addr);
810 return value;
811 #else
812 value = stat (fullname, st_addr);
813 #ifdef MSDOS
814 #if __DJGPP__ > 1
815 _djstat_flags = save_djstat_flags;
816 #endif /* __DJGPP__ > 1 */
817 #endif /* MSDOS */
818 return value;
819 #endif /* S_IFLNK */
822 #ifdef VMS
824 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
825 Sfile_name_all_versions, 2, 2, 0,
826 doc: /* Return a list of all versions of file name FILE in directory DIRECTORY. */)
827 (file, directory)
828 Lisp_Object file, directory;
830 return file_name_completion (file, directory, 1, 1);
833 DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
834 doc: /* Return the maximum number of versions allowed for FILE.
835 Returns nil if the file cannot be opened or if there is no version limit. */)
836 (filename)
837 Lisp_Object filename;
839 Lisp_Object retval;
840 struct FAB fab;
841 struct RAB rab;
842 struct XABFHC xabfhc;
843 int status;
845 filename = Fexpand_file_name (filename, Qnil);
846 fab = cc$rms_fab;
847 xabfhc = cc$rms_xabfhc;
848 fab.fab$l_fna = SDATA (filename);
849 fab.fab$b_fns = strlen (fab.fab$l_fna);
850 fab.fab$l_xab = (char *) &xabfhc;
851 status = sys$open (&fab, 0, 0);
852 if (status != RMS$_NORMAL) /* Probably non-existent file */
853 return Qnil;
854 sys$close (&fab, 0, 0);
855 if (xabfhc.xab$w_verlimit == 32767)
856 return Qnil; /* No version limit */
857 else
858 return make_number (xabfhc.xab$w_verlimit);
861 #endif /* VMS */
863 Lisp_Object
864 make_time (time)
865 time_t time;
867 return Fcons (make_number (time >> 16),
868 Fcons (make_number (time & 0177777), Qnil));
871 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
872 doc: /* Return a list of attributes of file FILENAME.
873 Value is nil if specified file cannot be opened.
875 ID-FORMAT specifies the preferred format of attributes uid and gid (see
876 below) - valid values are 'string and 'integer. The latter is the default,
877 but we plan to change that, so you should specify a non-nil value for
878 ID-FORMAT if you use the returned uid or gid.
880 Elements of the attribute list are:
881 0. t for directory, string (name linked to) for symbolic link, or nil.
882 1. Number of links to file.
883 2. File uid as a string or an integer. If a string value cannot be
884 looked up, the integer value is returned.
885 3. File gid, likewise.
886 4. Last access time, as a list of two integers.
887 First integer has high-order 16 bits of time, second has low 16 bits.
888 5. Last modification time, likewise.
889 6. Last status change time, likewise.
890 7. Size in bytes.
891 This is a floating point number if the size is too large for an integer.
892 8. File modes, as a string of ten letters or dashes as in ls -l.
893 9. t iff file's gid would change if file were deleted and recreated.
894 10. inode number. If inode number is larger than the Emacs integer,
895 this is a cons cell containing two integers: first the high part,
896 then the low 16 bits.
897 11. Device number. If it is larger than the Emacs integer, this is
898 a cons cell, similar to the inode number. */)
899 (filename, id_format)
900 Lisp_Object filename, id_format;
902 Lisp_Object values[12];
903 Lisp_Object encoded;
904 struct stat s;
905 struct passwd *pw;
906 struct group *gr;
907 #if defined (BSD4_2) || defined (BSD4_3)
908 Lisp_Object dirname;
909 struct stat sdir;
910 #endif
911 char modes[10];
912 Lisp_Object handler;
913 struct gcpro gcpro1;
915 filename = Fexpand_file_name (filename, Qnil);
917 /* If the file name has special constructs in it,
918 call the corresponding file handler. */
919 handler = Ffind_file_name_handler (filename, Qfile_attributes);
920 if (!NILP (handler))
921 { /* Only pass the extra arg if it is used to help backward compatibility
922 with old file handlers which do not implement the new arg. --Stef */
923 if (NILP (id_format))
924 return call2 (handler, Qfile_attributes, filename);
925 else
926 return call3 (handler, Qfile_attributes, filename, id_format);
929 GCPRO1 (filename);
930 encoded = ENCODE_FILE (filename);
931 UNGCPRO;
933 if (lstat (SDATA (encoded), &s) < 0)
934 return Qnil;
936 switch (s.st_mode & S_IFMT)
938 default:
939 values[0] = Qnil; break;
940 case S_IFDIR:
941 values[0] = Qt; break;
942 #ifdef S_IFLNK
943 case S_IFLNK:
944 values[0] = Ffile_symlink_p (filename); break;
945 #endif
947 values[1] = make_number (s.st_nlink);
948 if (NILP (id_format) || EQ (id_format, Qinteger))
950 values[2] = make_number (s.st_uid);
951 values[3] = make_number (s.st_gid);
953 else
955 BLOCK_INPUT;
956 pw = (struct passwd *) getpwuid (s.st_uid);
957 values[2] = (pw ? build_string (pw->pw_name) : make_number (s.st_uid));
958 gr = (struct group *) getgrgid (s.st_gid);
959 values[3] = (gr ? build_string (gr->gr_name) : make_number (s.st_gid));
960 UNBLOCK_INPUT;
962 values[4] = make_time (s.st_atime);
963 values[5] = make_time (s.st_mtime);
964 values[6] = make_time (s.st_ctime);
965 values[7] = make_number (s.st_size);
966 /* If the size is out of range for an integer, return a float. */
967 if (XINT (values[7]) != s.st_size)
968 values[7] = make_float ((double)s.st_size);
969 /* If the size is negative, and its type is long, convert it back to
970 positive. */
971 if (s.st_size < 0 && sizeof (s.st_size) == sizeof (long))
972 values[7] = make_float ((double) ((unsigned long) s.st_size));
974 filemodestring (&s, modes);
975 values[8] = make_string (modes, 10);
976 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
977 dirname = Ffile_name_directory (filename);
978 if (! NILP (dirname))
979 encoded = ENCODE_FILE (dirname);
980 if (! NILP (dirname) && stat (SDATA (encoded), &sdir) == 0)
981 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
982 else /* if we can't tell, assume worst */
983 values[9] = Qt;
984 #else /* file gid will be egid */
985 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
986 #endif /* BSD4_2 (or BSD4_3) */
987 if (FIXNUM_OVERFLOW_P (s.st_ino))
988 /* To allow inode numbers larger than VALBITS, separate the bottom
989 16 bits. */
990 values[10] = Fcons (make_number (s.st_ino >> 16),
991 make_number (s.st_ino & 0xffff));
992 else
993 /* But keep the most common cases as integers. */
994 values[10] = make_number (s.st_ino);
996 /* Likewise for device. */
997 if (FIXNUM_OVERFLOW_P (s.st_dev))
998 values[11] = Fcons (make_number (s.st_dev >> 16),
999 make_number (s.st_dev & 0xffff));
1000 else
1001 values[11] = make_number (s.st_dev);
1003 return Flist (sizeof(values) / sizeof(values[0]), values);
1006 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
1007 doc: /* Return t if first arg file attributes list is less than second.
1008 Comparison is in lexicographic order and case is significant. */)
1009 (f1, f2)
1010 Lisp_Object f1, f2;
1012 return Fstring_lessp (Fcar (f1), Fcar (f2));
1015 void
1016 syms_of_dired ()
1018 Qdirectory_files = intern ("directory-files");
1019 Qdirectory_files_and_attributes = intern ("directory-files-and-attributes");
1020 Qfile_name_completion = intern ("file-name-completion");
1021 Qfile_name_all_completions = intern ("file-name-all-completions");
1022 Qfile_attributes = intern ("file-attributes");
1023 Qfile_attributes_lessp = intern ("file-attributes-lessp");
1025 staticpro (&Qdirectory_files);
1026 staticpro (&Qdirectory_files_and_attributes);
1027 staticpro (&Qfile_name_completion);
1028 staticpro (&Qfile_name_all_completions);
1029 staticpro (&Qfile_attributes);
1030 staticpro (&Qfile_attributes_lessp);
1032 defsubr (&Sdirectory_files);
1033 defsubr (&Sdirectory_files_and_attributes);
1034 defsubr (&Sfile_name_completion);
1035 #ifdef VMS
1036 defsubr (&Sfile_name_all_versions);
1037 defsubr (&Sfile_version_limit);
1038 #endif /* VMS */
1039 defsubr (&Sfile_name_all_completions);
1040 defsubr (&Sfile_attributes);
1041 defsubr (&Sfile_attributes_lessp);
1043 #ifdef VMS
1044 Qcompletion_ignore_case = intern ("completion-ignore-case");
1045 staticpro (&Qcompletion_ignore_case);
1046 #endif /* VMS */
1048 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
1049 doc: /* Completion ignores file names ending in any string in this list.
1050 It does not ignore them if all possible completions end in one of
1051 these strings or when displaying a list of completions.
1052 It ignores directory names if they match any string in this list which
1053 ends in a slash. */);
1054 Vcompletion_ignored_extensions = Qnil;
1057 /* arch-tag: 1ac8deca-4d8f-4d41-ade9-089154d98c03
1058 (do not change this comment) */