git.chise.org Git - chise/xemacs-chise.git.1/blob - 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
  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 \f
  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 (xemacs_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 \f
 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     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 USER.
 520
 521 Returns the longest string common to all user names that start
 522 with USER.  If there is only one and USER matches it exactly,
 523 returns t.  Returns nil if there is no user name starting with USER.
 524 */
 525        (user))
 526 {
 527   return user_name_completion (user, 0, NULL);
 528 }
 529
 530 DEFUN ("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /*
 531 Complete user name USER.
 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 string common to all
 538 user names that start with USER.  If there is only one and USER
 539 matches it exactly, the car is t.  The car is nil if there is no
 540 user name starting with USER.  The cdr of the result is non-nil
 541 if and only if the completion returned in the car was unique.
 542 */
 543        (user))
 544 {
 545   int uniq;
 546   Lisp_Object completed = user_name_completion (user, 0, &uniq);
 547   return Fcons (completed, uniq ? Qt : Qnil);
 548 }
 549
 550 DEFUN ("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /*
 551 Return a list of all completions of user name USER.
 552 These are all user names which begin with USER.
 553 */
 554        (user))
 555 {
 556   return user_name_completion (user, 1, NULL);
 557 }
 558
 559 struct user_name
 560 {
 561   Bufbyte *ptr;
 562   size_t len;
 563 };
 564
 565 struct user_cache
 566 {
 567   struct user_name *user_names;
 568   int length;
 569   int size;
 570   EMACS_TIME last_rebuild_time;
 571 };
 572 static struct user_cache user_cache;
 573
 574 static void
 575 free_user_cache (struct user_cache *cache)
 576 {
 577   int i;
 578   for (i = 0; i < cache->length; i++)
 579     xfree (cache->user_names[i].ptr);
 580   xfree (cache->user_names);
 581   xzero (*cache);
 582 }
 583
 584 static Lisp_Object
 585 user_name_completion_unwind (Lisp_Object cache_incomplete_p)
 586 {
 587   endpwent ();
 588   speed_up_interrupts ();
 589
 590   if (! NILP (XCAR (cache_incomplete_p)))
 591     free_user_cache (&user_cache);
 592
 593   free_cons (XCONS (cache_incomplete_p));
 594
 595   return Qnil;
 596 }
 597
 598 #define  USER_CACHE_TTL  (24*60*60)  /* Time to live: 1 day, in seconds */
 599
 600 static Lisp_Object
 601 user_name_completion (Lisp_Object user, int all_flag, int *uniq)
 602 {
 603   /* This function can GC */
 604   int matchcount = 0;
 605   Lisp_Object bestmatch = Qnil;
 606   Charcount bestmatchsize = 0;
 607   Charcount user_name_length;
 608   EMACS_TIME t;
 609   int i;
 610   struct gcpro gcpro1, gcpro2;
 611
 612   GCPRO2 (user, bestmatch);
 613
 614   CHECK_STRING (user);
 615
 616   user_name_length = XSTRING_CHAR_LENGTH (user);
 617
 618   /* Cache user name lookups because it tends to be quite slow.
 619    * Rebuild the cache occasionally to catch changes */
 620   EMACS_GET_TIME (t);
 621   if (user_cache.user_names &&
 622       (EMACS_SECS (t) - EMACS_SECS (user_cache.last_rebuild_time)
 623        > USER_CACHE_TTL))
 624     free_user_cache (&user_cache);
 625
 626   if (!user_cache.user_names)
 627     {
 628       struct passwd *pwd;
 629       Lisp_Object cache_incomplete_p = noseeum_cons (Qt, Qnil);
 630       int speccount = specpdl_depth ();
 631
 632       slow_down_interrupts ();
 633       setpwent ();
 634       record_unwind_protect (user_name_completion_unwind, cache_incomplete_p);
 635       while ((pwd = getpwent ()))
 636         {
 637           QUIT;
 638           DO_REALLOC (user_cache.user_names, user_cache.size,
 639                       user_cache.length + 1, struct user_name);
 640           TO_INTERNAL_FORMAT (C_STRING, pwd->pw_name,
 641                               MALLOC,
 642                               (user_cache.user_names[user_cache.length].ptr,
 643                                user_cache.user_names[user_cache.length].len),
 644                               Qnative);
 645           user_cache.length++;
 646         }
 647       XCAR (cache_incomplete_p) = Qnil;
 648       unbind_to (speccount, Qnil);
 649
 650       EMACS_GET_TIME (user_cache.last_rebuild_time);
 651     }
 652
 653   for (i = 0; i < user_cache.length; i++)
 654     {
 655       Bufbyte *u_name = user_cache.user_names[i].ptr;
 656       Bytecount len   = user_cache.user_names[i].len;
 657       /* scmp() works in chars, not bytes, so we have to compute this: */
 658       Charcount cclen = bytecount_to_charcount (u_name, len);
 659
 660       QUIT;
 661
 662       if (cclen < user_name_length
 663           || 0 <= scmp_1 (u_name, XSTRING_DATA (user), user_name_length, 0))
 664         continue;
 665
 666       matchcount++;    /* count matching completions */
 667
 668       if (all_flag || NILP (bestmatch))
 669         {
 670           Lisp_Object name = Qnil;
 671           struct gcpro ngcpro1;
 672           NGCPRO1 (name);
 673           /* This is a possible completion */
 674           name = make_string (u_name, len);
 675           if (all_flag)
 676             {
 677               bestmatch = Fcons (name, bestmatch);
 678             }
 679           else
 680             {
 681               bestmatch = name;
 682               bestmatchsize = XSTRING_CHAR_LENGTH (name);
 683             }
 684           NUNGCPRO;
 685         }
 686       else
 687         {
 688           Charcount compare = min (bestmatchsize, cclen);
 689           Bufbyte *p1 = XSTRING_DATA (bestmatch);
 690           Bufbyte *p2 = u_name;
 691           Charcount matchsize = scmp_1 (p1, p2, compare, 0);
 692
 693           if (matchsize < 0)
 694             matchsize = compare;
 695
 696           bestmatchsize = matchsize;
 697         }
 698     }
 699
 700   UNGCPRO;
 701
 702   if (uniq)
 703     *uniq = (matchcount == 1);
 704
 705   if (all_flag || NILP (bestmatch))
 706     return bestmatch;
 707   if (matchcount == 1 && bestmatchsize == user_name_length)
 708     return Qt;
 709   return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize));
 710 }
 711 #endif   /* ! defined WIN32_NATIVE */
 712
 713 \f
 714 Lisp_Object
 715 make_directory_hash_table (const char *path)
 716 {
 717   DIR *d;
 718   if ((d = opendir (path)))
 719     {
 720       DIRENTRY *dp;
 721       Lisp_Object hash =
 722         make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
 723
 724       while ((dp = readdir (d)))
 725         {
 726           Bytecount len = NAMLEN (dp);
 727           if (DIRENTRY_NONEMPTY (dp))
 728             /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates.  */
 729             Fputhash (make_string ((Bufbyte *) dp->d_name, len), Qt, hash);
 730         }
 731       closedir (d);
 732       return hash;
 733     }
 734   else
 735     return Qnil;
 736 }
 737 \f
 738 Lisp_Object
 739 wasteful_word_to_lisp (unsigned int item)
 740 {
 741   /* Compatibility: in other versions, file-attributes returns a LIST
 742      of two 16 bit integers... */
 743   Lisp_Object cons = word_to_lisp (item);
 744   XCDR (cons) = Fcons (XCDR (cons), Qnil);
 745   return cons;
 746 }
 747
 748 DEFUN ("file-attributes", Ffile_attributes, 1, 1, 0, /*
 749 Return a list of attributes of file FILENAME.
 750 Value is nil if specified file cannot be opened.
 751 Otherwise, list elements are:
 752  0. t for directory, string (name linked to) for symbolic link, or nil.
 753  1. Number of links to file.
 754  2. File uid.
 755  3. File gid.
 756  4. Last access time, as a list of two integers.
 757   First integer has high-order 16 bits of time, second has low 16 bits.
 758  5. Last modification time, likewise.
 759  6. Last status change time, likewise.
 760  7. Size in bytes. (-1, if number is out of range).
 761  8. File modes, as a string of ten letters or dashes as in ls -l.
 762  9. t iff file's gid would change if file were deleted and recreated.
 763 10. inode number.
 764 11. Device number.
 765
 766 If file does not exist, returns nil.
 767 */
 768        (filename))
 769 {
 770   /* This function can GC. GC checked 1997.06.04. */
 771   Lisp_Object values[12];
 772   Lisp_Object directory = Qnil;
 773   struct stat s;
 774   char modes[10];
 775   Lisp_Object handler;
 776   struct gcpro gcpro1, gcpro2;
 777
 778   GCPRO2 (filename, directory);
 779   filename = Fexpand_file_name (filename, Qnil);
 780
 781   /* If the file name has special constructs in it,
 782      call the corresponding file handler.  */
 783   handler = Ffind_file_name_handler (filename, Qfile_attributes);
 784   if (!NILP (handler))
 785     {
 786       UNGCPRO;
 787       return call2 (handler, Qfile_attributes, filename);
 788     }
 789
 790   if (lstat ((char *) XSTRING_DATA (filename), &s) < 0)
 791     {
 792       UNGCPRO;
 793       return Qnil;
 794     }
 795
 796 #ifdef BSD4_2
 797   directory = Ffile_name_directory (filename);
 798 #endif
 799
 800 #if 0 /* #### shouldn't this apply to WIN32_NATIVE and maybe CYGWIN? */
 801   {
 802     char *tmpnam = (char *) XSTRING_DATA (Ffile_name_nondirectory (filename));
 803     int l = strlen (tmpnam);
 804
 805     if (l >= 5
 806         && S_ISREG (s.st_mode)
 807         && (stricmp (&tmpnam[l - 4], ".com") == 0 ||
 808             stricmp (&tmpnam[l - 4], ".exe") == 0 ||
 809             stricmp (&tmpnam[l - 4], ".bat") == 0))
 810       {
 811         s.st_mode |= S_IEXEC;
 812       }
 813   }
 814 #endif
 815
 816   switch (s.st_mode & S_IFMT)
 817     {
 818     default:
 819       values[0] = Qnil;
 820       break;
 821     case S_IFDIR:
 822       values[0] = Qt;
 823       break;
 824 #ifdef S_IFLNK
 825     case S_IFLNK:
 826       values[0] = Ffile_symlink_p (filename);
 827       break;
 828 #endif
 829     }
 830   values[1] = make_int (s.st_nlink);
 831   values[2] = make_int (s.st_uid);
 832   values[3] = make_int (s.st_gid);
 833   values[4] = wasteful_word_to_lisp (s.st_atime);
 834   values[5] = wasteful_word_to_lisp (s.st_mtime);
 835   values[6] = wasteful_word_to_lisp (s.st_ctime);
 836   values[7] = make_int ((EMACS_INT) s.st_size);
 837   /* If the size is out of range, give back -1.  */
 838   /* #### Fix when Emacs gets bignums! */
 839   if (XINT (values[7]) != s.st_size)
 840     values[7] = make_int (-1);
 841   filemodestring (&s, modes);
 842   values[8] = make_string ((Bufbyte *) modes, 10);
 843 #if defined (BSD4_2) || defined (BSD4_3)        /* file gid will be dir gid */
 844   {
 845     struct stat sdir;
 846
 847     if (!NILP (directory) && xemacs_stat ((char *) XSTRING_DATA (directory), &sdir) == 0)
 848       values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
 849     else                        /* if we can't tell, assume worst */
 850       values[9] = Qt;
 851   }
 852 #else                           /* file gid will be egid */
 853   values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
 854 #endif  /* BSD4_2 or BSD4_3 */
 855   values[10] = make_int (s.st_ino);
 856   values[11] = make_int (s.st_dev);
 857   UNGCPRO;
 858   return Flist (countof (values), values);
 859 }
 860
 861 \f
 862 /************************************************************************/
 863 /*                            initialization                            */
 864 /************************************************************************/
 865
 866 void
 867 syms_of_dired (void)
 868 {
 869   defsymbol (&Qdirectory_files, "directory-files");
 870   defsymbol (&Qfile_name_completion, "file-name-completion");
 871   defsymbol (&Qfile_name_all_completions, "file-name-all-completions");
 872   defsymbol (&Qfile_attributes, "file-attributes");
 873
 874   DEFSUBR (Fdirectory_files);
 875   DEFSUBR (Ffile_name_completion);
 876   DEFSUBR (Ffile_name_all_completions);
 877 #ifndef  WIN32_NATIVE
 878   DEFSUBR (Fuser_name_completion);
 879   DEFSUBR (Fuser_name_completion_1);
 880   DEFSUBR (Fuser_name_all_completions);
 881 #endif
 882   DEFSUBR (Ffile_attributes);
 883 }
 884
 885 void
 886 vars_of_dired (void)
 887 {
 888   DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions /*
 889 *Completion ignores filenames ending in any string in this list.
 890 This variable does not affect lists of possible completions,
 891 but does affect the commands that actually do completions.
 892 It is used by the functions `file-name-completion' and
 893 `file-name-all-completions'.
 894 */ );
 895   Vcompletion_ignored_extensions = Qnil;
 896 }