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