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