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