(vendor-key-syms): Set this variable.
[bpt/emacs.git] / src / dired.c
index feb68ed..8ff3864 100644 (file)
@@ -1,5 +1,5 @@
 /* Lisp functions for making directory listings.
-   Copyright (C) 1985, 1986 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1993 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -22,38 +22,66 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 #include <sys/types.h>
 #include <sys/stat.h>
 
-#include "config.h"
+#include <config.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
-#define NAMLEN(p) strlen (p->d_name)
 
-#else
+#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
-#define NAMLEN(p) p->d_namlen
 
 extern DIR *opendir ();
 extern struct direct *readdir ();
 
-#endif
+#endif /* not MSDOS */
+#endif /* not SYSV_SYSTEM_DIR */
 
-#undef NULL
+#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"
-#include "search.h"
+
+/* A search buffer, with a fastmap allocated and ready to go.  */
+extern struct re_pattern_buffer searchbuf;
 
 #define min(a, b) ((a) < (b) ? (a) : (b))
 
@@ -64,9 +92,17 @@ extern struct direct *readdir ();
 #define lstat stat
 #endif
 
+extern int completion_ignore_case;
+extern Lisp_Object Ffind_file_name_handler ();
+
 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\
@@ -80,22 +116,62 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
 {
   DIR *d;
   int length;
-  Lisp_Object list, name;
+  Lisp_Object list, name, dirfilename;
+  Lisp_Object handler;
+
+  /* If the file name has special constructs in it,
+     call the corresponding file handler.  */
+  handler = Ffind_file_name_handler (dirname);
+  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;
 
-  if (!NULL (match))
+    /* 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);
-      /* Compile it now so we don't get an error after opendir */
+
+      /* 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
-      compile_pattern (match, &searchbuf,
+      compile_pattern (match, &searchbuf, 0,
                       buffer_defaults.downcase_table->contents);
 #else
-      compile_pattern (match, &searchbuf, 0);
+      compile_pattern (match, &searchbuf, 0, 0);
 #endif
     }
 
-  dirname = Fexpand_file_name (dirname, Qnil);
-  if (!(d = opendir (XSTRING (Fdirectory_file_name (dirname))->data)))
+  /* Now searchbuf 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;
@@ -109,12 +185,12 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
 
       if (!dp) break;
       len = NAMLEN (dp);
-      if (dp->d_ino)
+      if (DIRENTRY_NONEMPTY (dp))
        {
-         if (NULL (match)
+         if (NILP (match)
              || (0 <= re_search (&searchbuf, dp->d_name, len, 0, len, 0)))
            {
-             if (!NULL (full))
+             if (!NILP (full))
                {
                  int index = XSTRING (dirname)->size;
                  int total = len + index;
@@ -141,7 +217,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
        }
     }
   closedir (d);
-  if (!NULL (nosort))
+  if (!NILP (nosort))
     return list;
   return Fsort (Fnreverse (list), Qstring_lessp);
 }
@@ -158,6 +234,7 @@ Returns nil if DIR contains no name starting with FILE.")
   (file, dirname)
      Lisp_Object file, dirname;
 {
+  Lisp_Object handler;
   /* 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 /.
@@ -165,6 +242,13 @@ Returns nil if DIR contains no name starting with FILE.")
      even if there are some unique characters in that directory.  */
   if (XTYPE (file) == Lisp_String && XSTRING (file)->size == 0)
     return file;
+
+  /* If the file name has special constructs in it,
+     call the corresponding file handler.  */
+  handler = Ffind_file_name_handler (dirname);
+  if (!NILP (handler))
+    return call3 (handler, Qfile_name_completion, file, dirname);
+
   return file_name_completion (file, dirname, 0, 0);
 }
 
@@ -175,22 +259,17 @@ 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);
-}
+  Lisp_Object handler;
 
-#ifdef VMS
+  /* If the file name has special constructs in it,
+     call the corresponding file handler.  */
+  handler = Ffind_file_name_handler (dirname);
+  if (!NILP (handler))
+    return call3 (handler, Qfile_name_all_completions, file, dirname);
 
-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);
+  return file_name_completion (file, dirname, 1, 0);
 }
 
-#endif /* VMS */
-
 Lisp_Object
 file_name_completion (file, dirname, all_flag, ver_flag)
      Lisp_Object file, dirname;
@@ -223,6 +302,9 @@ file_name_completion (file, dirname, all_flag, ver_flag)
   CHECK_STRING (file, 0);
 #endif /* not VMS */
 
+#ifdef FILE_SYSTEM_CASE
+  file = FILE_SYSTEM_CASE (file);
+#endif
   dirname = Fexpand_file_name (dirname, Qnil);
   bestmatch = Qnil;
 
@@ -234,7 +316,7 @@ file_name_completion (file, dirname, all_flag, ver_flag)
      ** 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++)
+  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));
@@ -255,9 +337,9 @@ file_name_completion (file, dirname, all_flag, ver_flag)
 
          len = NAMLEN (dp);
 
-         if (!NULL (Vquit_flag) && NULL (Vinhibit_quit))
+         if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
            goto quit;
-         if (!dp->d_ino
+         if (! DIRENTRY_NONEMPTY (dp)
              || len < XSTRING (file)->size
              || 0 <= scmp (dp->d_name, XSTRING (file)->data,
                            XSTRING (file)->size))
@@ -298,7 +380,7 @@ file_name_completion (file, dirname, all_flag, ver_flag)
 
              matchcount++;
 
-             if (all_flag || NULL (bestmatch))
+             if (all_flag || NILP (bestmatch))
                {
                  /* This is a possible completion */
                  if (directoryp)
@@ -326,14 +408,43 @@ file_name_completion (file, dirname, all_flag, ver_flag)
                  matchsize = scmp(p1, p2, compare);
                  if (matchsize < 0)
                    matchsize = compare;
-                 /* If this dirname all matches,
-                    see if implicit following slash does too.  */
+                 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 = min (matchsize, bestmatchsize);
+                 bestmatchsize = matchsize;
                }
            }
        }
@@ -342,7 +453,7 @@ file_name_completion (file, dirname, all_flag, ver_flag)
 
   unbind_to (count, Qnil);
 
-  if (all_flag || NULL (bestmatch))
+  if (all_flag || NILP (bestmatch))
     return bestmatch;
   if (matchcount == 1 && bestmatchsize == XSTRING (file)->size)
     return Qt;
@@ -371,8 +482,53 @@ file_name_completion_stat (dirname, dp, st_addr)
   bcopy (dp->d_name, fullname + pos, len);
   fullname[pos + len] = 0;
 
+#ifdef S_IFLNK
+  return lstat (fullname, st_addr);
+#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)
@@ -394,13 +550,13 @@ Otherwise, list elements are:\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\
+ 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 exists, returns nil.")
+If file does not exist, returns nil.")
   (filename)
      Lisp_Object filename;
 {
@@ -409,11 +565,35 @@ If file does not exists, returns nil.")
   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);
+  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:
@@ -431,16 +611,18 @@ If file does not exists, returns nil.")
   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);
+  /* 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 compatability' */
+#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 (dirname != Qnil && stat (XSTRING (dirname)->data, &sdir) == 0)
+  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;
@@ -457,10 +639,16 @@ If file does not exists, returns nil.")
 \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);