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;
 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, 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 #ifdef VMS
 406   extern DIRENTRY * readdirver ();
 407
 408   DIRENTRY *((* readfunc) ());
 409
 410   /* Filename completion on VMS ignores case, since VMS filesys does.  */
 411   specbind (Qcompletion_ignore_case, Qt);
 412
 413   readfunc = readdir;
 414   if (ver_flag)
 415     readfunc = readdirver;
 416   file = Fupcase (file);
 417 #else  /* not VMS */
 418   CHECK_STRING (file, 0);
 419 #endif /* not VMS */
 420
 421 #ifdef FILE_SYSTEM_CASE
 422   file = FILE_SYSTEM_CASE (file);
 423 #endif
 424   bestmatch = Qnil;
 425   encoded_file = encoded_dir = Qnil;
 426   GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
 427   dirname = Fexpand_file_name (dirname, Qnil);
 428
 429   /* Do completion on the encoded file name
 430      because the other names in the directory are (we presume)
 431      encoded likewise.  We decode the completed string at the end.  */
 432   encoded_file = ENCODE_FILE (file);
 433
 434   encoded_dir = ENCODE_FILE (dirname);
 435
 436   /* With passcount = 0, ignore files that end in an ignored extension.
 437      If nothing found then try again with passcount = 1, don't ignore them.
 438      If looking for all completions, start with passcount = 1,
 439      so always take even the ignored ones.
 440
 441      ** It would not actually be helpful to the user to ignore any possible
 442      completions when making a list of them.**  */
 443
 444   for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
 445     {
 446       d = opendir (XSTRING (Fdirectory_file_name (encoded_dir))->data);
 447       if (!d)
 448         report_file_error ("Opening directory", Fcons (dirname, Qnil));
 449
 450       /* Loop reading blocks */
 451       /* (att3b compiler bug requires do a null comparison this way) */
 452       while (1)
 453         {
 454           DIRENTRY *dp;
 455           int len;
 456
 457 #ifdef VMS
 458           dp = (*readfunc) (d);
 459 #else
 460           dp = readdir (d);
 461 #endif
 462           if (!dp) break;
 463
 464           len = NAMLEN (dp);
 465
 466           if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
 467             goto quit;
 468           if (! DIRENTRY_NONEMPTY (dp)
 469               || len < XSTRING (encoded_file)->size
 470               || 0 <= scmp (dp->d_name, XSTRING (encoded_file)->data,
 471                             XSTRING (encoded_file)->size))
 472             continue;
 473
 474           if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
 475             continue;
 476
 477           directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
 478           tem = Qnil;
 479           if (directoryp)
 480             {
 481 #ifndef TRIVIAL_DIRECTORY_ENTRY
 482 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
 483 #endif
 484               /* "." and ".." are never interesting as completions, but are
 485                  actually in the way in a directory contains only one file.  */
 486               if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
 487                 continue;
 488             }
 489           else
 490             {
 491               /* Compare extensions-to-be-ignored against end of this file name */
 492               /* if name is not an exact match against specified string */
 493               if (!passcount && len > XSTRING (encoded_file)->size)
 494                 /* and exit this for loop if a match is found */
 495                 for (tem = Vcompletion_ignored_extensions;
 496                      CONSP (tem); tem = XCDR (tem))
 497                   {
 498                     elt = XCAR (tem);
 499                     if (!STRINGP (elt)) continue;
 500                     skip = len - XSTRING (elt)->size;
 501                     if (skip < 0) continue;
 502
 503                     if (0 <= scmp (dp->d_name + skip,
 504                                    XSTRING (elt)->data,
 505                                    XSTRING (elt)->size))
 506                       continue;
 507                     break;
 508                   }
 509             }
 510
 511           /* If an ignored-extensions match was found,
 512              don't process this name as a completion.  */
 513           if (!passcount && CONSP (tem))
 514             continue;
 515
 516           if (!passcount)
 517             {
 518               Lisp_Object regexps;
 519               Lisp_Object zero;
 520               XSETFASTINT (zero, 0);
 521
 522               /* Ignore this element if it fails to match all the regexps.  */
 523               for (regexps = Vcompletion_regexp_list; CONSP (regexps);
 524                    regexps = XCDR (regexps))
 525                 {
 526                   tem = Fstring_match (XCAR (regexps), elt, zero);
 527                   if (NILP (tem))
 528                     break;
 529                 }
 530               if (CONSP (regexps))
 531                 continue;
 532             }
 533
 534           /* Update computation of how much all possible completions match */
 535
 536           matchcount++;
 537
 538           if (all_flag || NILP (bestmatch))
 539             {
 540               /* This is a possible completion */
 541               if (directoryp)
 542                 {
 543                   /* This completion is a directory; make it end with '/' */
 544                   name = Ffile_name_as_directory (make_string (dp->d_name, len));
 545                 }
 546               else
 547                 name = make_string (dp->d_name, len);
 548               if (all_flag)
 549                 {
 550                   name = DECODE_FILE (name);
 551                   bestmatch = Fcons (name, bestmatch);
 552                 }
 553               else
 554                 {
 555                   bestmatch = name;
 556                   bestmatchsize = XSTRING (name)->size;
 557                 }
 558             }
 559           else
 560             {
 561               compare = min (bestmatchsize, len);
 562               p1 = XSTRING (bestmatch)->data;
 563               p2 = (unsigned char *) dp->d_name;
 564               matchsize = scmp(p1, p2, compare);
 565               if (matchsize < 0)
 566                 matchsize = compare;
 567               if (completion_ignore_case)
 568                 {
 569                   /* If this is an exact match except for case,
 570                      use it as the best match rather than one that is not
 571                      an exact match.  This way, we get the case pattern
 572                      of the actual match.  */
 573                   /* This tests that the current file is an exact match
 574                      but BESTMATCH is not (it is too long).  */
 575                   if ((matchsize == len
 576                        && matchsize + !!directoryp
 577                           < XSTRING (bestmatch)->size)
 578                       ||
 579                       /* If there is no exact match ignoring case,
 580                          prefer a match that does not change the case
 581                          of the input.  */
 582                       /* If there is more than one exact match aside from
 583                          case, and one of them is exact including case,
 584                          prefer that one.  */
 585                       /* This == checks that, of current file and BESTMATCH,
 586                          either both or neither are exact.  */
 587                       (((matchsize == len)
 588                         ==
 589                         (matchsize + !!directoryp
 590                          == XSTRING (bestmatch)->size))
 591                        && !bcmp (p2, XSTRING (encoded_file)->data, XSTRING (encoded_file)->size)
 592                        && bcmp (p1, XSTRING (encoded_file)->data, XSTRING (encoded_file)->size)))
 593                     {
 594                       bestmatch = make_string (dp->d_name, len);
 595                       if (directoryp)
 596                         bestmatch = Ffile_name_as_directory (bestmatch);
 597                     }
 598                 }
 599
 600               /* If this dirname all matches, see if implicit following
 601                  slash does too.  */
 602               if (directoryp
 603                   && compare == matchsize
 604                   && bestmatchsize > matchsize
 605                   && IS_ANY_SEP (p1[matchsize]))
 606                 matchsize++;
 607               bestmatchsize = matchsize;
 608             }
 609         }
 610       closedir (d);
 611     }
 612
 613   UNGCPRO;
 614   bestmatch = unbind_to (count, bestmatch);
 615
 616   if (all_flag || NILP (bestmatch))
 617     {
 618       if (STRINGP (bestmatch))
 619         bestmatch = DECODE_FILE (bestmatch);
 620       return bestmatch;
 621     }
 622   if (matchcount == 1 && bestmatchsize == XSTRING (file)->size)
 623     return Qt;
 624   bestmatch = Fsubstring (bestmatch, make_number (0),
 625                           make_number (bestmatchsize));
 626   /* Now that we got the right initial segment of BESTMATCH,
 627      decode it from the coding system in use.  */
 628   bestmatch = DECODE_FILE (bestmatch);
 629   return bestmatch;
 630
 631  quit:
 632   if (d) closedir (d);
 633   Vquit_flag = Qnil;
 634   return Fsignal (Qquit, Qnil);
 635 }
 636
 637 static int
 638 file_name_completion_stat (dirname, dp, st_addr)
 639      Lisp_Object dirname;
 640      DIRENTRY *dp;
 641      struct stat *st_addr;
 642 {
 643   int len = NAMLEN (dp);
 644   int pos = XSTRING (dirname)->size;
 645   int value;
 646   char *fullname = (char *) alloca (len + pos + 2);
 647
 648 #ifdef MSDOS
 649 #if __DJGPP__ > 1
 650   /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
 651      but aren't required here.  Avoid computing the following fields:
 652      st_inode, st_size and st_nlink for directories, and the execute bits
 653      in st_mode for non-directory files with non-standard extensions.  */
 654
 655   unsigned short save_djstat_flags = _djstat_flags;
 656
 657   _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
 658 #endif /* __DJGPP__ > 1 */
 659 #endif /* MSDOS */
 660
 661   bcopy (XSTRING (dirname)->data, fullname, pos);
 662 #ifndef VMS
 663   if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
 664     fullname[pos++] = DIRECTORY_SEP;
 665 #endif
 666
 667   bcopy (dp->d_name, fullname + pos, len);
 668   fullname[pos + len] = 0;
 669
 670 #ifdef S_IFLNK
 671   /* We want to return success if a link points to a nonexistent file,
 672      but we want to return the status for what the link points to,
 673      in case it is a directory.  */
 674   value = lstat (fullname, st_addr);
 675   stat (fullname, st_addr);
 676   return value;
 677 #else
 678   value = stat (fullname, st_addr);
 679 #ifdef MSDOS
 680 #if __DJGPP__ > 1
 681   _djstat_flags = save_djstat_flags;
 682 #endif /* __DJGPP__ > 1 */
 683 #endif /* MSDOS */
 684   return value;
 685 #endif /* S_IFLNK */
 686 }
 687 \f
 688 #ifdef VMS
 689
 690 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
 691   Sfile_name_all_versions, 2, 2, 0,
 692   "Return a list of all versions of file name FILE in directory DIRECTORY.")
 693   (file, directory)
 694      Lisp_Object file, directory;
 695 {
 696   return file_name_completion (file, directory, 1, 1);
 697 }
 698
 699 DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
 700   "Return the maximum number of versions allowed for FILE.\n\
 701 Returns nil if the file cannot be opened or if there is no version limit.")
 702   (filename)
 703      Lisp_Object filename;
 704 {
 705   Lisp_Object retval;
 706   struct FAB    fab;
 707   struct RAB    rab;
 708   struct XABFHC xabfhc;
 709   int status;
 710
 711   filename = Fexpand_file_name (filename, Qnil);
 712   fab      = cc$rms_fab;
 713   xabfhc   = cc$rms_xabfhc;
 714   fab.fab$l_fna = XSTRING (filename)->data;
 715   fab.fab$b_fns = strlen (fab.fab$l_fna);
 716   fab.fab$l_xab = (char *) &xabfhc;
 717   status = sys$open (&fab, 0, 0);
 718   if (status != RMS$_NORMAL)    /* Probably non-existent file */
 719     return Qnil;
 720   sys$close (&fab, 0, 0);
 721   if (xabfhc.xab$w_verlimit == 32767)
 722     return Qnil;                /* No version limit */
 723   else
 724     return make_number (xabfhc.xab$w_verlimit);
 725 }
 726
 727 #endif /* VMS */
 728 \f
 729 Lisp_Object
 730 make_time (time)
 731      time_t time;
 732 {
 733   return Fcons (make_number (time >> 16),
 734                 Fcons (make_number (time & 0177777), Qnil));
 735 }
 736
 737 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
 738   "Return a list of attributes of file FILENAME.\n\
 739 Value is nil if specified file cannot be opened.\n\
 740 Otherwise, list elements are:\n\
 741  0. t for directory, string (name linked to) for symbolic link, or nil.\n\
 742  1. Number of links to file.\n\
 743  2. File uid.\n\
 744  3. File gid.\n\
 745  4. Last access time, as a list of two integers.\n\
 746   First integer has high-order 16 bits of time, second has low 16 bits.\n\
 747  5. Last modification time, likewise.\n\
 748  6. Last status change time, likewise.\n\
 749  7. Size in bytes.\n\
 750   This is a floating point number if the size is too large for an integer.\n\
 751  8. File modes, as a string of ten letters or dashes as in ls -l.\n\
 752  9. t iff file's gid would change if file were deleted and recreated.\n\
 753 10. inode number.  If inode number is larger than the Emacs integer,\n\
 754   this is a cons cell containing two integers: first the high part,\n\
 755   then the low 16 bits.\n\
 756 11. Device number.\n\
 757 \n\
 758 If file does not exist, returns nil.")
 759   (filename)
 760      Lisp_Object filename;
 761 {
 762   Lisp_Object values[12];
 763   Lisp_Object dirname;
 764   Lisp_Object encoded;
 765   struct stat s;
 766   struct stat sdir;
 767   char modes[10];
 768   Lisp_Object handler;
 769
 770   filename = Fexpand_file_name (filename, Qnil);
 771
 772   /* If the file name has special constructs in it,
 773      call the corresponding file handler.  */
 774   handler = Ffind_file_name_handler (filename, Qfile_attributes);
 775   if (!NILP (handler))
 776     return call2 (handler, Qfile_attributes, filename);
 777
 778   encoded = ENCODE_FILE (filename);
 779
 780   if (lstat (XSTRING (encoded)->data, &s) < 0)
 781     return Qnil;
 782
 783   switch (s.st_mode & S_IFMT)
 784     {
 785     default:
 786       values[0] = Qnil; break;
 787     case S_IFDIR:
 788       values[0] = Qt; break;
 789 #ifdef S_IFLNK
 790     case S_IFLNK:
 791       values[0] = Ffile_symlink_p (filename); break;
 792 #endif
 793     }
 794   values[1] = make_number (s.st_nlink);
 795   values[2] = make_number (s.st_uid);
 796   values[3] = make_number (s.st_gid);
 797   values[4] = make_time (s.st_atime);
 798   values[5] = make_time (s.st_mtime);
 799   values[6] = make_time (s.st_ctime);
 800   values[7] = make_number (s.st_size);
 801   /* If the size is out of range for an integer, return a float.  */
 802   if (XINT (values[7]) != s.st_size)
 803     values[7] = make_float ((double)s.st_size);
 804   filemodestring (&s, modes);
 805   values[8] = make_string (modes, 10);
 806 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
 807 #define BSD4_2 /* A new meaning to the term `backwards compatibility' */
 808 #endif
 809 #ifdef BSD4_2                   /* file gid will be dir gid */
 810   dirname = Ffile_name_directory (filename);
 811   if (! NILP (dirname))
 812     encoded = ENCODE_FILE (dirname);
 813   if (! NILP (dirname) && stat (XSTRING (encoded)->data, &sdir) == 0)
 814     values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
 815   else                                  /* if we can't tell, assume worst */
 816     values[9] = Qt;
 817 #else                                   /* file gid will be egid */
 818   values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
 819 #endif  /* BSD4_2 (or BSD4_3) */
 820 #ifdef BSD4_3
 821 #undef BSD4_2 /* ok, you can look again without throwing up */
 822 #endif
 823   /* Cast -1 to avoid warning if int is not as wide as VALBITS.  */
 824   if (s.st_ino & (((EMACS_INT) (-1)) << VALBITS))
 825     /* To allow inode numbers larger than VALBITS, separate the bottom
 826        16 bits.  */
 827     values[10] = Fcons (make_number (s.st_ino >> 16),
 828                         make_number (s.st_ino & 0xffff));
 829   else
 830     /* But keep the most common cases as integers.  */
 831     values[10] = make_number (s.st_ino);
 832
 833   /* Likewise for device.  */
 834   if (s.st_dev & (((EMACS_INT) (-1)) << VALBITS))
 835     values[11] = Fcons (make_number (s.st_dev >> 16),
 836                         make_number (s.st_dev & 0xffff));
 837   else
 838     values[11] = make_number (s.st_dev);
 839
 840   return Flist (sizeof(values) / sizeof(values[0]), values);
 841 }
 842
 843 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
 844   "Return t if first arg file attributes list is less than second.\n\
 845 Comparison is in lexicographic order and case is significant.")
 846   (f1, f2)
 847      Lisp_Object f1, f2;
 848 {
 849   return Fstring_lessp (Fcar (f1), Fcar (f2));
 850 }
 851 \f
 852 void
 853 syms_of_dired ()
 854 {
 855   Qdirectory_files = intern ("directory-files");
 856   Qdirectory_files_and_attributes = intern ("directory-files-and-attributes");
 857   Qfile_name_completion = intern ("file-name-completion");
 858   Qfile_name_all_completions = intern ("file-name-all-completions");
 859   Qfile_attributes = intern ("file-attributes");
 860   Qfile_attributes_lessp = intern ("file-attributes-lessp");
 861
 862   staticpro (&Qdirectory_files);
 863   staticpro (&Qdirectory_files_and_attributes);
 864   staticpro (&Qfile_name_completion);
 865   staticpro (&Qfile_name_all_completions);
 866   staticpro (&Qfile_attributes);
 867   staticpro (&Qfile_attributes_lessp);
 868
 869   defsubr (&Sdirectory_files);
 870   defsubr (&Sdirectory_files_and_attributes);
 871   defsubr (&Sfile_name_completion);
 872 #ifdef VMS
 873   defsubr (&Sfile_name_all_versions);
 874   defsubr (&Sfile_version_limit);
 875 #endif /* VMS */
 876   defsubr (&Sfile_name_all_completions);
 877   defsubr (&Sfile_attributes);
 878   defsubr (&Sfile_attributes_lessp);
 879
 880 #ifdef VMS
 881   Qcompletion_ignore_case = intern ("completion-ignore-case");
 882   staticpro (&Qcompletion_ignore_case);
 883 #endif /* VMS */
 884
 885   DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
 886     "*Completion ignores filenames ending in any string in this list.\n\
 887 This variable does not affect lists of possible completions,\n\
 888 but does affect the commands that actually do completions.");
 889   Vcompletion_ignored_extensions = Qnil;
 890 }