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