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