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