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