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