]> code.delx.au - gnu-emacs/blob - src/dired.c
Ibuffer change marks
[gnu-emacs] / src / dired.c
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985-1986, 1993-1994, 1999-2016 Free Software
3 Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or (at
10 your option) any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19
20
21 #include <config.h>
22
23 #include <stdio.h>
24 #include <sys/types.h>
25 #include <sys/stat.h>
26
27 #ifdef HAVE_PWD_H
28 #include <pwd.h>
29 #endif
30 #include <grp.h>
31
32 #include <errno.h>
33 #include <fcntl.h>
34 #include <unistd.h>
35
36 #include <dirent.h>
37 #include <filemode.h>
38 #include <stat-time.h>
39
40 #include "lisp.h"
41 #include "systime.h"
42 #include "buffer.h"
43 #include "coding.h"
44 #include "regex.h"
45
46 #ifdef MSDOS
47 #include "msdos.h" /* for fstatat */
48 #endif
49
50 #ifdef WINDOWSNT
51 extern int is_slow_fs (const char *);
52 #endif
53
54 static ptrdiff_t scmp (const char *, const char *, ptrdiff_t);
55 static Lisp_Object file_attributes (int, char const *, Lisp_Object);
56 \f
57 /* Return the number of bytes in DP's name. */
58 static ptrdiff_t
59 dirent_namelen (struct dirent *dp)
60 {
61 #ifdef _D_EXACT_NAMLEN
62 return _D_EXACT_NAMLEN (dp);
63 #else
64 return strlen (dp->d_name);
65 #endif
66 }
67
68 static DIR *
69 open_directory (Lisp_Object dirname, int *fdp)
70 {
71 char *name = SSDATA (dirname);
72 DIR *d;
73 int fd, opendir_errno;
74
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)
85 {
86 opendir_errno = errno;
87 d = 0;
88 }
89 else
90 {
91 d = fdopendir (fd);
92 opendir_errno = errno;
93 if (! d)
94 emacs_close (fd);
95 }
96 #endif
97
98 if (!d)
99 report_file_errno ("Opening directory", dirname, opendir_errno);
100 *fdp = fd;
101 return d;
102 }
103
104 #ifdef WINDOWSNT
105 static void
106 directory_files_internal_w32_unwind (Lisp_Object arg)
107 {
108 Vw32_get_true_file_attributes = arg;
109 }
110 #endif
111
112 static void
113 directory_files_internal_unwind (void *d)
114 {
115 closedir (d);
116 }
117
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. */
121
122 static struct dirent *
123 read_dirent (DIR *dir, Lisp_Object dirname)
124 {
125 while (true)
126 {
127 errno = 0;
128 struct dirent *dp = readdir (dir);
129 if (dp || errno == 0)
130 return dp;
131 if (! (errno == EAGAIN || errno == EINTR))
132 {
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);
142 }
143 QUIT;
144 }
145 }
146
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. */
151
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)
156 {
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
165
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;
169
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);
174
175 if (!NILP (match))
176 {
177 CHECK_STRING (match);
178
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 */
191 }
192
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);
198
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! */
201
202 int fd;
203 DIR *d = open_directory (dirfilename, &fd);
204
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);
209
210 #ifdef WINDOWSNT
211 if (attrs)
212 {
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))
219 {
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;
226 }
227 }
228 #endif
229
230 directory_nbytes = SBYTES (directory);
231 re_match_object = Qt;
232
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;
237
238 /* Loop reading directory entries. */
239 for (struct dirent *dp; (dp = read_dirent (d, directory)); )
240 {
241 ptrdiff_t len = dirent_namelen (dp);
242 Lisp_Object name = make_unibyte_string (dp->d_name, len);
243 Lisp_Object finalname = name;
244
245 /* Note: DECODE_FILE can GC; it should protect its argument,
246 though. */
247 name = DECODE_FILE (name);
248 len = SBYTES (name);
249
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;
254
255 bool wanted = (NILP (match)
256 || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0);
257
258 immediate_quit = 0;
259
260 if (wanted)
261 {
262 if (!NILP (full))
263 {
264 Lisp_Object fullname;
265 ptrdiff_t nbytes = len + directory_nbytes + needsep;
266 ptrdiff_t nchars;
267
268 fullname = make_uninit_multibyte_string (nbytes, nbytes);
269 memcpy (SDATA (fullname), SDATA (directory),
270 directory_nbytes);
271
272 if (needsep)
273 SSET (fullname, directory_nbytes, DIRECTORY_SEP);
274
275 memcpy (SDATA (fullname) + directory_nbytes + needsep,
276 SDATA (name), len);
277
278 nchars = multibyte_chars_in_text (SDATA (fullname), nbytes);
279
280 /* Some bug somewhere. */
281 if (nchars > nbytes)
282 emacs_abort ();
283
284 STRING_SET_CHARS (fullname, nchars);
285 if (nchars == nbytes)
286 STRING_SET_UNIBYTE (fullname);
287
288 finalname = fullname;
289 }
290 else
291 finalname = name;
292
293 if (attrs)
294 {
295 Lisp_Object fileattrs
296 = file_attributes (fd, dp->d_name, id_format);
297 list = Fcons (Fcons (finalname, fileattrs), list);
298 }
299 else
300 list = Fcons (finalname, list);
301 }
302 }
303
304 closedir (d);
305 #ifdef WINDOWSNT
306 if (attrs)
307 Vw32_get_true_file_attributes = w32_save;
308 #endif
309
310 /* Discard the unwind protect. */
311 specpdl_ptr = specpdl + count;
312
313 if (NILP (nosort))
314 list = Fsort (Fnreverse (list),
315 attrs ? Qfile_attributes_lessp : Qstring_lessp);
316
317 (void) directory_volatile;
318 return list;
319 }
320
321
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)
332 {
333 Lisp_Object handler;
334 directory = Fexpand_file_name (directory, Qnil);
335
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);
342
343 return directory_files_internal (directory, full, match, nosort, 0, Qnil);
344 }
345
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)
360 {
361 Lisp_Object handler;
362 directory = Fexpand_file_name (directory, Qnil);
363
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);
370
371 return directory_files_internal (directory, full, match, nosort, 1, id_format);
372 }
373
374 \f
375 static Lisp_Object file_name_completion (Lisp_Object, Lisp_Object, bool,
376 Lisp_Object);
377
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.
385
386 If PREDICATE is non-nil, call PREDICATE with each possible
387 completion (in absolute form) and ignore it if PREDICATE returns nil.
388
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)
394 {
395 Lisp_Object handler;
396 directory = Fexpand_file_name (directory, Qnil);
397
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);
403
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);
409
410 return file_name_completion (file, directory, 0, predicate);
411 }
412
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.
417
418 This function ignores some of the possible completions as determined
419 by `completion-regexp-list', which see. `completion-regexp-list'
420 is matched against file and directory names relative to DIRECTORY. */)
421 (Lisp_Object file, Lisp_Object directory)
422 {
423 Lisp_Object handler;
424 directory = Fexpand_file_name (directory, Qnil);
425
426 /* If the directory name has special constructs in it,
427 call the corresponding file handler. */
428 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
429 if (!NILP (handler))
430 return call3 (handler, Qfile_name_all_completions, file, directory);
431
432 /* If the file name has special constructs in it,
433 call the corresponding file handler. */
434 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
435 if (!NILP (handler))
436 return call3 (handler, Qfile_name_all_completions, file, directory);
437
438 return file_name_completion (file, directory, 1, Qnil);
439 }
440
441 static int file_name_completion_stat (int, struct dirent *, struct stat *);
442
443 static Lisp_Object
444 file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
445 Lisp_Object predicate)
446 {
447 ptrdiff_t bestmatchsize = 0;
448 int matchcount = 0;
449 /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
450 If ALL_FLAG is 0, BESTMATCH is either nil
451 or the best match so far, not decoded. */
452 Lisp_Object bestmatch, tem, elt, name;
453 Lisp_Object encoded_file;
454 Lisp_Object encoded_dir;
455 struct stat st;
456 bool directoryp;
457 /* If not INCLUDEALL, exclude files in completion-ignored-extensions as
458 well as "." and "..". Until shown otherwise, assume we can't exclude
459 anything. */
460 bool includeall = 1;
461 bool check_decoded = false;
462 ptrdiff_t count = SPECPDL_INDEX ();
463
464 elt = Qnil;
465
466 CHECK_STRING (file);
467
468 bestmatch = Qnil;
469 encoded_file = encoded_dir = Qnil;
470 specbind (Qdefault_directory, dirname);
471
472 /* Do completion on the encoded file name
473 because the other names in the directory are (we presume)
474 encoded likewise. We decode the completed string at the end. */
475 /* Actually, this is not quite true any more: we do most of the completion
476 work with decoded file names, but we still do some filtering based
477 on the encoded file name. */
478 encoded_file = ENCODE_FILE (file);
479 encoded_dir = ENCODE_FILE (Fdirectory_file_name (dirname));
480
481 Lisp_Object file_encoding = Vfile_name_coding_system;
482 if (NILP (Vfile_name_coding_system))
483 file_encoding = Vdefault_file_name_coding_system;
484 /* If the file-name encoding decomposes characters, as we do for
485 HFS+ filesystems, we need to make an additional comparison of
486 decoded names in order to filter false positives, such as "a"
487 falsely matching "a-ring". */
488 if (!NILP (file_encoding)
489 && !NILP (Fplist_get (Fcoding_system_plist (file_encoding),
490 Qdecomposed_characters)))
491 {
492 check_decoded = true;
493 if (STRING_MULTIBYTE (file))
494 {
495 /* Recompute FILE to make sure any decomposed characters in
496 it are re-composed by the post-read-conversion.
497 Otherwise, any decomposed characters will be rejected by
498 the additional check below. */
499 file = DECODE_FILE (encoded_file);
500 }
501 }
502 int fd;
503 DIR *d = open_directory (encoded_dir, &fd);
504 record_unwind_protect_ptr (directory_files_internal_unwind, d);
505
506 /* Loop reading directory entries. */
507 for (struct dirent *dp; (dp = read_dirent (d, dirname)); )
508 {
509 ptrdiff_t len = dirent_namelen (dp);
510 bool canexclude = 0;
511
512 QUIT;
513 if (len < SCHARS (encoded_file)
514 || (scmp (dp->d_name, SSDATA (encoded_file),
515 SCHARS (encoded_file))
516 >= 0))
517 continue;
518
519 if (file_name_completion_stat (fd, dp, &st) < 0)
520 continue;
521
522 directoryp = S_ISDIR (st.st_mode) != 0;
523 tem = Qnil;
524 /* If all_flag is set, always include all.
525 It would not actually be helpful to the user to ignore any possible
526 completions when making a list of them. */
527 if (!all_flag)
528 {
529 ptrdiff_t skip;
530
531 #if 0 /* FIXME: The `scmp' call compares an encoded and a decoded string. */
532 /* If this entry matches the current bestmatch, the only
533 thing it can do is increase matchcount, so don't bother
534 investigating it any further. */
535 if (!completion_ignore_case
536 /* The return result depends on whether it's the sole match. */
537 && matchcount > 1
538 && !includeall /* This match may allow includeall to 0. */
539 && len >= bestmatchsize
540 && 0 > scmp (dp->d_name, SSDATA (bestmatch), bestmatchsize))
541 continue;
542 #endif
543
544 if (directoryp)
545 {
546 #ifndef TRIVIAL_DIRECTORY_ENTRY
547 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
548 #endif
549 /* "." and ".." are never interesting as completions, and are
550 actually in the way in a directory with only one file. */
551 if (TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
552 canexclude = 1;
553 else if (len > SCHARS (encoded_file))
554 /* Ignore directories if they match an element of
555 completion-ignored-extensions which ends in a slash. */
556 for (tem = Vcompletion_ignored_extensions;
557 CONSP (tem); tem = XCDR (tem))
558 {
559 ptrdiff_t elt_len;
560 char *p1;
561
562 elt = XCAR (tem);
563 if (!STRINGP (elt))
564 continue;
565 /* Need to encode ELT, since scmp compares unibyte
566 strings only. */
567 elt = ENCODE_FILE (elt);
568 elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
569 if (elt_len <= 0)
570 continue;
571 p1 = SSDATA (elt);
572 if (p1[elt_len] != '/')
573 continue;
574 skip = len - elt_len;
575 if (skip < 0)
576 continue;
577
578 if (scmp (dp->d_name + skip, p1, elt_len) >= 0)
579 continue;
580 break;
581 }
582 }
583 else
584 {
585 /* Compare extensions-to-be-ignored against end of this file name */
586 /* if name is not an exact match against specified string */
587 if (len > SCHARS (encoded_file))
588 /* and exit this for loop if a match is found */
589 for (tem = Vcompletion_ignored_extensions;
590 CONSP (tem); tem = XCDR (tem))
591 {
592 elt = XCAR (tem);
593 if (!STRINGP (elt)) continue;
594 /* Need to encode ELT, since scmp compares unibyte
595 strings only. */
596 elt = ENCODE_FILE (elt);
597 skip = len - SCHARS (elt);
598 if (skip < 0) continue;
599
600 if (scmp (dp->d_name + skip, SSDATA (elt), SCHARS (elt))
601 >= 0)
602 continue;
603 break;
604 }
605 }
606
607 /* If an ignored-extensions match was found,
608 don't process this name as a completion. */
609 if (CONSP (tem))
610 canexclude = 1;
611
612 if (!includeall && canexclude)
613 /* We're not including all files and this file can be excluded. */
614 continue;
615
616 if (includeall && !canexclude)
617 { /* If we have one non-excludable file, we want to exclude the
618 excludable files. */
619 includeall = 0;
620 /* Throw away any previous excludable match found. */
621 bestmatch = Qnil;
622 bestmatchsize = 0;
623 matchcount = 0;
624 }
625 }
626 /* FIXME: If we move this `decode' earlier we can eliminate
627 the repeated ENCODE_FILE on Vcompletion_ignored_extensions. */
628 name = make_unibyte_string (dp->d_name, len);
629 name = DECODE_FILE (name);
630
631 {
632 Lisp_Object regexps, table = (completion_ignore_case
633 ? Vascii_canon_table : Qnil);
634
635 /* Ignore this element if it fails to match all the regexps. */
636 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
637 regexps = XCDR (regexps))
638 if (fast_string_match_internal (XCAR (regexps), name, table) < 0)
639 break;
640
641 if (CONSP (regexps))
642 continue;
643 }
644
645 /* This is a possible completion */
646 if (directoryp)
647 /* This completion is a directory; make it end with '/'. */
648 name = Ffile_name_as_directory (name);
649
650 /* Test the predicate, if any. */
651 if (!NILP (predicate) && NILP (call1 (predicate, name)))
652 continue;
653
654 /* Reject entries where the encoded strings match, but the
655 decoded don't. For example, "a" should not match "a-ring" on
656 file systems that store decomposed characters. */
657 Lisp_Object zero = make_number (0);
658
659 if (check_decoded && SCHARS (file) <= SCHARS (name))
660 {
661 /* FIXME: This is a copy of the code below. */
662 ptrdiff_t compare = SCHARS (file);
663 Lisp_Object cmp
664 = Fcompare_strings (name, zero, make_number (compare),
665 file, zero, make_number (compare),
666 completion_ignore_case ? Qt : Qnil);
667 if (!EQ (cmp, Qt))
668 continue;
669 }
670
671 /* Suitably record this match. */
672
673 matchcount += matchcount <= 1;
674
675 if (all_flag)
676 bestmatch = Fcons (name, bestmatch);
677 else if (NILP (bestmatch))
678 {
679 bestmatch = name;
680 bestmatchsize = SCHARS (name);
681 }
682 else
683 {
684 /* FIXME: This is a copy of the code in Ftry_completion. */
685 ptrdiff_t compare = min (bestmatchsize, SCHARS (name));
686 Lisp_Object cmp
687 = Fcompare_strings (bestmatch, zero, make_number (compare),
688 name, zero, make_number (compare),
689 completion_ignore_case ? Qt : Qnil);
690 ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XINT (cmp)) - 1;
691
692 if (completion_ignore_case)
693 {
694 /* If this is an exact match except for case,
695 use it as the best match rather than one that is not
696 an exact match. This way, we get the case pattern
697 of the actual match. */
698 /* This tests that the current file is an exact match
699 but BESTMATCH is not (it is too long). */
700 if ((matchsize == SCHARS (name)
701 && matchsize + directoryp < SCHARS (bestmatch))
702 ||
703 /* If there is no exact match ignoring case,
704 prefer a match that does not change the case
705 of the input. */
706 /* If there is more than one exact match aside from
707 case, and one of them is exact including case,
708 prefer that one. */
709 /* This == checks that, of current file and BESTMATCH,
710 either both or neither are exact. */
711 (((matchsize == SCHARS (name))
712 ==
713 (matchsize + directoryp == SCHARS (bestmatch)))
714 && (cmp = Fcompare_strings (name, zero,
715 make_number (SCHARS (file)),
716 file, zero,
717 Qnil,
718 Qnil),
719 EQ (Qt, cmp))
720 && (cmp = Fcompare_strings (bestmatch, zero,
721 make_number (SCHARS (file)),
722 file, zero,
723 Qnil,
724 Qnil),
725 ! EQ (Qt, cmp))))
726 bestmatch = name;
727 }
728 bestmatchsize = matchsize;
729
730 /* If the best completion so far is reduced to the string
731 we're trying to complete, then we already know there's no
732 other completion, so there's no point looking any further. */
733 if (matchsize <= SCHARS (file)
734 && !includeall /* A future match may allow includeall to 0. */
735 /* If completion-ignore-case is non-nil, don't
736 short-circuit because we want to find the best
737 possible match *including* case differences. */
738 && (!completion_ignore_case || matchsize == 0)
739 /* The return value depends on whether it's the sole match. */
740 && matchcount > 1)
741 break;
742
743 }
744 }
745
746 /* This closes the directory. */
747 bestmatch = unbind_to (count, bestmatch);
748
749 if (all_flag || NILP (bestmatch))
750 return bestmatch;
751 /* Return t if the supplied string is an exact match (counting case);
752 it does not require any change to be made. */
753 if (matchcount == 1 && !NILP (Fequal (bestmatch, file)))
754 return Qt;
755 bestmatch = Fsubstring (bestmatch, make_number (0),
756 make_number (bestmatchsize));
757 return bestmatch;
758 }
759
760 /* Compare exactly LEN chars of strings at S1 and S2,
761 ignoring case if appropriate.
762 Return -1 if strings match,
763 else number of chars that match at the beginning. */
764
765 static ptrdiff_t
766 scmp (const char *s1, const char *s2, ptrdiff_t len)
767 {
768 register ptrdiff_t l = len;
769
770 if (completion_ignore_case)
771 {
772 while (l
773 && (downcase ((unsigned char) *s1++)
774 == downcase ((unsigned char) *s2++)))
775 l--;
776 }
777 else
778 {
779 while (l && *s1++ == *s2++)
780 l--;
781 }
782 if (l == 0)
783 return -1;
784 else
785 return len - l;
786 }
787
788 static int
789 file_name_completion_stat (int fd, struct dirent *dp, struct stat *st_addr)
790 {
791 int value;
792
793 #ifdef MSDOS
794 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
795 but aren't required here. Avoid computing the following fields:
796 st_inode, st_size and st_nlink for directories, and the execute bits
797 in st_mode for non-directory files with non-standard extensions. */
798
799 unsigned short save_djstat_flags = _djstat_flags;
800
801 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
802 #endif /* MSDOS */
803
804 /* We want to return success if a link points to a nonexistent file,
805 but we want to return the status for what the link points to,
806 in case it is a directory. */
807 value = fstatat (fd, dp->d_name, st_addr, AT_SYMLINK_NOFOLLOW);
808 if (value == 0 && S_ISLNK (st_addr->st_mode))
809 fstatat (fd, dp->d_name, st_addr, 0);
810 #ifdef MSDOS
811 _djstat_flags = save_djstat_flags;
812 #endif /* MSDOS */
813 return value;
814 }
815 \f
816 static char *
817 stat_uname (struct stat *st)
818 {
819 #ifdef WINDOWSNT
820 return st->st_uname;
821 #else
822 struct passwd *pw = getpwuid (st->st_uid);
823
824 if (pw)
825 return pw->pw_name;
826 else
827 return NULL;
828 #endif
829 }
830
831 static char *
832 stat_gname (struct stat *st)
833 {
834 #ifdef WINDOWSNT
835 return st->st_gname;
836 #else
837 struct group *gr = getgrgid (st->st_gid);
838
839 if (gr)
840 return gr->gr_name;
841 else
842 return NULL;
843 #endif
844 }
845
846 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
847 doc: /* Return a list of attributes of file FILENAME.
848 Value is nil if specified file cannot be opened.
849
850 ID-FORMAT specifies the preferred format of attributes uid and gid (see
851 below) - valid values are `string' and `integer'. The latter is the
852 default, but we plan to change that, so you should specify a non-nil value
853 for ID-FORMAT if you use the returned uid or gid.
854
855 To access the elements returned, the following access functions are
856 provided: `file-attribute-type', `file-attribute-link-number',
857 `file-attribute-user-id', `file-attribute-group-id',
858 `file-attribute-access-time', `file-attribute-modification-time',
859 `file-attribute-status-change-time', `file-attribute-size',
860 `file-attribute-modes', `file-attribute-inode-number', and
861 `file-attribute-device-number'.
862
863 Elements of the attribute list are:
864 0. t for directory, string (name linked to) for symbolic link, or nil.
865 1. Number of links to file.
866 2. File uid as a string or a number. If a string value cannot be
867 looked up, a numeric value, either an integer or a float, is returned.
868 3. File gid, likewise.
869 4. Last access time, as a list of integers (HIGH LOW USEC PSEC) in the
870 same style as (current-time).
871 (See a note below about access time on FAT-based filesystems.)
872 5. Last modification time, likewise. This is the time of the last
873 change to the file's contents.
874 6. Last status change time, likewise. This is the time of last change
875 to the file's attributes: owner and group, access mode bits, etc.
876 7. Size in bytes.
877 This is a floating point number if the size is too large for an integer.
878 8. File modes, as a string of ten letters or dashes as in ls -l.
879 9. An unspecified value, present only for backward compatibility.
880 10. inode number. If it is larger than what an Emacs integer can hold,
881 this is of the form (HIGH . LOW): first the high bits, then the low 16 bits.
882 If even HIGH is too large for an Emacs integer, this is instead of the form
883 (HIGH MIDDLE . LOW): first the high bits, then the middle 24 bits,
884 and finally the low 16 bits.
885 11. Filesystem device number. If it is larger than what the Emacs
886 integer can hold, this is a cons cell, similar to the inode number.
887
888 On most filesystems, the combination of the inode and the device
889 number uniquely identifies the file.
890
891 On MS-Windows, performance depends on `w32-get-true-file-attributes',
892 which see.
893
894 On some FAT-based filesystems, only the date of last access is recorded,
895 so last access time will always be midnight of that day. */)
896 (Lisp_Object filename, Lisp_Object id_format)
897 {
898 Lisp_Object encoded;
899 Lisp_Object handler;
900
901 filename = internal_condition_case_2 (Fexpand_file_name, filename, Qnil,
902 Qt, Fidentity);
903 if (!STRINGP (filename))
904 return Qnil;
905
906 /* If the file name has special constructs in it,
907 call the corresponding file handler. */
908 handler = Ffind_file_name_handler (filename, Qfile_attributes);
909 if (!NILP (handler))
910 { /* Only pass the extra arg if it is used to help backward compatibility
911 with old file handlers which do not implement the new arg. --Stef */
912 if (NILP (id_format))
913 return call2 (handler, Qfile_attributes, filename);
914 else
915 return call3 (handler, Qfile_attributes, filename, id_format);
916 }
917
918 encoded = ENCODE_FILE (filename);
919 return file_attributes (AT_FDCWD, SSDATA (encoded), id_format);
920 }
921
922 static Lisp_Object
923 file_attributes (int fd, char const *name, Lisp_Object id_format)
924 {
925 struct stat s;
926 int lstat_result;
927
928 /* An array to hold the mode string generated by filemodestring,
929 including its terminating space and null byte. */
930 char modes[sizeof "-rwxr-xr-x "];
931
932 char *uname = NULL, *gname = NULL;
933
934 #ifdef WINDOWSNT
935 /* We usually don't request accurate owner and group info, because
936 it can be very expensive on Windows to get that, and most callers
937 of 'lstat' don't need that. But here we do want that information
938 to be accurate. */
939 w32_stat_get_owner_group = 1;
940 #endif
941
942 lstat_result = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW);
943
944 #ifdef WINDOWSNT
945 w32_stat_get_owner_group = 0;
946 #endif
947
948 if (lstat_result < 0)
949 return Qnil;
950
951 if (!(NILP (id_format) || EQ (id_format, Qinteger)))
952 {
953 uname = stat_uname (&s);
954 gname = stat_gname (&s);
955 }
956
957 filemodestring (&s, modes);
958
959 return CALLN (Flist,
960 (S_ISLNK (s.st_mode) ? emacs_readlinkat (fd, name)
961 : S_ISDIR (s.st_mode) ? Qt : Qnil),
962 make_number (s.st_nlink),
963 (uname
964 ? DECODE_SYSTEM (build_unibyte_string (uname))
965 : make_fixnum_or_float (s.st_uid)),
966 (gname
967 ? DECODE_SYSTEM (build_unibyte_string (gname))
968 : make_fixnum_or_float (s.st_gid)),
969 make_lisp_time (get_stat_atime (&s)),
970 make_lisp_time (get_stat_mtime (&s)),
971 make_lisp_time (get_stat_ctime (&s)),
972
973 /* If the file size is a 4-byte type, assume that
974 files of sizes in the 2-4 GiB range wrap around to
975 negative values, as this is a common bug on older
976 32-bit platforms. */
977 make_fixnum_or_float (sizeof (s.st_size) == 4
978 ? s.st_size & 0xffffffffu
979 : s.st_size),
980
981 make_string (modes, 10),
982 Qt,
983 INTEGER_TO_CONS (s.st_ino),
984 INTEGER_TO_CONS (s.st_dev));
985 }
986
987 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
988 doc: /* Return t if first arg file attributes list is less than second.
989 Comparison is in lexicographic order and case is significant. */)
990 (Lisp_Object f1, Lisp_Object f2)
991 {
992 return Fstring_lessp (Fcar (f1), Fcar (f2));
993 }
994 \f
995
996 DEFUN ("system-users", Fsystem_users, Ssystem_users, 0, 0, 0,
997 doc: /* Return a list of user names currently registered in the system.
998 If we don't know how to determine that on this platform, just
999 return a list with one element, taken from `user-real-login-name'. */)
1000 (void)
1001 {
1002 Lisp_Object users = Qnil;
1003 #if defined HAVE_GETPWENT && defined HAVE_ENDPWENT
1004 struct passwd *pw;
1005
1006 while ((pw = getpwent ()))
1007 users = Fcons (DECODE_SYSTEM (build_string (pw->pw_name)), users);
1008
1009 endpwent ();
1010 #endif
1011 if (EQ (users, Qnil))
1012 /* At least current user is always known. */
1013 users = list1 (Vuser_real_login_name);
1014 return users;
1015 }
1016
1017 DEFUN ("system-groups", Fsystem_groups, Ssystem_groups, 0, 0, 0,
1018 doc: /* Return a list of user group names currently registered in the system.
1019 The value may be nil if not supported on this platform. */)
1020 (void)
1021 {
1022 Lisp_Object groups = Qnil;
1023 #if defined HAVE_GETGRENT && defined HAVE_ENDGRENT
1024 struct group *gr;
1025
1026 while ((gr = getgrent ()))
1027 groups = Fcons (DECODE_SYSTEM (build_string (gr->gr_name)), groups);
1028
1029 endgrent ();
1030 #endif
1031 return groups;
1032 }
1033
1034 void
1035 syms_of_dired (void)
1036 {
1037 DEFSYM (Qdirectory_files, "directory-files");
1038 DEFSYM (Qdirectory_files_and_attributes, "directory-files-and-attributes");
1039 DEFSYM (Qfile_name_completion, "file-name-completion");
1040 DEFSYM (Qfile_name_all_completions, "file-name-all-completions");
1041 DEFSYM (Qfile_attributes, "file-attributes");
1042 DEFSYM (Qfile_attributes_lessp, "file-attributes-lessp");
1043 DEFSYM (Qdefault_directory, "default-directory");
1044 DEFSYM (Qdecomposed_characters, "decomposed-characters");
1045
1046 defsubr (&Sdirectory_files);
1047 defsubr (&Sdirectory_files_and_attributes);
1048 defsubr (&Sfile_name_completion);
1049 defsubr (&Sfile_name_all_completions);
1050 defsubr (&Sfile_attributes);
1051 defsubr (&Sfile_attributes_lessp);
1052 defsubr (&Ssystem_users);
1053 defsubr (&Ssystem_groups);
1054
1055 DEFVAR_LISP ("completion-ignored-extensions", Vcompletion_ignored_extensions,
1056 doc: /* Completion ignores file names ending in any string in this list.
1057 It does not ignore them if all possible completions end in one of
1058 these strings or when displaying a list of completions.
1059 It ignores directory names if they match any string in this list which
1060 ends in a slash. */);
1061 Vcompletion_ignored_extensions = Qnil;
1062 }