Typo.
[emacs.git] / src / dired.c
blob3505448017ebe9ede096e1490fe106f99aaabcac
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006, 2007, 2008, 2009 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 3 of the License, or
10 (at your option) 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. If not, see <http://www.gnu.org/licenses/>. */
21 #include <config.h>
23 #include <stdio.h>
24 #include <sys/types.h>
25 #include <sys/stat.h>
27 #ifdef HAVE_PWD_H
28 #include <pwd.h>
29 #endif
30 #include <grp.h>
32 #include <errno.h>
34 #ifdef HAVE_UNISTD_H
35 #include <unistd.h>
36 #endif
38 /* The d_nameln member of a struct dirent includes the '\0' character
39 on some systems, but not on others. What's worse, you can't tell
40 at compile-time which one it will be, since it really depends on
41 the sort of system providing the filesystem you're reading from,
42 not the system you are running on. Paul Eggert
43 <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
44 SunOS 4.1.2 host, reading a directory that is remote-mounted from a
45 Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
47 Since applying strlen to the name always works, we'll just do that. */
48 #define NAMLEN(p) strlen (p->d_name)
50 #ifdef SYSV_SYSTEM_DIR
52 #include <dirent.h>
53 #define DIRENTRY struct dirent
55 #else /* not SYSV_SYSTEM_DIR */
57 #ifdef MSDOS
58 #include <dirent.h>
59 #else
60 #include <sys/dir.h>
61 #endif
63 #include <sys/stat.h>
65 #ifndef MSDOS
66 #define DIRENTRY struct direct
68 extern DIR *opendir ();
69 extern struct direct *readdir ();
71 #endif /* not MSDOS */
72 #endif /* not SYSV_SYSTEM_DIR */
74 /* Some versions of Cygwin don't have d_ino in `struct dirent'. */
75 #if defined(MSDOS) || defined(__CYGWIN__)
76 #define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
77 #else
78 #define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
79 #endif
81 #include "lisp.h"
82 #include "systime.h"
83 #include "buffer.h"
84 #include "commands.h"
85 #include "character.h"
86 #include "charset.h"
87 #include "coding.h"
88 #include "regex.h"
89 #include "blockinput.h"
91 /* Returns a search buffer, with a fastmap allocated and ready to go. */
92 extern struct re_pattern_buffer *compile_pattern ();
94 /* From filemode.c. Can't go in Lisp.h because of `stat'. */
95 extern void filemodestring P_ ((struct stat *, char *));
97 /* if system does not have symbolic links, it does not have lstat.
98 In that case, use ordinary stat instead. */
100 #ifndef S_IFLNK
101 #define lstat stat
102 #endif
104 extern int completion_ignore_case;
105 extern Lisp_Object Qcompletion_ignore_case;
106 extern Lisp_Object Vcompletion_regexp_list;
108 Lisp_Object Vcompletion_ignored_extensions;
109 Lisp_Object Qdirectory_files;
110 Lisp_Object Qdirectory_files_and_attributes;
111 Lisp_Object Qfile_name_completion;
112 Lisp_Object Qfile_name_all_completions;
113 Lisp_Object Qfile_attributes;
114 Lisp_Object Qfile_attributes_lessp;
116 static int scmp P_ ((unsigned char *, unsigned char *, int));
119 Lisp_Object
120 directory_files_internal_unwind (dh)
121 Lisp_Object dh;
123 DIR *d = (DIR *) XSAVE_VALUE (dh)->pointer;
124 BLOCK_INPUT;
125 closedir (d);
126 UNBLOCK_INPUT;
127 return Qnil;
130 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
131 When ATTRS is zero, return a list of directory filenames; when
132 non-zero, return a list of directory filenames and their attributes.
133 In the latter case, ID_FORMAT is passed to Ffile_attributes. */
135 Lisp_Object
136 directory_files_internal (directory, full, match, nosort, attrs, id_format)
137 Lisp_Object directory, full, match, nosort;
138 int attrs;
139 Lisp_Object id_format;
141 DIR *d;
142 int directory_nbytes;
143 Lisp_Object list, dirfilename, encoded_directory;
144 struct re_pattern_buffer *bufp = NULL;
145 int needsep = 0;
146 int count = SPECPDL_INDEX ();
147 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
148 DIRENTRY *dp;
150 /* Because of file name handlers, these functions might call
151 Ffuncall, and cause a GC. */
152 list = encoded_directory = dirfilename = Qnil;
153 GCPRO5 (match, directory, list, dirfilename, encoded_directory);
154 dirfilename = Fdirectory_file_name (directory);
156 if (!NILP (match))
158 CHECK_STRING (match);
160 /* MATCH might be a flawed regular expression. Rather than
161 catching and signaling our own errors, we just call
162 compile_pattern to do the work for us. */
163 /* Pass 1 for the MULTIBYTE arg
164 because we do make multibyte strings if the contents warrant. */
165 # ifdef WINDOWSNT
166 /* Windows users want case-insensitive wildcards. */
167 bufp = compile_pattern (match, 0,
168 buffer_defaults.case_canon_table, 0, 1);
169 # else /* !WINDOWSNT */
170 bufp = compile_pattern (match, 0, Qnil, 0, 1);
171 # endif /* !WINDOWSNT */
174 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
175 run_pre_post_conversion_on_str which calls Lisp directly and
176 indirectly. */
177 if (STRING_MULTIBYTE (dirfilename))
178 dirfilename = ENCODE_FILE (dirfilename);
179 encoded_directory = (STRING_MULTIBYTE (directory)
180 ? ENCODE_FILE (directory) : directory);
182 /* Now *bufp is the compiled form of MATCH; don't call anything
183 which might compile a new regexp until we're done with the loop! */
185 BLOCK_INPUT;
186 d = opendir (SDATA (dirfilename));
187 UNBLOCK_INPUT;
188 if (d == NULL)
189 report_file_error ("Opening directory", Fcons (directory, Qnil));
191 /* Unfortunately, we can now invoke expand-file-name and
192 file-attributes on filenames, both of which can throw, so we must
193 do a proper unwind-protect. */
194 record_unwind_protect (directory_files_internal_unwind,
195 make_save_value (d, 0));
197 directory_nbytes = SBYTES (directory);
198 re_match_object = Qt;
200 /* Decide whether we need to add a directory separator. */
201 if (directory_nbytes == 0
202 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
203 needsep = 1;
205 /* Loop reading blocks until EOF or error. */
206 for (;;)
208 errno = 0;
209 dp = readdir (d);
211 if (dp == NULL && (0
212 #ifdef EAGAIN
213 || errno == EAGAIN
214 #endif
215 #ifdef EINTR
216 || errno == EINTR
217 #endif
219 { QUIT; continue; }
221 if (dp == NULL)
222 break;
224 if (DIRENTRY_NONEMPTY (dp))
226 int len;
227 int wanted = 0;
228 Lisp_Object name, finalname;
229 struct gcpro gcpro1, gcpro2;
231 len = NAMLEN (dp);
232 name = finalname = make_unibyte_string (dp->d_name, len);
233 GCPRO2 (finalname, name);
235 /* Note: DECODE_FILE can GC; it should protect its argument,
236 though. */
237 name = DECODE_FILE (name);
238 len = SBYTES (name);
240 /* Now that we have unwind_protect in place, we might as well
241 allow matching to be interrupted. */
242 immediate_quit = 1;
243 QUIT;
245 if (NILP (match)
246 || (0 <= re_search (bufp, SDATA (name), len, 0, len, 0)))
247 wanted = 1;
249 immediate_quit = 0;
251 if (wanted)
253 if (!NILP (full))
255 Lisp_Object fullname;
256 int nbytes = len + directory_nbytes + needsep;
257 int nchars;
259 fullname = make_uninit_multibyte_string (nbytes, nbytes);
260 bcopy (SDATA (directory), SDATA (fullname),
261 directory_nbytes);
263 if (needsep)
264 SSET (fullname, directory_nbytes, DIRECTORY_SEP);
266 bcopy (SDATA (name),
267 SDATA (fullname) + directory_nbytes + needsep,
268 len);
270 nchars = chars_in_text (SDATA (fullname), nbytes);
272 /* Some bug somewhere. */
273 if (nchars > nbytes)
274 abort ();
276 STRING_SET_CHARS (fullname, nchars);
277 if (nchars == nbytes)
278 STRING_SET_UNIBYTE (fullname);
280 finalname = fullname;
282 else
283 finalname = name;
285 if (attrs)
287 /* Construct an expanded filename for the directory entry.
288 Use the decoded names for input to Ffile_attributes. */
289 Lisp_Object decoded_fullname, fileattrs;
290 struct gcpro gcpro1, gcpro2;
292 decoded_fullname = fileattrs = Qnil;
293 GCPRO2 (decoded_fullname, fileattrs);
295 /* Both Fexpand_file_name and Ffile_attributes can GC. */
296 decoded_fullname = Fexpand_file_name (name, directory);
297 fileattrs = Ffile_attributes (decoded_fullname, id_format);
299 list = Fcons (Fcons (finalname, fileattrs), list);
300 UNGCPRO;
302 else
303 list = Fcons (finalname, list);
306 UNGCPRO;
310 BLOCK_INPUT;
311 closedir (d);
312 UNBLOCK_INPUT;
314 /* Discard the unwind protect. */
315 specpdl_ptr = specpdl + count;
317 if (NILP (nosort))
318 list = Fsort (Fnreverse (list),
319 attrs ? Qfile_attributes_lessp : Qstring_lessp);
321 RETURN_UNGCPRO (list);
325 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
326 doc: /* Return a list of names of files in DIRECTORY.
327 There are three optional arguments:
328 If FULL is non-nil, return absolute file names. Otherwise return names
329 that are relative to the specified directory.
330 If MATCH is non-nil, mention only file names that match the regexp MATCH.
331 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
332 Otherwise, the list returned is sorted with `stringp-lessp'.
333 NOSORT is useful if you plan to sort the result yourself. */)
334 (directory, full, match, nosort)
335 Lisp_Object directory, full, match, nosort;
337 Lisp_Object handler;
338 directory = Fexpand_file_name (directory, Qnil);
340 /* If the file name has special constructs in it,
341 call the corresponding file handler. */
342 handler = Ffind_file_name_handler (directory, Qdirectory_files);
343 if (!NILP (handler))
344 return call5 (handler, Qdirectory_files, directory,
345 full, match, nosort);
347 return directory_files_internal (directory, full, match, nosort, 0, Qnil);
350 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
351 Sdirectory_files_and_attributes, 1, 5, 0,
352 doc: /* Return a list of names of files and their attributes in DIRECTORY.
353 There are four optional arguments:
354 If FULL is non-nil, return absolute file names. Otherwise return names
355 that are relative to the specified directory.
356 If MATCH is non-nil, mention only file names that match the regexp MATCH.
357 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
358 NOSORT is useful if you plan to sort the result yourself.
359 ID-FORMAT specifies the preferred format of attributes uid and gid, see
360 `file-attributes' for further documentation.
361 On MS-Windows, performance depends on `w32-get-true-file-attributes',
362 which see. */)
363 (directory, full, match, nosort, id_format)
364 Lisp_Object directory, full, match, nosort, id_format;
366 Lisp_Object handler;
367 directory = Fexpand_file_name (directory, Qnil);
369 /* If the file name has special constructs in it,
370 call the corresponding file handler. */
371 handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
372 if (!NILP (handler))
373 return call6 (handler, Qdirectory_files_and_attributes,
374 directory, full, match, nosort, id_format);
376 return directory_files_internal (directory, full, match, nosort, 1, id_format);
380 Lisp_Object file_name_completion ();
382 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
383 2, 3, 0,
384 doc: /* Complete file name FILE in directory DIRECTORY.
385 Returns the longest string
386 common to all file names in DIRECTORY that start with FILE.
387 If there is only one and FILE matches it exactly, returns t.
388 Returns nil if DIRECTORY contains no name starting with FILE.
390 If PREDICATE is non-nil, call PREDICATE with each possible
391 completion (in absolute form) and ignore it if PREDICATE returns nil.
393 This function ignores some of the possible completions as
394 determined by the variable `completion-ignored-extensions', which see. */)
395 (file, directory, predicate)
396 Lisp_Object file, directory, predicate;
398 Lisp_Object handler;
400 /* If the directory name has special constructs in it,
401 call the corresponding file handler. */
402 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
403 if (!NILP (handler))
404 return call4 (handler, Qfile_name_completion, file, directory, predicate);
406 /* If the file name has special constructs in it,
407 call the corresponding file handler. */
408 handler = Ffind_file_name_handler (file, Qfile_name_completion);
409 if (!NILP (handler))
410 return call4 (handler, Qfile_name_completion, file, directory, predicate);
412 return file_name_completion (file, directory, 0, 0, predicate);
415 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
416 Sfile_name_all_completions, 2, 2, 0,
417 doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
418 These are all file names in directory DIRECTORY which begin with FILE. */)
419 (file, directory)
420 Lisp_Object file, directory;
422 Lisp_Object handler;
424 /* If the directory name has special constructs in it,
425 call the corresponding file handler. */
426 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
427 if (!NILP (handler))
428 return call3 (handler, Qfile_name_all_completions, file, directory);
430 /* If the file name has special constructs in it,
431 call the corresponding file handler. */
432 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
433 if (!NILP (handler))
434 return call3 (handler, Qfile_name_all_completions, file, directory);
436 return file_name_completion (file, directory, 1, 0, Qnil);
439 static int file_name_completion_stat ();
440 Lisp_Object Qdefault_directory;
442 Lisp_Object
443 file_name_completion (file, dirname, all_flag, ver_flag, predicate)
444 Lisp_Object file, dirname;
445 int all_flag, ver_flag;
446 Lisp_Object predicate;
448 DIR *d;
449 int bestmatchsize = 0;
450 int matchcount = 0;
451 /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
452 If ALL_FLAG is 0, BESTMATCH is either nil
453 or the best match so far, not decoded. */
454 Lisp_Object bestmatch, tem, elt, name;
455 Lisp_Object encoded_file;
456 Lisp_Object encoded_dir;
457 struct stat st;
458 int directoryp;
459 /* If includeall is zero, exclude files in completion-ignored-extensions as
460 well as "." and "..". Until shown otherwise, assume we can't exclude
461 anything. */
462 int includeall = 1;
463 int count = SPECPDL_INDEX ();
464 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
466 elt = Qnil;
468 CHECK_STRING (file);
470 #ifdef FILE_SYSTEM_CASE
471 file = FILE_SYSTEM_CASE (file);
472 #endif
473 bestmatch = Qnil;
474 encoded_file = encoded_dir = Qnil;
475 GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
476 dirname = Fexpand_file_name (dirname, Qnil);
477 specbind (Qdefault_directory, dirname);
479 /* Do completion on the encoded file name
480 because the other names in the directory are (we presume)
481 encoded likewise. We decode the completed string at the end. */
482 /* Actually, this is not quite true any more: we do most of the completion
483 work with decoded file names, but we still do some filtering based
484 on the encoded file name. */
485 encoded_file = STRING_MULTIBYTE (file) ? ENCODE_FILE (file) : file;
487 encoded_dir = ENCODE_FILE (dirname);
489 BLOCK_INPUT;
490 d = opendir (SDATA (Fdirectory_file_name (encoded_dir)));
491 UNBLOCK_INPUT;
492 if (!d)
493 report_file_error ("Opening directory", Fcons (dirname, Qnil));
495 record_unwind_protect (directory_files_internal_unwind,
496 make_save_value (d, 0));
498 /* Loop reading blocks */
499 /* (att3b compiler bug requires do a null comparison this way) */
500 while (1)
502 DIRENTRY *dp;
503 int len;
504 int canexclude = 0;
506 errno = 0;
507 dp = readdir (d);
508 if (dp == NULL && (0
509 # ifdef EAGAIN
510 || errno == EAGAIN
511 # endif
512 # ifdef EINTR
513 || errno == EINTR
514 # endif
516 { QUIT; continue; }
518 if (!dp) break;
520 len = NAMLEN (dp);
522 QUIT;
523 if (! DIRENTRY_NONEMPTY (dp)
524 || len < SCHARS (encoded_file)
525 || 0 <= scmp (dp->d_name, SDATA (encoded_file),
526 SCHARS (encoded_file)))
527 continue;
529 if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
530 continue;
532 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
533 tem = Qnil;
534 /* If all_flag is set, always include all.
535 It would not actually be helpful to the user to ignore any possible
536 completions when making a list of them. */
537 if (!all_flag)
539 int skip;
541 #if 0 /* FIXME: The `scmp' call compares an encoded and a decoded string. */
542 /* If this entry matches the current bestmatch, the only
543 thing it can do is increase matchcount, so don't bother
544 investigating it any further. */
545 if (!completion_ignore_case
546 /* The return result depends on whether it's the sole match. */
547 && matchcount > 1
548 && !includeall /* This match may allow includeall to 0. */
549 && len >= bestmatchsize
550 && 0 > scmp (dp->d_name, SDATA (bestmatch), bestmatchsize))
551 continue;
552 #endif
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, and are
560 actually in the way in a directory with only one file. */
561 if (TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
562 canexclude = 1;
563 else if (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;
570 unsigned char *p1;
572 elt = XCAR (tem);
573 if (!STRINGP (elt))
574 continue;
575 /* Need to encode ELT, since scmp compares unibyte
576 strings only. */
577 elt = ENCODE_FILE (elt);
578 elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
579 if (elt_len <= 0)
580 continue;
581 p1 = SDATA (elt);
582 if (p1[elt_len] != '/')
583 continue;
584 skip = len - elt_len;
585 if (skip < 0)
586 continue;
588 if (0 <= scmp (dp->d_name + skip, p1, elt_len))
589 continue;
590 break;
593 else
595 /* Compare extensions-to-be-ignored against end of this file name */
596 /* if name is not an exact match against specified string */
597 if (len > SCHARS (encoded_file))
598 /* and exit this for loop if a match is found */
599 for (tem = Vcompletion_ignored_extensions;
600 CONSP (tem); tem = XCDR (tem))
602 elt = XCAR (tem);
603 if (!STRINGP (elt)) continue;
604 /* Need to encode ELT, since scmp compares unibyte
605 strings only. */
606 elt = ENCODE_FILE (elt);
607 skip = len - SCHARS (elt);
608 if (skip < 0) continue;
610 if (0 <= scmp (dp->d_name + skip,
611 SDATA (elt),
612 SCHARS (elt)))
613 continue;
614 break;
618 /* If an ignored-extensions match was found,
619 don't process this name as a completion. */
620 if (CONSP (tem))
621 canexclude = 1;
623 if (!includeall && canexclude)
624 /* We're not including all files and this file can be excluded. */
625 continue;
627 if (includeall && !canexclude)
628 { /* If we have one non-excludable file, we want to exclude the
629 excudable files. */
630 includeall = 0;
631 /* Throw away any previous excludable match found. */
632 bestmatch = Qnil;
633 bestmatchsize = 0;
634 matchcount = 0;
637 /* FIXME: If we move this `decode' earlier we can eliminate
638 the repeated ENCODE_FILE on Vcompletion_ignored_extensions. */
639 name = make_unibyte_string (dp->d_name, len);
640 name = DECODE_FILE (name);
643 Lisp_Object regexps;
644 Lisp_Object zero;
645 XSETFASTINT (zero, 0);
647 /* Ignore this element if it fails to match all the regexps. */
648 if (completion_ignore_case)
650 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
651 regexps = XCDR (regexps))
652 if (fast_string_match_ignore_case (XCAR (regexps), name) < 0)
653 break;
655 else
657 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
658 regexps = XCDR (regexps))
659 if (fast_string_match (XCAR (regexps), name) < 0)
660 break;
663 if (CONSP (regexps))
664 continue;
667 /* This is a possible completion */
668 if (directoryp)
669 /* This completion is a directory; make it end with '/'. */
670 name = Ffile_name_as_directory (name);
672 /* Test the predicate, if any. */
673 if (!NILP (predicate))
675 Lisp_Object val;
676 struct gcpro gcpro1;
678 GCPRO1 (name);
679 val = call1 (predicate, name);
680 UNGCPRO;
682 if (NILP (val))
683 continue;
686 /* Suitably record this match. */
688 matchcount++;
690 if (all_flag)
691 bestmatch = Fcons (name, bestmatch);
692 else if (NILP (bestmatch))
694 bestmatch = name;
695 bestmatchsize = SCHARS (name);
697 else
699 Lisp_Object zero = make_number (0);
700 /* FIXME: This is a copy of the code in Ftry_completion. */
701 int compare = min (bestmatchsize, SCHARS (name));
702 Lisp_Object tem
703 = Fcompare_strings (bestmatch, zero,
704 make_number (compare),
705 name, zero,
706 make_number (compare),
707 completion_ignore_case ? Qt : Qnil);
708 int matchsize
709 = (EQ (tem, Qt) ? compare
710 : XINT (tem) < 0 ? - XINT (tem) - 1
711 : XINT (tem) - 1);
713 if (completion_ignore_case)
715 /* If this is an exact match except for case,
716 use it as the best match rather than one that is not
717 an exact match. This way, we get the case pattern
718 of the actual match. */
719 /* This tests that the current file is an exact match
720 but BESTMATCH is not (it is too long). */
721 if ((matchsize == SCHARS (name)
722 && matchsize + !!directoryp < SCHARS (bestmatch))
724 /* If there is no exact match ignoring case,
725 prefer a match that does not change the case
726 of the input. */
727 /* If there is more than one exact match aside from
728 case, and one of them is exact including case,
729 prefer that one. */
730 /* This == checks that, of current file and BESTMATCH,
731 either both or neither are exact. */
732 (((matchsize == SCHARS (name))
734 (matchsize + !!directoryp == SCHARS (bestmatch)))
735 && (tem = Fcompare_strings (name, zero,
736 make_number (SCHARS (file)),
737 file, zero,
738 Qnil,
739 Qnil),
740 EQ (Qt, tem))
741 && (tem = Fcompare_strings (bestmatch, zero,
742 make_number (SCHARS (file)),
743 file, zero,
744 Qnil,
745 Qnil),
746 ! EQ (Qt, tem))))
747 bestmatch = name;
749 bestmatchsize = matchsize;
751 /* If the best completion so far is reduced to the string
752 we're trying to complete, then we already know there's no
753 other completion, so there's no point looking any further. */
754 if (matchsize <= SCHARS (file)
755 && !includeall /* A future match may allow includeall to 0. */
756 /* If completion-ignore-case is non-nil, don't
757 short-circuit because we want to find the best
758 possible match *including* case differences. */
759 && (!completion_ignore_case || matchsize == 0)
760 /* The return value depends on whether it's the sole match. */
761 && matchcount > 1)
762 break;
767 UNGCPRO;
768 /* This closes the directory. */
769 bestmatch = unbind_to (count, bestmatch);
771 if (all_flag || NILP (bestmatch))
772 return bestmatch;
773 /* Return t if the supplied string is an exact match (counting case);
774 it does not require any change to be made. */
775 if (matchcount == 1 && !NILP (Fequal (bestmatch, file)))
776 return Qt;
777 bestmatch = Fsubstring (bestmatch, make_number (0),
778 make_number (bestmatchsize));
779 return bestmatch;
782 /* Compare exactly LEN chars of strings at S1 and S2,
783 ignoring case if appropriate.
784 Return -1 if strings match,
785 else number of chars that match at the beginning. */
787 static int
788 scmp (s1, s2, len)
789 register unsigned char *s1, *s2;
790 int len;
792 register int l = len;
794 if (completion_ignore_case)
796 while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++))
797 l--;
799 else
801 while (l && *s1++ == *s2++)
802 l--;
804 if (l == 0)
805 return -1;
806 else
807 return len - l;
810 static int
811 file_name_completion_stat (dirname, dp, st_addr)
812 Lisp_Object dirname;
813 DIRENTRY *dp;
814 struct stat *st_addr;
816 int len = NAMLEN (dp);
817 int pos = SCHARS (dirname);
818 int value;
819 char *fullname = (char *) alloca (len + pos + 2);
821 #ifdef MSDOS
822 #if __DJGPP__ > 1
823 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
824 but aren't required here. Avoid computing the following fields:
825 st_inode, st_size and st_nlink for directories, and the execute bits
826 in st_mode for non-directory files with non-standard extensions. */
828 unsigned short save_djstat_flags = _djstat_flags;
830 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
831 #endif /* __DJGPP__ > 1 */
832 #endif /* MSDOS */
834 bcopy (SDATA (dirname), fullname, pos);
835 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
836 fullname[pos++] = DIRECTORY_SEP;
838 bcopy (dp->d_name, fullname + pos, len);
839 fullname[pos + len] = 0;
841 #ifdef S_IFLNK
842 /* We want to return success if a link points to a nonexistent file,
843 but we want to return the status for what the link points to,
844 in case it is a directory. */
845 value = lstat (fullname, st_addr);
846 stat (fullname, st_addr);
847 return value;
848 #else
849 value = stat (fullname, st_addr);
850 #ifdef MSDOS
851 #if __DJGPP__ > 1
852 _djstat_flags = save_djstat_flags;
853 #endif /* __DJGPP__ > 1 */
854 #endif /* MSDOS */
855 return value;
856 #endif /* S_IFLNK */
859 Lisp_Object
860 make_time (time)
861 time_t time;
863 return Fcons (make_number (time >> 16),
864 Fcons (make_number (time & 0177777), Qnil));
867 static char *
868 stat_uname (struct stat *st)
870 #ifdef WINDOWSNT
871 return st->st_uname;
872 #else
873 struct passwd *pw = (struct passwd *) getpwuid (st->st_uid);
875 if (pw)
876 return pw->pw_name;
877 else
878 return NULL;
879 #endif
882 static char *
883 stat_gname (struct stat *st)
885 #ifdef WINDOWSNT
886 return st->st_gname;
887 #else
888 struct group *gr = (struct group *) getgrgid (st->st_gid);
890 if (gr)
891 return gr->gr_name;
892 else
893 return NULL;
894 #endif
897 /* Make an integer or float number for UID and GID, while being
898 careful not to produce negative numbers due to signed integer
899 overflow. */
900 static Lisp_Object
901 make_uid (struct stat *st)
903 EMACS_INT uid = st->st_uid;
905 if (sizeof (st->st_uid) > sizeof (uid) || uid < 0 || FIXNUM_OVERFLOW_P (uid))
906 return make_float ((double)st->st_uid);
907 return make_number (uid);
910 static Lisp_Object
911 make_gid (struct stat *st)
913 EMACS_INT gid = st->st_gid;
915 if (sizeof (st->st_gid) > sizeof (gid) || gid < 0 || FIXNUM_OVERFLOW_P (gid))
916 return make_float ((double)st->st_gid);
917 return make_number (gid);
920 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
921 doc: /* Return a list of attributes of file FILENAME.
922 Value is nil if specified file cannot be opened.
924 ID-FORMAT specifies the preferred format of attributes uid and gid (see
925 below) - valid values are 'string and 'integer. The latter is the default,
926 but we plan to change that, so you should specify a non-nil value for
927 ID-FORMAT if you use the returned uid or gid.
929 Elements of the attribute list are:
930 0. t for directory, string (name linked to) for symbolic link, or nil.
931 1. Number of links to file.
932 2. File uid as a string or a number. If a string value cannot be
933 looked up, a numeric value, either an integer or a float, is returned.
934 3. File gid, likewise.
935 4. Last access time, as a list of two integers.
936 First integer has high-order 16 bits of time, second has low 16 bits.
937 5. Last modification time, likewise.
938 6. Last status change time, likewise.
939 7. Size in bytes.
940 This is a floating point number if the size is too large for an integer.
941 8. File modes, as a string of ten letters or dashes as in ls -l.
942 9. t if file's gid would change if file were deleted and recreated.
943 10. inode number. If inode number is larger than the Emacs integer,
944 but still fits into a 32-bit number, this is a cons cell containing two
945 integers: first the high part, then the low 16 bits. If the inode number
946 is wider than 32 bits, this is a cons cell containing three integers:
947 first the high 24 bits, then middle 24 bits, and finally the low 16 bits.
948 11. Device number. If it is larger than the Emacs integer, this is
949 a cons cell, similar to the inode number.
951 On MS-Windows, performance depends on `w32-get-true-file-attributes',
952 which see. */)
953 (filename, id_format)
954 Lisp_Object filename, id_format;
956 Lisp_Object values[12];
957 Lisp_Object encoded;
958 struct stat s;
959 #if defined (BSD4_2) || defined (BSD4_3)
960 Lisp_Object dirname;
961 struct stat sdir;
962 #endif
963 char modes[10];
964 Lisp_Object handler;
965 struct gcpro gcpro1;
966 EMACS_INT ino, uid, gid;
967 char *uname = NULL, *gname = NULL;
969 filename = Fexpand_file_name (filename, Qnil);
971 /* If the file name has special constructs in it,
972 call the corresponding file handler. */
973 handler = Ffind_file_name_handler (filename, Qfile_attributes);
974 if (!NILP (handler))
975 { /* Only pass the extra arg if it is used to help backward compatibility
976 with old file handlers which do not implement the new arg. --Stef */
977 if (NILP (id_format))
978 return call2 (handler, Qfile_attributes, filename);
979 else
980 return call3 (handler, Qfile_attributes, filename, id_format);
983 GCPRO1 (filename);
984 encoded = ENCODE_FILE (filename);
985 UNGCPRO;
987 if (lstat (SDATA (encoded), &s) < 0)
988 return Qnil;
990 switch (s.st_mode & S_IFMT)
992 default:
993 values[0] = Qnil; break;
994 case S_IFDIR:
995 values[0] = Qt; break;
996 #ifdef S_IFLNK
997 case S_IFLNK:
998 values[0] = Ffile_symlink_p (filename); break;
999 #endif
1001 values[1] = make_number (s.st_nlink);
1003 if (!(NILP (id_format) || EQ (id_format, Qinteger)))
1005 BLOCK_INPUT;
1006 uname = stat_uname (&s);
1007 gname = stat_gname (&s);
1008 UNBLOCK_INPUT;
1010 if (uname)
1011 values[2] = build_string (uname);
1012 else
1013 values[2] = make_uid (&s);
1014 if (gname)
1015 values[3] = build_string (gname);
1016 else
1017 values[3] = make_gid (&s);
1019 values[4] = make_time (s.st_atime);
1020 values[5] = make_time (s.st_mtime);
1021 values[6] = make_time (s.st_ctime);
1022 values[7] = make_number (s.st_size);
1023 /* If the size is out of range for an integer, return a float. */
1024 if (XINT (values[7]) != s.st_size)
1025 values[7] = make_float ((double)s.st_size);
1026 /* If the size is negative, and its type is long, convert it back to
1027 positive. */
1028 if (s.st_size < 0 && sizeof (s.st_size) == sizeof (long))
1029 values[7] = make_float ((double) ((unsigned long) s.st_size));
1031 filemodestring (&s, modes);
1032 values[8] = make_string (modes, 10);
1033 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
1034 dirname = Ffile_name_directory (filename);
1035 if (! NILP (dirname))
1036 encoded = ENCODE_FILE (dirname);
1037 if (! NILP (dirname) && stat (SDATA (encoded), &sdir) == 0)
1038 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
1039 else /* if we can't tell, assume worst */
1040 values[9] = Qt;
1041 #else /* file gid will be egid */
1042 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
1043 #endif /* BSD4_2 (or BSD4_3) */
1044 /* Shut up GCC warnings in FIXNUM_OVERFLOW_P below. */
1045 if (sizeof (s.st_ino) > sizeof (ino))
1046 ino = (EMACS_INT)(s.st_ino & 0xffffffff);
1047 else
1048 ino = s.st_ino;
1049 if (!FIXNUM_OVERFLOW_P (ino)
1050 && (sizeof (s.st_ino) <= sizeof (ino) || (s.st_ino & ~INTMASK) == 0))
1051 /* Keep the most common cases as integers. */
1052 values[10] = make_number (ino);
1053 else if (sizeof (s.st_ino) <= sizeof (ino)
1054 || ((s.st_ino >> 16) & ~INTMASK) == 0)
1055 /* To allow inode numbers larger than VALBITS, separate the bottom
1056 16 bits. */
1057 values[10] = Fcons (make_number ((EMACS_INT)(s.st_ino >> 16)),
1058 make_number ((EMACS_INT)(s.st_ino & 0xffff)));
1059 else
1061 /* To allow inode numbers beyond 32 bits, separate into 2 24-bit
1062 high parts and a 16-bit bottom part.
1063 The code on the next line avoids a compiler warning on
1064 systems where st_ino is 32 bit wide. (bug#766). */
1065 EMACS_INT high_ino = s.st_ino >> 31 >> 1;
1066 EMACS_INT low_ino = s.st_ino & 0xffffffff;
1068 values[10] = Fcons (make_number (high_ino >> 8),
1069 Fcons (make_number (((high_ino & 0xff) << 16)
1070 + (low_ino >> 16)),
1071 make_number (low_ino & 0xffff)));
1074 /* Likewise for device, but don't let it become negative. We used
1075 to use FIXNUM_OVERFLOW_P here, but that won't catch large
1076 positive numbers such as 0xFFEEDDCC. */
1077 if ((EMACS_INT)s.st_dev < 0
1078 || (EMACS_INT)s.st_dev > MOST_POSITIVE_FIXNUM)
1079 values[11] = Fcons (make_number (s.st_dev >> 16),
1080 make_number (s.st_dev & 0xffff));
1081 else
1082 values[11] = make_number (s.st_dev);
1084 return Flist (sizeof(values) / sizeof(values[0]), values);
1087 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
1088 doc: /* Return t if first arg file attributes list is less than second.
1089 Comparison is in lexicographic order and case is significant. */)
1090 (f1, f2)
1091 Lisp_Object f1, f2;
1093 return Fstring_lessp (Fcar (f1), Fcar (f2));
1096 void
1097 syms_of_dired ()
1099 Qdirectory_files = intern ("directory-files");
1100 Qdirectory_files_and_attributes = intern ("directory-files-and-attributes");
1101 Qfile_name_completion = intern ("file-name-completion");
1102 Qfile_name_all_completions = intern ("file-name-all-completions");
1103 Qfile_attributes = intern ("file-attributes");
1104 Qfile_attributes_lessp = intern ("file-attributes-lessp");
1105 Qdefault_directory = intern ("default-directory");
1107 staticpro (&Qdirectory_files);
1108 staticpro (&Qdirectory_files_and_attributes);
1109 staticpro (&Qfile_name_completion);
1110 staticpro (&Qfile_name_all_completions);
1111 staticpro (&Qfile_attributes);
1112 staticpro (&Qfile_attributes_lessp);
1113 staticpro (&Qdefault_directory);
1115 defsubr (&Sdirectory_files);
1116 defsubr (&Sdirectory_files_and_attributes);
1117 defsubr (&Sfile_name_completion);
1118 defsubr (&Sfile_name_all_completions);
1119 defsubr (&Sfile_attributes);
1120 defsubr (&Sfile_attributes_lessp);
1122 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
1123 doc: /* Completion ignores file names ending in any string in this list.
1124 It does not ignore them if all possible completions end in one of
1125 these strings or when displaying a list of completions.
1126 It ignores directory names if they match any string in this list which
1127 ends in a slash. */);
1128 Vcompletion_ignored_extensions = Qnil;
1131 /* arch-tag: 1ac8deca-4d8f-4d41-ade9-089154d98c03
1132 (do not change this comment) */