(char-db-feature-domains): Delete `jis/alt' because it has been
[chise/xemacs-chise.git] / 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   /* #### In Matt's code, this was Qt.  Why? */
128   regex_match_object = Qnil;
129   regex_emacs_buffer = current_buffer;
130
131   record_unwind_protect (close_directory_unwind, make_opaque_ptr ((void *)d));
132
133   /* Loop reading blocks */
134   while (1)
135     {
136       DIRENTRY *dp = readdir (d);
137       int len;
138
139       if (!dp)
140         break;
141       len = NAMLEN (dp);
142       if (DIRENTRY_NONEMPTY (dp)
143           && (NILP (match)
144               || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0))))
145         {
146           if (!NILP (files_only))
147             {
148               struct stat st;
149               int dir_p = 0;
150
151               memcpy (statbuf_tail, dp->d_name, len);
152               statbuf_tail[len] = 0;
153
154               if (xemacs_stat (statbuf, &st) == 0
155                   && (st.st_mode & S_IFMT) == S_IFDIR)
156                 dir_p = 1;
157
158               if (EQ (files_only, Qt) && dir_p)
159                 continue;
160               else if (!EQ (files_only, Qt) && !dir_p)
161                 continue;
162             }
163
164           {
165             Lisp_Object name =
166               make_string ((Bufbyte *)dp->d_name, len);
167             if (!NILP (full))
168               name = concat2 (directory, name);
169
170             list = Fcons (name, list);
171           }
172         }
173     }
174   unbind_to (speccount, Qnil);  /* This will close the dir */
175
176   if (NILP (nosort))
177     list = Fsort (Fnreverse (list), Qstring_lessp);
178
179   RETURN_UNGCPRO (list);
180 }
181 \f
182 static Lisp_Object file_name_completion (Lisp_Object file,
183                                          Lisp_Object directory,
184                                          int all_flag, int ver_flag);
185
186 DEFUN ("file-name-completion", Ffile_name_completion, 2, 2, 0, /*
187 Complete file name PARTIAL-FILENAME in directory DIRECTORY.
188 Return the longest prefix common to all file names in DIRECTORY
189 that start with PARTIAL-FILENAME.
190 If there is only one and PARTIAL-FILENAME matches it exactly, return t.
191 Return nil if DIRECTORY contains no name starting with PARTIAL-FILENAME.
192
193 File names which end with any member of `completion-ignored-extensions'
194 are not considered as possible completions for PARTIAL-FILENAME unless
195 there is no other possible completion. `completion-ignored-extensions'
196 is not applied to the names of directories.
197 */
198        (partial_filename, directory))
199 {
200   /* This function can GC.  GC checked 1996.04.06. */
201   Lisp_Object handler;
202
203   /* If the directory name has special constructs in it,
204      call the corresponding file handler.  */
205   handler = Ffind_file_name_handler (directory, Qfile_name_completion);
206   if (!NILP (handler))
207     return call3 (handler, Qfile_name_completion, partial_filename, directory);
208
209   /* If the file name has special constructs in it,
210      call the corresponding file handler.  */
211   handler = Ffind_file_name_handler (partial_filename, Qfile_name_completion);
212   if (!NILP (handler))
213     return call3 (handler, Qfile_name_completion, partial_filename, directory);
214
215   return file_name_completion (partial_filename, directory, 0, 0);
216 }
217
218 DEFUN ("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /*
219 Return a list of all completions of PARTIAL-FILENAME in DIRECTORY.
220 These are all file names in DIRECTORY which begin with PARTIAL-FILENAME.
221 */
222        (partial_filename, 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, partial_filename,
236                   directory);
237
238   return file_name_completion (partial_filename, 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     xemacs_stat (fullname, st_addr);
264 #else
265   value = xemacs_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 WIN32_NATIVE
307   /* Filename completion on Windows ignores case, since Windows
308      filesystems do.  */
309   specbind (Qcompletion_ignore_case, Qt);
310 #endif /* WIN32_NATIVE */
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 \f
509
510 /* The *pwent() functions do not exist on NT.  #### The NT equivalent
511    is NetUserEnum(), and rewriting to use it is not hard.*/
512 #ifndef  WIN32_NATIVE
513
514 static Lisp_Object user_name_completion (Lisp_Object user,
515                                          int all_flag,
516                                          int *uniq);
517
518 DEFUN ("user-name-completion", Fuser_name_completion, 1, 1, 0, /*
519 Complete user name from PARTIAL-USERNAME.
520 Return the longest prefix common to all user names starting with
521 PARTIAL-USERNAME.  If there is only one and PARTIAL-USERNAME matches
522 it exactly, returns t.  Return nil if there is no user name starting
523 with PARTIAL-USERNAME.
524 */
525        (partial_username))
526 {
527   return user_name_completion (partial_username, 0, NULL);
528 }
529
530 DEFUN ("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /*
531 Complete user name from PARTIAL-USERNAME.
532
533 This function is identical to `user-name-completion', except that
534 the cons of the completion and an indication of whether the
535 completion was unique is returned.
536
537 The car of the returned value is the longest prefix common to all user
538 names that start with PARTIAL-USERNAME.  If there is only one and
539 PARTIAL-USERNAME matches it exactly, the car is t.  The car is nil if
540 there is no user name starting with PARTIAL-USERNAME.  The cdr of the
541 result is non-nil if and only if the completion returned in the car
542 was unique.
543 */
544        (partial_username))
545 {
546   int uniq;
547   Lisp_Object completed = user_name_completion (partial_username, 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 user name completions from PARTIAL-USERNAME.
553 These are all the user names which begin with PARTIAL-USERNAME.
554 */
555        (partial_username))
556 {
557   return user_name_completion (partial_username, 1, NULL);
558 }
559
560 struct user_name
561 {
562   Bufbyte *ptr;
563   size_t len;
564 };
565
566 struct user_cache
567 {
568   struct user_name *user_names;
569   int length;
570   int size;
571   EMACS_TIME last_rebuild_time;
572 };
573 static struct user_cache user_cache;
574
575 static void
576 free_user_cache (struct user_cache *cache)
577 {
578   int i;
579   for (i = 0; i < cache->length; i++)
580     xfree (cache->user_names[i].ptr);
581   xfree (cache->user_names);
582   xzero (*cache);
583 }
584
585 static Lisp_Object
586 user_name_completion_unwind (Lisp_Object cache_incomplete_p)
587 {
588   endpwent ();
589   speed_up_interrupts ();
590
591   if (! NILP (XCAR (cache_incomplete_p)))
592     free_user_cache (&user_cache);
593
594   free_cons (XCONS (cache_incomplete_p));
595
596   return Qnil;
597 }
598
599 #define  USER_CACHE_TTL  (24*60*60)  /* Time to live: 1 day, in seconds */
600
601 static Lisp_Object
602 user_name_completion (Lisp_Object user, int all_flag, int *uniq)
603 {
604   /* This function can GC */
605   int matchcount = 0;
606   Lisp_Object bestmatch = Qnil;
607   Charcount bestmatchsize = 0;
608   Charcount user_name_length;
609   EMACS_TIME t;
610   int i;
611   struct gcpro gcpro1, gcpro2;
612
613   GCPRO2 (user, bestmatch);
614
615   CHECK_STRING (user);
616
617   user_name_length = XSTRING_CHAR_LENGTH (user);
618
619   /* Cache user name lookups because it tends to be quite slow.
620    * Rebuild the cache occasionally to catch changes */
621   EMACS_GET_TIME (t);
622   if (user_cache.user_names &&
623       (EMACS_SECS (t) - EMACS_SECS (user_cache.last_rebuild_time)
624        > USER_CACHE_TTL))
625     free_user_cache (&user_cache);
626
627   if (!user_cache.user_names)
628     {
629       struct passwd *pwd;
630       Lisp_Object cache_incomplete_p = noseeum_cons (Qt, Qnil);
631       int speccount = specpdl_depth ();
632
633       slow_down_interrupts ();
634       setpwent ();
635       record_unwind_protect (user_name_completion_unwind, cache_incomplete_p);
636       while ((pwd = getpwent ()))
637         {
638           QUIT;
639           DO_REALLOC (user_cache.user_names, user_cache.size,
640                       user_cache.length + 1, struct user_name);
641           TO_INTERNAL_FORMAT (C_STRING, pwd->pw_name,
642                               MALLOC,
643                               (user_cache.user_names[user_cache.length].ptr,
644                                user_cache.user_names[user_cache.length].len),
645                               Qnative);
646           user_cache.length++;
647         }
648       XCAR (cache_incomplete_p) = Qnil;
649       unbind_to (speccount, Qnil);
650
651       EMACS_GET_TIME (user_cache.last_rebuild_time);
652     }
653
654   for (i = 0; i < user_cache.length; i++)
655     {
656       Bufbyte *u_name = user_cache.user_names[i].ptr;
657       Bytecount len   = user_cache.user_names[i].len;
658       /* scmp() works in chars, not bytes, so we have to compute this: */
659       Charcount cclen = bytecount_to_charcount (u_name, len);
660
661       QUIT;
662
663       if (cclen < user_name_length
664           || 0 <= scmp_1 (u_name, XSTRING_DATA (user), user_name_length, 0))
665         continue;
666
667       matchcount++;    /* count matching completions */
668
669       if (all_flag || NILP (bestmatch))
670         {
671           Lisp_Object name = Qnil;
672           struct gcpro ngcpro1;
673           NGCPRO1 (name);
674           /* This is a possible completion */
675           name = make_string (u_name, len);
676           if (all_flag)
677             {
678               bestmatch = Fcons (name, bestmatch);
679             }
680           else
681             {
682               bestmatch = name;
683               bestmatchsize = XSTRING_CHAR_LENGTH (name);
684             }
685           NUNGCPRO;
686         }
687       else
688         {
689           Charcount compare = min (bestmatchsize, cclen);
690           Bufbyte *p1 = XSTRING_DATA (bestmatch);
691           Bufbyte *p2 = u_name;
692           Charcount matchsize = scmp_1 (p1, p2, compare, 0);
693
694           if (matchsize < 0)
695             matchsize = compare;
696
697           bestmatchsize = matchsize;
698         }
699     }
700
701   UNGCPRO;
702
703   if (uniq)
704     *uniq = (matchcount == 1);
705
706   if (all_flag || NILP (bestmatch))
707     return bestmatch;
708   if (matchcount == 1 && bestmatchsize == user_name_length)
709     return Qt;
710   return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
711 }
712 #endif   /* ! defined WIN32_NATIVE */
713
714 \f
715 Lisp_Object
716 make_directory_hash_table (const char *path)
717 {
718   DIR *d;
719   if ((d = opendir (path)))
720     {
721       DIRENTRY *dp;
722       Lisp_Object hash =
723         make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
724
725       while ((dp = readdir (d)))
726         {
727           Bytecount len = NAMLEN (dp);
728           if (DIRENTRY_NONEMPTY (dp))
729             /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates.  */
730             Fputhash (make_string ((Bufbyte *) dp->d_name, len), Qt, hash);
731         }
732       closedir (d);
733       return hash;
734     }
735   else
736     return Qnil;
737 }
738 \f
739 #if 0
740 /* ... never used ... should use list2 directly anyway ... */
741 /* NOTE: This function can never return a negative value. */
742 Lisp_Object
743 wasteful_word_to_lisp (unsigned int item)
744 {
745   /* Compatibility: in other versions, file-attributes returns a LIST
746      of two 16 bit integers... */
747   Lisp_Object cons = word_to_lisp (item);
748   XCDR (cons) = Fcons (XCDR (cons), Qnil);
749   return cons;
750 }
751 #endif
752
753 DEFUN ("file-attributes", Ffile_attributes, 1, 1, 0, /*
754 Return a list of attributes of file FILENAME.
755 Value is nil if specified file cannot be opened.
756 Otherwise, list elements are:
757  0. t for directory, string (name linked to) for symbolic link, or nil.
758  1. Number of links to file.
759  2. File uid.
760  3. File gid.
761  4. Last access time, as a list of two integers.
762   First integer has high-order 16 bits of time, second has low 16 bits.
763  5. Last modification time, likewise.
764  6. Last status change time, likewise.
765  7. Size in bytes. (-1, if number is out of range).
766  8. File modes, as a string of ten letters or dashes as in ls -l.
767  9. t iff file's gid would change if file were deleted and recreated.
768 10. inode number.
769 11. Device number.
770
771 If file does not exist, returns nil.
772 */
773        (filename))
774 {
775   /* This function can GC. GC checked 1997.06.04. */
776   Lisp_Object values[12];
777   Lisp_Object directory = Qnil;
778   struct stat s;
779   char modes[10];
780   Lisp_Object handler;
781   struct gcpro gcpro1, gcpro2;
782
783   GCPRO2 (filename, directory);
784   filename = Fexpand_file_name (filename, Qnil);
785
786   /* If the file name has special constructs in it,
787      call the corresponding file handler.  */
788   handler = Ffind_file_name_handler (filename, Qfile_attributes);
789   if (!NILP (handler))
790     {
791       UNGCPRO;
792       return call2 (handler, Qfile_attributes, filename);
793     }
794
795   if (lstat ((char *) XSTRING_DATA (filename), &s) < 0)
796     {
797       UNGCPRO;
798       return Qnil;
799     }
800
801 #ifdef BSD4_2
802   directory = Ffile_name_directory (filename);
803 #endif
804
805 #if 0 /* #### shouldn't this apply to WIN32_NATIVE and maybe CYGWIN? */
806   {
807     char *tmpnam = (char *) XSTRING_DATA (Ffile_name_nondirectory (filename));
808     int l = strlen (tmpnam);
809
810     if (l >= 5
811         && S_ISREG (s.st_mode)
812         && (stricmp (&tmpnam[l - 4], ".com") == 0 ||
813             stricmp (&tmpnam[l - 4], ".exe") == 0 ||
814             stricmp (&tmpnam[l - 4], ".bat") == 0))
815       {
816         s.st_mode |= S_IEXEC;
817       }
818   }
819 #endif
820
821   switch (s.st_mode & S_IFMT)
822     {
823     default:
824       values[0] = Qnil;
825       break;
826     case S_IFDIR:
827       values[0] = Qt;
828       break;
829 #ifdef S_IFLNK
830     case S_IFLNK:
831       values[0] = Ffile_symlink_p (filename);
832       break;
833 #endif
834     }
835   values[1] = make_int (s.st_nlink);
836   values[2] = make_int (s.st_uid);
837   values[3] = make_int (s.st_gid);
838   values[4] = make_time (s.st_atime);
839   values[5] = make_time (s.st_mtime);
840   values[6] = make_time (s.st_ctime);
841   values[7] = make_int ((EMACS_INT) s.st_size);
842   /* If the size is out of range, give back -1.  */
843   /* #### Fix when Emacs gets bignums! */
844   if (XINT (values[7]) != s.st_size)
845     values[7] = make_int (-1);
846   filemodestring (&s, modes);
847   values[8] = make_string ((Bufbyte *) modes, 10);
848 #if defined (BSD4_2) || defined (BSD4_3)        /* file gid will be dir gid */
849   {
850     struct stat sdir;
851
852     if (!NILP (directory) && xemacs_stat ((char *) XSTRING_DATA (directory), &sdir) == 0)
853       values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
854     else                        /* if we can't tell, assume worst */
855       values[9] = Qt;
856   }
857 #else                           /* file gid will be egid */
858   values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
859 #endif  /* BSD4_2 or BSD4_3 */
860   values[10] = make_int (s.st_ino);
861   values[11] = make_int (s.st_dev);
862   UNGCPRO;
863   return Flist (countof (values), values);
864 }
865
866 \f
867 /************************************************************************/
868 /*                            initialization                            */
869 /************************************************************************/
870
871 void
872 syms_of_dired (void)
873 {
874   defsymbol (&Qdirectory_files, "directory-files");
875   defsymbol (&Qfile_name_completion, "file-name-completion");
876   defsymbol (&Qfile_name_all_completions, "file-name-all-completions");
877   defsymbol (&Qfile_attributes, "file-attributes");
878
879   DEFSUBR (Fdirectory_files);
880   DEFSUBR (Ffile_name_completion);
881   DEFSUBR (Ffile_name_all_completions);
882 #ifndef  WIN32_NATIVE
883   DEFSUBR (Fuser_name_completion);
884   DEFSUBR (Fuser_name_completion_1);
885   DEFSUBR (Fuser_name_all_completions);
886 #endif
887   DEFSUBR (Ffile_attributes);
888 }
889
890 void
891 vars_of_dired (void)
892 {
893   DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions /*
894 *Completion ignores filenames ending in any string in this list.
895 This variable does not affect lists of possible completions,
896 but does affect the commands that actually do completions.
897 It is used by the function `file-name-completion'.
898 */ );
899   Vcompletion_ignored_extensions = Qnil;
900 }