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