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