src/dired.c

   1 /* Lisp functions for making directory listings.
   2    Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001, 2002, 2003,
   3                  2004, 2005, 2006 Free Software Foundation, Inc.
   4
   5 This file is part of GNU Emacs.
   6
   7 GNU Emacs is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GNU Emacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU Emacs; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  20 Boston, MA 02110-1301, USA.  */
  21
  22
  23 #include <config.h>
  24
  25 #include <stdio.h>
  26 #include <sys/types.h>
  27 #include <sys/stat.h>
  28
  29 #ifdef HAVE_PWD_H
  30 #include <pwd.h>
  31 #endif
  32 #ifndef VMS
  33 #include <grp.h>
  34 #endif
  35
  36 #include <errno.h>
  37
  38 #ifdef VMS
  39 #include <string.h>
  40 #include <rms.h>
  41 #include <rmsdef.h>
  42 #endif
  43
  44 #ifdef HAVE_UNISTD_H
  45 #include <unistd.h>
  46 #endif
  47
  48 /* The d_nameln member of a struct dirent includes the '\0' character
  49    on some systems, but not on others.  What's worse, you can't tell
  50    at compile-time which one it will be, since it really depends on
  51    the sort of system providing the filesystem you're reading from,
  52    not the system you are running on.  Paul Eggert
  53    <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
  54    SunOS 4.1.2 host, reading a directory that is remote-mounted from a
  55    Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
  56
  57    Since applying strlen to the name always works, we'll just do that.  */
  58 #define NAMLEN(p) strlen (p->d_name)
  59
  60 #ifdef SYSV_SYSTEM_DIR
  61
  62 #include <dirent.h>
  63 #define DIRENTRY struct dirent
  64
  65 #else /* not SYSV_SYSTEM_DIR */
  66
  67 #ifdef NONSYSTEM_DIR_LIBRARY
  68 #include "ndir.h"
  69 #else /* not NONSYSTEM_DIR_LIBRARY */
  70 #ifdef MSDOS
  71 #include <dirent.h>
  72 #else
  73 #include <sys/dir.h>
  74 #endif
  75 #endif /* not NONSYSTEM_DIR_LIBRARY */
  76
  77 #include <sys/stat.h>
  78
  79 #ifndef MSDOS
  80 #define DIRENTRY struct direct
  81
  82 extern DIR *opendir ();
  83 extern struct direct *readdir ();
  84
  85 #endif /* not MSDOS */
  86 #endif /* not SYSV_SYSTEM_DIR */
  87
  88 /* Some versions of Cygwin don't have d_ino in `struct dirent'.  */
  89 #if defined(MSDOS) || defined(__CYGWIN__)
  90 #define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
  91 #else
  92 #define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
  93 #endif
  94
  95 #include "lisp.h"
  96 #include "systime.h"
  97 #include "buffer.h"
  98 #include "commands.h"
  99 #include "charset.h"
 100 #include "coding.h"
 101 #include "regex.h"
 102
 103 /* Returns a search buffer, with a fastmap allocated and ready to go.  */
 104 extern struct re_pattern_buffer *compile_pattern ();
 105
 106 /* From filemode.c.  Can't go in Lisp.h because of `stat'.  */
 107 extern void filemodestring P_ ((struct stat *, char *));
 108
 109 /* if system does not have symbolic links, it does not have lstat.
 110    In that case, use ordinary stat instead.  */
 111
 112 #ifndef S_IFLNK
 113 #define lstat stat
 114 #endif
 115
 116 extern int completion_ignore_case;
 117 extern Lisp_Object Vcompletion_regexp_list;
 118
 119 Lisp_Object Vcompletion_ignored_extensions;
 120 Lisp_Object Qcompletion_ignore_case;
 121 Lisp_Object Qdirectory_files;
 122 Lisp_Object Qdirectory_files_and_attributes;
 123 Lisp_Object Qfile_name_completion;
 124 Lisp_Object Qfile_name_all_completions;
 125 Lisp_Object Qfile_attributes;
 126 Lisp_Object Qfile_attributes_lessp;
 127
 128 static int scmp P_ ((unsigned char *, unsigned char *, int));
 129 \f
 130
 131 Lisp_Object
 132 directory_files_internal_unwind (dh)
 133      Lisp_Object dh;
 134 {
 135   DIR *d = (DIR *) XSAVE_VALUE (dh)->pointer;
 136   closedir (d);
 137   return Qnil;
 138 }
 139
 140 /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
 141    When ATTRS is zero, return a list of directory filenames; when
 142    non-zero, return a list of directory filenames and their attributes.
 143    In the latter case, ID_FORMAT is passed to Ffile_attributes.  */
 144
 145 Lisp_Object
 146 directory_files_internal (directory, full, match, nosort, attrs, id_format)
 147      Lisp_Object directory, full, match, nosort;
 148      int attrs;
 149      Lisp_Object id_format;
 150 {
 151   DIR *d;
 152   int directory_nbytes;
 153   Lisp_Object list, dirfilename, encoded_directory;
 154   struct re_pattern_buffer *bufp = NULL;
 155   int needsep = 0;
 156   int count = SPECPDL_INDEX ();
 157   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 158   DIRENTRY *dp;
 159
 160   /* Because of file name handlers, these functions might call
 161      Ffuncall, and cause a GC.  */
 162   list = encoded_directory = dirfilename = Qnil;
 163   GCPRO5 (match, directory, list, dirfilename, encoded_directory);
 164   dirfilename = Fdirectory_file_name (directory);
 165
 166   if (!NILP (match))
 167     {
 168       CHECK_STRING (match);
 169
 170       /* MATCH might be a flawed regular expression.  Rather than
 171          catching and signaling our own errors, we just call
 172          compile_pattern to do the work for us.  */
 173       /* Pass 1 for the MULTIBYTE arg
 174          because we do make multibyte strings if the contents warrant.  */
 175 #ifdef VMS
 176       bufp = compile_pattern (match, 0,
 177                               buffer_defaults.downcase_table, 0, 1);
 178 #else  /* !VMS */
 179 # ifdef WINDOWSNT
 180       /* Windows users want case-insensitive wildcards.  */
 181       bufp = compile_pattern (match, 0,
 182                               buffer_defaults.case_canon_table, 0, 1);
 183 # else  /* !WINDOWSNT */
 184       bufp = compile_pattern (match, 0, Qnil, 0, 1);
 185 # endif  /* !WINDOWSNT */
 186 #endif   /* !VMS */
 187     }
 188
 189   /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
 190      run_pre_post_conversion_on_str which calls Lisp directly and
 191      indirectly.  */
 192   dirfilename = ENCODE_FILE (dirfilename);
 193   encoded_directory = ENCODE_FILE (directory);
 194
 195   /* Now *bufp is the compiled form of MATCH; don't call anything
 196      which might compile a new regexp until we're done with the loop!  */
 197
 198   d = opendir (SDATA (dirfilename));
 199   if (d == NULL)
 200     report_file_error ("Opening directory", Fcons (directory, Qnil));
 201
 202   /* Unfortunately, we can now invoke expand-file-name and
 203      file-attributes on filenames, both of which can throw, so we must
 204      do a proper unwind-protect.  */
 205   record_unwind_protect (directory_files_internal_unwind,
 206                          make_save_value (d, 0));
 207
 208   directory_nbytes = SBYTES (directory);
 209   re_match_object = Qt;
 210
 211   /* Decide whether we need to add a directory separator.  */
 212 #ifndef VMS
 213   if (directory_nbytes == 0
 214       || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
 215     needsep = 1;
 216 #endif /* not VMS */
 217
 218   /* Loop reading blocks until EOF or error.  */
 219   for (;;)
 220     {
 221       errno = 0;
 222       dp = readdir (d);
 223
 224       if (dp == NULL && (0
 225 #ifdef EAGAIN
 226                          || errno == EAGAIN
 227 #endif
 228 #ifdef EINTR
 229                          || errno == EINTR
 230 #endif
 231                          ))
 232         { QUIT; continue; }
 233
 234       if (dp == NULL)
 235         break;
 236
 237       if (DIRENTRY_NONEMPTY (dp))
 238         {
 239           int len;
 240           int wanted = 0;
 241           Lisp_Object name, finalname;
 242           struct gcpro gcpro1, gcpro2;
 243
 244           len = NAMLEN (dp);
 245           name = finalname = make_unibyte_string (dp->d_name, len);
 246           GCPRO2 (finalname, name);
 247
 248           /* Note: ENCODE_FILE can GC; it should protect its argument,
 249              though.  */
 250           name = DECODE_FILE (name);
 251           len = SBYTES (name);
 252
 253           /* Now that we have unwind_protect in place, we might as well
 254              allow matching to be interrupted.  */
 255           immediate_quit = 1;
 256           QUIT;
 257
 258           if (NILP (match)
 259               || (0 <= re_search (bufp, SDATA (name), len, 0, len, 0)))
 260             wanted = 1;
 261
 262           immediate_quit = 0;
 263
 264           if (wanted)
 265             {
 266               if (!NILP (full))
 267                 {
 268                   Lisp_Object fullname;
 269                   int nbytes = len + directory_nbytes + needsep;
 270                   int nchars;
 271
 272                   fullname = make_uninit_multibyte_string (nbytes, nbytes);
 273                   bcopy (SDATA (directory), SDATA (fullname),
 274                          directory_nbytes);
 275
 276                   if (needsep)
 277                     SSET (fullname, directory_nbytes, DIRECTORY_SEP);
 278
 279                   bcopy (SDATA (name),
 280                          SDATA (fullname) + directory_nbytes + needsep,
 281                          len);
 282
 283                   nchars = chars_in_text (SDATA (fullname), nbytes);
 284
 285                   /* Some bug somewhere.  */
 286                   if (nchars > nbytes)
 287                     abort ();
 288
 289                   STRING_SET_CHARS (fullname, nchars);
 290                   if (nchars == nbytes)
 291                     STRING_SET_UNIBYTE (fullname);
 292
 293                   finalname = fullname;
 294                 }
 295               else
 296                 finalname = name;
 297
 298               if (attrs)
 299                 {
 300                   /* Construct an expanded filename for the directory entry.
 301                      Use the decoded names for input to Ffile_attributes.  */
 302                   Lisp_Object decoded_fullname, fileattrs;
 303                   struct gcpro gcpro1, gcpro2;
 304
 305                   decoded_fullname = fileattrs = Qnil;
 306                   GCPRO2 (decoded_fullname, fileattrs);
 307
 308                   /* Both Fexpand_file_name and Ffile_attributes can GC.  */
 309                   decoded_fullname = Fexpand_file_name (name, directory);
 310                   fileattrs = Ffile_attributes (decoded_fullname, id_format);
 311
 312                   list = Fcons (Fcons (finalname, fileattrs), list);
 313                   UNGCPRO;
 314                 }
 315               else
 316                 list = Fcons (finalname, list);
 317             }
 318
 319           UNGCPRO;
 320         }
 321     }
 322
 323   closedir (d);
 324
 325   /* Discard the unwind protect.  */
 326   specpdl_ptr = specpdl + count;
 327
 328   if (NILP (nosort))
 329     list = Fsort (Fnreverse (list),
 330                   attrs ? Qfile_attributes_lessp : Qstring_lessp);
 331
 332   RETURN_UNGCPRO (list);
 333 }
 334
 335
 336 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
 337        doc: /* Return a list of names of files in DIRECTORY.
 338 There are three optional arguments:
 339 If FULL is non-nil, return absolute file names.  Otherwise return names
 340  that are relative to the specified directory.
 341 If MATCH is non-nil, mention only file names that match the regexp MATCH.
 342 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
 343  NOSORT is useful if you plan to sort the result yourself.  */)
 344      (directory, full, match, nosort)
 345      Lisp_Object directory, full, match, nosort;
 346 {
 347   Lisp_Object handler;
 348   directory = Fexpand_file_name (directory, Qnil);
 349
 350   /* If the file name has special constructs in it,
 351      call the corresponding file handler.  */
 352   handler = Ffind_file_name_handler (directory, Qdirectory_files);
 353   if (!NILP (handler))
 354     return call5 (handler, Qdirectory_files, directory,
 355                   full, match, nosort);
 356
 357   return directory_files_internal (directory, full, match, nosort, 0, Qnil);
 358 }
 359
 360 DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
 361        Sdirectory_files_and_attributes, 1, 5, 0,
 362        doc: /* Return a list of names of files and their attributes in DIRECTORY.
 363 There are four optional arguments:
 364 If FULL is non-nil, return absolute file names.  Otherwise return names
 365  that are relative to the specified directory.
 366 If MATCH is non-nil, mention only file names that match the regexp MATCH.
 367 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
 368  NOSORT is useful if you plan to sort the result yourself.
 369 ID-FORMAT specifies the preferred format of attributes uid and gid, see
 370 `file-attributes' for further documentation. */)
 371      (directory, full, match, nosort, id_format)
 372      Lisp_Object directory, full, match, nosort, id_format;
 373 {
 374   Lisp_Object handler;
 375   directory = Fexpand_file_name (directory, Qnil);
 376
 377   /* If the file name has special constructs in it,
 378      call the corresponding file handler.  */
 379   handler = Ffind_file_name_handler (directory, Qdirectory_files_and_attributes);
 380   if (!NILP (handler))
 381     return call6 (handler, Qdirectory_files_and_attributes,
 382                   directory, full, match, nosort, id_format);
 383
 384   return directory_files_internal (directory, full, match, nosort, 1, id_format);
 385 }
 386
 387 \f
 388 Lisp_Object file_name_completion ();
 389
 390 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
 391        2, 2, 0,
 392        doc: /* Complete file name FILE in directory DIRECTORY.
 393 Returns the longest string
 394 common to all file names in DIRECTORY that start with FILE.
 395 If there is only one and FILE matches it exactly, returns t.
 396 Returns nil if DIRECTORY contains no name starting with FILE.
 397
 398 This function ignores some of the possible completions as
 399 determined by the variable `completion-ignored-extensions', which see.  */)
 400      (file, directory)
 401      Lisp_Object file, directory;
 402 {
 403   Lisp_Object handler;
 404
 405   /* If the directory name has special constructs in it,
 406      call the corresponding file handler.  */
 407   handler = Ffind_file_name_handler (directory, Qfile_name_completion);
 408   if (!NILP (handler))
 409     return call3 (handler, Qfile_name_completion, file, directory);
 410
 411   /* If the file name has special constructs in it,
 412      call the corresponding file handler.  */
 413   handler = Ffind_file_name_handler (file, Qfile_name_completion);
 414   if (!NILP (handler))
 415     return call3 (handler, Qfile_name_completion, file, directory);
 416
 417   return file_name_completion (file, directory, 0, 0);
 418 }
 419
 420 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
 421        Sfile_name_all_completions, 2, 2, 0,
 422        doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
 423 These are all file names in directory DIRECTORY which begin with FILE.  */)
 424      (file, directory)
 425      Lisp_Object file, directory;
 426 {
 427   Lisp_Object handler;
 428
 429   /* If the directory name has special constructs in it,
 430      call the corresponding file handler.  */
 431   handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
 432   if (!NILP (handler))
 433     return call3 (handler, Qfile_name_all_completions, file, directory);
 434
 435   /* If the file name has special constructs in it,
 436      call the corresponding file handler.  */
 437   handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
 438   if (!NILP (handler))
 439     return call3 (handler, Qfile_name_all_completions, file, directory);
 440
 441   return file_name_completion (file, directory, 1, 0);
 442 }
 443
 444 static int file_name_completion_stat ();
 445
 446 Lisp_Object
 447 file_name_completion (file, dirname, all_flag, ver_flag)
 448      Lisp_Object file, dirname;
 449      int all_flag, ver_flag;
 450 {
 451   DIR *d;
 452   int bestmatchsize = 0, skip;
 453   register int compare, matchsize;
 454   unsigned char *p1, *p2;
 455   int matchcount = 0;
 456   Lisp_Object bestmatch, tem, elt, name;
 457   Lisp_Object encoded_file;
 458   Lisp_Object encoded_dir;
 459   struct stat st;
 460   int directoryp;
 461   int passcount;
 462   int count = SPECPDL_INDEX ();
 463   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 464
 465   elt = Qnil;
 466
 467 #ifdef VMS
 468   extern DIRENTRY * readdirver ();
 469
 470   DIRENTRY *((* readfunc) ());
 471
 472   /* Filename completion on VMS ignores case, since VMS filesys does.  */
 473   specbind (Qcompletion_ignore_case, Qt);
 474
 475   readfunc = readdir;
 476   if (ver_flag)
 477     readfunc = readdirver;
 478   file = Fupcase (file);
 479 #else  /* not VMS */
 480   CHECK_STRING (file);
 481 #endif /* not VMS */
 482
 483 #ifdef FILE_SYSTEM_CASE
 484   file = FILE_SYSTEM_CASE (file);
 485 #endif
 486   bestmatch = Qnil;
 487   encoded_file = encoded_dir = Qnil;
 488   GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
 489   dirname = Fexpand_file_name (dirname, Qnil);
 490
 491   /* Do completion on the encoded file name
 492      because the other names in the directory are (we presume)
 493      encoded likewise.  We decode the completed string at the end.  */
 494   encoded_file = ENCODE_FILE (file);
 495
 496   encoded_dir = ENCODE_FILE (dirname);
 497
 498   /* With passcount = 0, ignore files that end in an ignored extension.
 499      If nothing found then try again with passcount = 1, don't ignore them.
 500      If looking for all completions, start with passcount = 1,
 501      so always take even the ignored ones.
 502
 503      ** It would not actually be helpful to the user to ignore any possible
 504      completions when making a list of them.**  */
 505
 506   for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
 507     {
 508       int inner_count = SPECPDL_INDEX ();
 509
 510       d = opendir (SDATA (Fdirectory_file_name (encoded_dir)));
 511       if (!d)
 512         report_file_error ("Opening directory", Fcons (dirname, Qnil));
 513
 514       record_unwind_protect (directory_files_internal_unwind,
 515                              make_save_value (d, 0));
 516
 517       /* Loop reading blocks */
 518       /* (att3b compiler bug requires do a null comparison this way) */
 519       while (1)
 520         {
 521           DIRENTRY *dp;
 522           int len;
 523
 524 #ifdef VMS
 525           dp = (*readfunc) (d);
 526 #else
 527           errno = 0;
 528           dp = readdir (d);
 529           if (dp == NULL && (0
 530 # ifdef EAGAIN
 531                              || errno == EAGAIN
 532 # endif
 533 # ifdef EINTR
 534                              || errno == EINTR
 535 # endif
 536                              ))
 537             { QUIT; continue; }
 538 #endif
 539
 540           if (!dp) break;
 541
 542           len = NAMLEN (dp);
 543
 544           QUIT;
 545           if (! DIRENTRY_NONEMPTY (dp)
 546               || len < SCHARS (encoded_file)
 547               || 0 <= scmp (dp->d_name, SDATA (encoded_file),
 548                             SCHARS (encoded_file)))
 549             continue;
 550
 551           if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
 552             continue;
 553
 554           directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
 555           tem = Qnil;
 556           if (directoryp)
 557             {
 558 #ifndef TRIVIAL_DIRECTORY_ENTRY
 559 #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
 560 #endif
 561               /* "." and ".." are never interesting as completions, but are
 562                  actually in the way in a directory contains only one file.  */
 563               if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
 564                 continue;
 565               if (!passcount && len > SCHARS (encoded_file))
 566                 /* Ignore directories if they match an element of
 567                    completion-ignored-extensions which ends in a slash.  */
 568                 for (tem = Vcompletion_ignored_extensions;
 569                      CONSP (tem); tem = XCDR (tem))
 570                   {
 571                     int elt_len;
 572
 573                     elt = XCAR (tem);
 574                     if (!STRINGP (elt))
 575                       continue;
 576                     /* Need to encode ELT, since scmp compares unibyte
 577                        strings only.  */
 578                     elt = ENCODE_FILE (elt);
 579                     elt_len = SCHARS (elt) - 1; /* -1 for trailing / */
 580                     if (elt_len <= 0)
 581                       continue;
 582                     p1 = SDATA (elt);
 583                     if (p1[elt_len] != '/')
 584                       continue;
 585                     skip = len - elt_len;
 586                     if (skip < 0)
 587                       continue;
 588
 589                     if (0 <= scmp (dp->d_name + skip, p1, elt_len))
 590                       continue;
 591                     break;
 592                   }
 593             }
 594           else
 595             {
 596               /* Compare extensions-to-be-ignored against end of this file name */
 597               /* if name is not an exact match against specified string */
 598               if (!passcount && len > SCHARS (encoded_file))
 599                 /* and exit this for loop if a match is found */
 600                 for (tem = Vcompletion_ignored_extensions;
 601                      CONSP (tem); tem = XCDR (tem))
 602                   {
 603                     elt = XCAR (tem);
 604                     if (!STRINGP (elt)) continue;
 605                     /* Need to encode ELT, since scmp compares unibyte
 606                        strings only.  */
 607                     elt = ENCODE_FILE (elt);
 608                     skip = len - SCHARS (elt);
 609                     if (skip < 0) continue;
 610
 611                     if (0 <= scmp (dp->d_name + skip,
 612                                    SDATA (elt),
 613                                    SCHARS (elt)))
 614                       continue;
 615                     break;
 616                   }
 617             }
 618
 619           /* If an ignored-extensions match was found,
 620              don't process this name as a completion.  */
 621           if (!passcount && CONSP (tem))
 622             continue;
 623
 624           if (!passcount)
 625             {
 626               Lisp_Object regexps;
 627               Lisp_Object zero;
 628               XSETFASTINT (zero, 0);
 629
 630               /* Ignore this element if it fails to match all the regexps.  */
 631               for (regexps = Vcompletion_regexp_list; CONSP (regexps);
 632                    regexps = XCDR (regexps))
 633                 {
 634                   tem = Fstring_match (XCAR (regexps),
 635                                        make_string (dp->d_name, len), zero);
 636                   if (NILP (tem))
 637                     break;
 638                 }
 639               if (CONSP (regexps))
 640                 continue;
 641             }
 642
 643           /* Update computation of how much all possible completions match */
 644
 645           matchcount++;
 646
 647           if (all_flag || NILP (bestmatch))
 648             {
 649               /* This is a possible completion */
 650               if (directoryp)
 651                 {
 652                   /* This completion is a directory; make it end with '/' */
 653                   name = Ffile_name_as_directory (make_string (dp->d_name, len));
 654                 }
 655               else
 656                 name = make_string (dp->d_name, len);
 657               if (all_flag)
 658                 {
 659                   name = DECODE_FILE (name);
 660                   bestmatch = Fcons (name, bestmatch);
 661                 }
 662               else
 663                 {
 664                   bestmatch = name;
 665                   bestmatchsize = SCHARS (name);
 666                 }
 667             }
 668           else
 669             {
 670               compare = min (bestmatchsize, len);
 671               p1 = SDATA (bestmatch);
 672               p2 = (unsigned char *) dp->d_name;
 673               matchsize = scmp(p1, p2, compare);
 674               if (matchsize < 0)
 675                 matchsize = compare;
 676               if (completion_ignore_case)
 677                 {
 678                   /* If this is an exact match except for case,
 679                      use it as the best match rather than one that is not
 680                      an exact match.  This way, we get the case pattern
 681                      of the actual match.  */
 682                   /* This tests that the current file is an exact match
 683                      but BESTMATCH is not (it is too long).  */
 684                   if ((matchsize == len
 685                        && matchsize + !!directoryp
 686                           < SCHARS (bestmatch))
 687                       ||
 688                       /* If there is no exact match ignoring case,
 689                          prefer a match that does not change the case
 690                          of the input.  */
 691                       /* If there is more than one exact match aside from
 692                          case, and one of them is exact including case,
 693                          prefer that one.  */
 694                       /* This == checks that, of current file and BESTMATCH,
 695                          either both or neither are exact.  */
 696                       (((matchsize == len)
 697                         ==
 698                         (matchsize + !!directoryp
 699                          == SCHARS (bestmatch)))
 700                        && !bcmp (p2, SDATA (encoded_file), SCHARS (encoded_file))
 701                        && bcmp (p1, SDATA (encoded_file), SCHARS (encoded_file))))
 702                     {
 703                       bestmatch = make_string (dp->d_name, len);
 704                       if (directoryp)
 705                         bestmatch = Ffile_name_as_directory (bestmatch);
 706                     }
 707                 }
 708
 709               /* If this dirname all matches, see if implicit following
 710                  slash does too.  */
 711               if (directoryp
 712                   && compare == matchsize
 713                   && bestmatchsize > matchsize
 714                   && IS_ANY_SEP (p1[matchsize]))
 715                 matchsize++;
 716               bestmatchsize = matchsize;
 717             }
 718         }
 719       /* This closes the directory.  */
 720       bestmatch = unbind_to (inner_count, bestmatch);
 721     }
 722
 723   UNGCPRO;
 724   bestmatch = unbind_to (count, bestmatch);
 725
 726   if (all_flag || NILP (bestmatch))
 727     {
 728       if (STRINGP (bestmatch))
 729         bestmatch = DECODE_FILE (bestmatch);
 730       return bestmatch;
 731     }
 732   if (matchcount == 1 && bestmatchsize == SCHARS (file))
 733     return Qt;
 734   bestmatch = Fsubstring (bestmatch, make_number (0),
 735                           make_number (bestmatchsize));
 736   /* Now that we got the right initial segment of BESTMATCH,
 737      decode it from the coding system in use.  */
 738   bestmatch = DECODE_FILE (bestmatch);
 739   return bestmatch;
 740 }
 741
 742 /* Compare exactly LEN chars of strings at S1 and S2,
 743    ignoring case if appropriate.
 744    Return -1 if strings match,
 745    else number of chars that match at the beginning.  */
 746
 747 static int
 748 scmp (s1, s2, len)
 749      register unsigned char *s1, *s2;
 750      int len;
 751 {
 752   register int l = len;
 753
 754   if (completion_ignore_case)
 755     {
 756       while (l && DOWNCASE (*s1++) == DOWNCASE (*s2++))
 757         l--;
 758     }
 759   else
 760     {
 761       while (l && *s1++ == *s2++)
 762         l--;
 763     }
 764   if (l == 0)
 765     return -1;
 766   else
 767     return len - l;
 768 }
 769
 770 static int
 771 file_name_completion_stat (dirname, dp, st_addr)
 772      Lisp_Object dirname;
 773      DIRENTRY *dp;
 774      struct stat *st_addr;
 775 {
 776   int len = NAMLEN (dp);
 777   int pos = SCHARS (dirname);
 778   int value;
 779   char *fullname = (char *) alloca (len + pos + 2);
 780
 781 #ifdef MSDOS
 782 #if __DJGPP__ > 1
 783   /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
 784      but aren't required here.  Avoid computing the following fields:
 785      st_inode, st_size and st_nlink for directories, and the execute bits
 786      in st_mode for non-directory files with non-standard extensions.  */
 787
 788   unsigned short save_djstat_flags = _djstat_flags;
 789
 790   _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
 791 #endif /* __DJGPP__ > 1 */
 792 #endif /* MSDOS */
 793
 794   bcopy (SDATA (dirname), fullname, pos);
 795 #ifndef VMS
 796   if (!IS_DIRECTORY_SEP (fullname[pos - 1]))
 797     fullname[pos++] = DIRECTORY_SEP;
 798 #endif
 799
 800   bcopy (dp->d_name, fullname + pos, len);
 801   fullname[pos + len] = 0;
 802
 803 #ifdef S_IFLNK
 804   /* We want to return success if a link points to a nonexistent file,
 805      but we want to return the status for what the link points to,
 806      in case it is a directory.  */
 807   value = lstat (fullname, st_addr);
 808   stat (fullname, st_addr);
 809   return value;
 810 #else
 811   value = stat (fullname, st_addr);
 812 #ifdef MSDOS
 813 #if __DJGPP__ > 1
 814   _djstat_flags = save_djstat_flags;
 815 #endif /* __DJGPP__ > 1 */
 816 #endif /* MSDOS */
 817   return value;
 818 #endif /* S_IFLNK */
 819 }
 820 \f
 821 #ifdef VMS
 822
 823 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
 824        Sfile_name_all_versions, 2, 2, 0,
 825        doc: /* Return a list of all versions of file name FILE in directory DIRECTORY.  */)
 826      (file, directory)
 827      Lisp_Object file, directory;
 828 {
 829   return file_name_completion (file, directory, 1, 1);
 830 }
 831
 832 DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
 833        doc: /* Return the maximum number of versions allowed for FILE.
 834 Returns nil if the file cannot be opened or if there is no version limit.  */)
 835      (filename)
 836      Lisp_Object filename;
 837 {
 838   Lisp_Object retval;
 839   struct FAB    fab;
 840   struct RAB    rab;
 841   struct XABFHC xabfhc;
 842   int status;
 843
 844   filename = Fexpand_file_name (filename, Qnil);
 845   fab      = cc$rms_fab;
 846   xabfhc   = cc$rms_xabfhc;
 847   fab.fab$l_fna = SDATA (filename);
 848   fab.fab$b_fns = strlen (fab.fab$l_fna);
 849   fab.fab$l_xab = (char *) &xabfhc;
 850   status = sys$open (&fab, 0, 0);
 851   if (status != RMS$_NORMAL)    /* Probably non-existent file */
 852     return Qnil;
 853   sys$close (&fab, 0, 0);
 854   if (xabfhc.xab$w_verlimit == 32767)
 855     return Qnil;                /* No version limit */
 856   else
 857     return make_number (xabfhc.xab$w_verlimit);
 858 }
 859
 860 #endif /* VMS */
 861 \f
 862 Lisp_Object
 863 make_time (time)
 864      time_t time;
 865 {
 866   return Fcons (make_number (time >> 16),
 867                 Fcons (make_number (time & 0177777), Qnil));
 868 }
 869
 870 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 2, 0,
 871        doc: /* Return a list of attributes of file FILENAME.
 872 Value is nil if specified file cannot be opened.
 873
 874 ID-FORMAT specifies the preferred format of attributes uid and gid (see
 875 below) - valid values are 'string and 'integer. The latter is the default,
 876 but we plan to change that, so you should specify a non-nil value for
 877 ID-FORMAT if you use the returned uid or gid.
 878
 879 Elements of the attribute list are:
 880  0. t for directory, string (name linked to) for symbolic link, or nil.
 881  1. Number of links to file.
 882  2. File uid as a string or an integer.  If a string value cannot be
 883   looked up, the integer value is returned.
 884  3. File gid, likewise.
 885  4. Last access time, as a list of two integers.
 886   First integer has high-order 16 bits of time, second has low 16 bits.
 887  5. Last modification time, likewise.
 888  6. Last status change time, likewise.
 889  7. Size in bytes.
 890   This is a floating point number if the size is too large for an integer.
 891  8. File modes, as a string of ten letters or dashes as in ls -l.
 892  9. t iff file's gid would change if file were deleted and recreated.
 893 10. inode number.  If inode number is larger than the Emacs integer,
 894   this is a cons cell containing two integers: first the high part,
 895   then the low 16 bits.
 896 11. Device number.  If it is larger than the Emacs integer, this is
 897   a cons cell, similar to the inode number.  */)
 898      (filename, id_format)
 899      Lisp_Object filename, id_format;
 900 {
 901   Lisp_Object values[12];
 902   Lisp_Object encoded;
 903   struct stat s;
 904   struct passwd *pw;
 905   struct group *gr;
 906 #if defined (BSD4_2) || defined (BSD4_3)
 907   Lisp_Object dirname;
 908   struct stat sdir;
 909 #endif
 910   char modes[10];
 911   Lisp_Object handler;
 912   struct gcpro gcpro1;
 913
 914   filename = Fexpand_file_name (filename, Qnil);
 915
 916   /* If the file name has special constructs in it,
 917      call the corresponding file handler.  */
 918   handler = Ffind_file_name_handler (filename, Qfile_attributes);
 919   if (!NILP (handler))
 920     { /* Only pass the extra arg if it is used to help backward compatibility
 921          with old file handlers which do not implement the new arg.  --Stef  */
 922       if (NILP (id_format))
 923         return call2 (handler, Qfile_attributes, filename);
 924       else
 925         return call3 (handler, Qfile_attributes, filename, id_format);
 926     }
 927
 928   GCPRO1 (filename);
 929   encoded = ENCODE_FILE (filename);
 930   UNGCPRO;
 931
 932   if (lstat (SDATA (encoded), &s) < 0)
 933     return Qnil;
 934
 935   switch (s.st_mode & S_IFMT)
 936     {
 937     default:
 938       values[0] = Qnil; break;
 939     case S_IFDIR:
 940       values[0] = Qt; break;
 941 #ifdef S_IFLNK
 942     case S_IFLNK:
 943       values[0] = Ffile_symlink_p (filename); break;
 944 #endif
 945     }
 946   values[1] = make_number (s.st_nlink);
 947   if (NILP (id_format) || EQ (id_format, Qinteger))
 948     {
 949       values[2] = make_number (s.st_uid);
 950       values[3] = make_number (s.st_gid);
 951     }
 952   else
 953     {
 954       pw = (struct passwd *) getpwuid (s.st_uid);
 955       values[2] = (pw ? build_string (pw->pw_name) : make_number (s.st_uid));
 956       gr = (struct group *) getgrgid (s.st_gid);
 957       values[3] = (gr ? build_string (gr->gr_name) : make_number (s.st_gid));
 958     }
 959   values[4] = make_time (s.st_atime);
 960   values[5] = make_time (s.st_mtime);
 961   values[6] = make_time (s.st_ctime);
 962   values[7] = make_number (s.st_size);
 963   /* If the size is out of range for an integer, return a float.  */
 964   if (XINT (values[7]) != s.st_size)
 965     values[7] = make_float ((double)s.st_size);
 966   /* If the size is negative, and its type is long, convert it back to
 967      positive.  */
 968   if (s.st_size < 0 && sizeof (s.st_size) == sizeof (long))
 969     values[7] = make_float ((double) ((unsigned long) s.st_size));
 970
 971   filemodestring (&s, modes);
 972   values[8] = make_string (modes, 10);
 973 #if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */
 974   dirname = Ffile_name_directory (filename);
 975   if (! NILP (dirname))
 976     encoded = ENCODE_FILE (dirname);
 977   if (! NILP (dirname) && stat (SDATA (encoded), &sdir) == 0)
 978     values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
 979   else                                  /* if we can't tell, assume worst */
 980     values[9] = Qt;
 981 #else                                   /* file gid will be egid */
 982   values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
 983 #endif  /* BSD4_2 (or BSD4_3) */
 984   if (FIXNUM_OVERFLOW_P (s.st_ino))
 985     /* To allow inode numbers larger than VALBITS, separate the bottom
 986        16 bits.  */
 987     values[10] = Fcons (make_number (s.st_ino >> 16),
 988                         make_number (s.st_ino & 0xffff));
 989   else
 990     /* But keep the most common cases as integers.  */
 991     values[10] = make_number (s.st_ino);
 992
 993   /* Likewise for device.  */
 994   if (FIXNUM_OVERFLOW_P (s.st_dev))
 995     values[11] = Fcons (make_number (s.st_dev >> 16),
 996                         make_number (s.st_dev & 0xffff));
 997   else
 998     values[11] = make_number (s.st_dev);
 999
1000   return Flist (sizeof(values) / sizeof(values[0]), values);
1001 }
1002
1003 DEFUN ("file-attributes-lessp", Ffile_attributes_lessp, Sfile_attributes_lessp, 2, 2, 0,
1004        doc: /* Return t if first arg file attributes list is less than second.
1005 Comparison is in lexicographic order and case is significant.  */)
1006      (f1, f2)
1007      Lisp_Object f1, f2;
1008 {
1009   return Fstring_lessp (Fcar (f1), Fcar (f2));
1010 }
1011 \f
1012 void
1013 syms_of_dired ()
1014 {
1015   Qdirectory_files = intern ("directory-files");
1016   Qdirectory_files_and_attributes = intern ("directory-files-and-attributes");
1017   Qfile_name_completion = intern ("file-name-completion");
1018   Qfile_name_all_completions = intern ("file-name-all-completions");
1019   Qfile_attributes = intern ("file-attributes");
1020   Qfile_attributes_lessp = intern ("file-attributes-lessp");
1021
1022   staticpro (&Qdirectory_files);
1023   staticpro (&Qdirectory_files_and_attributes);
1024   staticpro (&Qfile_name_completion);
1025   staticpro (&Qfile_name_all_completions);
1026   staticpro (&Qfile_attributes);
1027   staticpro (&Qfile_attributes_lessp);
1028
1029   defsubr (&Sdirectory_files);
1030   defsubr (&Sdirectory_files_and_attributes);
1031   defsubr (&Sfile_name_completion);
1032 #ifdef VMS
1033   defsubr (&Sfile_name_all_versions);
1034   defsubr (&Sfile_version_limit);
1035 #endif /* VMS */
1036   defsubr (&Sfile_name_all_completions);
1037   defsubr (&Sfile_attributes);
1038   defsubr (&Sfile_attributes_lessp);
1039
1040 #ifdef VMS
1041   Qcompletion_ignore_case = intern ("completion-ignore-case");
1042   staticpro (&Qcompletion_ignore_case);
1043 #endif /* VMS */
1044
1045   DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
1046                doc: /* Completion ignores file names ending in any string in this list.
1047 It does not ignore them if all possible completions end in one of
1048 these strings or when displaying a list of completions.
1049 It ignores directory names if they match any string in this list which
1050 ends in a slash.  */);
1051   Vcompletion_ignored_extensions = Qnil;
1052 }
1053
1054 /* arch-tag: 1ac8deca-4d8f-4d41-ade9-089154d98c03
1055    (do not change this comment) */