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