Prefer straight quoting in some text files
[emacs.git] / src / dired.c
blob97736673f5d5aefa6f76a59b24e241a6ed7171a4
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985-1986, 1993-1994, 1999-2015 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
10 (at 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 "character.h"
43 #include "buffer.h"
44 #include "commands.h"
45 #include "charset.h"
46 #include "coding.h"
47 #include "regex.h"
48 #include "blockinput.h"
50 #ifdef MSDOS
51 #include "msdos.h" /* for fstatat */
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 block_input ();
77 #ifdef DOS_NT
78 /* Directories cannot be opened. The emulation assumes that any
79 file descriptor other than AT_FDCWD corresponds to the most
80 recently opened directory. This hack is good enough for Emacs. */
81 fd = 0;
82 d = opendir (name);
83 opendir_errno = errno;
84 #else
85 fd = emacs_open (name, O_RDONLY | O_DIRECTORY, 0);
86 if (fd < 0)
88 opendir_errno = errno;
89 d = 0;
91 else
93 d = fdopendir (fd);
94 opendir_errno = errno;
95 if (! d)
96 emacs_close (fd);
98 #endif
100 unblock_input ();
102 if (!d)
103 report_file_errno ("Opening directory", dirname, opendir_errno);
104 *fdp = fd;
105 return d;
108 #ifdef WINDOWSNT
109 void
110 directory_files_internal_w32_unwind (Lisp_Object arg)
112 Vw32_get_true_file_attributes = arg;
114 #endif
116 static void
117 directory_files_internal_unwind (void *dh)
119 DIR *d = dh;
120 block_input ();
121 closedir (d);
122 unblock_input ();
125 /* Return the next directory entry from DIR; DIR's name is DIRNAME.
126 If there are no more directory entries, return a null pointer.
127 Signal any unrecoverable errors. */
129 static struct dirent *
130 read_dirent (DIR *dir, Lisp_Object dirname)
132 while (true)
134 errno = 0;
135 struct dirent *dp = readdir (dir);
136 if (dp || errno == 0)
137 return dp;
138 if (! (errno == EAGAIN || errno == EINTR))
140 #ifdef WINDOWSNT
141 /* The MS-Windows implementation of 'opendir' doesn't
142 actually open a directory until the first call to
143 'readdir'. If 'readdir' fails to open the directory, it
144 sets errno to ENOENT or EACCES, see w32.c. */
145 if (errno == ENOENT || errno == EACCES)
146 report_file_error ("Opening directory", dirname);
147 #endif
148 report_file_error ("Reading directory", dirname);
150 QUIT;
154 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
155 If not ATTRS, return a list of directory filenames;
156 if ATTRS, return a list of directory filenames and their attributes.
157 In the latter case, ID_FORMAT is passed to Ffile_attributes. */
159 Lisp_Object
160 directory_files_internal (Lisp_Object directory, Lisp_Object full,
161 Lisp_Object match, Lisp_Object nosort, bool attrs,
162 Lisp_Object id_format)
164 ptrdiff_t directory_nbytes;
165 Lisp_Object list, dirfilename, encoded_directory;
166 struct re_pattern_buffer *bufp = NULL;
167 bool needsep = 0;
168 ptrdiff_t count = SPECPDL_INDEX ();
169 #ifdef WINDOWSNT
170 Lisp_Object w32_save = Qnil;
171 #endif
173 /* Don't let the compiler optimize away all copies of DIRECTORY,
174 which would break GC; see Bug#16986. */
175 Lisp_Object volatile directory_volatile = directory;
177 /* Because of file name handlers, these functions might call
178 Ffuncall, and cause a GC. */
179 list = encoded_directory = dirfilename = Qnil;
180 dirfilename = Fdirectory_file_name (directory);
182 if (!NILP (match))
184 CHECK_STRING (match);
186 /* MATCH might be a flawed regular expression. Rather than
187 catching and signaling our own errors, we just call
188 compile_pattern to do the work for us. */
189 /* Pass 1 for the MULTIBYTE arg
190 because we do make multibyte strings if the contents warrant. */
191 # ifdef WINDOWSNT
192 /* Windows users want case-insensitive wildcards. */
193 bufp = compile_pattern (match, 0,
194 BVAR (&buffer_defaults, case_canon_table), 0, 1);
195 # else /* !WINDOWSNT */
196 bufp = compile_pattern (match, 0, Qnil, 0, 1);
197 # endif /* !WINDOWSNT */
200 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
201 run_pre_post_conversion_on_str which calls Lisp directly and
202 indirectly. */
203 dirfilename = ENCODE_FILE (dirfilename);
204 encoded_directory = ENCODE_FILE (directory);
206 /* Now *bufp is the compiled form of MATCH; don't call anything
207 which might compile a new regexp until we're done with the loop! */
209 int fd;
210 DIR *d = open_directory (dirfilename, &fd);
212 /* Unfortunately, we can now invoke expand-file-name and
213 file-attributes on filenames, both of which can throw, so we must
214 do a proper unwind-protect. */
215 record_unwind_protect_ptr (directory_files_internal_unwind, d);
217 #ifdef WINDOWSNT
218 if (attrs)
220 extern int is_slow_fs (const char *);
222 /* Do this only once to avoid doing it (in w32.c:stat) for each
223 file in the directory, when we call Ffile_attributes below. */
224 record_unwind_protect (directory_files_internal_w32_unwind,
225 Vw32_get_true_file_attributes);
226 w32_save = Vw32_get_true_file_attributes;
227 if (EQ (Vw32_get_true_file_attributes, Qlocal))
229 /* w32.c:stat will notice these bindings and avoid calling
230 GetDriveType for each file. */
231 if (is_slow_fs (SDATA (dirfilename)))
232 Vw32_get_true_file_attributes = Qnil;
233 else
234 Vw32_get_true_file_attributes = Qt;
237 #endif
239 directory_nbytes = SBYTES (directory);
240 re_match_object = Qt;
242 /* Decide whether we need to add a directory separator. */
243 if (directory_nbytes == 0
244 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
245 needsep = 1;
247 /* Loop reading directory entries. */
248 for (struct dirent *dp; (dp = read_dirent (d, directory)); )
250 ptrdiff_t len = dirent_namelen (dp);
251 Lisp_Object name = make_unibyte_string (dp->d_name, len);
252 Lisp_Object finalname = name;
254 /* Note: DECODE_FILE can GC; it should protect its argument,
255 though. */
256 name = DECODE_FILE (name);
257 len = SBYTES (name);
259 /* Now that we have unwind_protect in place, we might as well
260 allow matching to be interrupted. */
261 immediate_quit = 1;
262 QUIT;
264 bool wanted = (NILP (match)
265 || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0);
267 immediate_quit = 0;
269 if (wanted)
271 if (!NILP (full))
273 Lisp_Object fullname;
274 ptrdiff_t nbytes = len + directory_nbytes + needsep;
275 ptrdiff_t nchars;
277 fullname = make_uninit_multibyte_string (nbytes, nbytes);
278 memcpy (SDATA (fullname), SDATA (directory),
279 directory_nbytes);
281 if (needsep)
282 SSET (fullname, directory_nbytes, DIRECTORY_SEP);
284 memcpy (SDATA (fullname) + directory_nbytes + needsep,
285 SDATA (name), len);
287 nchars = multibyte_chars_in_text (SDATA (fullname), nbytes);
289 /* Some bug somewhere. */
290 if (nchars > nbytes)
291 emacs_abort ();
293 STRING_SET_CHARS (fullname, nchars);
294 if (nchars == nbytes)
295 STRING_SET_UNIBYTE (fullname);
297 finalname = fullname;
299 else
300 finalname = name;
302 if (attrs)
304 Lisp_Object fileattrs
305 = file_attributes (fd, dp->d_name, id_format);
306 list = Fcons (Fcons (finalname, fileattrs), list);
308 else
309 list = Fcons (finalname, list);
313 block_input ();
314 closedir (d);
315 unblock_input ();
316 #ifdef WINDOWSNT
317 if (attrs)
318 Vw32_get_true_file_attributes = w32_save;
319 #endif
321 /* Discard the unwind protect. */
322 specpdl_ptr = specpdl + count;
324 if (NILP (nosort))
325 list = Fsort (Fnreverse (list),
326 attrs ? Qfile_attributes_lessp : Qstring_lessp);
328 (void) directory_volatile;
329 return list;
333 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
334 doc: /* Return a list of names of files in DIRECTORY.
335 There are three optional arguments:
336 If FULL is non-nil, return absolute file names. Otherwise return names
337 that are relative to the specified directory.
338 If MATCH is non-nil, mention only file names that match the regexp MATCH.
339 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
340 Otherwise, the list returned is sorted with `string-lessp'.
341 NOSORT is useful if you plan to sort the result yourself. */)
342 (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort)
344 Lisp_Object handler;
345 directory = Fexpand_file_name (directory, Qnil);
347 /* If the file name has special constructs in it,
348 call the corresponding file handler. */
349 handler = Ffind_file_name_handler (directory, Qdirectory_files);
350 if (!NILP (handler))
351 return call5 (handler, Qdirectory_files, directory,
352 full, match, nosort);
354 return directory_files_internal (directory, full, match, nosort, 0, Qnil);
357 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
358 Sdirectory_files_and_attributes, 1, 5, 0,
359 doc: /* Return a list of names of files and their attributes in DIRECTORY.
360 There are four optional arguments:
361 If FULL is non-nil, return absolute file names. Otherwise return names
362 that are relative to the specified directory.
363 If MATCH is non-nil, mention only file names that match 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 On MS-Windows, performance depends on `w32-get-true-file-attributes',
369 which see. */)
370 (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, Lisp_Object id_format)
372 Lisp_Object handler;
373 directory = Fexpand_file_name (directory, Qnil);
375 /* If the file name has special constructs in it,
376 call the corresponding file handler. */
377 handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
378 if (!NILP (handler))
379 return call6 (handler, Qdirectory_files_and_attributes,
380 directory, full, match, nosort, id_format);
382 return directory_files_internal (directory, full, match, nosort, 1, id_format);
386 static Lisp_Object file_name_completion (Lisp_Object, Lisp_Object, bool,
387 Lisp_Object);
389 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
390 2, 3, 0,
391 doc: /* Complete file name FILE in directory DIRECTORY.
392 Returns the longest string
393 common to all file names in DIRECTORY that start with FILE.
394 If there is only one and FILE matches it exactly, returns t.
395 Returns nil if DIRECTORY contains no name starting with FILE.
397 If PREDICATE is non-nil, call PREDICATE with each possible
398 completion (in absolute form) and ignore it if PREDICATE returns nil.
400 This function ignores some of the possible completions as
401 determined by the variable `completion-ignored-extensions', which see. */)
402 (Lisp_Object file, Lisp_Object directory, Lisp_Object predicate)
404 Lisp_Object handler;
405 directory = Fexpand_file_name (directory, Qnil);
407 /* If the directory name has special constructs in it,
408 call the corresponding file handler. */
409 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
410 if (!NILP (handler))
411 return call4 (handler, Qfile_name_completion, file, directory, predicate);
413 /* If the file name has special constructs in it,
414 call the corresponding file handler. */
415 handler = Ffind_file_name_handler (file, Qfile_name_completion);
416 if (!NILP (handler))
417 return call4 (handler, Qfile_name_completion, file, directory, predicate);
419 return file_name_completion (file, directory, 0, predicate);
422 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
423 Sfile_name_all_completions, 2, 2, 0,
424 doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
425 These are all file names in directory DIRECTORY which begin with FILE. */)
426 (Lisp_Object file, Lisp_Object directory)
428 Lisp_Object handler;
429 directory = Fexpand_file_name (directory, Qnil);
431 /* If the directory name has special constructs in it,
432 call the corresponding file handler. */
433 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
434 if (!NILP (handler))
435 return call3 (handler, Qfile_name_all_completions, file, directory);
437 /* If the file name has special constructs in it,
438 call the corresponding file handler. */
439 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
440 if (!NILP (handler))
441 return call3 (handler, Qfile_name_all_completions, file, directory);
443 return file_name_completion (file, directory, 1, Qnil);
446 static int file_name_completion_stat (int, struct dirent *, struct stat *);
448 static Lisp_Object
449 file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
450 Lisp_Object predicate)
452 ptrdiff_t bestmatchsize = 0;
453 int matchcount = 0;
454 /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
455 If ALL_FLAG is 0, BESTMATCH is either nil
456 or the best match so far, not decoded. */
457 Lisp_Object bestmatch, tem, elt, name;
458 Lisp_Object encoded_file;
459 Lisp_Object encoded_dir;
460 struct stat st;
461 bool directoryp;
462 /* If not INCLUDEALL, exclude files in completion-ignored-extensions as
463 well as "." and "..". Until shown otherwise, assume we can't exclude
464 anything. */
465 bool includeall = 1;
466 ptrdiff_t count = SPECPDL_INDEX ();
468 elt = Qnil;
470 CHECK_STRING (file);
472 bestmatch = Qnil;
473 encoded_file = encoded_dir = Qnil;
474 specbind (Qdefault_directory, dirname);
476 /* Do completion on the encoded file name
477 because the other names in the directory are (we presume)
478 encoded likewise. We decode the completed string at the end. */
479 /* Actually, this is not quite true any more: we do most of the completion
480 work with decoded file names, but we still do some filtering based
481 on the encoded file name. */
482 encoded_file = ENCODE_FILE (file);
483 encoded_dir = ENCODE_FILE (Fdirectory_file_name (dirname));
484 int fd;
485 DIR *d = open_directory (encoded_dir, &fd);
486 record_unwind_protect_ptr (directory_files_internal_unwind, d);
488 /* Loop reading directory entries. */
489 for (struct dirent *dp; (dp = read_dirent (d, dirname)); )
491 ptrdiff_t len = dirent_namelen (dp);
492 bool canexclude = 0;
494 QUIT;
495 if (len < SCHARS (encoded_file)
496 || (scmp (dp->d_name, SSDATA (encoded_file),
497 SCHARS (encoded_file))
498 >= 0))
499 continue;
501 if (file_name_completion_stat (fd, dp, &st) < 0)
502 continue;
504 directoryp = S_ISDIR (st.st_mode) != 0;
505 tem = Qnil;
506 /* If all_flag is set, always include all.
507 It would not actually be helpful to the user to ignore any possible
508 completions when making a list of them. */
509 if (!all_flag)
511 ptrdiff_t skip;
513 #if 0 /* FIXME: The `scmp' call compares an encoded and a decoded string. */
514 /* If this entry matches the current bestmatch, the only
515 thing it can do is increase matchcount, so don't bother
516 investigating it any further. */
517 if (!completion_ignore_case
518 /* The return result depends on whether it's the sole match. */
519 && matchcount > 1
520 && !includeall /* This match may allow includeall to 0. */
521 && len >= bestmatchsize
522 && 0 > scmp (dp->d_name, SSDATA (bestmatch), bestmatchsize))
523 continue;
524 #endif
526 if (directoryp)
528 #ifndef TRIVIAL_DIRECTORY_ENTRY
529 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
530 #endif
531 /* "." and ".." are never interesting as completions, and are
532 actually in the way in a directory with only one file. */
533 if (TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
534 canexclude = 1;
535 else if (len > SCHARS (encoded_file))
536 /* Ignore directories if they match an element of
537 completion-ignored-extensions which ends in a slash. */
538 for (tem = Vcompletion_ignored_extensions;
539 CONSP (tem); tem = XCDR (tem))
541 ptrdiff_t elt_len;
542 char *p1;
544 elt = XCAR (tem);
545 if (!STRINGP (elt))
546 continue;
547 /* Need to encode ELT, since scmp compares unibyte
548 strings only. */
549 elt = ENCODE_FILE (elt);
550 elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
551 if (elt_len <= 0)
552 continue;
553 p1 = SSDATA (elt);
554 if (p1[elt_len] != '/')
555 continue;
556 skip = len - elt_len;
557 if (skip < 0)
558 continue;
560 if (scmp (dp->d_name + skip, p1, elt_len) >= 0)
561 continue;
562 break;
565 else
567 /* Compare extensions-to-be-ignored against end of this file name */
568 /* if name is not an exact match against specified string */
569 if (len > SCHARS (encoded_file))
570 /* and exit this for loop if a match is found */
571 for (tem = Vcompletion_ignored_extensions;
572 CONSP (tem); tem = XCDR (tem))
574 elt = XCAR (tem);
575 if (!STRINGP (elt)) continue;
576 /* Need to encode ELT, since scmp compares unibyte
577 strings only. */
578 elt = ENCODE_FILE (elt);
579 skip = len - SCHARS (elt);
580 if (skip < 0) continue;
582 if (scmp (dp->d_name + skip, SSDATA (elt), SCHARS (elt))
583 >= 0)
584 continue;
585 break;
589 /* If an ignored-extensions match was found,
590 don't process this name as a completion. */
591 if (CONSP (tem))
592 canexclude = 1;
594 if (!includeall && canexclude)
595 /* We're not including all files and this file can be excluded. */
596 continue;
598 if (includeall && !canexclude)
599 { /* If we have one non-excludable file, we want to exclude the
600 excludable files. */
601 includeall = 0;
602 /* Throw away any previous excludable match found. */
603 bestmatch = Qnil;
604 bestmatchsize = 0;
605 matchcount = 0;
608 /* FIXME: If we move this `decode' earlier we can eliminate
609 the repeated ENCODE_FILE on Vcompletion_ignored_extensions. */
610 name = make_unibyte_string (dp->d_name, len);
611 name = DECODE_FILE (name);
614 Lisp_Object regexps, table = (completion_ignore_case
615 ? Vascii_canon_table : Qnil);
617 /* Ignore this element if it fails to match all the regexps. */
618 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
619 regexps = XCDR (regexps))
620 if (fast_string_match_internal (XCAR (regexps), name, table) < 0)
621 break;
623 if (CONSP (regexps))
624 continue;
627 /* This is a possible completion */
628 if (directoryp)
629 /* This completion is a directory; make it end with '/'. */
630 name = Ffile_name_as_directory (name);
632 /* Test the predicate, if any. */
633 if (!NILP (predicate) && NILP (call1 (predicate, name)))
634 continue;
636 /* Suitably record this match. */
638 matchcount += matchcount <= 1;
640 if (all_flag)
641 bestmatch = Fcons (name, bestmatch);
642 else if (NILP (bestmatch))
644 bestmatch = name;
645 bestmatchsize = SCHARS (name);
647 else
649 Lisp_Object zero = make_number (0);
650 /* FIXME: This is a copy of the code in Ftry_completion. */
651 ptrdiff_t compare = min (bestmatchsize, SCHARS (name));
652 Lisp_Object cmp
653 = Fcompare_strings (bestmatch, zero,
654 make_number (compare),
655 name, zero,
656 make_number (compare),
657 completion_ignore_case ? Qt : Qnil);
658 ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XINT (cmp)) - 1;
660 if (completion_ignore_case)
662 /* If this is an exact match except for case,
663 use it as the best match rather than one that is not
664 an exact match. This way, we get the case pattern
665 of the actual match. */
666 /* This tests that the current file is an exact match
667 but BESTMATCH is not (it is too long). */
668 if ((matchsize == SCHARS (name)
669 && matchsize + directoryp < SCHARS (bestmatch))
671 /* If there is no exact match ignoring case,
672 prefer a match that does not change the case
673 of the input. */
674 /* If there is more than one exact match aside from
675 case, and one of them is exact including case,
676 prefer that one. */
677 /* This == checks that, of current file and BESTMATCH,
678 either both or neither are exact. */
679 (((matchsize == SCHARS (name))
681 (matchsize + directoryp == SCHARS (bestmatch)))
682 && (cmp = Fcompare_strings (name, zero,
683 make_number (SCHARS (file)),
684 file, zero,
685 Qnil,
686 Qnil),
687 EQ (Qt, cmp))
688 && (cmp = Fcompare_strings (bestmatch, zero,
689 make_number (SCHARS (file)),
690 file, zero,
691 Qnil,
692 Qnil),
693 ! EQ (Qt, cmp))))
694 bestmatch = name;
696 bestmatchsize = matchsize;
698 /* If the best completion so far is reduced to the string
699 we're trying to complete, then we already know there's no
700 other completion, so there's no point looking any further. */
701 if (matchsize <= SCHARS (file)
702 && !includeall /* A future match may allow includeall to 0. */
703 /* If completion-ignore-case is non-nil, don't
704 short-circuit because we want to find the best
705 possible match *including* case differences. */
706 && (!completion_ignore_case || matchsize == 0)
707 /* The return value depends on whether it's the sole match. */
708 && matchcount > 1)
709 break;
714 /* This closes the directory. */
715 bestmatch = unbind_to (count, bestmatch);
717 if (all_flag || NILP (bestmatch))
718 return bestmatch;
719 /* Return t if the supplied string is an exact match (counting case);
720 it does not require any change to be made. */
721 if (matchcount == 1 && !NILP (Fequal (bestmatch, file)))
722 return Qt;
723 bestmatch = Fsubstring (bestmatch, make_number (0),
724 make_number (bestmatchsize));
725 return bestmatch;
728 /* Compare exactly LEN chars of strings at S1 and S2,
729 ignoring case if appropriate.
730 Return -1 if strings match,
731 else number of chars that match at the beginning. */
733 static ptrdiff_t
734 scmp (const char *s1, const char *s2, ptrdiff_t len)
736 register ptrdiff_t l = len;
738 if (completion_ignore_case)
740 while (l
741 && (downcase ((unsigned char) *s1++)
742 == downcase ((unsigned char) *s2++)))
743 l--;
745 else
747 while (l && *s1++ == *s2++)
748 l--;
750 if (l == 0)
751 return -1;
752 else
753 return len - l;
756 static int
757 file_name_completion_stat (int fd, struct dirent *dp, struct stat *st_addr)
759 int value;
761 #ifdef MSDOS
762 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
763 but aren't required here. Avoid computing the following fields:
764 st_inode, st_size and st_nlink for directories, and the execute bits
765 in st_mode for non-directory files with non-standard extensions. */
767 unsigned short save_djstat_flags = _djstat_flags;
769 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
770 #endif /* MSDOS */
772 /* We want to return success if a link points to a nonexistent file,
773 but we want to return the status for what the link points to,
774 in case it is a directory. */
775 value = fstatat (fd, dp->d_name, st_addr, AT_SYMLINK_NOFOLLOW);
776 if (value == 0 && S_ISLNK (st_addr->st_mode))
777 fstatat (fd, dp->d_name, st_addr, 0);
778 #ifdef MSDOS
779 _djstat_flags = save_djstat_flags;
780 #endif /* MSDOS */
781 return value;
784 static char *
785 stat_uname (struct stat *st)
787 #ifdef WINDOWSNT
788 return st->st_uname;
789 #else
790 struct passwd *pw = getpwuid (st->st_uid);
792 if (pw)
793 return pw->pw_name;
794 else
795 return NULL;
796 #endif
799 static char *
800 stat_gname (struct stat *st)
802 #ifdef WINDOWSNT
803 return st->st_gname;
804 #else
805 struct group *gr = getgrgid (st->st_gid);
807 if (gr)
808 return gr->gr_name;
809 else
810 return NULL;
811 #endif
814 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
815 doc: /* Return a list of attributes of file FILENAME.
816 Value is nil if specified file cannot be opened.
818 ID-FORMAT specifies the preferred format of attributes uid and gid (see
819 below) - valid values are `string' and `integer'. The latter is the
820 default, but we plan to change that, so you should specify a non-nil value
821 for ID-FORMAT if you use the returned uid or gid.
823 Elements of the attribute list are:
824 0. t for directory, string (name linked to) for symbolic link, or nil.
825 1. Number of links to file.
826 2. File uid as a string or a number. If a string value cannot be
827 looked up, a numeric value, either an integer or a float, is returned.
828 3. File gid, likewise.
829 4. Last access time, as a list of integers (HIGH LOW USEC PSEC) in the
830 same style as (current-time).
831 (See a note below about access time on FAT-based filesystems.)
832 5. Last modification time, likewise. This is the time of the last
833 change to the file's contents.
834 6. Last status change time, likewise. This is the time of last change
835 to the file's attributes: owner and group, access mode bits, etc.
836 7. Size in bytes.
837 This is a floating point number if the size is too large for an integer.
838 8. File modes, as a string of ten letters or dashes as in ls -l.
839 9. An unspecified value, present only for backward compatibility.
840 10. inode number. If it is larger than what an Emacs integer can hold,
841 this is of the form (HIGH . LOW): first the high bits, then the low 16 bits.
842 If even HIGH is too large for an Emacs integer, this is instead of the form
843 (HIGH MIDDLE . LOW): first the high bits, then the middle 24 bits,
844 and finally the low 16 bits.
845 11. Filesystem device number. If it is larger than what the Emacs
846 integer can hold, this is a cons cell, similar to the inode number.
848 On most filesystems, the combination of the inode and the device
849 number uniquely identifies the file.
851 On MS-Windows, performance depends on `w32-get-true-file-attributes',
852 which see.
854 On some FAT-based filesystems, only the date of last access is recorded,
855 so last access time will always be midnight of that day. */)
856 (Lisp_Object filename, Lisp_Object id_format)
858 Lisp_Object encoded;
859 Lisp_Object handler;
861 filename = internal_condition_case_2 (Fexpand_file_name, filename, Qnil,
862 Qt, Fidentity);
863 if (!STRINGP (filename))
864 return Qnil;
866 /* If the file name has special constructs in it,
867 call the corresponding file handler. */
868 handler = Ffind_file_name_handler (filename, Qfile_attributes);
869 if (!NILP (handler))
870 { /* Only pass the extra arg if it is used to help backward compatibility
871 with old file handlers which do not implement the new arg. --Stef */
872 if (NILP (id_format))
873 return call2 (handler, Qfile_attributes, filename);
874 else
875 return call3 (handler, Qfile_attributes, filename, id_format);
878 encoded = ENCODE_FILE (filename);
879 return file_attributes (AT_FDCWD, SSDATA (encoded), id_format);
882 static Lisp_Object
883 file_attributes (int fd, char const *name, Lisp_Object id_format)
885 struct stat s;
886 int lstat_result;
888 /* An array to hold the mode string generated by filemodestring,
889 including its terminating space and null byte. */
890 char modes[sizeof "-rwxr-xr-x "];
892 char *uname = NULL, *gname = NULL;
894 #ifdef WINDOWSNT
895 /* We usually don't request accurate owner and group info, because
896 it can be very expensive on Windows to get that, and most callers
897 of 'lstat' don't need that. But here we do want that information
898 to be accurate. */
899 w32_stat_get_owner_group = 1;
900 #endif
902 lstat_result = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW);
904 #ifdef WINDOWSNT
905 w32_stat_get_owner_group = 0;
906 #endif
908 if (lstat_result < 0)
909 return Qnil;
911 if (!(NILP (id_format) || EQ (id_format, Qinteger)))
913 block_input ();
914 uname = stat_uname (&s);
915 gname = stat_gname (&s);
916 unblock_input ();
919 filemodestring (&s, modes);
921 return CALLN (Flist,
922 (S_ISLNK (s.st_mode) ? emacs_readlinkat (fd, name)
923 : S_ISDIR (s.st_mode) ? Qt : Qnil),
924 make_number (s.st_nlink),
925 (uname
926 ? DECODE_SYSTEM (build_unibyte_string (uname))
927 : make_fixnum_or_float (s.st_uid)),
928 (gname
929 ? DECODE_SYSTEM (build_unibyte_string (gname))
930 : make_fixnum_or_float (s.st_gid)),
931 make_lisp_time (get_stat_atime (&s)),
932 make_lisp_time (get_stat_mtime (&s)),
933 make_lisp_time (get_stat_ctime (&s)),
935 /* If the file size is a 4-byte type, assume that
936 files of sizes in the 2-4 GiB range wrap around to
937 negative values, as this is a common bug on older
938 32-bit platforms. */
939 make_fixnum_or_float (sizeof (s.st_size) == 4
940 ? s.st_size & 0xffffffffu
941 : s.st_size),
943 make_string (modes, 10),
945 INTEGER_TO_CONS (s.st_ino),
946 INTEGER_TO_CONS (s.st_dev));
949 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
950 doc: /* Return t if first arg file attributes list is less than second.
951 Comparison is in lexicographic order and case is significant. */)
952 (Lisp_Object f1, Lisp_Object f2)
954 return Fstring_lessp (Fcar (f1), Fcar (f2));
958 DEFUN ("system-users", Fsystem_users, Ssystem_users, 0, 0, 0,
959 doc: /* Return a list of user names currently registered in the system.
960 If we don't know how to determine that on this platform, just
961 return a list with one element, taken from `user-real-login-name'. */)
962 (void)
964 Lisp_Object users = Qnil;
965 #if defined HAVE_GETPWENT && defined HAVE_ENDPWENT
966 struct passwd *pw;
968 while ((pw = getpwent ()))
969 users = Fcons (DECODE_SYSTEM (build_string (pw->pw_name)), users);
971 endpwent ();
972 #endif
973 if (EQ (users, Qnil))
974 /* At least current user is always known. */
975 users = list1 (Vuser_real_login_name);
976 return users;
979 DEFUN ("system-groups", Fsystem_groups, Ssystem_groups, 0, 0, 0,
980 doc: /* Return a list of user group names currently registered in the system.
981 The value may be nil if not supported on this platform. */)
982 (void)
984 Lisp_Object groups = Qnil;
985 #if defined HAVE_GETGRENT && defined HAVE_ENDGRENT
986 struct group *gr;
988 while ((gr = getgrent ()))
989 groups = Fcons (DECODE_SYSTEM (build_string (gr->gr_name)), groups);
991 endgrent ();
992 #endif
993 return groups;
996 void
997 syms_of_dired (void)
999 DEFSYM (Qdirectory_files, "directory-files");
1000 DEFSYM (Qdirectory_files_and_attributes, "directory-files-and-attributes");
1001 DEFSYM (Qfile_name_completion, "file-name-completion");
1002 DEFSYM (Qfile_name_all_completions, "file-name-all-completions");
1003 DEFSYM (Qfile_attributes, "file-attributes");
1004 DEFSYM (Qfile_attributes_lessp, "file-attributes-lessp");
1005 DEFSYM (Qdefault_directory, "default-directory");
1007 defsubr (&Sdirectory_files);
1008 defsubr (&Sdirectory_files_and_attributes);
1009 defsubr (&Sfile_name_completion);
1010 defsubr (&Sfile_name_all_completions);
1011 defsubr (&Sfile_attributes);
1012 defsubr (&Sfile_attributes_lessp);
1013 defsubr (&Ssystem_users);
1014 defsubr (&Ssystem_groups);
1016 DEFVAR_LISP ("completion-ignored-extensions", Vcompletion_ignored_extensions,
1017 doc: /* Completion ignores file names ending in any string in this list.
1018 It does not ignore them if all possible completions end in one of
1019 these strings or when displaying a list of completions.
1020 It ignores directory names if they match any string in this list which
1021 ends in a slash. */);
1022 Vcompletion_ignored_extensions = Qnil;