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