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