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