src/dired.c

/* Lisp functions for making directory listings.
   Copyright (C) 1985, 1986, 1993, 1994 Free Software Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */


#include <config.h>

#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>

#ifdef VMS
#include <string.h>
#include <rms.h>
#include <rmsdef.h>
#endif

/* The d_nameln member of a struct dirent includes the '\0' character
   on some systems, but not on others.  What's worse, you can't tell
   at compile-time which one it will be, since it really depends on
   the sort of system providing the filesystem you're reading from,
   not the system you are running on.  Paul Eggert
   <eggert@bi.twinsun.com> says this occurs when Emacs is running on a
   SunOS 4.1.2 host, reading a directory that is remote-mounted from a
   Solaris 2.1 host and is in a native Solaris 2.1 filesystem.

   Since applying strlen to the name always works, we'll just do that.  */
#define NAMLEN(p) strlen (p->d_name)

#ifdef SYSV_SYSTEM_DIR

#include <dirent.h>
#define DIRENTRY struct dirent

#else /* not SYSV_SYSTEM_DIR */

#ifdef NONSYSTEM_DIR_LIBRARY
#include "ndir.h"
#else /* not NONSYSTEM_DIR_LIBRARY */
#ifdef MSDOS
#include <dirent.h>
#else
#include <sys/dir.h>
#endif
#endif /* not NONSYSTEM_DIR_LIBRARY */

#ifndef MSDOS
#define DIRENTRY struct direct

extern DIR *opendir ();
extern struct direct *readdir ();

#endif /* not MSDOS */
#endif /* not SYSV_SYSTEM_DIR */

#ifdef MSDOS
#define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0)
#else
#define DIRENTRY_NONEMPTY(p) ((p)->d_ino)
#endif

#include "lisp.h"
#include "buffer.h"
#include "commands.h"

#include "regex.h"

/* Returns a search buffer, with a fastmap allocated and ready to go.  */
extern struct re_pattern_buffer *compile_pattern ();

#define min(a, b) ((a) < (b) ? (a) : (b))

/* if system does not have symbolic links, it does not have lstat.
   In that case, use ordinary stat instead.  */

#ifndef S_IFLNK
#define lstat stat
#endif

extern int completion_ignore_case;
extern Lisp_Object Vcompletion_regexp_list;

Lisp_Object Vcompletion_ignored_extensions;
Lisp_Object Qcompletion_ignore_case;
Lisp_Object Qdirectory_files;
Lisp_Object Qfile_name_completion;
Lisp_Object Qfile_name_all_completions;
Lisp_Object Qfile_attributes;
\f
DEFUN ("directory-files", Fdirectory_files, Sdirectory_files, 1, 4, 0,
  "Return a list of names of files in DIRECTORY.\n\
There are three optional arguments:\n\
If FULL is non-nil, absolute pathnames of the files are returned.\n\
If MATCH is non-nil, only pathnames containing that regexp are returned.\n\
If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
 NOSORT is useful if you plan to sort the result yourself.")
  (dirname, full, match, nosort)
     Lisp_Object dirname, full, match, nosort;
{
  DIR *d;
  int length;
  Lisp_Object list, name, dirfilename;
  Lisp_Object handler;
  struct re_pattern_buffer *bufp;

  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
  handler = Ffind_file_name_handler (dirname, Qdirectory_files);
  if (!NILP (handler))
    {
      Lisp_Object args[6];

      args[0] = handler;
      args[1] = Qdirectory_files;
      args[2] = dirname;
      args[3] = full;
      args[4] = match;
      args[5] = nosort;
      return Ffuncall (6, args);
    }

  {
    struct gcpro gcpro1, gcpro2;

    /* Because of file name handlers, these functions might call
     Ffuncall, and cause a GC.  */
    GCPRO1 (match);
    dirname = Fexpand_file_name (dirname, Qnil);
    UNGCPRO;
    GCPRO2 (match, dirname);
    dirfilename = Fdirectory_file_name (dirname);
    UNGCPRO;
  }

  if (!NILP (match))
    {
      CHECK_STRING (match, 3);

      /* MATCH might be a flawed regular expression.  Rather than
	 catching and signalling our own errors, we just call
	 compile_pattern to do the work for us.  */
#ifdef VMS
      bufp = compile_pattern (match, 0,
			      buffer_defaults.downcase_table->contents);
#else
      bufp = compile_pattern (match, 0, 0);
#endif
    }

  /* Now *bufp is the compiled form of MATCH; don't call anything
     which might compile a new regexp until we're done with the loop!  */

  /* Do this opendir after anything which might signal an error; if
     an error is signalled while the directory stream is open, we
     have to make sure it gets closed, and setting up an
     unwind_protect to do so would be a pain.  */
  d = opendir (XSTRING (dirfilename)->data);
  if (! d)
    report_file_error ("Opening directory", Fcons (dirname, Qnil));

  list = Qnil;
  length = XSTRING (dirname)->size;

  /* Loop reading blocks */
  while (1)
    {
      DIRENTRY *dp = readdir (d);
      int len;

      if (!dp) break;
      len = NAMLEN (dp);
      if (DIRENTRY_NONEMPTY (dp))
	{
	  if (NILP (match)
	      || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0)))
	    {
	      if (!NILP (full))
		{
		  int index = XSTRING (dirname)->size;
		  int total = len + index;
#ifndef VMS
		  if (length == 0
		      || XSTRING (dirname)->data[length - 1] != '/')
		    total++;
#endif /* VMS */

		  name = make_uninit_string (total);
		  bcopy (XSTRING (dirname)->data, XSTRING (name)->data,
			 index);
#ifndef VMS
		  if (length == 0
		      || XSTRING (dirname)->data[length - 1] != '/')
		    XSTRING (name)->data[index++] = '/';
#endif /* VMS */
		  bcopy (dp->d_name, XSTRING (name)->data + index, len);
		}
	      else
		name = make_string (dp->d_name, len);
	      list = Fcons (name, list);
	    }
	}
    }
  closedir (d);
  if (!NILP (nosort))
    return list;
  return Fsort (Fnreverse (list), Qstring_lessp);
}
\f
Lisp_Object file_name_completion ();

DEFUN ("file-name-completion", Ffile_name_completion, Sfile_name_completion,
  2, 2, 0,
  "Complete file name FILE in directory DIR.\n\
Returns the longest string\n\
common to all filenames in DIR that start with FILE.\n\
If there is only one and FILE matches it exactly, returns t.\n\
Returns nil if DIR contains no name starting with FILE.")
  (file, dirname)
     Lisp_Object file, dirname;
{
  Lisp_Object handler;

  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
  handler = Ffind_file_name_handler (dirname, Qfile_name_completion);
  if (!NILP (handler))
    return call3 (handler, Qfile_name_completion, file, dirname);

  return file_name_completion (file, dirname, 0, 0);
}

DEFUN ("file-name-all-completions", Ffile_name_all_completions,
  Sfile_name_all_completions, 2, 2, 0,
  "Return a list of all completions of file name FILE in directory DIR.\n\
These are all file names in directory DIR which begin with FILE.")
  (file, dirname)
     Lisp_Object file, dirname;
{
  Lisp_Object handler;

  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
  handler = Ffind_file_name_handler (dirname, Qfile_name_all_completions);
  if (!NILP (handler))
    return call3 (handler, Qfile_name_all_completions, file, dirname);

  return file_name_completion (file, dirname, 1, 0);
}

Lisp_Object
file_name_completion (file, dirname, all_flag, ver_flag)
     Lisp_Object file, dirname;
     int all_flag, ver_flag;
{
  DIR *d;
  DIRENTRY *dp;
  int bestmatchsize, skip;
  register int compare, matchsize;
  unsigned char *p1, *p2;
  int matchcount = 0;
  Lisp_Object bestmatch, tem, elt, name;
  struct stat st;
  int directoryp;
  int passcount;
  int count = specpdl_ptr - specpdl;
  struct gcpro gcpro1, gcpro2, gcpro3;

#ifdef VMS
  extern DIRENTRY * readdirver ();

  DIRENTRY *((* readfunc) ());

  /* Filename completion on VMS ignores case, since VMS filesys does.  */
  specbind (Qcompletion_ignore_case, Qt);

  readfunc = readdir;
  if (ver_flag)
    readfunc = readdirver;
  file = Fupcase (file);
#else  /* not VMS */
  CHECK_STRING (file, 0);
#endif /* not VMS */

#ifdef FILE_SYSTEM_CASE
  file = FILE_SYSTEM_CASE (file);
#endif
  bestmatch = Qnil;
  GCPRO3 (file, dirname, bestmatch);
  dirname = Fexpand_file_name (dirname, Qnil);

  /* With passcount = 0, ignore files that end in an ignored extension.
     If nothing found then try again with passcount = 1, don't ignore them.
     If looking for all completions, start with passcount = 1,
     so always take even the ignored ones.

     ** It would not actually be helpful to the user to ignore any possible
     completions when making a list of them.**  */

  for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++)
    {
      if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data)))
	report_file_error ("Opening directory", Fcons (dirname, Qnil));

      /* Loop reading blocks */
      /* (att3b compiler bug requires do a null comparison this way) */
      while (1)
	{
	  DIRENTRY *dp;
	  int len;

#ifdef VMS
	  dp = (*readfunc) (d);
#else
	  dp = readdir (d);
#endif
	  if (!dp) break;

	  len = NAMLEN (dp);

	  if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
	    goto quit;
	  if (! DIRENTRY_NONEMPTY (dp)
	      || len < XSTRING (file)->size
	      || 0 <= scmp (dp->d_name, XSTRING (file)->data,
			    XSTRING (file)->size))
	    continue;

          if (file_name_completion_stat (dirname, dp, &st) < 0)
            continue;

          directoryp = ((st.st_mode & S_IFMT) == S_IFDIR);
	  tem = Qnil;
          if (directoryp)
	    {
#ifndef TRIVIAL_DIRECTORY_ENTRY
#define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, ".."))
#endif
	      /* "." and ".." are never interesting as completions, but are
		 actually in the way in a directory contains only one file.  */
	      if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name))
		continue;
	    }
	  else
            {
	      /* Compare extensions-to-be-ignored against end of this file name */
	      /* if name is not an exact match against specified string */
	      if (!passcount && len > XSTRING (file)->size)
		/* and exit this for loop if a match is found */
		for (tem = Vcompletion_ignored_extensions;
		     CONSP (tem); tem = XCONS (tem)->cdr)
		  {
		    elt = XCONS (tem)->car;
		    if (!STRINGP (elt)) continue;
		    skip = len - XSTRING (elt)->size;
		    if (skip < 0) continue;

		    if (0 <= scmp (dp->d_name + skip,
				   XSTRING (elt)->data,
				   XSTRING (elt)->size))
		      continue;
		    break;
		  }
	    }

	  /* If an ignored-extensions match was found,
	     don't process this name as a completion.  */
	  if (!passcount && CONSP (tem))
	    continue;

	  if (!passcount)
	    {
	      Lisp_Object regexps;
	      Lisp_Object zero;
	      XSETFASTINT (zero, 0);

	      /* Ignore this element if it fails to match all the regexps.  */
	      for (regexps = Vcompletion_regexp_list; CONSP (regexps);
		   regexps = XCONS (regexps)->cdr)
		{
		  tem = Fstring_match (XCONS (regexps)->car, elt, zero);
		  if (NILP (tem))
		    break;
		}
	      if (CONSP (regexps))
		continue;
	    }

	  /* Update computation of how much all possible completions match */

	  matchcount++;

	  if (all_flag || NILP (bestmatch))
	    {
	      /* This is a possible completion */
	      if (directoryp)
		{
		  /* This completion is a directory; make it end with '/' */
		  name = Ffile_name_as_directory (make_string (dp->d_name, len));
		}
	      else
		name = make_string (dp->d_name, len);
	      if (all_flag)
		{
		  bestmatch = Fcons (name, bestmatch);
		}
	      else
		{
		  bestmatch = name;
		  bestmatchsize = XSTRING (name)->size;
		}
	    }
	  else
	    {
	      compare = min (bestmatchsize, len);
	      p1 = XSTRING (bestmatch)->data;
	      p2 = (unsigned char *) dp->d_name;
	      matchsize = scmp(p1, p2, compare);
	      if (matchsize < 0)
		matchsize = compare;
	      if (completion_ignore_case)
		{
		  /* If this is an exact match except for case,
		     use it as the best match rather than one that is not
		     an exact match.  This way, we get the case pattern
		     of the actual match.  */
		  if ((matchsize == len
		       && matchsize + !!directoryp
			  < XSTRING (bestmatch)->size)
		      ||
		      /* If there is no exact match ignoring case,
			 prefer a match that does not change the case
			 of the input.  */
		      (((matchsize == len)
			==
			(matchsize + !!directoryp
			 == XSTRING (bestmatch)->size))
		       /* If there is more than one exact match aside from
			  case, and one of them is exact including case,
			  prefer that one.  */
		       && !bcmp (p2, XSTRING (file)->data, XSTRING (file)->size)
		       && bcmp (p1, XSTRING (file)->data, XSTRING (file)->size)))
		    {
		      bestmatch = make_string (dp->d_name, len);
		      if (directoryp)
			bestmatch = Ffile_name_as_directory (bestmatch);
		    }
		}

	      /* If this dirname all matches, see if implicit following
		 slash does too.  */
	      if (directoryp
		  && compare == matchsize
		  && bestmatchsize > matchsize
		  && p1[matchsize] == '/')
		matchsize++;
	      bestmatchsize = matchsize;
	    }
	}
      closedir (d);
    }

  UNGCPRO;
  bestmatch = unbind_to (count, bestmatch);

  if (all_flag || NILP (bestmatch))
    return bestmatch;
  if (matchcount == 1 && bestmatchsize == XSTRING (file)->size)
    return Qt;
  return Fsubstring (bestmatch, make_number (0), make_number (bestmatchsize));
 quit:
  if (d) closedir (d);
  Vquit_flag = Qnil;
  return Fsignal (Qquit, Qnil);
}

file_name_completion_stat (dirname, dp, st_addr)
     Lisp_Object dirname;
     DIRENTRY *dp;
     struct stat *st_addr;
{
  int len = NAMLEN (dp);
  int pos = XSTRING (dirname)->size;
  int value;
  char *fullname = (char *) alloca (len + pos + 2);

  bcopy (XSTRING (dirname)->data, fullname, pos);
#ifndef VMS
  if (fullname[pos - 1] != '/')
    fullname[pos++] = '/';
#endif

  bcopy (dp->d_name, fullname + pos, len);
  fullname[pos + len] = 0;

#ifdef S_IFLNK
  /* We want to return success if a link points to a nonexistent file,
     but we want to return the status for what the link points to,
     in case it is a directory.  */
  value = lstat (fullname, st_addr);
  stat (fullname, st_addr);
  return value;
#else
  return stat (fullname, st_addr);
#endif
}
\f
#ifdef VMS

DEFUN ("file-name-all-versions", Ffile_name_all_versions,
  Sfile_name_all_versions, 2, 2, 0,
  "Return a list of all versions of file name FILE in directory DIR.")
  (file, dirname)
     Lisp_Object file, dirname;
{
  return file_name_completion (file, dirname, 1, 1);
}

DEFUN ("file-version-limit", Ffile_version_limit, Sfile_version_limit, 1, 1, 0,
  "Return the maximum number of versions allowed for FILE.\n\
Returns nil if the file cannot be opened or if there is no version limit.")
  (filename)
     Lisp_Object filename;
{
  Lisp_Object retval;
  struct FAB    fab;
  struct RAB    rab;
  struct XABFHC xabfhc;
  int status;

  filename = Fexpand_file_name (filename, Qnil);
  fab      = cc$rms_fab;
  xabfhc   = cc$rms_xabfhc;
  fab.fab$l_fna = XSTRING (filename)->data;
  fab.fab$b_fns = strlen (fab.fab$l_fna);
  fab.fab$l_xab = (char *) &xabfhc;
  status = sys$open (&fab, 0, 0);
  if (status != RMS$_NORMAL)	/* Probably non-existent file */
    return Qnil;
  sys$close (&fab, 0, 0);
  if (xabfhc.xab$w_verlimit == 32767)
    return Qnil;		/* No version limit */
  else
    return make_number (xabfhc.xab$w_verlimit);
}

#endif /* VMS */
\f
Lisp_Object
make_time (time)
     int time;
{
  return Fcons (make_number (time >> 16),
		Fcons (make_number (time & 0177777), Qnil));
}

DEFUN ("file-attributes", Ffile_attributes, Sfile_attributes, 1, 1, 0,
  "Return a list of attributes of file FILENAME.\n\
Value is nil if specified file cannot be opened.\n\
Otherwise, list elements are:\n\
 0. t for directory, string (name linked to) for symbolic link, or nil.\n\
 1. Number of links to file.\n\
 2. File uid.\n\
 3. File gid.\n\
 4. Last access time, as a list of two integers.\n\
  First integer has high-order 16 bits of time, second has low 16 bits.\n\
 5. Last modification time, likewise.\n\
 6. Last status change time, likewise.\n\
 7. Size in bytes (-1, if number is out of range).\n\
 8. File modes, as a string of ten letters or dashes as in ls -l.\n\
 9. t iff file's gid would change if file were deleted and recreated.\n\
10. inode number.\n\
11. Device number.\n\
\n\
If file does not exist, returns nil.")
  (filename)
     Lisp_Object filename;
{
  Lisp_Object values[12];
  Lisp_Object dirname;
  struct stat s;
  struct stat sdir;
  char modes[10];
  Lisp_Object handler;

  filename = Fexpand_file_name (filename, Qnil);

  /* If the file name has special constructs in it,
     call the corresponding file handler.  */
  handler = Ffind_file_name_handler (filename, Qfile_attributes);
  if (!NILP (handler))
    return call2 (handler, Qfile_attributes, filename);

  if (lstat (XSTRING (filename)->data, &s) < 0)
    return Qnil;

#ifdef MSDOS
  {
    char *tmpnam = XSTRING (Ffile_name_nondirectory (filename))->data;
    int l = strlen (tmpnam);

    if (l >= 5
	&& S_ISREG (s.st_mode)
	&& (stricmp (&tmpnam[l - 4], ".com") == 0
	    || stricmp (&tmpnam[l - 4], ".exe") == 0
	    || stricmp (&tmpnam[l - 4], ".bat") == 0))
      {
	s.st_mode |= S_IEXEC;
      }
  }
#endif /* MSDOS */

  switch (s.st_mode & S_IFMT)
    {
    default:
      values[0] = Qnil; break;
    case S_IFDIR:
      values[0] = Qt; break;
#ifdef S_IFLNK
    case S_IFLNK:
      values[0] = Ffile_symlink_p (filename); break;
#endif
    }
  values[1] = make_number (s.st_nlink);
  values[2] = make_number (s.st_uid);
  values[3] = make_number (s.st_gid);
  values[4] = make_time (s.st_atime);
  values[5] = make_time (s.st_mtime);
  values[6] = make_time (s.st_ctime);
  values[7] = make_number ((int) s.st_size);
  /* If the size is out of range, give back -1.  */
  if (XINT (values[7]) != s.st_size)
    XSETINT (values[7], -1);
  filemodestring (&s, modes);
  values[8] = make_string (modes, 10);
#ifdef BSD4_3 /* Gross kludge to avoid lack of "#if defined(...)" in VMS */
#define BSD4_2 /* A new meaning to the term `backwards compatibility' */
#endif
#ifdef BSD4_2			/* file gid will be dir gid */
  dirname = Ffile_name_directory (filename);
  if (! NILP (dirname) && stat (XSTRING (dirname)->data, &sdir) == 0)
    values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil;
  else					/* if we can't tell, assume worst */
    values[9] = Qt;
#else					/* file gid will be egid */
  values[9] = (s.st_gid != getegid ()) ? Qt : Qnil;
#endif	/* BSD4_2 (or BSD4_3) */
#ifdef BSD4_3
#undef BSD4_2 /* ok, you can look again without throwing up */
#endif
  values[10] = make_number (s.st_ino);
  values[11] = make_number (s.st_dev);
  return Flist (sizeof(values) / sizeof(values[0]), values);
}
\f
syms_of_dired ()
{
  Qdirectory_files = intern ("directory-files");
  Qfile_name_completion = intern ("file-name-completion");
  Qfile_name_all_completions = intern ("file-name-all-completions");
  Qfile_attributes = intern ("file-attributes");

  defsubr (&Sdirectory_files);
  defsubr (&Sfile_name_completion);
#ifdef VMS
  defsubr (&Sfile_name_all_versions);
  defsubr (&Sfile_version_limit);
#endif /* VMS */
  defsubr (&Sfile_name_all_completions);
  defsubr (&Sfile_attributes);

#ifdef VMS
  Qcompletion_ignore_case = intern ("completion-ignore-case");
  staticpro (&Qcompletion_ignore_case);
#endif /* VMS */

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