Fix keyboard macro key lookup (Bug#5481).
[emacs.git] / src / dired.c
blob951969be0a4aef2141cc95dc0c91f36c3b6642bc
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 #if __DJGPP__ > 1
863 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
864 but aren't required here. Avoid computing the following fields:
865 st_inode, st_size and st_nlink for directories, and the execute bits
866 in st_mode for non-directory files with non-standard extensions. */
868 unsigned short save_djstat_flags = _djstat_flags;
870 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
871 #endif /* __DJGPP__ > 1 */
872 #endif /* MSDOS */
874 bcopy (SDATA (dirname), fullname, pos);
875 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
876 fullname[pos++] = DIRECTORY_SEP;
878 bcopy (dp->d_name, fullname + pos, len);
879 fullname[pos + len] = 0;
881 #ifdef S_IFLNK
882 /* We want to return success if a link points to a nonexistent file,
883 but we want to return the status for what the link points to,
884 in case it is a directory. */
885 value = lstat (fullname, st_addr);
886 stat (fullname, st_addr);
887 return value;
888 #else
889 value = stat (fullname, st_addr);
890 #ifdef MSDOS
891 #if __DJGPP__ > 1
892 _djstat_flags = save_djstat_flags;
893 #endif /* __DJGPP__ > 1 */
894 #endif /* MSDOS */
895 return value;
896 #endif /* S_IFLNK */
899 Lisp_Object
900 make_time (time)
901 time_t time;
903 return Fcons (make_number (time >> 16),
904 Fcons (make_number (time & 0177777), Qnil));
907 static char *
908 stat_uname (struct stat *st)
910 #ifdef WINDOWSNT
911 return st->st_uname;
912 #else
913 struct passwd *pw = (struct passwd *) getpwuid (st->st_uid);
915 if (pw)
916 return pw->pw_name;
917 else
918 return NULL;
919 #endif
922 static char *
923 stat_gname (struct stat *st)
925 #ifdef WINDOWSNT
926 return st->st_gname;
927 #else
928 struct group *gr = (struct group *) getgrgid (st->st_gid);
930 if (gr)
931 return gr->gr_name;
932 else
933 return NULL;
934 #endif
937 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
938 doc: /* Return a list of attributes of file FILENAME.
939 Value is nil if specified file cannot be opened.
941 ID-FORMAT specifies the preferred format of attributes uid and gid (see
942 below) - valid values are 'string and 'integer. The latter is the default,
943 but we plan to change that, so you should specify a non-nil value for
944 ID-FORMAT if you use the returned uid or gid.
946 Elements of the attribute list are:
947 0. t for directory, string (name linked to) for symbolic link, or nil.
948 1. Number of links to file.
949 2. File uid as a string or a number. If a string value cannot be
950 looked up, a numeric value, either an integer or a float, is returned.
951 3. File gid, likewise.
952 4. Last access time, as a list of two integers.
953 First integer has high-order 16 bits of time, second has low 16 bits.
954 (See a note below about access time on FAT-based filesystems.)
955 5. Last modification time, likewise. This is the time of the last
956 change to the file's contents.
957 6. Last status change time, likewise. This is the time of last change
958 to the file's attributes: owner and group, access mode bits, etc.
959 7. Size in bytes.
960 This is a floating point number if the size is too large for an integer.
961 8. File modes, as a string of ten letters or dashes as in ls -l.
962 9. t if file's gid would change if file were deleted and recreated.
963 10. inode number. If inode number is larger than what Emacs integer
964 can hold, but still fits into a 32-bit number, this is a cons cell
965 containing two integers: first the high part, then the low 16 bits.
966 If the inode number is wider than 32 bits, this is of the form
967 (HIGH MIDDLE . LOW): first the high 24 bits, then middle 24 bits,
968 and finally the low 16 bits.
969 11. Filesystem device number. If it is larger than what the Emacs
970 integer can hold, this is a cons cell, similar to the inode number.
972 On most filesystems, the combination of the inode and the device
973 number uniquely identifies the file.
975 On MS-Windows, performance depends on `w32-get-true-file-attributes',
976 which see.
978 On some FAT-based filesystems, only the date of last access is recorded,
979 so last access time will always be midnight of that day. */)
980 (filename, id_format)
981 Lisp_Object filename, id_format;
983 Lisp_Object values[12];
984 Lisp_Object encoded;
985 struct stat s;
986 #if defined (BSD4_2) || defined (BSD4_3)
987 Lisp_Object dirname;
988 struct stat sdir;
989 #endif
990 char modes[10];
991 Lisp_Object handler;
992 struct gcpro gcpro1;
993 char *uname = NULL, *gname = NULL;
995 filename = Fexpand_file_name (filename, Qnil);
997 /* If the file name has special constructs in it,
998 call the corresponding file handler. */
999 handler = Ffind_file_name_handler (filename, Qfile_attributes);
1000 if (!NILP (handler))
1001 { /* Only pass the extra arg if it is used to help backward compatibility
1002 with old file handlers which do not implement the new arg. --Stef */
1003 if (NILP (id_format))
1004 return call2 (handler, Qfile_attributes, filename);
1005 else
1006 return call3 (handler, Qfile_attributes, filename, id_format);
1009 GCPRO1 (filename);
1010 encoded = ENCODE_FILE (filename);
1011 UNGCPRO;
1013 if (lstat (SDATA (encoded), &s) < 0)
1014 return Qnil;
1016 switch (s.st_mode & S_IFMT)
1018 default:
1019 values[0] = Qnil; break;
1020 case S_IFDIR:
1021 values[0] = Qt; break;
1022 #ifdef S_IFLNK
1023 case S_IFLNK:
1024 values[0] = Ffile_symlink_p (filename); break;
1025 #endif
1027 values[1] = make_number (s.st_nlink);
1029 if (!(NILP (id_format) || EQ (id_format, Qinteger)))
1031 BLOCK_INPUT;
1032 uname = stat_uname (&s);
1033 gname = stat_gname (&s);
1034 UNBLOCK_INPUT;
1036 if (uname)
1037 values[2] = DECODE_SYSTEM (build_string (uname));
1038 else
1039 values[2] = make_fixnum_or_float (s.st_uid);
1040 if (gname)
1041 values[3] = DECODE_SYSTEM (build_string (gname));
1042 else
1043 values[3] = make_fixnum_or_float (s.st_gid);
1045 values[4] = make_time (s.st_atime);
1046 values[5] = make_time (s.st_mtime);
1047 values[6] = make_time (s.st_ctime);
1048 values[7] = make_fixnum_or_float (s.st_size);
1049 /* If the size is negative, and its type is long, convert it back to
1050 positive. */
1051 if (s.st_size < 0 && sizeof (s.st_size) == sizeof (long))
1052 values[7] = make_float ((double) ((unsigned long) s.st_size));
1054 filemodestring (&s, modes);
1055 values[8] = make_string (modes, 10);
1056 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
1057 dirname = Ffile_name_directory (filename);
1058 if (! NILP (dirname))
1059 encoded = ENCODE_FILE (dirname);
1060 if (! NILP (dirname) && stat (SDATA (encoded), &sdir) == 0)
1061 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
1062 else /* if we can't tell, assume worst */
1063 values[9] = Qt;
1064 #else /* file gid will be egid */
1065 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
1066 #endif /* BSD4_2 (or BSD4_3) */
1067 if (!FIXNUM_OVERFLOW_P (s.st_ino))
1068 /* Keep the most common cases as integers. */
1069 values[10] = make_number (s.st_ino);
1070 else if (!FIXNUM_OVERFLOW_P (s.st_ino >> 16))
1071 /* To allow inode numbers larger than VALBITS, separate the bottom
1072 16 bits. */
1073 values[10] = Fcons (make_number ((EMACS_INT)(s.st_ino >> 16)),
1074 make_number ((EMACS_INT)(s.st_ino & 0xffff)));
1075 else
1077 /* To allow inode numbers beyond 32 bits, separate into 2 24-bit
1078 high parts and a 16-bit bottom part.
1079 The code on the next line avoids a compiler warning on
1080 systems where st_ino is 32 bit wide. (bug#766). */
1081 EMACS_INT high_ino = s.st_ino >> 31 >> 1;
1082 EMACS_INT low_ino = s.st_ino & 0xffffffff;
1084 values[10] = Fcons (make_number (high_ino >> 8),
1085 Fcons (make_number (((high_ino & 0xff) << 16)
1086 + (low_ino >> 16)),
1087 make_number (low_ino & 0xffff)));
1090 /* Likewise for device. */
1091 if (FIXNUM_OVERFLOW_P (s.st_dev))
1092 values[11] = Fcons (make_number (s.st_dev >> 16),
1093 make_number (s.st_dev & 0xffff));
1094 else
1095 values[11] = make_number (s.st_dev);
1097 return Flist (sizeof(values) / sizeof(values[0]), values);
1100 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
1101 doc: /* Return t if first arg file attributes list is less than second.
1102 Comparison is in lexicographic order and case is significant. */)
1103 (f1, f2)
1104 Lisp_Object f1, f2;
1106 return Fstring_lessp (Fcar (f1), Fcar (f2));
1109 void
1110 syms_of_dired ()
1112 Qdirectory_files = intern_c_string ("directory-files");
1113 Qdirectory_files_and_attributes = intern_c_string ("directory-files-and-attributes");
1114 Qfile_name_completion = intern_c_string ("file-name-completion");
1115 Qfile_name_all_completions = intern_c_string ("file-name-all-completions");
1116 Qfile_attributes = intern_c_string ("file-attributes");
1117 Qfile_attributes_lessp = intern_c_string ("file-attributes-lessp");
1118 Qdefault_directory = intern_c_string ("default-directory");
1120 staticpro (&Qdirectory_files);
1121 staticpro (&Qdirectory_files_and_attributes);
1122 staticpro (&Qfile_name_completion);
1123 staticpro (&Qfile_name_all_completions);
1124 staticpro (&Qfile_attributes);
1125 staticpro (&Qfile_attributes_lessp);
1126 staticpro (&Qdefault_directory);
1128 defsubr (&Sdirectory_files);
1129 defsubr (&Sdirectory_files_and_attributes);
1130 defsubr (&Sfile_name_completion);
1131 defsubr (&Sfile_name_all_completions);
1132 defsubr (&Sfile_attributes);
1133 defsubr (&Sfile_attributes_lessp);
1135 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
1136 doc: /* Completion ignores file names ending in any string in this list.
1137 It does not ignore them if all possible completions end in one of
1138 these strings or when displaying a list of completions.
1139 It ignores directory names if they match any string in this list which
1140 ends in a slash. */);
1141 Vcompletion_ignored_extensions = Qnil;
1144 /* arch-tag: 1ac8deca-4d8f-4d41-ade9-089154d98c03
1145 (do not change this comment) */