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     goto retry;
 316
 317   if (NILP (nosort))
 318     list = Fsort (Fnreverse (list),
 319                   attrs ? Qfile_attributes_lessp : Qstring_lessp);
 320
 321   RETURN_UNGCPRO (list);
 322 }
 323
 324
 325 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
 326   "Return a list of names of files in DIRECTORY.\n\
 327 There are three optional arguments:\n\
 328 If FULL is non-nil, return absolute file names.  Otherwise return names\n\
 329  that are relative to the specified directory.\n\
 330 If MATCH is non-nil, mention only file names that match the regexp MATCH.\n\
 331 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
 332  NOSORT is useful if you plan to sort the result yourself.")
 333   (directory, full, match, nosort)
 334      Lisp_Object directory, full, match, nosort;
 335 {
 336   Lisp_Object handler;
 337
 338   /* If the file name has special constructs in it,
 339      call the corresponding file handler.  */
 340   handler = Ffind_file_name_handler (directory, Qdirectory_files);
 341   if (!NILP (handler))
 342     {
 343       Lisp_Object args[6];
 344
 345       args[0] = handler;
 346       args[1] = Qdirectory_files;
 347       args[2] = directory;
 348       args[3] = full;
 349       args[4] = match;
 350       args[5] = nosort;
 351       return Ffuncall (6, args);
 352     }
 353
 354   return directory_files_internal (directory, full, match, nosort, 0);
 355 }
 356
 357 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes, Sdirectory_files_and_attributes, 1, 4, 0,
 358   "Return a list of names of files and their attributes in DIRECTORY.\n\
 359 There are three optional arguments:\n\
 360 If FULL is non-nil, return absolute file names.  Otherwise return names\n\
 361  that are relative to the specified directory.\n\
 362 If MATCH is non-nil, mention only file names that match the regexp MATCH.\n\
 363 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
 364  NOSORT is useful if you plan to sort the result yourself.")
 365   (directory, full, match, nosort)
 366      Lisp_Object directory, full, match, nosort;
 367 {
 368   Lisp_Object handler;
 369
 370   /* If the file name has special constructs in it,
 371      call the corresponding file handler.  */
 372   handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
 373   if (!NILP (handler))
 374     {
 375       Lisp_Object args[6];
 376
 377       args[0] = handler;
 378       args[1] = Qdirectory_files_and_attributes;
 379       args[2] = directory;
 380       args[3] = full;
 381       args[4] = match;
 382       args[5] = nosort;
 383       return Ffuncall (6, args);
 384     }
 385
 386   return directory_files_internal (directory, full, match, nosort, 1);
 387 }
 388
 389 \f
 390 Lisp_Object file_name_completion ();
 391
 392 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
 393   2, 2, 0,
 394   "Complete file name FILE in directory DIRECTORY.\n\
 395 Returns the longest string\n\
 396 common to all file names in DIRECTORY that start with FILE.\n\
 397 If there is only one and FILE matches it exactly, returns t.\n\
 398 Returns nil if DIR contains no name starting with FILE.")
 399   (file, directory)
 400      Lisp_Object file, directory;
 401 {
 402   Lisp_Object handler;
 403
 404   /* If the directory name has special constructs in it,
 405      call the corresponding file handler.  */
 406   handler = Ffind_file_name_handler (directory, Qfile_name_completion);
 407   if (!NILP (handler))
 408     return call3 (handler, Qfile_name_completion, file, directory);
 409
 410   /* If the file name has special constructs in it,
 411      call the corresponding file handler.  */
 412   handler = Ffind_file_name_handler (file, Qfile_name_completion);
 413   if (!NILP (handler))
 414     return call3 (handler, Qfile_name_completion, file, directory);
 415
 416   return file_name_completion (file, directory, 0, 0);
 417 }
 418
 419 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
 420   Sfile_name_all_completions, 2, 2, 0,
 421   "Return a list of all completions of file name FILE in directory DIRECTORY.\n\
 422 These are all file names in directory DIRECTORY which begin with FILE.")
 423   (file, directory)
 424      Lisp_Object file, directory;
 425 {
 426   Lisp_Object handler;
 427
 428   /* If the directory name has special constructs in it,
 429      call the corresponding file handler.  */
 430   handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
 431   if (!NILP (handler))
 432     return call3 (handler, Qfile_name_all_completions, file, directory);
 433
 434   /* If the file name has special constructs in it,
 435      call the corresponding file handler.  */
 436   handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
 437   if (!NILP (handler))
 438     return call3 (handler, Qfile_name_all_completions, file, directory);
 439
 440   return file_name_completion (file, directory, 1, 0);
 441 }
 442
 443 static int file_name_completion_stat ();
 444
 445 Lisp_Object
 446 file_name_completion (file, dirname, all_flag, ver_flag)
 447      Lisp_Object file, dirname;
 448      int all_flag, ver_flag;
 449 {
 450   DIR *d;
 451   int bestmatchsize = 0, skip;
 452   register int compare, matchsize;
 453   unsigned char *p1, *p2;
 454   int matchcount = 0;
 455   Lisp_Object bestmatch, tem, elt, name;
 456   Lisp_Object encoded_file;
 457   Lisp_Object encoded_dir;
 458   struct stat st;
 459   int directoryp;
 460   int passcount;
 461   int count = specpdl_ptr - specpdl;
 462   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 463
 464   elt = Qnil;
 465
 466 #ifdef VMS
 467   extern DIRENTRY * readdirver ();
 468
 469   DIRENTRY *((* readfunc) ());
 470
 471   /* Filename completion on VMS ignores case, since VMS filesys does.  */
 472   specbind (Qcompletion_ignore_case, Qt);
 473
 474   readfunc = readdir;
 475   if (ver_flag)
 476     readfunc = readdirver;
 477   file = Fupcase (file);
 478 #else  /* not VMS */
 479   CHECK_STRING (file, 0);
 480 #endif /* not VMS */
 481
 482 #ifdef FILE_SYSTEM_CASE
 483   file = FILE_SYSTEM_CASE (file);
 484 #endif
 485   bestmatch = Qnil;
 486   encoded_file = encoded_dir = Qnil;
 487   GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
 488   dirname = Fexpand_file_name (dirname, Qnil);
 489
 490   /* Do completion on the encoded file name
 491      because the other names in the directory are (we presume)
 492      encoded likewise.  We decode the completed string at the end.  */
 493   encoded_file = ENCODE_FILE (file);
 494
 495   encoded_dir = ENCODE_FILE (dirname);
 496
 497   /* With passcount = 0, ignore files that end in an ignored extension.
 498      If nothing found then try again with passcount = 1, don't ignore them.
 499      If looking for all completions, start with passcount = 1,
 500      so always take even the ignored ones.
 501
 502      ** It would not actually be helpful to the user to ignore any possible
 503      completions when making a list of them.**  */
 504
 505   for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
 506     {
 507       d = opendir (XSTRING (Fdirectory_file_name (encoded_dir))->data);
 508       if (!d)
 509         report_file_error ("Opening directory", Fcons (dirname, Qnil));
 510
 511       /* Loop reading blocks */
 512       /* (att3b compiler bug requires do a null comparison this way) */
 513       while (1)
 514         {
 515           DIRENTRY *dp;
 516           int len;
 517
 518 #ifdef VMS
 519           dp = (*readfunc) (d);
 520 #else
 521           dp = readdir (d);
 522 #endif
 523           if (!dp) break;
 524
 525           len = NAMLEN (dp);
 526
 527           if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
 528             goto quit;
 529           if (! DIRENTRY_NONEMPTY (dp)
 530               || len < XSTRING (encoded_file)->size
 531               || 0 <= scmp (dp->d_name, XSTRING (encoded_file)->data,
 532                             XSTRING (encoded_file)->size))
 533             continue;
 534
 535           if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
 536             continue;
 537
 538           directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
 539           tem = Qnil;
 540           if (directoryp)
 541             {
 542 #ifndef TRIVIAL_DIRECTORY_ENTRY
 543 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
 544 #endif
 545               /* "." and ".." are never interesting as completions, but are
 546                  actually in the way in a directory contains only one file.  */
 547               if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
 548                 continue;
 549             }
 550           else
 551             {
 552               /* Compare extensions-to-be-ignored against end of this file name */
 553               /* if name is not an exact match against specified string */
 554               if (!passcount && len > XSTRING (encoded_file)->size)
 555                 /* and exit this for loop if a match is found */
 556                 for (tem = Vcompletion_ignored_extensions;
 557                      CONSP (tem); tem = XCDR (tem))
 558                   {
 559                     elt = XCAR (tem);
 560                     if (!STRINGP (elt)) continue;
 561                     skip = len - XSTRING (elt)->size;
 562                     if (skip < 0) continue;
 563
 564                     if (0 <= scmp (dp->d_name + skip,
 565                                    XSTRING (elt)->data,
 566                                    XSTRING (elt)->size))
 567                       continue;
 568                     break;
 569                   }
 570             }
 571
 572           /* If an ignored-extensions match was found,
 573              don't process this name as a completion.  */
 574           if (!passcount && CONSP (tem))
 575             continue;
 576
 577           if (!passcount)
 578             {
 579               Lisp_Object regexps;
 580               Lisp_Object zero;
 581               XSETFASTINT (zero, 0);
 582
 583               /* Ignore this element if it fails to match all the regexps.  */
 584               for (regexps = Vcompletion_regexp_list; CONSP (regexps);
 585                    regexps = XCDR (regexps))
 586                 {
 587                   tem = Fstring_match (XCAR (regexps), elt, zero);
 588                   if (NILP (tem))
 589                     break;
 590                 }
 591               if (CONSP (regexps))
 592                 continue;
 593             }
 594
 595           /* Update computation of how much all possible completions match */
 596
 597           matchcount++;
 598
 599           if (all_flag || NILP (bestmatch))
 600             {
 601               /* This is a possible completion */
 602               if (directoryp)
 603                 {
 604                   /* This completion is a directory; make it end with '/' */
 605                   name = Ffile_name_as_directory (make_string (dp->d_name, len));
 606                 }
 607               else
 608                 name = make_string (dp->d_name, len);
 609               if (all_flag)
 610                 {
 611                   name = DECODE_FILE (name);
 612                   bestmatch = Fcons (name, bestmatch);
 613                 }
 614               else
 615                 {
 616                   bestmatch = name;
 617                   bestmatchsize = XSTRING (name)->size;
 618                 }
 619             }
 620           else
 621             {
 622               compare = min (bestmatchsize, len);
 623               p1 = XSTRING (bestmatch)->data;
 624               p2 = (unsigned char *) dp->d_name;
 625               matchsize = scmp(p1, p2, compare);
 626               if (matchsize < 0)
 627                 matchsize = compare;
 628               if (completion_ignore_case)
 629                 {
 630                   /* If this is an exact match except for case,
 631                      use it as the best match rather than one that is not
 632                      an exact match.  This way, we get the case pattern
 633                      of the actual match.  */
 634                   /* This tests that the current file is an exact match
 635                      but BESTMATCH is not (it is too long).  */
 636                   if ((matchsize == len
 637                        && matchsize + !!directoryp
 638                           < XSTRING (bestmatch)->size)
 639                       ||
 640                       /* If there is no exact match ignoring case,
 641                          prefer a match that does not change the case
 642                          of the input.  */
 643                       /* If there is more than one exact match aside from
 644                          case, and one of them is exact including case,
 645                          prefer that one.  */
 646                       /* This == checks that, of current file and BESTMATCH,
 647                          either both or neither are exact.  */
 648                       (((matchsize == len)
 649                         ==
 650                         (matchsize + !!directoryp
 651                          == XSTRING (bestmatch)->size))
 652                        && !bcmp (p2, XSTRING (encoded_file)->data, XSTRING (encoded_file)->size)
 653                        && bcmp (p1, XSTRING (encoded_file)->data, XSTRING (encoded_file)->size)))
 654                     {
 655                       bestmatch = make_string (dp->d_name, len);
 656                       if (directoryp)
 657                         bestmatch = Ffile_name_as_directory (bestmatch);
 658                     }
 659                 }
 660
 661               /* If this dirname all matches, see if implicit following
 662                  slash does too.  */
 663               if (directoryp
 664                   && compare == matchsize
 665                   && bestmatchsize > matchsize
 666                   && IS_ANY_SEP (p1[matchsize]))
 667                 matchsize++;
 668               bestmatchsize = matchsize;
 669             }
 670         }
 671       closedir (d);
 672     }
 673
 674   UNGCPRO;
 675   bestmatch = unbind_to (count, bestmatch);
 676
 677   if (all_flag || NILP (bestmatch))
 678     {
 679       if (STRINGP (bestmatch))
 680         bestmatch = DECODE_FILE (bestmatch);
 681       return bestmatch;
 682     }
 683   if (matchcount == 1 && bestmatchsize == XSTRING (file)->size)
 684     return Qt;
 685   bestmatch = Fsubstring (bestmatch, make_number (0),
 686                           make_number (bestmatchsize));
 687   /* Now that we got the right initial segment of BESTMATCH,
 688      decode it from the coding system in use.  */
 689   bestmatch = DECODE_FILE (bestmatch);
 690   return bestmatch;
 691
 692  quit:
 693   if (d) closedir (d);
 694   Vquit_flag = Qnil;
 695   return Fsignal (Qquit, Qnil);
 696 }
 697
 698 static int
 699 file_name_completion_stat (dirname, dp, st_addr)
 700      Lisp_Object dirname;
 701      DIRENTRY *dp;
 702      struct stat *st_addr;
 703 {
 704   int len = NAMLEN (dp);
 705   int pos = XSTRING (dirname)->size;
 706   int value;
 707   char *fullname = (char *) alloca (len + pos + 2);
 708
 709 #ifdef MSDOS
 710 #if __DJGPP__ > 1
 711   /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
 712      but aren't required here.  Avoid computing the following fields:
 713      st_inode, st_size and st_nlink for directories, and the execute bits
 714      in st_mode for non-directory files with non-standard extensions.  */
 715
 716   unsigned short save_djstat_flags = _djstat_flags;
 717
 718   _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
 719 #endif /* __DJGPP__ > 1 */
 720 #endif /* MSDOS */
 721
 722   bcopy (XSTRING (dirname)->data, fullname, pos);
 723 #ifndef VMS
 724   if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
 725     fullname[pos++] = DIRECTORY_SEP;
 726 #endif
 727
 728   bcopy (dp->d_name, fullname + pos, len);
 729   fullname[pos + len] = 0;
 730
 731 #ifdef S_IFLNK
 732   /* We want to return success if a link points to a nonexistent file,
 733      but we want to return the status for what the link points to,
 734      in case it is a directory.  */
 735   value = lstat (fullname, st_addr);
 736   stat (fullname, st_addr);
 737   return value;
 738 #else
 739   value = stat (fullname, st_addr);
 740 #ifdef MSDOS
 741 #if __DJGPP__ > 1
 742   _djstat_flags = save_djstat_flags;
 743 #endif /* __DJGPP__ > 1 */
 744 #endif /* MSDOS */
 745   return value;
 746 #endif /* S_IFLNK */
 747 }
 748 \f
 749 #ifdef VMS
 750
 751 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
 752   Sfile_name_all_versions, 2, 2, 0,
 753   "Return a list of all versions of file name FILE in directory DIRECTORY.")
 754   (file, directory)
 755      Lisp_Object file, directory;
 756 {
 757   return file_name_completion (file, directory, 1, 1);
 758 }
 759
 760 DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
 761   "Return the maximum number of versions allowed for FILE.\n\
 762 Returns nil if the file cannot be opened or if there is no version limit.")
 763   (filename)
 764      Lisp_Object filename;
 765 {
 766   Lisp_Object retval;
 767   struct FAB    fab;
 768   struct RAB    rab;
 769   struct XABFHC xabfhc;
 770   int status;
 771
 772   filename = Fexpand_file_name (filename, Qnil);
 773   fab      = cc$rms_fab;
 774   xabfhc   = cc$rms_xabfhc;
 775   fab.fab$l_fna = XSTRING (filename)->data;
 776   fab.fab$b_fns = strlen (fab.fab$l_fna);
 777   fab.fab$l_xab = (char *) &xabfhc;
 778   status = sys$open (&fab, 0, 0);
 779   if (status != RMS$_NORMAL)    /* Probably non-existent file */
 780     return Qnil;
 781   sys$close (&fab, 0, 0);
 782   if (xabfhc.xab$w_verlimit == 32767)
 783     return Qnil;                /* No version limit */
 784   else
 785     return make_number (xabfhc.xab$w_verlimit);
 786 }
 787
 788 #endif /* VMS */
 789 \f
 790 Lisp_Object
 791 make_time (time)
 792      time_t time;
 793 {
 794   return Fcons (make_number (time >> 16),
 795                 Fcons (make_number (time & 0177777), Qnil));
 796 }
 797
 798 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
 799   "Return a list of attributes of file FILENAME.\n\
 800 Value is nil if specified file cannot be opened.\n\
 801 Otherwise, list elements are:\n\
 802  0. t for directory, string (name linked to) for symbolic link, or nil.\n\
 803  1. Number of links to file.\n\
 804  2. File uid.\n\
 805  3. File gid.\n\
 806  4. Last access time, as a list of two integers.\n\
 807   First integer has high-order 16 bits of time, second has low 16 bits.\n\
 808  5. Last modification time, likewise.\n\
 809  6. Last status change time, likewise.\n\
 810  7. Size in bytes.\n\
 811   This is a floating point number if the size is too large for an integer.\n\
 812  8. File modes, as a string of ten letters or dashes as in ls -l.\n\
 813  9. t iff file's gid would change if file were deleted and recreated.\n\
 814 10. inode number.  If inode number is larger than the Emacs integer,\n\
 815   this is a cons cell containing two integers: first the high part,\n\
 816   then the low 16 bits.\n\
 817 11. Device number.\n\
 818 \n\
 819 If file does not exist, returns nil.")
 820   (filename)
 821      Lisp_Object filename;
 822 {
 823   Lisp_Object values[12];
 824   Lisp_Object encoded;
 825   struct stat s;
 826 #if defined (BSD4_2) || defined (BSD4_3)
 827   Lisp_Object dirname;
 828   struct stat sdir;
 829 #endif
 830   char modes[10];
 831   Lisp_Object handler;
 832
 833   filename = Fexpand_file_name (filename, Qnil);
 834
 835   /* If the file name has special constructs in it,
 836      call the corresponding file handler.  */
 837   handler = Ffind_file_name_handler (filename, Qfile_attributes);
 838   if (!NILP (handler))
 839     return call2 (handler, Qfile_attributes, filename);
 840
 841   encoded = ENCODE_FILE (filename);
 842
 843   if (lstat (XSTRING (encoded)->data, &s) < 0)
 844     return Qnil;
 845
 846   switch (s.st_mode & S_IFMT)
 847     {
 848     default:
 849       values[0] = Qnil; break;
 850     case S_IFDIR:
 851       values[0] = Qt; break;
 852 #ifdef S_IFLNK
 853     case S_IFLNK:
 854       values[0] = Ffile_symlink_p (filename); break;
 855 #endif
 856     }
 857   values[1] = make_number (s.st_nlink);
 858   values[2] = make_number (s.st_uid);
 859   values[3] = make_number (s.st_gid);
 860   values[4] = make_time (s.st_atime);
 861   values[5] = make_time (s.st_mtime);
 862   values[6] = make_time (s.st_ctime);
 863   values[7] = make_number (s.st_size);
 864   /* If the size is out of range for an integer, return a float.  */
 865   if (XINT (values[7]) != s.st_size)
 866     values[7] = make_float ((double)s.st_size);
 867   filemodestring (&s, modes);
 868   values[8] = make_string (modes, 10);
 869 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
 870   dirname = Ffile_name_directory (filename);
 871   if (! NILP (dirname))
 872     encoded = ENCODE_FILE (dirname);
 873   if (! NILP (dirname) && stat (XSTRING (encoded)->data, &sdir) == 0)
 874     values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
 875   else                                  /* if we can't tell, assume worst */
 876     values[9] = Qt;
 877 #else                                   /* file gid will be egid */
 878   values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
 879 #endif  /* BSD4_2 (or BSD4_3) */
 880   /* Cast -1 to avoid warning if int is not as wide as VALBITS.  */
 881   if (s.st_ino & (((EMACS_INT) (-1)) << VALBITS))
 882     /* To allow inode numbers larger than VALBITS, separate the bottom
 883        16 bits.  */
 884     values[10] = Fcons (make_number (s.st_ino >> 16),
 885                         make_number (s.st_ino & 0xffff));
 886   else
 887     /* But keep the most common cases as integers.  */
 888     values[10] = make_number (s.st_ino);
 889
 890   /* Likewise for device.  */
 891   if (s.st_dev & (((EMACS_INT) (-1)) << VALBITS))
 892     values[11] = Fcons (make_number (s.st_dev >> 16),
 893                         make_number (s.st_dev & 0xffff));
 894   else
 895     values[11] = make_number (s.st_dev);
 896
 897   return Flist (sizeof(values) / sizeof(values[0]), values);
 898 }
 899
 900 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
 901   "Return t if first arg file attributes list is less than second.\n\
 902 Comparison is in lexicographic order and case is significant.")
 903   (f1, f2)
 904      Lisp_Object f1, f2;
 905 {
 906   return Fstring_lessp (Fcar (f1), Fcar (f2));
 907 }
 908 \f
 909 void
 910 syms_of_dired ()
 911 {
 912   Qdirectory_files = intern ("directory-files");
 913   Qdirectory_files_and_attributes = intern ("directory-files-and-attributes");
 914   Qfile_name_completion = intern ("file-name-completion");
 915   Qfile_name_all_completions = intern ("file-name-all-completions");
 916   Qfile_attributes = intern ("file-attributes");
 917   Qfile_attributes_lessp = intern ("file-attributes-lessp");
 918
 919   staticpro (&Qdirectory_files);
 920   staticpro (&Qdirectory_files_and_attributes);
 921   staticpro (&Qfile_name_completion);
 922   staticpro (&Qfile_name_all_completions);
 923   staticpro (&Qfile_attributes);
 924   staticpro (&Qfile_attributes_lessp);
 925
 926   defsubr (&Sdirectory_files);
 927   defsubr (&Sdirectory_files_and_attributes);
 928   defsubr (&Sfile_name_completion);
 929 #ifdef VMS
 930   defsubr (&Sfile_name_all_versions);
 931   defsubr (&Sfile_version_limit);
 932 #endif /* VMS */
 933   defsubr (&Sfile_name_all_completions);
 934   defsubr (&Sfile_attributes);
 935   defsubr (&Sfile_attributes_lessp);
 936
 937 #ifdef VMS
 938   Qcompletion_ignore_case = intern ("completion-ignore-case");
 939   staticpro (&Qcompletion_ignore_case);
 940 #endif /* VMS */
 941
 942   DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
 943     "*Completion ignores filenames ending in any string in this list.\n\
 944 This variable does not affect lists of possible completions,\n\
 945 but does affect the commands that actually do completions.");
 946   Vcompletion_ignored_extensions = Qnil;
 947 }