]> code.delx.au - gnu-emacs/blob - src/dired.c
(case table): Do nothing special for i and I.
[gnu-emacs] / src / dired.c
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006 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 2, or (at your option)
10 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; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
21
22
23 #include <config.h>
24
25 #include <stdio.h>
26 #include <sys/types.h>
27 #include <sys/stat.h>
28
29 #ifdef HAVE_PWD_H
30 #include <pwd.h>
31 #endif
32 #ifndef VMS
33 #include <grp.h>
34 #endif
35
36 #include <errno.h>
37
38 #ifdef VMS
39 #include <string.h>
40 #include <rms.h>
41 #include <rmsdef.h>
42 #endif
43
44 #ifdef HAVE_UNISTD_H
45 #include <unistd.h>
46 #endif
47
48 /* The d_nameln member of a struct dirent includes the '\0' character
49 on some systems, but not on others. What's worse, you can't tell
50 at compile-time which one it will be, since it really depends on
51 the sort of system providing the filesystem you're reading from,
52 not the system you are running on. Paul Eggert
53 <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
54 SunOS 4.1.2 host, reading a directory that is remote-mounted from a
55 Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
56
57 Since applying strlen to the name always works, we'll just do that. */
58 #define NAMLEN(p) strlen (p->d_name)
59
60 #ifdef SYSV_SYSTEM_DIR
61
62 #include <dirent.h>
63 #define DIRENTRY struct dirent
64
65 #else /* not SYSV_SYSTEM_DIR */
66
67 #ifdef NONSYSTEM_DIR_LIBRARY
68 #include "ndir.h"
69 #else /* not NONSYSTEM_DIR_LIBRARY */
70 #ifdef MSDOS
71 #include <dirent.h>
72 #else
73 #include <sys/dir.h>
74 #endif
75 #endif /* not NONSYSTEM_DIR_LIBRARY */
76
77 #include <sys/stat.h>
78
79 #ifndef MSDOS
80 #define DIRENTRY struct direct
81
82 extern DIR *opendir ();
83 extern struct direct *readdir ();
84
85 #endif /* not MSDOS */
86 #endif /* not SYSV_SYSTEM_DIR */
87
88 /* Some versions of Cygwin don't have d_ino in `struct dirent'. */
89 #if defined(MSDOS) || defined(__CYGWIN__)
90 #define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
91 #else
92 #define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
93 #endif
94
95 #include "lisp.h"
96 #include "systime.h"
97 #include "buffer.h"
98 #include "commands.h"
99 #include "charset.h"
100 #include "coding.h"
101 #include "regex.h"
102 #include "blockinput.h"
103
104 /* Returns a search buffer, with a fastmap allocated and ready to go. */
105 extern struct re_pattern_buffer *compile_pattern ();
106
107 /* From filemode.c. Can't go in Lisp.h because of `stat'. */
108 extern void filemodestring P_ ((struct stat *, char *));
109
110 /* if system does not have symbolic links, it does not have lstat.
111 In that case, use ordinary stat instead. */
112
113 #ifndef S_IFLNK
114 #define lstat stat
115 #endif
116
117 extern int completion_ignore_case;
118 extern Lisp_Object Vcompletion_regexp_list;
119
120 Lisp_Object Vcompletion_ignored_extensions;
121 Lisp_Object Qcompletion_ignore_case;
122 Lisp_Object Qdirectory_files;
123 Lisp_Object Qdirectory_files_and_attributes;
124 Lisp_Object Qfile_name_completion;
125 Lisp_Object Qfile_name_all_completions;
126 Lisp_Object Qfile_attributes;
127 Lisp_Object Qfile_attributes_lessp;
128
129 static int scmp P_ ((unsigned char *, unsigned char *, int));
130 \f
131
132 Lisp_Object
133 directory_files_internal_unwind (dh)
134 Lisp_Object dh;
135 {
136 DIR *d = (DIR *) XSAVE_VALUE (dh)->pointer;
137 BLOCK_INPUT;
138 closedir (d);
139 UNBLOCK_INPUT;
140 return Qnil;
141 }
142
143 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
144 When ATTRS is zero, return a list of directory filenames; when
145 non-zero, return a list of directory filenames and their attributes.
146 In the latter case, ID_FORMAT is passed to Ffile_attributes. */
147
148 Lisp_Object
149 directory_files_internal (directory, full, match, nosort, attrs, id_format)
150 Lisp_Object directory, full, match, nosort;
151 int attrs;
152 Lisp_Object id_format;
153 {
154 DIR *d;
155 int directory_nbytes;
156 Lisp_Object list, dirfilename, encoded_directory;
157 struct re_pattern_buffer *bufp = NULL;
158 int needsep = 0;
159 int count = SPECPDL_INDEX ();
160 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
161 DIRENTRY *dp;
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 VMS
179 bufp = compile_pattern (match, 0,
180 buffer_defaults.downcase_table, 0, 1);
181 #else /* !VMS */
182 # ifdef WINDOWSNT
183 /* Windows users want case-insensitive wildcards. */
184 bufp = compile_pattern (match, 0,
185 buffer_defaults.case_canon_table, 0, 1);
186 # else /* !WINDOWSNT */
187 bufp = compile_pattern (match, 0, Qnil, 0, 1);
188 # endif /* !WINDOWSNT */
189 #endif /* !VMS */
190 }
191
192 /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
193 run_pre_post_conversion_on_str which calls Lisp directly and
194 indirectly. */
195 dirfilename = ENCODE_FILE (dirfilename);
196 encoded_directory = ENCODE_FILE (directory);
197
198 /* Now *bufp is the compiled form of MATCH; don't call anything
199 which might compile a new regexp until we're done with the loop! */
200
201 BLOCK_INPUT;
202 d = opendir (SDATA (dirfilename));
203 UNBLOCK_INPUT;
204 if (d == NULL)
205 report_file_error ("Opening directory", Fcons (directory, Qnil));
206
207 /* Unfortunately, we can now invoke expand-file-name and
208 file-attributes on filenames, both of which can throw, so we must
209 do a proper unwind-protect. */
210 record_unwind_protect (directory_files_internal_unwind,
211 make_save_value (d, 0));
212
213 directory_nbytes = SBYTES (directory);
214 re_match_object = Qt;
215
216 /* Decide whether we need to add a directory separator. */
217 #ifndef VMS
218 if (directory_nbytes == 0
219 || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
220 needsep = 1;
221 #endif /* not VMS */
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: ENCODE_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 bcopy (SDATA (directory), SDATA (fullname),
279 directory_nbytes);
280
281 if (needsep)
282 SSET (fullname, directory_nbytes, DIRECTORY_SEP);
283
284 bcopy (SDATA (name),
285 SDATA (fullname) + directory_nbytes + needsep,
286 len);
287
288 nchars = chars_in_text (SDATA (fullname), nbytes);
289
290 /* Some bug somewhere. */
291 if (nchars > nbytes)
292 abort ();
293
294 STRING_SET_CHARS (fullname, nchars);
295 if (nchars == nbytes)
296 STRING_SET_UNIBYTE (fullname);
297
298 finalname = fullname;
299 }
300 else
301 finalname = name;
302
303 if (attrs)
304 {
305 /* Construct an expanded filename for the directory entry.
306 Use the decoded names for input to Ffile_attributes. */
307 Lisp_Object decoded_fullname, fileattrs;
308 struct gcpro gcpro1, gcpro2;
309
310 decoded_fullname = fileattrs = Qnil;
311 GCPRO2 (decoded_fullname, fileattrs);
312
313 /* Both Fexpand_file_name and Ffile_attributes can GC. */
314 decoded_fullname = Fexpand_file_name (name, directory);
315 fileattrs = Ffile_attributes (decoded_fullname, id_format);
316
317 list = Fcons (Fcons (finalname, fileattrs), list);
318 UNGCPRO;
319 }
320 else
321 list = Fcons (finalname, list);
322 }
323
324 UNGCPRO;
325 }
326 }
327
328 BLOCK_INPUT;
329 closedir (d);
330 UNBLOCK_INPUT;
331
332 /* Discard the unwind protect. */
333 specpdl_ptr = specpdl + count;
334
335 if (NILP (nosort))
336 list = Fsort (Fnreverse (list),
337 attrs ? Qfile_attributes_lessp : Qstring_lessp);
338
339 RETURN_UNGCPRO (list);
340 }
341
342
343 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
344 doc: /* Return a list of names of files in DIRECTORY.
345 There are three optional arguments:
346 If FULL is non-nil, return absolute file names. Otherwise return names
347 that are relative to the specified directory.
348 If MATCH is non-nil, mention only file names that match the regexp MATCH.
349 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
350 NOSORT is useful if you plan to sort the result yourself. */)
351 (directory, full, match, nosort)
352 Lisp_Object directory, full, match, nosort;
353 {
354 Lisp_Object handler;
355 directory = Fexpand_file_name (directory, Qnil);
356
357 /* If the file name has special constructs in it,
358 call the corresponding file handler. */
359 handler = Ffind_file_name_handler (directory, Qdirectory_files);
360 if (!NILP (handler))
361 return call5 (handler, Qdirectory_files, directory,
362 full, match, nosort);
363
364 return directory_files_internal (directory, full, match, nosort, 0, Qnil);
365 }
366
367 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
368 Sdirectory_files_and_attributes, 1, 5, 0,
369 doc: /* Return a list of names of files and their attributes in DIRECTORY.
370 There are four optional arguments:
371 If FULL is non-nil, return absolute file names. Otherwise return names
372 that are relative to the specified directory.
373 If MATCH is non-nil, mention only file names that match the regexp MATCH.
374 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
375 NOSORT is useful if you plan to sort the result yourself.
376 ID-FORMAT specifies the preferred format of attributes uid and gid, see
377 `file-attributes' for further documentation. */)
378 (directory, full, match, nosort, id_format)
379 Lisp_Object directory, full, match, nosort, id_format;
380 {
381 Lisp_Object handler;
382 directory = Fexpand_file_name (directory, Qnil);
383
384 /* If the file name has special constructs in it,
385 call the corresponding file handler. */
386 handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
387 if (!NILP (handler))
388 return call6 (handler, Qdirectory_files_and_attributes,
389 directory, full, match, nosort, id_format);
390
391 return directory_files_internal (directory, full, match, nosort, 1, id_format);
392 }
393
394 \f
395 Lisp_Object file_name_completion ();
396
397 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
398 2, 2, 0,
399 doc: /* Complete file name FILE in directory DIRECTORY.
400 Returns the longest string
401 common to all file names in DIRECTORY that start with FILE.
402 If there is only one and FILE matches it exactly, returns t.
403 Returns nil if DIRECTORY contains no name starting with FILE.
404
405 This function ignores some of the possible completions as
406 determined by the variable `completion-ignored-extensions', which see. */)
407 (file, directory)
408 Lisp_Object file, directory;
409 {
410 Lisp_Object handler;
411
412 /* If the directory name has special constructs in it,
413 call the corresponding file handler. */
414 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
415 if (!NILP (handler))
416 return call3 (handler, Qfile_name_completion, file, directory);
417
418 /* If the file name has special constructs in it,
419 call the corresponding file handler. */
420 handler = Ffind_file_name_handler (file, Qfile_name_completion);
421 if (!NILP (handler))
422 return call3 (handler, Qfile_name_completion, file, directory);
423
424 return file_name_completion (file, directory, 0, 0);
425 }
426
427 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
428 Sfile_name_all_completions, 2, 2, 0,
429 doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
430 These are all file names in directory DIRECTORY which begin with FILE. */)
431 (file, directory)
432 Lisp_Object file, directory;
433 {
434 Lisp_Object handler;
435
436 /* If the directory name has special constructs in it,
437 call the corresponding file handler. */
438 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
439 if (!NILP (handler))
440 return call3 (handler, Qfile_name_all_completions, file, directory);
441
442 /* If the file name has special constructs in it,
443 call the corresponding file handler. */
444 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
445 if (!NILP (handler))
446 return call3 (handler, Qfile_name_all_completions, file, directory);
447
448 return file_name_completion (file, directory, 1, 0);
449 }
450
451 static int file_name_completion_stat ();
452
453 Lisp_Object
454 file_name_completion (file, dirname, all_flag, ver_flag)
455 Lisp_Object file, dirname;
456 int all_flag, ver_flag;
457 {
458 DIR *d;
459 int bestmatchsize = 0, skip;
460 register int compare, matchsize;
461 unsigned char *p1, *p2;
462 int matchcount = 0;
463 Lisp_Object bestmatch, tem, elt, name;
464 Lisp_Object encoded_file;
465 Lisp_Object encoded_dir;
466 struct stat st;
467 int directoryp;
468 int passcount;
469 int count = SPECPDL_INDEX ();
470 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
471
472 elt = Qnil;
473
474 #ifdef VMS
475 extern DIRENTRY * readdirver ();
476
477 DIRENTRY *((* readfunc) ());
478
479 /* Filename completion on VMS ignores case, since VMS filesys does. */
480 specbind (Qcompletion_ignore_case, Qt);
481
482 readfunc = readdir;
483 if (ver_flag)
484 readfunc = readdirver;
485 file = Fupcase (file);
486 #else /* not VMS */
487 CHECK_STRING (file);
488 #endif /* not VMS */
489
490 #ifdef FILE_SYSTEM_CASE
491 file = FILE_SYSTEM_CASE (file);
492 #endif
493 bestmatch = Qnil;
494 encoded_file = encoded_dir = Qnil;
495 GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
496 dirname = Fexpand_file_name (dirname, Qnil);
497
498 /* Do completion on the encoded file name
499 because the other names in the directory are (we presume)
500 encoded likewise. We decode the completed string at the end. */
501 encoded_file = ENCODE_FILE (file);
502
503 encoded_dir = ENCODE_FILE (dirname);
504
505 /* With passcount = 0, ignore files that end in an ignored extension.
506 If nothing found then try again with passcount = 1, don't ignore them.
507 If looking for all completions, start with passcount = 1,
508 so always take even the ignored ones.
509
510 ** It would not actually be helpful to the user to ignore any possible
511 completions when making a list of them.** */
512
513 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
514 {
515 int inner_count = SPECPDL_INDEX ();
516
517 BLOCK_INPUT;
518 d = opendir (SDATA (Fdirectory_file_name (encoded_dir)));
519 UNBLOCK_INPUT;
520 if (!d)
521 report_file_error ("Opening directory", Fcons (dirname, Qnil));
522
523 record_unwind_protect (directory_files_internal_unwind,
524 make_save_value (d, 0));
525
526 /* Loop reading blocks */
527 /* (att3b compiler bug requires do a null comparison this way) */
528 while (1)
529 {
530 DIRENTRY *dp;
531 int len;
532
533 #ifdef VMS
534 dp = (*readfunc) (d);
535 #else
536 errno = 0;
537 dp = readdir (d);
538 if (dp == NULL && (0
539 # ifdef EAGAIN
540 || errno == EAGAIN
541 # endif
542 # ifdef EINTR
543 || errno == EINTR
544 # endif
545 ))
546 { QUIT; continue; }
547 #endif
548
549 if (!dp) break;
550
551 len = NAMLEN (dp);
552
553 QUIT;
554 if (! DIRENTRY_NONEMPTY (dp)
555 || len < SCHARS (encoded_file)
556 || 0 <= scmp (dp->d_name, SDATA (encoded_file),
557 SCHARS (encoded_file)))
558 continue;
559
560 if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
561 continue;
562
563 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
564 tem = Qnil;
565 if (directoryp)
566 {
567 #ifndef TRIVIAL_DIRECTORY_ENTRY
568 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
569 #endif
570 /* "." and ".." are never interesting as completions, but are
571 actually in the way in a directory contains only one file. */
572 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
573 continue;
574 if (!passcount && len > SCHARS (encoded_file))
575 /* Ignore directories if they match an element of
576 completion-ignored-extensions which ends in a slash. */
577 for (tem = Vcompletion_ignored_extensions;
578 CONSP (tem); tem = XCDR (tem))
579 {
580 int elt_len;
581
582 elt = XCAR (tem);
583 if (!STRINGP (elt))
584 continue;
585 /* Need to encode ELT, since scmp compares unibyte
586 strings only. */
587 elt = ENCODE_FILE (elt);
588 elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
589 if (elt_len <= 0)
590 continue;
591 p1 = SDATA (elt);
592 if (p1[elt_len] != '/')
593 continue;
594 skip = len - elt_len;
595 if (skip < 0)
596 continue;
597
598 if (0 <= scmp (dp->d_name + skip, p1, elt_len))
599 continue;
600 break;
601 }
602 }
603 else
604 {
605 /* Compare extensions-to-be-ignored against end of this file name */
606 /* if name is not an exact match against specified string */
607 if (!passcount && len > SCHARS (encoded_file))
608 /* and exit this for loop if a match is found */
609 for (tem = Vcompletion_ignored_extensions;
610 CONSP (tem); tem = XCDR (tem))
611 {
612 elt = XCAR (tem);
613 if (!STRINGP (elt)) continue;
614 /* Need to encode ELT, since scmp compares unibyte
615 strings only. */
616 elt = ENCODE_FILE (elt);
617 skip = len - SCHARS (elt);
618 if (skip < 0) continue;
619
620 if (0 <= scmp (dp->d_name + skip,
621 SDATA (elt),
622 SCHARS (elt)))
623 continue;
624 break;
625 }
626 }
627
628 /* If an ignored-extensions match was found,
629 don't process this name as a completion. */
630 if (!passcount && CONSP (tem))
631 continue;
632
633 if (!passcount)
634 {
635 Lisp_Object regexps;
636 Lisp_Object zero;
637 XSETFASTINT (zero, 0);
638
639 /* Ignore this element if it fails to match all the regexps. */
640 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
641 regexps = XCDR (regexps))
642 {
643 tem = Fstring_match (XCAR (regexps),
644 make_string (dp->d_name, len), zero);
645 if (NILP (tem))
646 break;
647 }
648 if (CONSP (regexps))
649 continue;
650 }
651
652 /* Update computation of how much all possible completions match */
653
654 matchcount++;
655
656 if (all_flag || NILP (bestmatch))
657 {
658 /* This is a possible completion */
659 if (directoryp)
660 {
661 /* This completion is a directory; make it end with '/' */
662 name = Ffile_name_as_directory (make_string (dp->d_name, len));
663 }
664 else
665 name = make_string (dp->d_name, len);
666 if (all_flag)
667 {
668 name = DECODE_FILE (name);
669 bestmatch = Fcons (name, bestmatch);
670 }
671 else
672 {
673 bestmatch = name;
674 bestmatchsize = SCHARS (name);
675 }
676 }
677 else
678 {
679 compare = min (bestmatchsize, len);
680 p1 = SDATA (bestmatch);
681 p2 = (unsigned char *) dp->d_name;
682 matchsize = scmp(p1, p2, compare);
683 if (matchsize < 0)
684 matchsize = compare;
685 if (completion_ignore_case)
686 {
687 /* If this is an exact match except for case,
688 use it as the best match rather than one that is not
689 an exact match. This way, we get the case pattern
690 of the actual match. */
691 /* This tests that the current file is an exact match
692 but BESTMATCH is not (it is too long). */
693 if ((matchsize == len
694 && matchsize + !!directoryp
695 < SCHARS (bestmatch))
696 ||
697 /* If there is no exact match ignoring case,
698 prefer a match that does not change the case
699 of the input. */
700 /* If there is more than one exact match aside from
701 case, and one of them is exact including case,
702 prefer that one. */
703 /* This == checks that, of current file and BESTMATCH,
704 either both or neither are exact. */
705 (((matchsize == len)
706 ==
707 (matchsize + !!directoryp
708 == SCHARS (bestmatch)))
709 && !bcmp (p2, SDATA (encoded_file), SCHARS (encoded_file))
710 && bcmp (p1, SDATA (encoded_file), SCHARS (encoded_file))))
711 {
712 bestmatch = make_string (dp->d_name, len);
713 if (directoryp)
714 bestmatch = Ffile_name_as_directory (bestmatch);
715 }
716 }
717
718 /* If this dirname all matches, see if implicit following
719 slash does too. */
720 if (directoryp
721 && compare == matchsize
722 && bestmatchsize > matchsize
723 && IS_ANY_SEP (p1[matchsize]))
724 matchsize++;
725 bestmatchsize = matchsize;
726 }
727 }
728 /* This closes the directory. */
729 bestmatch = unbind_to (inner_count, bestmatch);
730 }
731
732 UNGCPRO;
733 bestmatch = unbind_to (count, bestmatch);
734
735 if (all_flag || NILP (bestmatch))
736 {
737 if (STRINGP (bestmatch))
738 bestmatch = DECODE_FILE (bestmatch);
739 return bestmatch;
740 }
741 if (matchcount == 1 && bestmatchsize == SCHARS (file))
742 return Qt;
743 bestmatch = Fsubstring (bestmatch, make_number (0),
744 make_number (bestmatchsize));
745 /* Now that we got the right initial segment of BESTMATCH,
746 decode it from the coding system in use. */
747 bestmatch = DECODE_FILE (bestmatch);
748 return bestmatch;
749 }
750
751 /* Compare exactly LEN chars of strings at S1 and S2,
752 ignoring case if appropriate.
753 Return -1 if strings match,
754 else number of chars that match at the beginning. */
755
756 static int
757 scmp (s1, s2, len)
758 register unsigned char *s1, *s2;
759 int len;
760 {
761 register int l = len;
762
763 if (completion_ignore_case)
764 {
765 while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++))
766 l--;
767 }
768 else
769 {
770 while (l && *s1++ == *s2++)
771 l--;
772 }
773 if (l == 0)
774 return -1;
775 else
776 return len - l;
777 }
778
779 static int
780 file_name_completion_stat (dirname, dp, st_addr)
781 Lisp_Object dirname;
782 DIRENTRY *dp;
783 struct stat *st_addr;
784 {
785 int len = NAMLEN (dp);
786 int pos = SCHARS (dirname);
787 int value;
788 char *fullname = (char *) alloca (len + pos + 2);
789
790 #ifdef MSDOS
791 #if __DJGPP__ > 1
792 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
793 but aren't required here. Avoid computing the following fields:
794 st_inode, st_size and st_nlink for directories, and the execute bits
795 in st_mode for non-directory files with non-standard extensions. */
796
797 unsigned short save_djstat_flags = _djstat_flags;
798
799 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
800 #endif /* __DJGPP__ > 1 */
801 #endif /* MSDOS */
802
803 bcopy (SDATA (dirname), fullname, pos);
804 #ifndef VMS
805 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
806 fullname[pos++] = DIRECTORY_SEP;
807 #endif
808
809 bcopy (dp->d_name, fullname + pos, len);
810 fullname[pos + len] = 0;
811
812 #ifdef S_IFLNK
813 /* We want to return success if a link points to a nonexistent file,
814 but we want to return the status for what the link points to,
815 in case it is a directory. */
816 value = lstat (fullname, st_addr);
817 stat (fullname, st_addr);
818 return value;
819 #else
820 value = stat (fullname, st_addr);
821 #ifdef MSDOS
822 #if __DJGPP__ > 1
823 _djstat_flags = save_djstat_flags;
824 #endif /* __DJGPP__ > 1 */
825 #endif /* MSDOS */
826 return value;
827 #endif /* S_IFLNK */
828 }
829 \f
830 #ifdef VMS
831
832 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
833 Sfile_name_all_versions, 2, 2, 0,
834 doc: /* Return a list of all versions of file name FILE in directory DIRECTORY. */)
835 (file, directory)
836 Lisp_Object file, directory;
837 {
838 return file_name_completion (file, directory, 1, 1);
839 }
840
841 DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
842 doc: /* Return the maximum number of versions allowed for FILE.
843 Returns nil if the file cannot be opened or if there is no version limit. */)
844 (filename)
845 Lisp_Object filename;
846 {
847 Lisp_Object retval;
848 struct FAB fab;
849 struct RAB rab;
850 struct XABFHC xabfhc;
851 int status;
852
853 filename = Fexpand_file_name (filename, Qnil);
854 fab = cc$rms_fab;
855 xabfhc = cc$rms_xabfhc;
856 fab.fab$l_fna = SDATA (filename);
857 fab.fab$b_fns = strlen (fab.fab$l_fna);
858 fab.fab$l_xab = (char *) &xabfhc;
859 status = sys$open (&fab, 0, 0);
860 if (status != RMS$_NORMAL) /* Probably non-existent file */
861 return Qnil;
862 sys$close (&fab, 0, 0);
863 if (xabfhc.xab$w_verlimit == 32767)
864 return Qnil; /* No version limit */
865 else
866 return make_number (xabfhc.xab$w_verlimit);
867 }
868
869 #endif /* VMS */
870 \f
871 Lisp_Object
872 make_time (time)
873 time_t time;
874 {
875 return Fcons (make_number (time >> 16),
876 Fcons (make_number (time & 0177777), Qnil));
877 }
878
879 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
880 doc: /* Return a list of attributes of file FILENAME.
881 Value is nil if specified file cannot be opened.
882
883 ID-FORMAT specifies the preferred format of attributes uid and gid (see
884 below) - valid values are 'string and 'integer. The latter is the default,
885 but we plan to change that, so you should specify a non-nil value for
886 ID-FORMAT if you use the returned uid or gid.
887
888 Elements of the attribute list are:
889 0. t for directory, string (name linked to) for symbolic link, or nil.
890 1. Number of links to file.
891 2. File uid as a string or an integer. If a string value cannot be
892 looked up, the integer value is returned.
893 3. File gid, likewise.
894 4. Last access time, as a list of two integers.
895 First integer has high-order 16 bits of time, second has low 16 bits.
896 5. Last modification time, likewise.
897 6. Last status change time, likewise.
898 7. Size in bytes.
899 This is a floating point number if the size is too large for an integer.
900 8. File modes, as a string of ten letters or dashes as in ls -l.
901 9. t iff file's gid would change if file were deleted and recreated.
902 10. inode number. If inode number is larger than the Emacs integer,
903 this is a cons cell containing two integers: first the high part,
904 then the low 16 bits.
905 11. Device number. If it is larger than the Emacs integer, this is
906 a cons cell, similar to the inode number. */)
907 (filename, id_format)
908 Lisp_Object filename, id_format;
909 {
910 Lisp_Object values[12];
911 Lisp_Object encoded;
912 struct stat s;
913 struct passwd *pw;
914 struct group *gr;
915 #if defined (BSD4_2) || defined (BSD4_3)
916 Lisp_Object dirname;
917 struct stat sdir;
918 #endif
919 char modes[10];
920 Lisp_Object handler;
921 struct gcpro gcpro1;
922
923 filename = Fexpand_file_name (filename, Qnil);
924
925 /* If the file name has special constructs in it,
926 call the corresponding file handler. */
927 handler = Ffind_file_name_handler (filename, Qfile_attributes);
928 if (!NILP (handler))
929 { /* Only pass the extra arg if it is used to help backward compatibility
930 with old file handlers which do not implement the new arg. --Stef */
931 if (NILP (id_format))
932 return call2 (handler, Qfile_attributes, filename);
933 else
934 return call3 (handler, Qfile_attributes, filename, id_format);
935 }
936
937 GCPRO1 (filename);
938 encoded = ENCODE_FILE (filename);
939 UNGCPRO;
940
941 if (lstat (SDATA (encoded), &s) < 0)
942 return Qnil;
943
944 switch (s.st_mode & S_IFMT)
945 {
946 default:
947 values[0] = Qnil; break;
948 case S_IFDIR:
949 values[0] = Qt; break;
950 #ifdef S_IFLNK
951 case S_IFLNK:
952 values[0] = Ffile_symlink_p (filename); break;
953 #endif
954 }
955 values[1] = make_number (s.st_nlink);
956 if (NILP (id_format) || EQ (id_format, Qinteger))
957 {
958 values[2] = make_number (s.st_uid);
959 values[3] = make_number (s.st_gid);
960 }
961 else
962 {
963 BLOCK_INPUT;
964 pw = (struct passwd *) getpwuid (s.st_uid);
965 values[2] = (pw ? build_string (pw->pw_name) : make_number (s.st_uid));
966 gr = (struct group *) getgrgid (s.st_gid);
967 values[3] = (gr ? build_string (gr->gr_name) : make_number (s.st_gid));
968 UNBLOCK_INPUT;
969 }
970 values[4] = make_time (s.st_atime);
971 values[5] = make_time (s.st_mtime);
972 values[6] = make_time (s.st_ctime);
973 values[7] = make_number (s.st_size);
974 /* If the size is out of range for an integer, return a float. */
975 if (XINT (values[7]) != s.st_size)
976 values[7] = make_float ((double)s.st_size);
977 /* If the size is negative, and its type is long, convert it back to
978 positive. */
979 if (s.st_size < 0 && sizeof (s.st_size) == sizeof (long))
980 values[7] = make_float ((double) ((unsigned long) s.st_size));
981
982 filemodestring (&s, modes);
983 values[8] = make_string (modes, 10);
984 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
985 dirname = Ffile_name_directory (filename);
986 if (! NILP (dirname))
987 encoded = ENCODE_FILE (dirname);
988 if (! NILP (dirname) && stat (SDATA (encoded), &sdir) == 0)
989 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
990 else /* if we can't tell, assume worst */
991 values[9] = Qt;
992 #else /* file gid will be egid */
993 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
994 #endif /* BSD4_2 (or BSD4_3) */
995 if (FIXNUM_OVERFLOW_P (s.st_ino))
996 /* To allow inode numbers larger than VALBITS, separate the bottom
997 16 bits. */
998 values[10] = Fcons (make_number (s.st_ino >> 16),
999 make_number (s.st_ino & 0xffff));
1000 else
1001 /* But keep the most common cases as integers. */
1002 values[10] = make_number (s.st_ino);
1003
1004 /* Likewise for device. */
1005 if (FIXNUM_OVERFLOW_P (s.st_dev))
1006 values[11] = Fcons (make_number (s.st_dev >> 16),
1007 make_number (s.st_dev & 0xffff));
1008 else
1009 values[11] = make_number (s.st_dev);
1010
1011 return Flist (sizeof(values) / sizeof(values[0]), values);
1012 }
1013
1014 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
1015 doc: /* Return t if first arg file attributes list is less than second.
1016 Comparison is in lexicographic order and case is significant. */)
1017 (f1, f2)
1018 Lisp_Object f1, f2;
1019 {
1020 return Fstring_lessp (Fcar (f1), Fcar (f2));
1021 }
1022 \f
1023 void
1024 syms_of_dired ()
1025 {
1026 Qdirectory_files = intern ("directory-files");
1027 Qdirectory_files_and_attributes = intern ("directory-files-and-attributes");
1028 Qfile_name_completion = intern ("file-name-completion");
1029 Qfile_name_all_completions = intern ("file-name-all-completions");
1030 Qfile_attributes = intern ("file-attributes");
1031 Qfile_attributes_lessp = intern ("file-attributes-lessp");
1032
1033 staticpro (&Qdirectory_files);
1034 staticpro (&Qdirectory_files_and_attributes);
1035 staticpro (&Qfile_name_completion);
1036 staticpro (&Qfile_name_all_completions);
1037 staticpro (&Qfile_attributes);
1038 staticpro (&Qfile_attributes_lessp);
1039
1040 defsubr (&Sdirectory_files);
1041 defsubr (&Sdirectory_files_and_attributes);
1042 defsubr (&Sfile_name_completion);
1043 #ifdef VMS
1044 defsubr (&Sfile_name_all_versions);
1045 defsubr (&Sfile_version_limit);
1046 #endif /* VMS */
1047 defsubr (&Sfile_name_all_completions);
1048 defsubr (&Sfile_attributes);
1049 defsubr (&Sfile_attributes_lessp);
1050
1051 #ifdef VMS
1052 Qcompletion_ignore_case = intern ("completion-ignore-case");
1053 staticpro (&Qcompletion_ignore_case);
1054 #endif /* VMS */
1055
1056 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
1057 doc: /* Completion ignores file names ending in any string in this list.
1058 It does not ignore them if all possible completions end in one of
1059 these strings or when displaying a list of completions.
1060 It ignores directory names if they match any string in this list which
1061 ends in a slash. */);
1062 Vcompletion_ignored_extensions = Qnil;
1063 }
1064
1065 /* arch-tag: 1ac8deca-4d8f-4d41-ade9-089154d98c03
1066 (do not change this comment) */