src/dired.c

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