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