src/dired.c

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