1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985-1986, 1993-1994, 1999-2023 Free Software
3 Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
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.
11
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.
16
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/>. */
19
20
21 #include <config.h>
22
23 #include <sys/stat.h>
24
25 #ifdef HAVE_PWD_H
26 #include <pwd.h>
27 #endif
28 #include <grp.h>
29
30 #include <errno.h>
31 #include <fcntl.h>
32 #include <unistd.h>
33
34 #include <dirent.h>
35 #include <filemode.h>
36 #include <stat-time.h>
37
38 #include "lisp.h"
39 #include "systime.h"
40 #include "buffer.h"
41 #include "coding.h"
42
43 #ifdef MSDOS
44 #include "msdos.h" /* for fstatat */
45 #endif
46
47 #ifdef WINDOWSNT
48 extern int is_slow_fs (const char *);
49 #endif
50
51 static ptrdiff_t scmp (const char *, const char *, ptrdiff_t);
52 static Lisp_Object file_attributes (int, char const *, Lisp_Object,
53 Lisp_Object, Lisp_Object);
54
55 /* Return the number of bytes in DP's name. */
56 static ptrdiff_t
57 dirent_namelen (struct dirent *dp)
58 {
59 #ifdef _D_EXACT_NAMLEN
60 return _D_EXACT_NAMLEN (dp);
61 #else
62 return strlen (dp->d_name);
63 #endif
64 }
65
66 #ifndef HAVE_STRUCT_DIRENT_D_TYPE
67 enum { DT_UNKNOWN, DT_DIR, DT_LNK };
68 #endif
69
70 /* Return the file type of DP. */
71 static int
72 dirent_type (struct dirent *dp)
73 {
74 #ifdef HAVE_STRUCT_DIRENT_D_TYPE
75 return dp->d_type;
76 #else
77 return DT_UNKNOWN;
78 #endif
79 }
80
81 static DIR *
82 open_directory (Lisp_Object dirname, Lisp_Object encoded_dirname, int *fdp)
83 {
84 char *name = SSDATA (encoded_dirname);
85 DIR *d;
86 int fd, opendir_errno;
87
88 #ifdef DOS_NT
89 /* Directories cannot be opened. The emulation assumes that any
90 file descriptor other than AT_FDCWD corresponds to the most
91 recently opened directory. This hack is good enough for Emacs. */
92 fd = 0;
93 d = opendir (name);
94 opendir_errno = errno;
95 #else
96 fd = emacs_open (name, O_RDONLY | O_DIRECTORY, 0);
97 if (fd < 0)
98 {
99 opendir_errno = errno;
100 d = 0;
101 }
102 else
103 {
104 d = fdopendir (fd);
105 opendir_errno = errno;
106 if (! d)
107 emacs_close (fd);
108 }
109 #endif
110
111 if (!d)
112 report_file_errno ("Opening directory", dirname, opendir_errno);
113 *fdp = fd;
114 return d;
115 }
116
117 #ifdef WINDOWSNT
118 static void
119 directory_files_internal_w32_unwind (Lisp_Object arg)
120 {
121 Vw32_get_true_file_attributes = arg;
122 }
123 #endif
124
125 static void
126 directory_files_internal_unwind (void *d)
127 {
128 closedir (d);
129 }
130
131 /* Return the next directory entry from DIR; DIR's name is DIRNAME.
132 If there are no more directory entries, return a null pointer.
133 Signal any unrecoverable errors. */
134
135 static struct dirent *
136 read_dirent (DIR *dir, Lisp_Object dirname)
137 {
138 while (true)
139 {
140 errno = 0;
141 struct dirent *dp = readdir (dir);
142 if (dp || errno == 0)
143 return dp;
144 if (! (errno == EAGAIN || errno == EINTR))
145 {
146 #ifdef WINDOWSNT
147 /* The MS-Windows implementation of 'opendir' doesn't
148 actually open a directory until the first call to
149 'readdir'. If 'readdir' fails to open the directory, it
150 sets errno to ENOENT or EACCES, see w32.c. */
151 if (errno == ENOENT || errno == EACCES)
152 report_file_error ("Opening directory", dirname);
153 #endif
154 report_file_error ("Reading directory", dirname);
155 }
156 maybe_quit ();
157 }
158 }
159
160 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
161 If not ATTRS, return a list of directory filenames;
162 if ATTRS, return a list of directory filenames and their attributes.
163 In the latter case, pass ID_FORMAT to file_attributes. */
164
165 Lisp_Object
166 directory_files_internal (Lisp_Object directory, Lisp_Object full,
167 Lisp_Object match, Lisp_Object nosort, bool attrs,
168 Lisp_Object id_format, Lisp_Object return_count)
169 {
170 EMACS_INT ind = 0, last = MOST_POSITIVE_FIXNUM;
171
172 if (!NILP (return_count))
173 {
174 CHECK_FIXNAT (return_count);
175 last = XFIXNAT (return_count);
176 }
177
178 if (!NILP (match))
179 CHECK_STRING (match);
180
181 /* Don't let the compiler optimize away all copies of DIRECTORY,
182 which would break GC; see Bug#16986. */
183 Lisp_Object volatile directory_volatile = directory;
184
185 Lisp_Object dirfilename = Fdirectory_file_name (directory);
186
187 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
188 run_pre_post_conversion_on_str which calls Lisp directly and
189 indirectly. */
190 Lisp_Object encoded_dirfilename = ENCODE_FILE (dirfilename);
191
192 int fd;
193 DIR *d = open_directory (dirfilename, encoded_dirfilename, &fd);
194
195 /* Unfortunately, we can now invoke expand-file-name and
196 file-attributes on filenames, both of which can throw, so we must
197 do a proper unwind-protect. */
198 specpdl_ref count = SPECPDL_INDEX ();
199 record_unwind_protect_ptr (directory_files_internal_unwind, d);
200
201 #ifdef WINDOWSNT
202 Lisp_Object w32_save = Qnil;
203 if (attrs)
204 {
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))
211 {
212 /* w32.c:stat will notice these bindings and avoid calling
213 GetDriveType for each file. */
214 if (is_slow_fs (SSDATA (encoded_dirfilename)))
215 Vw32_get_true_file_attributes = Qnil;
216 else
217 Vw32_get_true_file_attributes = Qt;
218 }
219 }
220 #endif
221
222 if (!NILP (full) && !STRING_MULTIBYTE (directory))
223 { /* We will be concatenating 'directory' with local file name.
224 We always decode local file names, so in order to safely concatenate
225 them we need 'directory' to be decoded as well (bug#56469). */
226 directory = DECODE_FILE (directory);
227 }
228
229 ptrdiff_t directory_nbytes = SBYTES (directory);
230 re_match_object = Qt;
231
232 /* Decide whether we need to add a directory separator. */
233 bool needsep = (directory_nbytes == 0
234 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)));
235
236 /* Windows users want case-insensitive wildcards. */
237 Lisp_Object case_table = Qnil;
238 #ifdef WINDOWSNT
239 case_table = BVAR (&buffer_defaults, case_canon_table);
240 #endif
241
242 /* Read directory entries and accumulate them into LIST. */
243 Lisp_Object list = Qnil;
244 for (struct dirent *dp; (dp = read_dirent (d, directory)); )
245 {
246 ptrdiff_t len = dirent_namelen (dp);
247 Lisp_Object name = make_unibyte_string (dp->d_name, len);
248 Lisp_Object finalname = name;
249
250 /* This can GC. */
251 name = DECODE_FILE (name);
252
253 maybe_quit ();
254
255 if (!NILP (match)
256 && fast_string_match_internal (match, name, case_table) < 0)
257 continue;
258
259 Lisp_Object fileattrs UNINIT;
260 if (attrs)
261 {
262 fileattrs = file_attributes (fd, dp->d_name, directory, name,
263 id_format);
264 if (NILP (fileattrs))
265 continue;
266 }
267
268 if (!NILP (full))
269 {
270 ptrdiff_t name_nbytes = SBYTES (name);
271 ptrdiff_t nbytes = directory_nbytes + needsep + name_nbytes;
272 ptrdiff_t nchars = SCHARS (directory) + needsep + SCHARS (name);
273 /* DECODE_FILE may return non-ASCII unibyte strings (e.g. when
274 file-name-coding-system is 'binary'), so we don't know for sure
275 that the bytes we have follow our internal utf-8 representation
276 for multibyte strings. If nchars == nbytes we don't need to
277 care and just return a unibyte string; and if not, that means
278 one of 'name' or 'directory' is multibyte, in which case we
279 presume that the other one would also be multibyte if it
280 contained non-ASCII.
281 FIXME: This last presumption is broken when 'directory' is
282 multibyte (with non-ASCII), and 'name' is unibyte with non-ASCII
283 (because file-name-coding-system is 'binary'). */
284 finalname = (nchars == nbytes)
285 ? make_uninit_string (nbytes)
286 : make_uninit_multibyte_string (nchars, nbytes);
287 memcpy (SDATA (finalname), SDATA (directory), directory_nbytes);
288 if (needsep)
289 SSET (finalname, directory_nbytes, DIRECTORY_SEP);
290 memcpy (SDATA (finalname) + directory_nbytes + needsep,
291 SDATA (name), name_nbytes);
292 }
293 else
294 finalname = name;
295
296 if (ind == last)
297 break;
298 ind ++;
299
300 list = Fcons (attrs ? Fcons (finalname, fileattrs) : finalname, list);
301 }
302
303 closedir (d);
304 #ifdef WINDOWSNT
305 if (attrs)
306 Vw32_get_true_file_attributes = w32_save;
307 #endif
308
309 /* Discard the unwind protect. */
310 specpdl_ptr = specpdl_ref_to_ptr (count);
311
312 if (NILP (nosort))
313 list = Fsort (Fnreverse (list),
314 attrs ? Qfile_attributes_lessp : Qstring_lessp);
315
316 (void) directory_volatile;
317 return list;
318 }
319
320
321 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 5, 0,
322 doc: /* Return a list of names of files in DIRECTORY.
323 There are four 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 whose non-directory part
327 matches the regexp MATCH.
328 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
329 Otherwise, the list returned is sorted with `string-lessp'.
330 NOSORT is useful if you plan to sort the result yourself.
331 If COUNT is non-nil and a natural number, the function will return
332 COUNT number of file names (if so many are present). */)
333 (Lisp_Object directory, Lisp_Object full, Lisp_Object match,
334 Lisp_Object nosort, Lisp_Object count)
335 {
336 directory = Fexpand_file_name (directory, Qnil);
337
338 /* If the file name has special constructs in it,
339 call the corresponding file name handler. */
340 Lisp_Object handler = Ffind_file_name_handler (directory, Qdirectory_files);
341 if (!NILP (handler))
342 return call6 (handler, Qdirectory_files, directory,
343 full, match, nosort, count);
344
345 return directory_files_internal (directory, full, match, nosort,
346 false, Qnil, count);
347 }
348
349 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
350 Sdirectory_files_and_attributes, 1, 6, 0,
351 doc: /* Return a list of names of files and their attributes in DIRECTORY.
352 Value is a list of the form:
353
354 ((FILE1 . FILE1-ATTRS) (FILE2 . FILE2-ATTRS) ...)
355
356 where each FILEn-ATTRS is the attributes of FILEn as returned
357 by `file-attributes'.
358
359 This function accepts five optional arguments:
360 If FULL is non-nil, return absolute file names. Otherwise return names
361 that are relative to the specified directory.
362 If MATCH is non-nil, mention only file names whose non-directory part
363 matches the regexp MATCH.
364 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
365 NOSORT is useful if you plan to sort the result yourself.
366 ID-FORMAT specifies the preferred format of attributes uid and gid, see
367 `file-attributes' for further documentation.
368 If COUNT is non-nil and a natural number, the function will return
369 COUNT number of file names (if so many are present).
370 On MS-Windows, performance depends on `w32-get-true-file-attributes',
371 which see. */)
372 (Lisp_Object directory, Lisp_Object full, Lisp_Object match,
373 Lisp_Object nosort, Lisp_Object id_format, Lisp_Object count)
374 {
375 directory = Fexpand_file_name (directory, Qnil);
376
377 /* If the file name has special constructs in it,
378 call the corresponding file name handler. */
379 Lisp_Object handler
380 = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
381 if (!NILP (handler))
382 return call7 (handler, Qdirectory_files_and_attributes,
383 directory, full, match, nosort, id_format, count);
384
385 return directory_files_internal (directory, full, match, nosort,
386 true, id_format, count);
387 }
388
389
390 static Lisp_Object file_name_completion (Lisp_Object, Lisp_Object, bool,
391 Lisp_Object);
392
393 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
394 2, 3, 0,
395 doc: /* Complete file name FILE in directory DIRECTORY.
396 Returns the longest string
397 common to all file names in DIRECTORY that start with FILE.
398 If there is only one and FILE matches it exactly, returns t.
399 Returns nil if DIRECTORY contains no name starting with FILE.
400
401 If PREDICATE is non-nil, call PREDICATE with each possible
402 completion (in absolute form) and ignore it if PREDICATE returns nil.
403
404 This function ignores some of the possible completions as determined
405 by the variables `completion-regexp-list' and
406 `completion-ignored-extensions', which see. `completion-regexp-list'
407 is matched against file and directory names relative to DIRECTORY. */)
408 (Lisp_Object file, Lisp_Object directory, Lisp_Object predicate)
409 {
410 Lisp_Object handler;
411 directory = Fexpand_file_name (directory, Qnil);
412
413 /* If the directory name has special constructs in it,
414 call the corresponding file name handler. */
415 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
416 if (!NILP (handler))
417 return call4 (handler, Qfile_name_completion, file, directory, predicate);
418
419 /* If the file name has special constructs in it,
420 call the corresponding file name handler. */
421 handler = Ffind_file_name_handler (file, Qfile_name_completion);
422 if (!NILP (handler))
423 return call4 (handler, Qfile_name_completion, file, directory, predicate);
424
425 return file_name_completion (file, directory, 0, predicate);
426 }
427
428 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
429 Sfile_name_all_completions, 2, 2, 0,
430 doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
431 These are all file names in directory DIRECTORY which begin with FILE.
432
433 This function ignores some of the possible completions as determined
434 by `completion-regexp-list', which see. `completion-regexp-list'
435 is matched against file and directory names relative to DIRECTORY. */)
436 (Lisp_Object file, Lisp_Object directory)
437 {
438 Lisp_Object handler;
439 directory = Fexpand_file_name (directory, Qnil);
440
441 /* If the directory name has special constructs in it,
442 call the corresponding file name handler. */
443 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
444 if (!NILP (handler))
445 return call3 (handler, Qfile_name_all_completions, file, directory);
446
447 /* If the file name has special constructs in it,
448 call the corresponding file name handler. */
449 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
450 if (!NILP (handler))
451 return call3 (handler, Qfile_name_all_completions, file, directory);
452
453 return file_name_completion (file, directory, 1, Qnil);
454 }
455
456 static bool file_name_completion_dirp (int, struct dirent *, ptrdiff_t);
457
458 static Lisp_Object
459 file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
460 Lisp_Object predicate)
461 {
462 ptrdiff_t bestmatchsize = 0;
463 int matchcount = 0;
464 /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
465 If ALL_FLAG is 0, BESTMATCH is either nil
466 or the best match so far, not decoded. */
467 Lisp_Object bestmatch, tem, elt, name;
468 Lisp_Object encoded_file;
469 Lisp_Object encoded_dir;
470 bool directoryp;
471 /* If not INCLUDEALL, exclude files in completion-ignored-extensions as
472 well as "." and "..". Until shown otherwise, assume we can't exclude
473 anything. */
474 bool includeall = 1;
475 bool check_decoded = false;
476 specpdl_ref count = SPECPDL_INDEX ();
477
478 elt = Qnil;
479
480 CHECK_STRING (file);
481
482 bestmatch = Qnil;
483 encoded_file = encoded_dir = Qnil;
484 specbind (Qdefault_directory, dirname);
485
486 /* Do completion on the encoded file name
487 because the other names in the directory are (we presume)
488 encoded likewise. We decode the completed string at the end. */
489 /* Actually, this is not quite true any more: we do most of the completion
490 work with decoded file names, but we still do some filtering based
491 on the encoded file name. */
492 encoded_file = ENCODE_FILE (file);
493 encoded_dir = ENCODE_FILE (Fdirectory_file_name (dirname));
494
495 Lisp_Object file_encoding = Vfile_name_coding_system;
496 if (NILP (Vfile_name_coding_system))
497 file_encoding = Vdefault_file_name_coding_system;
498 /* If the file-name encoding decomposes characters, as we do for
499 HFS+ filesystems, we need to make an additional comparison of
500 decoded names in order to filter false positives, such as "a"
501 falsely matching "a-ring". */
502 if (!NILP (file_encoding)
503 && !NILP (plist_get (Fcoding_system_plist (file_encoding),
504 Qdecomposed_characters)))
505 {
506 check_decoded = true;
507 if (STRING_MULTIBYTE (file))
508 {
509 /* Recompute FILE to make sure any decomposed characters in
510 it are re-composed by the post-read-conversion.
511 Otherwise, any decomposed characters will be rejected by
512 the additional check below. */
513 file = DECODE_FILE (encoded_file);
514 }
515 }
516 int fd;
517 DIR *d = open_directory (dirname, encoded_dir, &fd);
518 record_unwind_protect_ptr (directory_files_internal_unwind, d);
519
520 /* Loop reading directory entries. */
521 Lisp_Object zero = make_fixnum (0);
522 ptrdiff_t enc_file_len = SCHARS (encoded_file);
523 Lisp_Object file_len = make_fixnum (SCHARS (file));
524 for (struct dirent *dp; (dp = read_dirent (d, dirname)); )
525 {
526 ptrdiff_t len = dirent_namelen (dp);
527 bool canexclude = 0;
528
529 maybe_quit ();
530
531 if (len < enc_file_len
532 /* scmp cannot reliably compare non-ASCII strings while
533 ignoring letter-case. */
534 || (!completion_ignore_case
535 && scmp (dp->d_name, SSDATA (encoded_file), enc_file_len) >= 0))
536 continue;
537
538 name = make_unibyte_string (dp->d_name, len);
539 name = DECODE_FILE (name);
540 ptrdiff_t name_blen = SBYTES (name), name_len = SCHARS (name);
541 if (completion_ignore_case
542 && !BASE_EQ (Fcompare_strings (name, zero, file_len, file, zero,
543 file_len, Qt),
544 Qt))
545 continue;
546
547 switch (dirent_type (dp))
548 {
549 case DT_DIR:
550 directoryp = true;
551 break;
552
553 case DT_LNK: case DT_UNKNOWN:
554 directoryp = file_name_completion_dirp (fd, dp, len);
555 break;
556
557 default:
558 directoryp = false;
559 break;
560 }
561
562 tem = Qnil;
563 /* If all_flag is set, always include all.
564 It would not actually be helpful to the user to ignore any possible
565 completions when making a list of them. */
566 if (!all_flag)
567 {
568 ptrdiff_t skip;
569 Lisp_Object cmp_len = make_fixnum (name_len);
570
571 #if 0 /* FIXME: The `scmp' call compares an encoded and a decoded string. */
572 /* If this entry matches the current bestmatch, the only
573 thing it can do is increase matchcount, so don't bother
574 investigating it any further. */
575 if (!completion_ignore_case
576 /* The return result depends on whether it's the sole match. */
577 && matchcount > 1
578 && !includeall /* This match may allow includeall to 0. */
579 && len >= bestmatchsize
580 && 0 > scmp (dp->d_name, SSDATA (bestmatch), bestmatchsize))
581 continue;
582 #endif
583
584 if (directoryp)
585 {
586 #ifndef TRIVIAL_DIRECTORY_ENTRY
587 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
588 #endif
589 /* "." and ".." are never interesting as completions, and are
590 actually in the way in a directory with only one file. */
591 if (TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
592 canexclude = 1;
593 else if (len > enc_file_len)
594 /* Ignore directories if they match an element of
595 completion-ignored-extensions which ends in a slash. */
596 for (tem = Vcompletion_ignored_extensions;
597 CONSP (tem); tem = XCDR (tem))
598 {
599 ptrdiff_t elt_len;
600 char *p1;
601
602 elt = XCAR (tem);
603 if (!STRINGP (elt))
604 continue;
605 elt_len = SBYTES (elt) - 1; /* -1 for trailing / */
606 if (elt_len <= 0)
607 continue;
608 p1 = SSDATA (elt);
609 if (p1[elt_len] != '/')
610 continue;
611 skip = name_blen - elt_len;
612 if (skip < 0)
613 continue;
614
615 if (!completion_ignore_case
616 && scmp (SSDATA (name) + skip, p1, elt_len) >= 0)
617 continue;
618 if (completion_ignore_case)
619 {
620 elt_len = SCHARS (elt) - 1;
621 skip = name_len - elt_len;
622 cmp_len = make_fixnum (elt_len);
623 if (skip < 0
624 || !BASE_EQ (Fcompare_strings (name,
625 make_fixnum (skip),
626 Qnil,
627 elt, zero, cmp_len,
628 Qt),
629 Qt))
630 continue;
631 }
632 break;
633 }
634 }
635 else
636 {
637 /* Compare extensions-to-be-ignored against end of this file name */
638 /* if name is not an exact match against specified string */
639 if (len > enc_file_len)
640 /* and exit this for loop if a match is found */
641 for (tem = Vcompletion_ignored_extensions;
642 CONSP (tem); tem = XCDR (tem))
643 {
644 elt = XCAR (tem);
645 if (!STRINGP (elt)) continue;
646 ptrdiff_t elt_len = SBYTES (elt);
647 skip = len - elt_len;
648 if (skip < 0) continue;
649
650 if (!completion_ignore_case
651 && (scmp (SSDATA (name) + skip, SSDATA (elt), elt_len)
652 >= 0))
653 continue;
654 if (completion_ignore_case)
655 {
656 elt_len = SCHARS (elt);
657 skip = name_len - elt_len;
658 cmp_len = make_fixnum (elt_len);
659 if (skip < 0
660 || !BASE_EQ (Fcompare_strings (name,
661 make_fixnum (skip),
662 Qnil,
663 elt, zero, cmp_len,
664 Qt),
665 Qt))
666 continue;
667 }
668 break;
669 }
670 }
671
672 /* If an ignored-extensions match was found,
673 don't process this name as a completion. */
674 if (CONSP (tem))
675 canexclude = 1;
676
677 if (!includeall && canexclude)
678 /* We're not including all files and this file can be excluded. */
679 continue;
680
681 if (includeall && !canexclude)
682 { /* If we have one non-excludable file, we want to exclude the
683 excludable files. */
684 includeall = 0;
685 /* Throw away any previous excludable match found. */
686 bestmatch = Qnil;
687 bestmatchsize = 0;
688 matchcount = 0;
689 }
690 }
691
692 Lisp_Object regexps, table = (completion_ignore_case
693 ? Vascii_canon_table : Qnil);
694
695 /* Ignore this element if it fails to match all the regexps. */
696 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
697 regexps = XCDR (regexps))
698 if (fast_string_match_internal (XCAR (regexps), name, table) < 0)
699 break;
700
701 if (CONSP (regexps))
702 continue;
703
704 /* This is a possible completion */
705 if (directoryp)
706 /* This completion is a directory; make it end with '/'. */
707 name = Ffile_name_as_directory (name);
708
709 /* Test the predicate, if any. */
710 if (!NILP (predicate) && NILP (call1 (predicate, name)))
711 continue;
712
713 /* Reject entries where the encoded strings match, but the
714 decoded don't. For example, "a" should not match "a-ring" on
715 file systems that store decomposed characters. */
716 if (check_decoded && SCHARS (file) <= SCHARS (name))
717 {
718 /* FIXME: This is a copy of the code below. */
719 ptrdiff_t compare = SCHARS (file);
720 Lisp_Object cmp
721 = Fcompare_strings (name, zero, make_fixnum (compare),
722 file, zero, make_fixnum (compare),
723 completion_ignore_case ? Qt : Qnil);
724 if (!BASE_EQ (cmp, Qt))
725 continue;
726 }
727
728 /* Suitably record this match. */
729
730 matchcount += matchcount <= 1;
731
732 if (all_flag)
733 bestmatch = Fcons (name, bestmatch);
734 else if (NILP (bestmatch))
735 {
736 bestmatch = name;
737 bestmatchsize = SCHARS (name);
738 }
739 else
740 {
741 /* FIXME: This is a copy of the code in Ftry_completion. */
742 ptrdiff_t compare = min (bestmatchsize, SCHARS (name));
743 Lisp_Object cmp
744 = Fcompare_strings (bestmatch, zero, make_fixnum (compare),
745 name, zero, make_fixnum (compare),
746 completion_ignore_case ? Qt : Qnil);
747 ptrdiff_t matchsize = BASE_EQ (cmp, Qt)
748 ? compare : eabs (XFIXNUM (cmp)) - 1;
749
750 if (completion_ignore_case)
751 {
752 /* If this is an exact match except for case,
753 use it as the best match rather than one that is not
754 an exact match. This way, we get the case pattern
755 of the actual match. */
756 /* This tests that the current file is an exact match
757 but BESTMATCH is not (it is too long). */
758 if ((matchsize == SCHARS (name)
759 && matchsize + directoryp < SCHARS (bestmatch))
760 ||
761 /* If there is no exact match ignoring case,
762 prefer a match that does not change the case
763 of the input. */
764 /* If there is more than one exact match aside from
765 case, and one of them is exact including case,
766 prefer that one. */
767 /* This == checks that, of current file and BESTMATCH,
768 either both or neither are exact. */
769 (((matchsize == SCHARS (name))
770 ==
771 (matchsize + directoryp == SCHARS (bestmatch)))
772 && (cmp = Fcompare_strings (name, zero,
773 make_fixnum (SCHARS (file)),
774 file, zero,
775 Qnil,
776 Qnil),
777 BASE_EQ (Qt, cmp))
778 && (cmp = Fcompare_strings (bestmatch, zero,
779 make_fixnum (SCHARS (file)),
780 file, zero,
781 Qnil,
782 Qnil),
783 ! BASE_EQ (Qt, cmp))))
784 bestmatch = name;
785 }
786 bestmatchsize = matchsize;
787
788 /* If the best completion so far is reduced to the string
789 we're trying to complete, then we already know there's no
790 other completion, so there's no point looking any further. */
791 if (matchsize <= SCHARS (file)
792 && !includeall /* A future match may allow includeall to 0. */
793 /* If completion-ignore-case is non-nil, don't
794 short-circuit because we want to find the best
795 possible match *including* case differences. */
796 && (!completion_ignore_case || matchsize == 0)
797 /* The return value depends on whether it's the sole match. */
798 && matchcount > 1)
799 break;
800
801 }
802 }
803
804 /* This closes the directory. */
805 bestmatch = unbind_to (count, bestmatch);
806
807 if (all_flag || NILP (bestmatch))
808 return bestmatch;
809 /* Return t if the supplied string is an exact match (counting case);
810 it does not require any change to be made. */
811 if (matchcount == 1 && !NILP (Fequal (bestmatch, file)))
812 return Qt;
813 bestmatch = Fsubstring (bestmatch, make_fixnum (0),
814 make_fixnum (bestmatchsize));
815 return bestmatch;
816 }
817
818 /* Compare exactly LEN chars of strings at S1 and S2,
819 ignoring case if appropriate.
820 Return -1 if strings match,
821 else number of chars that match at the beginning. */
822
823 static ptrdiff_t
824 scmp (const char *s1, const char *s2, ptrdiff_t len)
825 {
826 register ptrdiff_t l = len;
827
828 if (completion_ignore_case)
829 {
830 /* WARNING: This only works for pure ASCII strings, as we
831 compare bytes, not characters! Use Fcompare_strings for
832 comparing non-ASCII strings case-insensitively. */
833 while (l
834 && (downcase ((unsigned char) *s1++)
835 == downcase ((unsigned char) *s2++)))
836 l--;
837 }
838 else
839 {
840 while (l && *s1++ == *s2++)
841 l--;
842 }
843 if (l == 0)
844 return -1;
845 else
846 return len - l;
847 }
848
849 /* Return true if in the directory FD the directory entry DP, whose
850 string length is LEN, is that of a subdirectory that can be searched. */
851 static bool
852 file_name_completion_dirp (int fd, struct dirent *dp, ptrdiff_t len)
853 {
854 USE_SAFE_ALLOCA;
855 char *subdir_name = SAFE_ALLOCA (len + 2);
856 memcpy (subdir_name, dp->d_name, len);
857 strcpy (subdir_name + len, "/");
858 bool dirp = faccessat (fd, subdir_name, F_OK, AT_EACCESS) == 0;
859 SAFE_FREE ();
860 return dirp;
861 }
862
863 static char *
864 stat_uname (struct stat *st)
865 {
866 #ifdef WINDOWSNT
867 return st->st_uname;
868 #else
869 struct passwd *pw = getpwuid (st->st_uid);
870
871 if (pw)
872 return pw->pw_name;
873 else
874 return NULL;
875 #endif
876 }
877
878 static char *
879 stat_gname (struct stat *st)
880 {
881 #ifdef WINDOWSNT
882 return st->st_gname;
883 #else
884 struct group *gr = getgrgid (st->st_gid);
885
886 if (gr)
887 return gr->gr_name;
888 else
889 return NULL;
890 #endif
891 }
892
893 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
894 doc: /* Return a list of attributes of file FILENAME.
895 Value is nil if specified file does not exist.
896
897 ID-FORMAT specifies the preferred format of attributes uid and gid (see
898 below) - valid values are `string' and `integer'. The latter is the
899 default, but we plan to change that, so you should specify a non-nil value
900 for ID-FORMAT if you use the returned uid or gid.
901
902 To access the elements returned, the following access functions are
903 provided: `file-attribute-type', `file-attribute-link-number',
904 `file-attribute-user-id', `file-attribute-group-id',
905 `file-attribute-access-time', `file-attribute-modification-time',
906 `file-attribute-status-change-time', `file-attribute-size',
907 `file-attribute-modes', `file-attribute-inode-number', and
908 `file-attribute-device-number'.
909
910 Elements of the attribute list are:
911 0. t for directory, string (name linked to) for symbolic link, or nil.
912 1. Number of links to file.
913 2. File uid as a string or (if ID-FORMAT is `integer' or a string value
914 cannot be looked up) as an integer.
915 3. File gid, likewise.
916 4. Last access time, in the style of `current-time'.
917 (See a note below about access time on FAT-based filesystems.)
918 5. Last modification time, likewise. This is the time of the last
919 change to the file's contents.
920 6. Last status change time, likewise. This is the time of last change
921 to the file's attributes: owner and group, access mode bits, etc.
922 7. Size in bytes, as an integer.
923 8. File modes, as a string of ten letters or dashes as in ls -l.
924 9. An unspecified value, present only for backward compatibility.
925 10. inode number, as a nonnegative integer.
926 11. Filesystem device identifier, as an integer or a cons cell of integers.
927
928 Large integers are bignums, so `eq' might not work on them.
929 On most filesystems, the combination of the inode and the device
930 identifier uniquely identifies the file. This unique file identification
931 is provided by the access function `file-attribute-file-identifier'.
932
933 On MS-Windows, performance depends on `w32-get-true-file-attributes',
934 which see.
935
936 On some FAT-based filesystems, only the date of last access is recorded,
937 so last access time will always be midnight of that day. */)
938 (Lisp_Object filename, Lisp_Object id_format)
939 {
940 Lisp_Object encoded;
941 Lisp_Object handler;
942
943 filename = internal_condition_case_2 (Fexpand_file_name, filename, Qnil,
944 Qt, Fidentity);
945 if (!STRINGP (filename))
946 return Qnil;
947
948 /* If the file name has special constructs in it,
949 call the corresponding file name handler. */
950 handler = Ffind_file_name_handler (filename, Qfile_attributes);
951 if (!NILP (handler))
952 { /* Only pass the extra arg if it is used to help backward
953 compatibility with old file name handlers which do not
954 implement the new arg. --Stef */
955 if (NILP (id_format))
956 return call2 (handler, Qfile_attributes, filename);
957 else
958 return call3 (handler, Qfile_attributes, filename, id_format);
959 }
960
961 encoded = ENCODE_FILE (filename);
962 return file_attributes (AT_FDCWD, SSDATA (encoded), Qnil, filename,
963 id_format);
964 }
965
966 static Lisp_Object
967 file_attributes (int fd, char const *name,
968 Lisp_Object dirname, Lisp_Object filename,
969 Lisp_Object id_format)
970 {
971 specpdl_ref count = SPECPDL_INDEX ();
972 struct stat s;
973
974 /* An array to hold the mode string generated by filemodestring,
975 including its terminating space and null byte. */
976 char modes[sizeof "-rwxr-xr-x "];
977
978 char *uname = NULL, *gname = NULL;
979
980 int err = EINVAL;
981
982 #if defined O_PATH && !defined HAVE_CYGWIN_O_PATH_BUG
983 int namefd = emacs_openat (fd, name, O_PATH | O_CLOEXEC | O_NOFOLLOW, 0);
984 if (namefd < 0)
985 err = errno;
986 else
987 {
988 record_unwind_protect_int (close_file_unwind, namefd);
989 if (fstat (namefd, &s) != 0)
990 {
991 err = errno;
992 /* The Linux kernel before version 3.6 does not support
993 fstat on O_PATH file descriptors. Handle this error like
994 missing support for O_PATH. */
995 if (err == EBADF)
996 err = EINVAL;
997 }
998 else
999 {
1000 err = 0;
1001 fd = namefd;
1002 name = "";
1003 }
1004 }
1005 #endif
1006
1007 if (err == EINVAL)
1008 {
1009 #ifdef WINDOWSNT
1010 /* We usually don't request accurate owner and group info,
1011 because it can be expensive on Windows to get that, and most
1012 callers of 'lstat' don't need that. But here we do want that
1013 information to be accurate. */
1014 w32_stat_get_owner_group = 1;
1015 #endif
1016 err = emacs_fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0 ? 0 : errno;
1017 #ifdef WINDOWSNT
1018 w32_stat_get_owner_group = 0;
1019 #endif
1020 }
1021
1022 if (err != 0)
1023 return unbind_to (count, file_attribute_errno (filename, err));
1024
1025 Lisp_Object file_type;
1026 if (S_ISLNK (s.st_mode))
1027 {
1028 /* On systems lacking O_PATH support there is a race if the
1029 symlink is replaced between the call to fstatat and the call
1030 to emacs_readlinkat. Detect this race unless the replacement
1031 is also a symlink. */
1032 file_type = check_emacs_readlinkat (fd, filename, name);
1033 if (NILP (file_type))
1034 return unbind_to (count, Qnil);
1035 }
1036 else
1037 file_type = S_ISDIR (s.st_mode) ? Qt : Qnil;
1038
1039 unbind_to (count, Qnil);
1040
1041 if (!(NILP (id_format) || EQ (id_format, Qinteger)))
1042 {
1043 uname = stat_uname (&s);
1044 gname = stat_gname (&s);
1045 }
1046
1047 filemodestring (&s, modes);
1048
1049 return CALLN (Flist,
1050 file_type,
1051 make_fixnum (s.st_nlink),
1052 (uname
1053 ? DECODE_SYSTEM (build_unibyte_string (uname))
1054 : INT_TO_INTEGER (s.st_uid)),
1055 (gname
1056 ? DECODE_SYSTEM (build_unibyte_string (gname))
1057 : INT_TO_INTEGER (s.st_gid)),
1058 make_lisp_time (get_stat_atime (&s)),
1059 make_lisp_time (get_stat_mtime (&s)),
1060 make_lisp_time (get_stat_ctime (&s)),
1061
1062 /* If the file size is a 4-byte type, assume that
1063 files of sizes in the 2-4 GiB range wrap around to
1064 negative values, as this is a common bug on older
1065 32-bit platforms. */
1066 INT_TO_INTEGER (sizeof (s.st_size) == 4
1067 ? s.st_size & 0xffffffffu
1068 : s.st_size),
1069
1070 make_string (modes, 10),
1071 Qt,
1072 INT_TO_INTEGER (s.st_ino),
1073 INT_TO_INTEGER (s.st_dev));
1074 }
1075
1076 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp,
1077 Sfile_attributes_lessp, 2, 2, 0,
1078 doc: /* Return t if first arg file attributes list is less than second.
1079 Comparison is in lexicographic order and case is significant. */)
1080 (Lisp_Object f1, Lisp_Object f2)
1081 {
1082 return Fstring_lessp (Fcar (f1), Fcar (f2));
1083 }
1084
1085
1086 DEFUN ("system-users", Fsystem_users, Ssystem_users, 0, 0, 0,
1087 doc: /* Return a list of user names currently registered in the system.
1088 If we don't know how to determine that on this platform, just
1089 return a list with one element, taken from `user-real-login-name'. */)
1090 (void)
1091 {
1092 Lisp_Object users = Qnil;
1093 #if defined HAVE_GETPWENT && defined HAVE_ENDPWENT
1094 struct passwd *pw;
1095
1096 while ((pw = getpwent ()))
1097 users = Fcons (DECODE_SYSTEM (build_string (pw->pw_name)), users);
1098
1099 endpwent ();
1100 #endif
1101 if (NILP (users))
1102 /* At least current user is always known. */
1103 users = list1 (Vuser_real_login_name);
1104 return users;
1105 }
1106
1107 DEFUN ("system-groups", Fsystem_groups, Ssystem_groups, 0, 0, 0,
1108 doc: /* Return a list of user group names currently registered in the system.
1109 The value may be nil if not supported on this platform. */)
1110 (void)
1111 {
1112 Lisp_Object groups = Qnil;
1113 #if defined HAVE_GETGRENT && defined HAVE_ENDGRENT
1114 struct group *gr;
1115
1116 while ((gr = getgrent ()))
1117 groups = Fcons (DECODE_SYSTEM (build_string (gr->gr_name)), groups);
1118
1119 endgrent ();
1120 #endif
1121 return groups;
1122 }
1123
1124 void
1125 syms_of_dired (void)
1126 {
1127 DEFSYM (Qdirectory_files, "directory-files");
1128 DEFSYM (Qdirectory_files_and_attributes, "directory-files-and-attributes");
1129 DEFSYM (Qfile_name_completion, "file-name-completion");
1130 DEFSYM (Qfile_name_all_completions, "file-name-all-completions");
1131 DEFSYM (Qfile_attributes, "file-attributes");
1132 DEFSYM (Qfile_attributes_lessp, "file-attributes-lessp");
1133 DEFSYM (Qdefault_directory, "default-directory");
1134 DEFSYM (Qdecomposed_characters, "decomposed-characters");
1135
1136 defsubr (&Sdirectory_files);
1137 defsubr (&Sdirectory_files_and_attributes);
1138 defsubr (&Sfile_name_completion);
1139 defsubr (&Sfile_name_all_completions);
1140 defsubr (&Sfile_attributes);
1141 defsubr (&Sfile_attributes_lessp);
1142 defsubr (&Ssystem_users);
1143 defsubr (&Ssystem_groups);
1144
1145 DEFVAR_LISP ("completion-ignored-extensions", Vcompletion_ignored_extensions,
1146 doc: /* Completion ignores file names ending in any string in this list.
1147 It does not ignore them if all possible completions end in one of
1148 these strings or when displaying a list of completions.
1149 It ignores directory names if they match any string in this list which
1150 ends in a slash. */);
1151 Vcompletion_ignored_extensions = Qnil;
1152 }