]> code.delx.au - gnu-emacs/blob - src/dired.c
* test/automated/viper-tests.el (viper-test-undo-kmacro):
[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 #include "blockinput.h"
46
47 #ifdef MSDOS
48 #include "msdos.h" /* for fstatat */
49 #endif
50
51 static ptrdiff_t scmp (const char *, const char *, ptrdiff_t);
52 static Lisp_Object file_attributes (int, char const *, Lisp_Object);
53 \f
54 /* Return the number of bytes in DP's name. */
55 static ptrdiff_t
56 dirent_namelen (struct dirent *dp)
57 {
58 #ifdef _D_EXACT_NAMLEN
59 return _D_EXACT_NAMLEN (dp);
60 #else
61 return strlen (dp->d_name);
62 #endif
63 }
64
65 static DIR *
66 open_directory (Lisp_Object dirname, int *fdp)
67 {
68 char *name = SSDATA (dirname);
69 DIR *d;
70 int fd, opendir_errno;
71
72 block_input ();
73
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)
84 {
85 opendir_errno = errno;
86 d = 0;
87 }
88 else
89 {
90 d = fdopendir (fd);
91 opendir_errno = errno;
92 if (! d)
93 emacs_close (fd);
94 }
95 #endif
96
97 unblock_input ();
98
99 if (!d)
100 report_file_errno ("Opening directory", dirname, opendir_errno);
101 *fdp = fd;
102 return d;
103 }
104
105 #ifdef WINDOWSNT
106 void
107 directory_files_internal_w32_unwind (Lisp_Object arg)
108 {
109 Vw32_get_true_file_attributes = arg;
110 }
111 #endif
112
113 static void
114 directory_files_internal_unwind (void *dh)
115 {
116 DIR *d = dh;
117 block_input ();
118 closedir (d);
119 unblock_input ();
120 }
121
122 /* Return the next directory entry from DIR; DIR's name is DIRNAME.
123 If there are no more directory entries, return a null pointer.
124 Signal any unrecoverable errors. */
125
126 static struct dirent *
127 read_dirent (DIR *dir, Lisp_Object dirname)
128 {
129 while (true)
130 {
131 errno = 0;
132 struct dirent *dp = readdir (dir);
133 if (dp || errno == 0)
134 return dp;
135 if (! (errno == EAGAIN || errno == EINTR))
136 {
137 #ifdef WINDOWSNT
138 /* The MS-Windows implementation of 'opendir' doesn't
139 actually open a directory until the first call to
140 'readdir'. If 'readdir' fails to open the directory, it
141 sets errno to ENOENT or EACCES, see w32.c. */
142 if (errno == ENOENT || errno == EACCES)
143 report_file_error ("Opening directory", dirname);
144 #endif
145 report_file_error ("Reading directory", dirname);
146 }
147 QUIT;
148 }
149 }
150
151 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
152 If not ATTRS, return a list of directory filenames;
153 if ATTRS, return a list of directory filenames and their attributes.
154 In the latter case, ID_FORMAT is passed to Ffile_attributes. */
155
156 Lisp_Object
157 directory_files_internal (Lisp_Object directory, Lisp_Object full,
158 Lisp_Object match, Lisp_Object nosort, bool attrs,
159 Lisp_Object id_format)
160 {
161 ptrdiff_t directory_nbytes;
162 Lisp_Object list, dirfilename, encoded_directory;
163 struct re_pattern_buffer *bufp = NULL;
164 bool needsep = 0;
165 ptrdiff_t count = SPECPDL_INDEX ();
166 #ifdef WINDOWSNT
167 Lisp_Object w32_save = Qnil;
168 #endif
169
170 /* Don't let the compiler optimize away all copies of DIRECTORY,
171 which would break GC; see Bug#16986. */
172 Lisp_Object volatile directory_volatile = directory;
173
174 /* Because of file name handlers, these functions might call
175 Ffuncall, and cause a GC. */
176 list = encoded_directory = dirfilename = Qnil;
177 dirfilename = Fdirectory_file_name (directory);
178
179 if (!NILP (match))
180 {
181 CHECK_STRING (match);
182
183 /* MATCH might be a flawed regular expression. Rather than
184 catching and signaling our own errors, we just call
185 compile_pattern to do the work for us. */
186 /* Pass 1 for the MULTIBYTE arg
187 because we do make multibyte strings if the contents warrant. */
188 # ifdef WINDOWSNT
189 /* Windows users want case-insensitive wildcards. */
190 bufp = compile_pattern (match, 0,
191 BVAR (&buffer_defaults, case_canon_table), 0, 1);
192 # else /* !WINDOWSNT */
193 bufp = compile_pattern (match, 0, Qnil, 0, 1);
194 # endif /* !WINDOWSNT */
195 }
196
197 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
198 run_pre_post_conversion_on_str which calls Lisp directly and
199 indirectly. */
200 dirfilename = ENCODE_FILE (dirfilename);
201 encoded_directory = ENCODE_FILE (directory);
202
203 /* Now *bufp is the compiled form of MATCH; don't call anything
204 which might compile a new regexp until we're done with the loop! */
205
206 int fd;
207 DIR *d = open_directory (dirfilename, &fd);
208
209 /* Unfortunately, we can now invoke expand-file-name and
210 file-attributes on filenames, both of which can throw, so we must
211 do a proper unwind-protect. */
212 record_unwind_protect_ptr (directory_files_internal_unwind, d);
213
214 #ifdef WINDOWSNT
215 if (attrs)
216 {
217 extern int is_slow_fs (const char *);
218
219 /* Do this only once to avoid doing it (in w32.c:stat) for each
220 file in the directory, when we call Ffile_attributes below. */
221 record_unwind_protect (directory_files_internal_w32_unwind,
222 Vw32_get_true_file_attributes);
223 w32_save = Vw32_get_true_file_attributes;
224 if (EQ (Vw32_get_true_file_attributes, Qlocal))
225 {
226 /* w32.c:stat will notice these bindings and avoid calling
227 GetDriveType for each file. */
228 if (is_slow_fs (SDATA (dirfilename)))
229 Vw32_get_true_file_attributes = Qnil;
230 else
231 Vw32_get_true_file_attributes = Qt;
232 }
233 }
234 #endif
235
236 directory_nbytes = SBYTES (directory);
237 re_match_object = Qt;
238
239 /* Decide whether we need to add a directory separator. */
240 if (directory_nbytes == 0
241 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
242 needsep = 1;
243
244 /* Loop reading directory entries. */
245 for (struct dirent *dp; (dp = read_dirent (d, directory)); )
246 {
247 ptrdiff_t len = dirent_namelen (dp);
248 Lisp_Object name = make_unibyte_string (dp->d_name, len);
249 Lisp_Object finalname = name;
250
251 /* Note: DECODE_FILE can GC; it should protect its argument,
252 though. */
253 name = DECODE_FILE (name);
254 len = SBYTES (name);
255
256 /* Now that we have unwind_protect in place, we might as well
257 allow matching to be interrupted. */
258 immediate_quit = 1;
259 QUIT;
260
261 bool wanted = (NILP (match)
262 || re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0);
263
264 immediate_quit = 0;
265
266 if (wanted)
267 {
268 if (!NILP (full))
269 {
270 Lisp_Object fullname;
271 ptrdiff_t nbytes = len + directory_nbytes + needsep;
272 ptrdiff_t nchars;
273
274 fullname = make_uninit_multibyte_string (nbytes, nbytes);
275 memcpy (SDATA (fullname), SDATA (directory),
276 directory_nbytes);
277
278 if (needsep)
279 SSET (fullname, directory_nbytes, DIRECTORY_SEP);
280
281 memcpy (SDATA (fullname) + directory_nbytes + needsep,
282 SDATA (name), len);
283
284 nchars = multibyte_chars_in_text (SDATA (fullname), nbytes);
285
286 /* Some bug somewhere. */
287 if (nchars > nbytes)
288 emacs_abort ();
289
290 STRING_SET_CHARS (fullname, nchars);
291 if (nchars == nbytes)
292 STRING_SET_UNIBYTE (fullname);
293
294 finalname = fullname;
295 }
296 else
297 finalname = name;
298
299 if (attrs)
300 {
301 Lisp_Object fileattrs
302 = file_attributes (fd, dp->d_name, id_format);
303 list = Fcons (Fcons (finalname, fileattrs), list);
304 }
305 else
306 list = Fcons (finalname, list);
307 }
308 }
309
310 block_input ();
311 closedir (d);
312 unblock_input ();
313 #ifdef WINDOWSNT
314 if (attrs)
315 Vw32_get_true_file_attributes = w32_save;
316 #endif
317
318 /* Discard the unwind protect. */
319 specpdl_ptr = specpdl + count;
320
321 if (NILP (nosort))
322 list = Fsort (Fnreverse (list),
323 attrs ? Qfile_attributes_lessp : Qstring_lessp);
324
325 (void) directory_volatile;
326 return list;
327 }
328
329
330 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
331 doc: /* Return a list of names of files in DIRECTORY.
332 There are three optional arguments:
333 If FULL is non-nil, return absolute file names. Otherwise return names
334 that are relative to the specified directory.
335 If MATCH is non-nil, mention only file names that match the regexp MATCH.
336 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
337 Otherwise, the list returned is sorted with `string-lessp'.
338 NOSORT is useful if you plan to sort the result yourself. */)
339 (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort)
340 {
341 Lisp_Object handler;
342 directory = Fexpand_file_name (directory, Qnil);
343
344 /* If the file name has special constructs in it,
345 call the corresponding file handler. */
346 handler = Ffind_file_name_handler (directory, Qdirectory_files);
347 if (!NILP (handler))
348 return call5 (handler, Qdirectory_files, directory,
349 full, match, nosort);
350
351 return directory_files_internal (directory, full, match, nosort, 0, Qnil);
352 }
353
354 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
355 Sdirectory_files_and_attributes, 1, 5, 0,
356 doc: /* Return a list of names of files and their attributes in DIRECTORY.
357 There are four optional arguments:
358 If FULL is non-nil, return absolute file names. Otherwise return names
359 that are relative to the specified directory.
360 If MATCH is non-nil, mention only file names that match the regexp MATCH.
361 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
362 NOSORT is useful if you plan to sort the result yourself.
363 ID-FORMAT specifies the preferred format of attributes uid and gid, see
364 `file-attributes' for further documentation.
365 On MS-Windows, performance depends on `w32-get-true-file-attributes',
366 which see. */)
367 (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, Lisp_Object id_format)
368 {
369 Lisp_Object handler;
370 directory = Fexpand_file_name (directory, Qnil);
371
372 /* If the file name has special constructs in it,
373 call the corresponding file handler. */
374 handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
375 if (!NILP (handler))
376 return call6 (handler, Qdirectory_files_and_attributes,
377 directory, full, match, nosort, id_format);
378
379 return directory_files_internal (directory, full, match, nosort, 1, id_format);
380 }
381
382 \f
383 static Lisp_Object file_name_completion (Lisp_Object, Lisp_Object, bool,
384 Lisp_Object);
385
386 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
387 2, 3, 0,
388 doc: /* Complete file name FILE in directory DIRECTORY.
389 Returns the longest string
390 common to all file names in DIRECTORY that start with FILE.
391 If there is only one and FILE matches it exactly, returns t.
392 Returns nil if DIRECTORY contains no name starting with FILE.
393
394 If PREDICATE is non-nil, call PREDICATE with each possible
395 completion (in absolute form) and ignore it if PREDICATE returns nil.
396
397 This function ignores some of the possible completions as determined
398 by the variables `completion-regexp-list' and
399 `completion-ignored-extensions', which see. `completion-regexp-list'
400 is matched against file and directory names relative to DIRECTORY. */)
401 (Lisp_Object file, Lisp_Object directory, Lisp_Object predicate)
402 {
403 Lisp_Object handler;
404 directory = Fexpand_file_name (directory, Qnil);
405
406 /* If the directory name has special constructs in it,
407 call the corresponding file handler. */
408 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
409 if (!NILP (handler))
410 return call4 (handler, Qfile_name_completion, file, directory, predicate);
411
412 /* If the file name has special constructs in it,
413 call the corresponding file handler. */
414 handler = Ffind_file_name_handler (file, Qfile_name_completion);
415 if (!NILP (handler))
416 return call4 (handler, Qfile_name_completion, file, directory, predicate);
417
418 return file_name_completion (file, directory, 0, predicate);
419 }
420
421 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
422 Sfile_name_all_completions, 2, 2, 0,
423 doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
424 These are all file names in directory DIRECTORY which begin with FILE.
425
426 This function ignores some of the possible completions as determined
427 by `completion-regexp-list', which see. `completion-regexp-list'
428 is matched against file and directory names relative to DIRECTORY. */)
429 (Lisp_Object file, Lisp_Object directory)
430 {
431 Lisp_Object handler;
432 directory = Fexpand_file_name (directory, Qnil);
433
434 /* If the directory name has special constructs in it,
435 call the corresponding file handler. */
436 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
437 if (!NILP (handler))
438 return call3 (handler, Qfile_name_all_completions, file, directory);
439
440 /* If the file name has special constructs in it,
441 call the corresponding file handler. */
442 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
443 if (!NILP (handler))
444 return call3 (handler, Qfile_name_all_completions, file, directory);
445
446 return file_name_completion (file, directory, 1, Qnil);
447 }
448
449 static int file_name_completion_stat (int, struct dirent *, struct stat *);
450
451 static Lisp_Object
452 file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
453 Lisp_Object predicate)
454 {
455 ptrdiff_t bestmatchsize = 0;
456 int matchcount = 0;
457 /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
458 If ALL_FLAG is 0, BESTMATCH is either nil
459 or the best match so far, not decoded. */
460 Lisp_Object bestmatch, tem, elt, name;
461 Lisp_Object encoded_file;
462 Lisp_Object encoded_dir;
463 struct stat st;
464 bool directoryp;
465 /* If not INCLUDEALL, exclude files in completion-ignored-extensions as
466 well as "." and "..". Until shown otherwise, assume we can't exclude
467 anything. */
468 bool includeall = 1;
469 bool check_decoded = false;
470 ptrdiff_t count = SPECPDL_INDEX ();
471
472 elt = Qnil;
473
474 CHECK_STRING (file);
475
476 bestmatch = Qnil;
477 encoded_file = encoded_dir = Qnil;
478 specbind (Qdefault_directory, dirname);
479
480 /* Do completion on the encoded file name
481 because the other names in the directory are (we presume)
482 encoded likewise. We decode the completed string at the end. */
483 /* Actually, this is not quite true any more: we do most of the completion
484 work with decoded file names, but we still do some filtering based
485 on the encoded file name. */
486 encoded_file = ENCODE_FILE (file);
487 encoded_dir = ENCODE_FILE (Fdirectory_file_name (dirname));
488
489 Lisp_Object file_encoding = Vfile_name_coding_system;
490 if (NILP (Vfile_name_coding_system))
491 file_encoding = Vdefault_file_name_coding_system;
492 /* If the file-name encoding decomposes characters, as we do for
493 HFS+ filesystems, we need to make an additional comparison of
494 decoded names in order to filter false positives, such as "a"
495 falsely matching "a-ring". */
496 if (!NILP (file_encoding)
497 && !NILP (Fplist_get (Fcoding_system_plist (file_encoding),
498 Qdecomposed_characters)))
499 {
500 check_decoded = true;
501 if (STRING_MULTIBYTE (file))
502 {
503 /* Recompute FILE to make sure any decomposed characters in
504 it are re-composed by the post-read-conversion.
505 Otherwise, any decomposed characters will be rejected by
506 the additional check below. */
507 file = DECODE_FILE (encoded_file);
508 }
509 }
510 int fd;
511 DIR *d = open_directory (encoded_dir, &fd);
512 record_unwind_protect_ptr (directory_files_internal_unwind, d);
513
514 /* Loop reading directory entries. */
515 for (struct dirent *dp; (dp = read_dirent (d, dirname)); )
516 {
517 ptrdiff_t len = dirent_namelen (dp);
518 bool canexclude = 0;
519
520 QUIT;
521 if (len < SCHARS (encoded_file)
522 || (scmp (dp->d_name, SSDATA (encoded_file),
523 SCHARS (encoded_file))
524 >= 0))
525 continue;
526
527 if (file_name_completion_stat (fd, dp, &st) < 0)
528 continue;
529
530 directoryp = S_ISDIR (st.st_mode) != 0;
531 tem = Qnil;
532 /* If all_flag is set, always include all.
533 It would not actually be helpful to the user to ignore any possible
534 completions when making a list of them. */
535 if (!all_flag)
536 {
537 ptrdiff_t skip;
538
539 #if 0 /* FIXME: The `scmp' call compares an encoded and a decoded string. */
540 /* If this entry matches the current bestmatch, the only
541 thing it can do is increase matchcount, so don't bother
542 investigating it any further. */
543 if (!completion_ignore_case
544 /* The return result depends on whether it's the sole match. */
545 && matchcount > 1
546 && !includeall /* This match may allow includeall to 0. */
547 && len >= bestmatchsize
548 && 0 > scmp (dp->d_name, SSDATA (bestmatch), bestmatchsize))
549 continue;
550 #endif
551
552 if (directoryp)
553 {
554 #ifndef TRIVIAL_DIRECTORY_ENTRY
555 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
556 #endif
557 /* "." and ".." are never interesting as completions, and are
558 actually in the way in a directory with only one file. */
559 if (TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
560 canexclude = 1;
561 else if (len > SCHARS (encoded_file))
562 /* Ignore directories if they match an element of
563 completion-ignored-extensions which ends in a slash. */
564 for (tem = Vcompletion_ignored_extensions;
565 CONSP (tem); tem = XCDR (tem))
566 {
567 ptrdiff_t elt_len;
568 char *p1;
569
570 elt = XCAR (tem);
571 if (!STRINGP (elt))
572 continue;
573 /* Need to encode ELT, since scmp compares unibyte
574 strings only. */
575 elt = ENCODE_FILE (elt);
576 elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
577 if (elt_len <= 0)
578 continue;
579 p1 = SSDATA (elt);
580 if (p1[elt_len] != '/')
581 continue;
582 skip = len - elt_len;
583 if (skip < 0)
584 continue;
585
586 if (scmp (dp->d_name + skip, p1, elt_len) >= 0)
587 continue;
588 break;
589 }
590 }
591 else
592 {
593 /* Compare extensions-to-be-ignored against end of this file name */
594 /* if name is not an exact match against specified string */
595 if (len > SCHARS (encoded_file))
596 /* and exit this for loop if a match is found */
597 for (tem = Vcompletion_ignored_extensions;
598 CONSP (tem); tem = XCDR (tem))
599 {
600 elt = XCAR (tem);
601 if (!STRINGP (elt)) continue;
602 /* Need to encode ELT, since scmp compares unibyte
603 strings only. */
604 elt = ENCODE_FILE (elt);
605 skip = len - SCHARS (elt);
606 if (skip < 0) continue;
607
608 if (scmp (dp->d_name + skip, SSDATA (elt), SCHARS (elt))
609 >= 0)
610 continue;
611 break;
612 }
613 }
614
615 /* If an ignored-extensions match was found,
616 don't process this name as a completion. */
617 if (CONSP (tem))
618 canexclude = 1;
619
620 if (!includeall && canexclude)
621 /* We're not including all files and this file can be excluded. */
622 continue;
623
624 if (includeall && !canexclude)
625 { /* If we have one non-excludable file, we want to exclude the
626 excludable files. */
627 includeall = 0;
628 /* Throw away any previous excludable match found. */
629 bestmatch = Qnil;
630 bestmatchsize = 0;
631 matchcount = 0;
632 }
633 }
634 /* FIXME: If we move this `decode' earlier we can eliminate
635 the repeated ENCODE_FILE on Vcompletion_ignored_extensions. */
636 name = make_unibyte_string (dp->d_name, len);
637 name = DECODE_FILE (name);
638
639 {
640 Lisp_Object regexps, table = (completion_ignore_case
641 ? Vascii_canon_table : Qnil);
642
643 /* Ignore this element if it fails to match all the regexps. */
644 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
645 regexps = XCDR (regexps))
646 if (fast_string_match_internal (XCAR (regexps), name, table) < 0)
647 break;
648
649 if (CONSP (regexps))
650 continue;
651 }
652
653 /* This is a possible completion */
654 if (directoryp)
655 /* This completion is a directory; make it end with '/'. */
656 name = Ffile_name_as_directory (name);
657
658 /* Test the predicate, if any. */
659 if (!NILP (predicate) && NILP (call1 (predicate, name)))
660 continue;
661
662 /* Reject entries where the encoded strings match, but the
663 decoded don't. For example, "a" should not match "a-ring" on
664 file systems that store decomposed characters. */
665 Lisp_Object zero = make_number (0);
666
667 if (check_decoded && SCHARS (file) <= SCHARS (name))
668 {
669 /* FIXME: This is a copy of the code below. */
670 ptrdiff_t compare = SCHARS (file);
671 Lisp_Object cmp
672 = Fcompare_strings (name, zero, make_number (compare),
673 file, zero, make_number (compare),
674 completion_ignore_case ? Qt : Qnil);
675 if (!EQ (cmp, Qt))
676 continue;
677 }
678
679 /* Suitably record this match. */
680
681 matchcount += matchcount <= 1;
682
683 if (all_flag)
684 bestmatch = Fcons (name, bestmatch);
685 else if (NILP (bestmatch))
686 {
687 bestmatch = name;
688 bestmatchsize = SCHARS (name);
689 }
690 else
691 {
692 /* FIXME: This is a copy of the code in Ftry_completion. */
693 ptrdiff_t compare = min (bestmatchsize, SCHARS (name));
694 Lisp_Object cmp
695 = Fcompare_strings (bestmatch, zero, make_number (compare),
696 name, zero, make_number (compare),
697 completion_ignore_case ? Qt : Qnil);
698 ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XINT (cmp)) - 1;
699
700 if (completion_ignore_case)
701 {
702 /* If this is an exact match except for case,
703 use it as the best match rather than one that is not
704 an exact match. This way, we get the case pattern
705 of the actual match. */
706 /* This tests that the current file is an exact match
707 but BESTMATCH is not (it is too long). */
708 if ((matchsize == SCHARS (name)
709 && matchsize + directoryp < SCHARS (bestmatch))
710 ||
711 /* If there is no exact match ignoring case,
712 prefer a match that does not change the case
713 of the input. */
714 /* If there is more than one exact match aside from
715 case, and one of them is exact including case,
716 prefer that one. */
717 /* This == checks that, of current file and BESTMATCH,
718 either both or neither are exact. */
719 (((matchsize == SCHARS (name))
720 ==
721 (matchsize + directoryp == SCHARS (bestmatch)))
722 && (cmp = Fcompare_strings (name, zero,
723 make_number (SCHARS (file)),
724 file, zero,
725 Qnil,
726 Qnil),
727 EQ (Qt, cmp))
728 && (cmp = Fcompare_strings (bestmatch, zero,
729 make_number (SCHARS (file)),
730 file, zero,
731 Qnil,
732 Qnil),
733 ! EQ (Qt, cmp))))
734 bestmatch = name;
735 }
736 bestmatchsize = matchsize;
737
738 /* If the best completion so far is reduced to the string
739 we're trying to complete, then we already know there's no
740 other completion, so there's no point looking any further. */
741 if (matchsize <= SCHARS (file)
742 && !includeall /* A future match may allow includeall to 0. */
743 /* If completion-ignore-case is non-nil, don't
744 short-circuit because we want to find the best
745 possible match *including* case differences. */
746 && (!completion_ignore_case || matchsize == 0)
747 /* The return value depends on whether it's the sole match. */
748 && matchcount > 1)
749 break;
750
751 }
752 }
753
754 /* This closes the directory. */
755 bestmatch = unbind_to (count, bestmatch);
756
757 if (all_flag || NILP (bestmatch))
758 return bestmatch;
759 /* Return t if the supplied string is an exact match (counting case);
760 it does not require any change to be made. */
761 if (matchcount == 1 && !NILP (Fequal (bestmatch, file)))
762 return Qt;
763 bestmatch = Fsubstring (bestmatch, make_number (0),
764 make_number (bestmatchsize));
765 return bestmatch;
766 }
767
768 /* Compare exactly LEN chars of strings at S1 and S2,
769 ignoring case if appropriate.
770 Return -1 if strings match,
771 else number of chars that match at the beginning. */
772
773 static ptrdiff_t
774 scmp (const char *s1, const char *s2, ptrdiff_t len)
775 {
776 register ptrdiff_t l = len;
777
778 if (completion_ignore_case)
779 {
780 while (l
781 && (downcase ((unsigned char) *s1++)
782 == downcase ((unsigned char) *s2++)))
783 l--;
784 }
785 else
786 {
787 while (l && *s1++ == *s2++)
788 l--;
789 }
790 if (l == 0)
791 return -1;
792 else
793 return len - l;
794 }
795
796 static int
797 file_name_completion_stat (int fd, struct dirent *dp, struct stat *st_addr)
798 {
799 int value;
800
801 #ifdef MSDOS
802 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
803 but aren't required here. Avoid computing the following fields:
804 st_inode, st_size and st_nlink for directories, and the execute bits
805 in st_mode for non-directory files with non-standard extensions. */
806
807 unsigned short save_djstat_flags = _djstat_flags;
808
809 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
810 #endif /* MSDOS */
811
812 /* We want to return success if a link points to a nonexistent file,
813 but we want to return the status for what the link points to,
814 in case it is a directory. */
815 value = fstatat (fd, dp->d_name, st_addr, AT_SYMLINK_NOFOLLOW);
816 if (value == 0 && S_ISLNK (st_addr->st_mode))
817 fstatat (fd, dp->d_name, st_addr, 0);
818 #ifdef MSDOS
819 _djstat_flags = save_djstat_flags;
820 #endif /* MSDOS */
821 return value;
822 }
823 \f
824 static char *
825 stat_uname (struct stat *st)
826 {
827 #ifdef WINDOWSNT
828 return st->st_uname;
829 #else
830 struct passwd *pw = getpwuid (st->st_uid);
831
832 if (pw)
833 return pw->pw_name;
834 else
835 return NULL;
836 #endif
837 }
838
839 static char *
840 stat_gname (struct stat *st)
841 {
842 #ifdef WINDOWSNT
843 return st->st_gname;
844 #else
845 struct group *gr = getgrgid (st->st_gid);
846
847 if (gr)
848 return gr->gr_name;
849 else
850 return NULL;
851 #endif
852 }
853
854 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
855 doc: /* Return a list of attributes of file FILENAME.
856 Value is nil if specified file cannot be opened.
857
858 ID-FORMAT specifies the preferred format of attributes uid and gid (see
859 below) - valid values are `string' and `integer'. The latter is the
860 default, but we plan to change that, so you should specify a non-nil value
861 for ID-FORMAT if you use the returned uid or gid.
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 block_input ();
954 uname = stat_uname (&s);
955 gname = stat_gname (&s);
956 unblock_input ();
957 }
958
959 filemodestring (&s, modes);
960
961 return CALLN (Flist,
962 (S_ISLNK (s.st_mode) ? emacs_readlinkat (fd, name)
963 : S_ISDIR (s.st_mode) ? Qt : Qnil),
964 make_number (s.st_nlink),
965 (uname
966 ? DECODE_SYSTEM (build_unibyte_string (uname))
967 : make_fixnum_or_float (s.st_uid)),
968 (gname
969 ? DECODE_SYSTEM (build_unibyte_string (gname))
970 : make_fixnum_or_float (s.st_gid)),
971 make_lisp_time (get_stat_atime (&s)),
972 make_lisp_time (get_stat_mtime (&s)),
973 make_lisp_time (get_stat_ctime (&s)),
974
975 /* If the file size is a 4-byte type, assume that
976 files of sizes in the 2-4 GiB range wrap around to
977 negative values, as this is a common bug on older
978 32-bit platforms. */
979 make_fixnum_or_float (sizeof (s.st_size) == 4
980 ? s.st_size & 0xffffffffu
981 : s.st_size),
982
983 make_string (modes, 10),
984 Qt,
985 INTEGER_TO_CONS (s.st_ino),
986 INTEGER_TO_CONS (s.st_dev));
987 }
988
989 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
990 doc: /* Return t if first arg file attributes list is less than second.
991 Comparison is in lexicographic order and case is significant. */)
992 (Lisp_Object f1, Lisp_Object f2)
993 {
994 return Fstring_lessp (Fcar (f1), Fcar (f2));
995 }
996 \f
997
998 DEFUN ("system-users", Fsystem_users, Ssystem_users, 0, 0, 0,
999 doc: /* Return a list of user names currently registered in the system.
1000 If we don't know how to determine that on this platform, just
1001 return a list with one element, taken from `user-real-login-name'. */)
1002 (void)
1003 {
1004 Lisp_Object users = Qnil;
1005 #if defined HAVE_GETPWENT && defined HAVE_ENDPWENT
1006 struct passwd *pw;
1007
1008 while ((pw = getpwent ()))
1009 users = Fcons (DECODE_SYSTEM (build_string (pw->pw_name)), users);
1010
1011 endpwent ();
1012 #endif
1013 if (EQ (users, Qnil))
1014 /* At least current user is always known. */
1015 users = list1 (Vuser_real_login_name);
1016 return users;
1017 }
1018
1019 DEFUN ("system-groups", Fsystem_groups, Ssystem_groups, 0, 0, 0,
1020 doc: /* Return a list of user group names currently registered in the system.
1021 The value may be nil if not supported on this platform. */)
1022 (void)
1023 {
1024 Lisp_Object groups = Qnil;
1025 #if defined HAVE_GETGRENT && defined HAVE_ENDGRENT
1026 struct group *gr;
1027
1028 while ((gr = getgrent ()))
1029 groups = Fcons (DECODE_SYSTEM (build_string (gr->gr_name)), groups);
1030
1031 endgrent ();
1032 #endif
1033 return groups;
1034 }
1035
1036 void
1037 syms_of_dired (void)
1038 {
1039 DEFSYM (Qdirectory_files, "directory-files");
1040 DEFSYM (Qdirectory_files_and_attributes, "directory-files-and-attributes");
1041 DEFSYM (Qfile_name_completion, "file-name-completion");
1042 DEFSYM (Qfile_name_all_completions, "file-name-all-completions");
1043 DEFSYM (Qfile_attributes, "file-attributes");
1044 DEFSYM (Qfile_attributes_lessp, "file-attributes-lessp");
1045 DEFSYM (Qdefault_directory, "default-directory");
1046 DEFSYM (Qdecomposed_characters, "decomposed-characters");
1047
1048 defsubr (&Sdirectory_files);
1049 defsubr (&Sdirectory_files_and_attributes);
1050 defsubr (&Sfile_name_completion);
1051 defsubr (&Sfile_name_all_completions);
1052 defsubr (&Sfile_attributes);
1053 defsubr (&Sfile_attributes_lessp);
1054 defsubr (&Ssystem_users);
1055 defsubr (&Ssystem_groups);
1056
1057 DEFVAR_LISP ("completion-ignored-extensions", Vcompletion_ignored_extensions,
1058 doc: /* Completion ignores file names ending in any string in this list.
1059 It does not ignore them if all possible completions end in one of
1060 these strings or when displaying a list of completions.
1061 It ignores directory names if they match any string in this list which
1062 ends in a slash. */);
1063 Vcompletion_ignored_extensions = Qnil;
1064 }