Initial revision

src/dired.c

@@ -0,0 +1,478 @@
+/* Lisp functions for making directory listings.
+   Copyright (C) 1985, 1986 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 <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+
+#include "config.h"
+
+#ifdef SYSV_SYSTEM_DIR
+
+#include <dirent.h>
+#define DIRENTRY struct dirent
+#define NAMLEN(p) strlen (p->d_name)
+
+#else
+
+#ifdef NONSYSTEM_DIR_LIBRARY
+#include "ndir.h"
+#else /* not NONSYSTEM_DIR_LIBRARY */
+#include <sys/dir.h>
+#endif /* not NONSYSTEM_DIR_LIBRARY */
+
+#define DIRENTRY struct direct
+#define NAMLEN(p) p->d_namlen
+
+extern DIR *opendir ();
+extern struct direct *readdir ();
+
+#endif
+
+#undef NULL
+
+#include "lisp.h"
+#include "buffer.h"
+#include "commands.h"
+
+#include "regex.h"
+#include "search.h"
+
+#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
+
+Lisp_Object Vcompletion_ignored_extensions;
+
+Lisp_Object Qcompletion_ignore_case;
+
+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;
+
+  if (!NULL (match))
+    {
+      CHECK_STRING (match, 3);
+      /* Compile it now so we don't get an error after opendir */
+#ifdef VMS
+      compile_pattern (match, &searchbuf,
+		       buffer_defaults.downcase_table->contents);
+#else
+      compile_pattern (match, &searchbuf, 0);
+#endif
+    }
+
+  dirname = Fexpand_file_name (dirname, Qnil);
+  if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data)))
+    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 (dp->d_ino)
+	{
+	  if (NULL (match)
+	      || (0 <= re_search (&searchbuf, dp->d_name, len, 0, len, 0)))
+	    {
+	      if (!NULL (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 (!NULL (nosort))
+    return list;
+  return Fsort (Fnreverse (list), Qstring_lessp);
+}
+
+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;
+{
+  /* Don't waste time trying to complete a null string.
+     Besides, this case happens when user is being asked for
+     a directory name and has supplied one ending in a /.
+     We would not want to add anything in that case
+     even if there are some unique characters in that directory.  */
+  if (XTYPE (file) == Lisp_String && XSTRING (file)->size == 0)
+    return file;
+  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;
+{
+  return file_name_completion (file, dirname, 1, 0);
+}
+
+#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);
+}
+
+#endif /* VMS */
+
+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;
+#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 */
+
+  dirname = Fexpand_file_name (dirname, Qnil);
+  bestmatch = 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; NULL (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 (!NULL (Vquit_flag) && NULL (Vinhibit_quit))
+	    goto quit;
+	  if (!dp->d_ino
+	      || 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)
+            {
+	      /* 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 (XTYPE (elt) != Lisp_String) 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;
+		  }
+	    }
+
+	  /* Unless an ignored-extensions match was found,
+             process this name as a completion */
+	  if (passcount || !CONSP (tem))
+	    {
+	      /* Update computation of how much all possible completions match */
+
+	      matchcount++;
+
+	      if (all_flag || NULL (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 this dirname all matches,
+		     see if implicit following slash does too.  */
+		  if (directoryp
+		      && compare == matchsize
+		      && bestmatchsize > matchsize
+		      && p1[matchsize] == '/')
+		    matchsize++;
+		  bestmatchsize = min (matchsize, bestmatchsize);
+		}
+	    }
+	}
+      closedir (d);
+    }
+
+  unbind_to (count, Qnil);
+
+  if (all_flag || NULL (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;
+  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;
+
+  return stat (fullname, st_addr);
+}
+
+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.\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 exists, returns nil.")
+  (filename)
+     Lisp_Object filename;
+{
+  Lisp_Object values[12];
+  Lisp_Object dirname;
+  struct stat s;
+  struct stat sdir;
+  char modes[10];
+
+  filename = Fexpand_file_name (filename, Qnil);
+  if (lstat (XSTRING (filename)->data, &s) < 0)
+    return Qnil;
+
+  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);
+  /* perhaps we should set this to most-positive-fixnum if it is too large? */
+  values[7] = make_number (s.st_size);
+  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 compatability' */
+#endif
+#ifdef BSD4_2			/* file gid will be dir gid */
+  dirname = Ffile_name_directory (filename);
+  if (dirname != Qnil && 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);
+}
+
+syms_of_dired ()
+{
+  defsubr (&Sdirectory_files);
+  defsubr (&Sfile_name_completion);
+#ifdef VMS
+  defsubr (&Sfile_name_all_versions);
+#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;
+}

src/mocklisp.c

@@ -0,0 +1,242 @@
+/* Mocklisp compatibility functions for GNU Emacs Lisp interpreter.
+   Copyright (C) 1985, 1986 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.  */
+
+
+/* Compatibility for mocklisp */
+
+#include "config.h"
+#include "lisp.h"
+#include "buffer.h"
+
+/* Now in lisp code ("macrocode...")
+* DEFUN ("ml-defun", Fml_defun, Sml_defun, 0, UNEVALLED, 0,
+*  "Define mocklisp functions")
+*  (args)
+*     Lisp_Object args;
+* {
+*  Lisp_Object elt;
+*
+*   while (!NULL (args))
+*     {
+*       elt = Fcar (args);
+*       Ffset (Fcar (elt), Fcons (Qmocklisp, Fcdr (elt)));
+*       args = Fcdr (args);
+*     }
+*   return Qnil;
+* }
+*/
+
+DEFUN ("ml-if", Fml_if, Sml_if, 0, UNEVALLED, 0, "Mocklisp version of `if'.")
+  (args)
+     Lisp_Object args;
+{
+  register Lisp_Object val;
+  struct gcpro gcpro1;
+
+  GCPRO1 (args);
+  while (!NULL (args))
+    {
+      val = Feval (Fcar (args));
+      args = Fcdr (args);
+      if (NULL (args)) break;
+      if (XINT (val))
+	{
+	  val = Feval (Fcar (args));
+	  break;
+	}
+      args = Fcdr (args);
+    }
+  UNGCPRO;
+  return val;
+}
+
+/* Now converted to regular "while" by hairier conversion code.
+* DEFUN ("ml-while", Fml_while, Sml_while, 1, UNEVALLED, 0, "while  for mocklisp programs")
+*   (args)
+*      Lisp_Object args;
+* {
+*   Lisp_Object test, body, tem;
+*   struct gcpro gcpro1, gcpro2;
+*
+*   GCPRO2 (test, body);
+*
+*   test = Fcar (args);
+*   body = Fcdr (args);
+*   while (tem = Feval (test), XINT (tem))
+*     {
+*       QUIT;
+*       Fprogn (body);
+*    }
+*
+*   UNGCPRO;
+*   return Qnil;
+*}
+
+/* This is the main entry point to mocklisp execution.
+ When eval sees a mocklisp function being called, it calls here
+ with the unevaluated argument list */
+
+Lisp_Object
+ml_apply (function, args)
+     Lisp_Object function, args;
+{
+  register int count = specpdl_ptr - specpdl;
+  register Lisp_Object val;
+
+  specbind (Qmocklisp_arguments, args);
+  val = Fprogn (Fcdr (function));
+  return unbind_to (count, val);
+}
+
+DEFUN ("ml-nargs", Fml_nargs, Sml_nargs, 0, 0, 0,
+  "Number of arguments to currently executing mocklisp function.")
+  ()
+{
+  if (EQ (Vmocklisp_arguments, Qinteractive))
+    return make_number (0);
+  return Flength (Vmocklisp_arguments);
+}
+
+DEFUN ("ml-arg", Fml_arg, Sml_arg, 1, 2, 0,
+  "Argument number N to currently executing mocklisp function.")
+  (n, prompt)
+     Lisp_Object n, prompt;
+{
+  if (EQ (Vmocklisp_arguments, Qinteractive))
+    return Fread_string (prompt, Qnil);
+  CHECK_NUMBER (n, 0);
+  XSETINT (n, XINT (n) - 1);	/* Mocklisp likes to be origin-1 */
+  return Fcar (Fnthcdr (n, Vmocklisp_arguments));
+}
+
+DEFUN ("ml-interactive", Fml_interactive, Sml_interactive, 0, 0, 0,
+ "True if currently executing mocklisp function was called interactively.")
+  ()
+{
+  return (EQ (Vmocklisp_arguments, Qinteractive)) ? Qt : Qnil;
+}
+
+DEFUN ("ml-provide-prefix-argument", Fml_provide_prefix_argument, Sml_provide_prefix_argument,
+  2, UNEVALLED, 0,
+  "Evaluate second argument, using first argument as prefix arg value.")
+  (args)
+     Lisp_Object args;
+{
+  struct gcpro gcpro1;
+  GCPRO1 (args);
+  Vcurrent_prefix_arg = Feval (Fcar (args));
+  UNGCPRO;
+  return Feval (Fcar (Fcdr (args)));
+}
+
+DEFUN ("ml-prefix-argument-loop", Fml_prefix_argument_loop, Sml_prefix_argument_loop,
+       0, UNEVALLED, 0,
+  "")
+  (args)
+     Lisp_Object args;
+{
+  register Lisp_Object tem;
+  register int i;
+  struct gcpro gcpro1;
+
+  /* Set `arg' in case we call a built-in function that looks at it.  Still are a few. */
+  if (NULL (Vcurrent_prefix_arg))
+    i = 1;
+  else
+    {
+      tem = Vcurrent_prefix_arg;
+      if (CONSP (tem))
+	tem = Fcar (tem);
+      if (EQ (tem, Qminus))
+	i = -1;
+      else i = XINT (tem);
+    }
+
+  GCPRO1 (args);
+  while (i-- > 0)
+    Fprogn (args);
+  UNGCPRO;
+  return Qnil;
+}
+
+#if 0 /* Now in mlsupport.el */
+
+DEFUN ("ml-substr", Fml_substr, Sml_substr, 3, 3, 0,
+  "Return a substring of STRING, starting at index FROM and of length LENGTH.\n\
+If either FROM or LENGTH is negative, the length of STRING is added to it.")
+  (string, from, to)
+     Lisp_Object string, from, to;
+{
+  CHECK_STRING (string, 0);
+  CHECK_NUMBER (from, 1);
+  CHECK_NUMBER (to, 2);
+
+  if (XINT (from) < 0)
+    XSETINT (from, XINT (from) + XSTRING (string)->size);
+  if (XINT (to) < 0)
+    XSETINT (to, XINT (to) + XSTRING (string)->size);
+  XSETINT (to, XINT (to) + XINT (from));
+  return Fsubstring (string, from, to);
+}
+#endif NOTDEF
+DEFUN ("insert-string", Finsert_string, Sinsert_string, 0, MANY, 0,
+  "Mocklisp-compatibility insert function.\n\
+Like the function `insert' except that any argument that is a number\n\
+is converted into a string by expressing it in decimal.")
+  (nargs, args)
+     int nargs;
+     Lisp_Object *args;
+{
+  register int argnum;
+  register Lisp_Object tem;
+
+  for (argnum = 0; argnum < nargs; argnum++)
+    {
+      tem = args[argnum];
+    retry:
+      if (XTYPE (tem) == Lisp_Int)
+	tem = Fint_to_string (tem);
+      if (XTYPE (tem) == Lisp_String)
+	insert1 (tem);
+      else
+	{
+	  tem = wrong_type_argument (Qstringp, tem);
+	  goto retry;
+	}
+    }
+  return Qnil;
+}
+
+
+syms_of_mocklisp ()
+{
+  Qmocklisp = intern ("mocklisp");
+  staticpro (&Qmocklisp);
+
+/*defsubr (&Sml_defun);*/
+  defsubr (&Sml_if);
+/*defsubr (&Sml_while);*/
+  defsubr (&Sml_arg);
+  defsubr (&Sml_nargs);
+  defsubr (&Sml_interactive);
+  defsubr (&Sml_provide_prefix_argument);
+  defsubr (&Sml_prefix_argument_loop);
+/*defsubr (&Sml_substr);*/
+  defsubr (&Sinsert_string);
+}