src/dired.c

   1 /* Lisp functions for making directory listings.
   2    Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001
   3      Free Software Foundation, Inc.
   4
   5 This file is part of GNU Emacs.
   6
   7 GNU Emacs is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GNU Emacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Emacs; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22
  23 #include <config.h>
  24
  25 #include <stdio.h>
  26 #include <sys/types.h>
  27 #include <sys/stat.h>
  28
  29 #include "systime.h"
  30 #include <errno.h>
  31
  32 #ifdef VMS
  33 #include <string.h>
  34 #include <rms.h>
  35 #include <rmsdef.h>
  36 #endif
  37
  38 #ifdef HAVE_UNISTD_H
  39 #include <unistd.h>
  40 #endif
  41
  42 /* The d_nameln member of a struct dirent includes the '\0' character
  43    on some systems, but not on others.  What's worse, you can't tell
  44    at compile-time which one it will be, since it really depends on
  45    the sort of system providing the filesystem you're reading from,
  46    not the system you are running on.  Paul Eggert
  47    <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
  48    SunOS 4.1.2 host, reading a directory that is remote-mounted from a
  49    Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
  50
  51    Since applying strlen to the name always works, we'll just do that.  */
  52 #define NAMLEN(p) strlen (p->d_name)
  53
  54 #ifdef SYSV_SYSTEM_DIR
  55
  56 #include <dirent.h>
  57 #define DIRENTRY struct dirent
  58
  59 #else /* not SYSV_SYSTEM_DIR */
  60
  61 #ifdef NONSYSTEM_DIR_LIBRARY
  62 #include "ndir.h"
  63 #else /* not NONSYSTEM_DIR_LIBRARY */
  64 #ifdef MSDOS
  65 #include <dirent.h>
  66 #else
  67 #include <sys/dir.h>
  68 #endif
  69 #endif /* not NONSYSTEM_DIR_LIBRARY */
  70
  71 #include <sys/stat.h>
  72
  73 #ifndef MSDOS
  74 #define DIRENTRY struct direct
  75
  76 extern DIR *opendir ();
  77 extern struct direct *readdir ();
  78
  79 #endif /* not MSDOS */
  80 #endif /* not SYSV_SYSTEM_DIR */
  81
  82 #ifdef MSDOS
  83 #define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
  84 #else
  85 #define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
  86 #endif
  87
  88 #include "lisp.h"
  89 #include "buffer.h"
  90 #include "commands.h"
  91 #include "charset.h"
  92 #include "coding.h"
  93 #include "regex.h"
  94
  95 /* Returns a search buffer, with a fastmap allocated and ready to go.  */
  96 extern struct re_pattern_buffer *compile_pattern ();
  97
  98 /* From filemode.c.  Can't go in Lisp.h because of `stat'.  */
  99 extern void filemodestring P_ ((struct stat *, char *));
 100
 101 /* if system does not have symbolic links, it does not have lstat.
 102    In that case, use ordinary stat instead.  */
 103
 104 #ifndef S_IFLNK
 105 #define lstat stat
 106 #endif
 107
 108 extern int completion_ignore_case;
 109 extern Lisp_Object Vcompletion_regexp_list;
 110 extern Lisp_Object Vfile_name_coding_system, Vdefault_file_name_coding_system;
 111
 112 Lisp_Object Vcompletion_ignored_extensions;
 113 Lisp_Object Qcompletion_ignore_case;
 114 Lisp_Object Qdirectory_files;
 115 Lisp_Object Qdirectory_files_and_attributes;
 116 Lisp_Object Qfile_name_completion;
 117 Lisp_Object Qfile_name_all_completions;
 118 Lisp_Object Qfile_attributes;
 119 Lisp_Object Qfile_attributes_lessp;
 120 \f
 121
 122 Lisp_Object
 123 directory_files_internal_unwind (dh)
 124      Lisp_Object dh;
 125 {
 126   DIR *d = (DIR *) ((XINT (XCAR (dh)) << 16) + XINT (XCDR (dh)));
 127   closedir (d);
 128   return Qnil;
 129 }
 130
 131 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
 132    When ATTRS is zero, return a list of directory filenames; when
 133    non-zero, return a list of directory filenames and their attributes.  */
 134
 135 Lisp_Object
 136 directory_files_internal (directory, full, match, nosort, attrs)
 137      Lisp_Object directory, full, match, nosort;
 138      int attrs;
 139 {
 140   DIR *d;
 141   int directory_nbytes;
 142   Lisp_Object list, dirfilename, encoded_directory;
 143   struct re_pattern_buffer *bufp = NULL;
 144   int needsep = 0;
 145   int count = specpdl_ptr - specpdl;
 146   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 147   DIRENTRY *dp;
 148   int retry_p;
 149
 150   /* Because of file name handlers, these functions might call
 151      Ffuncall, and cause a GC.  */
 152   list = encoded_directory = dirfilename = Qnil;
 153   GCPRO5 (match, directory, list, dirfilename, encoded_directory);
 154   directory = Fexpand_file_name (directory, Qnil);
 155   dirfilename = Fdirectory_file_name (directory);
 156
 157   if (!NILP (match))
 158     {
 159       CHECK_STRING (match);
 160
 161       /* MATCH might be a flawed regular expression.  Rather than
 162          catching and signaling our own errors, we just call
 163          compile_pattern to do the work for us.  */
 164       /* Pass 1 for the MULTIBYTE arg
 165          because we do make multibyte strings if the contents warrant.  */
 166 #ifdef VMS
 167       bufp = compile_pattern (match, 0,
 168                               buffer_defaults.downcase_table, 0, 1);
 169 #else
 170       bufp = compile_pattern (match, 0, Qnil, 0, 1);
 171 #endif
 172     }
 173
 174   /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
 175      run_pre_post_conversion_on_str which calls Lisp directly and
 176      indirectly.  */
 177   dirfilename = ENCODE_FILE (dirfilename);
 178   encoded_directory = ENCODE_FILE (directory);
 179
 180   /* Now *bufp is the compiled form of MATCH; don't call anything
 181      which might compile a new regexp until we're done with the loop!  */
 182
 183   /* Do this opendir after anything which might signal an error; if
 184      an error is signaled while the directory stream is open, we
 185      have to make sure it gets closed, and setting up an
 186      unwind_protect to do so would be a pain.  */
 187  retry:
 188
 189   d = opendir (XSTRING (dirfilename)->data);
 190   if (d == NULL)
 191     report_file_error ("Opening directory", Fcons (directory, Qnil));
 192
 193   /* Unfortunately, we can now invoke expand-file-name and
 194      file-attributes on filenames, both of which can throw, so we must
 195      do a proper unwind-protect.  */
 196   record_unwind_protect (directory_files_internal_unwind,
 197                          Fcons (make_number (((unsigned long) d) >> 16),
 198                                 make_number (((unsigned long) d) & 0xffff)));
 199
 200   directory_nbytes = STRING_BYTES (XSTRING (directory));
 201   re_match_object = Qt;
 202
 203   /* Decide whether we need to add a directory separator.  */
 204 #ifndef VMS
 205   if (directory_nbytes == 0
 206       || !IS_ANY_SEP (XSTRING (directory)->data[directory_nbytes - 1]))
 207     needsep = 1;
 208 #endif /* not VMS */
 209
 210   /* Loop reading blocks until EOF or error.  */
 211   for (;;)
 212     {
 213       errno = 0;
 214       dp = readdir (d);
 215
 216 #ifdef EAGAIN
 217       if (dp == NULL && errno == EAGAIN)
 218         continue;
 219 #endif
 220
 221       if (dp == NULL)
 222         break;
 223
 224       if (DIRENTRY_NONEMPTY (dp))
 225         {
 226           int len;
 227           int wanted = 0;
 228           Lisp_Object name, finalname;
 229           struct gcpro gcpro1, gcpro2;
 230
 231           len = NAMLEN (dp);
 232           name = finalname = make_unibyte_string (dp->d_name, len);
 233           GCPRO2 (finalname, name);
 234
 235           /* Note: ENCODE_FILE can GC; it should protect its argument,
 236              though.  */
 237           name = DECODE_FILE (name);
 238           len = STRING_BYTES (XSTRING (name));
 239
 240           /* Now that we have unwind_protect in place, we might as well
 241              allow matching to be interrupted.  */
 242           immediate_quit = 1;
 243           QUIT;
 244
 245           if (NILP (match)
 246               || (0 <= re_search (bufp, XSTRING (name)->data, len, 0, len, 0)))
 247             wanted = 1;
 248
 249           immediate_quit = 0;
 250
 251           if (wanted)
 252             {
 253               if (!NILP (full))
 254                 {
 255                   Lisp_Object fullname;
 256                   int nbytes = len + directory_nbytes + needsep;
 257                   int nchars;
 258
 259                   fullname = make_uninit_multibyte_string (nbytes, nbytes);
 260                   bcopy (XSTRING (directory)->data, XSTRING (fullname)->data,
 261                          directory_nbytes);
 262
 263                   if (needsep)
 264                     XSTRING (fullname)->data[directory_nbytes] = DIRECTORY_SEP;
 265
 266                   bcopy (XSTRING (name)->data,
 267                          XSTRING (fullname)->data + directory_nbytes + needsep,
 268                          len);
 269
 270                   nchars = chars_in_text (XSTRING (fullname)->data, nbytes);
 271
 272                   /* Some bug somewhere.  */
 273                   if (nchars > nbytes)
 274                     abort ();
 275
 276                   XSTRING (fullname)->size = nchars;
 277                   if (nchars == nbytes)
 278                     SET_STRING_BYTES (XSTRING (fullname), -1);
 279
 280                   finalname = fullname;
 281                 }
 282               else
 283                 finalname = name;
 284
 285               if (attrs)
 286                 {
 287                   /* Construct an expanded filename for the directory entry.
 288                      Use the decoded names for input to Ffile_attributes.  */
 289                   Lisp_Object decoded_fullname, fileattrs;
 290                   struct gcpro gcpro1, gcpro2;
 291
 292                   decoded_fullname = fileattrs = Qnil;
 293                   GCPRO2 (decoded_fullname, fileattrs);
 294
 295                   /* Both Fexpand_file_name and Ffile_attributes can GC.  */
 296                   decoded_fullname = Fexpand_file_name (name, directory);
 297                   fileattrs = Ffile_attributes (decoded_fullname);
 298
 299                   list = Fcons (Fcons (finalname, fileattrs), list);
 300                   UNGCPRO;
 301                 }
 302               else
 303                 list = Fcons (finalname, list);
 304             }
 305
 306           UNGCPRO;
 307         }
 308     }
 309
 310   retry_p = 0;
 311 #ifdef EINTR
 312   retry_p |= errno == EINTR;
 313 #endif
 314
 315   closedir (d);
 316
 317   /* Discard the unwind protect.  */
 318   specpdl_ptr = specpdl + count;
 319
 320   if (retry_p)
 321     {
 322       list = Qnil;
 323       goto retry;
 324     }
 325
 326   if (NILP (nosort))
 327     list = Fsort (Fnreverse (list),
 328                   attrs ? Qfile_attributes_lessp : Qstring_lessp);
 329
 330   RETURN_UNGCPRO (list);
 331 }
 332
 333
 334 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
 335   "Return a list of names of files in DIRECTORY.\n\
 336 There are three optional arguments:\n\
 337 If FULL is non-nil, return absolute file names.  Otherwise return names\n\
 338  that are relative to the specified directory.\n\
 339 If MATCH is non-nil, mention only file names that match the regexp MATCH.\n\
 340 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
 341  NOSORT is useful if you plan to sort the result yourself.")
 342   (directory, full, match, nosort)
 343      Lisp_Object directory, full, match, nosort;
 344 {
 345   Lisp_Object handler;
 346
 347   /* If the file name has special constructs in it,
 348      call the corresponding file handler.  */
 349   handler = Ffind_file_name_handler (directory, Qdirectory_files);
 350   if (!NILP (handler))
 351     {
 352       Lisp_Object args[6];
 353
 354       args[0] = handler;
 355       args[1] = Qdirectory_files;
 356       args[2] = directory;
 357       args[3] = full;
 358       args[4] = match;
 359       args[5] = nosort;
 360       return Ffuncall (6, args);
 361     }
 362
 363   return directory_files_internal (directory, full, match, nosort, 0);
 364 }
 365
 366 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes, Sdirectory_files_and_attributes, 1, 4, 0,
 367   "Return a list of names of files and their attributes in DIRECTORY.\n\
 368 There are three optional arguments:\n\
 369 If FULL is non-nil, return absolute file names.  Otherwise return names\n\
 370  that are relative to the specified directory.\n\
 371 If MATCH is non-nil, mention only file names that match the regexp MATCH.\n\
 372 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
 373  NOSORT is useful if you plan to sort the result yourself.")
 374   (directory, full, match, nosort)
 375      Lisp_Object directory, full, match, nosort;
 376 {
 377   Lisp_Object handler;
 378
 379   /* If the file name has special constructs in it,
 380      call the corresponding file handler.  */
 381   handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
 382   if (!NILP (handler))
 383     {
 384       Lisp_Object args[6];
 385
 386       args[0] = handler;
 387       args[1] = Qdirectory_files_and_attributes;
 388       args[2] = directory;
 389       args[3] = full;
 390       args[4] = match;
 391       args[5] = nosort;
 392       return Ffuncall (6, args);
 393     }
 394
 395   return directory_files_internal (directory, full, match, nosort, 1);
 396 }
 397
 398 \f
 399 Lisp_Object file_name_completion ();
 400
 401 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
 402   2, 2, 0,
 403   "Complete file name FILE in directory DIRECTORY.\n\
 404 Returns the longest string\n\
 405 common to all file names in DIRECTORY that start with FILE.\n\
 406 If there is only one and FILE matches it exactly, returns t.\n\
 407 Returns nil if DIR contains no name starting with FILE.\n\
 408 \n\
 409 This function ignores some of the possible completions as\n\
 410 determined by the variable `completion-ignored-extensions', which see.")
 411   (file, directory)
 412      Lisp_Object file, directory;
 413 {
 414   Lisp_Object handler;
 415
 416   /* If the directory name has special constructs in it,
 417      call the corresponding file handler.  */
 418   handler = Ffind_file_name_handler (directory, Qfile_name_completion);
 419   if (!NILP (handler))
 420     return call3 (handler, Qfile_name_completion, file, directory);
 421
 422   /* If the file name has special constructs in it,
 423      call the corresponding file handler.  */
 424   handler = Ffind_file_name_handler (file, Qfile_name_completion);
 425   if (!NILP (handler))
 426     return call3 (handler, Qfile_name_completion, file, directory);
 427
 428   return file_name_completion (file, directory, 0, 0);
 429 }
 430
 431 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
 432   Sfile_name_all_completions, 2, 2, 0,
 433   "Return a list of all completions of file name FILE in directory DIRECTORY.\n\
 434 These are all file names in directory DIRECTORY which begin with FILE.")
 435   (file, directory)
 436      Lisp_Object file, directory;
 437 {
 438   Lisp_Object handler;
 439
 440   /* If the directory name has special constructs in it,
 441      call the corresponding file handler.  */
 442   handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
 443   if (!NILP (handler))
 444     return call3 (handler, Qfile_name_all_completions, file, directory);
 445
 446   /* If the file name has special constructs in it,
 447      call the corresponding file handler.  */
 448   handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
 449   if (!NILP (handler))
 450     return call3 (handler, Qfile_name_all_completions, file, directory);
 451
 452   return file_name_completion (file, directory, 1, 0);
 453 }
 454
 455 static int file_name_completion_stat ();
 456
 457 Lisp_Object
 458 file_name_completion (file, dirname, all_flag, ver_flag)
 459      Lisp_Object file, dirname;
 460      int all_flag, ver_flag;
 461 {
 462   DIR *d;
 463   int bestmatchsize = 0, skip;
 464   register int compare, matchsize;
 465   unsigned char *p1, *p2;
 466   int matchcount = 0;
 467   Lisp_Object bestmatch, tem, elt, name;
 468   Lisp_Object encoded_file;
 469   Lisp_Object encoded_dir;
 470   struct stat st;
 471   int directoryp;
 472   int passcount;
 473   int count = specpdl_ptr - specpdl;
 474   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 475
 476   elt = Qnil;
 477
 478 #ifdef VMS
 479   extern DIRENTRY * readdirver ();
 480
 481   DIRENTRY *((* readfunc) ());
 482
 483   /* Filename completion on VMS ignores case, since VMS filesys does.  */
 484   specbind (Qcompletion_ignore_case, Qt);
 485
 486   readfunc = readdir;
 487   if (ver_flag)
 488     readfunc = readdirver;
 489   file = Fupcase (file);
 490 #else  /* not VMS */
 491   CHECK_STRING (file);
 492 #endif /* not VMS */
 493
 494 #ifdef FILE_SYSTEM_CASE
 495   file = FILE_SYSTEM_CASE (file);
 496 #endif
 497   bestmatch = Qnil;
 498   encoded_file = encoded_dir = Qnil;
 499   GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
 500   dirname = Fexpand_file_name (dirname, Qnil);
 501
 502   /* Do completion on the encoded file name
 503      because the other names in the directory are (we presume)
 504      encoded likewise.  We decode the completed string at the end.  */
 505   encoded_file = ENCODE_FILE (file);
 506
 507   encoded_dir = ENCODE_FILE (dirname);
 508
 509   /* With passcount = 0, ignore files that end in an ignored extension.
 510      If nothing found then try again with passcount = 1, don't ignore them.
 511      If looking for all completions, start with passcount = 1,
 512      so always take even the ignored ones.
 513
 514      ** It would not actually be helpful to the user to ignore any possible
 515      completions when making a list of them.**  */
 516
 517   for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
 518     {
 519       d = opendir (XSTRING (Fdirectory_file_name (encoded_dir))->data);
 520       if (!d)
 521         report_file_error ("Opening directory", Fcons (dirname, Qnil));
 522
 523       /* Loop reading blocks */
 524       /* (att3b compiler bug requires do a null comparison this way) */
 525       while (1)
 526         {
 527           DIRENTRY *dp;
 528           int len;
 529
 530 #ifdef VMS
 531           dp = (*readfunc) (d);
 532 #else
 533           dp = readdir (d);
 534 #endif
 535           if (!dp) break;
 536
 537           len = NAMLEN (dp);
 538
 539           if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
 540             goto quit;
 541           if (! DIRENTRY_NONEMPTY (dp)
 542               || len < XSTRING (encoded_file)->size
 543               || 0 <= scmp (dp->d_name, XSTRING (encoded_file)->data,
 544                             XSTRING (encoded_file)->size))
 545             continue;
 546
 547           if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
 548             continue;
 549
 550           directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
 551           tem = Qnil;
 552           if (directoryp)
 553             {
 554 #ifndef TRIVIAL_DIRECTORY_ENTRY
 555 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
 556 #endif
 557               /* "." and ".." are never interesting as completions, but are
 558                  actually in the way in a directory contains only one file.  */
 559               if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
 560                 continue;
 561               if (!passcount && len > XSTRING (encoded_file)->size)
 562                 /* Ignore directories if they match an element of
 563                    completion-ignored-extensions which ends in a slash.  */
 564                 for (tem = Vcompletion_ignored_extensions;
 565                      CONSP (tem); tem = XCDR (tem))
 566                   {
 567                     int elt_len;
 568
 569                     elt = XCAR (tem);
 570                     if (!STRINGP (elt))
 571                       continue;
 572                     elt_len = XSTRING (elt)->size - 1; /* -1 for trailing / */
 573                     if (elt_len <= 0)
 574                       continue;
 575                     p1 = XSTRING (elt)->data;
 576                     if (p1[elt_len] != '/')
 577                       continue;
 578                     skip = len - elt_len;
 579                     if (skip < 0)
 580                       continue;
 581
 582                     if (0 <= scmp (dp->d_name + skip, p1, elt_len))
 583                       continue;
 584                     break;
 585                   }
 586             }
 587           else
 588             {
 589               /* Compare extensions-to-be-ignored against end of this file name */
 590               /* if name is not an exact match against specified string */
 591               if (!passcount && len > XSTRING (encoded_file)->size)
 592                 /* and exit this for loop if a match is found */
 593                 for (tem = Vcompletion_ignored_extensions;
 594                      CONSP (tem); tem = XCDR (tem))
 595                   {
 596                     elt = XCAR (tem);
 597                     if (!STRINGP (elt)) continue;
 598                     skip = len - XSTRING (elt)->size;
 599                     if (skip < 0) continue;
 600
 601                     if (0 <= scmp (dp->d_name + skip,
 602                                    XSTRING (elt)->data,
 603                                    XSTRING (elt)->size))
 604                       continue;
 605                     break;
 606                   }
 607             }
 608
 609           /* If an ignored-extensions match was found,
 610              don't process this name as a completion.  */
 611           if (!passcount && CONSP (tem))
 612             continue;
 613
 614           if (!passcount)
 615             {
 616               Lisp_Object regexps;
 617               Lisp_Object zero;
 618               XSETFASTINT (zero, 0);
 619
 620               /* Ignore this element if it fails to match all the regexps.  */
 621               for (regexps = Vcompletion_regexp_list; CONSP (regexps);
 622                    regexps = XCDR (regexps))
 623                 {
 624                   tem = Fstring_match (XCAR (regexps),
 625                                        make_string (dp->d_name, len), zero);
 626                   if (NILP (tem))
 627                     break;
 628                 }
 629               if (CONSP (regexps))
 630                 continue;
 631             }
 632
 633           /* Update computation of how much all possible completions match */
 634
 635           matchcount++;
 636
 637           if (all_flag || NILP (bestmatch))
 638             {
 639               /* This is a possible completion */
 640               if (directoryp)
 641                 {
 642                   /* This completion is a directory; make it end with '/' */
 643                   name = Ffile_name_as_directory (make_string (dp->d_name, len));
 644                 }
 645               else
 646                 name = make_string (dp->d_name, len);
 647               if (all_flag)
 648                 {
 649                   name = DECODE_FILE (name);
 650                   bestmatch = Fcons (name, bestmatch);
 651                 }
 652               else
 653                 {
 654                   bestmatch = name;
 655                   bestmatchsize = XSTRING (name)->size;
 656                 }
 657             }
 658           else
 659             {
 660               compare = min (bestmatchsize, len);
 661               p1 = XSTRING (bestmatch)->data;
 662               p2 = (unsigned char *) dp->d_name;
 663               matchsize = scmp(p1, p2, compare);
 664               if (matchsize < 0)
 665                 matchsize = compare;
 666               if (completion_ignore_case)
 667                 {
 668                   /* If this is an exact match except for case,
 669                      use it as the best match rather than one that is not
 670                      an exact match.  This way, we get the case pattern
 671                      of the actual match.  */
 672                   /* This tests that the current file is an exact match
 673                      but BESTMATCH is not (it is too long).  */
 674                   if ((matchsize == len
 675                        && matchsize + !!directoryp
 676                           < XSTRING (bestmatch)->size)
 677                       ||
 678                       /* If there is no exact match ignoring case,
 679                          prefer a match that does not change the case
 680                          of the input.  */
 681                       /* If there is more than one exact match aside from
 682                          case, and one of them is exact including case,
 683                          prefer that one.  */
 684                       /* This == checks that, of current file and BESTMATCH,
 685                          either both or neither are exact.  */
 686                       (((matchsize == len)
 687                         ==
 688                         (matchsize + !!directoryp
 689                          == XSTRING (bestmatch)->size))
 690                        && !bcmp (p2, XSTRING (encoded_file)->data, XSTRING (encoded_file)->size)
 691                        && bcmp (p1, XSTRING (encoded_file)->data, XSTRING (encoded_file)->size)))
 692                     {
 693                       bestmatch = make_string (dp->d_name, len);
 694                       if (directoryp)
 695                         bestmatch = Ffile_name_as_directory (bestmatch);
 696                     }
 697                 }
 698
 699               /* If this dirname all matches, see if implicit following
 700                  slash does too.  */
 701               if (directoryp
 702                   && compare == matchsize
 703                   && bestmatchsize > matchsize
 704                   && IS_ANY_SEP (p1[matchsize]))
 705                 matchsize++;
 706               bestmatchsize = matchsize;
 707             }
 708         }
 709       closedir (d);
 710     }
 711
 712   UNGCPRO;
 713   bestmatch = unbind_to (count, bestmatch);
 714
 715   if (all_flag || NILP (bestmatch))
 716     {
 717       if (STRINGP (bestmatch))
 718         bestmatch = DECODE_FILE (bestmatch);
 719       return bestmatch;
 720     }
 721   if (matchcount == 1 && bestmatchsize == XSTRING (file)->size)
 722     return Qt;
 723   bestmatch = Fsubstring (bestmatch, make_number (0),
 724                           make_number (bestmatchsize));
 725   /* Now that we got the right initial segment of BESTMATCH,
 726      decode it from the coding system in use.  */
 727   bestmatch = DECODE_FILE (bestmatch);
 728   return bestmatch;
 729
 730  quit:
 731   if (d) closedir (d);
 732   Vquit_flag = Qnil;
 733   return Fsignal (Qquit, Qnil);
 734 }
 735
 736 static int
 737 file_name_completion_stat (dirname, dp, st_addr)
 738      Lisp_Object dirname;
 739      DIRENTRY *dp;
 740      struct stat *st_addr;
 741 {
 742   int len = NAMLEN (dp);
 743   int pos = XSTRING (dirname)->size;
 744   int value;
 745   char *fullname = (char *) alloca (len + pos + 2);
 746
 747 #ifdef MSDOS
 748 #if __DJGPP__ > 1
 749   /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
 750      but aren't required here.  Avoid computing the following fields:
 751      st_inode, st_size and st_nlink for directories, and the execute bits
 752      in st_mode for non-directory files with non-standard extensions.  */
 753
 754   unsigned short save_djstat_flags = _djstat_flags;
 755
 756   _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
 757 #endif /* __DJGPP__ > 1 */
 758 #endif /* MSDOS */
 759
 760   bcopy (XSTRING (dirname)->data, fullname, pos);
 761 #ifndef VMS
 762   if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
 763     fullname[pos++] = DIRECTORY_SEP;
 764 #endif
 765
 766   bcopy (dp->d_name, fullname + pos, len);
 767   fullname[pos + len] = 0;
 768
 769 #ifdef S_IFLNK
 770   /* We want to return success if a link points to a nonexistent file,
 771      but we want to return the status for what the link points to,
 772      in case it is a directory.  */
 773   value = lstat (fullname, st_addr);
 774   stat (fullname, st_addr);
 775   return value;
 776 #else
 777   value = stat (fullname, st_addr);
 778 #ifdef MSDOS
 779 #if __DJGPP__ > 1
 780   _djstat_flags = save_djstat_flags;
 781 #endif /* __DJGPP__ > 1 */
 782 #endif /* MSDOS */
 783   return value;
 784 #endif /* S_IFLNK */
 785 }
 786 \f
 787 #ifdef VMS
 788
 789 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
 790   Sfile_name_all_versions, 2, 2, 0,
 791   "Return a list of all versions of file name FILE in directory DIRECTORY.")
 792   (file, directory)
 793      Lisp_Object file, directory;
 794 {
 795   return file_name_completion (file, directory, 1, 1);
 796 }
 797
 798 DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
 799   "Return the maximum number of versions allowed for FILE.\n\
 800 Returns nil if the file cannot be opened or if there is no version limit.")
 801   (filename)
 802      Lisp_Object filename;
 803 {
 804   Lisp_Object retval;
 805   struct FAB    fab;
 806   struct RAB    rab;
 807   struct XABFHC xabfhc;
 808   int status;
 809
 810   filename = Fexpand_file_name (filename, Qnil);
 811   fab      = cc$rms_fab;
 812   xabfhc   = cc$rms_xabfhc;
 813   fab.fab$l_fna = XSTRING (filename)->data;
 814   fab.fab$b_fns = strlen (fab.fab$l_fna);
 815   fab.fab$l_xab = (char *) &xabfhc;
 816   status = sys$open (&fab, 0, 0);
 817   if (status != RMS$_NORMAL)    /* Probably non-existent file */
 818     return Qnil;
 819   sys$close (&fab, 0, 0);
 820   if (xabfhc.xab$w_verlimit == 32767)
 821     return Qnil;                /* No version limit */
 822   else
 823     return make_number (xabfhc.xab$w_verlimit);
 824 }
 825
 826 #endif /* VMS */
 827 \f
 828 Lisp_Object
 829 make_time (time)
 830      time_t time;
 831 {
 832   return Fcons (make_number (time >> 16),
 833                 Fcons (make_number (time & 0177777), Qnil));
 834 }
 835
 836 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
 837   "Return a list of attributes of file FILENAME.\n\
 838 Value is nil if specified file cannot be opened.\n\
 839 Otherwise, list elements are:\n\
 840  0. t for directory, string (name linked to) for symbolic link, or nil.\n\
 841  1. Number of links to file.\n\
 842  2. File uid.\n\
 843  3. File gid.\n\
 844  4. Last access time, as a list of two integers.\n\
 845   First integer has high-order 16 bits of time, second has low 16 bits.\n\
 846  5. Last modification time, likewise.\n\
 847  6. Last status change time, likewise.\n\
 848  7. Size in bytes.\n\
 849   This is a floating point number if the size is too large for an integer.\n\
 850  8. File modes, as a string of ten letters or dashes as in ls -l.\n\
 851  9. t iff file's gid would change if file were deleted and recreated.\n\
 852 10. inode number.  If inode number is larger than the Emacs integer,\n\
 853   this is a cons cell containing two integers: first the high part,\n\
 854   then the low 16 bits.\n\
 855 11. Device number.  If it is larger than the Emacs integer, this is\n\
 856   a cons cell, similar to the inode number.\n\
 857 \n\
 858 If file does not exist, returns nil.")
 859   (filename)
 860      Lisp_Object filename;
 861 {
 862   Lisp_Object values[12];
 863   Lisp_Object encoded;
 864   struct stat s;
 865 #if defined (BSD4_2) || defined (BSD4_3)
 866   Lisp_Object dirname;
 867   struct stat sdir;
 868 #endif
 869   char modes[10];
 870   Lisp_Object handler;
 871
 872   filename = Fexpand_file_name (filename, Qnil);
 873
 874   /* If the file name has special constructs in it,
 875      call the corresponding file handler.  */
 876   handler = Ffind_file_name_handler (filename, Qfile_attributes);
 877   if (!NILP (handler))
 878     return call2 (handler, Qfile_attributes, filename);
 879
 880   encoded = ENCODE_FILE (filename);
 881
 882   if (lstat (XSTRING (encoded)->data, &s) < 0)
 883     return Qnil;
 884
 885   switch (s.st_mode & S_IFMT)
 886     {
 887     default:
 888       values[0] = Qnil; break;
 889     case S_IFDIR:
 890       values[0] = Qt; break;
 891 #ifdef S_IFLNK
 892     case S_IFLNK:
 893       values[0] = Ffile_symlink_p (filename); break;
 894 #endif
 895     }
 896   values[1] = make_number (s.st_nlink);
 897   values[2] = make_number (s.st_uid);
 898   values[3] = make_number (s.st_gid);
 899   values[4] = make_time (s.st_atime);
 900   values[5] = make_time (s.st_mtime);
 901   values[6] = make_time (s.st_ctime);
 902   values[7] = make_number (s.st_size);
 903   /* If the size is out of range for an integer, return a float.  */
 904   if (XINT (values[7]) != s.st_size)
 905     values[7] = make_float ((double)s.st_size);
 906   filemodestring (&s, modes);
 907   values[8] = make_string (modes, 10);
 908 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
 909   dirname = Ffile_name_directory (filename);
 910   if (! NILP (dirname))
 911     encoded = ENCODE_FILE (dirname);
 912   if (! NILP (dirname) && stat (XSTRING (encoded)->data, &sdir) == 0)
 913     values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
 914   else                                  /* if we can't tell, assume worst */
 915     values[9] = Qt;
 916 #else                                   /* file gid will be egid */
 917   values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
 918 #endif  /* BSD4_2 (or BSD4_3) */
 919   /* Cast -1 to avoid warning if int is not as wide as VALBITS.  */
 920   if (FIXNUM_OVERFLOW_P (s.st_ino))
 921     /* To allow inode numbers larger than VALBITS, separate the bottom
 922        16 bits.  */
 923     values[10] = Fcons (make_number (s.st_ino >> 16),
 924                         make_number (s.st_ino & 0xffff));
 925   else
 926     /* But keep the most common cases as integers.  */
 927     values[10] = make_number (s.st_ino);
 928
 929   /* Likewise for device.  */
 930   if (FIXNUM_OVERFLOW_P (s.st_dev))
 931     values[11] = Fcons (make_number (s.st_dev >> 16),
 932                         make_number (s.st_dev & 0xffff));
 933   else
 934     values[11] = make_number (s.st_dev);
 935
 936   return Flist (sizeof(values) / sizeof(values[0]), values);
 937 }
 938
 939 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
 940   "Return t if first arg file attributes list is less than second.\n\
 941 Comparison is in lexicographic order and case is significant.")
 942   (f1, f2)
 943      Lisp_Object f1, f2;
 944 {
 945   return Fstring_lessp (Fcar (f1), Fcar (f2));
 946 }
 947 \f
 948 void
 949 syms_of_dired ()
 950 {
 951   Qdirectory_files = intern ("directory-files");
 952   Qdirectory_files_and_attributes = intern ("directory-files-and-attributes");
 953   Qfile_name_completion = intern ("file-name-completion");
 954   Qfile_name_all_completions = intern ("file-name-all-completions");
 955   Qfile_attributes = intern ("file-attributes");
 956   Qfile_attributes_lessp = intern ("file-attributes-lessp");
 957
 958   staticpro (&Qdirectory_files);
 959   staticpro (&Qdirectory_files_and_attributes);
 960   staticpro (&Qfile_name_completion);
 961   staticpro (&Qfile_name_all_completions);
 962   staticpro (&Qfile_attributes);
 963   staticpro (&Qfile_attributes_lessp);
 964
 965   defsubr (&Sdirectory_files);
 966   defsubr (&Sdirectory_files_and_attributes);
 967   defsubr (&Sfile_name_completion);
 968 #ifdef VMS
 969   defsubr (&Sfile_name_all_versions);
 970   defsubr (&Sfile_version_limit);
 971 #endif /* VMS */
 972   defsubr (&Sfile_name_all_completions);
 973   defsubr (&Sfile_attributes);
 974   defsubr (&Sfile_attributes_lessp);
 975
 976 #ifdef VMS
 977   Qcompletion_ignore_case = intern ("completion-ignore-case");
 978   staticpro (&Qcompletion_ignore_case);
 979 #endif /* VMS */
 980
 981   DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
 982     "*Completion ignores filenames ending in any string in this list.\n\
 983 Directories are ignored if they match any string in this list which\n\
 984 ends in a slash.\n\
 985 This variable does not affect lists of possible completions,\n\
 986 but does affect the commands that actually do completions.");
 987   Vcompletion_ignored_extensions = Qnil;
 988 }