*** empty log message ***
[bpt/emacs.git] / src / dired.c
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985, 1986, 1993, 1994, 1999 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21
22 #include <config.h>
23
24 #include <stdio.h>
25 #include <sys/types.h>
26 #include <sys/stat.h>
27
28 #include "systime.h"
29
30 #ifdef VMS
31 #include <string.h>
32 #include <rms.h>
33 #include <rmsdef.h>
34 #endif
35
36 #ifdef HAVE_UNISTD_H
37 #include <unistd.h>
38 #endif
39
40 /* The d_nameln member of a struct dirent includes the '\0' character
41 on some systems, but not on others. What's worse, you can't tell
42 at compile-time which one it will be, since it really depends on
43 the sort of system providing the filesystem you're reading from,
44 not the system you are running on. Paul Eggert
45 <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
46 SunOS 4.1.2 host, reading a directory that is remote-mounted from a
47 Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
48
49 Since applying strlen to the name always works, we'll just do that. */
50 #define NAMLEN(p) strlen (p->d_name)
51
52 #ifdef SYSV_SYSTEM_DIR
53
54 #include <dirent.h>
55 #define DIRENTRY struct dirent
56
57 #else /* not SYSV_SYSTEM_DIR */
58
59 #ifdef NONSYSTEM_DIR_LIBRARY
60 #include "ndir.h"
61 #else /* not NONSYSTEM_DIR_LIBRARY */
62 #ifdef MSDOS
63 #include <dirent.h>
64 #else
65 #include <sys/dir.h>
66 #endif
67 #endif /* not NONSYSTEM_DIR_LIBRARY */
68
69 #include <sys/stat.h>
70
71 #ifndef MSDOS
72 #define DIRENTRY struct direct
73
74 extern DIR *opendir ();
75 extern struct direct *readdir ();
76
77 #endif /* not MSDOS */
78 #endif /* not SYSV_SYSTEM_DIR */
79
80 #ifdef MSDOS
81 #define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
82 #else
83 #define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
84 #endif
85
86 #include "lisp.h"
87 #include "buffer.h"
88 #include "commands.h"
89 #include "charset.h"
90 #include "coding.h"
91 #include "regex.h"
92
93 /* Returns a search buffer, with a fastmap allocated and ready to go. */
94 extern struct re_pattern_buffer *compile_pattern ();
95
96 /* From filemode.c. Can't go in Lisp.h because of `stat'. */
97 extern void filemodestring P_ ((struct stat *, char *));
98
99 #define min(a, b) ((a) < (b) ? (a) : (b))
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 \f
121 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
122 When ATTRS is zero, return a list of directory filenames; when
123 non-zero, return a list of directory filenames and their attributes. */
124 Lisp_Object
125 directory_files_internal (directory, full, match, nosort, attrs)
126 Lisp_Object directory, full, match, nosort;
127 int attrs;
128 {
129 DIR *d;
130 int dirnamelen;
131 Lisp_Object list, name, dirfilename;
132 Lisp_Object encoded_directory;
133 Lisp_Object handler;
134 struct re_pattern_buffer *bufp = NULL;
135 int needsep = 0;
136 struct gcpro gcpro1, gcpro2;
137
138 /* Because of file name handlers, these functions might call
139 Ffuncall, and cause a GC. */
140 GCPRO1 (match);
141 directory = Fexpand_file_name (directory, Qnil);
142 UNGCPRO;
143 GCPRO2 (match, directory);
144 dirfilename = Fdirectory_file_name (directory);
145 UNGCPRO;
146
147 if (!NILP (match))
148 {
149 CHECK_STRING (match, 3);
150
151 /* MATCH might be a flawed regular expression. Rather than
152 catching and signaling our own errors, we just call
153 compile_pattern to do the work for us. */
154 /* Pass 1 for the MULTIBYTE arg
155 because we do make multibyte strings if the contents warrant. */
156 #ifdef VMS
157 bufp = compile_pattern (match, 0,
158 buffer_defaults.downcase_table, 0, 1);
159 #else
160 bufp = compile_pattern (match, 0, Qnil, 0, 1);
161 #endif
162 }
163
164 dirfilename = ENCODE_FILE (dirfilename);
165
166 encoded_directory = ENCODE_FILE (directory);
167
168 /* Now *bufp is the compiled form of MATCH; don't call anything
169 which might compile a new regexp until we're done with the loop! */
170
171 /* Do this opendir after anything which might signal an error; if
172 an error is signaled while the directory stream is open, we
173 have to make sure it gets closed, and setting up an
174 unwind_protect to do so would be a pain. */
175 d = opendir (XSTRING (dirfilename)->data);
176 if (! d)
177 report_file_error ("Opening directory", Fcons (directory, Qnil));
178
179 list = Qnil;
180 dirnamelen = STRING_BYTES (XSTRING (directory));
181 re_match_object = Qt;
182
183 /* Decide whether we need to add a directory separator. */
184 #ifndef VMS
185 if (dirnamelen == 0
186 || !IS_ANY_SEP (XSTRING (directory)->data[dirnamelen - 1]))
187 needsep = 1;
188 #endif /* not VMS */
189
190 GCPRO2 (encoded_directory, list);
191
192 /* Loop reading blocks */
193 while (1)
194 {
195 DIRENTRY *dp = readdir (d);
196
197 if (!dp) break;
198 if (DIRENTRY_NONEMPTY (dp))
199 {
200 int len;
201
202 len = NAMLEN (dp);
203 name = DECODE_FILE (make_string (dp->d_name, len));
204 len = STRING_BYTES (XSTRING (name));
205
206 if (NILP (match)
207 || (0 <= re_search (bufp, XSTRING (name)->data, len, 0, len, 0)))
208 {
209 Lisp_Object finalname;
210
211 finalname = name;
212 if (!NILP (full))
213 {
214 int afterdirindex = dirnamelen;
215 int total = len + dirnamelen;
216 int nchars;
217 Lisp_Object fullname;
218
219 fullname = make_uninit_multibyte_string (total + needsep,
220 total + needsep);
221 bcopy (XSTRING (directory)->data, XSTRING (fullname)->data,
222 dirnamelen);
223 if (needsep)
224 XSTRING (fullname)->data[afterdirindex++] = DIRECTORY_SEP;
225 bcopy (XSTRING (name)->data,
226 XSTRING (fullname)->data + afterdirindex, len);
227 nchars = chars_in_text (XSTRING (fullname)->data,
228 afterdirindex + len);
229 XSTRING (fullname)->size = nchars;
230 if (nchars == STRING_BYTES (XSTRING (fullname)))
231 SET_STRING_BYTES (XSTRING (fullname), -1);
232 finalname = fullname;
233 }
234
235 if (attrs)
236 {
237 /* Construct an expanded filename for the directory entry.
238 Use the decoded names for input to Ffile_attributes. */
239 Lisp_Object decoded_fullname;
240 Lisp_Object fileattrs;
241
242 decoded_fullname = Fexpand_file_name (name, directory);
243 fileattrs = Ffile_attributes (decoded_fullname);
244
245 list = Fcons (Fcons (finalname, fileattrs), list);
246 }
247 else
248 {
249 list = Fcons (finalname, list);
250 }
251 }
252 }
253 }
254 closedir (d);
255 UNGCPRO;
256 if (!NILP (nosort))
257 return list;
258 if (attrs)
259 return Fsort (Fnreverse (list), Qfile_attributes_lessp);
260 else
261 return Fsort (Fnreverse (list), Qstring_lessp);
262 }
263
264
265 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
266 "Return a list of names of files in DIRECTORY.\n\
267 There are three optional arguments:\n\
268 If FULL is non-nil, return absolute file names. Otherwise return names\n\
269 that are relative to the specified directory.\n\
270 If MATCH is non-nil, mention only file names that match the regexp MATCH.\n\
271 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
272 NOSORT is useful if you plan to sort the result yourself.")
273 (directory, full, match, nosort)
274 Lisp_Object directory, full, match, nosort;
275 {
276 Lisp_Object handler;
277
278 /* If the file name has special constructs in it,
279 call the corresponding file handler. */
280 handler = Ffind_file_name_handler (directory, Qdirectory_files);
281 if (!NILP (handler))
282 {
283 Lisp_Object args[6];
284
285 args[0] = handler;
286 args[1] = Qdirectory_files;
287 args[2] = directory;
288 args[3] = full;
289 args[4] = match;
290 args[5] = nosort;
291 return Ffuncall (6, args);
292 }
293
294 return directory_files_internal (directory, full, match, nosort, 0);
295 }
296
297 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes, Sdirectory_files_and_attributes, 1, 4, 0,
298 "Return a list of names of files and their attributes in DIRECTORY.\n\
299 There are three optional arguments:\n\
300 If FULL is non-nil, return absolute file names. Otherwise return names\n\
301 that are relative to the specified directory.\n\
302 If MATCH is non-nil, mention only file names that match the regexp MATCH.\n\
303 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
304 NOSORT is useful if you plan to sort the result yourself.")
305 (directory, full, match, nosort)
306 Lisp_Object directory, full, match, nosort;
307 {
308 Lisp_Object handler;
309
310 /* If the file name has special constructs in it,
311 call the corresponding file handler. */
312 handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
313 if (!NILP (handler))
314 {
315 Lisp_Object args[6];
316
317 args[0] = handler;
318 args[1] = Qdirectory_files_and_attributes;
319 args[2] = directory;
320 args[3] = full;
321 args[4] = match;
322 args[5] = nosort;
323 return Ffuncall (6, args);
324 }
325
326 return directory_files_internal (directory, full, match, nosort, 1);
327 }
328
329 \f
330 Lisp_Object file_name_completion ();
331
332 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
333 2, 2, 0,
334 "Complete file name FILE in directory DIRECTORY.\n\
335 Returns the longest string\n\
336 common to all file names in DIRECTORY that start with FILE.\n\
337 If there is only one and FILE matches it exactly, returns t.\n\
338 Returns nil if DIR contains no name starting with FILE.")
339 (file, directory)
340 Lisp_Object file, directory;
341 {
342 Lisp_Object handler;
343
344 /* If the directory name has special constructs in it,
345 call the corresponding file handler. */
346 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
347 if (!NILP (handler))
348 return call3 (handler, Qfile_name_completion, file, directory);
349
350 /* If the file name has special constructs in it,
351 call the corresponding file handler. */
352 handler = Ffind_file_name_handler (file, Qfile_name_completion);
353 if (!NILP (handler))
354 return call3 (handler, Qfile_name_completion, file, directory);
355
356 return file_name_completion (file, directory, 0, 0);
357 }
358
359 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
360 Sfile_name_all_completions, 2, 2, 0,
361 "Return a list of all completions of file name FILE in directory DIRECTORY.\n\
362 These are all file names in directory DIRECTORY which begin with FILE.")
363 (file, directory)
364 Lisp_Object file, directory;
365 {
366 Lisp_Object handler;
367
368 /* If the directory name has special constructs in it,
369 call the corresponding file handler. */
370 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
371 if (!NILP (handler))
372 return call3 (handler, Qfile_name_all_completions, file, directory);
373
374 /* If the file name has special constructs in it,
375 call the corresponding file handler. */
376 handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
377 if (!NILP (handler))
378 return call3 (handler, Qfile_name_all_completions, file, directory);
379
380 return file_name_completion (file, directory, 1, 0);
381 }
382
383 static int file_name_completion_stat ();
384
385 Lisp_Object
386 file_name_completion (file, dirname, all_flag, ver_flag)
387 Lisp_Object file, dirname;
388 int all_flag, ver_flag;
389 {
390 DIR *d;
391 DIRENTRY *dp;
392 int bestmatchsize = 0, skip;
393 register int compare, matchsize;
394 unsigned char *p1, *p2;
395 int matchcount = 0;
396 Lisp_Object bestmatch, tem, elt, name;
397 Lisp_Object encoded_file;
398 Lisp_Object encoded_dir;
399 struct stat st;
400 int directoryp;
401 int passcount;
402 int count = specpdl_ptr - specpdl;
403 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
404
405 elt = Qnil;
406
407 #ifdef VMS
408 extern DIRENTRY * readdirver ();
409
410 DIRENTRY *((* readfunc) ());
411
412 /* Filename completion on VMS ignores case, since VMS filesys does. */
413 specbind (Qcompletion_ignore_case, Qt);
414
415 readfunc = readdir;
416 if (ver_flag)
417 readfunc = readdirver;
418 file = Fupcase (file);
419 #else /* not VMS */
420 CHECK_STRING (file, 0);
421 #endif /* not VMS */
422
423 #ifdef FILE_SYSTEM_CASE
424 file = FILE_SYSTEM_CASE (file);
425 #endif
426 bestmatch = Qnil;
427 encoded_file = encoded_dir = Qnil;
428 GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
429 dirname = Fexpand_file_name (dirname, Qnil);
430
431 /* Do completion on the encoded file name
432 because the other names in the directory are (we presume)
433 encoded likewise. We decode the completed string at the end. */
434 encoded_file = ENCODE_FILE (file);
435
436 encoded_dir = ENCODE_FILE (dirname);
437
438 /* With passcount = 0, ignore files that end in an ignored extension.
439 If nothing found then try again with passcount = 1, don't ignore them.
440 If looking for all completions, start with passcount = 1,
441 so always take even the ignored ones.
442
443 ** It would not actually be helpful to the user to ignore any possible
444 completions when making a list of them.** */
445
446 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
447 {
448 d = opendir (XSTRING (Fdirectory_file_name (encoded_dir))->data);
449 if (!d)
450 report_file_error ("Opening directory", Fcons (dirname, Qnil));
451
452 /* Loop reading blocks */
453 /* (att3b compiler bug requires do a null comparison this way) */
454 while (1)
455 {
456 DIRENTRY *dp;
457 int len;
458
459 #ifdef VMS
460 dp = (*readfunc) (d);
461 #else
462 dp = readdir (d);
463 #endif
464 if (!dp) break;
465
466 len = NAMLEN (dp);
467
468 if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
469 goto quit;
470 if (! DIRENTRY_NONEMPTY (dp)
471 || len < XSTRING (encoded_file)->size
472 || 0 <= scmp (dp->d_name, XSTRING (encoded_file)->data,
473 XSTRING (encoded_file)->size))
474 continue;
475
476 if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
477 continue;
478
479 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
480 tem = Qnil;
481 if (directoryp)
482 {
483 #ifndef TRIVIAL_DIRECTORY_ENTRY
484 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
485 #endif
486 /* "." and ".." are never interesting as completions, but are
487 actually in the way in a directory contains only one file. */
488 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
489 continue;
490 }
491 else
492 {
493 /* Compare extensions-to-be-ignored against end of this file name */
494 /* if name is not an exact match against specified string */
495 if (!passcount && len > XSTRING (encoded_file)->size)
496 /* and exit this for loop if a match is found */
497 for (tem = Vcompletion_ignored_extensions;
498 CONSP (tem); tem = XCDR (tem))
499 {
500 elt = XCAR (tem);
501 if (!STRINGP (elt)) continue;
502 skip = len - XSTRING (elt)->size;
503 if (skip < 0) continue;
504
505 if (0 <= scmp (dp->d_name + skip,
506 XSTRING (elt)->data,
507 XSTRING (elt)->size))
508 continue;
509 break;
510 }
511 }
512
513 /* If an ignored-extensions match was found,
514 don't process this name as a completion. */
515 if (!passcount && CONSP (tem))
516 continue;
517
518 if (!passcount)
519 {
520 Lisp_Object regexps;
521 Lisp_Object zero;
522 XSETFASTINT (zero, 0);
523
524 /* Ignore this element if it fails to match all the regexps. */
525 for (regexps = Vcompletion_regexp_list; CONSP (regexps);
526 regexps = XCDR (regexps))
527 {
528 tem = Fstring_match (XCAR (regexps), elt, zero);
529 if (NILP (tem))
530 break;
531 }
532 if (CONSP (regexps))
533 continue;
534 }
535
536 /* Update computation of how much all possible completions match */
537
538 matchcount++;
539
540 if (all_flag || NILP (bestmatch))
541 {
542 /* This is a possible completion */
543 if (directoryp)
544 {
545 /* This completion is a directory; make it end with '/' */
546 name = Ffile_name_as_directory (make_string (dp->d_name, len));
547 }
548 else
549 name = make_string (dp->d_name, len);
550 if (all_flag)
551 {
552 name = DECODE_FILE (name);
553 bestmatch = Fcons (name, bestmatch);
554 }
555 else
556 {
557 bestmatch = name;
558 bestmatchsize = XSTRING (name)->size;
559 }
560 }
561 else
562 {
563 compare = min (bestmatchsize, len);
564 p1 = XSTRING (bestmatch)->data;
565 p2 = (unsigned char *) dp->d_name;
566 matchsize = scmp(p1, p2, compare);
567 if (matchsize < 0)
568 matchsize = compare;
569 if (completion_ignore_case)
570 {
571 /* If this is an exact match except for case,
572 use it as the best match rather than one that is not
573 an exact match. This way, we get the case pattern
574 of the actual match. */
575 /* This tests that the current file is an exact match
576 but BESTMATCH is not (it is too long). */
577 if ((matchsize == len
578 && matchsize + !!directoryp
579 < XSTRING (bestmatch)->size)
580 ||
581 /* If there is no exact match ignoring case,
582 prefer a match that does not change the case
583 of the input. */
584 /* If there is more than one exact match aside from
585 case, and one of them is exact including case,
586 prefer that one. */
587 /* This == checks that, of current file and BESTMATCH,
588 either both or neither are exact. */
589 (((matchsize == len)
590 ==
591 (matchsize + !!directoryp
592 == XSTRING (bestmatch)->size))
593 && !bcmp (p2, XSTRING (encoded_file)->data, XSTRING (encoded_file)->size)
594 && bcmp (p1, XSTRING (encoded_file)->data, XSTRING (encoded_file)->size)))
595 {
596 bestmatch = make_string (dp->d_name, len);
597 if (directoryp)
598 bestmatch = Ffile_name_as_directory (bestmatch);
599 }
600 }
601
602 /* If this dirname all matches, see if implicit following
603 slash does too. */
604 if (directoryp
605 && compare == matchsize
606 && bestmatchsize > matchsize
607 && IS_ANY_SEP (p1[matchsize]))
608 matchsize++;
609 bestmatchsize = matchsize;
610 }
611 }
612 closedir (d);
613 }
614
615 UNGCPRO;
616 bestmatch = unbind_to (count, bestmatch);
617
618 if (all_flag || NILP (bestmatch))
619 {
620 if (STRINGP (bestmatch))
621 bestmatch = DECODE_FILE (bestmatch);
622 return bestmatch;
623 }
624 if (matchcount == 1 && bestmatchsize == XSTRING (file)->size)
625 return Qt;
626 bestmatch = Fsubstring (bestmatch, make_number (0),
627 make_number (bestmatchsize));
628 /* Now that we got the right initial segment of BESTMATCH,
629 decode it from the coding system in use. */
630 bestmatch = DECODE_FILE (bestmatch);
631 return bestmatch;
632
633 quit:
634 if (d) closedir (d);
635 Vquit_flag = Qnil;
636 return Fsignal (Qquit, Qnil);
637 }
638
639 static int
640 file_name_completion_stat (dirname, dp, st_addr)
641 Lisp_Object dirname;
642 DIRENTRY *dp;
643 struct stat *st_addr;
644 {
645 int len = NAMLEN (dp);
646 int pos = XSTRING (dirname)->size;
647 int value;
648 char *fullname = (char *) alloca (len + pos + 2);
649
650 #ifdef MSDOS
651 #if __DJGPP__ > 1
652 /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
653 but aren't required here. Avoid computing the following fields:
654 st_inode, st_size and st_nlink for directories, and the execute bits
655 in st_mode for non-directory files with non-standard extensions. */
656
657 unsigned short save_djstat_flags = _djstat_flags;
658
659 _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
660 #endif /* __DJGPP__ > 1 */
661 #endif /* MSDOS */
662
663 bcopy (XSTRING (dirname)->data, fullname, pos);
664 #ifndef VMS
665 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
666 fullname[pos++] = DIRECTORY_SEP;
667 #endif
668
669 bcopy (dp->d_name, fullname + pos, len);
670 fullname[pos + len] = 0;
671
672 #ifdef S_IFLNK
673 /* We want to return success if a link points to a nonexistent file,
674 but we want to return the status for what the link points to,
675 in case it is a directory. */
676 value = lstat (fullname, st_addr);
677 stat (fullname, st_addr);
678 return value;
679 #else
680 value = stat (fullname, st_addr);
681 #ifdef MSDOS
682 #if __DJGPP__ > 1
683 _djstat_flags = save_djstat_flags;
684 #endif /* __DJGPP__ > 1 */
685 #endif /* MSDOS */
686 return value;
687 #endif /* S_IFLNK */
688 }
689 \f
690 #ifdef VMS
691
692 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
693 Sfile_name_all_versions, 2, 2, 0,
694 "Return a list of all versions of file name FILE in directory DIRECTORY.")
695 (file, directory)
696 Lisp_Object file, directory;
697 {
698 return file_name_completion (file, directory, 1, 1);
699 }
700
701 DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
702 "Return the maximum number of versions allowed for FILE.\n\
703 Returns nil if the file cannot be opened or if there is no version limit.")
704 (filename)
705 Lisp_Object filename;
706 {
707 Lisp_Object retval;
708 struct FAB fab;
709 struct RAB rab;
710 struct XABFHC xabfhc;
711 int status;
712
713 filename = Fexpand_file_name (filename, Qnil);
714 fab = cc$rms_fab;
715 xabfhc = cc$rms_xabfhc;
716 fab.fab$l_fna = XSTRING (filename)->data;
717 fab.fab$b_fns = strlen (fab.fab$l_fna);
718 fab.fab$l_xab = (char *) &xabfhc;
719 status = sys$open (&fab, 0, 0);
720 if (status != RMS$_NORMAL) /* Probably non-existent file */
721 return Qnil;
722 sys$close (&fab, 0, 0);
723 if (xabfhc.xab$w_verlimit == 32767)
724 return Qnil; /* No version limit */
725 else
726 return make_number (xabfhc.xab$w_verlimit);
727 }
728
729 #endif /* VMS */
730 \f
731 Lisp_Object
732 make_time (time)
733 time_t time;
734 {
735 return Fcons (make_number (time >> 16),
736 Fcons (make_number (time & 0177777), Qnil));
737 }
738
739 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
740 "Return a list of attributes of file FILENAME.\n\
741 Value is nil if specified file cannot be opened.\n\
742 Otherwise, list elements are:\n\
743 0. t for directory, string (name linked to) for symbolic link, or nil.\n\
744 1. Number of links to file.\n\
745 2. File uid.\n\
746 3. File gid.\n\
747 4. Last access time, as a list of two integers.\n\
748 First integer has high-order 16 bits of time, second has low 16 bits.\n\
749 5. Last modification time, likewise.\n\
750 6. Last status change time, likewise.\n\
751 7. Size in bytes.\n\
752 This is a floating point number if the size is too large for an integer.\n\
753 8. File modes, as a string of ten letters or dashes as in ls -l.\n\
754 9. t iff file's gid would change if file were deleted and recreated.\n\
755 10. inode number. If inode number is larger than the Emacs integer,\n\
756 this is a cons cell containing two integers: first the high part,\n\
757 then the low 16 bits.\n\
758 11. Device number.\n\
759 \n\
760 If file does not exist, returns nil.")
761 (filename)
762 Lisp_Object filename;
763 {
764 Lisp_Object values[12];
765 Lisp_Object dirname;
766 Lisp_Object encoded;
767 struct stat s;
768 struct stat sdir;
769 char modes[10];
770 Lisp_Object handler;
771
772 filename = Fexpand_file_name (filename, Qnil);
773
774 /* If the file name has special constructs in it,
775 call the corresponding file handler. */
776 handler = Ffind_file_name_handler (filename, Qfile_attributes);
777 if (!NILP (handler))
778 return call2 (handler, Qfile_attributes, filename);
779
780 encoded = ENCODE_FILE (filename);
781
782 if (lstat (XSTRING (encoded)->data, &s) < 0)
783 return Qnil;
784
785 switch (s.st_mode & S_IFMT)
786 {
787 default:
788 values[0] = Qnil; break;
789 case S_IFDIR:
790 values[0] = Qt; break;
791 #ifdef S_IFLNK
792 case S_IFLNK:
793 values[0] = Ffile_symlink_p (filename); break;
794 #endif
795 }
796 values[1] = make_number (s.st_nlink);
797 values[2] = make_number (s.st_uid);
798 values[3] = make_number (s.st_gid);
799 values[4] = make_time (s.st_atime);
800 values[5] = make_time (s.st_mtime);
801 values[6] = make_time (s.st_ctime);
802 values[7] = make_number (s.st_size);
803 /* If the size is out of range for an integer, return a float. */
804 if (XINT (values[7]) != s.st_size)
805 values[7] = make_float ((double)s.st_size);
806 filemodestring (&s, modes);
807 values[8] = make_string (modes, 10);
808 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
809 #define BSD4_2 /* A new meaning to the term `backwards compatibility' */
810 #endif
811 #ifdef BSD4_2 /* file gid will be dir gid */
812 dirname = Ffile_name_directory (filename);
813 if (! NILP (dirname))
814 encoded = ENCODE_FILE (dirname);
815 if (! NILP (dirname) && stat (XSTRING (encoded)->data, &sdir) == 0)
816 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
817 else /* if we can't tell, assume worst */
818 values[9] = Qt;
819 #else /* file gid will be egid */
820 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
821 #endif /* BSD4_2 (or BSD4_3) */
822 #ifdef BSD4_3
823 #undef BSD4_2 /* ok, you can look again without throwing up */
824 #endif
825 /* Cast -1 to avoid warning if int is not as wide as VALBITS. */
826 if (s.st_ino & (((EMACS_INT) (-1)) << VALBITS))
827 /* To allow inode numbers larger than VALBITS, separate the bottom
828 16 bits. */
829 values[10] = Fcons (make_number (s.st_ino >> 16),
830 make_number (s.st_ino & 0xffff));
831 else
832 /* But keep the most common cases as integers. */
833 values[10] = make_number (s.st_ino);
834
835 /* Likewise for device. */
836 if (s.st_dev & (((EMACS_INT) (-1)) << VALBITS))
837 values[11] = Fcons (make_number (s.st_dev >> 16),
838 make_number (s.st_dev & 0xffff));
839 else
840 values[11] = make_number (s.st_dev);
841
842 return Flist (sizeof(values) / sizeof(values[0]), values);
843 }
844
845 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
846 "Return t if first arg file attributes list is less than second.\n\
847 Comparison is in lexicographic order and case is significant.")
848 (f1, f2)
849 Lisp_Object f1, f2;
850 {
851 return Fstring_lessp (Fcar (f1), Fcar (f2));
852 }
853 \f
854 void
855 syms_of_dired ()
856 {
857 Qdirectory_files = intern ("directory-files");
858 Qdirectory_files_and_attributes = intern ("directory-files-and-attributes");
859 Qfile_name_completion = intern ("file-name-completion");
860 Qfile_name_all_completions = intern ("file-name-all-completions");
861 Qfile_attributes = intern ("file-attributes");
862 Qfile_attributes_lessp = intern ("file-attributes-lessp");
863
864 staticpro (&Qdirectory_files);
865 staticpro (&Qdirectory_files_and_attributes);
866 staticpro (&Qfile_name_completion);
867 staticpro (&Qfile_name_all_completions);
868 staticpro (&Qfile_attributes);
869 staticpro (&Qfile_attributes_lessp);
870
871 defsubr (&Sdirectory_files);
872 defsubr (&Sdirectory_files_and_attributes);
873 defsubr (&Sfile_name_completion);
874 #ifdef VMS
875 defsubr (&Sfile_name_all_versions);
876 defsubr (&Sfile_version_limit);
877 #endif /* VMS */
878 defsubr (&Sfile_name_all_completions);
879 defsubr (&Sfile_attributes);
880 defsubr (&Sfile_attributes_lessp);
881
882 #ifdef VMS
883 Qcompletion_ignore_case = intern ("completion-ignore-case");
884 staticpro (&Qcompletion_ignore_case);
885 #endif /* VMS */
886
887 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
888 "*Completion ignores filenames ending in any string in this list.\n\
889 This variable does not affect lists of possible completions,\n\
890 but does affect the commands that actually do completions.");
891 Vcompletion_ignored_extensions = Qnil;
892 }