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