]> code.delx.au - gnu-emacs/blobdiff - src/fileio.c
* xterm.c (XTread_socket): Turn off ControlMask for XLookupString.
[gnu-emacs] / src / fileio.c
index f9943927ca268102061d76369f9cfb06ec36cc80..5e6f048b9c25cde10c9dd12e4f89ed2594b56d1a 100644 (file)
@@ -1,5 +1,5 @@
 /* File IO for GNU Emacs.
-   Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -847,6 +847,9 @@ See also the function `substitute-in-file-name'.")
     {
       /* Get rid of any slash at the end of newdir.  */
       int length = strlen (newdir);
+      /* Adding `length > 1 &&' makes ~ expand into / when homedir
+        is the root dir.  People disagree about whether that is right.
+        Anyway, we can't take the risk of this change now.  */
       if (newdir[length - 1] == '/')
        {
          unsigned char *temp = (unsigned char *) alloca (length);
@@ -1861,7 +1864,7 @@ This happens for interactive use with M-x.")
       /* If we didn't complain already, silently delete existing file.  */
       if (errno == EEXIST)
        {
-         unlink (XSTRING (filename)->data);
+         unlink (XSTRING (linkname)->data);
          if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
            return Qnil;
        }
@@ -2046,22 +2049,46 @@ Otherwise returns NIL.")
       valsize = readlink (XSTRING (filename)->data, buf, bufsize);
       if (valsize < bufsize) break;
       /* Buffer was not long enough */
-      free (buf);
+      xfree (buf);
       bufsize *= 2;
     }
   if (valsize == -1)
     {
-      free (buf);
+      xfree (buf);
       return Qnil;
     }
   val = make_string (buf, valsize);
-  free (buf);
+  xfree (buf);
   return val;
 #else /* not S_IFLNK */
   return Qnil;
 #endif /* not S_IFLNK */
 }
 
+#ifdef SOLARIS_BROKEN_ACCESS
+/* In Solaris 2.1, the readonly-ness of the filesystem is not
+   considered by the access system call.  This is Sun's bug, but we
+   still have to make Emacs work.  */
+
+#include <sys/statvfs.h>
+
+static int
+ro_fsys (path)
+    char *path;
+{
+    struct statvfs statvfsb;
+
+    if (statvfs(path, &statvfsb))
+      return 1;  /* error from statvfs, be conservative and say not wrtable */
+    else
+      /* Otherwise, fsys is ro if bit is set.  */
+      return statvfsb.f_flag & ST_RDONLY;
+}
+#else
+/* But on every other os, access has already done the right thing.  */
+#define ro_fsys(path) 0
+#endif
+
 /* Having this before file-symlink-p mysteriously caused it to be forgotten
    on the RT/PC.  */
 DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
@@ -2082,13 +2109,16 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
     return call2 (handler, Qfile_writable_p, abspath);
 
   if (access (XSTRING (abspath)->data, 0) >= 0)
-    return (access (XSTRING (abspath)->data, 2) >= 0) ? Qt : Qnil;
+    return ((access (XSTRING (abspath)->data, 2) >= 0
+            && ! ro_fsys (XSTRING (abspath)))
+           ? Qt : Qnil);
   dir = Ffile_name_directory (abspath);
 #ifdef VMS
   if (!NILP (dir))
     dir = Fdirectory_file_name (dir);
 #endif /* VMS */
-  return (access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0
+  return ((access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0
+          && ! ro_fsys ((char *) XSTRING (dir)))
          ? Qt : Qnil);
 }