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