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