]> code.delx.au - gnu-emacs/blob - src/dired.c
Update copyright year to 2016
[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
10 (at 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 the variables `completion-regexp-list' and
428 `completion-ignored-extensions', which see. `completion-regexp-list'
429 is matched against file and directory names relative to DIRECTORY. */)
430 (Lisp_Object file, Lisp_Object directory)
431 {
432 Lisp_Object handler;
433 directory = Fexpand_file_name (directory, Qnil);
434
435 /* If the directory name has special constructs in it,
436 call the corresponding file handler. */
437 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
438 if (!NILP (handler))
439 return call3 (handler, Qfile_name_all_completions, file, directory);
440
441 /* If the file name has special constructs in it,
442 call the corresponding file handler. */
443 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
444 if (!NILP (handler))
445 return call3 (handler, Qfile_name_all_completions, file, directory);
446
447 return file_name_completion (file, directory, 1, Qnil);
448 }
449
450 static int file_name_completion_stat (int, struct dirent *, struct stat *);
451
452 static Lisp_Object
453 file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
454 Lisp_Object predicate)
455 {
456 ptrdiff_t bestmatchsize = 0;
457 int matchcount = 0;
458 /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
459 If ALL_FLAG is 0, BESTMATCH is either nil
460 or the best match so far, not decoded. */
461 Lisp_Object bestmatch, tem, elt, name;
462 Lisp_Object encoded_file;
463 Lisp_Object encoded_dir;
464 struct stat st;
465 bool directoryp;
466 /* If not INCLUDEALL, exclude files in completion-ignored-extensions as
467 well as "." and "..". Until shown otherwise, assume we can't exclude
468 anything. */
469 bool includeall = 1;
470 bool check_decoded = false;
471 ptrdiff_t count = SPECPDL_INDEX ();
472
473 elt = Qnil;
474
475 CHECK_STRING (file);
476
477 bestmatch = Qnil;
478 encoded_file = encoded_dir = Qnil;
479 specbind (Qdefault_directory, dirname);
480
481 /* Do completion on the encoded file name
482 because the other names in the directory are (we presume)
483 encoded likewise. We decode the completed string at the end. */
484 /* Actually, this is not quite true any more: we do most of the completion
485 work with decoded file names, but we still do some filtering based
486 on the encoded file name. */
487 encoded_file = ENCODE_FILE (file);
488 encoded_dir = ENCODE_FILE (Fdirectory_file_name (dirname));
489
490 Lisp_Object file_encoding = Vfile_name_coding_system;
491 if (NILP (Vfile_name_coding_system))
492 file_encoding = Vdefault_file_name_coding_system;
493 /* If the file-name encoding decomposes characters, as we do for
494 HFS+ filesystems, we need to make an additional comparison of
495 decoded names in order to filter false positives, such as "a"
496 falsely matching "a-ring". */
497 if (!NILP (file_encoding)
498 && !NILP (Fplist_get (Fcoding_system_plist (file_encoding),
499 Qdecomposed_characters)))
500 {
501 check_decoded = true;
502 if (STRING_MULTIBYTE (file))
503 {
504 /* Recompute FILE to make sure any decomposed characters in
505 it are re-composed by the post-read-conversion.
506 Otherwise, any decomposed characters will be rejected by
507 the additional check below. */
508 file = DECODE_FILE (encoded_file);
509 }
510 }
511 int fd;
512 DIR *d = open_directory (encoded_dir, &fd);
513 record_unwind_protect_ptr (directory_files_internal_unwind, d);
514
515 /* Loop reading directory entries. */
516 for (struct dirent *dp; (dp = read_dirent (d, dirname)); )
517 {
518 ptrdiff_t len = dirent_namelen (dp);
519 bool canexclude = 0;
520
521 QUIT;
522 if (len < SCHARS (encoded_file)
523 || (scmp (dp->d_name, SSDATA (encoded_file),
524 SCHARS (encoded_file))
525 >= 0))
526 continue;
527
528 if (file_name_completion_stat (fd, dp, &st) < 0)
529 continue;
530
531 directoryp = S_ISDIR (st.st_mode) != 0;
532 tem = Qnil;
533 /* If all_flag is set, always include all.
534 It would not actually be helpful to the user to ignore any possible
535 completions when making a list of them. */
536 if (!all_flag)
537 {
538 ptrdiff_t skip;
539
540 #if 0 /* FIXME: The `scmp' call compares an encoded and a decoded string. */
541 /* If this entry matches the current bestmatch, the only
542 thing it can do is increase matchcount, so don't bother
543 investigating it any further. */
544 if (!completion_ignore_case
545 /* The return result depends on whether it's the sole match. */
546 && matchcount > 1
547 && !includeall /* This match may allow includeall to 0. */
548 && len >= bestmatchsize
549 && 0 > scmp (dp->d_name, SSDATA (bestmatch), bestmatchsize))
550 continue;
551 #endif
552
553 if (directoryp)
554 {
555 #ifndef TRIVIAL_DIRECTORY_ENTRY
556 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
557 #endif
558 /* "." and ".." are never interesting as completions, and are
559 actually in the way in a directory with only one file. */
560 if (TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
561 canexclude = 1;
562 else if (len > SCHARS (encoded_file))
563 /* Ignore directories if they match an element of
564 completion-ignored-extensions which ends in a slash. */
565 for (tem = Vcompletion_ignored_extensions;
566 CONSP (tem); tem = XCDR (tem))
567 {
568 ptrdiff_t elt_len;
569 char *p1;
570
571 elt = XCAR (tem);
572 if (!STRINGP (elt))
573 continue;
574 /* Need to encode ELT, since scmp compares unibyte
575 strings only. */
576 elt = ENCODE_FILE (elt);
577 elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
578 if (elt_len <= 0)
579 continue;
580 p1 = SSDATA (elt);
581 if (p1[elt_len] != '/')
582 continue;
583 skip = len - elt_len;
584 if (skip < 0)
585 continue;
586
587 if (scmp (dp->d_name + skip, p1, elt_len) >= 0)
588 continue;
589 break;
590 }
591 }
592 else
593 {
594 /* Compare extensions-to-be-ignored against end of this file name */
595 /* if name is not an exact match against specified string */
596 if (len > SCHARS (encoded_file))
597 /* and exit this for loop if a match is found */
598 for (tem = Vcompletion_ignored_extensions;
599 CONSP (tem); tem = XCDR (tem))
600 {
601 elt = XCAR (tem);
602 if (!STRINGP (elt)) continue;
603 /* Need to encode ELT, since scmp compares unibyte
604 strings only. */
605 elt = ENCODE_FILE (elt);
606 skip = len - SCHARS (elt);
607 if (skip < 0) continue;
608
609 if (scmp (dp->d_name + skip, SSDATA (elt), SCHARS (elt))
610 >= 0)
611 continue;
612 break;
613 }
614 }
615
616 /* If an ignored-extensions match was found,
617 don't process this name as a completion. */
618 if (CONSP (tem))
619 canexclude = 1;
620
621 if (!includeall && canexclude)
622 /* We're not including all files and this file can be excluded. */
623 continue;
624
625 if (includeall && !canexclude)
626 { /* If we have one non-excludable file, we want to exclude the
627 excludable files. */
628 includeall = 0;
629 /* Throw away any previous excludable match found. */
630 bestmatch = Qnil;
631 bestmatchsize = 0;
632 matchcount = 0;
633 }
634 }
635 /* FIXME: If we move this `decode' earlier we can eliminate
636 the repeated ENCODE_FILE on Vcompletion_ignored_extensions. */
637 name = make_unibyte_string (dp->d_name, len);
638 name = DECODE_FILE (name);
639
640 {
641 Lisp_Object regexps, table = (completion_ignore_case
642 ? Vascii_canon_table : Qnil);
643
644 /* Ignore this element if it fails to match all the regexps. */
645 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
646 regexps = XCDR (regexps))
647 if (fast_string_match_internal (XCAR (regexps), name, table) < 0)
648 break;
649
650 if (CONSP (regexps))
651 continue;
652 }
653
654 /* This is a possible completion */
655 if (directoryp)
656 /* This completion is a directory; make it end with '/'. */
657 name = Ffile_name_as_directory (name);
658
659 /* Test the predicate, if any. */
660 if (!NILP (predicate) && NILP (call1 (predicate, name)))
661 continue;
662
663 /* Reject entries where the encoded strings match, but the
664 decoded don't. For example, "a" should not match "a-ring" on
665 file systems that store decomposed characters. */
666 Lisp_Object zero = make_number (0);
667
668 if (check_decoded && SCHARS (file) <= SCHARS (name))
669 {
670 /* FIXME: This is a copy of the code below. */
671 ptrdiff_t compare = SCHARS (file);
672 Lisp_Object cmp
673 = Fcompare_strings (name, zero, make_number (compare),
674 file, zero, make_number (compare),
675 completion_ignore_case ? Qt : Qnil);
676 if (!EQ (cmp, Qt))
677 continue;
678 }
679
680 /* Suitably record this match. */
681
682 matchcount += matchcount <= 1;
683
684 if (all_flag)
685 bestmatch = Fcons (name, bestmatch);
686 else if (NILP (bestmatch))
687 {
688 bestmatch = name;
689 bestmatchsize = SCHARS (name);
690 }
691 else
692 {
693 /* FIXME: This is a copy of the code in Ftry_completion. */
694 ptrdiff_t compare = min (bestmatchsize, SCHARS (name));
695 Lisp_Object cmp
696 = Fcompare_strings (bestmatch, zero, make_number (compare),
697 name, zero, make_number (compare),
698 completion_ignore_case ? Qt : Qnil);
699 ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XINT (cmp)) - 1;
700
701 if (completion_ignore_case)
702 {
703 /* If this is an exact match except for case,
704 use it as the best match rather than one that is not
705 an exact match. This way, we get the case pattern
706 of the actual match. */
707 /* This tests that the current file is an exact match
708 but BESTMATCH is not (it is too long). */
709 if ((matchsize == SCHARS (name)
710 && matchsize + directoryp < SCHARS (bestmatch))
711 ||
712 /* If there is no exact match ignoring case,
713 prefer a match that does not change the case
714 of the input. */
715 /* If there is more than one exact match aside from
716 case, and one of them is exact including case,
717 prefer that one. */
718 /* This == checks that, of current file and BESTMATCH,
719 either both or neither are exact. */
720 (((matchsize == SCHARS (name))
721 ==
722 (matchsize + directoryp == SCHARS (bestmatch)))
723 && (cmp = Fcompare_strings (name, zero,
724 make_number (SCHARS (file)),
725 file, zero,
726 Qnil,
727 Qnil),
728 EQ (Qt, cmp))
729 && (cmp = Fcompare_strings (bestmatch, zero,
730 make_number (SCHARS (file)),
731 file, zero,
732 Qnil,
733 Qnil),
734 ! EQ (Qt, cmp))))
735 bestmatch = name;
736 }
737 bestmatchsize = matchsize;
738
739 /* If the best completion so far is reduced to the string
740 we're trying to complete, then we already know there's no
741 other completion, so there's no point looking any further. */
742 if (matchsize <= SCHARS (file)
743 && !includeall /* A future match may allow includeall to 0. */
744 /* If completion-ignore-case is non-nil, don't
745 short-circuit because we want to find the best
746 possible match *including* case differences. */
747 && (!completion_ignore_case || matchsize == 0)
748 /* The return value depends on whether it's the sole match. */
749 && matchcount > 1)
750 break;
751
752 }
753 }
754
755 /* This closes the directory. */
756 bestmatch = unbind_to (count, bestmatch);
757
758 if (all_flag || NILP (bestmatch))
759 return bestmatch;
760 /* Return t if the supplied string is an exact match (counting case);
761 it does not require any change to be made. */
762 if (matchcount == 1 && !NILP (Fequal (bestmatch, file)))
763 return Qt;
764 bestmatch = Fsubstring (bestmatch, make_number (0),
765 make_number (bestmatchsize));
766 return bestmatch;
767 }
768
769 /* Compare exactly LEN chars of strings at S1 and S2,
770 ignoring case if appropriate.
771 Return -1 if strings match,
772 else number of chars that match at the beginning. */
773
774 static ptrdiff_t
775 scmp (const char *s1, const char *s2, ptrdiff_t len)
776 {
777 register ptrdiff_t l = len;
778
779 if (completion_ignore_case)
780 {
781 while (l
782 && (downcase ((unsigned char) *s1++)
783 == downcase ((unsigned char) *s2++)))
784 l--;
785 }
786 else
787 {
788 while (l && *s1++ == *s2++)
789 l--;
790 }
791 if (l == 0)
792 return -1;
793 else
794 return len - l;
795 }
796
797 static int
798 file_name_completion_stat (int fd, struct dirent *dp, struct stat *st_addr)
799 {
800 int value;
801
802 #ifdef MSDOS
803 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
804 but aren't required here. Avoid computing the following fields:
805 st_inode, st_size and st_nlink for directories, and the execute bits
806 in st_mode for non-directory files with non-standard extensions. */
807
808 unsigned short save_djstat_flags = _djstat_flags;
809
810 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
811 #endif /* MSDOS */
812
813 /* We want to return success if a link points to a nonexistent file,
814 but we want to return the status for what the link points to,
815 in case it is a directory. */
816 value = fstatat (fd, dp->d_name, st_addr, AT_SYMLINK_NOFOLLOW);
817 if (value == 0 && S_ISLNK (st_addr->st_mode))
818 fstatat (fd, dp->d_name, st_addr, 0);
819 #ifdef MSDOS
820 _djstat_flags = save_djstat_flags;
821 #endif /* MSDOS */
822 return value;
823 }
824 \f
825 static char *
826 stat_uname (struct stat *st)
827 {
828 #ifdef WINDOWSNT
829 return st->st_uname;
830 #else
831 struct passwd *pw = getpwuid (st->st_uid);
832
833 if (pw)
834 return pw->pw_name;
835 else
836 return NULL;
837 #endif
838 }
839
840 static char *
841 stat_gname (struct stat *st)
842 {
843 #ifdef WINDOWSNT
844 return st->st_gname;
845 #else
846 struct group *gr = getgrgid (st->st_gid);
847
848 if (gr)
849 return gr->gr_name;
850 else
851 return NULL;
852 #endif
853 }
854
855 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
856 doc: /* Return a list of attributes of file FILENAME.
857 Value is nil if specified file cannot be opened.
858
859 ID-FORMAT specifies the preferred format of attributes uid and gid (see
860 below) - valid values are `string' and `integer'. The latter is the
861 default, but we plan to change that, so you should specify a non-nil value
862 for ID-FORMAT if you use the returned uid or gid.
863
864 Elements of the attribute list are:
865 0. t for directory, string (name linked to) for symbolic link, or nil.
866 1. Number of links to file.
867 2. File uid as a string or a number. If a string value cannot be
868 looked up, a numeric value, either an integer or a float, is returned.
869 3. File gid, likewise.
870 4. Last access time, as a list of integers (HIGH LOW USEC PSEC) in the
871 same style as (current-time).
872 (See a note below about access time on FAT-based filesystems.)
873 5. Last modification time, likewise. This is the time of the last
874 change to the file's contents.
875 6. Last status change time, likewise. This is the time of last change
876 to the file's attributes: owner and group, access mode bits, etc.
877 7. Size in bytes.
878 This is a floating point number if the size is too large for an integer.
879 8. File modes, as a string of ten letters or dashes as in ls -l.
880 9. An unspecified value, present only for backward compatibility.
881 10. inode number. If it is larger than what an Emacs integer can hold,
882 this is of the form (HIGH . LOW): first the high bits, then the low 16 bits.
883 If even HIGH is too large for an Emacs integer, this is instead of the form
884 (HIGH MIDDLE . LOW): first the high bits, then the middle 24 bits,
885 and finally the low 16 bits.
886 11. Filesystem device number. If it is larger than what the Emacs
887 integer can hold, this is a cons cell, similar to the inode number.
888
889 On most filesystems, the combination of the inode and the device
890 number uniquely identifies the file.
891
892 On MS-Windows, performance depends on `w32-get-true-file-attributes',
893 which see.
894
895 On some FAT-based filesystems, only the date of last access is recorded,
896 so last access time will always be midnight of that day. */)
897 (Lisp_Object filename, Lisp_Object id_format)
898 {
899 Lisp_Object encoded;
900 Lisp_Object handler;
901
902 filename = internal_condition_case_2 (Fexpand_file_name, filename, Qnil,
903 Qt, Fidentity);
904 if (!STRINGP (filename))
905 return Qnil;
906
907 /* If the file name has special constructs in it,
908 call the corresponding file handler. */
909 handler = Ffind_file_name_handler (filename, Qfile_attributes);
910 if (!NILP (handler))
911 { /* Only pass the extra arg if it is used to help backward compatibility
912 with old file handlers which do not implement the new arg. --Stef */
913 if (NILP (id_format))
914 return call2 (handler, Qfile_attributes, filename);
915 else
916 return call3 (handler, Qfile_attributes, filename, id_format);
917 }
918
919 encoded = ENCODE_FILE (filename);
920 return file_attributes (AT_FDCWD, SSDATA (encoded), id_format);
921 }
922
923 static Lisp_Object
924 file_attributes (int fd, char const *name, Lisp_Object id_format)
925 {
926 struct stat s;
927 int lstat_result;
928
929 /* An array to hold the mode string generated by filemodestring,
930 including its terminating space and null byte. */
931 char modes[sizeof "-rwxr-xr-x "];
932
933 char *uname = NULL, *gname = NULL;
934
935 #ifdef WINDOWSNT
936 /* We usually don't request accurate owner and group info, because
937 it can be very expensive on Windows to get that, and most callers
938 of 'lstat' don't need that. But here we do want that information
939 to be accurate. */
940 w32_stat_get_owner_group = 1;
941 #endif
942
943 lstat_result = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW);
944
945 #ifdef WINDOWSNT
946 w32_stat_get_owner_group = 0;
947 #endif
948
949 if (lstat_result < 0)
950 return Qnil;
951
952 if (!(NILP (id_format) || EQ (id_format, Qinteger)))
953 {
954 block_input ();
955 uname = stat_uname (&s);
956 gname = stat_gname (&s);
957 unblock_input ();
958 }
959
960 filemodestring (&s, modes);
961
962 return CALLN (Flist,
963 (S_ISLNK (s.st_mode) ? emacs_readlinkat (fd, name)
964 : S_ISDIR (s.st_mode) ? Qt : Qnil),
965 make_number (s.st_nlink),
966 (uname
967 ? DECODE_SYSTEM (build_unibyte_string (uname))
968 : make_fixnum_or_float (s.st_uid)),
969 (gname
970 ? DECODE_SYSTEM (build_unibyte_string (gname))
971 : make_fixnum_or_float (s.st_gid)),
972 make_lisp_time (get_stat_atime (&s)),
973 make_lisp_time (get_stat_mtime (&s)),
974 make_lisp_time (get_stat_ctime (&s)),
975
976 /* If the file size is a 4-byte type, assume that
977 files of sizes in the 2-4 GiB range wrap around to
978 negative values, as this is a common bug on older
979 32-bit platforms. */
980 make_fixnum_or_float (sizeof (s.st_size) == 4
981 ? s.st_size & 0xffffffffu
982 : s.st_size),
983
984 make_string (modes, 10),
985 Qt,
986 INTEGER_TO_CONS (s.st_ino),
987 INTEGER_TO_CONS (s.st_dev));
988 }
989
990 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
991 doc: /* Return t if first arg file attributes list is less than second.
992 Comparison is in lexicographic order and case is significant. */)
993 (Lisp_Object f1, Lisp_Object f2)
994 {
995 return Fstring_lessp (Fcar (f1), Fcar (f2));
996 }
997 \f
998
999 DEFUN ("system-users", Fsystem_users, Ssystem_users, 0, 0, 0,
1000 doc: /* Return a list of user names currently registered in the system.
1001 If we don't know how to determine that on this platform, just
1002 return a list with one element, taken from `user-real-login-name'. */)
1003 (void)
1004 {
1005 Lisp_Object users = Qnil;
1006 #if defined HAVE_GETPWENT && defined HAVE_ENDPWENT
1007 struct passwd *pw;
1008
1009 while ((pw = getpwent ()))
1010 users = Fcons (DECODE_SYSTEM (build_string (pw->pw_name)), users);
1011
1012 endpwent ();
1013 #endif
1014 if (EQ (users, Qnil))
1015 /* At least current user is always known. */
1016 users = list1 (Vuser_real_login_name);
1017 return users;
1018 }
1019
1020 DEFUN ("system-groups", Fsystem_groups, Ssystem_groups, 0, 0, 0,
1021 doc: /* Return a list of user group names currently registered in the system.
1022 The value may be nil if not supported on this platform. */)
1023 (void)
1024 {
1025 Lisp_Object groups = Qnil;
1026 #if defined HAVE_GETGRENT && defined HAVE_ENDGRENT
1027 struct group *gr;
1028
1029 while ((gr = getgrent ()))
1030 groups = Fcons (DECODE_SYSTEM (build_string (gr->gr_name)), groups);
1031
1032 endgrent ();
1033 #endif
1034 return groups;
1035 }
1036
1037 void
1038 syms_of_dired (void)
1039 {
1040 DEFSYM (Qdirectory_files, "directory-files");
1041 DEFSYM (Qdirectory_files_and_attributes, "directory-files-and-attributes");
1042 DEFSYM (Qfile_name_completion, "file-name-completion");
1043 DEFSYM (Qfile_name_all_completions, "file-name-all-completions");
1044 DEFSYM (Qfile_attributes, "file-attributes");
1045 DEFSYM (Qfile_attributes_lessp, "file-attributes-lessp");
1046 DEFSYM (Qdefault_directory, "default-directory");
1047 DEFSYM (Qdecomposed_characters, "decomposed-characters");
1048
1049 defsubr (&Sdirectory_files);
1050 defsubr (&Sdirectory_files_and_attributes);
1051 defsubr (&Sfile_name_completion);
1052 defsubr (&Sfile_name_all_completions);
1053 defsubr (&Sfile_attributes);
1054 defsubr (&Sfile_attributes_lessp);
1055 defsubr (&Ssystem_users);
1056 defsubr (&Ssystem_groups);
1057
1058 DEFVAR_LISP ("completion-ignored-extensions", Vcompletion_ignored_extensions,
1059 doc: /* Completion ignores file names ending in any string in this list.
1060 It does not ignore them if all possible completions end in one of
1061 these strings or when displaying a list of completions.
1062 It ignores directory names if they match any string in this list which
1063 ends in a slash. */);
1064 Vcompletion_ignored_extensions = Qnil;
1065 }