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