src/dired.c

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