src/dired.c

   1 /* Lisp functions for making directory listings.
   2    Copyright (C) 1985, 1986 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 SYSV_SYSTEM_DIR
  28
  29 #include <dirent.h>
  30 #define DIRENTRY struct dirent
  31 #define NAMLEN(p) strlen (p->d_name)
  32
  33 #else
  34
  35 #ifdef NONSYSTEM_DIR_LIBRARY
  36 #include "ndir.h"
  37 #else /* not NONSYSTEM_DIR_LIBRARY */
  38 #include <sys/dir.h>
  39 #endif /* not NONSYSTEM_DIR_LIBRARY */
  40
  41 #define DIRENTRY struct direct
  42 #define NAMLEN(p) p->d_namlen
  43
  44 extern DIR *opendir ();
  45 extern struct direct *readdir ();
  46
  47 #endif
  48
  49 #include "lisp.h"
  50 #include "buffer.h"
  51 #include "commands.h"
  52
  53 #include "regex.h"
  54
  55 #define min(a, b) ((a) < (b) ? (a) : (b))
  56
  57 /* if system does not have symbolic links, it does not have lstat.
  58    In that case, use ordinary stat instead.  */
  59
  60 #ifndef S_IFLNK
  61 #define lstat stat
  62 #endif
  63
  64 Lisp_Object Vcompletion_ignored_extensions;
  65
  66 Lisp_Object Qcompletion_ignore_case;
  67 \f
  68 DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
  69   "Return a list of names of files in DIRECTORY.\n\
  70 There are three optional arguments:\n\
  71 If FULL is non-nil, absolute pathnames of the files are returned.\n\
  72 If MATCH is non-nil, only pathnames containing that regexp are returned.\n\
  73 If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
  74  NOSORT is useful if you plan to sort the result yourself.")
  75   (dirname, full, match, nosort)
  76      Lisp_Object dirname, full, match, nosort;
  77 {
  78   DIR *d;
  79   int length;
  80   Lisp_Object list, name;
  81
  82   if (!NILP (match))
  83     {
  84       CHECK_STRING (match, 3);
  85       /* Compile it now so we don't get an error after opendir */
  86 #ifdef VMS
  87       compile_pattern (match, &searchbuf,
  88                        buffer_defaults.downcase_table->contents);
  89 #else
  90       compile_pattern (match, &searchbuf, 0);
  91 #endif
  92     }
  93
  94   dirname = Fexpand_file_name (dirname, Qnil);
  95   if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data)))
  96     report_file_error ("Opening directory", Fcons (dirname, Qnil));
  97
  98   list = Qnil;
  99   length = XSTRING (dirname)->size;
 100
 101   /* Loop reading blocks */
 102   while (1)
 103     {
 104       DIRENTRY *dp = readdir (d);
 105       int len;
 106
 107       if (!dp) break;
 108       len = NAMLEN (dp);
 109       if (dp->d_ino)
 110         {
 111           if (NILP (match)
 112               || (0 <= re_search (&searchbuf, dp->d_name, len, 0, len, 0)))
 113             {
 114               if (!NILP (full))
 115                 {
 116                   int index = XSTRING (dirname)->size;
 117                   int total = len + index;
 118 #ifndef VMS
 119                   if (length == 0
 120                       || XSTRING (dirname)->data[length - 1] != '/')
 121                     total++;
 122 #endif /* VMS */
 123
 124                   name = make_uninit_string (total);
 125                   bcopy (XSTRING (dirname)->data, XSTRING (name)->data,
 126                          index);
 127 #ifndef VMS
 128                   if (length == 0
 129                       || XSTRING (dirname)->data[length - 1] != '/')
 130                     XSTRING (name)->data[index++] = '/';
 131 #endif /* VMS */
 132                   bcopy (dp->d_name, XSTRING (name)->data + index, len);
 133                 }
 134               else
 135                 name = make_string (dp->d_name, len);
 136               list = Fcons (name, list);
 137             }
 138         }
 139     }
 140   closedir (d);
 141   if (!NILP (nosort))
 142     return list;
 143   return Fsort (Fnreverse (list), Qstring_lessp);
 144 }
 145 \f
 146 Lisp_Object file_name_completion ();
 147
 148 DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
 149   2, 2, 0,
 150   "Complete file name FILE in directory DIR.\n\
 151 Returns the longest string\n\
 152 common to all filenames in DIR that start with FILE.\n\
 153 If there is only one and FILE matches it exactly, returns t.\n\
 154 Returns nil if DIR contains no name starting with FILE.")
 155   (file, dirname)
 156      Lisp_Object file, dirname;
 157 {
 158   /* Don't waste time trying to complete a null string.
 159      Besides, this case happens when user is being asked for
 160      a directory name and has supplied one ending in a /.
 161      We would not want to add anything in that case
 162      even if there are some unique characters in that directory.  */
 163   if (XTYPE (file) == Lisp_String && XSTRING (file)->size == 0)
 164     return file;
 165   return file_name_completion (file, dirname, 0, 0);
 166 }
 167
 168 DEFUN ("file-name-all-completions", Ffile_name_all_completions,
 169   Sfile_name_all_completions, 2, 2, 0,
 170   "Return a list of all completions of file name FILE in directory DIR.\n\
 171 These are all file names in directory DIR which begin with FILE.")
 172   (file, dirname)
 173      Lisp_Object file, dirname;
 174 {
 175   return file_name_completion (file, dirname, 1, 0);
 176 }
 177
 178 #ifdef VMS
 179
 180 DEFUN ("file-name-all-versions", Ffile_name_all_versions,
 181   Sfile_name_all_versions, 2, 2, 0,
 182   "Return a list of all versions of file name FILE in directory DIR.")
 183   (file, dirname)
 184      Lisp_Object file, dirname;
 185 {
 186   return file_name_completion (file, dirname, 1, 1);
 187 }
 188
 189 #endif /* VMS */
 190
 191 Lisp_Object
 192 file_name_completion (file, dirname, all_flag, ver_flag)
 193      Lisp_Object file, dirname;
 194      int all_flag, ver_flag;
 195 {
 196   DIR *d;
 197   DIRENTRY *dp;
 198   int bestmatchsize, skip;
 199   register int compare, matchsize;
 200   unsigned char *p1, *p2;
 201   int matchcount = 0;
 202   Lisp_Object bestmatch, tem, elt, name;
 203   struct stat st;
 204   int directoryp;
 205   int passcount;
 206   int count = specpdl_ptr - specpdl;
 207 #ifdef VMS
 208   extern DIRENTRY * readdirver ();
 209
 210   DIRENTRY *((* readfunc) ());
 211
 212   /* Filename completion on VMS ignores case, since VMS filesys does.  */
 213   specbind (Qcompletion_ignore_case, Qt);
 214
 215   readfunc = readdir;
 216   if (ver_flag)
 217     readfunc = readdirver;
 218   file = Fupcase (file);
 219 #else  /* not VMS */
 220   CHECK_STRING (file, 0);
 221 #endif /* not VMS */
 222
 223   dirname = Fexpand_file_name (dirname, Qnil);
 224   bestmatch = Qnil;
 225
 226   /* With passcount = 0, ignore files that end in an ignored extension.
 227      If nothing found then try again with passcount = 1, don't ignore them.
 228      If looking for all completions, start with passcount = 1,
 229      so always take even the ignored ones.
 230
 231      ** It would not actually be helpful to the user to ignore any possible
 232      completions when making a list of them.**  */
 233
 234   for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
 235     {
 236       if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data)))
 237         report_file_error ("Opening directory", Fcons (dirname, Qnil));
 238
 239       /* Loop reading blocks */
 240       /* (att3b compiler bug requires do a null comparison this way) */
 241       while (1)
 242         {
 243           DIRENTRY *dp;
 244           int len;
 245
 246 #ifdef VMS
 247           dp = (*readfunc) (d);
 248 #else
 249           dp = readdir (d);
 250 #endif
 251           if (!dp) break;
 252
 253           len = NAMLEN (dp);
 254
 255           if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
 256             goto quit;
 257           if (!dp->d_ino
 258               || len < XSTRING (file)->size
 259               || 0 <= scmp (dp->d_name, XSTRING (file)->data,
 260                             XSTRING (file)->size))
 261             continue;
 262
 263           if (file_name_completion_stat (dirname, dp, &st) < 0)
 264             continue;
 265
 266           directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
 267           tem = Qnil;
 268           if (!directoryp)
 269             {
 270               /* Compare extensions-to-be-ignored against end of this file name */
 271               /* if name is not an exact match against specified string */
 272               if (!passcount && len > XSTRING (file)->size)
 273                 /* and exit this for loop if a match is found */
 274                 for (tem = Vcompletion_ignored_extensions;
 275                      CONSP (tem); tem = XCONS (tem)->cdr)
 276                   {
 277                     elt = XCONS (tem)->car;
 278                     if (XTYPE (elt) != Lisp_String) continue;
 279                     skip = len - XSTRING (elt)->size;
 280                     if (skip < 0) continue;
 281
 282                     if (0 <= scmp (dp->d_name + skip,
 283                                    XSTRING (elt)->data,
 284                                    XSTRING (elt)->size))
 285                       continue;
 286                     break;
 287                   }
 288             }
 289
 290           /* Unless an ignored-extensions match was found,
 291              process this name as a completion */
 292           if (passcount || !CONSP (tem))
 293             {
 294               /* Update computation of how much all possible completions match */
 295
 296               matchcount++;
 297
 298               if (all_flag || NILP (bestmatch))
 299                 {
 300                   /* This is a possible completion */
 301                   if (directoryp)
 302                     {
 303                       /* This completion is a directory; make it end with '/' */
 304                       name = Ffile_name_as_directory (make_string (dp->d_name, len));
 305                     }
 306                   else
 307                     name = make_string (dp->d_name, len);
 308                   if (all_flag)
 309                     {
 310                       bestmatch = Fcons (name, bestmatch);
 311                     }
 312                   else
 313                     {
 314                       bestmatch = name;
 315                       bestmatchsize = XSTRING (name)->size;
 316                     }
 317                 }
 318               else
 319                 {
 320                   compare = min (bestmatchsize, len);
 321                   p1 = XSTRING (bestmatch)->data;
 322                   p2 = (unsigned char *) dp->d_name;
 323                   matchsize = scmp(p1, p2, compare);
 324                   if (matchsize < 0)
 325                     matchsize = compare;
 326                   /* If this dirname all matches,
 327                      see if implicit following slash does too.  */
 328                   if (directoryp
 329                       && compare == matchsize
 330                       && bestmatchsize > matchsize
 331                       && p1[matchsize] == '/')
 332                     matchsize++;
 333                   bestmatchsize = min (matchsize, bestmatchsize);
 334                 }
 335             }
 336         }
 337       closedir (d);
 338     }
 339
 340   unbind_to (count, Qnil);
 341
 342   if (all_flag || NILP (bestmatch))
 343     return bestmatch;
 344   if (matchcount == 1 && bestmatchsize == XSTRING (file)->size)
 345     return Qt;
 346   return Fsubstring (bestmatch, make_number (0), make_number (bestmatchsize));
 347  quit:
 348   if (d) closedir (d);
 349   Vquit_flag = Qnil;
 350   return Fsignal (Qquit, Qnil);
 351 }
 352
 353 file_name_completion_stat (dirname, dp, st_addr)
 354      Lisp_Object dirname;
 355      DIRENTRY *dp;
 356      struct stat *st_addr;
 357 {
 358   int len = NAMLEN (dp);
 359   int pos = XSTRING (dirname)->size;
 360   char *fullname = (char *) alloca (len + pos + 2);
 361
 362   bcopy (XSTRING (dirname)->data, fullname, pos);
 363 #ifndef VMS
 364   if (fullname[pos - 1] != '/')
 365     fullname[pos++] = '/';
 366 #endif
 367
 368   bcopy (dp->d_name, fullname + pos, len);
 369   fullname[pos + len] = 0;
 370
 371   return stat (fullname, st_addr);
 372 }
 373 \f
 374 Lisp_Object
 375 make_time (time)
 376      int time;
 377 {
 378   return Fcons (make_number (time >> 16),
 379                 Fcons (make_number (time & 0177777), Qnil));
 380 }
 381
 382 DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
 383   "Return a list of attributes of file FILENAME.\n\
 384 Value is nil if specified file cannot be opened.\n\
 385 Otherwise, list elements are:\n\
 386  0. t for directory, string (name linked to) for symbolic link, or nil.\n\
 387  1. Number of links to file.\n\
 388  2. File uid.\n\
 389  3. File gid.\n\
 390  4. Last access time, as a list of two integers.\n\
 391   First integer has high-order 16 bits of time, second has low 16 bits.\n\
 392  5. Last modification time, likewise.\n\
 393  6. Last status change time, likewise.\n\
 394  7. Size in bytes.\n\
 395  8. File modes, as a string of ten letters or dashes as in ls -l.\n\
 396  9. t iff file's gid would change if file were deleted and recreated.\n\
 397 10. inode number.\n\
 398 11. Device number.\n\
 399 \n\
 400 If file does not exists, returns nil.")
 401   (filename)
 402      Lisp_Object filename;
 403 {
 404   Lisp_Object values[12];
 405   Lisp_Object dirname;
 406   struct stat s;
 407   struct stat sdir;
 408   char modes[10];
 409
 410   filename = Fexpand_file_name (filename, Qnil);
 411   if (lstat (XSTRING (filename)->data, &s) < 0)
 412     return Qnil;
 413
 414   switch (s.st_mode & S_IFMT)
 415     {
 416     default:
 417       values[0] = Qnil; break;
 418     case S_IFDIR:
 419       values[0] = Qt; break;
 420 #ifdef S_IFLNK
 421     case S_IFLNK:
 422       values[0] = Ffile_symlink_p (filename); break;
 423 #endif
 424     }
 425   values[1] = make_number (s.st_nlink);
 426   values[2] = make_number (s.st_uid);
 427   values[3] = make_number (s.st_gid);
 428   values[4] = make_time (s.st_atime);
 429   values[5] = make_time (s.st_mtime);
 430   values[6] = make_time (s.st_ctime);
 431   /* perhaps we should set this to most-positive-fixnum if it is too large? */
 432   values[7] = make_number (s.st_size);
 433   filemodestring (&s, modes);
 434   values[8] = make_string (modes, 10);
 435 #ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
 436 #define BSD4_2 /* A new meaning to the term `backwards compatability' */
 437 #endif
 438 #ifdef BSD4_2                   /* file gid will be dir gid */
 439   dirname = Ffile_name_directory (filename);
 440   if (dirname != Qnil && stat (XSTRING (dirname)->data, &sdir) == 0)
 441     values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
 442   else                                  /* if we can't tell, assume worst */
 443     values[9] = Qt;
 444 #else                                   /* file gid will be egid */
 445   values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
 446 #endif  /* BSD4_2 (or BSD4_3) */
 447 #ifdef BSD4_3
 448 #undef BSD4_2 /* ok, you can look again without throwing up */
 449 #endif
 450   values[10] = make_number (s.st_ino);
 451   values[11] = make_number (s.st_dev);
 452   return Flist (sizeof(values) / sizeof(values[0]), values);
 453 }
 454 \f
 455 syms_of_dired ()
 456 {
 457   defsubr (&Sdirectory_files);
 458   defsubr (&Sfile_name_completion);
 459 #ifdef VMS
 460   defsubr (&Sfile_name_all_versions);
 461 #endif /* VMS */
 462   defsubr (&Sfile_name_all_completions);
 463   defsubr (&Sfile_attributes);
 464
 465 #ifdef VMS
 466   Qcompletion_ignore_case = intern ("completion-ignore-case");
 467   staticpro (&Qcompletion_ignore_case);
 468 #endif /* VMS */
 469
 470   DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions,
 471     "*Completion ignores filenames ending in any string in this list.\n\
 472 This variable does not affect lists of possible completions,\n\
 473 but does affect the commands that actually do completions.");
 474   Vcompletion_ignored_extensions = Qnil;
 475 }