* doc/misc/eshell.texi: Fill most of the missing sections.
[bpt/emacs.git] / src / dired.c
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985-1986, 1993-1994, 1999-2013 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 <unistd.h>
34
35 /* The d_nameln member of a struct dirent includes the '\0' character
36 on some systems, but not on others. What's worse, you can't tell
37 at compile-time which one it will be, since it really depends on
38 the sort of system providing the filesystem you're reading from,
39 not the system you are running on. Paul Eggert
40 <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
41 SunOS 4.1.2 host, reading a directory that is remote-mounted from a
42 Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
43
44 Since applying strlen to the name always works, we'll just do that. */
45 #define NAMLEN(p) strlen (p->d_name)
46
47 #ifdef HAVE_DIRENT_H
48
49 #include <dirent.h>
50 #define DIRENTRY struct dirent
51
52 #else /* not HAVE_DIRENT_H */
53
54 #include <sys/dir.h>
55 #include <sys/stat.h>
56
57 #define DIRENTRY struct direct
58
59 extern DIR *opendir (char *);
60 extern struct direct *readdir (DIR *);
61
62 #endif /* HAVE_DIRENT_H */
63
64 #include <filemode.h>
65 #include <stat-time.h>
66
67 #ifdef MSDOS
68 #define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
69 #else
70 #define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
71 #endif
72
73 #include "lisp.h"
74 #include "systime.h"
75 #include "character.h"
76 #include "buffer.h"
77 #include "commands.h"
78 #include "charset.h"
79 #include "coding.h"
80 #include "regex.h"
81 #include "blockinput.h"
82
83 static Lisp_Object Qdirectory_files;
84 static Lisp_Object Qdirectory_files_and_attributes;
85 static Lisp_Object Qfile_name_completion;
86 static Lisp_Object Qfile_name_all_completions;
87 static Lisp_Object Qfile_attributes;
88 static Lisp_Object Qfile_attributes_lessp;
89
90 static ptrdiff_t scmp (const char *, const char *, ptrdiff_t);
91 \f
92 #ifdef WINDOWSNT
93 Lisp_Object
94 directory_files_internal_w32_unwind (Lisp_Object arg)
95 {
96 Vw32_get_true_file_attributes = arg;
97 return Qnil;
98 }
99 #endif
100
101 static Lisp_Object
102 directory_files_internal_unwind (Lisp_Object dh)
103 {
104 DIR *d = (DIR *) XSAVE_VALUE (dh)->pointer;
105 block_input ();
106 closedir (d);
107 unblock_input ();
108 return Qnil;
109 }
110
111 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
112 If not ATTRS, return a list of directory filenames;
113 if ATTRS, return a list of directory filenames and their attributes.
114 In the latter case, ID_FORMAT is passed to Ffile_attributes. */
115
116 Lisp_Object
117 directory_files_internal (Lisp_Object directory, Lisp_Object full,
118 Lisp_Object match, Lisp_Object nosort, bool attrs,
119 Lisp_Object id_format)
120 {
121 DIR *d;
122 ptrdiff_t directory_nbytes;
123 Lisp_Object list, dirfilename, encoded_directory;
124 struct re_pattern_buffer *bufp = NULL;
125 bool needsep = 0;
126 ptrdiff_t count = SPECPDL_INDEX ();
127 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
128 DIRENTRY *dp;
129 #ifdef WINDOWSNT
130 Lisp_Object w32_save = Qnil;
131 #endif
132
133 /* Because of file name handlers, these functions might call
134 Ffuncall, and cause a GC. */
135 list = encoded_directory = dirfilename = Qnil;
136 GCPRO5 (match, directory, list, dirfilename, encoded_directory);
137 dirfilename = Fdirectory_file_name (directory);
138
139 if (!NILP (match))
140 {
141 CHECK_STRING (match);
142
143 /* MATCH might be a flawed regular expression. Rather than
144 catching and signaling our own errors, we just call
145 compile_pattern to do the work for us. */
146 /* Pass 1 for the MULTIBYTE arg
147 because we do make multibyte strings if the contents warrant. */
148 # ifdef WINDOWSNT
149 /* Windows users want case-insensitive wildcards. */
150 bufp = compile_pattern (match, 0,
151 BVAR (&buffer_defaults, case_canon_table), 0, 1);
152 # else /* !WINDOWSNT */
153 bufp = compile_pattern (match, 0, Qnil, 0, 1);
154 # endif /* !WINDOWSNT */
155 }
156
157 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
158 run_pre_post_conversion_on_str which calls Lisp directly and
159 indirectly. */
160 if (STRING_MULTIBYTE (dirfilename))
161 dirfilename = ENCODE_FILE (dirfilename);
162 encoded_directory = (STRING_MULTIBYTE (directory)
163 ? ENCODE_FILE (directory) : directory);
164
165 /* Now *bufp is the compiled form of MATCH; don't call anything
166 which might compile a new regexp until we're done with the loop! */
167
168 block_input ();
169 d = opendir (SSDATA (dirfilename));
170 unblock_input ();
171 if (d == NULL)
172 report_file_error ("Opening directory", Fcons (directory, Qnil));
173
174 /* Unfortunately, we can now invoke expand-file-name and
175 file-attributes on filenames, both of which can throw, so we must
176 do a proper unwind-protect. */
177 record_unwind_protect (directory_files_internal_unwind,
178 make_save_value (d, 0));
179
180 #ifdef WINDOWSNT
181 if (attrs)
182 {
183 extern int is_slow_fs (const char *);
184
185 /* Do this only once to avoid doing it (in w32.c:stat) for each
186 file in the directory, when we call Ffile_attributes below. */
187 record_unwind_protect (directory_files_internal_w32_unwind,
188 Vw32_get_true_file_attributes);
189 w32_save = Vw32_get_true_file_attributes;
190 if (EQ (Vw32_get_true_file_attributes, Qlocal))
191 {
192 /* w32.c:stat will notice these bindings and avoid calling
193 GetDriveType for each file. */
194 if (is_slow_fs (SDATA (dirfilename)))
195 Vw32_get_true_file_attributes = Qnil;
196 else
197 Vw32_get_true_file_attributes = Qt;
198 }
199 }
200 #endif
201
202 directory_nbytes = SBYTES (directory);
203 re_match_object = Qt;
204
205 /* Decide whether we need to add a directory separator. */
206 if (directory_nbytes == 0
207 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
208 needsep = 1;
209
210 /* Loop reading blocks until EOF or error. */
211 for (;;)
212 {
213 errno = 0;
214 dp = readdir (d);
215
216 if (dp == NULL && (0
217 #ifdef EAGAIN
218 || errno == EAGAIN
219 #endif
220 #ifdef EINTR
221 || errno == EINTR
222 #endif
223 ))
224 { QUIT; continue; }
225
226 if (dp == NULL)
227 break;
228
229 if (DIRENTRY_NONEMPTY (dp))
230 {
231 ptrdiff_t len;
232 bool wanted = 0;
233 Lisp_Object name, finalname;
234 struct gcpro gcpro1, gcpro2;
235
236 len = NAMLEN (dp);
237 name = finalname = make_unibyte_string (dp->d_name, len);
238 GCPRO2 (finalname, name);
239
240 /* Note: DECODE_FILE can GC; it should protect its argument,
241 though. */
242 name = DECODE_FILE (name);
243 len = SBYTES (name);
244
245 /* Now that we have unwind_protect in place, we might as well
246 allow matching to be interrupted. */
247 immediate_quit = 1;
248 QUIT;
249
250 if (NILP (match)
251 || (0 <= re_search (bufp, SSDATA (name), len, 0, len, 0)))
252 wanted = 1;
253
254 immediate_quit = 0;
255
256 if (wanted)
257 {
258 if (!NILP (full))
259 {
260 Lisp_Object fullname;
261 ptrdiff_t nbytes = len + directory_nbytes + needsep;
262 ptrdiff_t nchars;
263
264 fullname = make_uninit_multibyte_string (nbytes, nbytes);
265 memcpy (SDATA (fullname), SDATA (directory),
266 directory_nbytes);
267
268 if (needsep)
269 SSET (fullname, directory_nbytes, DIRECTORY_SEP);
270
271 memcpy (SDATA (fullname) + directory_nbytes + needsep,
272 SDATA (name), len);
273
274 nchars = chars_in_text (SDATA (fullname), nbytes);
275
276 /* Some bug somewhere. */
277 if (nchars > nbytes)
278 emacs_abort ();
279
280 STRING_SET_CHARS (fullname, nchars);
281 if (nchars == nbytes)
282 STRING_SET_UNIBYTE (fullname);
283
284 finalname = fullname;
285 }
286 else
287 finalname = name;
288
289 if (attrs)
290 {
291 /* Construct an expanded filename for the directory entry.
292 Use the decoded names for input to Ffile_attributes. */
293 Lisp_Object decoded_fullname, fileattrs;
294 struct gcpro gcpro1, gcpro2;
295
296 decoded_fullname = fileattrs = Qnil;
297 GCPRO2 (decoded_fullname, fileattrs);
298
299 /* Both Fexpand_file_name and Ffile_attributes can GC. */
300 decoded_fullname = Fexpand_file_name (name, directory);
301 fileattrs = Ffile_attributes (decoded_fullname, id_format);
302
303 list = Fcons (Fcons (finalname, fileattrs), list);
304 UNGCPRO;
305 }
306 else
307 list = Fcons (finalname, list);
308 }
309
310 UNGCPRO;
311 }
312 }
313
314 block_input ();
315 closedir (d);
316 unblock_input ();
317 #ifdef WINDOWSNT
318 if (attrs)
319 Vw32_get_true_file_attributes = w32_save;
320 #endif
321
322 /* Discard the unwind protect. */
323 specpdl_ptr = specpdl + count;
324
325 if (NILP (nosort))
326 list = Fsort (Fnreverse (list),
327 attrs ? Qfile_attributes_lessp : Qstring_lessp);
328
329 RETURN_UNGCPRO (list);
330 }
331
332
333 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
334 doc: /* Return a list of names of files in DIRECTORY.
335 There are three optional arguments:
336 If FULL is non-nil, return absolute file names. Otherwise return names
337 that are relative to the specified directory.
338 If MATCH is non-nil, mention only file names that match the regexp MATCH.
339 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
340 Otherwise, the list returned is sorted with `string-lessp'.
341 NOSORT is useful if you plan to sort the result yourself. */)
342 (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort)
343 {
344 Lisp_Object handler;
345 directory = Fexpand_file_name (directory, Qnil);
346
347 /* If the file name has special constructs in it,
348 call the corresponding file handler. */
349 handler = Ffind_file_name_handler (directory, Qdirectory_files);
350 if (!NILP (handler))
351 return call5 (handler, Qdirectory_files, directory,
352 full, match, nosort);
353
354 return directory_files_internal (directory, full, match, nosort, 0, Qnil);
355 }
356
357 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
358 Sdirectory_files_and_attributes, 1, 5, 0,
359 doc: /* Return a list of names of files and their attributes in DIRECTORY.
360 There are four optional arguments:
361 If FULL is non-nil, return absolute file names. Otherwise return names
362 that are relative to the specified directory.
363 If MATCH is non-nil, mention only file names that match the regexp MATCH.
364 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
365 NOSORT is useful if you plan to sort the result yourself.
366 ID-FORMAT specifies the preferred format of attributes uid and gid, see
367 `file-attributes' for further documentation.
368 On MS-Windows, performance depends on `w32-get-true-file-attributes',
369 which see. */)
370 (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, Lisp_Object id_format)
371 {
372 Lisp_Object handler;
373 directory = Fexpand_file_name (directory, Qnil);
374
375 /* If the file name has special constructs in it,
376 call the corresponding file handler. */
377 handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
378 if (!NILP (handler))
379 return call6 (handler, Qdirectory_files_and_attributes,
380 directory, full, match, nosort, id_format);
381
382 return directory_files_internal (directory, full, match, nosort, 1, id_format);
383 }
384
385 \f
386 static Lisp_Object file_name_completion (Lisp_Object, Lisp_Object, bool,
387 Lisp_Object);
388
389 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
390 2, 3, 0,
391 doc: /* Complete file name FILE in directory DIRECTORY.
392 Returns the longest string
393 common to all file names in DIRECTORY that start with FILE.
394 If there is only one and FILE matches it exactly, returns t.
395 Returns nil if DIRECTORY contains no name starting with FILE.
396
397 If PREDICATE is non-nil, call PREDICATE with each possible
398 completion (in absolute form) and ignore it if PREDICATE returns nil.
399
400 This function ignores some of the possible completions as
401 determined by the variable `completion-ignored-extensions', which see. */)
402 (Lisp_Object file, Lisp_Object directory, Lisp_Object predicate)
403 {
404 Lisp_Object handler;
405 directory = Fexpand_file_name (directory, Qnil);
406
407 /* If the directory name has special constructs in it,
408 call the corresponding file handler. */
409 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
410 if (!NILP (handler))
411 return call4 (handler, Qfile_name_completion, file, directory, predicate);
412
413 /* If the file name has special constructs in it,
414 call the corresponding file handler. */
415 handler = Ffind_file_name_handler (file, Qfile_name_completion);
416 if (!NILP (handler))
417 return call4 (handler, Qfile_name_completion, file, directory, predicate);
418
419 return file_name_completion (file, directory, 0, predicate);
420 }
421
422 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
423 Sfile_name_all_completions, 2, 2, 0,
424 doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
425 These are all file names in directory DIRECTORY which begin with FILE. */)
426 (Lisp_Object file, Lisp_Object directory)
427 {
428 Lisp_Object handler;
429 directory = Fexpand_file_name (directory, Qnil);
430
431 /* If the directory name has special constructs in it,
432 call the corresponding file handler. */
433 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
434 if (!NILP (handler))
435 return call3 (handler, Qfile_name_all_completions, file, directory);
436
437 /* If the file name has special constructs in it,
438 call the corresponding file handler. */
439 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
440 if (!NILP (handler))
441 return call3 (handler, Qfile_name_all_completions, file, directory);
442
443 return file_name_completion (file, directory, 1, Qnil);
444 }
445
446 static int file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_addr);
447 static Lisp_Object Qdefault_directory;
448
449 static Lisp_Object
450 file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
451 Lisp_Object predicate)
452 {
453 DIR *d;
454 ptrdiff_t bestmatchsize = 0;
455 int matchcount = 0;
456 /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
457 If ALL_FLAG is 0, BESTMATCH is either nil
458 or the best match so far, not decoded. */
459 Lisp_Object bestmatch, tem, elt, name;
460 Lisp_Object encoded_file;
461 Lisp_Object encoded_dir;
462 struct stat st;
463 bool directoryp;
464 /* If not INCLUDEALL, exclude files in completion-ignored-extensions as
465 well as "." and "..". Until shown otherwise, assume we can't exclude
466 anything. */
467 bool includeall = 1;
468 ptrdiff_t count = SPECPDL_INDEX ();
469 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
470
471 elt = Qnil;
472
473 CHECK_STRING (file);
474
475 bestmatch = Qnil;
476 encoded_file = encoded_dir = Qnil;
477 GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
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 = STRING_MULTIBYTE (file) ? ENCODE_FILE (file) : file;
487
488 encoded_dir = ENCODE_FILE (dirname);
489
490 block_input ();
491 d = opendir (SSDATA (Fdirectory_file_name (encoded_dir)));
492 unblock_input ();
493 if (!d)
494 report_file_error ("Opening directory", Fcons (dirname, Qnil));
495
496 record_unwind_protect (directory_files_internal_unwind,
497 make_save_value (d, 0));
498
499 /* Loop reading blocks */
500 /* (att3b compiler bug requires do a null comparison this way) */
501 while (1)
502 {
503 DIRENTRY *dp;
504 ptrdiff_t len;
505 bool canexclude = 0;
506
507 errno = 0;
508 dp = readdir (d);
509 if (dp == NULL && (0
510 # ifdef EAGAIN
511 || errno == EAGAIN
512 # endif
513 # ifdef EINTR
514 || errno == EINTR
515 # endif
516 ))
517 { QUIT; continue; }
518
519 if (!dp) break;
520
521 len = NAMLEN (dp);
522
523 QUIT;
524 if (! DIRENTRY_NONEMPTY (dp)
525 || len < SCHARS (encoded_file)
526 || 0 <= scmp (dp->d_name, SSDATA (encoded_file),
527 SCHARS (encoded_file)))
528 continue;
529
530 if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
531 continue;
532
533 directoryp = S_ISDIR (st.st_mode) != 0;
534 tem = Qnil;
535 /* If all_flag is set, always include all.
536 It would not actually be helpful to the user to ignore any possible
537 completions when making a list of them. */
538 if (!all_flag)
539 {
540 ptrdiff_t skip;
541
542 #if 0 /* FIXME: The `scmp' call compares an encoded and a decoded string. */
543 /* If this entry matches the current bestmatch, the only
544 thing it can do is increase matchcount, so don't bother
545 investigating it any further. */
546 if (!completion_ignore_case
547 /* The return result depends on whether it's the sole match. */
548 && matchcount > 1
549 && !includeall /* This match may allow includeall to 0. */
550 && len >= bestmatchsize
551 && 0 > scmp (dp->d_name, SSDATA (bestmatch), bestmatchsize))
552 continue;
553 #endif
554
555 if (directoryp)
556 {
557 #ifndef TRIVIAL_DIRECTORY_ENTRY
558 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
559 #endif
560 /* "." and ".." are never interesting as completions, and are
561 actually in the way in a directory with only one file. */
562 if (TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
563 canexclude = 1;
564 else if (len > SCHARS (encoded_file))
565 /* Ignore directories if they match an element of
566 completion-ignored-extensions which ends in a slash. */
567 for (tem = Vcompletion_ignored_extensions;
568 CONSP (tem); tem = XCDR (tem))
569 {
570 ptrdiff_t elt_len;
571 char *p1;
572
573 elt = XCAR (tem);
574 if (!STRINGP (elt))
575 continue;
576 /* Need to encode ELT, since scmp compares unibyte
577 strings only. */
578 elt = ENCODE_FILE (elt);
579 elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
580 if (elt_len <= 0)
581 continue;
582 p1 = SSDATA (elt);
583 if (p1[elt_len] != '/')
584 continue;
585 skip = len - elt_len;
586 if (skip < 0)
587 continue;
588
589 if (0 <= scmp (dp->d_name + skip, p1, elt_len))
590 continue;
591 break;
592 }
593 }
594 else
595 {
596 /* Compare extensions-to-be-ignored against end of this file name */
597 /* if name is not an exact match against specified string */
598 if (len > SCHARS (encoded_file))
599 /* and exit this for loop if a match is found */
600 for (tem = Vcompletion_ignored_extensions;
601 CONSP (tem); tem = XCDR (tem))
602 {
603 elt = XCAR (tem);
604 if (!STRINGP (elt)) continue;
605 /* Need to encode ELT, since scmp compares unibyte
606 strings only. */
607 elt = ENCODE_FILE (elt);
608 skip = len - SCHARS (elt);
609 if (skip < 0) continue;
610
611 if (0 <= scmp (dp->d_name + skip,
612 SSDATA (elt),
613 SCHARS (elt)))
614 continue;
615 break;
616 }
617 }
618
619 /* If an ignored-extensions match was found,
620 don't process this name as a completion. */
621 if (CONSP (tem))
622 canexclude = 1;
623
624 if (!includeall && canexclude)
625 /* We're not including all files and this file can be excluded. */
626 continue;
627
628 if (includeall && !canexclude)
629 { /* If we have one non-excludable file, we want to exclude the
630 excludable files. */
631 includeall = 0;
632 /* Throw away any previous excludable match found. */
633 bestmatch = Qnil;
634 bestmatchsize = 0;
635 matchcount = 0;
636 }
637 }
638 /* FIXME: If we move this `decode' earlier we can eliminate
639 the repeated ENCODE_FILE on Vcompletion_ignored_extensions. */
640 name = make_unibyte_string (dp->d_name, len);
641 name = DECODE_FILE (name);
642
643 {
644 Lisp_Object regexps;
645
646 /* Ignore this element if it fails to match all the regexps. */
647 if (completion_ignore_case)
648 {
649 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
650 regexps = XCDR (regexps))
651 if (fast_string_match_ignore_case (XCAR (regexps), name) < 0)
652 break;
653 }
654 else
655 {
656 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
657 regexps = XCDR (regexps))
658 if (fast_string_match (XCAR (regexps), name) < 0)
659 break;
660 }
661
662 if (CONSP (regexps))
663 continue;
664 }
665
666 /* This is a possible completion */
667 if (directoryp)
668 /* This completion is a directory; make it end with '/'. */
669 name = Ffile_name_as_directory (name);
670
671 /* Test the predicate, if any. */
672 if (!NILP (predicate))
673 {
674 Lisp_Object val;
675 struct gcpro gcpro1;
676
677 GCPRO1 (name);
678 val = call1 (predicate, name);
679 UNGCPRO;
680
681 if (NILP (val))
682 continue;
683 }
684
685 /* Suitably record this match. */
686
687 matchcount += matchcount <= 1;
688
689 if (all_flag)
690 bestmatch = Fcons (name, bestmatch);
691 else if (NILP (bestmatch))
692 {
693 bestmatch = name;
694 bestmatchsize = SCHARS (name);
695 }
696 else
697 {
698 Lisp_Object zero = make_number (0);
699 /* FIXME: This is a copy of the code in Ftry_completion. */
700 ptrdiff_t compare = min (bestmatchsize, SCHARS (name));
701 Lisp_Object cmp
702 = Fcompare_strings (bestmatch, zero,
703 make_number (compare),
704 name, zero,
705 make_number (compare),
706 completion_ignore_case ? Qt : Qnil);
707 ptrdiff_t matchsize
708 = (EQ (cmp, Qt) ? compare
709 : XINT (cmp) < 0 ? - XINT (cmp) - 1
710 : XINT (cmp) - 1);
711
712 if (completion_ignore_case)
713 {
714 /* If this is an exact match except for case,
715 use it as the best match rather than one that is not
716 an exact match. This way, we get the case pattern
717 of the actual match. */
718 /* This tests that the current file is an exact match
719 but BESTMATCH is not (it is too long). */
720 if ((matchsize == SCHARS (name)
721 && matchsize + directoryp < SCHARS (bestmatch))
722 ||
723 /* If there is no exact match ignoring case,
724 prefer a match that does not change the case
725 of the input. */
726 /* If there is more than one exact match aside from
727 case, and one of them is exact including case,
728 prefer that one. */
729 /* This == checks that, of current file and BESTMATCH,
730 either both or neither are exact. */
731 (((matchsize == SCHARS (name))
732 ==
733 (matchsize + directoryp == SCHARS (bestmatch)))
734 && (cmp = Fcompare_strings (name, zero,
735 make_number (SCHARS (file)),
736 file, zero,
737 Qnil,
738 Qnil),
739 EQ (Qt, cmp))
740 && (cmp = Fcompare_strings (bestmatch, zero,
741 make_number (SCHARS (file)),
742 file, zero,
743 Qnil,
744 Qnil),
745 ! EQ (Qt, cmp))))
746 bestmatch = name;
747 }
748 bestmatchsize = matchsize;
749
750 /* If the best completion so far is reduced to the string
751 we're trying to complete, then we already know there's no
752 other completion, so there's no point looking any further. */
753 if (matchsize <= SCHARS (file)
754 && !includeall /* A future match may allow includeall to 0. */
755 /* If completion-ignore-case is non-nil, don't
756 short-circuit because we want to find the best
757 possible match *including* case differences. */
758 && (!completion_ignore_case || matchsize == 0)
759 /* The return value depends on whether it's the sole match. */
760 && matchcount > 1)
761 break;
762
763 }
764 }
765
766 UNGCPRO;
767 /* This closes the directory. */
768 bestmatch = unbind_to (count, bestmatch);
769
770 if (all_flag || NILP (bestmatch))
771 return bestmatch;
772 /* Return t if the supplied string is an exact match (counting case);
773 it does not require any change to be made. */
774 if (matchcount == 1 && !NILP (Fequal (bestmatch, file)))
775 return Qt;
776 bestmatch = Fsubstring (bestmatch, make_number (0),
777 make_number (bestmatchsize));
778 return bestmatch;
779 }
780
781 /* Compare exactly LEN chars of strings at S1 and S2,
782 ignoring case if appropriate.
783 Return -1 if strings match,
784 else number of chars that match at the beginning. */
785
786 static ptrdiff_t
787 scmp (const char *s1, const char *s2, ptrdiff_t len)
788 {
789 register ptrdiff_t l = len;
790
791 if (completion_ignore_case)
792 {
793 while (l
794 && (downcase ((unsigned char) *s1++)
795 == downcase ((unsigned char) *s2++)))
796 l--;
797 }
798 else
799 {
800 while (l && *s1++ == *s2++)
801 l--;
802 }
803 if (l == 0)
804 return -1;
805 else
806 return len - l;
807 }
808
809 static int
810 file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_addr)
811 {
812 ptrdiff_t len = NAMLEN (dp);
813 ptrdiff_t pos = SCHARS (dirname);
814 int value;
815 USE_SAFE_ALLOCA;
816 char *fullname = SAFE_ALLOCA (len + pos + 2);
817
818 #ifdef MSDOS
819 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
820 but aren't required here. Avoid computing the following fields:
821 st_inode, st_size and st_nlink for directories, and the execute bits
822 in st_mode for non-directory files with non-standard extensions. */
823
824 unsigned short save_djstat_flags = _djstat_flags;
825
826 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
827 #endif /* MSDOS */
828
829 memcpy (fullname, SDATA (dirname), pos);
830 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
831 fullname[pos++] = DIRECTORY_SEP;
832
833 memcpy (fullname + pos, dp->d_name, len);
834 fullname[pos + len] = 0;
835
836 /* We want to return success if a link points to a nonexistent file,
837 but we want to return the status for what the link points to,
838 in case it is a directory. */
839 value = lstat (fullname, st_addr);
840 if (value == 0 && S_ISLNK (st_addr->st_mode))
841 stat (fullname, st_addr);
842 #ifdef MSDOS
843 _djstat_flags = save_djstat_flags;
844 #endif /* MSDOS */
845 SAFE_FREE ();
846 return value;
847 }
848 \f
849 static char *
850 stat_uname (struct stat *st)
851 {
852 #ifdef WINDOWSNT
853 return st->st_uname;
854 #else
855 struct passwd *pw = (struct passwd *) getpwuid (st->st_uid);
856
857 if (pw)
858 return pw->pw_name;
859 else
860 return NULL;
861 #endif
862 }
863
864 static char *
865 stat_gname (struct stat *st)
866 {
867 #ifdef WINDOWSNT
868 return st->st_gname;
869 #else
870 struct group *gr = (struct group *) getgrgid (st->st_gid);
871
872 if (gr)
873 return gr->gr_name;
874 else
875 return NULL;
876 #endif
877 }
878
879 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
880 doc: /* Return a list of attributes of file FILENAME.
881 Value is nil if specified file cannot be opened.
882
883 ID-FORMAT specifies the preferred format of attributes uid and gid (see
884 below) - valid values are 'string and 'integer. The latter is the
885 default, but we plan to change that, so you should specify a non-nil value
886 for ID-FORMAT if you use the returned uid or gid.
887
888 Elements of the attribute list are:
889 0. t for directory, string (name linked to) for symbolic link, or nil.
890 1. Number of links to file.
891 2. File uid as a string or a number. If a string value cannot be
892 looked up, a numeric value, either an integer or a float, is returned.
893 3. File gid, likewise.
894 4. Last access time, as a list of integers (HIGH LOW USEC PSEC) in the
895 same style as (current-time).
896 (See a note below about access time on FAT-based filesystems.)
897 5. Last modification time, likewise. This is the time of the last
898 change to the file's contents.
899 6. Last status change time, likewise. This is the time of last change
900 to the file's attributes: owner and group, access mode bits, etc.
901 7. Size in bytes.
902 This is a floating point number if the size is too large for an integer.
903 8. File modes, as a string of ten letters or dashes as in ls -l.
904 9. t if file's gid would change if file were deleted and recreated.
905 10. inode number. If it is larger than what an Emacs integer can hold,
906 this is of the form (HIGH . LOW): first the high bits, then the low 16 bits.
907 If even HIGH is too large for an Emacs integer, this is instead of the form
908 (HIGH MIDDLE . LOW): first the high bits, then the middle 24 bits,
909 and finally the low 16 bits.
910 11. Filesystem device number. If it is larger than what the Emacs
911 integer can hold, this is a cons cell, similar to the inode number.
912
913 On most filesystems, the combination of the inode and the device
914 number uniquely identifies the file.
915
916 On MS-Windows, performance depends on `w32-get-true-file-attributes',
917 which see.
918
919 On some FAT-based filesystems, only the date of last access is recorded,
920 so last access time will always be midnight of that day. */)
921 (Lisp_Object filename, Lisp_Object id_format)
922 {
923 Lisp_Object values[12];
924 Lisp_Object encoded;
925 struct stat s;
926 #ifdef BSD4_2
927 Lisp_Object dirname;
928 struct stat sdir;
929 #endif /* BSD4_2 */
930
931 /* An array to hold the mode string generated by filemodestring,
932 including its terminating space and null byte. */
933 char modes[sizeof "-rwxr-xr-x "];
934
935 Lisp_Object handler;
936 struct gcpro gcpro1;
937 char *uname = NULL, *gname = NULL;
938
939 filename = Fexpand_file_name (filename, Qnil);
940
941 /* If the file name has special constructs in it,
942 call the corresponding file handler. */
943 handler = Ffind_file_name_handler (filename, Qfile_attributes);
944 if (!NILP (handler))
945 { /* Only pass the extra arg if it is used to help backward compatibility
946 with old file handlers which do not implement the new arg. --Stef */
947 if (NILP (id_format))
948 return call2 (handler, Qfile_attributes, filename);
949 else
950 return call3 (handler, Qfile_attributes, filename, id_format);
951 }
952
953 GCPRO1 (filename);
954 encoded = ENCODE_FILE (filename);
955 UNGCPRO;
956
957 if (lstat (SSDATA (encoded), &s) < 0)
958 return Qnil;
959
960 values[0] = (S_ISLNK (s.st_mode) ? Ffile_symlink_p (filename)
961 : S_ISDIR (s.st_mode) ? Qt : Qnil);
962 values[1] = make_number (s.st_nlink);
963
964 if (!(NILP (id_format) || EQ (id_format, Qinteger)))
965 {
966 block_input ();
967 uname = stat_uname (&s);
968 gname = stat_gname (&s);
969 unblock_input ();
970 }
971 if (uname)
972 values[2] = DECODE_SYSTEM (build_string (uname));
973 else
974 values[2] = make_fixnum_or_float (s.st_uid);
975 if (gname)
976 values[3] = DECODE_SYSTEM (build_string (gname));
977 else
978 values[3] = make_fixnum_or_float (s.st_gid);
979
980 values[4] = make_lisp_time (get_stat_atime (&s));
981 values[5] = make_lisp_time (get_stat_mtime (&s));
982 values[6] = make_lisp_time (get_stat_ctime (&s));
983
984 /* If the file size is a 4-byte type, assume that files of sizes in
985 the 2-4 GiB range wrap around to negative values, as this is a
986 common bug on older 32-bit platforms. */
987 if (sizeof (s.st_size) == 4)
988 values[7] = make_fixnum_or_float (s.st_size & 0xffffffffu);
989 else
990 values[7] = make_fixnum_or_float (s.st_size);
991
992 filemodestring (&s, modes);
993 values[8] = make_string (modes, 10);
994 #ifdef BSD4_2 /* file gid will be dir gid */
995 dirname = Ffile_name_directory (filename);
996 if (! NILP (dirname))
997 encoded = ENCODE_FILE (dirname);
998 if (! NILP (dirname) && stat (SDATA (encoded), &sdir) == 0)
999 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
1000 else /* if we can't tell, assume worst */
1001 values[9] = Qt;
1002 #else /* file gid will be egid */
1003 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
1004 #endif /* not BSD4_2 */
1005 values[10] = INTEGER_TO_CONS (s.st_ino);
1006 values[11] = INTEGER_TO_CONS (s.st_dev);
1007
1008 return Flist (sizeof (values) / sizeof (values[0]), values);
1009 }
1010
1011 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
1012 doc: /* Return t if first arg file attributes list is less than second.
1013 Comparison is in lexicographic order and case is significant. */)
1014 (Lisp_Object f1, Lisp_Object f2)
1015 {
1016 return Fstring_lessp (Fcar (f1), Fcar (f2));
1017 }
1018 \f
1019
1020 DEFUN ("system-users", Fsystem_users, Ssystem_users, 0, 0, 0,
1021 doc: /* Return a list of user names currently registered in the system.
1022 If we don't know how to determine that on this platform, just
1023 return a list with one element, taken from `user-real-login-name'. */)
1024 (void)
1025 {
1026 Lisp_Object users = Qnil;
1027 #if defined HAVE_GETPWENT && defined HAVE_ENDPWENT
1028 struct passwd *pw;
1029
1030 while ((pw = getpwent ()))
1031 users = Fcons (DECODE_SYSTEM (build_string (pw->pw_name)), users);
1032
1033 endpwent ();
1034 #endif
1035 if (EQ (users, Qnil))
1036 /* At least current user is always known. */
1037 users = Fcons (Vuser_real_login_name, Qnil);
1038 return users;
1039 }
1040
1041 DEFUN ("system-groups", Fsystem_groups, Ssystem_groups, 0, 0, 0,
1042 doc: /* Return a list of user group names currently registered in the system.
1043 The value may be nil if not supported on this platform. */)
1044 (void)
1045 {
1046 Lisp_Object groups = Qnil;
1047 #if defined HAVE_GETGRENT && defined HAVE_ENDGRENT
1048 struct group *gr;
1049
1050 while ((gr = getgrent ()))
1051 groups = Fcons (DECODE_SYSTEM (build_string (gr->gr_name)), groups);
1052
1053 endgrent ();
1054 #endif
1055 return groups;
1056 }
1057
1058 void
1059 syms_of_dired (void)
1060 {
1061 DEFSYM (Qdirectory_files, "directory-files");
1062 DEFSYM (Qdirectory_files_and_attributes, "directory-files-and-attributes");
1063 DEFSYM (Qfile_name_completion, "file-name-completion");
1064 DEFSYM (Qfile_name_all_completions, "file-name-all-completions");
1065 DEFSYM (Qfile_attributes, "file-attributes");
1066 DEFSYM (Qfile_attributes_lessp, "file-attributes-lessp");
1067 DEFSYM (Qdefault_directory, "default-directory");
1068
1069 defsubr (&Sdirectory_files);
1070 defsubr (&Sdirectory_files_and_attributes);
1071 defsubr (&Sfile_name_completion);
1072 defsubr (&Sfile_name_all_completions);
1073 defsubr (&Sfile_attributes);
1074 defsubr (&Sfile_attributes_lessp);
1075 defsubr (&Ssystem_users);
1076 defsubr (&Ssystem_groups);
1077
1078 DEFVAR_LISP ("completion-ignored-extensions", Vcompletion_ignored_extensions,
1079 doc: /* Completion ignores file names ending in any string in this list.
1080 It does not ignore them if all possible completions end in one of
1081 these strings or when displaying a list of completions.
1082 It ignores directory names if they match any string in this list which
1083 ends in a slash. */);
1084 Vcompletion_ignored_extensions = Qnil;
1085 }