Remove support for DJGPP v1.x (bug#5813).
[emacs.git] / src / dired.c
blob2240f6ec76e62243b7a28b5f339ae296ca1431f8
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
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.
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.
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/>. */
21 #include <config.h>
23 #include <stdio.h>
24 #include <sys/types.h>
25 #include <sys/stat.h>
26 #include <setjmp.h>
28 #ifdef HAVE_PWD_H
29 #include <pwd.h>
30 #endif
31 #include <grp.h>
33 #include <errno.h>
35 #ifdef HAVE_UNISTD_H
36 #include <unistd.h>
37 #endif
39 /* The d_nameln member of a struct dirent includes the '\0' character
40 on some systems, but not on others. What's worse, you can't tell
41 at compile-time which one it will be, since it really depends on
42 the sort of system providing the filesystem you're reading from,
43 not the system you are running on. Paul Eggert
44 <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
45 SunOS 4.1.2 host, reading a directory that is remote-mounted from a
46 Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
48 Since applying strlen to the name always works, we'll just do that. */
49 #define NAMLEN(p) strlen (p->d_name)
51 #ifdef SYSV_SYSTEM_DIR
53 #include <dirent.h>
54 #define DIRENTRY struct dirent
56 #else /* not SYSV_SYSTEM_DIR */
58 #ifdef MSDOS
59 #include <dirent.h>
60 #else
61 #include <sys/dir.h>
62 #endif
64 #include <sys/stat.h>
66 #ifndef MSDOS
67 #define DIRENTRY struct direct
69 extern DIR *opendir ();
70 extern struct direct *readdir ();
72 #endif /* not MSDOS */
73 #endif /* not SYSV_SYSTEM_DIR */
75 /* Some versions of Cygwin don't have d_ino in `struct dirent'. */
76 #if defined(MSDOS) || defined(__CYGWIN__)
77 #define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
78 #else
79 #define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
80 #endif
82 #include "lisp.h"
83 #include "systime.h"
84 #include "buffer.h"
85 #include "commands.h"
86 #include "character.h"
87 #include "charset.h"
88 #include "coding.h"
89 #include "regex.h"
90 #include "blockinput.h"
92 /* Returns a search buffer, with a fastmap allocated and ready to go. */
93 extern struct re_pattern_buffer *compile_pattern ();
95 /* From filemode.c. Can't go in Lisp.h because of `stat'. */
96 extern void filemodestring P_ ((struct stat *, char *));
98 /* if system does not have symbolic links, it does not have lstat.
99 In that case, use ordinary stat instead. */
101 #ifndef S_IFLNK
102 #define lstat stat
103 #endif
105 extern int completion_ignore_case;
106 extern Lisp_Object Qcompletion_ignore_case;
107 extern Lisp_Object Vcompletion_regexp_list;
108 extern Lisp_Object Vw32_get_true_file_attributes;
110 Lisp_Object Vcompletion_ignored_extensions;
111 Lisp_Object Qdirectory_files;
112 Lisp_Object Qdirectory_files_and_attributes;
113 Lisp_Object Qfile_name_completion;
114 Lisp_Object Qfile_name_all_completions;
115 Lisp_Object Qfile_attributes;
116 Lisp_Object Qfile_attributes_lessp;
118 static int scmp P_ ((unsigned char *, unsigned char *, int));
120 #ifdef WINDOWSNT
121 Lisp_Object
122 directory_files_internal_w32_unwind (Lisp_Object arg)
124 Vw32_get_true_file_attributes = arg;
125 return Qnil;
127 #endif
129 Lisp_Object
130 directory_files_internal_unwind (dh)
131 Lisp_Object dh;
133 DIR *d = (DIR *) XSAVE_VALUE (dh)->pointer;
134 BLOCK_INPUT;
135 closedir (d);
136 UNBLOCK_INPUT;
137 return Qnil;
140 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
141 When ATTRS is zero, return a list of directory filenames; when
142 non-zero, return a list of directory filenames and their attributes.
143 In the latter case, ID_FORMAT is passed to Ffile_attributes. */
145 Lisp_Object
146 directory_files_internal (directory, full, match, nosort, attrs, id_format)
147 Lisp_Object directory, full, match, nosort;
148 int attrs;
149 Lisp_Object id_format;
151 DIR *d;
152 int directory_nbytes;
153 Lisp_Object list, dirfilename, encoded_directory;
154 struct re_pattern_buffer *bufp = NULL;
155 int needsep = 0;
156 int count = SPECPDL_INDEX ();
157 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
158 DIRENTRY *dp;
159 #ifdef WINDOWSNT
160 Lisp_Object w32_save = Qnil;
161 #endif
163 /* Because of file name handlers, these functions might call
164 Ffuncall, and cause a GC. */
165 list = encoded_directory = dirfilename = Qnil;
166 GCPRO5 (match, directory, list, dirfilename, encoded_directory);
167 dirfilename = Fdirectory_file_name (directory);
169 if (!NILP (match))
171 CHECK_STRING (match);
173 /* MATCH might be a flawed regular expression. Rather than
174 catching and signaling our own errors, we just call
175 compile_pattern to do the work for us. */
176 /* Pass 1 for the MULTIBYTE arg
177 because we do make multibyte strings if the contents warrant. */
178 # ifdef WINDOWSNT
179 /* Windows users want case-insensitive wildcards. */
180 bufp = compile_pattern (match, 0,
181 buffer_defaults.case_canon_table, 0, 1);
182 # else /* !WINDOWSNT */
183 bufp = compile_pattern (match, 0, Qnil, 0, 1);
184 # endif /* !WINDOWSNT */
187 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
188 run_pre_post_conversion_on_str which calls Lisp directly and
189 indirectly. */
190 if (STRING_MULTIBYTE (dirfilename))
191 dirfilename = ENCODE_FILE (dirfilename);
192 encoded_directory = (STRING_MULTIBYTE (directory)
193 ? ENCODE_FILE (directory) : directory);
195 /* Now *bufp is the compiled form of MATCH; don't call anything
196 which might compile a new regexp until we're done with the loop! */
198 BLOCK_INPUT;
199 d = opendir (SDATA (dirfilename));
200 UNBLOCK_INPUT;
201 if (d == NULL)
202 report_file_error ("Opening directory", Fcons (directory, Qnil));
204 /* Unfortunately, we can now invoke expand-file-name and
205 file-attributes on filenames, both of which can throw, so we must
206 do a proper unwind-protect. */
207 record_unwind_protect (directory_files_internal_unwind,
208 make_save_value (d, 0));
210 #ifdef WINDOWSNT
211 if (attrs)
213 extern Lisp_Object Qlocal;
214 extern int is_slow_fs (const char *);
216 /* Do this only once to avoid doing it (in w32.c:stat) for each
217 file in the directory, when we call Ffile_attributes below. */
218 record_unwind_protect (directory_files_internal_w32_unwind,
219 Vw32_get_true_file_attributes);
220 w32_save = Vw32_get_true_file_attributes;
221 if (EQ (Vw32_get_true_file_attributes, Qlocal))
223 /* w32.c:stat will notice these bindings and avoid calling
224 GetDriveType for each file. */
225 if (is_slow_fs (SDATA (dirfilename)))
226 Vw32_get_true_file_attributes = Qnil;
227 else
228 Vw32_get_true_file_attributes = Qt;
231 #endif
233 directory_nbytes = SBYTES (directory);
234 re_match_object = Qt;
236 /* Decide whether we need to add a directory separator. */
237 if (directory_nbytes == 0
238 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
239 needsep = 1;
241 /* Loop reading blocks until EOF or error. */
242 for (;;)
244 errno = 0;
245 dp = readdir (d);
247 if (dp == NULL && (0
248 #ifdef EAGAIN
249 || errno == EAGAIN
250 #endif
251 #ifdef EINTR
252 || errno == EINTR
253 #endif
255 { QUIT; continue; }
257 if (dp == NULL)
258 break;
260 if (DIRENTRY_NONEMPTY (dp))
262 int len;
263 int wanted = 0;
264 Lisp_Object name, finalname;
265 struct gcpro gcpro1, gcpro2;
267 len = NAMLEN (dp);
268 name = finalname = make_unibyte_string (dp->d_name, len);
269 GCPRO2 (finalname, name);
271 /* Note: DECODE_FILE can GC; it should protect its argument,
272 though. */
273 name = DECODE_FILE (name);
274 len = SBYTES (name);
276 /* Now that we have unwind_protect in place, we might as well
277 allow matching to be interrupted. */
278 immediate_quit = 1;
279 QUIT;
281 if (NILP (match)
282 || (0 <= re_search (bufp, SDATA (name), len, 0, len, 0)))
283 wanted = 1;
285 immediate_quit = 0;
287 if (wanted)
289 if (!NILP (full))
291 Lisp_Object fullname;
292 int nbytes = len + directory_nbytes + needsep;
293 int nchars;
295 fullname = make_uninit_multibyte_string (nbytes, nbytes);
296 bcopy (SDATA (directory), SDATA (fullname),
297 directory_nbytes);
299 if (needsep)
300 SSET (fullname, directory_nbytes, DIRECTORY_SEP);
302 bcopy (SDATA (name),
303 SDATA (fullname) + directory_nbytes + needsep,
304 len);
306 nchars = chars_in_text (SDATA (fullname), nbytes);
308 /* Some bug somewhere. */
309 if (nchars > nbytes)
310 abort ();
312 STRING_SET_CHARS (fullname, nchars);
313 if (nchars == nbytes)
314 STRING_SET_UNIBYTE (fullname);
316 finalname = fullname;
318 else
319 finalname = name;
321 if (attrs)
323 /* Construct an expanded filename for the directory entry.
324 Use the decoded names for input to Ffile_attributes. */
325 Lisp_Object decoded_fullname, fileattrs;
326 struct gcpro gcpro1, gcpro2;
328 decoded_fullname = fileattrs = Qnil;
329 GCPRO2 (decoded_fullname, fileattrs);
331 /* Both Fexpand_file_name and Ffile_attributes can GC. */
332 decoded_fullname = Fexpand_file_name (name, directory);
333 fileattrs = Ffile_attributes (decoded_fullname, id_format);
335 list = Fcons (Fcons (finalname, fileattrs), list);
336 UNGCPRO;
338 else
339 list = Fcons (finalname, list);
342 UNGCPRO;
346 BLOCK_INPUT;
347 closedir (d);
348 UNBLOCK_INPUT;
349 #ifdef WINDOWSNT
350 if (attrs)
351 Vw32_get_true_file_attributes = w32_save;
352 #endif
354 /* Discard the unwind protect. */
355 specpdl_ptr = specpdl + count;
357 if (NILP (nosort))
358 list = Fsort (Fnreverse (list),
359 attrs ? Qfile_attributes_lessp : Qstring_lessp);
361 RETURN_UNGCPRO (list);
365 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
366 doc: /* Return a list of names of files in DIRECTORY.
367 There are three optional arguments:
368 If FULL is non-nil, return absolute file names. Otherwise return names
369 that are relative to the specified directory.
370 If MATCH is non-nil, mention only file names that match the regexp MATCH.
371 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
372 Otherwise, the list returned is sorted with `string-lessp'.
373 NOSORT is useful if you plan to sort the result yourself. */)
374 (directory, full, match, nosort)
375 Lisp_Object directory, full, match, nosort;
377 Lisp_Object handler;
378 directory = Fexpand_file_name (directory, Qnil);
380 /* If the file name has special constructs in it,
381 call the corresponding file handler. */
382 handler = Ffind_file_name_handler (directory, Qdirectory_files);
383 if (!NILP (handler))
384 return call5 (handler, Qdirectory_files, directory,
385 full, match, nosort);
387 return directory_files_internal (directory, full, match, nosort, 0, Qnil);
390 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
391 Sdirectory_files_and_attributes, 1, 5, 0,
392 doc: /* Return a list of names of files and their attributes in DIRECTORY.
393 There are four optional arguments:
394 If FULL is non-nil, return absolute file names. Otherwise return names
395 that are relative to the specified directory.
396 If MATCH is non-nil, mention only file names that match the regexp MATCH.
397 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
398 NOSORT is useful if you plan to sort the result yourself.
399 ID-FORMAT specifies the preferred format of attributes uid and gid, see
400 `file-attributes' for further documentation.
401 On MS-Windows, performance depends on `w32-get-true-file-attributes',
402 which see. */)
403 (directory, full, match, nosort, id_format)
404 Lisp_Object directory, full, match, nosort, id_format;
406 Lisp_Object handler;
407 directory = Fexpand_file_name (directory, Qnil);
409 /* If the file name has special constructs in it,
410 call the corresponding file handler. */
411 handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
412 if (!NILP (handler))
413 return call6 (handler, Qdirectory_files_and_attributes,
414 directory, full, match, nosort, id_format);
416 return directory_files_internal (directory, full, match, nosort, 1, id_format);
420 Lisp_Object file_name_completion ();
422 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
423 2, 3, 0,
424 doc: /* Complete file name FILE in directory DIRECTORY.
425 Returns the longest string
426 common to all file names in DIRECTORY that start with FILE.
427 If there is only one and FILE matches it exactly, returns t.
428 Returns nil if DIRECTORY contains no name starting with FILE.
430 If PREDICATE is non-nil, call PREDICATE with each possible
431 completion (in absolute form) and ignore it if PREDICATE returns nil.
433 This function ignores some of the possible completions as
434 determined by the variable `completion-ignored-extensions', which see. */)
435 (file, directory, predicate)
436 Lisp_Object file, directory, predicate;
438 Lisp_Object handler;
440 /* If the directory name has special constructs in it,
441 call the corresponding file handler. */
442 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
443 if (!NILP (handler))
444 return call4 (handler, Qfile_name_completion, file, directory, predicate);
446 /* If the file name has special constructs in it,
447 call the corresponding file handler. */
448 handler = Ffind_file_name_handler (file, Qfile_name_completion);
449 if (!NILP (handler))
450 return call4 (handler, Qfile_name_completion, file, directory, predicate);
452 return file_name_completion (file, directory, 0, 0, predicate);
455 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
456 Sfile_name_all_completions, 2, 2, 0,
457 doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
458 These are all file names in directory DIRECTORY which begin with FILE. */)
459 (file, directory)
460 Lisp_Object file, directory;
462 Lisp_Object handler;
464 /* If the directory name has special constructs in it,
465 call the corresponding file handler. */
466 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
467 if (!NILP (handler))
468 return call3 (handler, Qfile_name_all_completions, file, directory);
470 /* If the file name has special constructs in it,
471 call the corresponding file handler. */
472 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
473 if (!NILP (handler))
474 return call3 (handler, Qfile_name_all_completions, file, directory);
476 return file_name_completion (file, directory, 1, 0, Qnil);
479 static int file_name_completion_stat ();
480 Lisp_Object Qdefault_directory;
482 Lisp_Object
483 file_name_completion (file, dirname, all_flag, ver_flag, predicate)
484 Lisp_Object file, dirname;
485 int all_flag, ver_flag;
486 Lisp_Object predicate;
488 DIR *d;
489 int bestmatchsize = 0;
490 int matchcount = 0;
491 /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
492 If ALL_FLAG is 0, BESTMATCH is either nil
493 or the best match so far, not decoded. */
494 Lisp_Object bestmatch, tem, elt, name;
495 Lisp_Object encoded_file;
496 Lisp_Object encoded_dir;
497 struct stat st;
498 int directoryp;
499 /* If includeall is zero, exclude files in completion-ignored-extensions as
500 well as "." and "..". Until shown otherwise, assume we can't exclude
501 anything. */
502 int includeall = 1;
503 int count = SPECPDL_INDEX ();
504 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
506 elt = Qnil;
508 CHECK_STRING (file);
510 #ifdef FILE_SYSTEM_CASE
511 file = FILE_SYSTEM_CASE (file);
512 #endif
513 bestmatch = Qnil;
514 encoded_file = encoded_dir = Qnil;
515 GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
516 dirname = Fexpand_file_name (dirname, Qnil);
517 specbind (Qdefault_directory, dirname);
519 /* Do completion on the encoded file name
520 because the other names in the directory are (we presume)
521 encoded likewise. We decode the completed string at the end. */
522 /* Actually, this is not quite true any more: we do most of the completion
523 work with decoded file names, but we still do some filtering based
524 on the encoded file name. */
525 encoded_file = STRING_MULTIBYTE (file) ? ENCODE_FILE (file) : file;
527 encoded_dir = ENCODE_FILE (dirname);
529 BLOCK_INPUT;
530 d = opendir (SDATA (Fdirectory_file_name (encoded_dir)));
531 UNBLOCK_INPUT;
532 if (!d)
533 report_file_error ("Opening directory", Fcons (dirname, Qnil));
535 record_unwind_protect (directory_files_internal_unwind,
536 make_save_value (d, 0));
538 /* Loop reading blocks */
539 /* (att3b compiler bug requires do a null comparison this way) */
540 while (1)
542 DIRENTRY *dp;
543 int len;
544 int canexclude = 0;
546 errno = 0;
547 dp = readdir (d);
548 if (dp == NULL && (0
549 # ifdef EAGAIN
550 || errno == EAGAIN
551 # endif
552 # ifdef EINTR
553 || errno == EINTR
554 # endif
556 { QUIT; continue; }
558 if (!dp) break;
560 len = NAMLEN (dp);
562 QUIT;
563 if (! DIRENTRY_NONEMPTY (dp)
564 || len < SCHARS (encoded_file)
565 || 0 <= scmp (dp->d_name, SDATA (encoded_file),
566 SCHARS (encoded_file)))
567 continue;
569 if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
570 continue;
572 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
573 tem = Qnil;
574 /* If all_flag is set, always include all.
575 It would not actually be helpful to the user to ignore any possible
576 completions when making a list of them. */
577 if (!all_flag)
579 int skip;
581 #if 0 /* FIXME: The `scmp' call compares an encoded and a decoded string. */
582 /* If this entry matches the current bestmatch, the only
583 thing it can do is increase matchcount, so don't bother
584 investigating it any further. */
585 if (!completion_ignore_case
586 /* The return result depends on whether it's the sole match. */
587 && matchcount > 1
588 && !includeall /* This match may allow includeall to 0. */
589 && len >= bestmatchsize
590 && 0 > scmp (dp->d_name, SDATA (bestmatch), bestmatchsize))
591 continue;
592 #endif
594 if (directoryp)
596 #ifndef TRIVIAL_DIRECTORY_ENTRY
597 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
598 #endif
599 /* "." and ".." are never interesting as completions, and are
600 actually in the way in a directory with only one file. */
601 if (TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
602 canexclude = 1;
603 else if (len > SCHARS (encoded_file))
604 /* Ignore directories if they match an element of
605 completion-ignored-extensions which ends in a slash. */
606 for (tem = Vcompletion_ignored_extensions;
607 CONSP (tem); tem = XCDR (tem))
609 int elt_len;
610 unsigned char *p1;
612 elt = XCAR (tem);
613 if (!STRINGP (elt))
614 continue;
615 /* Need to encode ELT, since scmp compares unibyte
616 strings only. */
617 elt = ENCODE_FILE (elt);
618 elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
619 if (elt_len <= 0)
620 continue;
621 p1 = SDATA (elt);
622 if (p1[elt_len] != '/')
623 continue;
624 skip = len - elt_len;
625 if (skip < 0)
626 continue;
628 if (0 <= scmp (dp->d_name + skip, p1, elt_len))
629 continue;
630 break;
633 else
635 /* Compare extensions-to-be-ignored against end of this file name */
636 /* if name is not an exact match against specified string */
637 if (len > SCHARS (encoded_file))
638 /* and exit this for loop if a match is found */
639 for (tem = Vcompletion_ignored_extensions;
640 CONSP (tem); tem = XCDR (tem))
642 elt = XCAR (tem);
643 if (!STRINGP (elt)) continue;
644 /* Need to encode ELT, since scmp compares unibyte
645 strings only. */
646 elt = ENCODE_FILE (elt);
647 skip = len - SCHARS (elt);
648 if (skip < 0) continue;
650 if (0 <= scmp (dp->d_name + skip,
651 SDATA (elt),
652 SCHARS (elt)))
653 continue;
654 break;
658 /* If an ignored-extensions match was found,
659 don't process this name as a completion. */
660 if (CONSP (tem))
661 canexclude = 1;
663 if (!includeall && canexclude)
664 /* We're not including all files and this file can be excluded. */
665 continue;
667 if (includeall && !canexclude)
668 { /* If we have one non-excludable file, we want to exclude the
669 excudable files. */
670 includeall = 0;
671 /* Throw away any previous excludable match found. */
672 bestmatch = Qnil;
673 bestmatchsize = 0;
674 matchcount = 0;
677 /* FIXME: If we move this `decode' earlier we can eliminate
678 the repeated ENCODE_FILE on Vcompletion_ignored_extensions. */
679 name = make_unibyte_string (dp->d_name, len);
680 name = DECODE_FILE (name);
683 Lisp_Object regexps;
684 Lisp_Object zero;
685 XSETFASTINT (zero, 0);
687 /* Ignore this element if it fails to match all the regexps. */
688 if (completion_ignore_case)
690 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
691 regexps = XCDR (regexps))
692 if (fast_string_match_ignore_case (XCAR (regexps), name) < 0)
693 break;
695 else
697 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
698 regexps = XCDR (regexps))
699 if (fast_string_match (XCAR (regexps), name) < 0)
700 break;
703 if (CONSP (regexps))
704 continue;
707 /* This is a possible completion */
708 if (directoryp)
709 /* This completion is a directory; make it end with '/'. */
710 name = Ffile_name_as_directory (name);
712 /* Test the predicate, if any. */
713 if (!NILP (predicate))
715 Lisp_Object val;
716 struct gcpro gcpro1;
718 GCPRO1 (name);
719 val = call1 (predicate, name);
720 UNGCPRO;
722 if (NILP (val))
723 continue;
726 /* Suitably record this match. */
728 matchcount++;
730 if (all_flag)
731 bestmatch = Fcons (name, bestmatch);
732 else if (NILP (bestmatch))
734 bestmatch = name;
735 bestmatchsize = SCHARS (name);
737 else
739 Lisp_Object zero = make_number (0);
740 /* FIXME: This is a copy of the code in Ftry_completion. */
741 int compare = min (bestmatchsize, SCHARS (name));
742 Lisp_Object tem
743 = Fcompare_strings (bestmatch, zero,
744 make_number (compare),
745 name, zero,
746 make_number (compare),
747 completion_ignore_case ? Qt : Qnil);
748 int matchsize
749 = (EQ (tem, Qt) ? compare
750 : XINT (tem) < 0 ? - XINT (tem) - 1
751 : XINT (tem) - 1);
753 if (completion_ignore_case)
755 /* If this is an exact match except for case,
756 use it as the best match rather than one that is not
757 an exact match. This way, we get the case pattern
758 of the actual match. */
759 /* This tests that the current file is an exact match
760 but BESTMATCH is not (it is too long). */
761 if ((matchsize == SCHARS (name)
762 && matchsize + !!directoryp < SCHARS (bestmatch))
764 /* If there is no exact match ignoring case,
765 prefer a match that does not change the case
766 of the input. */
767 /* If there is more than one exact match aside from
768 case, and one of them is exact including case,
769 prefer that one. */
770 /* This == checks that, of current file and BESTMATCH,
771 either both or neither are exact. */
772 (((matchsize == SCHARS (name))
774 (matchsize + !!directoryp == SCHARS (bestmatch)))
775 && (tem = Fcompare_strings (name, zero,
776 make_number (SCHARS (file)),
777 file, zero,
778 Qnil,
779 Qnil),
780 EQ (Qt, tem))
781 && (tem = Fcompare_strings (bestmatch, zero,
782 make_number (SCHARS (file)),
783 file, zero,
784 Qnil,
785 Qnil),
786 ! EQ (Qt, tem))))
787 bestmatch = name;
789 bestmatchsize = matchsize;
791 /* If the best completion so far is reduced to the string
792 we're trying to complete, then we already know there's no
793 other completion, so there's no point looking any further. */
794 if (matchsize <= SCHARS (file)
795 && !includeall /* A future match may allow includeall to 0. */
796 /* If completion-ignore-case is non-nil, don't
797 short-circuit because we want to find the best
798 possible match *including* case differences. */
799 && (!completion_ignore_case || matchsize == 0)
800 /* The return value depends on whether it's the sole match. */
801 && matchcount > 1)
802 break;
807 UNGCPRO;
808 /* This closes the directory. */
809 bestmatch = unbind_to (count, bestmatch);
811 if (all_flag || NILP (bestmatch))
812 return bestmatch;
813 /* Return t if the supplied string is an exact match (counting case);
814 it does not require any change to be made. */
815 if (matchcount == 1 && !NILP (Fequal (bestmatch, file)))
816 return Qt;
817 bestmatch = Fsubstring (bestmatch, make_number (0),
818 make_number (bestmatchsize));
819 return bestmatch;
822 /* Compare exactly LEN chars of strings at S1 and S2,
823 ignoring case if appropriate.
824 Return -1 if strings match,
825 else number of chars that match at the beginning. */
827 static int
828 scmp (s1, s2, len)
829 register unsigned char *s1, *s2;
830 int len;
832 register int l = len;
834 if (completion_ignore_case)
836 while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++))
837 l--;
839 else
841 while (l && *s1++ == *s2++)
842 l--;
844 if (l == 0)
845 return -1;
846 else
847 return len - l;
850 static int
851 file_name_completion_stat (dirname, dp, st_addr)
852 Lisp_Object dirname;
853 DIRENTRY *dp;
854 struct stat *st_addr;
856 int len = NAMLEN (dp);
857 int pos = SCHARS (dirname);
858 int value;
859 char *fullname = (char *) alloca (len + pos + 2);
861 #ifdef MSDOS
862 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
863 but aren't required here. Avoid computing the following fields:
864 st_inode, st_size and st_nlink for directories, and the execute bits
865 in st_mode for non-directory files with non-standard extensions. */
867 unsigned short save_djstat_flags = _djstat_flags;
869 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
870 #endif /* MSDOS */
872 bcopy (SDATA (dirname), fullname, pos);
873 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
874 fullname[pos++] = DIRECTORY_SEP;
876 bcopy (dp->d_name, fullname + pos, len);
877 fullname[pos + len] = 0;
879 #ifdef S_IFLNK
880 /* We want to return success if a link points to a nonexistent file,
881 but we want to return the status for what the link points to,
882 in case it is a directory. */
883 value = lstat (fullname, st_addr);
884 stat (fullname, st_addr);
885 return value;
886 #else
887 value = stat (fullname, st_addr);
888 #ifdef MSDOS
889 _djstat_flags = save_djstat_flags;
890 #endif /* MSDOS */
891 return value;
892 #endif /* S_IFLNK */
895 Lisp_Object
896 make_time (time)
897 time_t time;
899 return Fcons (make_number (time >> 16),
900 Fcons (make_number (time & 0177777), Qnil));
903 static char *
904 stat_uname (struct stat *st)
906 #ifdef WINDOWSNT
907 return st->st_uname;
908 #else
909 struct passwd *pw = (struct passwd *) getpwuid (st->st_uid);
911 if (pw)
912 return pw->pw_name;
913 else
914 return NULL;
915 #endif
918 static char *
919 stat_gname (struct stat *st)
921 #ifdef WINDOWSNT
922 return st->st_gname;
923 #else
924 struct group *gr = (struct group *) getgrgid (st->st_gid);
926 if (gr)
927 return gr->gr_name;
928 else
929 return NULL;
930 #endif
933 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
934 doc: /* Return a list of attributes of file FILENAME.
935 Value is nil if specified file cannot be opened.
937 ID-FORMAT specifies the preferred format of attributes uid and gid (see
938 below) - valid values are 'string and 'integer. The latter is the default,
939 but we plan to change that, so you should specify a non-nil value for
940 ID-FORMAT if you use the returned uid or gid.
942 Elements of the attribute list are:
943 0. t for directory, string (name linked to) for symbolic link, or nil.
944 1. Number of links to file.
945 2. File uid as a string or a number. If a string value cannot be
946 looked up, a numeric value, either an integer or a float, is returned.
947 3. File gid, likewise.
948 4. Last access time, as a list of two integers.
949 First integer has high-order 16 bits of time, second has low 16 bits.
950 (See a note below about access time on FAT-based filesystems.)
951 5. Last modification time, likewise. This is the time of the last
952 change to the file's contents.
953 6. Last status change time, likewise. This is the time of last change
954 to the file's attributes: owner and group, access mode bits, etc.
955 7. Size in bytes.
956 This is a floating point number if the size is too large for an integer.
957 8. File modes, as a string of ten letters or dashes as in ls -l.
958 9. t if file's gid would change if file were deleted and recreated.
959 10. inode number. If inode number is larger than what Emacs integer
960 can hold, but still fits into a 32-bit number, this is a cons cell
961 containing two integers: first the high part, then the low 16 bits.
962 If the inode number is wider than 32 bits, this is of the form
963 (HIGH MIDDLE . LOW): first the high 24 bits, then middle 24 bits,
964 and finally the low 16 bits.
965 11. Filesystem device number. If it is larger than what the Emacs
966 integer can hold, this is a cons cell, similar to the inode number.
968 On most filesystems, the combination of the inode and the device
969 number uniquely identifies the file.
971 On MS-Windows, performance depends on `w32-get-true-file-attributes',
972 which see.
974 On some FAT-based filesystems, only the date of last access is recorded,
975 so last access time will always be midnight of that day. */)
976 (filename, id_format)
977 Lisp_Object filename, id_format;
979 Lisp_Object values[12];
980 Lisp_Object encoded;
981 struct stat s;
982 #if defined (BSD4_2) || defined (BSD4_3)
983 Lisp_Object dirname;
984 struct stat sdir;
985 #endif
986 char modes[10];
987 Lisp_Object handler;
988 struct gcpro gcpro1;
989 char *uname = NULL, *gname = NULL;
991 filename = Fexpand_file_name (filename, Qnil);
993 /* If the file name has special constructs in it,
994 call the corresponding file handler. */
995 handler = Ffind_file_name_handler (filename, Qfile_attributes);
996 if (!NILP (handler))
997 { /* Only pass the extra arg if it is used to help backward compatibility
998 with old file handlers which do not implement the new arg. --Stef */
999 if (NILP (id_format))
1000 return call2 (handler, Qfile_attributes, filename);
1001 else
1002 return call3 (handler, Qfile_attributes, filename, id_format);
1005 GCPRO1 (filename);
1006 encoded = ENCODE_FILE (filename);
1007 UNGCPRO;
1009 if (lstat (SDATA (encoded), &s) < 0)
1010 return Qnil;
1012 switch (s.st_mode & S_IFMT)
1014 default:
1015 values[0] = Qnil; break;
1016 case S_IFDIR:
1017 values[0] = Qt; break;
1018 #ifdef S_IFLNK
1019 case S_IFLNK:
1020 values[0] = Ffile_symlink_p (filename); break;
1021 #endif
1023 values[1] = make_number (s.st_nlink);
1025 if (!(NILP (id_format) || EQ (id_format, Qinteger)))
1027 BLOCK_INPUT;
1028 uname = stat_uname (&s);
1029 gname = stat_gname (&s);
1030 UNBLOCK_INPUT;
1032 if (uname)
1033 values[2] = DECODE_SYSTEM (build_string (uname));
1034 else
1035 values[2] = make_fixnum_or_float (s.st_uid);
1036 if (gname)
1037 values[3] = DECODE_SYSTEM (build_string (gname));
1038 else
1039 values[3] = make_fixnum_or_float (s.st_gid);
1041 values[4] = make_time (s.st_atime);
1042 values[5] = make_time (s.st_mtime);
1043 values[6] = make_time (s.st_ctime);
1044 values[7] = make_fixnum_or_float (s.st_size);
1045 /* If the size is negative, and its type is long, convert it back to
1046 positive. */
1047 if (s.st_size < 0 && sizeof (s.st_size) == sizeof (long))
1048 values[7] = make_float ((double) ((unsigned long) s.st_size));
1050 filemodestring (&s, modes);
1051 values[8] = make_string (modes, 10);
1052 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
1053 dirname = Ffile_name_directory (filename);
1054 if (! NILP (dirname))
1055 encoded = ENCODE_FILE (dirname);
1056 if (! NILP (dirname) && stat (SDATA (encoded), &sdir) == 0)
1057 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
1058 else /* if we can't tell, assume worst */
1059 values[9] = Qt;
1060 #else /* file gid will be egid */
1061 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
1062 #endif /* BSD4_2 (or BSD4_3) */
1063 if (!FIXNUM_OVERFLOW_P (s.st_ino))
1064 /* Keep the most common cases as integers. */
1065 values[10] = make_number (s.st_ino);
1066 else if (!FIXNUM_OVERFLOW_P (s.st_ino >> 16))
1067 /* To allow inode numbers larger than VALBITS, separate the bottom
1068 16 bits. */
1069 values[10] = Fcons (make_number ((EMACS_INT)(s.st_ino >> 16)),
1070 make_number ((EMACS_INT)(s.st_ino & 0xffff)));
1071 else
1073 /* To allow inode numbers beyond 32 bits, separate into 2 24-bit
1074 high parts and a 16-bit bottom part.
1075 The code on the next line avoids a compiler warning on
1076 systems where st_ino is 32 bit wide. (bug#766). */
1077 EMACS_INT high_ino = s.st_ino >> 31 >> 1;
1078 EMACS_INT low_ino = s.st_ino & 0xffffffff;
1080 values[10] = Fcons (make_number (high_ino >> 8),
1081 Fcons (make_number (((high_ino & 0xff) << 16)
1082 + (low_ino >> 16)),
1083 make_number (low_ino & 0xffff)));
1086 /* Likewise for device. */
1087 if (FIXNUM_OVERFLOW_P (s.st_dev))
1088 values[11] = Fcons (make_number (s.st_dev >> 16),
1089 make_number (s.st_dev & 0xffff));
1090 else
1091 values[11] = make_number (s.st_dev);
1093 return Flist (sizeof(values) / sizeof(values[0]), values);
1096 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
1097 doc: /* Return t if first arg file attributes list is less than second.
1098 Comparison is in lexicographic order and case is significant. */)
1099 (f1, f2)
1100 Lisp_Object f1, f2;
1102 return Fstring_lessp (Fcar (f1), Fcar (f2));
1105 void
1106 syms_of_dired ()
1108 Qdirectory_files = intern_c_string ("directory-files");
1109 Qdirectory_files_and_attributes = intern_c_string ("directory-files-and-attributes");
1110 Qfile_name_completion = intern_c_string ("file-name-completion");
1111 Qfile_name_all_completions = intern_c_string ("file-name-all-completions");
1112 Qfile_attributes = intern_c_string ("file-attributes");
1113 Qfile_attributes_lessp = intern_c_string ("file-attributes-lessp");
1114 Qdefault_directory = intern_c_string ("default-directory");
1116 staticpro (&Qdirectory_files);
1117 staticpro (&Qdirectory_files_and_attributes);
1118 staticpro (&Qfile_name_completion);
1119 staticpro (&Qfile_name_all_completions);
1120 staticpro (&Qfile_attributes);
1121 staticpro (&Qfile_attributes_lessp);
1122 staticpro (&Qdefault_directory);
1124 defsubr (&Sdirectory_files);
1125 defsubr (&Sdirectory_files_and_attributes);
1126 defsubr (&Sfile_name_completion);
1127 defsubr (&Sfile_name_all_completions);
1128 defsubr (&Sfile_attributes);
1129 defsubr (&Sfile_attributes_lessp);
1131 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
1132 doc: /* Completion ignores file names ending in any string in this list.
1133 It does not ignore them if all possible completions end in one of
1134 these strings or when displaying a list of completions.
1135 It ignores directory names if they match any string in this list which
1136 ends in a slash. */);
1137 Vcompletion_ignored_extensions = Qnil;
1140 /* arch-tag: 1ac8deca-4d8f-4d41-ade9-089154d98c03
1141 (do not change this comment) */