Avoid compiler warnings
[emacs.git] / src / dired.c
blob2dffbb756ac09d5685e77e7c33f2318e629967ed
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985-1986, 1993-1994, 1999-2016 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/types.h>
25 #include <sys/stat.h>
27 #ifdef HAVE_PWD_H
28 #include <pwd.h>
29 #endif
30 #include <grp.h>
32 #include <errno.h>
33 #include <fcntl.h>
34 #include <unistd.h>
36 #include <dirent.h>
37 #include <filemode.h>
38 #include <stat-time.h>
40 #include "lisp.h"
41 #include "systime.h"
42 #include "buffer.h"
43 #include "coding.h"
44 #include "regex.h"
46 #ifdef MSDOS
47 #include "msdos.h" /* for fstatat */
48 #endif
50 #ifdef WINDOWSNT
51 extern int is_slow_fs (const char *);
52 #endif
54 static ptrdiff_t scmp (const char *, const char *, ptrdiff_t);
55 static Lisp_Object file_attributes (int, char const *, Lisp_Object);
57 /* Return the number of bytes in DP's name. */
58 static ptrdiff_t
59 dirent_namelen (struct dirent *dp)
61 #ifdef _D_EXACT_NAMLEN
62 return _D_EXACT_NAMLEN (dp);
63 #else
64 return strlen (dp->d_name);
65 #endif
68 static DIR *
69 open_directory (Lisp_Object dirname, int *fdp)
71 char *name = SSDATA (dirname);
72 DIR *d;
73 int fd, opendir_errno;
75 #ifdef DOS_NT
76 /* Directories cannot be opened. The emulation assumes that any
77 file descriptor other than AT_FDCWD corresponds to the most
78 recently opened directory. This hack is good enough for Emacs. */
79 fd = 0;
80 d = opendir (name);
81 opendir_errno = errno;
82 #else
83 fd = emacs_open (name, O_RDONLY | O_DIRECTORY, 0);
84 if (fd < 0)
86 opendir_errno = errno;
87 d = 0;
89 else
91 d = fdopendir (fd);
92 opendir_errno = errno;
93 if (! d)
94 emacs_close (fd);
96 #endif
98 if (!d)
99 report_file_errno ("Opening directory", dirname, opendir_errno);
100 *fdp = fd;
101 return d;
104 #ifdef WINDOWSNT
105 static void
106 directory_files_internal_w32_unwind (Lisp_Object arg)
108 Vw32_get_true_file_attributes = arg;
110 #endif
112 static void
113 directory_files_internal_unwind (void *d)
115 closedir (d);
118 /* Return the next directory entry from DIR; DIR's name is DIRNAME.
119 If there are no more directory entries, return a null pointer.
120 Signal any unrecoverable errors. */
122 static struct dirent *
123 read_dirent (DIR *dir, Lisp_Object dirname)
125 while (true)
127 errno = 0;
128 struct dirent *dp = readdir (dir);
129 if (dp || errno == 0)
130 return dp;
131 if (! (errno == EAGAIN || errno == EINTR))
133 #ifdef WINDOWSNT
134 /* The MS-Windows implementation of 'opendir' doesn't
135 actually open a directory until the first call to
136 'readdir'. If 'readdir' fails to open the directory, it
137 sets errno to ENOENT or EACCES, see w32.c. */
138 if (errno == ENOENT || errno == EACCES)
139 report_file_error ("Opening directory", dirname);
140 #endif
141 report_file_error ("Reading directory", dirname);
143 QUIT;
147 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
148 If not ATTRS, return a list of directory filenames;
149 if ATTRS, return a list of directory filenames and their attributes.
150 In the latter case, ID_FORMAT is passed to Ffile_attributes. */
152 Lisp_Object
153 directory_files_internal (Lisp_Object directory, Lisp_Object full,
154 Lisp_Object match, Lisp_Object nosort, bool attrs,
155 Lisp_Object id_format)
157 ptrdiff_t directory_nbytes;
158 Lisp_Object list, dirfilename, encoded_directory;
159 struct re_pattern_buffer *bufp = NULL;
160 bool needsep = 0;
161 ptrdiff_t count = SPECPDL_INDEX ();
162 #ifdef WINDOWSNT
163 Lisp_Object w32_save = Qnil;
164 #endif
166 /* Don't let the compiler optimize away all copies of DIRECTORY,
167 which would break GC; see Bug#16986. */
168 Lisp_Object volatile directory_volatile = directory;
170 /* Because of file name handlers, these functions might call
171 Ffuncall, and cause a GC. */
172 list = encoded_directory = dirfilename = Qnil;
173 dirfilename = Fdirectory_file_name (directory);
175 if (!NILP (match))
177 CHECK_STRING (match);
179 /* MATCH might be a flawed regular expression. Rather than
180 catching and signaling our own errors, we just call
181 compile_pattern to do the work for us. */
182 /* Pass 1 for the MULTIBYTE arg
183 because we do make multibyte strings if the contents warrant. */
184 # ifdef WINDOWSNT
185 /* Windows users want case-insensitive wildcards. */
186 bufp = compile_pattern (match, 0,
187 BVAR (&buffer_defaults, case_canon_table), 0, 1);
188 # else /* !WINDOWSNT */
189 bufp = compile_pattern (match, 0, Qnil, 0, 1);
190 # endif /* !WINDOWSNT */
193 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
194 run_pre_post_conversion_on_str which calls Lisp directly and
195 indirectly. */
196 dirfilename = ENCODE_FILE (dirfilename);
197 encoded_directory = ENCODE_FILE (directory);
199 /* Now *bufp is the compiled form of MATCH; don't call anything
200 which might compile a new regexp until we're done with the loop! */
202 int fd;
203 DIR *d = open_directory (dirfilename, &fd);
205 /* Unfortunately, we can now invoke expand-file-name and
206 file-attributes on filenames, both of which can throw, so we must
207 do a proper unwind-protect. */
208 record_unwind_protect_ptr (directory_files_internal_unwind, d);
210 #ifdef WINDOWSNT
211 if (attrs)
213 /* Do this only once to avoid doing it (in w32.c:stat) for each
214 file in the directory, when we call Ffile_attributes below. */
215 record_unwind_protect (directory_files_internal_w32_unwind,
216 Vw32_get_true_file_attributes);
217 w32_save = Vw32_get_true_file_attributes;
218 if (EQ (Vw32_get_true_file_attributes, Qlocal))
220 /* w32.c:stat will notice these bindings and avoid calling
221 GetDriveType for each file. */
222 if (is_slow_fs (SSDATA (dirfilename)))
223 Vw32_get_true_file_attributes = Qnil;
224 else
225 Vw32_get_true_file_attributes = Qt;
228 #endif
230 directory_nbytes = SBYTES (directory);
231 re_match_object = Qt;
233 /* Decide whether we need to add a directory separator. */
234 if (directory_nbytes == 0
235 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
236 needsep = 1;
238 /* Loop reading directory entries. */
239 for (struct dirent *dp; (dp = read_dirent (d, directory)); )
241 ptrdiff_t len = dirent_namelen (dp);
242 Lisp_Object name = make_unibyte_string (dp->d_name, len);
243 Lisp_Object finalname = name;
245 /* Note: DECODE_FILE can GC; it should protect its argument,
246 though. */
247 name = DECODE_FILE (name);
248 len = SBYTES (name);
250 /* Now that we have unwind_protect in place, we might as well
251 allow matching to be interrupted. */
252 immediate_quit = 1;
253 QUIT;
255 bool wanted = (NILP (match)
256 || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0);
258 immediate_quit = 0;
260 if (wanted)
262 if (!NILP (full))
264 Lisp_Object fullname;
265 ptrdiff_t nbytes = len + directory_nbytes + needsep;
266 ptrdiff_t nchars;
268 fullname = make_uninit_multibyte_string (nbytes, nbytes);
269 memcpy (SDATA (fullname), SDATA (directory),
270 directory_nbytes);
272 if (needsep)
273 SSET (fullname, directory_nbytes, DIRECTORY_SEP);
275 memcpy (SDATA (fullname) + directory_nbytes + needsep,
276 SDATA (name), len);
278 nchars = multibyte_chars_in_text (SDATA (fullname), nbytes);
280 /* Some bug somewhere. */
281 if (nchars > nbytes)
282 emacs_abort ();
284 STRING_SET_CHARS (fullname, nchars);
285 if (nchars == nbytes)
286 STRING_SET_UNIBYTE (fullname);
288 finalname = fullname;
290 else
291 finalname = name;
293 if (attrs)
295 Lisp_Object fileattrs
296 = file_attributes (fd, dp->d_name, id_format);
297 list = Fcons (Fcons (finalname, fileattrs), list);
299 else
300 list = Fcons (finalname, list);
304 closedir (d);
305 #ifdef WINDOWSNT
306 if (attrs)
307 Vw32_get_true_file_attributes = w32_save;
308 #endif
310 /* Discard the unwind protect. */
311 specpdl_ptr = specpdl + count;
313 if (NILP (nosort))
314 list = Fsort (Fnreverse (list),
315 attrs ? Qfile_attributes_lessp : Qstring_lessp);
317 (void) directory_volatile;
318 return list;
322 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
323 doc: /* Return a list of names of files in DIRECTORY.
324 There are three optional arguments:
325 If FULL is non-nil, return absolute file names. Otherwise return names
326 that are relative to the specified directory.
327 If MATCH is non-nil, mention only file names that match 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 (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort)
333 Lisp_Object handler;
334 directory = Fexpand_file_name (directory, Qnil);
336 /* If the file name has special constructs in it,
337 call the corresponding file handler. */
338 handler = Ffind_file_name_handler (directory, Qdirectory_files);
339 if (!NILP (handler))
340 return call5 (handler, Qdirectory_files, directory,
341 full, match, nosort);
343 return directory_files_internal (directory, full, match, nosort, 0, Qnil);
346 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
347 Sdirectory_files_and_attributes, 1, 5, 0,
348 doc: /* Return a list of names of files and their attributes in DIRECTORY.
349 There are four optional arguments:
350 If FULL is non-nil, return absolute file names. Otherwise return names
351 that are relative to the specified directory.
352 If MATCH is non-nil, mention only file names that match the regexp MATCH.
353 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
354 NOSORT is useful if you plan to sort the result yourself.
355 ID-FORMAT specifies the preferred format of attributes uid and gid, see
356 `file-attributes' for further documentation.
357 On MS-Windows, performance depends on `w32-get-true-file-attributes',
358 which see. */)
359 (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, Lisp_Object id_format)
361 Lisp_Object handler;
362 directory = Fexpand_file_name (directory, Qnil);
364 /* If the file name has special constructs in it,
365 call the corresponding file handler. */
366 handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
367 if (!NILP (handler))
368 return call6 (handler, Qdirectory_files_and_attributes,
369 directory, full, match, nosort, id_format);
371 return directory_files_internal (directory, full, match, nosort, 1, id_format);
375 static Lisp_Object file_name_completion (Lisp_Object, Lisp_Object, bool,
376 Lisp_Object);
378 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
379 2, 3, 0,
380 doc: /* Complete file name FILE in directory DIRECTORY.
381 Returns the longest string
382 common to all file names in DIRECTORY that start with FILE.
383 If there is only one and FILE matches it exactly, returns t.
384 Returns nil if DIRECTORY contains no name starting with FILE.
386 If PREDICATE is non-nil, call PREDICATE with each possible
387 completion (in absolute form) and ignore it if PREDICATE returns nil.
389 This function ignores some of the possible completions as determined
390 by the variables `completion-regexp-list' and
391 `completion-ignored-extensions', which see. `completion-regexp-list'
392 is matched against file and directory names relative to DIRECTORY. */)
393 (Lisp_Object file, Lisp_Object directory, Lisp_Object predicate)
395 Lisp_Object handler;
396 directory = Fexpand_file_name (directory, Qnil);
398 /* If the directory name has special constructs in it,
399 call the corresponding file handler. */
400 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
401 if (!NILP (handler))
402 return call4 (handler, Qfile_name_completion, file, directory, predicate);
404 /* If the file name has special constructs in it,
405 call the corresponding file handler. */
406 handler = Ffind_file_name_handler (file, Qfile_name_completion);
407 if (!NILP (handler))
408 return call4 (handler, Qfile_name_completion, file, directory, predicate);
410 return file_name_completion (file, directory, 0, predicate);
413 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
414 Sfile_name_all_completions, 2, 2, 0,
415 doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
416 These are all file names in directory DIRECTORY which begin with FILE.
418 This function ignores some of the possible completions as determined
419 by the variables `completion-regexp-list' and
420 `completion-ignored-extensions', which see. `completion-regexp-list'
421 is matched against file and directory names relative to DIRECTORY. */)
422 (Lisp_Object file, Lisp_Object directory)
424 Lisp_Object handler;
425 directory = Fexpand_file_name (directory, Qnil);
427 /* If the directory name has special constructs in it,
428 call the corresponding file handler. */
429 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
430 if (!NILP (handler))
431 return call3 (handler, Qfile_name_all_completions, file, directory);
433 /* If the file name has special constructs in it,
434 call the corresponding file handler. */
435 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
436 if (!NILP (handler))
437 return call3 (handler, Qfile_name_all_completions, file, directory);
439 return file_name_completion (file, directory, 1, Qnil);
442 static int file_name_completion_stat (int, struct dirent *, struct stat *);
444 static Lisp_Object
445 file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
446 Lisp_Object predicate)
448 ptrdiff_t bestmatchsize = 0;
449 int matchcount = 0;
450 /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
451 If ALL_FLAG is 0, BESTMATCH is either nil
452 or the best match so far, not decoded. */
453 Lisp_Object bestmatch, tem, elt, name;
454 Lisp_Object encoded_file;
455 Lisp_Object encoded_dir;
456 struct stat st;
457 bool directoryp;
458 /* If not INCLUDEALL, exclude files in completion-ignored-extensions as
459 well as "." and "..". Until shown otherwise, assume we can't exclude
460 anything. */
461 bool includeall = 1;
462 bool check_decoded = false;
463 ptrdiff_t count = SPECPDL_INDEX ();
465 elt = Qnil;
467 CHECK_STRING (file);
469 bestmatch = Qnil;
470 encoded_file = encoded_dir = Qnil;
471 specbind (Qdefault_directory, dirname);
473 /* Do completion on the encoded file name
474 because the other names in the directory are (we presume)
475 encoded likewise. We decode the completed string at the end. */
476 /* Actually, this is not quite true any more: we do most of the completion
477 work with decoded file names, but we still do some filtering based
478 on the encoded file name. */
479 encoded_file = ENCODE_FILE (file);
480 encoded_dir = ENCODE_FILE (Fdirectory_file_name (dirname));
482 Lisp_Object file_encoding = Vfile_name_coding_system;
483 if (NILP (Vfile_name_coding_system))
484 file_encoding = Vdefault_file_name_coding_system;
485 /* If the file-name encoding decomposes characters, as we do for
486 HFS+ filesystems, we need to make an additional comparison of
487 decoded names in order to filter false positives, such as "a"
488 falsely matching "a-ring". */
489 if (!NILP (file_encoding)
490 && !NILP (Fplist_get (Fcoding_system_plist (file_encoding),
491 Qdecomposed_characters)))
493 check_decoded = true;
494 if (STRING_MULTIBYTE (file))
496 /* Recompute FILE to make sure any decomposed characters in
497 it are re-composed by the post-read-conversion.
498 Otherwise, any decomposed characters will be rejected by
499 the additional check below. */
500 file = DECODE_FILE (encoded_file);
503 int fd;
504 DIR *d = open_directory (encoded_dir, &fd);
505 record_unwind_protect_ptr (directory_files_internal_unwind, d);
507 /* Loop reading directory entries. */
508 for (struct dirent *dp; (dp = read_dirent (d, dirname)); )
510 ptrdiff_t len = dirent_namelen (dp);
511 bool canexclude = 0;
513 QUIT;
514 if (len < SCHARS (encoded_file)
515 || (scmp (dp->d_name, SSDATA (encoded_file),
516 SCHARS (encoded_file))
517 >= 0))
518 continue;
520 if (file_name_completion_stat (fd, dp, &st) < 0)
521 continue;
523 directoryp = S_ISDIR (st.st_mode) != 0;
524 tem = Qnil;
525 /* If all_flag is set, always include all.
526 It would not actually be helpful to the user to ignore any possible
527 completions when making a list of them. */
528 if (!all_flag)
530 ptrdiff_t skip;
532 #if 0 /* FIXME: The `scmp' call compares an encoded and a decoded string. */
533 /* If this entry matches the current bestmatch, the only
534 thing it can do is increase matchcount, so don't bother
535 investigating it any further. */
536 if (!completion_ignore_case
537 /* The return result depends on whether it's the sole match. */
538 && matchcount > 1
539 && !includeall /* This match may allow includeall to 0. */
540 && len >= bestmatchsize
541 && 0 > scmp (dp->d_name, SSDATA (bestmatch), bestmatchsize))
542 continue;
543 #endif
545 if (directoryp)
547 #ifndef TRIVIAL_DIRECTORY_ENTRY
548 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
549 #endif
550 /* "." and ".." are never interesting as completions, and are
551 actually in the way in a directory with only one file. */
552 if (TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
553 canexclude = 1;
554 else if (len > SCHARS (encoded_file))
555 /* Ignore directories if they match an element of
556 completion-ignored-extensions which ends in a slash. */
557 for (tem = Vcompletion_ignored_extensions;
558 CONSP (tem); tem = XCDR (tem))
560 ptrdiff_t elt_len;
561 char *p1;
563 elt = XCAR (tem);
564 if (!STRINGP (elt))
565 continue;
566 /* Need to encode ELT, since scmp compares unibyte
567 strings only. */
568 elt = ENCODE_FILE (elt);
569 elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
570 if (elt_len <= 0)
571 continue;
572 p1 = SSDATA (elt);
573 if (p1[elt_len] != '/')
574 continue;
575 skip = len - elt_len;
576 if (skip < 0)
577 continue;
579 if (scmp (dp->d_name + skip, p1, elt_len) >= 0)
580 continue;
581 break;
584 else
586 /* Compare extensions-to-be-ignored against end of this file name */
587 /* if name is not an exact match against specified string */
588 if (len > SCHARS (encoded_file))
589 /* and exit this for loop if a match is found */
590 for (tem = Vcompletion_ignored_extensions;
591 CONSP (tem); tem = XCDR (tem))
593 elt = XCAR (tem);
594 if (!STRINGP (elt)) continue;
595 /* Need to encode ELT, since scmp compares unibyte
596 strings only. */
597 elt = ENCODE_FILE (elt);
598 skip = len - SCHARS (elt);
599 if (skip < 0) continue;
601 if (scmp (dp->d_name + skip, SSDATA (elt), SCHARS (elt))
602 >= 0)
603 continue;
604 break;
608 /* If an ignored-extensions match was found,
609 don't process this name as a completion. */
610 if (CONSP (tem))
611 canexclude = 1;
613 if (!includeall && canexclude)
614 /* We're not including all files and this file can be excluded. */
615 continue;
617 if (includeall && !canexclude)
618 { /* If we have one non-excludable file, we want to exclude the
619 excludable files. */
620 includeall = 0;
621 /* Throw away any previous excludable match found. */
622 bestmatch = Qnil;
623 bestmatchsize = 0;
624 matchcount = 0;
627 /* FIXME: If we move this `decode' earlier we can eliminate
628 the repeated ENCODE_FILE on Vcompletion_ignored_extensions. */
629 name = make_unibyte_string (dp->d_name, len);
630 name = DECODE_FILE (name);
633 Lisp_Object regexps, table = (completion_ignore_case
634 ? Vascii_canon_table : Qnil);
636 /* Ignore this element if it fails to match all the regexps. */
637 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
638 regexps = XCDR (regexps))
639 if (fast_string_match_internal (XCAR (regexps), name, table) < 0)
640 break;
642 if (CONSP (regexps))
643 continue;
646 /* This is a possible completion */
647 if (directoryp)
648 /* This completion is a directory; make it end with '/'. */
649 name = Ffile_name_as_directory (name);
651 /* Test the predicate, if any. */
652 if (!NILP (predicate) && NILP (call1 (predicate, name)))
653 continue;
655 /* Reject entries where the encoded strings match, but the
656 decoded don't. For example, "a" should not match "a-ring" on
657 file systems that store decomposed characters. */
658 Lisp_Object zero = make_number (0);
660 if (check_decoded && SCHARS (file) <= SCHARS (name))
662 /* FIXME: This is a copy of the code below. */
663 ptrdiff_t compare = SCHARS (file);
664 Lisp_Object cmp
665 = Fcompare_strings (name, zero, make_number (compare),
666 file, zero, make_number (compare),
667 completion_ignore_case ? Qt : Qnil);
668 if (!EQ (cmp, Qt))
669 continue;
672 /* Suitably record this match. */
674 matchcount += matchcount <= 1;
676 if (all_flag)
677 bestmatch = Fcons (name, bestmatch);
678 else if (NILP (bestmatch))
680 bestmatch = name;
681 bestmatchsize = SCHARS (name);
683 else
685 /* FIXME: This is a copy of the code in Ftry_completion. */
686 ptrdiff_t compare = min (bestmatchsize, SCHARS (name));
687 Lisp_Object cmp
688 = Fcompare_strings (bestmatch, zero, make_number (compare),
689 name, zero, make_number (compare),
690 completion_ignore_case ? Qt : Qnil);
691 ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XINT (cmp)) - 1;
693 if (completion_ignore_case)
695 /* If this is an exact match except for case,
696 use it as the best match rather than one that is not
697 an exact match. This way, we get the case pattern
698 of the actual match. */
699 /* This tests that the current file is an exact match
700 but BESTMATCH is not (it is too long). */
701 if ((matchsize == SCHARS (name)
702 && matchsize + directoryp < SCHARS (bestmatch))
704 /* If there is no exact match ignoring case,
705 prefer a match that does not change the case
706 of the input. */
707 /* If there is more than one exact match aside from
708 case, and one of them is exact including case,
709 prefer that one. */
710 /* This == checks that, of current file and BESTMATCH,
711 either both or neither are exact. */
712 (((matchsize == SCHARS (name))
714 (matchsize + directoryp == SCHARS (bestmatch)))
715 && (cmp = Fcompare_strings (name, zero,
716 make_number (SCHARS (file)),
717 file, zero,
718 Qnil,
719 Qnil),
720 EQ (Qt, cmp))
721 && (cmp = Fcompare_strings (bestmatch, zero,
722 make_number (SCHARS (file)),
723 file, zero,
724 Qnil,
725 Qnil),
726 ! EQ (Qt, cmp))))
727 bestmatch = name;
729 bestmatchsize = matchsize;
731 /* If the best completion so far is reduced to the string
732 we're trying to complete, then we already know there's no
733 other completion, so there's no point looking any further. */
734 if (matchsize <= SCHARS (file)
735 && !includeall /* A future match may allow includeall to 0. */
736 /* If completion-ignore-case is non-nil, don't
737 short-circuit because we want to find the best
738 possible match *including* case differences. */
739 && (!completion_ignore_case || matchsize == 0)
740 /* The return value depends on whether it's the sole match. */
741 && matchcount > 1)
742 break;
747 /* This closes the directory. */
748 bestmatch = unbind_to (count, bestmatch);
750 if (all_flag || NILP (bestmatch))
751 return bestmatch;
752 /* Return t if the supplied string is an exact match (counting case);
753 it does not require any change to be made. */
754 if (matchcount == 1 && !NILP (Fequal (bestmatch, file)))
755 return Qt;
756 bestmatch = Fsubstring (bestmatch, make_number (0),
757 make_number (bestmatchsize));
758 return bestmatch;
761 /* Compare exactly LEN chars of strings at S1 and S2,
762 ignoring case if appropriate.
763 Return -1 if strings match,
764 else number of chars that match at the beginning. */
766 static ptrdiff_t
767 scmp (const char *s1, const char *s2, ptrdiff_t len)
769 register ptrdiff_t l = len;
771 if (completion_ignore_case)
773 while (l
774 && (downcase ((unsigned char) *s1++)
775 == downcase ((unsigned char) *s2++)))
776 l--;
778 else
780 while (l && *s1++ == *s2++)
781 l--;
783 if (l == 0)
784 return -1;
785 else
786 return len - l;
789 static int
790 file_name_completion_stat (int fd, struct dirent *dp, struct stat *st_addr)
792 int value;
794 #ifdef MSDOS
795 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
796 but aren't required here. Avoid computing the following fields:
797 st_inode, st_size and st_nlink for directories, and the execute bits
798 in st_mode for non-directory files with non-standard extensions. */
800 unsigned short save_djstat_flags = _djstat_flags;
802 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
803 #endif /* MSDOS */
805 /* We want to return success if a link points to a nonexistent file,
806 but we want to return the status for what the link points to,
807 in case it is a directory. */
808 value = fstatat (fd, dp->d_name, st_addr, AT_SYMLINK_NOFOLLOW);
809 if (value == 0 && S_ISLNK (st_addr->st_mode))
810 fstatat (fd, dp->d_name, st_addr, 0);
811 #ifdef MSDOS
812 _djstat_flags = save_djstat_flags;
813 #endif /* MSDOS */
814 return value;
817 static char *
818 stat_uname (struct stat *st)
820 #ifdef WINDOWSNT
821 return st->st_uname;
822 #else
823 struct passwd *pw = getpwuid (st->st_uid);
825 if (pw)
826 return pw->pw_name;
827 else
828 return NULL;
829 #endif
832 static char *
833 stat_gname (struct stat *st)
835 #ifdef WINDOWSNT
836 return st->st_gname;
837 #else
838 struct group *gr = getgrgid (st->st_gid);
840 if (gr)
841 return gr->gr_name;
842 else
843 return NULL;
844 #endif
847 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
848 doc: /* Return a list of attributes of file FILENAME.
849 Value is nil if specified file cannot be opened.
851 ID-FORMAT specifies the preferred format of attributes uid and gid (see
852 below) - valid values are `string' and `integer'. The latter is the
853 default, but we plan to change that, so you should specify a non-nil value
854 for ID-FORMAT if you use the returned uid or gid.
856 To access the elements returned, the following access functions are
857 provided: `file-attribute-type', `file-attribute-link-number',
858 `file-attribute-user-id', `file-attribute-group-id',
859 `file-attribute-access-time', `file-attribute-modification-time',
860 `file-attribute-status-change-time', `file-attribute-size',
861 `file-attribute-modes', `file-attribute-inode-number', and
862 `file-attribute-device-number'.
864 Elements of the attribute list are:
865 0. t for directory, string (name linked to) for symbolic link, or nil.
866 1. Number of links to file.
867 2. File uid as a string or a number. If a string value cannot be
868 looked up, a numeric value, either an integer or a float, is returned.
869 3. File gid, likewise.
870 4. Last access time, as a list of integers (HIGH LOW USEC PSEC) in the
871 same style as (current-time).
872 (See a note below about access time on FAT-based filesystems.)
873 5. Last modification time, likewise. This is the time of the last
874 change to the file's contents.
875 6. Last status change time, likewise. This is the time of last change
876 to the file's attributes: owner and group, access mode bits, etc.
877 7. Size in bytes.
878 This is a floating point number if the size is too large for an integer.
879 8. File modes, as a string of ten letters or dashes as in ls -l.
880 9. An unspecified value, present only for backward compatibility.
881 10. inode number. If it is larger than what an Emacs integer can hold,
882 this is of the form (HIGH . LOW): first the high bits, then the low 16 bits.
883 If even HIGH is too large for an Emacs integer, this is instead of the form
884 (HIGH MIDDLE . LOW): first the high bits, then the middle 24 bits,
885 and finally the low 16 bits.
886 11. Filesystem device number. If it is larger than what the Emacs
887 integer can hold, this is a cons cell, similar to the inode number.
889 On most filesystems, the combination of the inode and the device
890 number uniquely identifies the file.
892 On MS-Windows, performance depends on `w32-get-true-file-attributes',
893 which see.
895 On some FAT-based filesystems, only the date of last access is recorded,
896 so last access time will always be midnight of that day. */)
897 (Lisp_Object filename, Lisp_Object id_format)
899 Lisp_Object encoded;
900 Lisp_Object handler;
902 filename = internal_condition_case_2 (Fexpand_file_name, filename, Qnil,
903 Qt, Fidentity);
904 if (!STRINGP (filename))
905 return Qnil;
907 /* If the file name has special constructs in it,
908 call the corresponding file handler. */
909 handler = Ffind_file_name_handler (filename, Qfile_attributes);
910 if (!NILP (handler))
911 { /* Only pass the extra arg if it is used to help backward compatibility
912 with old file handlers which do not implement the new arg. --Stef */
913 if (NILP (id_format))
914 return call2 (handler, Qfile_attributes, filename);
915 else
916 return call3 (handler, Qfile_attributes, filename, id_format);
919 encoded = ENCODE_FILE (filename);
920 return file_attributes (AT_FDCWD, SSDATA (encoded), id_format);
923 static Lisp_Object
924 file_attributes (int fd, char const *name, Lisp_Object id_format)
926 struct stat s;
927 int lstat_result;
929 /* An array to hold the mode string generated by filemodestring,
930 including its terminating space and null byte. */
931 char modes[sizeof "-rwxr-xr-x "];
933 char *uname = NULL, *gname = NULL;
935 #ifdef WINDOWSNT
936 /* We usually don't request accurate owner and group info, because
937 it can be very expensive on Windows to get that, and most callers
938 of 'lstat' don't need that. But here we do want that information
939 to be accurate. */
940 w32_stat_get_owner_group = 1;
941 #endif
943 lstat_result = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW);
945 #ifdef WINDOWSNT
946 w32_stat_get_owner_group = 0;
947 #endif
949 if (lstat_result < 0)
950 return Qnil;
952 if (!(NILP (id_format) || EQ (id_format, Qinteger)))
954 uname = stat_uname (&s);
955 gname = stat_gname (&s);
958 filemodestring (&s, modes);
960 return CALLN (Flist,
961 (S_ISLNK (s.st_mode) ? emacs_readlinkat (fd, name)
962 : S_ISDIR (s.st_mode) ? Qt : Qnil),
963 make_number (s.st_nlink),
964 (uname
965 ? DECODE_SYSTEM (build_unibyte_string (uname))
966 : make_fixnum_or_float (s.st_uid)),
967 (gname
968 ? DECODE_SYSTEM (build_unibyte_string (gname))
969 : make_fixnum_or_float (s.st_gid)),
970 make_lisp_time (get_stat_atime (&s)),
971 make_lisp_time (get_stat_mtime (&s)),
972 make_lisp_time (get_stat_ctime (&s)),
974 /* If the file size is a 4-byte type, assume that
975 files of sizes in the 2-4 GiB range wrap around to
976 negative values, as this is a common bug on older
977 32-bit platforms. */
978 make_fixnum_or_float (sizeof (s.st_size) == 4
979 ? s.st_size & 0xffffffffu
980 : s.st_size),
982 make_string (modes, 10),
984 INTEGER_TO_CONS (s.st_ino),
985 INTEGER_TO_CONS (s.st_dev));
988 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
989 doc: /* Return t if first arg file attributes list is less than second.
990 Comparison is in lexicographic order and case is significant. */)
991 (Lisp_Object f1, Lisp_Object f2)
993 return Fstring_lessp (Fcar (f1), Fcar (f2));
997 DEFUN ("system-users", Fsystem_users, Ssystem_users, 0, 0, 0,
998 doc: /* Return a list of user names currently registered in the system.
999 If we don't know how to determine that on this platform, just
1000 return a list with one element, taken from `user-real-login-name'. */)
1001 (void)
1003 Lisp_Object users = Qnil;
1004 #if defined HAVE_GETPWENT && defined HAVE_ENDPWENT
1005 struct passwd *pw;
1007 while ((pw = getpwent ()))
1008 users = Fcons (DECODE_SYSTEM (build_string (pw->pw_name)), users);
1010 endpwent ();
1011 #endif
1012 if (EQ (users, Qnil))
1013 /* At least current user is always known. */
1014 users = list1 (Vuser_real_login_name);
1015 return users;
1018 DEFUN ("system-groups", Fsystem_groups, Ssystem_groups, 0, 0, 0,
1019 doc: /* Return a list of user group names currently registered in the system.
1020 The value may be nil if not supported on this platform. */)
1021 (void)
1023 Lisp_Object groups = Qnil;
1024 #if defined HAVE_GETGRENT && defined HAVE_ENDGRENT
1025 struct group *gr;
1027 while ((gr = getgrent ()))
1028 groups = Fcons (DECODE_SYSTEM (build_string (gr->gr_name)), groups);
1030 endgrent ();
1031 #endif
1032 return groups;
1035 void
1036 syms_of_dired (void)
1038 DEFSYM (Qdirectory_files, "directory-files");
1039 DEFSYM (Qdirectory_files_and_attributes, "directory-files-and-attributes");
1040 DEFSYM (Qfile_name_completion, "file-name-completion");
1041 DEFSYM (Qfile_name_all_completions, "file-name-all-completions");
1042 DEFSYM (Qfile_attributes, "file-attributes");
1043 DEFSYM (Qfile_attributes_lessp, "file-attributes-lessp");
1044 DEFSYM (Qdefault_directory, "default-directory");
1045 DEFSYM (Qdecomposed_characters, "decomposed-characters");
1047 defsubr (&Sdirectory_files);
1048 defsubr (&Sdirectory_files_and_attributes);
1049 defsubr (&Sfile_name_completion);
1050 defsubr (&Sfile_name_all_completions);
1051 defsubr (&Sfile_attributes);
1052 defsubr (&Sfile_attributes_lessp);
1053 defsubr (&Ssystem_users);
1054 defsubr (&Ssystem_groups);
1056 DEFVAR_LISP ("completion-ignored-extensions", Vcompletion_ignored_extensions,
1057 doc: /* Completion ignores file names ending in any string in this list.
1058 It does not ignore them if all possible completions end in one of
1059 these strings or when displaying a list of completions.
1060 It ignores directory names if they match any string in this list which
1061 ends in a slash. */);
1062 Vcompletion_ignored_extensions = Qnil;