(vendor-key-syms): Set this variable.
[bpt/emacs.git] / src / dired.c
index a3b02f0..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,28 +22,56 @@ 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 /* 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"
@@ -52,6 +80,9 @@ extern struct direct *readdir ();
 
 #include "regex.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))
 
 /* if system does not have symbolic links, it does not have lstat.
@@ -61,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\
@@ -77,7 +116,37 @@ 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;
+
+    /* 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))
     {
@@ -87,15 +156,22 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.\n\
         catching and signalling our own errors, we just call
         compile_pattern to do the work for us.  */
 #ifdef VMS
-      compile_pattern (match, &searchbuf, 0
+      compile_pattern (match, &searchbuf, 0,
                       buffer_defaults.downcase_table->contents);
 #else
       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,7 +185,7 @@ 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 (NILP (match)
              || (0 <= re_search (&searchbuf, dp->d_name, len, 0, len, 0)))
@@ -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;
 
@@ -257,7 +339,7 @@ file_name_completion (file, dirname, all_flag, ver_flag)
 
          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))
@@ -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;
                }
            }
        }
@@ -371,9 +482,54 @@ 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)
      int 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);