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