Mercurial > hg > xemacs-beta

comparison src/dired.c @ 428:3ecd8885ac67 r21-2-22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children 8de8e3f6228a
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
1 /* Lisp functions for making directory listings.
2 Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
3
4 This file is part of XEmacs.
5
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
9 later version.
10
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* Synched up with: FSF 19.30. */
22
23 #include <config.h>
24 #include "lisp.h"
25
26 #include "buffer.h"
27 #include "commands.h"
28 #include "elhash.h"
29 #include "regex.h"
30 #include "opaque.h"
31 #include "sysfile.h"
32 #include "sysdir.h"
33 #include "systime.h"
34 #include "sysdep.h"
35 #include "syspwd.h"
36
37 Lisp_Object Vcompletion_ignored_extensions;
38 Lisp_Object Qdirectory_files;
39 Lisp_Object Qfile_name_completion;
40 Lisp_Object Qfile_name_all_completions;
41 Lisp_Object Qfile_attributes;
42
43 static Lisp_Object
44 close_directory_unwind (Lisp_Object unwind_obj)
45 {
46 DIR *d = (DIR *)get_opaque_ptr (unwind_obj);
47 closedir (d);
48 free_opaque_ptr (unwind_obj);
49 return Qnil;
50 }
51
52 DEFUN ("directory-files", Fdirectory_files, 1, 5, 0, /*
53 Return a list of names of files in DIRECTORY.
54 There are four optional arguments:
55 If FULL is non-nil, absolute pathnames of the files are returned.
56 If MATCH is non-nil, only pathnames containing that regexp are returned.
57 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
58 NOSORT is useful if you plan to sort the result yourself.
59 If FILES-ONLY is the symbol t, then only the "files" in the directory
60 will be returned; subdirectories will be excluded. If FILES-ONLY is not
61 nil and not t, then only the subdirectories will be returned. Otherwise,
62 if FILES-ONLY is nil (the default) then both files and subdirectories will
63 be returned.
64 */
65 (directory, full, match, nosort, files_only))
66 {
67 /* This function can GC */
68 DIR *d;
69 Lisp_Object list = Qnil;
70 Bytecount directorylen;
71 Lisp_Object handler;
72 struct re_pattern_buffer *bufp = NULL;
73 int speccount = specpdl_depth ();
74 char *statbuf, *statbuf_tail;
75
76 struct gcpro gcpro1, gcpro2;
77 GCPRO2 (directory, list);
78
79 /* If the file name has special constructs in it,
80 call the corresponding file handler. */
81 handler = Ffind_file_name_handler (directory, Qdirectory_files);
82 if (!NILP (handler))
83 {
84 UNGCPRO;
85 if (!NILP (files_only))
86 return call6 (handler, Qdirectory_files, directory, full, match,
87 nosort, files_only);
88 else
89 return call5 (handler, Qdirectory_files, directory, full, match,
90 nosort);
91 }
92
93 /* #### why do we do Fexpand_file_name after file handlers here,
94 but earlier everywhere else? */
95 directory = Fexpand_file_name (directory, Qnil);
96 directory = Ffile_name_as_directory (directory);
97 directorylen = XSTRING_LENGTH (directory);
98
99 statbuf = (char *)alloca (directorylen + MAXNAMLEN + 1);
100 memcpy (statbuf, XSTRING_DATA (directory), directorylen);
101 statbuf_tail = statbuf + directorylen;
102
103 /* XEmacs: this should come after Ffile_name_as_directory() to avoid
104 potential regexp cache smashage. It comes before the opendir()
105 because it might signal an error. */
106 if (!NILP (match))
107 {
108 CHECK_STRING (match);
109
110 /* MATCH might be a flawed regular expression. Rather than
111 catching and signalling our own errors, we just call
112 compile_pattern to do the work for us. */
113 bufp = compile_pattern (match, 0, 0, 0, ERROR_ME);
114 }
115
116 /* Now *bufp is the compiled form of MATCH; don't call anything
117 which might compile a new regexp until we're done with the loop! */
118
119 /* Do this opendir after anything which might signal an error.
120 NOTE: the above comment is old; previously, there was no
121 unwind-protection in case of error, but now there is. */
122 d = opendir ((char *) XSTRING_DATA (directory));
123 if (!d)
124 report_file_error ("Opening directory", list1 (directory));
125
126 record_unwind_protect (close_directory_unwind, make_opaque_ptr ((void *)d));
127
128 /* Loop reading blocks */
129 while (1)
130 {
131 DIRENTRY *dp = readdir (d);
132 int len;
133
134 if (!dp)
135 break;
136 len = NAMLEN (dp);
137 if (DIRENTRY_NONEMPTY (dp)
138 && (NILP (match)
139 || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0))))
140 {
141 if (!NILP (files_only))
142 {
143 struct stat st;
144 int dir_p = 0;
145
146 memcpy (statbuf_tail, dp->d_name, len);
147 statbuf_tail[len] = 0;
148
149 if (stat (statbuf, &st) == 0
150 && (st.st_mode & S_IFMT) == S_IFDIR)
151 dir_p = 1;
152
153 if (EQ (files_only, Qt) && dir_p)
154 continue;
155 else if (!EQ (files_only, Qt) && !dir_p)
156 continue;
157 }
158
159 {
160 Lisp_Object name =
161 make_string ((Bufbyte *)dp->d_name, len);
162 if (!NILP (full))
163 name = concat2 (directory, name);
164
165 list = Fcons (name, list);
166 }
167 }
168 }
169 unbind_to (speccount, Qnil); /* This will close the dir */
170
171 if (NILP (nosort))
172 list = Fsort (Fnreverse (list), Qstring_lessp);
173
174 RETURN_UNGCPRO (list);
175 }
176
177 static Lisp_Object file_name_completion (Lisp_Object file,
178 Lisp_Object directory,
179 int all_flag, int ver_flag);
180
181 DEFUN ("file-name-completion", Ffile_name_completion, 2, 2, 0, /*
182 Complete file name FILE in directory DIRECTORY.
183 Returns the longest string common to all filenames in DIRECTORY
184 that start with FILE.
185 If there is only one and FILE matches it exactly, returns t.
186 Returns nil if DIRECTORY contains no name starting with FILE.
187
188 Filenames which end with any member of `completion-ignored-extensions'
189 are not considered as possible completions for FILE unless there is no
190 other possible completion. `completion-ignored-extensions' is not applied
191 to the names of directories.
192 */
193 (file, directory))
194 {
195 /* This function can GC. GC checked 1996.04.06. */
196 Lisp_Object handler;
197
198 /* If the directory name has special constructs in it,
199 call the corresponding file handler. */
200 handler = Ffind_file_name_handler (directory, Qfile_name_completion);
201 if (!NILP (handler))
202 return call3 (handler, Qfile_name_completion, file, directory);
203
204 /* If the file name has special constructs in it,
205 call the corresponding file handler. */
206 handler = Ffind_file_name_handler (file, Qfile_name_completion);
207 if (!NILP (handler))
208 return call3 (handler, Qfile_name_completion, file, directory);
209
210 return file_name_completion (file, directory, 0, 0);
211 }
212
213 DEFUN ("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
214 Return a list of all completions of file name FILE in directory DIRECTORY.
215 These are all file names in directory DIRECTORY which begin with FILE.
216
217 File names which end with any member of `completion-ignored-extensions'
218 are not considered as possible completions for FILE unless there is no
219 other possible completion. `completion-ignored-extensions' is not applied
220 to the names of directories.
221 */
222 (file, directory))
223 {
224 /* This function can GC. GC checked 1997.06.04. */
225 Lisp_Object handler;
226 struct gcpro gcpro1;
227
228 GCPRO1 (directory);
229 directory = Fexpand_file_name (directory, Qnil);
230 /* If the file name has special constructs in it,
231 call the corresponding file handler. */
232 handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
233 UNGCPRO;
234 if (!NILP (handler))
235 return call3 (handler, Qfile_name_all_completions, file,
236 directory);
237
238 return file_name_completion (file, directory, 1, 0);
239 }
240
241 static int
242 file_name_completion_stat (Lisp_Object directory, DIRENTRY *dp,
243 struct stat *st_addr)
244 {
245 Bytecount len = NAMLEN (dp);
246 Bytecount pos = XSTRING_LENGTH (directory);
247 int value;
248 char *fullname = (char *) alloca (len + pos + 2);
249
250 memcpy (fullname, XSTRING_DATA (directory), pos);
251 if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
252 fullname[pos++] = DIRECTORY_SEP;
253
254 memcpy (fullname + pos, dp->d_name, len);
255 fullname[pos + len] = 0;
256
257 #ifdef S_IFLNK
258 /* We want to return success if a link points to a nonexistent file,
259 but we want to return the status for what the link points to,
260 in case it is a directory. */
261 value = lstat (fullname, st_addr);
262 if (S_ISLNK (st_addr->st_mode))
263 stat (fullname, st_addr);
264 #else
265 value = stat (fullname, st_addr);
266 #endif
267 return value;
268 }
269
270 static Lisp_Object
271 file_name_completion_unwind (Lisp_Object locative)
272 {
273 DIR *d;
274 Lisp_Object obj = XCAR (locative);
275
276 if (!NILP (obj))
277 {
278 d = (DIR *)get_opaque_ptr (obj);
279 closedir (d);
280 free_opaque_ptr (obj);
281 }
282 free_cons (XCONS (locative));
283 return Qnil;
284 }
285
286 static Lisp_Object
287 file_name_completion (Lisp_Object file, Lisp_Object directory, int all_flag,
288 int ver_flag)
289 {
290 /* This function can GC */
291 DIR *d = 0;
292 int matchcount = 0;
293 Lisp_Object bestmatch = Qnil;
294 Charcount bestmatchsize = 0;
295 struct stat st;
296 int passcount;
297 int speccount = specpdl_depth ();
298 Charcount file_name_length;
299 Lisp_Object locative;
300 struct gcpro gcpro1, gcpro2, gcpro3;
301
302 GCPRO3 (file, directory, bestmatch);
303
304 CHECK_STRING (file);
305
306 #ifdef WINDOWSNT
307 /* Filename completion on Windows ignores case, since Windows
308 filesystems do. */
309 specbind (Qcompletion_ignore_case, Qt);
310 #endif /* WINDOWSNT */
311
312 #ifdef FILE_SYSTEM_CASE
313 file = FILE_SYSTEM_CASE (file);
314 #endif
315 directory = Fexpand_file_name (directory, Qnil);
316 file_name_length = XSTRING_CHAR_LENGTH (file);
317
318 /* With passcount = 0, ignore files that end in an ignored extension.
319 If nothing found then try again with passcount = 1, don't ignore them.
320 If looking for all completions, start with passcount = 1,
321 so always take even the ignored ones.
322
323 ** It would not actually be helpful to the user to ignore any possible
324 completions when making a list of them.** */
325
326 /* We cannot use close_directory_unwind() because we change the
327 directory. The old code used to just avoid signaling errors, and
328 call closedir, but it was wrong, because it made sane handling of
329 QUIT impossible and, besides, various utility functions like
330 regexp_ignore_completion_p can signal errors. */
331 locative = noseeum_cons (Qnil, Qnil);
332 record_unwind_protect (file_name_completion_unwind, locative);
333
334 for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
335 {
336 d = opendir ((char *) XSTRING_DATA (Fdirectory_file_name (directory)));
337 if (!d)
338 report_file_error ("Opening directory", list1 (directory));
339 XCAR (locative) = make_opaque_ptr ((void *)d);
340
341 /* Loop reading blocks */
342 while (1)
343 {
344 DIRENTRY *dp;
345 Bytecount len;
346 /* scmp() works in characters, not bytes, so we have to compute
347 this value: */
348 Charcount cclen;
349 int directoryp;
350 int ignored_extension_p = 0;
351 Bufbyte *d_name;
352
353 dp = readdir (d);
354 if (!dp) break;
355
356 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
357 d_name = (Bufbyte *) dp->d_name;
358 len = NAMLEN (dp);
359 cclen = bytecount_to_charcount (d_name, len);
360
361 QUIT;
362
363 if (! DIRENTRY_NONEMPTY (dp)
364 || cclen < file_name_length
365 || 0 <= scmp (d_name, XSTRING_DATA (file), file_name_length))
366 continue;
367
368 if (file_name_completion_stat (directory, dp, &st) < 0)
369 continue;
370
371 directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
372 if (directoryp)
373 {
374 #ifndef TRIVIAL_DIRECTORY_ENTRY
375 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
376 #endif
377 /* "." and ".." are never interesting as completions, but are
378 actually in the way in a directory containing only one file. */
379 if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
380 continue;
381 }
382 else
383 {
384 /* Compare extensions-to-be-ignored against end of this file name */
385 /* if name is not an exact match against specified string. */
386 if (!passcount && cclen > file_name_length)
387 {
388 Lisp_Object tem;
389 /* and exit this for loop if a match is found */
390 EXTERNAL_LIST_LOOP (tem, Vcompletion_ignored_extensions)
391 {
392 Lisp_Object elt = XCAR (tem);
393 Charcount skip;
394
395 CHECK_STRING (elt);
396
397 skip = cclen - XSTRING_CHAR_LENGTH (elt);
398 if (skip < 0) continue;
399
400 if (0 > scmp (charptr_n_addr (d_name, skip),
401 XSTRING_DATA (elt),
402 XSTRING_CHAR_LENGTH (elt)))
403 {
404 ignored_extension_p = 1;
405 break;
406 }
407 }
408 }
409 }
410
411 /* If an ignored-extensions match was found,
412 don't process this name as a completion. */
413 if (!passcount && ignored_extension_p)
414 continue;
415
416 if (!passcount && regexp_ignore_completion_p (d_name, Qnil, 0, cclen))
417 continue;
418
419 /* Update computation of how much all possible completions match */
420 matchcount++;
421
422 if (all_flag || NILP (bestmatch))
423 {
424 Lisp_Object name = Qnil;
425 struct gcpro ngcpro1;
426 NGCPRO1 (name);
427 /* This is a possible completion */
428 name = make_string (d_name, len);
429 if (directoryp) /* Completion is a directory; end it with '/' */
430 name = Ffile_name_as_directory (name);
431 if (all_flag)
432 {
433 bestmatch = Fcons (name, bestmatch);
434 }
435 else
436 {
437 bestmatch = name;
438 bestmatchsize = XSTRING_CHAR_LENGTH (name);
439 }
440 NUNGCPRO;
441 }
442 else
443 {
444 Charcount compare = min (bestmatchsize, cclen);
445 Bufbyte *p1 = XSTRING_DATA (bestmatch);
446 Bufbyte *p2 = d_name;
447 Charcount matchsize = scmp (p1, p2, compare);
448
449 if (matchsize < 0)
450 matchsize = compare;
451 if (completion_ignore_case)
452 {
453 /* If this is an exact match except for case,
454 use it as the best match rather than one that is not
455 an exact match. This way, we get the case pattern
456 of the actual match. */
457 if ((matchsize == cclen
458 && matchsize + !!directoryp
459 < XSTRING_CHAR_LENGTH (bestmatch))
460 ||
461 /* If there is no exact match ignoring case,
462 prefer a match that does not change the case
463 of the input. */
464 (((matchsize == cclen)
465 ==
466 (matchsize + !!directoryp
467 == XSTRING_CHAR_LENGTH (bestmatch)))
468 /* If there is more than one exact match aside from
469 case, and one of them is exact including case,
470 prefer that one. */
471 && 0 > scmp_1 (p2, XSTRING_DATA (file),
472 file_name_length, 0)
473 && 0 <= scmp_1 (p1, XSTRING_DATA (file),
474 file_name_length, 0)))
475 {
476 bestmatch = make_string (d_name, len);
477 if (directoryp)
478 bestmatch = Ffile_name_as_directory (bestmatch);
479 }
480 }
481
482 /* If this directory all matches,
483 see if implicit following slash does too. */
484 if (directoryp
485 && compare == matchsize
486 && bestmatchsize > matchsize
487 && IS_ANY_SEP (charptr_emchar_n (p1, matchsize)))
488 matchsize++;
489 bestmatchsize = matchsize;
490 }
491 }
492 closedir (d);
493 free_opaque_ptr (XCAR (locative));
494 XCAR (locative) = Qnil;
495 }
496
497 unbind_to (speccount, Qnil);
498
499 UNGCPRO;
500
501 if (all_flag || NILP (bestmatch))
502 return bestmatch;
503 if (matchcount == 1 && bestmatchsize == file_name_length)
504 return Qt;
505 return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
506 }
507
508
509
510 /* The *pwent() functions do not exist on NT */
511 #ifndef WINDOWSNT
512
513 static Lisp_Object user_name_completion (Lisp_Object user,
514 int all_flag,
515 int *uniq);
516
517 DEFUN ("user-name-completion", Fuser_name_completion, 1, 1, 0, /*
518 Complete user name USER.
519
520 Returns the longest string common to all user names that start
521 with USER. If there is only one and USER matches it exactly,
522 returns t. Returns nil if there is no user name starting with USER.
523 */
524 (user))
525 {
526 return user_name_completion (user, 0, NULL);
527 }
528
529 DEFUN ("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /*
530 Complete user name USER.
531
532 This function is identical to `user-name-completion', except that
533 the cons of the completion and an indication of whether the
534 completion was unique is returned.
535
536 The car of the returned value is the longest string common to all
537 user names that start with USER. If there is only one and USER
538 matches it exactly, the car is t. The car is nil if there is no
539 user name starting with USER. The cdr of the result is non-nil
540 if and only if the completion returned in the car was unique.
541 */
542 (user))
543 {
544 int uniq;
545 Lisp_Object completed;
546
547 completed = user_name_completion (user, 0, &uniq);
548 return Fcons (completed, uniq ? Qt : Qnil);
549 }
550
551 DEFUN ("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
552 Return a list of all completions of user name USER.
553 These are all user names which begin with USER.
554 */
555 (user))
556 {
557 return user_name_completion (user, 1, NULL);
558 }
559
560 struct user_cache {
561 Bufbyte **data;
562 int length;
563 int size;
564 EMACS_TIME last_rebuild_time;
565 };
566 static struct user_cache user_cache;
567
568 static void
569 free_user_cache (struct user_cache *cache)
570 {
571 int i;
572 for (i = 0; i < cache->length; i++)
573 xfree (cache->data[i]);
574 xfree (cache->data);
575 }
576
577 static Lisp_Object
578 user_name_completion_unwind (Lisp_Object locative)
579 {
580 int interrupted = !NILP (XCAR (locative));
581
582 if (interrupted)
583 {
584 endpwent ();
585 speed_up_interrupts ();
586 free_user_cache (&user_cache);
587 }
588 free_cons (XCONS (locative));
589
590 return Qnil;
591 }
592
593 #define USER_CACHE_REBUILD (24*60*60) /* 1 day, in seconds */
594
595 static Lisp_Object
596 user_name_completion (Lisp_Object user, int all_flag, int *uniq)
597 {
598 /* This function can GC */
599 int matchcount = 0;
600 Lisp_Object bestmatch = Qnil;
601 Charcount bestmatchsize = 0;
602 int speccount = specpdl_depth ();
603 Charcount user_name_length;
604 EMACS_TIME t;
605 int i;
606 struct gcpro gcpro1, gcpro2;
607
608 GCPRO2 (user, bestmatch);
609
610 CHECK_STRING (user);
611
612 user_name_length = XSTRING_CHAR_LENGTH (user);
613
614 /* Cache user name lookups because it tends to be quite slow.
615 * Rebuild the cache occasionally to catch changes */
616 EMACS_GET_TIME (t);
617 if (user_cache.data &&
618 (EMACS_SECS (t) - EMACS_SECS (user_cache.last_rebuild_time)
619 > USER_CACHE_REBUILD))
620 {
621 free_user_cache (&user_cache);
622 xzero (user_cache);
623 }
624
625 if (!user_cache.data)
626 {
627 struct passwd *pwd;
628 Lisp_Object locative = noseeum_cons (Qt, Qnil);
629 slow_down_interrupts ();
630 setpwent ();
631 record_unwind_protect (user_name_completion_unwind, locative);
632 while ((pwd = getpwent ()))
633 {
634 Bufbyte *pwuser;
635 QUIT;
636 DO_REALLOC (user_cache.data, user_cache.size,
637 user_cache.length + 1, Bufbyte *);
638 GET_C_CHARPTR_INT_DATA_ALLOCA (pwd->pw_name, FORMAT_OS, pwuser);
639 user_cache.data[user_cache.length++] =
640 (Bufbyte *) xstrdup ((char *) pwuser);
641 }
642 endpwent ();
643 speed_up_interrupts ();
644 XCAR (locative) = Qnil;
645 unbind_to (speccount, Qnil); /* free locative cons */
646 EMACS_GET_TIME (user_cache.last_rebuild_time);
647 }
648
649 for (i = 0; i < user_cache.length; i++)
650 {
651 Bufbyte *u_name = user_cache.data[i];
652 Bytecount len = strlen ((char *) u_name);
653 /* scmp() works in chars, not bytes, so we have to compute this: */
654 Charcount cclen = bytecount_to_charcount (u_name, len);
655
656 QUIT;
657
658 if (cclen < user_name_length
659 || 0 <= scmp_1 (u_name, XSTRING_DATA (user), user_name_length, 0))
660 continue;
661
662 matchcount++; /* count matching completions */
663
664 if (all_flag || NILP (bestmatch))
665 {
666 Lisp_Object name = Qnil;
667 struct gcpro ngcpro1;
668 NGCPRO1 (name);
669 /* This is a possible completion */
670 name = make_string (u_name, len);
671 if (all_flag)
672 {
673 bestmatch = Fcons (name, bestmatch);
674 }
675 else
676 {
677 bestmatch = name;
678 bestmatchsize = XSTRING_CHAR_LENGTH (name);
679 }
680 NUNGCPRO;
681 }
682 else
683 {
684 Charcount compare = min (bestmatchsize, cclen);
685 Bufbyte *p1 = XSTRING_DATA (bestmatch);
686 Bufbyte *p2 = u_name;
687 Charcount matchsize = scmp_1 (p1, p2, compare, 0);
688
689 if (matchsize < 0)
690 matchsize = compare;
691
692 bestmatchsize = matchsize;
693 }
694 }
695
696 UNGCPRO;
697
698 if (uniq)
699 *uniq = (matchcount == 1);
700
701 if (all_flag || NILP (bestmatch))
702 return bestmatch;
703 if (matchcount == 1 && bestmatchsize == user_name_length)
704 return Qt;
705 return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
706 }
707 #endif /* ! defined WINDOWSNT */
708
709
710 Lisp_Object
711 make_directory_hash_table (CONST char *path)
712 {
713 DIR *d;
714 if ((d = opendir (path)))
715 {
716 DIRENTRY *dp;
717 Lisp_Object hash =
718 make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
719
720 while ((dp = readdir (d)))
721 {
722 Bytecount len = NAMLEN (dp);
723 if (DIRENTRY_NONEMPTY (dp))
724 /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */
725 Fputhash (make_string ((Bufbyte *) dp->d_name, len), Qt, hash);
726 }
727 closedir (d);
728 return hash;
729 }
730 else
731 return Qnil;
732 }
733
734 Lisp_Object
735 wasteful_word_to_lisp (unsigned int item)
736 {
737 /* Compatibility: in other versions, file-attributes returns a LIST
738 of two 16 bit integers... */
739 Lisp_Object cons = word_to_lisp (item);
740 XCDR (cons) = Fcons (XCDR (cons), Qnil);
741 return cons;
742 }
743
744 DEFUN ("file-attributes", Ffile_attributes, 1, 1, 0, /*
745 Return a list of attributes of file FILENAME.
746 Value is nil if specified file cannot be opened.
747 Otherwise, list elements are:
748 0. t for directory, string (name linked to) for symbolic link, or nil.
749 1. Number of links to file.
750 2. File uid.
751 3. File gid.
752 4. Last access time, as a list of two integers.
753 First integer has high-order 16 bits of time, second has low 16 bits.
754 5. Last modification time, likewise.
755 6. Last status change time, likewise.
756 7. Size in bytes. (-1, if number is out of range).
757 8. File modes, as a string of ten letters or dashes as in ls -l.
758 9. t iff file's gid would change if file were deleted and recreated.
759 10. inode number.
760 11. Device number.
761
762 If file does not exist, returns nil.
763 */
764 (filename))
765 {
766 /* This function can GC. GC checked 1997.06.04. */
767 Lisp_Object values[12];
768 Lisp_Object directory = Qnil;
769 struct stat s;
770 char modes[10];
771 Lisp_Object handler;
772 struct gcpro gcpro1, gcpro2;
773
774 GCPRO2 (filename, directory);
775 filename = Fexpand_file_name (filename, Qnil);
776
777 /* If the file name has special constructs in it,
778 call the corresponding file handler. */
779 handler = Ffind_file_name_handler (filename, Qfile_attributes);
780 if (!NILP (handler))
781 {
782 UNGCPRO;
783 return call2 (handler, Qfile_attributes, filename);
784 }
785
786 if (lstat ((char *) XSTRING_DATA (filename), &s) < 0)
787 {
788 UNGCPRO;
789 return Qnil;
790 }
791
792 #ifdef BSD4_2
793 directory = Ffile_name_directory (filename);
794 #endif
795
796 #ifdef MSDOS
797 {
798 char *tmpnam = (char *) XSTRING_DATA (Ffile_name_nondirectory (filename));
799 int l = strlen (tmpnam);
800
801 if (l >= 5
802 && S_ISREG (s.st_mode)
803 && (stricmp (&tmpnam[l - 4], ".com") == 0 ||
804 stricmp (&tmpnam[l - 4], ".exe") == 0 ||
805 stricmp (&tmpnam[l - 4], ".bat") == 0))
806 {
807 s.st_mode |= S_IEXEC;
808 }
809 }
810 #endif /* MSDOS */
811
812 switch (s.st_mode & S_IFMT)
813 {
814 default:
815 values[0] = Qnil;
816 break;
817 case S_IFDIR:
818 values[0] = Qt;
819 break;
820 #ifdef S_IFLNK
821 case S_IFLNK:
822 values[0] = Ffile_symlink_p (filename);
823 break;
824 #endif
825 }
826 values[1] = make_int (s.st_nlink);
827 values[2] = make_int (s.st_uid);
828 values[3] = make_int (s.st_gid);
829 values[4] = wasteful_word_to_lisp (s.st_atime);
830 values[5] = wasteful_word_to_lisp (s.st_mtime);
831 values[6] = wasteful_word_to_lisp (s.st_ctime);
832 values[7] = make_int ((EMACS_INT) s.st_size);
833 /* If the size is out of range, give back -1. */
834 /* #### Fix when Emacs gets bignums! */
835 if (XINT (values[7]) != s.st_size)
836 values[7] = make_int (-1);
837 filemodestring (&s, modes);
838 values[8] = make_string ((Bufbyte *) modes, 10);
839 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
840 {
841 struct stat sdir;
842
843 if (!NILP (directory) && stat ((char *) XSTRING_DATA (directory), &sdir) == 0)
844 values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
845 else /* if we can't tell, assume worst */
846 values[9] = Qt;
847 }
848 #else /* file gid will be egid */
849 values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
850 #endif /* BSD4_2 or BSD4_3 */
851 values[10] = make_int (s.st_ino);
852 values[11] = make_int (s.st_dev);
853 UNGCPRO;
854 return Flist (countof (values), values);
855 }
856
857
858 /************************************************************************/
859 /* initialization */
860 /************************************************************************/
861
862 void
863 syms_of_dired (void)
864 {
865 defsymbol (&Qdirectory_files, "directory-files");
866 defsymbol (&Qfile_name_completion, "file-name-completion");
867 defsymbol (&Qfile_name_all_completions, "file-name-all-completions");
868 defsymbol (&Qfile_attributes, "file-attributes");
869
870 DEFSUBR (Fdirectory_files);
871 DEFSUBR (Ffile_name_completion);
872 DEFSUBR (Ffile_name_all_completions);
873 #ifndef WINDOWSNT
874 DEFSUBR (Fuser_name_completion);
875 DEFSUBR (Fuser_name_completion_1);
876 DEFSUBR (Fuser_name_all_completions);
877 #endif
878 DEFSUBR (Ffile_attributes);
879 }
880
881 void
882 vars_of_dired (void)
883 {
884 DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions /*
885 *Completion ignores filenames ending in any string in this list.
886 This variable does not affect lists of possible completions,
887 but does affect the commands that actually do completions.
888 It is used by the functions `file-name-completion' and
889 `file-name-all-completions'.
890 */ );
891 Vcompletion_ignored_extensions = Qnil;
892 }