src/dired.c

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