1: /* Lisp functions for making directory listings.
    2:    Copyright (C) 1985, 1986, 1993, 1994, 1999, 2000, 2001, 2002, 2003,
    3:                  2004, 2005, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
   20: Boston, MA 02110-1301, 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 <errno.h>
   37: 
   38: #ifdef VMS
   39: #include <string.h>
   40: #include <rms.h>
   41: #include <rmsdef.h>
   42: #endif
   43: 
   44: #ifdef HAVE_UNISTD_H
   45: #include <unistd.h>
   46: #endif
   47: 
   48: /* The d_nameln member of a struct dirent includes the '\0' character
   49:    on some systems, but not on others.  What's worse, you can't tell
   50:    at compile-time which one it will be, since it really depends on
   51:    the sort of system providing the filesystem you're reading from,
   52:    not the system you are running on.  Paul Eggert
   53:    <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
   54:    SunOS 4.1.2 host, reading a directory that is remote-mounted from a
   55:    Solaris 2.1 host and is in a native Solaris 2.1 filesystem.
   56: 
   57:    Since applying strlen to the name always works, we'll just do that.  */
   58: #define NAMLEN(p) strlen (p->d_name)
   59: 
   60: #ifdef SYSV_SYSTEM_DIR
   61: 
   62: #include <dirent.h>
   63: #define DIRENTRY struct dirent
   64: 
   65: #else /* not SYSV_SYSTEM_DIR */
   66: 
   67: #ifdef NONSYSTEM_DIR_LIBRARY
   68: #include "ndir.h"
   69: #else /* not NONSYSTEM_DIR_LIBRARY */
   70: #ifdef MSDOS
   71: #include <dirent.h>
   72: #else
   73: #include <sys/dir.h>
   74: #endif
   75: #endif /* not NONSYSTEM_DIR_LIBRARY */
   76: 
   77: #include <sys/stat.h>
   78: 
   79: #ifndef MSDOS
   80: #define DIRENTRY struct direct
   81: 
   82: extern DIR *opendir ();
   83: extern struct direct *readdir ();
   84: 
   85: #endif /* not MSDOS */
   86: #endif /* not SYSV_SYSTEM_DIR */
   87: 
   88: /* Some versions of Cygwin don't have d_ino in `struct dirent'.  */
   89: #if defined(MSDOS) || defined(__CYGWIN__)
   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 "systime.h"
   97: #include "buffer.h"
   98: #include "commands.h"
   99: #include "charset.h"
  100: #include "coding.h"
  101: #include "regex.h"
  102: #include "blockinput.h"
  103: 
  104: /* Returns a search buffer, with a fastmap allocated and ready to go.  */
  105: extern struct re_pattern_buffer *compile_pattern ();
  106: 
  107: /* From filemode.c.  Can't go in Lisp.h because of `stat'.  */
  108: extern void filemodestring P_ ((struct stat *, char *));
  109: 
  110: /* if system does not have symbolic links, it does not have lstat.
  111:    In that case, use ordinary stat instead.  */
  112: 
  113: #ifndef S_IFLNK
  114: #define lstat stat
  115: #endif
  116: 
  117: extern int completion_ignore_case;
  118: extern Lisp_Object Vcompletion_regexp_list;
  119: 
  120: Lisp_Object Vcompletion_ignored_extensions;
  121: Lisp_Object Qcompletion_ignore_case;
  122: Lisp_Object Qdirectory_files;
  123: Lisp_Object Qdirectory_files_and_attributes;
  124: Lisp_Object Qfile_name_completion;
  125: Lisp_Object Qfile_name_all_completions;
  126: Lisp_Object Qfile_attributes;
  127: Lisp_Object Qfile_attributes_lessp;
  128: 
  129: static int scmp P_ ((unsigned char *, unsigned char *, int));
  130: ^L
  131: 
  132: Lisp_Object
  133: directory_files_internal_unwind (dh)
  134:      Lisp_Object dh;
  135: {
  136:   DIR *d = (DIR *) XSAVE_VALUE (dh)->pointer;
  137:   BLOCK_INPUT;
  138:   closedir (d);
  139:   UNBLOCK_INPUT;
  140:   return Qnil;
  141: }
  142: 
  143: /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
  144:    When ATTRS is zero, return a list of directory filenames; when
  145:    non-zero, return a list of directory filenames and their attributes.
  146:    In the latter case, ID_FORMAT is passed to Ffile_attributes.  */
  147: 
  148: Lisp_Object
  149: directory_files_internal (directory, full, match, nosort, attrs, id_format)
  150:      Lisp_Object directory, full, match, nosort;
  151:      int attrs;
  152:      Lisp_Object id_format;
  153: {
  154:   DIR *d;
  155:   int directory_nbytes;
  156:   Lisp_Object list, dirfilename, encoded_directory;
  157:   struct re_pattern_buffer *bufp = NULL;
  158:   int needsep = 0;
  159:   int count = SPECPDL_INDEX ();
  160:   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
  161:   DIRENTRY *dp;
  162: 
  163:   /* Because of file name handlers, these functions might call
  164:      Ffuncall, and cause a GC.  */
  165:   list = encoded_directory = dirfilename = Qnil;
  166:   GCPRO5 (match, directory, list, dirfilename, encoded_directory);
  167:   dirfilename = Fdirectory_file_name (directory);
  168: 
  169:   if (!NILP (match))
  170:     {
  171:       CHECK_STRING (match);
  172: 
  173:       /* MATCH might be a flawed regular expression.  Rather than
  174:          catching and signaling our own errors, we just call
  175:          compile_pattern to do the work for us.  */
  176:       /* Pass 1 for the MULTIBYTE arg
  177:          because we do make multibyte strings if the contents warrant.  */
  178: #ifdef VMS
  179:       bufp = compile_pattern (match, 0,
  180:                               buffer_defaults.downcase_table, 0, 1);
  181: #else  /* !VMS */
  182: # ifdef WINDOWSNT
  183:       /* Windows users want case-insensitive wildcards.  */
  184:       bufp = compile_pattern (match, 0,
  185:                               buffer_defaults.case_canon_table, 0, 1);
  186: # else  /* !WINDOWSNT */
  187:       bufp = compile_pattern (match, 0, Qnil, 0, 1);
  188: # endif  /* !WINDOWSNT */
  189: #endif   /* !VMS */
  190:     }
  191: 
  192:   /* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
  193:      run_pre_post_conversion_on_str which calls Lisp directly and
  194:      indirectly.  */
  195:   dirfilename = ENCODE_FILE (dirfilename);
  196:   encoded_directory = ENCODE_FILE (directory);
  197: 
  198:   /* Now *bufp is the compiled form of MATCH; don't call anything
  199:      which might compile a new regexp until we're done with the loop!  */
  200: 
  201:   BLOCK_INPUT;
  202:   d = opendir (SDATA (dirfilename));
  203:   UNBLOCK_INPUT;
  204:   if (d == NULL)
  205:     report_file_error ("Opening directory", Fcons (directory, Qnil));
  206: 
  207:   /* Unfortunately, we can now invoke expand-file-name and
  208:      file-attributes on filenames, both of which can throw, so we must
  209:      do a proper unwind-protect.  */
  210:   record_unwind_protect (directory_files_internal_unwind,
  211:                          make_save_value (d, 0));
  212: 
  213:   directory_nbytes = SBYTES (directory);
  214:   re_match_object = Qt;
  215: 
  216:   /* Decide whether we need to add a directory separator.  */
  217: #ifndef VMS
  218:   if (directory_nbytes == 0
  219:       || !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
  220:     needsep = 1;
  221: #endif /* not VMS */
  222: 
  223:   /* Loop reading blocks until EOF or error.  */
  224:   for (;;)
  225:     {
  226:       errno = 0;
  227:       dp = readdir (d);
  228: 
  229:       if (dp == NULL && (0
  230: #ifdef EAGAIN
  231:                          || errno == EAGAIN
  232: #endif
  233: #ifdef EINTR
  234:                          || errno == EINTR
  235: #endif
  236:                          ))
  237:         { QUIT; continue; }
  238: 
  239:       if (dp == NULL)
  240:         break;
  241: 
  242:       if (DIRENTRY_NONEMPTY (dp))
  243:         {
  244:           int len;
  245:           int wanted = 0;
  246:           Lisp_Object name, finalname;
  247:           struct gcpro gcpro1, gcpro2;
  248: 
  249:           len = NAMLEN (dp);
  250:           name = finalname = make_unibyte_string (dp->d_name, len);
  251:           GCPRO2 (finalname, name);
  252: 
  253:           /* Note: ENCODE_FILE can GC; it should protect its argument,
  254:              though.  */
  255:           name = DECODE_FILE (name);
  256:           len = SBYTES (name);
  257: 
  258:           /* Now that we have unwind_protect in place, we might as well
  259:              allow matching to be interrupted.  */
  260:           immediate_quit = 1;
  261:           QUIT;
  262: 
  263:           if (NILP (match)
  264:               || (0 <= re_search (bufp, SDATA (name), len, 0, len, 0)))
  265:             wanted = 1;
  266: 
  267:           immediate_quit = 0;
  268: 
  269:           if (wanted)
  270:             {
  271:               if (!NILP (full))
  272:                 {
  273:                   Lisp_Object fullname;
  274:                   int nbytes = len + directory_nbytes + needsep;
  275:                   int nchars;
  276: 
  277:                   fullname = make_uninit_multibyte_string (nbytes, nbytes);
  278:                   bcopy (SDATA (directory), SDATA (fullname),
  279:                          directory_nbytes);
  280: 
  281:                   if (needsep)
  282:                     SSET (fullname, directory_nbytes, DIRECTORY_SEP);
  283: 
  284:                   bcopy (SDATA (name),
  285:                          SDATA (fullname) + directory_nbytes + needsep,
  286:                          len);
  287: 
  288:                   nchars = chars_in_text (SDATA (fullname), nbytes);
  289: 
  290:                   /* Some bug somewhere.  */
  291:                   if (nchars > nbytes)
  292:                     abort ();
  293: 
  294:                   STRING_SET_CHARS (fullname, nchars);
  295:                   if (nchars == nbytes)
  296:                     STRING_SET_UNIBYTE (fullname);
  297: 
  298:                   finalname = fullname;
  299:                 }
  300:               else
  301:                 finalname = name;
  302: 
  303:               if (attrs)
  304:                 {
  305:                   /* Construct an expanded filename for the directory entry.
  306:                      Use the decoded names for input to Ffile_attributes.  */
  307:                   Lisp_Object decoded_fullname, fileattrs;
  308:                   struct gcpro gcpro1, gcpro2;
  309: 
  310:                   decoded_fullname = fileattrs = Qnil;
  311:                   GCPRO2 (decoded_fullname, fileattrs);
  312: 
  313:                   /* Both Fexpand_file_name and Ffile_attributes can GC.  */
  314:                   decoded_fullname = Fexpand_file_name (name, directory);
  315:                   fileattrs = Ffile_attributes (decoded_fullname, id_format);
  316: 
  317:                   list = Fcons (Fcons (finalname, fileattrs), list);
  318:                   UNGCPRO;
  319:                 }
  320:               else
  321:                 list = Fcons (finalname, list);
  322:             }
  323: 
  324:           UNGCPRO;
  325:         }
  326:     }
  327: 
  328:   BLOCK_INPUT;
  329:   closedir (d);
  330:   UNBLOCK_INPUT;
  331: 
  332:   /* Discard the unwind protect.  */
  333:   specpdl_ptr = specpdl + count;
  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: ^L
  395: Lisp_Object file_name_completion ();
  396: 
  397: DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
  398:        2, 3, 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: If PREDICATE is non-nil, call PREDICATE with each possible
  406: completion (in absolute form) and ignore it if PREDICATE returns nil.
  407: 
  408: This function ignores some of the possible completions as
  409: determined by the variable `completion-ignored-extensions', which see.  */)
  410:      (file, directory, predicate)
  411:      Lisp_Object file, directory, predicate;
  412: {
  413:   Lisp_Object handler;
  414: 
  415:   /* If the directory name has special constructs in it,
  416:      call the corresponding file handler.  */
  417:   handler = Ffind_file_name_handler (directory, Qfile_name_completion);
  418:   if (!NILP (handler))
  419:     return call4 (handler, Qfile_name_completion, file, directory, predicate);
  420: 
  421:   /* If the file name has special constructs in it,
  422:      call the corresponding file handler.  */
  423:   handler = Ffind_file_name_handler (file, Qfile_name_completion);
  424:   if (!NILP (handler))
  425:     return call4 (handler, Qfile_name_completion, file, directory, predicate);
  426: 
  427:   return file_name_completion (file, directory, 0, 0, predicate);
  428: }
  429: 
  430: DEFUN ("file-name-all-completions", Ffile_name_all_completions,
  431:        Sfile_name_all_completions, 2, 2, 0,
  432:        doc: /* Return a list of all completions of file name FILE in directory DIRECTORY.
  433: These are all file names in directory DIRECTORY which begin with FILE.  */)
  434:      (file, directory)
  435:      Lisp_Object file, directory;
  436: {
  437:   Lisp_Object handler;
  438: 
  439:   /* If the directory name has special constructs in it,
  440:      call the corresponding file handler.  */
  441:   handler = Ffind_file_name_handler (directory, Qfile_name_all_completions);
  442:   if (!NILP (handler))
  443:     return call3 (handler, Qfile_name_all_completions, file, directory);
  444: 
  445:   /* If the file name has special constructs in it,
  446:      call the corresponding file handler.  */
  447:   handler = Ffind_file_name_handler (file, Qfile_name_all_completions);
  448:   if (!NILP (handler))
  449:     return call3 (handler, Qfile_name_all_completions, file, directory);
  450: 
  451:   return file_name_completion (file, directory, 1, 0, Qnil);
  452: }
  453: 
  454: static int file_name_completion_stat ();
  455: 
  456: Lisp_Object
  457: file_name_completion (file, dirname, all_flag, ver_flag, predicate)
  458:      Lisp_Object file, dirname;
  459:      int all_flag, ver_flag;
  460:      Lisp_Object predicate;
  461: {
  462:   DIR *d;
  463:   int bestmatchsize = 0, skip;
  464:   register int compare, matchsize;
  465:   unsigned char *p1, *p2;
  466:   int matchcount = 0;
  467:   /* If ALL_FLAG is 1, BESTMATCH is the list of all matches, decoded.
  468:      If ALL_FLAG is 0, BESTMATCH is either nil
  469:      or the best match so far, not decoded.  */
  470:   Lisp_Object bestmatch, tem, elt, name;
  471:   Lisp_Object encoded_file;
  472:   Lisp_Object encoded_dir;
  473:   struct stat st;
  474:   int directoryp;
  475:   int passcount;
  476:   int count = SPECPDL_INDEX ();
  477:   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
  478: 
  479:   elt = Qnil;
  480: 
  481: #ifdef VMS
  482:   extern DIRENTRY * readdirver ();
  483: 
  484:   DIRENTRY *((* readfunc) ());
  485: 
  486:   /* Filename completion on VMS ignores case, since VMS filesys does.  */
  487:   specbind (Qcompletion_ignore_case, Qt);
  488: 
  489:   readfunc = readdir;
  490:   if (ver_flag)
  491:     readfunc = readdirver;
  492:   file = Fupcase (file);
  493: #else  /* not VMS */
  494:   CHECK_STRING (file);
  495: #endif /* not VMS */
  496: 
  497: #ifdef FILE_SYSTEM_CASE
  498:   file = FILE_SYSTEM_CASE (file);
  499: #endif
  500:   bestmatch = Qnil;
  501:   encoded_file = encoded_dir = Qnil;
  502:   GCPRO5 (file, dirname, bestmatch, encoded_file, encoded_dir);
  503:   dirname = Fexpand_file_name (dirname, Qnil);
  504: 
  505:   /* Do completion on the encoded file name
  506:      because the other names in the directory are (we presume)
  507:      encoded likewise.  We decode the completed string at the end.  */
  508:   encoded_file = ENCODE_FILE (file);
  509: 
  510:   encoded_dir = ENCODE_FILE (dirname);
  511: 
  512:   /* With passcount = 0, ignore files that end in an ignored extension.
  513:      If nothing found then try again with passcount = 1, don't ignore them.
  514:      If looking for all completions, start with passcount = 1,
  515:      so always take even the ignored ones.
  516: 
  517:      ** It would not actually be helpful to the user to ignore any possible
  518:      completions when making a list of them.**  */
  519: 
  520:   for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
  521:     {
  522:       int inner_count = SPECPDL_INDEX ();
  523: 
  524:       BLOCK_INPUT;
  525:       d = opendir (SDATA (Fdirectory_file_name (encoded_dir)));
  526:       UNBLOCK_INPUT;
  527:       if (!d)
  528:         report_file_error ("Opening directory", Fcons (dirname, Qnil));
  529: 
  530:       record_unwind_protect (directory_files_internal_unwind,
  531:                              make_save_value (d, 0));
  532: 
  533:       /* Loop reading blocks */
  534:       /* (att3b compiler bug requires do a null comparison this way) */
  535:       while (1)
  536:         {
  537:           DIRENTRY *dp;
  538:           int len;
  539: 
  540: #ifdef VMS
  541:           dp = (*readfunc) (d);
  542: #else
  543:           errno = 0;
  544:           dp = readdir (d);
  545:           if (dp == NULL && (0
  546: # ifdef EAGAIN
  547:                              || errno == EAGAIN
  548: # endif
  549: # ifdef EINTR
  550:                              || errno == EINTR
  551: # endif
  552:                              ))
  553:             { QUIT; continue; }
  554: #endif
  555: 
  556:           if (!dp) break;
  557: 
  558:           len = NAMLEN (dp);
  559: 
  560:           QUIT;
  561:           if (! DIRENTRY_NONEMPTY (dp)
  562:               || len < SCHARS (encoded_file)
  563:               || 0 <= scmp (dp->d_name, SDATA (encoded_file),
  564:                             SCHARS (encoded_file)))
  565:             continue;
  566: 
  567:           if (file_name_completion_stat (encoded_dir, dp, &st) < 0)
  568:             continue;
  569: 
  570:           directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
  571:           tem = Qnil;
  572:           if (directoryp)
  573:             {
  574: #ifndef TRIVIAL_DIRECTORY_ENTRY
  575: #define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
  576: #endif
  577:               /* "." and ".." are never interesting as completions, and are
  578:                  actually in the way in a directory with only one file.  */
  579:               if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
  580:                 continue;
  581:               if (!passcount && len > SCHARS (encoded_file))
  582:                 /* Ignore directories if they match an element of
  583:                    completion-ignored-extensions which ends in a slash.  */
  584:                 for (tem = Vcompletion_ignored_extensions;
  585:                      CONSP (