2001-11-04 Stefan Jahn <stefan@lkcc.org>

[bpt/guile.git] / libguile / filesys.c

diff --git a/libguile/filesys.c b/libguile/filesys.c
index 0593414..806c8c1 100644 (file)
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -39,8 +39,6 @@
  * whether to permit this exception to apply to your modifications.
  * If you do not wish that, delete this exception notice.  */
 
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
-   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
 
 \f
 #include <stdio.h>
@@ -62,6 +60,10 @@
 #include <io.h>
 #endif
 
+#ifdef HAVE_DIRECT_H
+#include <direct.h>
+#endif
+
 #ifdef TIME_WITH_SYS_TIME
 # include <sys/time.h>
 # include <time.h>
@@ -98,7 +100,10 @@
 #endif
 
 
-#if HAVE_DIRENT_H
+#if defined (__MINGW32__) || defined (_MSC_VER) || defined (__BORLANDC__)
+# include "win32-dirent.h"
+# define NAMLEN(dirent) strlen((dirent)->d_name)
+#elif HAVE_DIRENT_H
 # include <dirent.h>
 # define NAMLEN(dirent) strlen((dirent)->d_name)
 #else
@@ -123,15 +128,60 @@
 /* The MinGW gcc does not define the S_ISSOCK macro. Any other native Windows
    compiler like BorlandC or MSVC has none of these macros defined. */
 #ifdef __MINGW32__
-# define S_ISSOCK(mode) (0)
-#endif
-#if defined (__BORLANDC__) || defined (_MSC_VER)
-# define S_ISBLK(mode) (0)
+
+# ifdef _S_IFIFO
+#  undef _S_IFIFO
+# endif
+# ifdef _S_IFCHR
+#  undef _S_IFCHR
+# endif
+# ifdef _S_IFBLK
+#  undef _S_IFBLK
+# endif
+# ifdef _S_IFDIR
+#  undef _S_IFDIR
+# endif
+# ifdef _S_IFREG
+#  undef _S_IFREG
+# endif
+# ifdef _S_IFSOCK
+#  undef _S_IFSOCK
+# endif
+
+# define _S_IFIFO        0x1000  /* FIFO */
+# define _S_IFCHR        0x2000  /* Character */
+# define _S_IFBLK        0x3000  /* Block */
+# define _S_IFDIR        0x4000  /* Directory */
+# define _S_IFREG        0x8000  /* Regular */
+# define _S_IFSOCK       0xC000  /* Socket */
+
+# ifdef S_ISBLK
+#  undef S_ISBLK
+# endif
+# ifdef S_ISFIFO
+#  undef S_ISFIFO
+# endif
+# ifdef S_ISCHR
+#  undef S_ISCHR
+# endif
+# ifdef S_ISDIR
+#  undef S_ISDIR
+# endif
+# ifdef S_ISREG
+#  undef S_ISREG
+# endif
+# ifdef S_ISSOCK
+#  undef S_ISSOCK
+# endif
+
+# define S_ISBLK(mode)  (((mode) & _S_IFMT) == _S_IFBLK)
 # define S_ISFIFO(mode) (((mode) & _S_IFMT) == _S_IFIFO)
-# define S_ISCHR(mode) (((mode) & _S_IFMT) == _S_IFCHR)
-# define S_ISDIR(mode) (((mode) & _S_IFMT) == _S_IFDIR)
-# define S_ISREG(mode) (((mode) & _S_IFMT) == _S_IFREG)
-#endif
+# define S_ISCHR(mode)  (((mode) & _S_IFMT) == _S_IFCHR)
+# define S_ISDIR(mode)  (((mode) & _S_IFMT) == _S_IFDIR)
+# define S_ISREG(mode)  (((mode) & _S_IFMT) == _S_IFREG)
+# define S_ISSOCK(mode) (((mode) & _S_IFMT) == _S_IFSOCK)
+
+#endif /* __MINGW32__ */
 
 /* Some more definitions for the native Windows port. */
 #ifdef __MINGW32__
@@ -181,7 +231,6 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0,
 #endif
     {
       SCM_VALIDATE_STRING (1, object);
-      SCM_STRING_COERCE_0TERMINATION_X (object);
       SCM_SYSCALL (rv = chown (SCM_STRING_CHARS (object),
                               SCM_INUM (owner), SCM_INUM (group)));
     }
@@ -221,7 +270,6 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
   else
     {
       SCM_VALIDATE_STRING (1, object);
-      SCM_STRING_COERCE_0TERMINATION_X (object);
       SCM_SYSCALL (rv = chmod (SCM_STRING_CHARS (object), SCM_INUM (mode)));
     }
   if (rv == -1)
@@ -266,7 +314,6 @@ SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0,
   int imode;
 
   SCM_VALIDATE_STRING (1, path);
-  SCM_STRING_COERCE_0TERMINATION_X (path);
   iflags = SCM_NUM2INT (2, flags);
   imode = SCM_NUM2INT_DEF (3, mode, 0666);
   SCM_SYSCALL (fd = open (SCM_STRING_CHARS (path), iflags, imode));
@@ -488,6 +535,31 @@ scm_stat2scm (struct stat *stat_temp)
   return ans;
 }
 
+#ifdef __MINGW32__
+/*
+ * Try getting the appropiate stat buffer for a given file descriptor
+ * under Windows. It differentiates between file, pipe and socket 
+ * descriptors.
+ */
+static int fstat_Win32 (int fdes, struct stat *buf)
+{
+  int error, optlen = sizeof (int);
+
+  memset (buf, 0, sizeof (struct stat));
+
+  /* Is this a socket ? */
+  if (getsockopt (fdes, SOL_SOCKET, SO_ERROR, (void *) &error, &optlen) >= 0)
+    {
+      buf->st_mode = _S_IFSOCK | _S_IREAD | _S_IWRITE | _S_IEXEC;
+      buf->st_nlink = 1;
+      buf->st_atime = buf->st_ctime = buf->st_mtime = time (NULL);
+      return 0;
+    }
+  /* Maybe a regular file or pipe ? */
+  return fstat (fdes, buf);
+}
+#endif /* __MINGW32__ */
+
 SCM_DEFINE (scm_stat, "stat", 1, 0, 0, 
             (SCM object),
            "Return an object containing various information about the file\n"
@@ -554,19 +626,35 @@ SCM_DEFINE (scm_stat, "stat", 1, 0, 0,
 
   if (SCM_INUMP (object))
     {
+#ifdef __MINGW32__
+      SCM_SYSCALL (rv = fstat_Win32 (SCM_INUM (object), &stat_temp));
+#else
       SCM_SYSCALL (rv = fstat (SCM_INUM (object), &stat_temp));
+#endif
     }
   else if (SCM_STRINGP (object))
     {
-      SCM_STRING_COERCE_0TERMINATION_X (object);
+#ifdef __MINGW32__
+      char *p, *file = strdup (SCM_STRING_CHARS (object));
+      p = file + strlen (file) - 1;
+      while (p > file && (*p == '/' || *p == '\\'))
+       *p-- = '\0';
+      SCM_SYSCALL (rv = stat (file, &stat_temp));
+      free (file);
+#else
       SCM_SYSCALL (rv = stat (SCM_STRING_CHARS (object), &stat_temp));
+#endif
     }
   else
     {
       object = SCM_COERCE_OUTPORT (object);
       SCM_VALIDATE_OPFPORT (1, object);
       fdes = SCM_FPORT_FDES (object);
+#ifdef __MINGW32__
+      SCM_SYSCALL (rv = fstat_Win32 (fdes, &stat_temp));
+#else
       SCM_SYSCALL (rv = fstat (fdes, &stat_temp));
+#endif
     }
 
   if (rv == -1)
@@ -574,7 +662,8 @@ SCM_DEFINE (scm_stat, "stat", 1, 0, 0,
       int en = errno;
 
       SCM_SYSERROR_MSG ("~A: ~S",
-                       SCM_LIST2 (scm_makfrom0str (strerror (errno)), object),
+                       scm_list_2 (scm_makfrom0str (strerror (errno)),
+                                   object),
                        en);
     }
   return scm_stat2scm (&stat_temp);
@@ -597,9 +686,7 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0,
   int val;
 
   SCM_VALIDATE_STRING (1, oldpath);
-  SCM_STRING_COERCE_0TERMINATION_X (oldpath);
   SCM_VALIDATE_STRING (2, newpath);
-  SCM_STRING_COERCE_0TERMINATION_X (newpath);
   SCM_SYSCALL (val = link (SCM_STRING_CHARS (oldpath),
                           SCM_STRING_CHARS (newpath)));
   if (val != 0)
@@ -620,8 +707,6 @@ SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0,
   int rv;
   SCM_VALIDATE_STRING (1, oldname);
   SCM_VALIDATE_STRING (2, newname);
-  SCM_STRING_COERCE_0TERMINATION_X (oldname);
-  SCM_STRING_COERCE_0TERMINATION_X (newname);
 #ifdef HAVE_RENAME
   SCM_SYSCALL (rv = rename (SCM_STRING_CHARS (oldname), SCM_STRING_CHARS (newname)));
 #else
@@ -648,7 +733,6 @@ SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0,
 {
   int ans;
   SCM_VALIDATE_STRING (1, str);
-  SCM_STRING_COERCE_0TERMINATION_X (str);
   SCM_SYSCALL (ans = unlink (SCM_STRING_CHARS (str)));
   if (ans != 0)
     SCM_SYSERROR;
@@ -668,7 +752,6 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
   int rv;
   mode_t mask;
   SCM_VALIDATE_STRING (1, path);
-  SCM_STRING_COERCE_0TERMINATION_X (path);
   if (SCM_UNBNDP (mode))
     {
       mask = umask (0);
@@ -697,7 +780,6 @@ SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0,
   int val;
 
   SCM_VALIDATE_STRING (1, path);
-  SCM_STRING_COERCE_0TERMINATION_X (path);
   SCM_SYSCALL (val = rmdir (SCM_STRING_CHARS (path)));
   if (val != 0)
     SCM_SYSERROR;
@@ -733,7 +815,6 @@ SCM_DEFINE (scm_opendir, "opendir", 1, 0, 0,
 {
   DIR *ds;
   SCM_VALIDATE_STRING (1, dirname);
-  SCM_STRING_COERCE_0TERMINATION_X (dirname);
   SCM_SYSCALL (ds = opendir (SCM_STRING_CHARS (dirname)));
   if (ds == NULL)
     SCM_SYSERROR;
@@ -753,7 +834,7 @@ SCM_DEFINE (scm_readdir, "readdir", 1, 0, 0,
 
   SCM_VALIDATE_DIR (1, port);
   if (!SCM_DIR_OPEN_P (port))
-    SCM_MISC_ERROR ("Directory ~S is not open.", SCM_LIST1 (port));
+    SCM_MISC_ERROR ("Directory ~S is not open.", scm_list_1 (port));
 
   errno = 0;
   SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CELL_WORD_1 (port)));
@@ -774,7 +855,7 @@ SCM_DEFINE (scm_rewinddir, "rewinddir", 1, 0, 0,
 {
   SCM_VALIDATE_DIR (1, port);
   if (!SCM_DIR_OPEN_P (port))
-    SCM_MISC_ERROR ("Directory ~S is not open.", SCM_LIST1 (port));
+    SCM_MISC_ERROR ("Directory ~S is not open.", scm_list_1 (port));
 
   rewinddir ((DIR *) SCM_CELL_WORD_1 (port));
 
@@ -842,7 +923,6 @@ SCM_DEFINE (scm_chdir, "chdir", 1, 0, 0,
   int ans;
 
   SCM_VALIDATE_STRING (1, str);
-  SCM_STRING_COERCE_0TERMINATION_X (str);
   SCM_SYSCALL (ans = chdir (SCM_STRING_CHARS (str)));
   if (ans != 0)
     SCM_SYSERROR;
@@ -1162,9 +1242,9 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
     if (rv < 0)
       SCM_SYSERROR;
   }
-  return SCM_LIST3 (retrieve_select_type (&read_set, read_ports_ready, reads),
-                   retrieve_select_type (&write_set, write_ports_ready, writes),
-                   retrieve_select_type (&except_set, SCM_EOL, excepts));
+  return scm_list_3 (retrieve_select_type (&read_set, read_ports_ready, reads),
+                    retrieve_select_type (&write_set, write_ports_ready, writes),
+                    retrieve_select_type (&except_set, SCM_EOL, excepts));
 }
 #undef FUNC_NAME
 #endif /* HAVE_SELECT */
@@ -1267,8 +1347,6 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0,
 
   SCM_VALIDATE_STRING (1, oldpath);
   SCM_VALIDATE_STRING (2, newpath);
-  SCM_STRING_COERCE_0TERMINATION_X (oldpath);
-  SCM_STRING_COERCE_0TERMINATION_X (newpath);
   SCM_SYSCALL (val = symlink (SCM_STRING_CHARS (oldpath), SCM_STRING_CHARS (newpath)));
   if (val != 0)
     SCM_SYSERROR;
@@ -1289,7 +1367,6 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
   char *buf;
   SCM result;
   SCM_VALIDATE_STRING (1, path);
-  SCM_STRING_COERCE_0TERMINATION_X (path);
   buf = scm_must_malloc (size, FUNC_NAME);
   while ((rv = readlink (SCM_STRING_CHARS (path), buf, size)) == size)
     {
@@ -1318,14 +1395,13 @@ SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0,
   struct stat stat_temp;
 
   SCM_VALIDATE_STRING (1, str);
-  SCM_STRING_COERCE_0TERMINATION_X (str);
   SCM_SYSCALL (rv = lstat (SCM_STRING_CHARS (str), &stat_temp));
   if (rv != 0)
     {
       int en = errno;
 
       SCM_SYSERROR_MSG ("~A: ~S",
-                       SCM_LIST2 (scm_makfrom0str (strerror (errno)), str),
+                       scm_list_2 (scm_makfrom0str (strerror (errno)), str),
                        en);
     }
   return scm_stat2scm(&stat_temp);
@@ -1345,9 +1421,7 @@ SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0,
   struct stat oldstat;
 
   SCM_VALIDATE_STRING (1, oldfile);
-  SCM_STRING_COERCE_0TERMINATION_X (oldfile);
   SCM_VALIDATE_STRING (2, newfile);
-  SCM_STRING_COERCE_0TERMINATION_X (newfile);
   if (stat (SCM_STRING_CHARS (oldfile), &oldstat) == -1)
     SCM_SYSERROR;
   oldfd = open (SCM_STRING_CHARS (oldfile), O_RDONLY);
@@ -1398,7 +1472,7 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
   i = len - 1;
 #ifdef __MINGW32__
   while (i >= 0 && (s[i] == '/' || s[i] == '\\')) --i;
-  while (i >= 0 && (s[i] != '/' || s[i] != '\\')) --i;
+  while (i >= 0 && (s[i] != '/' && s[i] != '\\')) --i;
   while (i >= 0 && (s[i] == '/' || s[i] == '\\')) --i;
 #else
   while (i >= 0 && s[i] == '/') --i;