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