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