src/dired.c

   1 /* Lisp functions for making directory listings.
   2    Copyright (C) 1985, 1986, 1993 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 1, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20
  21 #include <stdio.h>
  22 #include <sys/types.h>
  23 #include <sys/stat.h>
  24
  25 #include "config.h"
  26
  27 #ifdef VMS
  28 #include <string.h>
  29 #include <rms.h>
  30 #include <rmsdef.h>
  31 #endif
  32
  33 /* The d_nameln member of a struct dirent includes the '\0' character
  34    on some systems, but not on others.  What's worse, you can't tell
  35    at compile-time which one it will be, since it really depends on
  36    the sort of system providing the filesystem you're reading from,
  37    not the system you are running on.  Paul Eggert
  38    <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
  39    SunOS 4.1.2 host, reading a directory that is remote-mounted from a
  40    Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
  41
  42    Since applying strlen to the name always works, we'll just do that.  */
  43 #define NAMLEN(p) strlen (p->d_name)
  44
  45 #ifdef SYSV_SYSTEM_DIR
  46
  47 #include <dirent.h>
  48 #define DIRENTRY struct dirent
  49
  50 #else
  51
  52 #ifdef NONSYSTEM_DIR_LIBRARY
  53 #include "ndir.h"
  54 #else /* not NONSYSTEM_DIR_LIBRARY */
  55 #include <sys/dir.h>
  56 #endif /* not NONSYSTEM_DIR_LIBRARY */
  57
  58 #define DIRENTRY struct direct
  59
  60 extern DIR *opendir ();
  61 extern struct direct *readdir ();
  62
  63 #endif
  64
  65 #include "lisp.h"
  66 #include "buffer.h"
  67 #include "commands.h"
  68
  69 #include "regex.h"
  70
  71 /* A search buffer, with a fastmap allocated and ready to go.  */
  72 extern struct re_pattern_buffer searchbuf;
  73
  74 #define min(a, b) ((a) < (b) ? (a) : (b))
  75
  76 /* if system does not have symbolic links, it does not have lstat.
  77    In that case, use ordinary stat instead.  */
  78
  79 #ifndef S_IFLNK
  80 #define lstat stat
  81 #endif
  82
  83 extern Lisp_Object Ffind_file_name_handler ();
  84
  85 Lisp_Object Vcompletion_ignored_extensions;
  86
  87 Lisp_Object Qcompletion_ignore_case;
  88
  89 Lisp_Object Qdirectory_files;
  90 Lisp_Object Qfile_name_completion;
  91 Lisp_Object Qfile_name_all_completions;
  92 Lisp_Object Qfile_attributes;
  93 \f
  94 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
  95   "Return a list of names of files in DIRECTORY.\n\
  96 There are three optional arguments:\n\
  97 If FULL is non-nil, absolute pathnames of the files are returned.\n\
  98 If MATCH is non-nil, only pathnames containing that regexp are returned.\n\
  99 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
 100  NOSORT is useful if you plan to sort the result yourself.")
 101   (dirname, full, match, nosort)
 102      Lisp_Object dirname, full, match, nosort;
 103 {
 104   DIR *d;
 105   int length;
 106   Lisp_Object list, name, dirfilename;
 107   Lisp_Object handler;
 108
 109   /* If the file name has special constructs in it,
 110      call the corresponding file handler.  */
 111   handler = Ffind_file_name_handler (dirname);
 112   if (!NILP (handler))
 113     {
 114       Lisp_Object args[6];
 115
 116       args[0] = handler;
 117       args[1] = Qdirectory_files;
 118       args[2] = dirname;
 119       args[3] = full;
 120       args[4] = match;
 121       args[5] = nosort;
 122       return Ffuncall (6, args);
 123     }
 124
 125   {
 126     struct gcpro gcpro1, gcpro2;
 127
 128     /* Because of file name handlers, these functions might call
 129      Ffuncall, and cause a GC.  */
 130     GCPRO1 (match);
 131     dirname = Fexpand_file_name (dirname, Qnil);
 132     UNGCPRO;
 133     GCPRO2 (match, dirname);
 134     dirfilename = Fdirectory_file_name (dirname);
 135     UNGCPRO;
 136   }
 137
 138   if (!NILP (match))
 139     {
 140       CHECK_STRING (match, 3);
 141
 142       /* MATCH might be a flawed regular expression.  Rather than
 143          catching and signalling our own errors, we just call
 144          compile_pattern to do the work for us.  */
 145 #ifdef VMS
 146       compile_pattern (match, &searchbuf, 0,
 147                        buffer_defaults.downcase_table->contents);
 148 #else
 149       compile_pattern (match, &searchbuf, 0, 0);
 150 #endif
 151     }
 152
 153   /* Now searchbuf is the compiled form of MATCH; don't call anything
 154      which might compile a new regexp until we're done with the loop!  */
 155
 156   /* Do this opendir after anything which might signal an error; if
 157      an error is signalled while the directory stream is open, we
 158      have to make sure it gets closed, and setting up an
 159      unwind_protect to do so would be a pain.  */
 160   d = opendir (XSTRING (dirfilename)->data);
 161   if (! d)
 162     report_file_error ("Opening directory", Fcons (dirname, Qnil));
 163
 164   list = Qnil;
 165   length = XSTRING (dirname)->size;
 166
 167   /* Loop reading blocks */
 168   while (1)
 169     {
 170       DIRENTRY *dp = readdir (d);
 171       int len;
 172
 173       if (!dp) break;
 174       len = NAMLEN (dp);
 175       if (dp->d_ino)
 176         {
 177           if (NILP (match)
 178               || (0 <= re_search (&searchbuf, dp->d_name, len, 0, len, 0)))
 179             {
 180               if (!NILP (full))
 181                 {
 182                   int index = XSTRING (dirname)->size;
 183                   int total = len + index;
 184 #ifndef VMS
 185                   if (length == 0
 186                       || XSTRING (dirname)->data[length - 1] != '/')
 187                     total++;
 188 #endif /* VMS */
 189
 190                   name = make_uninit_string (total);
 191                   bcopy (XSTRING (dirname)->data, XSTRING (name)->data,
 192                          index);
 193 #ifndef VMS
 194                   if (length == 0
 195                       || XSTRING (dirname)->data[length - 1] != '/')
 196                     XSTRING (name)->data[index++] = '/';
 197 #endif /* VMS */
 198                   bcopy (dp->d_name, XSTRING (name)->data + index, len);
 199                 }
 200               else
 201                 name = make_string (dp->d_name, len);
 202               list = Fcons (name, list);
 203             }
 204         }
 205     }
 206   closedir (d);
 207   if (!NILP (nosort))
 208     return list;
 209   return Fsort (Fnreverse (list), Qstring_lessp);
 210 }
 211 \f
 212 Lisp_Object file_name_completion ();
 213
 214 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
 215   2, 2, 0,
 216   "Complete file name FILE in directory DIR.\n\
 217 Returns the longest string\n\
 218 common to all filenames in DIR that start with FILE.\n\
 219 If there is only one and FILE matches it exactly, returns t.\n\
 220 Returns nil if DIR contains no name starting with FILE.")
 221   (file, dirname)
 222      Lisp_Object file, dirname;
 223 {
 224   Lisp_Object handler;
 225   /* Don't waste time trying to complete a null string.
 226      Besides, this case happens when user is being asked for
 227      a directory name and has supplied one ending in a /.
 228      We would not want to add anything in that case
 229      even if there are some unique characters in that directory.  */
 230   if (XTYPE (file) == Lisp_String && XSTRING (file)->size == 0)
 231     return file;
 232
 233   /* If the file name has special constructs in it,
 234      call the corresponding file handler.  */
 235   handler = Ffind_file_name_handler (dirname);
 236   if (!NILP (handler))
 237     return call3 (handler, Qfile_name_completion, file, dirname);
 238
 239   return file_name_completion (file, dirname, 0, 0);
 240 }
 241
 242 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
 243   Sfile_name_all_completions, 2, 2, 0,
 244   "Return a list of all completions of file name FILE in directory DIR.\n\
 245 These are all file names in directory DIR which begin with FILE.")
 246   (file, dirname)
 247      Lisp_Object file, dirname;
 248 {
 249   Lisp_Object handler;
 250
 251   /* If the file name has special constructs in it,
 252      call the corresponding file handler.  */
 253   handler = Ffind_file_name_handler (dirname);
 254   if (!NILP (handler))
 255     return call3 (handler, Qfile_name_all_completions, file, dirname);
 256
 257   return file_name_completion (file, dirname, 1, 0);
 258 }
 259
 260 Lisp_Object
 261 file_name_completion (file, dirname, all_flag, ver_flag)
 262      Lisp_Object file, dirname;
 263      int all_flag, ver_flag;
 264 {
 265   DIR *d;
 266   DIRENTRY *dp;
 267   int bestmatchsize, skip;
 268   register int compare, matchsize;
 269   unsigned char *p1, *p2;
 270   int matchcount = 0;
 271   Lisp_Object bestmatch, tem, elt, name;
 272   struct stat st;
 273   int directoryp;
 274   int passcount;
 275   int count = specpdl_ptr - specpdl;
 276 #ifdef VMS
 277   extern DIRENTRY * readdirver ();
 278
 279   DIRENTRY *((* readfunc) ());
 280
 281   /* Filename completion on VMS ignores case, since VMS filesys does.  */
 282   specbind (Qcompletion_ignore_case, Qt);
 283
 284   readfunc = readdir;
 285   if (ver_flag)
 286     readfunc = readdirver;
 287   file = Fupcase (file);
 288 #else  /* not VMS */
 289   CHECK_STRING (file, 0);
 290 #endif /* not VMS */
 291
 292   dirname = Fexpand_file_name (dirname, Qnil);
 293   bestmatch = Qnil;
 294
 295   /* With passcount = 0, ignore files that end in an ignored extension.
 296      If nothing found then try again with passcount = 1, don't ignore them.
 297      If looking for all completions, start with passcount = 1,
 298      so always take even the ignored ones.
 299
 300      ** It would not actually be helpful to the user to ignore any possible
 301      completions when making a list of them.**  */
 302
 303   for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
 304     {
 305       if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data)))
 306         report_file_error ("Opening directory", Fcons (dirname, Qnil));
 307
 308       /* Loop reading blocks */
 309       /* (att3b compiler bug requires do a null comparison this way) */
 310       while (1)
 311         {
 312           DIRENTRY *dp;
 313           int len;
 314
 315 #ifdef VMS
 316           dp = (*readfunc) (d);
 317 #else
 318           dp = readdir (d);
 319 #endif
 320           if (!dp) break;
 321
 322           len = NAMLEN (dp);
 323
 324           if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
 325             goto quit;
 326           if (!dp->d_ino
 327               || len < XSTRING (file)->size
 328               || 0 <= scmp (dp->d_name, XSTRING (file)->data,
 329                             XSTRING (file)->size))
 330             continue;
 331
 332           if (file_name_completion_stat (dirname, dp, &st) < 0)
 333             continue;
 334
 335           directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
 336           tem = Qnil;
 337           if (!directoryp)
 338             {
 339               /* Compare extensions-to-be-ignored against end of this file name */
 340               /* if name is not an exact match against specified string */
 341               if (!passcount && len > XSTRING (file)->size)
 342                 /* and exit this for loop if a match is found */
 343                 for (tem = Vcompletion_ignored_extensions;
 344                      CONSP (tem); tem = XCONS (tem)->cdr)
 345                   {
 346                     elt = XCONS (tem)->car;
 347                     if (XTYPE (elt) != Lisp_String) continue;
 348                     skip = len - XSTRING (elt)->size;
 349                     if (skip < 0) continue;
 350
 351                     if (0 <= scmp (dp->d_name + skip,
 352                                    XSTRING (elt)->data,
 353                                    XSTRING (elt)->size))
 354                       continue;
 355                     break;
 356                   }
 357             }
 358
 359           /* Unless an ignored-extensions match was found,
 360              process this name as a completion */
 361           if (passcount || !CONSP (tem))
 362             {
 363               /* Update computation of how much all possible completions match */
 364
 365               matchcount++;
 366
 367               if (all_flag || NILP (bestmatch))
 368                 {
 369                   /* This is a possible completion */
 370                   if (directoryp)
 371                     {
 372                       /* This completion is a directory; make it end with '/' */
 373                       name = Ffile_name_as_directory (make_string (dp->d_name, len));
 374                     }
 375                   else
 376                     name = make_string (dp->d_name, len);
 377                   if (all_flag)
 378                     {
 379                       bestmatch = Fcons (name, bestmatch);
 380                     }
 381                   else
 382                     {
 383                       bestmatch = name;
 384                       bestmatchsize = XSTRING (name)->size;
 385                     }
 386                 }
 387               else
 388                 {
 389                   compare = min (bestmatchsize, len);
 390                   p1 = XSTRING (bestmatch)->data;
 391                   p2 = (unsigned char *) dp->d_name;
 392                   matchsize = scmp(p1, p2, compare);
 393                   if (matchsize < 0)
 394                     matchsize = compare;
 395                   /* If this dirname all matches,
 396                      see if implicit following slash does too.  */
 397                   if (directoryp
 398                       && compare == matchsize
 399                       && bestmatchsize > matchsize
 400                       && p1[matchsize] == '/')
 401                     matchsize++;
 402                   bestmatchsize = min (matchsize, bestmatchsize);
 403                 }
 404             }
 405         }
 406       closedir (d);
 407     }
 408
 409   unbind_to (count, Qnil);
 410
 411   if (all_flag || NILP (bestmatch))
 412     return bestmatch;
 413   if (matchcount == 1 && bestmatchsize == XSTRING (file)->size)
 414     return Qt;
 415   return Fsubstring (bestmatch, make_number (0), make_number (bestmatchsize));
 416  quit:
 417   if (d) closedir (d);
 418   Vquit_flag = Qnil;
 419   return Fsignal (Qquit, Qnil);
 420 }
 421
 422 file_name_completion_stat (dirname, dp, st_addr)
 423      Lisp_Object dirname;
 424      DIRENTRY *dp;
 425      struct stat *st_addr;
 426 {
 427   int len = NAMLEN (dp);
 428   int pos = XSTRING (dirname)->size;
 429   char *fullname = (char *) alloca (len + pos + 2);
 430
 431   bcopy (XSTRING (dirname)->data, fullname, pos);
 432 #ifndef VMS
 433   if (fullname[pos - 1] != '/')
 434     fullname[pos++] = '/';
 435 #endif
 436
 437   bcopy (dp->d_name, fullname + pos, len);
 438   fullname[pos + len] = 0;
 439
 440   return stat (fullname, st_addr);
 441 }
 442 \f
 443 #ifdef VMS
 444
 445 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
 446   Sfile_name_all_versions, 2, 2, 0,
 447   "Return a list of all versions of file name FILE in directory DIR.")
 448   (file, dirname)
 449      Lisp_Object file, dirname;
 450 {
 451   return file_name_completion (file, dirname, 1, 1);
 452 }
 453
 454 DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
 455   "Return the maximum number of versions allowed for FILE.\n\
 456 Returns nil if the file cannot be opened or if there is no version limit.")
 457   (filename)
 458      Lisp_Object filename;
 459 {
 460   Lisp_Object retval;
 461   struct FAB    fab;
 462   struct RAB    rab;
 463   struct XABFHC xabfhc;
 464   int status;
 465
 466   filename = Fexpand_file_name (filename, Qnil);
 467   fab      = cc$rms_fab;
 468   xabfhc   = cc$rms_xabfhc;
 469   fab.fab$l_fna = XSTRING (filename)->data;
 470   fab.fab$b_fns = strlen (fab.fab$l_fna);
 471   fab.fab$l_xab = (char *) &xabfhc;
 472   status = sys$open (&fab, 0, 0);
 473   if (status != RMS$_NORMAL)    /* Probably non-existent file */
 474     return Qnil;
 475   sys$close (&fab, 0, 0);
 476   if (xabfhc.xab$w_verlimit == 32767)
 477     return Qnil;                /* No version limit */
 478   else
 479     return make_number (xabfhc.xab$w_verlimit);
 480 }
 481
 482 #endif /* VMS */
 483 \f
 484 Lisp_Object
 485 make_time (time)
 486      int time;
 487 {
 488   return Fcons (make_number (time >> 16),
 489                 Fcons (make_number (time & 0177777), Qnil));
 490 }
 491
 492 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
 493   "Return a list of attributes of file FILENAME.\n\
 494 Value is nil if specified file cannot be opened.\n\
 495 Otherwise, list elements are:\n\
 496  0. t for directory, string (name linked to) for symbolic link, or nil.\n\
 497  1. Number of links to file.\n\
 498  2. File uid.\n\
 499  3. File gid.\n\
 500  4. Last access time, as a list of two integers.\n\
 501   First integer has high-order 16 bits of time, second has low 16 bits.\n\
 502  5. Last modification time, likewise.\n\
 503  6. Last status change time, likewise.\n\
 504  7. Size in bytes.\n\
 505  8. File modes, as a string of ten letters or dashes as in ls -l.\n\
 506  9. t iff file's gid would change if file were deleted and recreated.\n\
 507 10. inode number.\n\
 508 11. Device number.\n\
 509 \n\
 510 If file does not exist, returns nil.")
 511   (filename)
 512      Lisp_Object filename;
 513 {
 514   Lisp_Object values[12];
 515   Lisp_Object dirname;
 516   struct stat s;
 517   struct stat sdir;
 518   char modes[10];
 519   Lisp_Object handler;
 520
 521   filename = Fexpand_file_name (filename, Qnil);
 522
 523   /* If the file name has special constructs in it,
 524      call the corresponding file handler.  */
 525   handler = Ffind_file_name_handler (filename);
 526   if (!NILP (handler))
 527     return call2 (handler, Qfile_attributes, filename);
 528
 529   if (lstat (XSTRING (filename)->data, &s) < 0)
 530     return Qnil;
 531
 532   switch (s.st_mode & S_IFMT)
 533     {
 534     default:
 535       values[0] = Qnil; break;
 536     case S_IFDIR:
 537       values[0] = Qt; break;
 538 #ifdef S_IFLNK
 539     case S_IFLNK:
 540       values[0] = Ffile_symlink_p (filename); break;
 541 #endif
 542     }
 543   values[1] = make_number (s.st_nlink);
 544   values[2] = make_number (s.st_uid);
 545   values[3] = make_number (s.st_gid);
 546   values[4] = make_time (s.st_atime);
 547   values[5] = make_time (s.st_mtime);
 548   values[6] = make_time (s.st_ctime);
 549   /* perhaps we should set this to most-positive-fixnum if it is too large? */
 550   values[7] = make_number (s.st_size);
 551   filemodestring (&s, modes);
 552   values[8] = make_string (modes, 10);
 553 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
 554 #define BSD4_2 /* A new meaning to the term `backwards compatability' */
 555 #endif
 556 #ifdef BSD4_2                   /* file gid will be dir gid */
 557   dirname = Ffile_name_directory (filename);
 558   if (! NILP (dirname) && stat (XSTRING (dirname)->data, &sdir) == 0)
 559     values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
 560   else                                  /* if we can't tell, assume worst */
 561     values[9] = Qt;
 562 #else                                   /* file gid will be egid */
 563   values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
 564 #endif  /* BSD4_2 (or BSD4_3) */
 565 #ifdef BSD4_3
 566 #undef BSD4_2 /* ok, you can look again without throwing up */
 567 #endif
 568   values[10] = make_number (s.st_ino);
 569   values[11] = make_number (s.st_dev);
 570   return Flist (sizeof(values) / sizeof(values[0]), values);
 571 }
 572 \f
 573 syms_of_dired ()
 574 {
 575   Qdirectory_files = intern ("directory-files");
 576   Qfile_name_completion = intern ("file-name-completion");
 577   Qfile_name_all_completions = intern ("file-name-all-completions");
 578   Qfile_attributes = intern ("file-attributes");
 579
 580   defsubr (&Sdirectory_files);
 581   defsubr (&Sfile_name_completion);
 582 #ifdef VMS
 583   defsubr (&Sfile_name_all_versions);
 584   defsubr (&Sfile_version_limit);
 585 #endif /* VMS */
 586   defsubr (&Sfile_name_all_completions);
 587   defsubr (&Sfile_attributes);
 588
 589 #ifdef VMS
 590   Qcompletion_ignore_case = intern ("completion-ignore-case");
 591   staticpro (&Qcompletion_ignore_case);
 592 #endif /* VMS */
 593
 594   DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
 595     "*Completion ignores filenames ending in any string in this list.\n\
 596 This variable does not affect lists of possible completions,\n\
 597 but does affect the commands that actually do completions.");
 598   Vcompletion_ignored_extensions = Qnil;
 599 }