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