; doc/emacs/misc.texi (Network Security): Fix typo.
[emacs.git] / src / dired.c
blob5812c569fa6d2ffc5971af82cbfa403e145d6e9c
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985-1986, 1993-1994, 1999-2018 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 <https://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"
44 #ifdef MSDOS
45 #include "msdos.h" /* for fstatat */
46 #endif
48 #ifdef WINDOWSNT
49 extern int is_slow_fs (const char *);
50 #endif
52 static ptrdiff_t scmp (const char *, const char *, ptrdiff_t);
53 static Lisp_Object file_attributes (int, char const *, Lisp_Object,
54 Lisp_Object, 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 #ifndef HAVE_STRUCT_DIRENT_D_TYPE
68 enum { DT_UNKNOWN, DT_DIR, DT_LNK };
69 #endif
71 /* Return the file type of DP. */
72 static int
73 dirent_type (struct dirent *dp)
75 #ifdef HAVE_STRUCT_DIRENT_D_TYPE
76 return dp->d_type;
77 #else
78 return DT_UNKNOWN;
79 #endif
82 static DIR *
83 open_directory (Lisp_Object dirname, int *fdp)
85 char *name = SSDATA (dirname);
86 DIR *d;
87 int fd, opendir_errno;
89 #ifdef DOS_NT
90 /* Directories cannot be opened. The emulation assumes that any
91 file descriptor other than AT_FDCWD corresponds to the most
92 recently opened directory. This hack is good enough for Emacs. */
93 fd = 0;
94 d = opendir (name);
95 opendir_errno = errno;
96 #else
97 fd = emacs_open (name, O_RDONLY | O_DIRECTORY, 0);
98 if (fd < 0)
100 opendir_errno = errno;
101 d = 0;
103 else
105 d = fdopendir (fd);
106 opendir_errno = errno;
107 if (! d)
108 emacs_close (fd);
110 #endif
112 if (!d)
113 report_file_errno ("Opening directory", dirname, opendir_errno);
114 *fdp = fd;
115 return d;
118 #ifdef WINDOWSNT
119 static void
120 directory_files_internal_w32_unwind (Lisp_Object arg)
122 Vw32_get_true_file_attributes = arg;
124 #endif
126 static void
127 directory_files_internal_unwind (void *d)
129 closedir (d);
132 /* Return the next directory entry from DIR; DIR's name is DIRNAME.
133 If there are no more directory entries, return a null pointer.
134 Signal any unrecoverable errors. */
136 static struct dirent *
137 read_dirent (DIR *dir, Lisp_Object dirname)
139 while (true)
141 errno = 0;
142 struct dirent *dp = readdir (dir);
143 if (dp || errno == 0)
144 return dp;
145 if (! (errno == EAGAIN || errno == EINTR))
147 #ifdef WINDOWSNT
148 /* The MS-Windows implementation of 'opendir' doesn't
149 actually open a directory until the first call to
150 'readdir'. If 'readdir' fails to open the directory, it
151 sets errno to ENOENT or EACCES, see w32.c. */
152 if (errno == ENOENT || errno == EACCES)
153 report_file_error ("Opening directory", dirname);
154 #endif
155 report_file_error ("Reading directory", dirname);
157 maybe_quit ();
161 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
162 If not ATTRS, return a list of directory filenames;
163 if ATTRS, return a list of directory filenames and their attributes.
164 In the latter case, pass ID_FORMAT to file_attributes. */
166 Lisp_Object
167 directory_files_internal (Lisp_Object directory, Lisp_Object full,
168 Lisp_Object match, Lisp_Object nosort, bool attrs,
169 Lisp_Object id_format)
171 ptrdiff_t directory_nbytes;
172 Lisp_Object list, dirfilename, encoded_directory;
173 bool needsep = 0;
174 ptrdiff_t count = SPECPDL_INDEX ();
175 #ifdef WINDOWSNT
176 Lisp_Object w32_save = Qnil;
177 #endif
179 /* Don't let the compiler optimize away all copies of DIRECTORY,
180 which would break GC; see Bug#16986. */
181 Lisp_Object volatile directory_volatile = directory;
183 /* Because of file name handlers, these functions might call
184 Ffuncall, and cause a GC. */
185 list = encoded_directory = dirfilename = Qnil;
186 dirfilename = Fdirectory_file_name (directory);
188 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
189 run_pre_post_conversion_on_str which calls Lisp directly and
190 indirectly. */
191 dirfilename = ENCODE_FILE (dirfilename);
192 encoded_directory = ENCODE_FILE (directory);
194 int fd;
195 DIR *d = open_directory (dirfilename, &fd);
197 /* Unfortunately, we can now invoke expand-file-name and
198 file-attributes on filenames, both of which can throw, so we must
199 do a proper unwind-protect. */
200 record_unwind_protect_ptr (directory_files_internal_unwind, d);
202 #ifdef WINDOWSNT
203 if (attrs)
205 /* Do this only once to avoid doing it (in w32.c:stat) for each
206 file in the directory, when we call file_attributes below. */
207 record_unwind_protect (directory_files_internal_w32_unwind,
208 Vw32_get_true_file_attributes);
209 w32_save = Vw32_get_true_file_attributes;
210 if (EQ (Vw32_get_true_file_attributes, Qlocal))
212 /* w32.c:stat will notice these bindings and avoid calling
213 GetDriveType for each file. */
214 if (is_slow_fs (SSDATA (dirfilename)))
215 Vw32_get_true_file_attributes = Qnil;
216 else
217 Vw32_get_true_file_attributes = Qt;
220 #endif
222 directory_nbytes = SBYTES (directory);
223 re_match_object = Qt;
225 /* Decide whether we need to add a directory separator. */
226 if (directory_nbytes == 0
227 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
228 needsep = 1;
230 /* Windows users want case-insensitive wildcards. */
231 Lisp_Object case_table =
232 #ifdef WINDOWSNT
233 BVAR (&buffer_defaults, case_canon_table)
234 #else
235 Qnil
236 #endif
239 /* Loop reading directory entries. */
240 for (struct dirent *dp; (dp = read_dirent (d, directory)); )
242 ptrdiff_t len = dirent_namelen (dp);
243 Lisp_Object name = make_unibyte_string (dp->d_name, len);
244 Lisp_Object finalname = name;
246 /* Note: DECODE_FILE can GC; it should protect its argument,
247 though. */
248 name = DECODE_FILE (name);
249 len = SBYTES (name);
251 /* Now that we have unwind_protect in place, we might as well
252 allow matching to be interrupted. */
253 maybe_quit ();
255 bool wanted = (NILP (match) ||
256 fast_string_match_internal (
257 match, name, case_table) >= 0);
259 if (wanted)
261 if (!NILP (full))
263 Lisp_Object fullname;
264 ptrdiff_t nbytes = len + directory_nbytes + needsep;
265 ptrdiff_t nchars;
267 fullname = make_uninit_multibyte_string (nbytes, nbytes);
268 memcpy (SDATA (fullname), SDATA (directory),
269 directory_nbytes);
271 if (needsep)
272 SSET (fullname, directory_nbytes, DIRECTORY_SEP);
274 memcpy (SDATA (fullname) + directory_nbytes + needsep,
275 SDATA (name), len);
277 nchars = multibyte_chars_in_text (SDATA (fullname), nbytes);
279 /* Some bug somewhere. */
280 if (nchars > nbytes)
281 emacs_abort ();
283 STRING_SET_CHARS (fullname, nchars);
284 if (nchars == nbytes)
285 STRING_SET_UNIBYTE (fullname);
287 finalname = fullname;
289 else
290 finalname = name;
292 if (attrs)
294 Lisp_Object fileattrs
295 = file_attributes (fd, dp->d_name, directory, name, id_format);
296 list = Fcons (Fcons (finalname, fileattrs), list);
298 else
299 list = Fcons (finalname, list);
303 closedir (d);
304 #ifdef WINDOWSNT
305 if (attrs)
306 Vw32_get_true_file_attributes = w32_save;
307 #endif
309 /* Discard the unwind protect. */
310 specpdl_ptr = specpdl + count;
312 if (NILP (nosort))
313 list = Fsort (Fnreverse (list),
314 attrs ? Qfile_attributes_lessp : Qstring_lessp);
316 (void) directory_volatile;
317 return list;
321 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
322 doc: /* Return a list of names of files in DIRECTORY.
323 There are three optional arguments:
324 If FULL is non-nil, return absolute file names. Otherwise return names
325 that are relative to the specified directory.
326 If MATCH is non-nil, mention only file names that match the regexp MATCH.
327 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
328 Otherwise, the list returned is sorted with `string-lessp'.
329 NOSORT is useful if you plan to sort the result yourself. */)
330 (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort)
332 Lisp_Object handler;
333 directory = Fexpand_file_name (directory, Qnil);
335 /* If the file name has special constructs in it,
336 call the corresponding file handler. */
337 handler = Ffind_file_name_handler (directory, Qdirectory_files);
338 if (!NILP (handler))
339 return call5 (handler, Qdirectory_files, directory,
340 full, match, nosort);
342 return directory_files_internal (directory, full, match, nosort, false, Qnil);
345 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
346 Sdirectory_files_and_attributes, 1, 5, 0,
347 doc: /* Return a list of names of files and their attributes in DIRECTORY.
348 Value is a list of the form:
350 ((FILE1 FILE1-ATTRS) (FILE2 FILE2-ATTRS) ...)
352 where each FILEn-ATTRS is the attributes of FILEn as returned
353 by `file-attributes'.
355 This function accepts four optional arguments:
356 If FULL is non-nil, return absolute file names. Otherwise return names
357 that are relative to the specified directory.
358 If MATCH is non-nil, mention only file names that match the regexp MATCH.
359 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
360 NOSORT is useful if you plan to sort the result yourself.
361 ID-FORMAT specifies the preferred format of attributes uid and gid, see
362 `file-attributes' for further documentation.
363 On MS-Windows, performance depends on `w32-get-true-file-attributes',
364 which see. */)
365 (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, Lisp_Object id_format)
367 Lisp_Object handler;
368 directory = Fexpand_file_name (directory, Qnil);
370 /* If the file name has special constructs in it,
371 call the corresponding file handler. */
372 handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
373 if (!NILP (handler))
374 return call6 (handler, Qdirectory_files_and_attributes,
375 directory, full, match, nosort, id_format);
377 return directory_files_internal (directory, full, match, nosort,
378 true, id_format);
382 static Lisp_Object file_name_completion (Lisp_Object, Lisp_Object, bool,
383 Lisp_Object);
385 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
386 2, 3, 0,
387 doc: /* Complete file name FILE in directory DIRECTORY.
388 Returns the longest string
389 common to all file names in DIRECTORY that start with FILE.
390 If there is only one and FILE matches it exactly, returns t.
391 Returns nil if DIRECTORY contains no name starting with FILE.
393 If PREDICATE is non-nil, call PREDICATE with each possible
394 completion (in absolute form) and ignore it if PREDICATE returns nil.
396 This function ignores some of the possible completions as determined
397 by the variables `completion-regexp-list' and
398 `completion-ignored-extensions', which see. `completion-regexp-list'
399 is matched against file and directory names relative to DIRECTORY. */)
400 (Lisp_Object file, Lisp_Object directory, Lisp_Object predicate)
402 Lisp_Object handler;
403 directory = Fexpand_file_name (directory, Qnil);
405 /* If the directory name has special constructs in it,
406 call the corresponding file handler. */
407 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
408 if (!NILP (handler))
409 return call4 (handler, Qfile_name_completion, file, directory, predicate);
411 /* If the file name has special constructs in it,
412 call the corresponding file handler. */
413 handler = Ffind_file_name_handler (file, Qfile_name_completion);
414 if (!NILP (handler))
415 return call4 (handler, Qfile_name_completion, file, directory, predicate);
417 return file_name_completion (file, directory, 0, predicate);
420 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
421 Sfile_name_all_completions, 2, 2, 0,
422 doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
423 These are all file names in directory DIRECTORY which begin with FILE.
425 This function ignores some of the possible completions as determined
426 by `completion-regexp-list', which see. `completion-regexp-list'
427 is matched against file and directory names relative to DIRECTORY. */)
428 (Lisp_Object file, Lisp_Object directory)
430 Lisp_Object handler;
431 directory = Fexpand_file_name (directory, Qnil);
433 /* If the directory name has special constructs in it,
434 call the corresponding file handler. */
435 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
436 if (!NILP (handler))
437 return call3 (handler, Qfile_name_all_completions, file, directory);
439 /* If the file name has special constructs in it,
440 call the corresponding file handler. */
441 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
442 if (!NILP (handler))
443 return call3 (handler, Qfile_name_all_completions, file, directory);
445 return file_name_completion (file, directory, 1, Qnil);
448 static bool file_name_completion_dirp (int, struct dirent *, ptrdiff_t);
450 static Lisp_Object
451 file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
452 Lisp_Object predicate)
454 ptrdiff_t bestmatchsize = 0;
455 int matchcount = 0;
456 /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
457 If ALL_FLAG is 0, BESTMATCH is either nil
458 or the best match so far, not decoded. */
459 Lisp_Object bestmatch, tem, elt, name;
460 Lisp_Object encoded_file;
461 Lisp_Object encoded_dir;
462 bool directoryp;
463 /* If not INCLUDEALL, exclude files in completion-ignored-extensions as
464 well as "." and "..". Until shown otherwise, assume we can't exclude
465 anything. */
466 bool includeall = 1;
467 bool check_decoded = false;
468 ptrdiff_t count = SPECPDL_INDEX ();
470 elt = Qnil;
472 CHECK_STRING (file);
474 bestmatch = Qnil;
475 encoded_file = encoded_dir = Qnil;
476 specbind (Qdefault_directory, dirname);
478 /* Do completion on the encoded file name
479 because the other names in the directory are (we presume)
480 encoded likewise. We decode the completed string at the end. */
481 /* Actually, this is not quite true any more: we do most of the completion
482 work with decoded file names, but we still do some filtering based
483 on the encoded file name. */
484 encoded_file = ENCODE_FILE (file);
485 encoded_dir = ENCODE_FILE (Fdirectory_file_name (dirname));
487 Lisp_Object file_encoding = Vfile_name_coding_system;
488 if (NILP (Vfile_name_coding_system))
489 file_encoding = Vdefault_file_name_coding_system;
490 /* If the file-name encoding decomposes characters, as we do for
491 HFS+ filesystems, we need to make an additional comparison of
492 decoded names in order to filter false positives, such as "a"
493 falsely matching "a-ring". */
494 if (!NILP (file_encoding)
495 && !NILP (Fplist_get (Fcoding_system_plist (file_encoding),
496 Qdecomposed_characters)))
498 check_decoded = true;
499 if (STRING_MULTIBYTE (file))
501 /* Recompute FILE to make sure any decomposed characters in
502 it are re-composed by the post-read-conversion.
503 Otherwise, any decomposed characters will be rejected by
504 the additional check below. */
505 file = DECODE_FILE (encoded_file);
508 int fd;
509 DIR *d = open_directory (encoded_dir, &fd);
510 record_unwind_protect_ptr (directory_files_internal_unwind, d);
512 /* Loop reading directory entries. */
513 for (struct dirent *dp; (dp = read_dirent (d, dirname)); )
515 ptrdiff_t len = dirent_namelen (dp);
516 bool canexclude = 0;
518 maybe_quit ();
519 if (len < SCHARS (encoded_file)
520 || (scmp (dp->d_name, SSDATA (encoded_file),
521 SCHARS (encoded_file))
522 >= 0))
523 continue;
525 switch (dirent_type (dp))
527 case DT_DIR:
528 directoryp = true;
529 break;
531 case DT_LNK: case DT_UNKNOWN:
532 directoryp = file_name_completion_dirp (fd, dp, len);
533 break;
535 default:
536 directoryp = false;
537 break;
540 tem = Qnil;
541 /* If all_flag is set, always include all.
542 It would not actually be helpful to the user to ignore any possible
543 completions when making a list of them. */
544 if (!all_flag)
546 ptrdiff_t skip;
548 #if 0 /* FIXME: The `scmp' call compares an encoded and a decoded string. */
549 /* If this entry matches the current bestmatch, the only
550 thing it can do is increase matchcount, so don't bother
551 investigating it any further. */
552 if (!completion_ignore_case
553 /* The return result depends on whether it's the sole match. */
554 && matchcount > 1
555 && !includeall /* This match may allow includeall to 0. */
556 && len >= bestmatchsize
557 && 0 > scmp (dp->d_name, SSDATA (bestmatch), bestmatchsize))
558 continue;
559 #endif
561 if (directoryp)
563 #ifndef TRIVIAL_DIRECTORY_ENTRY
564 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
565 #endif
566 /* "." and ".." are never interesting as completions, and are
567 actually in the way in a directory with only one file. */
568 if (TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
569 canexclude = 1;
570 else if (len > SCHARS (encoded_file))
571 /* Ignore directories if they match an element of
572 completion-ignored-extensions which ends in a slash. */
573 for (tem = Vcompletion_ignored_extensions;
574 CONSP (tem); tem = XCDR (tem))
576 ptrdiff_t elt_len;
577 char *p1;
579 elt = XCAR (tem);
580 if (!STRINGP (elt))
581 continue;
582 /* Need to encode ELT, since scmp compares unibyte
583 strings only. */
584 elt = ENCODE_FILE (elt);
585 elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
586 if (elt_len <= 0)
587 continue;
588 p1 = SSDATA (elt);
589 if (p1[elt_len] != '/')
590 continue;
591 skip = len - elt_len;
592 if (skip < 0)
593 continue;
595 if (scmp (dp->d_name + skip, p1, elt_len) >= 0)
596 continue;
597 break;
600 else
602 /* Compare extensions-to-be-ignored against end of this file name */
603 /* if name is not an exact match against specified string */
604 if (len > SCHARS (encoded_file))
605 /* and exit this for loop if a match is found */
606 for (tem = Vcompletion_ignored_extensions;
607 CONSP (tem); tem = XCDR (tem))
609 elt = XCAR (tem);
610 if (!STRINGP (elt)) continue;
611 /* Need to encode ELT, since scmp compares unibyte
612 strings only. */
613 elt = ENCODE_FILE (elt);
614 skip = len - SCHARS (elt);
615 if (skip < 0) continue;
617 if (scmp (dp->d_name + skip, SSDATA (elt), SCHARS (elt))
618 >= 0)
619 continue;
620 break;
624 /* If an ignored-extensions match was found,
625 don't process this name as a completion. */
626 if (CONSP (tem))
627 canexclude = 1;
629 if (!includeall && canexclude)
630 /* We're not including all files and this file can be excluded. */
631 continue;
633 if (includeall && !canexclude)
634 { /* If we have one non-excludable file, we want to exclude the
635 excludable files. */
636 includeall = 0;
637 /* Throw away any previous excludable match found. */
638 bestmatch = Qnil;
639 bestmatchsize = 0;
640 matchcount = 0;
643 /* FIXME: If we move this `decode' earlier we can eliminate
644 the repeated ENCODE_FILE on Vcompletion_ignored_extensions. */
645 name = make_unibyte_string (dp->d_name, len);
646 name = DECODE_FILE (name);
649 Lisp_Object regexps, table = (completion_ignore_case
650 ? Vascii_canon_table : Qnil);
652 /* Ignore this element if it fails to match all the regexps. */
653 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
654 regexps = XCDR (regexps))
655 if (fast_string_match_internal (XCAR (regexps), name, table) < 0)
656 break;
658 if (CONSP (regexps))
659 continue;
662 /* This is a possible completion */
663 if (directoryp)
664 /* This completion is a directory; make it end with '/'. */
665 name = Ffile_name_as_directory (name);
667 /* Test the predicate, if any. */
668 if (!NILP (predicate) && NILP (call1 (predicate, name)))
669 continue;
671 /* Reject entries where the encoded strings match, but the
672 decoded don't. For example, "a" should not match "a-ring" on
673 file systems that store decomposed characters. */
674 Lisp_Object zero = make_number (0);
676 if (check_decoded && SCHARS (file) <= SCHARS (name))
678 /* FIXME: This is a copy of the code below. */
679 ptrdiff_t compare = SCHARS (file);
680 Lisp_Object cmp
681 = Fcompare_strings (name, zero, make_number (compare),
682 file, zero, make_number (compare),
683 completion_ignore_case ? Qt : Qnil);
684 if (!EQ (cmp, Qt))
685 continue;
688 /* Suitably record this match. */
690 matchcount += matchcount <= 1;
692 if (all_flag)
693 bestmatch = Fcons (name, bestmatch);
694 else if (NILP (bestmatch))
696 bestmatch = name;
697 bestmatchsize = SCHARS (name);
699 else
701 /* FIXME: This is a copy of the code in Ftry_completion. */
702 ptrdiff_t compare = min (bestmatchsize, SCHARS (name));
703 Lisp_Object cmp
704 = Fcompare_strings (bestmatch, zero, make_number (compare),
705 name, zero, make_number (compare),
706 completion_ignore_case ? Qt : Qnil);
707 ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XINT (cmp)) - 1;
709 if (completion_ignore_case)
711 /* If this is an exact match except for case,
712 use it as the best match rather than one that is not
713 an exact match. This way, we get the case pattern
714 of the actual match. */
715 /* This tests that the current file is an exact match
716 but BESTMATCH is not (it is too long). */
717 if ((matchsize == SCHARS (name)
718 && matchsize + directoryp < SCHARS (bestmatch))
720 /* If there is no exact match ignoring case,
721 prefer a match that does not change the case
722 of the input. */
723 /* If there is more than one exact match aside from
724 case, and one of them is exact including case,
725 prefer that one. */
726 /* This == checks that, of current file and BESTMATCH,
727 either both or neither are exact. */
728 (((matchsize == SCHARS (name))
730 (matchsize + directoryp == SCHARS (bestmatch)))
731 && (cmp = Fcompare_strings (name, zero,
732 make_number (SCHARS (file)),
733 file, zero,
734 Qnil,
735 Qnil),
736 EQ (Qt, cmp))
737 && (cmp = Fcompare_strings (bestmatch, zero,
738 make_number (SCHARS (file)),
739 file, zero,
740 Qnil,
741 Qnil),
742 ! EQ (Qt, cmp))))
743 bestmatch = name;
745 bestmatchsize = matchsize;
747 /* If the best completion so far is reduced to the string
748 we're trying to complete, then we already know there's no
749 other completion, so there's no point looking any further. */
750 if (matchsize <= SCHARS (file)
751 && !includeall /* A future match may allow includeall to 0. */
752 /* If completion-ignore-case is non-nil, don't
753 short-circuit because we want to find the best
754 possible match *including* case differences. */
755 && (!completion_ignore_case || matchsize == 0)
756 /* The return value depends on whether it's the sole match. */
757 && matchcount > 1)
758 break;
763 /* This closes the directory. */
764 bestmatch = unbind_to (count, bestmatch);
766 if (all_flag || NILP (bestmatch))
767 return bestmatch;
768 /* Return t if the supplied string is an exact match (counting case);
769 it does not require any change to be made. */
770 if (matchcount == 1 && !NILP (Fequal (bestmatch, file)))
771 return Qt;
772 bestmatch = Fsubstring (bestmatch, make_number (0),
773 make_number (bestmatchsize));
774 return bestmatch;
777 /* Compare exactly LEN chars of strings at S1 and S2,
778 ignoring case if appropriate.
779 Return -1 if strings match,
780 else number of chars that match at the beginning. */
782 static ptrdiff_t
783 scmp (const char *s1, const char *s2, ptrdiff_t len)
785 register ptrdiff_t l = len;
787 if (completion_ignore_case)
789 while (l
790 && (downcase ((unsigned char) *s1++)
791 == downcase ((unsigned char) *s2++)))
792 l--;
794 else
796 while (l && *s1++ == *s2++)
797 l--;
799 if (l == 0)
800 return -1;
801 else
802 return len - l;
805 /* Return true if in the directory FD the directory entry DP, whose
806 string length is LEN, is that of a subdirectory that can be searched. */
807 static bool
808 file_name_completion_dirp (int fd, struct dirent *dp, ptrdiff_t len)
810 USE_SAFE_ALLOCA;
811 char *subdir_name = SAFE_ALLOCA (len + 2);
812 memcpy (subdir_name, dp->d_name, len);
813 strcpy (subdir_name + len, "/");
814 bool dirp = faccessat (fd, subdir_name, F_OK, AT_EACCESS) == 0;
815 SAFE_FREE ();
816 return dirp;
819 static char *
820 stat_uname (struct stat *st)
822 #ifdef WINDOWSNT
823 return st->st_uname;
824 #else
825 struct passwd *pw = getpwuid (st->st_uid);
827 if (pw)
828 return pw->pw_name;
829 else
830 return NULL;
831 #endif
834 static char *
835 stat_gname (struct stat *st)
837 #ifdef WINDOWSNT
838 return st->st_gname;
839 #else
840 struct group *gr = getgrgid (st->st_gid);
842 if (gr)
843 return gr->gr_name;
844 else
845 return NULL;
846 #endif
849 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
850 doc: /* Return a list of attributes of file FILENAME.
851 Value is nil if specified file cannot be opened.
853 ID-FORMAT specifies the preferred format of attributes uid and gid (see
854 below) - valid values are `string' and `integer'. The latter is the
855 default, but we plan to change that, so you should specify a non-nil value
856 for ID-FORMAT if you use the returned uid or gid.
858 To access the elements returned, the following access functions are
859 provided: `file-attribute-type', `file-attribute-link-number',
860 `file-attribute-user-id', `file-attribute-group-id',
861 `file-attribute-access-time', `file-attribute-modification-time',
862 `file-attribute-status-change-time', `file-attribute-size',
863 `file-attribute-modes', `file-attribute-inode-number', and
864 `file-attribute-device-number'.
866 Elements of the attribute list are:
867 0. t for directory, string (name linked to) for symbolic link, or nil.
868 1. Number of links to file.
869 2. File uid as a string or a number. If a string value cannot be
870 looked up, a numeric value, either an integer or a float, is returned.
871 3. File gid, likewise.
872 4. Last access time, as a list of integers (HIGH LOW USEC PSEC) in the
873 same style as (current-time).
874 (See a note below about access time on FAT-based filesystems.)
875 5. Last modification time, likewise. This is the time of the last
876 change to the file's contents.
877 6. Last status change time, likewise. This is the time of last change
878 to the file's attributes: owner and group, access mode bits, etc.
879 7. Size in bytes.
880 This is a floating point number if the size is too large for an integer.
881 8. File modes, as a string of ten letters or dashes as in ls -l.
882 9. An unspecified value, present only for backward compatibility.
883 10. inode number. If it is larger than what an Emacs integer can hold,
884 this is of the form (HIGH . LOW): first the high bits, then the low 16 bits.
885 If even HIGH is too large for an Emacs integer, this is instead of the form
886 (HIGH MIDDLE . LOW): first the high bits, then the middle 24 bits,
887 and finally the low 16 bits.
888 11. Filesystem device number. If it is larger than what the Emacs
889 integer can hold, this is a cons cell, similar to the inode number.
891 On most filesystems, the combination of the inode and the device
892 number uniquely identifies the file.
894 On MS-Windows, performance depends on `w32-get-true-file-attributes',
895 which see.
897 On some FAT-based filesystems, only the date of last access is recorded,
898 so last access time will always be midnight of that day. */)
899 (Lisp_Object filename, Lisp_Object id_format)
901 Lisp_Object encoded;
902 Lisp_Object handler;
904 filename = internal_condition_case_2 (Fexpand_file_name, filename, Qnil,
905 Qt, Fidentity);
906 if (!STRINGP (filename))
907 return Qnil;
909 /* If the file name has special constructs in it,
910 call the corresponding file handler. */
911 handler = Ffind_file_name_handler (filename, Qfile_attributes);
912 if (!NILP (handler))
913 { /* Only pass the extra arg if it is used to help backward compatibility
914 with old file handlers which do not implement the new arg. --Stef */
915 if (NILP (id_format))
916 return call2 (handler, Qfile_attributes, filename);
917 else
918 return call3 (handler, Qfile_attributes, filename, id_format);
921 encoded = ENCODE_FILE (filename);
922 return file_attributes (AT_FDCWD, SSDATA (encoded), Qnil, filename,
923 id_format);
926 static Lisp_Object
927 file_attributes (int fd, char const *name,
928 Lisp_Object dirname, Lisp_Object filename,
929 Lisp_Object id_format)
931 ptrdiff_t count = SPECPDL_INDEX ();
932 struct stat s;
934 /* An array to hold the mode string generated by filemodestring,
935 including its terminating space and null byte. */
936 char modes[sizeof "-rwxr-xr-x "];
938 char *uname = NULL, *gname = NULL;
940 int err = EINVAL;
942 #ifdef O_PATH
943 int namefd = openat (fd, name, O_PATH | O_CLOEXEC | O_NOFOLLOW);
944 if (namefd < 0)
945 err = errno;
946 else
948 record_unwind_protect_int (close_file_unwind, namefd);
949 if (fstat (namefd, &s) != 0)
951 err = errno;
952 /* The Linux kernel before version 3.6 does not support
953 fstat on O_PATH file descriptors. Handle this error like
954 missing support for O_PATH. */
955 if (err == EBADF)
956 err = EINVAL;
958 else
960 err = 0;
961 fd = namefd;
962 name = "";
965 #endif
967 if (err == EINVAL)
969 #ifdef WINDOWSNT
970 /* We usually don't request accurate owner and group info,
971 because it can be expensive on Windows to get that, and most
972 callers of 'lstat' don't need that. But here we do want that
973 information to be accurate. */
974 w32_stat_get_owner_group = 1;
975 #endif
976 if (fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0)
977 err = 0;
978 #ifdef WINDOWSNT
979 w32_stat_get_owner_group = 0;
980 #endif
983 if (err != 0)
984 return unbind_to (count, Qnil);
986 Lisp_Object file_type;
987 if (S_ISLNK (s.st_mode))
989 /* On systems lacking O_PATH support there is a race if the
990 symlink is replaced between the call to fstatat and the call
991 to emacs_readlinkat. Detect this race unless the replacement
992 is also a symlink. */
993 file_type = emacs_readlinkat (fd, name);
994 if (NILP (file_type))
995 return unbind_to (count, Qnil);
997 else
998 file_type = S_ISDIR (s.st_mode) ? Qt : Qnil;
1000 unbind_to (count, Qnil);
1002 if (!(NILP (id_format) || EQ (id_format, Qinteger)))
1004 uname = stat_uname (&s);
1005 gname = stat_gname (&s);
1008 filemodestring (&s, modes);
1010 return CALLN (Flist,
1011 file_type,
1012 make_number (s.st_nlink),
1013 (uname
1014 ? DECODE_SYSTEM (build_unibyte_string (uname))
1015 : make_fixnum_or_float (s.st_uid)),
1016 (gname
1017 ? DECODE_SYSTEM (build_unibyte_string (gname))
1018 : make_fixnum_or_float (s.st_gid)),
1019 make_lisp_time (get_stat_atime (&s)),
1020 make_lisp_time (get_stat_mtime (&s)),
1021 make_lisp_time (get_stat_ctime (&s)),
1023 /* If the file size is a 4-byte type, assume that
1024 files of sizes in the 2-4 GiB range wrap around to
1025 negative values, as this is a common bug on older
1026 32-bit platforms. */
1027 make_fixnum_or_float (sizeof (s.st_size) == 4
1028 ? s.st_size & 0xffffffffu
1029 : s.st_size),
1031 make_string (modes, 10),
1033 INTEGER_TO_CONS (s.st_ino),
1034 INTEGER_TO_CONS (s.st_dev));
1037 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
1038 doc: /* Return t if first arg file attributes list is less than second.
1039 Comparison is in lexicographic order and case is significant. */)
1040 (Lisp_Object f1, Lisp_Object f2)
1042 return Fstring_lessp (Fcar (f1), Fcar (f2));
1046 DEFUN ("system-users", Fsystem_users, Ssystem_users, 0, 0, 0,
1047 doc: /* Return a list of user names currently registered in the system.
1048 If we don't know how to determine that on this platform, just
1049 return a list with one element, taken from `user-real-login-name'. */)
1050 (void)
1052 Lisp_Object users = Qnil;
1053 #if defined HAVE_GETPWENT && defined HAVE_ENDPWENT
1054 struct passwd *pw;
1056 while ((pw = getpwent ()))
1057 users = Fcons (DECODE_SYSTEM (build_string (pw->pw_name)), users);
1059 endpwent ();
1060 #endif
1061 if (EQ (users, Qnil))
1062 /* At least current user is always known. */
1063 users = list1 (Vuser_real_login_name);
1064 return users;
1067 DEFUN ("system-groups", Fsystem_groups, Ssystem_groups, 0, 0, 0,
1068 doc: /* Return a list of user group names currently registered in the system.
1069 The value may be nil if not supported on this platform. */)
1070 (void)
1072 Lisp_Object groups = Qnil;
1073 #if defined HAVE_GETGRENT && defined HAVE_ENDGRENT
1074 struct group *gr;
1076 while ((gr = getgrent ()))
1077 groups = Fcons (DECODE_SYSTEM (build_string (gr->gr_name)), groups);
1079 endgrent ();
1080 #endif
1081 return groups;
1084 void
1085 syms_of_dired (void)
1087 DEFSYM (Qdirectory_files, "directory-files");
1088 DEFSYM (Qdirectory_files_and_attributes, "directory-files-and-attributes");
1089 DEFSYM (Qfile_name_completion, "file-name-completion");
1090 DEFSYM (Qfile_name_all_completions, "file-name-all-completions");
1091 DEFSYM (Qfile_attributes, "file-attributes");
1092 DEFSYM (Qfile_attributes_lessp, "file-attributes-lessp");
1093 DEFSYM (Qdefault_directory, "default-directory");
1094 DEFSYM (Qdecomposed_characters, "decomposed-characters");
1096 defsubr (&Sdirectory_files);
1097 defsubr (&Sdirectory_files_and_attributes);
1098 defsubr (&Sfile_name_completion);
1099 defsubr (&Sfile_name_all_completions);
1100 defsubr (&Sfile_attributes);
1101 defsubr (&Sfile_attributes_lessp);
1102 defsubr (&Ssystem_users);
1103 defsubr (&Ssystem_groups);
1105 DEFVAR_LISP ("completion-ignored-extensions", Vcompletion_ignored_extensions,
1106 doc: /* Completion ignores file names ending in any string in this list.
1107 It does not ignore them if all possible completions end in one of
1108 these strings or when displaying a list of completions.
1109 It ignores directory names if they match any string in this list which
1110 ends in a slash. */);
1111 Vcompletion_ignored_extensions = Qnil;