Fix autorevert-tests on MS-Windows
[emacs.git] / src / dired.c
blob5ea00fb8db47bf5f2037ec80b530b342e53b3d28
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985-1986, 1993-1994, 1999-2017 Free Software
3 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 (at
10 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/stat.h>
26 #ifdef HAVE_PWD_H
27 #include <pwd.h>
28 #endif
29 #include <grp.h>
31 #include <errno.h>
32 #include <fcntl.h>
33 #include <unistd.h>
35 #include <dirent.h>
36 #include <filemode.h>
37 #include <stat-time.h>
39 #include "lisp.h"
40 #include "systime.h"
41 #include "buffer.h"
42 #include "coding.h"
43 #include "regex.h"
45 #ifdef MSDOS
46 #include "msdos.h" /* for fstatat */
47 #endif
49 #ifdef WINDOWSNT
50 extern int is_slow_fs (const char *);
51 #endif
53 static ptrdiff_t scmp (const char *, const char *, ptrdiff_t);
54 static Lisp_Object file_attributes (int, char const *, Lisp_Object);
56 /* Return the number of bytes in DP's name. */
57 static ptrdiff_t
58 dirent_namelen (struct dirent *dp)
60 #ifdef _D_EXACT_NAMLEN
61 return _D_EXACT_NAMLEN (dp);
62 #else
63 return strlen (dp->d_name);
64 #endif
67 static DIR *
68 open_directory (Lisp_Object dirname, int *fdp)
70 char *name = SSDATA (dirname);
71 DIR *d;
72 int fd, opendir_errno;
74 #ifdef DOS_NT
75 /* Directories cannot be opened. The emulation assumes that any
76 file descriptor other than AT_FDCWD corresponds to the most
77 recently opened directory. This hack is good enough for Emacs. */
78 fd = 0;
79 d = opendir (name);
80 opendir_errno = errno;
81 #else
82 fd = emacs_open (name, O_RDONLY | O_DIRECTORY, 0);
83 if (fd < 0)
85 opendir_errno = errno;
86 d = 0;
88 else
90 d = fdopendir (fd);
91 opendir_errno = errno;
92 if (! d)
93 emacs_close (fd);
95 #endif
97 if (!d)
98 report_file_errno ("Opening directory", dirname, opendir_errno);
99 *fdp = fd;
100 return d;
103 #ifdef WINDOWSNT
104 static void
105 directory_files_internal_w32_unwind (Lisp_Object arg)
107 Vw32_get_true_file_attributes = arg;
109 #endif
111 static void
112 directory_files_internal_unwind (void *d)
114 closedir (d);
117 /* Return the next directory entry from DIR; DIR's name is DIRNAME.
118 If there are no more directory entries, return a null pointer.
119 Signal any unrecoverable errors. */
121 static struct dirent *
122 read_dirent (DIR *dir, Lisp_Object dirname)
124 while (true)
126 errno = 0;
127 struct dirent *dp = readdir (dir);
128 if (dp || errno == 0)
129 return dp;
130 if (! (errno == EAGAIN || errno == EINTR))
132 #ifdef WINDOWSNT
133 /* The MS-Windows implementation of 'opendir' doesn't
134 actually open a directory until the first call to
135 'readdir'. If 'readdir' fails to open the directory, it
136 sets errno to ENOENT or EACCES, see w32.c. */
137 if (errno == ENOENT || errno == EACCES)
138 report_file_error ("Opening directory", dirname);
139 #endif
140 report_file_error ("Reading directory", dirname);
142 maybe_quit ();
146 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
147 If not ATTRS, return a list of directory filenames;
148 if ATTRS, return a list of directory filenames and their attributes.
149 In the latter case, ID_FORMAT is passed to Ffile_attributes. */
151 Lisp_Object
152 directory_files_internal (Lisp_Object directory, Lisp_Object full,
153 Lisp_Object match, Lisp_Object nosort, bool attrs,
154 Lisp_Object id_format)
156 ptrdiff_t directory_nbytes;
157 Lisp_Object list, dirfilename, encoded_directory;
158 struct re_pattern_buffer *bufp = NULL;
159 bool needsep = 0;
160 ptrdiff_t count = SPECPDL_INDEX ();
161 #ifdef WINDOWSNT
162 Lisp_Object w32_save = Qnil;
163 #endif
165 /* Don't let the compiler optimize away all copies of DIRECTORY,
166 which would break GC; see Bug#16986. */
167 Lisp_Object volatile directory_volatile = directory;
169 /* Because of file name handlers, these functions might call
170 Ffuncall, and cause a GC. */
171 list = encoded_directory = dirfilename = Qnil;
172 dirfilename = Fdirectory_file_name (directory);
174 if (!NILP (match))
176 CHECK_STRING (match);
178 /* MATCH might be a flawed regular expression. Rather than
179 catching and signaling our own errors, we just call
180 compile_pattern to do the work for us. */
181 /* Pass 1 for the MULTIBYTE arg
182 because we do make multibyte strings if the contents warrant. */
183 # ifdef WINDOWSNT
184 /* Windows users want case-insensitive wildcards. */
185 bufp = compile_pattern (match, 0,
186 BVAR (&buffer_defaults, case_canon_table), 0, 1);
187 # else /* !WINDOWSNT */
188 bufp = compile_pattern (match, 0, Qnil, 0, 1);
189 # endif /* !WINDOWSNT */
192 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
193 run_pre_post_conversion_on_str which calls Lisp directly and
194 indirectly. */
195 dirfilename = ENCODE_FILE (dirfilename);
196 encoded_directory = ENCODE_FILE (directory);
198 /* Now *bufp is the compiled form of MATCH; don't call anything
199 which might compile a new regexp until we're done with the loop! */
201 int fd;
202 DIR *d = open_directory (dirfilename, &fd);
204 /* Unfortunately, we can now invoke expand-file-name and
205 file-attributes on filenames, both of which can throw, so we must
206 do a proper unwind-protect. */
207 record_unwind_protect_ptr (directory_files_internal_unwind, d);
209 #ifdef WINDOWSNT
210 if (attrs)
212 /* Do this only once to avoid doing it (in w32.c:stat) for each
213 file in the directory, when we call Ffile_attributes below. */
214 record_unwind_protect (directory_files_internal_w32_unwind,
215 Vw32_get_true_file_attributes);
216 w32_save = Vw32_get_true_file_attributes;
217 if (EQ (Vw32_get_true_file_attributes, Qlocal))
219 /* w32.c:stat will notice these bindings and avoid calling
220 GetDriveType for each file. */
221 if (is_slow_fs (SSDATA (dirfilename)))
222 Vw32_get_true_file_attributes = Qnil;
223 else
224 Vw32_get_true_file_attributes = Qt;
227 #endif
229 directory_nbytes = SBYTES (directory);
230 re_match_object = Qt;
232 /* Decide whether we need to add a directory separator. */
233 if (directory_nbytes == 0
234 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
235 needsep = 1;
237 /* Loop reading directory entries. */
238 for (struct dirent *dp; (dp = read_dirent (d, directory)); )
240 ptrdiff_t len = dirent_namelen (dp);
241 Lisp_Object name = make_unibyte_string (dp->d_name, len);
242 Lisp_Object finalname = name;
244 /* Note: DECODE_FILE can GC; it should protect its argument,
245 though. */
246 name = DECODE_FILE (name);
247 len = SBYTES (name);
249 /* Now that we have unwind_protect in place, we might as well
250 allow matching to be interrupted. */
251 maybe_quit ();
253 bool wanted = (NILP (match)
254 || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0);
256 if (wanted)
258 if (!NILP (full))
260 Lisp_Object fullname;
261 ptrdiff_t nbytes = len + directory_nbytes + needsep;
262 ptrdiff_t nchars;
264 fullname = make_uninit_multibyte_string (nbytes, nbytes);
265 memcpy (SDATA (fullname), SDATA (directory),
266 directory_nbytes);
268 if (needsep)
269 SSET (fullname, directory_nbytes, DIRECTORY_SEP);
271 memcpy (SDATA (fullname) + directory_nbytes + needsep,
272 SDATA (name), len);
274 nchars = multibyte_chars_in_text (SDATA (fullname), nbytes);
276 /* Some bug somewhere. */
277 if (nchars > nbytes)
278 emacs_abort ();
280 STRING_SET_CHARS (fullname, nchars);
281 if (nchars == nbytes)
282 STRING_SET_UNIBYTE (fullname);
284 finalname = fullname;
286 else
287 finalname = name;
289 if (attrs)
291 Lisp_Object fileattrs
292 = file_attributes (fd, dp->d_name, id_format);
293 list = Fcons (Fcons (finalname, fileattrs), list);
295 else
296 list = Fcons (finalname, list);
300 closedir (d);
301 #ifdef WINDOWSNT
302 if (attrs)
303 Vw32_get_true_file_attributes = w32_save;
304 #endif
306 /* Discard the unwind protect. */
307 specpdl_ptr = specpdl + count;
309 if (NILP (nosort))
310 list = Fsort (Fnreverse (list),
311 attrs ? Qfile_attributes_lessp : Qstring_lessp);
313 (void) directory_volatile;
314 return list;
318 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
319 doc: /* Return a list of names of files in DIRECTORY.
320 There are three optional arguments:
321 If FULL is non-nil, return absolute file names. Otherwise return names
322 that are relative to the specified directory.
323 If MATCH is non-nil, mention only file names that match the regexp MATCH.
324 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
325 Otherwise, the list returned is sorted with `string-lessp'.
326 NOSORT is useful if you plan to sort the result yourself. */)
327 (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort)
329 Lisp_Object handler;
330 directory = Fexpand_file_name (directory, Qnil);
332 /* If the file name has special constructs in it,
333 call the corresponding file handler. */
334 handler = Ffind_file_name_handler (directory, Qdirectory_files);
335 if (!NILP (handler))
336 return call5 (handler, Qdirectory_files, directory,
337 full, match, nosort);
339 return directory_files_internal (directory, full, match, nosort, 0, Qnil);
342 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
343 Sdirectory_files_and_attributes, 1, 5, 0,
344 doc: /* Return a list of names of files and their attributes in DIRECTORY.
345 There are four optional arguments:
346 If FULL is non-nil, return absolute file names. Otherwise return names
347 that are relative to the specified directory.
348 If MATCH is non-nil, mention only file names that match the regexp MATCH.
349 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
350 NOSORT is useful if you plan to sort the result yourself.
351 ID-FORMAT specifies the preferred format of attributes uid and gid, see
352 `file-attributes' for further documentation.
353 On MS-Windows, performance depends on `w32-get-true-file-attributes',
354 which see. */)
355 (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, Lisp_Object id_format)
357 Lisp_Object handler;
358 directory = Fexpand_file_name (directory, Qnil);
360 /* If the file name has special constructs in it,
361 call the corresponding file handler. */
362 handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
363 if (!NILP (handler))
364 return call6 (handler, Qdirectory_files_and_attributes,
365 directory, full, match, nosort, id_format);
367 return directory_files_internal (directory, full, match, nosort, 1, id_format);
371 static Lisp_Object file_name_completion (Lisp_Object, Lisp_Object, bool,
372 Lisp_Object);
374 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
375 2, 3, 0,
376 doc: /* Complete file name FILE in directory DIRECTORY.
377 Returns the longest string
378 common to all file names in DIRECTORY that start with FILE.
379 If there is only one and FILE matches it exactly, returns t.
380 Returns nil if DIRECTORY contains no name starting with FILE.
382 If PREDICATE is non-nil, call PREDICATE with each possible
383 completion (in absolute form) and ignore it if PREDICATE returns nil.
385 This function ignores some of the possible completions as determined
386 by the variables `completion-regexp-list' and
387 `completion-ignored-extensions', which see. `completion-regexp-list'
388 is matched against file and directory names relative to DIRECTORY. */)
389 (Lisp_Object file, Lisp_Object directory, Lisp_Object predicate)
391 Lisp_Object handler;
392 directory = Fexpand_file_name (directory, Qnil);
394 /* If the directory name has special constructs in it,
395 call the corresponding file handler. */
396 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
397 if (!NILP (handler))
398 return call4 (handler, Qfile_name_completion, file, directory, predicate);
400 /* If the file name has special constructs in it,
401 call the corresponding file handler. */
402 handler = Ffind_file_name_handler (file, Qfile_name_completion);
403 if (!NILP (handler))
404 return call4 (handler, Qfile_name_completion, file, directory, predicate);
406 return file_name_completion (file, directory, 0, predicate);
409 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
410 Sfile_name_all_completions, 2, 2, 0,
411 doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
412 These are all file names in directory DIRECTORY which begin with FILE.
414 This function ignores some of the possible completions as determined
415 by `completion-regexp-list', which see. `completion-regexp-list'
416 is matched against file and directory names relative to DIRECTORY. */)
417 (Lisp_Object file, Lisp_Object directory)
419 Lisp_Object handler;
420 directory = Fexpand_file_name (directory, Qnil);
422 /* If the directory name has special constructs in it,
423 call the corresponding file handler. */
424 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
425 if (!NILP (handler))
426 return call3 (handler, Qfile_name_all_completions, file, directory);
428 /* If the file name has special constructs in it,
429 call the corresponding file handler. */
430 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
431 if (!NILP (handler))
432 return call3 (handler, Qfile_name_all_completions, file, directory);
434 return file_name_completion (file, directory, 1, Qnil);
437 static int file_name_completion_stat (int, struct dirent *, struct stat *);
439 static Lisp_Object
440 file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
441 Lisp_Object predicate)
443 ptrdiff_t bestmatchsize = 0;
444 int matchcount = 0;
445 /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
446 If ALL_FLAG is 0, BESTMATCH is either nil
447 or the best match so far, not decoded. */
448 Lisp_Object bestmatch, tem, elt, name;
449 Lisp_Object encoded_file;
450 Lisp_Object encoded_dir;
451 struct stat st;
452 bool directoryp;
453 /* If not INCLUDEALL, exclude files in completion-ignored-extensions as
454 well as "." and "..". Until shown otherwise, assume we can't exclude
455 anything. */
456 bool includeall = 1;
457 bool check_decoded = false;
458 ptrdiff_t count = SPECPDL_INDEX ();
460 elt = Qnil;
462 CHECK_STRING (file);
464 bestmatch = Qnil;
465 encoded_file = encoded_dir = Qnil;
466 specbind (Qdefault_directory, dirname);
468 /* Do completion on the encoded file name
469 because the other names in the directory are (we presume)
470 encoded likewise. We decode the completed string at the end. */
471 /* Actually, this is not quite true any more: we do most of the completion
472 work with decoded file names, but we still do some filtering based
473 on the encoded file name. */
474 encoded_file = ENCODE_FILE (file);
475 encoded_dir = ENCODE_FILE (Fdirectory_file_name (dirname));
477 Lisp_Object file_encoding = Vfile_name_coding_system;
478 if (NILP (Vfile_name_coding_system))
479 file_encoding = Vdefault_file_name_coding_system;
480 /* If the file-name encoding decomposes characters, as we do for
481 HFS+ filesystems, we need to make an additional comparison of
482 decoded names in order to filter false positives, such as "a"
483 falsely matching "a-ring". */
484 if (!NILP (file_encoding)
485 && !NILP (Fplist_get (Fcoding_system_plist (file_encoding),
486 Qdecomposed_characters)))
488 check_decoded = true;
489 if (STRING_MULTIBYTE (file))
491 /* Recompute FILE to make sure any decomposed characters in
492 it are re-composed by the post-read-conversion.
493 Otherwise, any decomposed characters will be rejected by
494 the additional check below. */
495 file = DECODE_FILE (encoded_file);
498 int fd;
499 DIR *d = open_directory (encoded_dir, &fd);
500 record_unwind_protect_ptr (directory_files_internal_unwind, d);
502 /* Loop reading directory entries. */
503 for (struct dirent *dp; (dp = read_dirent (d, dirname)); )
505 ptrdiff_t len = dirent_namelen (dp);
506 bool canexclude = 0;
508 maybe_quit ();
509 if (len < SCHARS (encoded_file)
510 || (scmp (dp->d_name, SSDATA (encoded_file),
511 SCHARS (encoded_file))
512 >= 0))
513 continue;
515 if (file_name_completion_stat (fd, dp, &st) < 0)
516 continue;
518 directoryp = S_ISDIR (st.st_mode) != 0;
519 tem = Qnil;
520 /* If all_flag is set, always include all.
521 It would not actually be helpful to the user to ignore any possible
522 completions when making a list of them. */
523 if (!all_flag)
525 ptrdiff_t skip;
527 #if 0 /* FIXME: The `scmp' call compares an encoded and a decoded string. */
528 /* If this entry matches the current bestmatch, the only
529 thing it can do is increase matchcount, so don't bother
530 investigating it any further. */
531 if (!completion_ignore_case
532 /* The return result depends on whether it's the sole match. */
533 && matchcount > 1
534 && !includeall /* This match may allow includeall to 0. */
535 && len >= bestmatchsize
536 && 0 > scmp (dp->d_name, SSDATA (bestmatch), bestmatchsize))
537 continue;
538 #endif
540 if (directoryp)
542 #ifndef TRIVIAL_DIRECTORY_ENTRY
543 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
544 #endif
545 /* "." and ".." are never interesting as completions, and are
546 actually in the way in a directory with only one file. */
547 if (TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
548 canexclude = 1;
549 else if (len > SCHARS (encoded_file))
550 /* Ignore directories if they match an element of
551 completion-ignored-extensions which ends in a slash. */
552 for (tem = Vcompletion_ignored_extensions;
553 CONSP (tem); tem = XCDR (tem))
555 ptrdiff_t elt_len;
556 char *p1;
558 elt = XCAR (tem);
559 if (!STRINGP (elt))
560 continue;
561 /* Need to encode ELT, since scmp compares unibyte
562 strings only. */
563 elt = ENCODE_FILE (elt);
564 elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
565 if (elt_len <= 0)
566 continue;
567 p1 = SSDATA (elt);
568 if (p1[elt_len] != '/')
569 continue;
570 skip = len - elt_len;
571 if (skip < 0)
572 continue;
574 if (scmp (dp->d_name + skip, p1, elt_len) >= 0)
575 continue;
576 break;
579 else
581 /* Compare extensions-to-be-ignored against end of this file name */
582 /* if name is not an exact match against specified string */
583 if (len > SCHARS (encoded_file))
584 /* and exit this for loop if a match is found */
585 for (tem = Vcompletion_ignored_extensions;
586 CONSP (tem); tem = XCDR (tem))
588 elt = XCAR (tem);
589 if (!STRINGP (elt)) continue;
590 /* Need to encode ELT, since scmp compares unibyte
591 strings only. */
592 elt = ENCODE_FILE (elt);
593 skip = len - SCHARS (elt);
594 if (skip < 0) continue;
596 if (scmp (dp->d_name + skip, SSDATA (elt), SCHARS (elt))
597 >= 0)
598 continue;
599 break;
603 /* If an ignored-extensions match was found,
604 don't process this name as a completion. */
605 if (CONSP (tem))
606 canexclude = 1;
608 if (!includeall && canexclude)
609 /* We're not including all files and this file can be excluded. */
610 continue;
612 if (includeall && !canexclude)
613 { /* If we have one non-excludable file, we want to exclude the
614 excludable files. */
615 includeall = 0;
616 /* Throw away any previous excludable match found. */
617 bestmatch = Qnil;
618 bestmatchsize = 0;
619 matchcount = 0;
622 /* FIXME: If we move this `decode' earlier we can eliminate
623 the repeated ENCODE_FILE on Vcompletion_ignored_extensions. */
624 name = make_unibyte_string (dp->d_name, len);
625 name = DECODE_FILE (name);
628 Lisp_Object regexps, table = (completion_ignore_case
629 ? Vascii_canon_table : Qnil);
631 /* Ignore this element if it fails to match all the regexps. */
632 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
633 regexps = XCDR (regexps))
634 if (fast_string_match_internal (XCAR (regexps), name, table) < 0)
635 break;
637 if (CONSP (regexps))
638 continue;
641 /* This is a possible completion */
642 if (directoryp)
643 /* This completion is a directory; make it end with '/'. */
644 name = Ffile_name_as_directory (name);
646 /* Test the predicate, if any. */
647 if (!NILP (predicate) && NILP (call1 (predicate, name)))
648 continue;
650 /* Reject entries where the encoded strings match, but the
651 decoded don't. For example, "a" should not match "a-ring" on
652 file systems that store decomposed characters. */
653 Lisp_Object zero = make_number (0);
655 if (check_decoded && SCHARS (file) <= SCHARS (name))
657 /* FIXME: This is a copy of the code below. */
658 ptrdiff_t compare = SCHARS (file);
659 Lisp_Object cmp
660 = Fcompare_strings (name, zero, make_number (compare),
661 file, zero, make_number (compare),
662 completion_ignore_case ? Qt : Qnil);
663 if (!EQ (cmp, Qt))
664 continue;
667 /* Suitably record this match. */
669 matchcount += matchcount <= 1;
671 if (all_flag)
672 bestmatch = Fcons (name, bestmatch);
673 else if (NILP (bestmatch))
675 bestmatch = name;
676 bestmatchsize = SCHARS (name);
678 else
680 /* FIXME: This is a copy of the code in Ftry_completion. */
681 ptrdiff_t compare = min (bestmatchsize, SCHARS (name));
682 Lisp_Object cmp
683 = Fcompare_strings (bestmatch, zero, make_number (compare),
684 name, zero, make_number (compare),
685 completion_ignore_case ? Qt : Qnil);
686 ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XINT (cmp)) - 1;
688 if (completion_ignore_case)
690 /* If this is an exact match except for case,
691 use it as the best match rather than one that is not
692 an exact match. This way, we get the case pattern
693 of the actual match. */
694 /* This tests that the current file is an exact match
695 but BESTMATCH is not (it is too long). */
696 if ((matchsize == SCHARS (name)
697 && matchsize + directoryp < SCHARS (bestmatch))
699 /* If there is no exact match ignoring case,
700 prefer a match that does not change the case
701 of the input. */
702 /* If there is more than one exact match aside from
703 case, and one of them is exact including case,
704 prefer that one. */
705 /* This == checks that, of current file and BESTMATCH,
706 either both or neither are exact. */
707 (((matchsize == SCHARS (name))
709 (matchsize + directoryp == SCHARS (bestmatch)))
710 && (cmp = Fcompare_strings (name, zero,
711 make_number (SCHARS (file)),
712 file, zero,
713 Qnil,
714 Qnil),
715 EQ (Qt, cmp))
716 && (cmp = Fcompare_strings (bestmatch, zero,
717 make_number (SCHARS (file)),
718 file, zero,
719 Qnil,
720 Qnil),
721 ! EQ (Qt, cmp))))
722 bestmatch = name;
724 bestmatchsize = matchsize;
726 /* If the best completion so far is reduced to the string
727 we're trying to complete, then we already know there's no
728 other completion, so there's no point looking any further. */
729 if (matchsize <= SCHARS (file)
730 && !includeall /* A future match may allow includeall to 0. */
731 /* If completion-ignore-case is non-nil, don't
732 short-circuit because we want to find the best
733 possible match *including* case differences. */
734 && (!completion_ignore_case || matchsize == 0)
735 /* The return value depends on whether it's the sole match. */
736 && matchcount > 1)
737 break;
742 /* This closes the directory. */
743 bestmatch = unbind_to (count, bestmatch);
745 if (all_flag || NILP (bestmatch))
746 return bestmatch;
747 /* Return t if the supplied string is an exact match (counting case);
748 it does not require any change to be made. */
749 if (matchcount == 1 && !NILP (Fequal (bestmatch, file)))
750 return Qt;
751 bestmatch = Fsubstring (bestmatch, make_number (0),
752 make_number (bestmatchsize));
753 return bestmatch;
756 /* Compare exactly LEN chars of strings at S1 and S2,
757 ignoring case if appropriate.
758 Return -1 if strings match,
759 else number of chars that match at the beginning. */
761 static ptrdiff_t
762 scmp (const char *s1, const char *s2, ptrdiff_t len)
764 register ptrdiff_t l = len;
766 if (completion_ignore_case)
768 while (l
769 && (downcase ((unsigned char) *s1++)
770 == downcase ((unsigned char) *s2++)))
771 l--;
773 else
775 while (l && *s1++ == *s2++)
776 l--;
778 if (l == 0)
779 return -1;
780 else
781 return len - l;
784 static int
785 file_name_completion_stat (int fd, struct dirent *dp, struct stat *st_addr)
787 int value;
789 #ifdef MSDOS
790 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
791 but aren't required here. Avoid computing the following fields:
792 st_inode, st_size and st_nlink for directories, and the execute bits
793 in st_mode for non-directory files with non-standard extensions. */
795 unsigned short save_djstat_flags = _djstat_flags;
797 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
798 #endif /* MSDOS */
800 /* We want to return success if a link points to a nonexistent file,
801 but we want to return the status for what the link points to,
802 in case it is a directory. */
803 value = fstatat (fd, dp->d_name, st_addr, AT_SYMLINK_NOFOLLOW);
804 if (value == 0 && S_ISLNK (st_addr->st_mode))
805 fstatat (fd, dp->d_name, st_addr, 0);
806 #ifdef MSDOS
807 _djstat_flags = save_djstat_flags;
808 #endif /* MSDOS */
809 return value;
812 static char *
813 stat_uname (struct stat *st)
815 #ifdef WINDOWSNT
816 return st->st_uname;
817 #else
818 struct passwd *pw = getpwuid (st->st_uid);
820 if (pw)
821 return pw->pw_name;
822 else
823 return NULL;
824 #endif
827 static char *
828 stat_gname (struct stat *st)
830 #ifdef WINDOWSNT
831 return st->st_gname;
832 #else
833 struct group *gr = getgrgid (st->st_gid);
835 if (gr)
836 return gr->gr_name;
837 else
838 return NULL;
839 #endif
842 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
843 doc: /* Return a list of attributes of file FILENAME.
844 Value is nil if specified file cannot be opened.
846 ID-FORMAT specifies the preferred format of attributes uid and gid (see
847 below) - valid values are `string' and `integer'. The latter is the
848 default, but we plan to change that, so you should specify a non-nil value
849 for ID-FORMAT if you use the returned uid or gid.
851 To access the elements returned, the following access functions are
852 provided: `file-attribute-type', `file-attribute-link-number',
853 `file-attribute-user-id', `file-attribute-group-id',
854 `file-attribute-access-time', `file-attribute-modification-time',
855 `file-attribute-status-change-time', `file-attribute-size',
856 `file-attribute-modes', `file-attribute-inode-number', and
857 `file-attribute-device-number'.
859 Elements of the attribute list are:
860 0. t for directory, string (name linked to) for symbolic link, or nil.
861 1. Number of links to file.
862 2. File uid as a string or a number. If a string value cannot be
863 looked up, a numeric value, either an integer or a float, is returned.
864 3. File gid, likewise.
865 4. Last access time, as a list of integers (HIGH LOW USEC PSEC) in the
866 same style as (current-time).
867 (See a note below about access time on FAT-based filesystems.)
868 5. Last modification time, likewise. This is the time of the last
869 change to the file's contents.
870 6. Last status change time, likewise. This is the time of last change
871 to the file's attributes: owner and group, access mode bits, etc.
872 7. Size in bytes.
873 This is a floating point number if the size is too large for an integer.
874 8. File modes, as a string of ten letters or dashes as in ls -l.
875 9. An unspecified value, present only for backward compatibility.
876 10. inode number. If it is larger than what an Emacs integer can hold,
877 this is of the form (HIGH . LOW): first the high bits, then the low 16 bits.
878 If even HIGH is too large for an Emacs integer, this is instead of the form
879 (HIGH MIDDLE . LOW): first the high bits, then the middle 24 bits,
880 and finally the low 16 bits.
881 11. Filesystem device number. If it is larger than what the Emacs
882 integer can hold, this is a cons cell, similar to the inode number.
884 On most filesystems, the combination of the inode and the device
885 number uniquely identifies the file.
887 On MS-Windows, performance depends on `w32-get-true-file-attributes',
888 which see.
890 On some FAT-based filesystems, only the date of last access is recorded,
891 so last access time will always be midnight of that day. */)
892 (Lisp_Object filename, Lisp_Object id_format)
894 Lisp_Object encoded;
895 Lisp_Object handler;
897 filename = internal_condition_case_2 (Fexpand_file_name, filename, Qnil,
898 Qt, Fidentity);
899 if (!STRINGP (filename))
900 return Qnil;
902 /* If the file name has special constructs in it,
903 call the corresponding file handler. */
904 handler = Ffind_file_name_handler (filename, Qfile_attributes);
905 if (!NILP (handler))
906 { /* Only pass the extra arg if it is used to help backward compatibility
907 with old file handlers which do not implement the new arg. --Stef */
908 if (NILP (id_format))
909 return call2 (handler, Qfile_attributes, filename);
910 else
911 return call3 (handler, Qfile_attributes, filename, id_format);
914 encoded = ENCODE_FILE (filename);
915 return file_attributes (AT_FDCWD, SSDATA (encoded), id_format);
918 static Lisp_Object
919 file_attributes (int fd, char const *name, Lisp_Object id_format)
921 struct stat s;
922 int lstat_result;
924 /* An array to hold the mode string generated by filemodestring,
925 including its terminating space and null byte. */
926 char modes[sizeof "-rwxr-xr-x "];
928 char *uname = NULL, *gname = NULL;
930 #ifdef WINDOWSNT
931 /* We usually don't request accurate owner and group info, because
932 it can be very expensive on Windows to get that, and most callers
933 of 'lstat' don't need that. But here we do want that information
934 to be accurate. */
935 w32_stat_get_owner_group = 1;
936 #endif
938 lstat_result = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW);
940 #ifdef WINDOWSNT
941 w32_stat_get_owner_group = 0;
942 #endif
944 if (lstat_result < 0)
945 return Qnil;
947 if (!(NILP (id_format) || EQ (id_format, Qinteger)))
949 uname = stat_uname (&s);
950 gname = stat_gname (&s);
953 filemodestring (&s, modes);
955 return CALLN (Flist,
956 (S_ISLNK (s.st_mode) ? emacs_readlinkat (fd, name)
957 : S_ISDIR (s.st_mode) ? Qt : Qnil),
958 make_number (s.st_nlink),
959 (uname
960 ? DECODE_SYSTEM (build_unibyte_string (uname))
961 : make_fixnum_or_float (s.st_uid)),
962 (gname
963 ? DECODE_SYSTEM (build_unibyte_string (gname))
964 : make_fixnum_or_float (s.st_gid)),
965 make_lisp_time (get_stat_atime (&s)),
966 make_lisp_time (get_stat_mtime (&s)),
967 make_lisp_time (get_stat_ctime (&s)),
969 /* If the file size is a 4-byte type, assume that
970 files of sizes in the 2-4 GiB range wrap around to
971 negative values, as this is a common bug on older
972 32-bit platforms. */
973 make_fixnum_or_float (sizeof (s.st_size) == 4
974 ? s.st_size & 0xffffffffu
975 : s.st_size),
977 make_string (modes, 10),
979 INTEGER_TO_CONS (s.st_ino),
980 INTEGER_TO_CONS (s.st_dev));
983 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
984 doc: /* Return t if first arg file attributes list is less than second.
985 Comparison is in lexicographic order and case is significant. */)
986 (Lisp_Object f1, Lisp_Object f2)
988 return Fstring_lessp (Fcar (f1), Fcar (f2));
992 DEFUN ("system-users", Fsystem_users, Ssystem_users, 0, 0, 0,
993 doc: /* Return a list of user names currently registered in the system.
994 If we don't know how to determine that on this platform, just
995 return a list with one element, taken from `user-real-login-name'. */)
996 (void)
998 Lisp_Object users = Qnil;
999 #if defined HAVE_GETPWENT && defined HAVE_ENDPWENT
1000 struct passwd *pw;
1002 while ((pw = getpwent ()))
1003 users = Fcons (DECODE_SYSTEM (build_string (pw->pw_name)), users);
1005 endpwent ();
1006 #endif
1007 if (EQ (users, Qnil))
1008 /* At least current user is always known. */
1009 users = list1 (Vuser_real_login_name);
1010 return users;
1013 DEFUN ("system-groups", Fsystem_groups, Ssystem_groups, 0, 0, 0,
1014 doc: /* Return a list of user group names currently registered in the system.
1015 The value may be nil if not supported on this platform. */)
1016 (void)
1018 Lisp_Object groups = Qnil;
1019 #if defined HAVE_GETGRENT && defined HAVE_ENDGRENT
1020 struct group *gr;
1022 while ((gr = getgrent ()))
1023 groups = Fcons (DECODE_SYSTEM (build_string (gr->gr_name)), groups);
1025 endgrent ();
1026 #endif
1027 return groups;
1030 void
1031 syms_of_dired (void)
1033 DEFSYM (Qdirectory_files, "directory-files");
1034 DEFSYM (Qdirectory_files_and_attributes, "directory-files-and-attributes");
1035 DEFSYM (Qfile_name_completion, "file-name-completion");
1036 DEFSYM (Qfile_name_all_completions, "file-name-all-completions");
1037 DEFSYM (Qfile_attributes, "file-attributes");
1038 DEFSYM (Qfile_attributes_lessp, "file-attributes-lessp");
1039 DEFSYM (Qdefault_directory, "default-directory");
1040 DEFSYM (Qdecomposed_characters, "decomposed-characters");
1042 defsubr (&Sdirectory_files);
1043 defsubr (&Sdirectory_files_and_attributes);
1044 defsubr (&Sfile_name_completion);
1045 defsubr (&Sfile_name_all_completions);
1046 defsubr (&Sfile_attributes);
1047 defsubr (&Sfile_attributes_lessp);
1048 defsubr (&Ssystem_users);
1049 defsubr (&Ssystem_groups);
1051 DEFVAR_LISP ("completion-ignored-extensions", Vcompletion_ignored_extensions,
1052 doc: /* Completion ignores file names ending in any string in this list.
1053 It does not ignore them if all possible completions end in one of
1054 these strings or when displaying a list of completions.
1055 It ignores directory names if they match any string in this list which
1056 ends in a slash. */);
1057 Vcompletion_ignored_extensions = Qnil;