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