src/dired.c

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