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