* make-dist: Distribute some VMS files we got from Richard Levitte.

[gnu-emacs] / src / fileio.c

diff --git a/src/fileio.c b/src/fileio.c
index 537a957e76b69afb84a58bfefe08c7239f498e60..5e6f048b9c25cde10c9dd12e4f89ed2594b56d1a 100644 (file)
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -1,5 +1,5 @@
 /* File IO for GNU Emacs.
 /* 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.
 
 
 This file is part of GNU Emacs.
 


@@ -51,6 +51,14 @@ extern int sys_nerr;
 #include <sys/time.h>
 #endif
 
 #include <sys/time.h>
 #endif
 

+#ifndef USG
+#ifndef VMS
+#ifndef BSD4_1
+#define HAVE_FSYNC
+#endif
+#endif
+#endif
+

 #include "lisp.h"
 #include "intervals.h"
 #include "buffer.h"
 #include "lisp.h"
 #include "intervals.h"
 #include "buffer.h"


@@ -597,7 +605,6 @@ See also the function `substitute-in-file-name'.")
   int tlen;
   unsigned char *target;
   struct passwd *pw;
   int tlen;
   unsigned char *target;
   struct passwd *pw;

-  int lose;

 #ifdef VMS
   unsigned char * colon = 0;
   unsigned char * close = 0;
 #ifdef VMS
   unsigned char * colon = 0;
   unsigned char * close = 0;


@@ -616,6 +623,32 @@ See also the function `substitute-in-file-name'.")
   if (!NILP (handler))
     return call3 (handler, Qexpand_file_name, name, defalt);
 
   if (!NILP (handler))
     return call3 (handler, Qexpand_file_name, name, defalt);
 

+  /* Use the buffer's default-directory if DEFALT is omitted.  */
+  if (NILP (defalt))
+    defalt = current_buffer->directory;
+  CHECK_STRING (defalt, 1);
+
+  /* Make sure DEFALT is properly expanded.
+     It would be better to do this down below where we actually use
+     defalt.  Unfortunately, calling Fexpand_file_name recursively
+     could invoke GC, and the strings might be relocated.  This would
+     be annoying because we have pointers into strings lying around
+     that would need adjusting, and people would add new pointers to
+     the code and forget to adjust them, resulting in intermittent bugs.
+     Putting this call here avoids all that crud.
+
+     The EQ test avoids infinite recursion.  */
+  if (! NILP (defalt) && !EQ (defalt, name)
+      /* This saves time in a common case.  */
+      && XSTRING (defalt)->data[0] != '/')
+    {
+      struct gcpro gcpro1;
+
+      GCPRO1 (name);
+      defalt = Fexpand_file_name (defalt, Qnil);
+      UNGCPRO;
+    }
+

 #ifdef VMS
   /* Filenames on VMS are always upper case.  */
   name = Fupcase (name);
 #ifdef VMS
   /* Filenames on VMS are always upper case.  */
   name = Fupcase (name);


@@ -632,8 +665,15 @@ See also the function `substitute-in-file-name'.")
 #endif /* VMS */
       )
     {
 #endif /* VMS */
       )
     {

+      /* If it turns out that the filename we want to return is just a
+        suffix of FILENAME, we don't need to go through and edit
+        things; we just need to construct a new string using data
+        starting at the middle of FILENAME.  If we set lose to a
+        non-zero value, that means we've discovered that we can't do
+        that cool trick.  */
+      int lose = 0;
+

       p = nm;
       p = nm;

-      lose = 0;

       while (*p)
        {
          /* Since we know the path is absolute, we can assume that each
       while (*p)
        {
          /* Since we know the path is absolute, we can assume that each


@@ -800,9 +840,6 @@ See also the function `substitute-in-file-name'.")
 #endif /* not VMS */
       && !newdir)
     {
 #endif /* not VMS */
       && !newdir)
     {

-      if (NILP (defalt))
-       defalt = current_buffer->directory;
-      CHECK_STRING (defalt, 1);

       newdir = XSTRING (defalt)->data;
     }
 
       newdir = XSTRING (defalt)->data;
     }
 


@@ -810,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);
     {
       /* 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);
       if (newdir[length - 1] == '/')
        {
          unsigned char *temp = (unsigned char *) alloca (length);


@@ -1824,7 +1864,7 @@ This happens for interactive use with M-x.")
       /* If we didn't complain already, silently delete existing file.  */
       if (errno == EEXIST)
        {
       /* 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;
        }
          if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
            return Qnil;
        }


@@ -1937,7 +1977,7 @@ See also `file-readable-p' and `file-attributes'.")
 
 DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
   "Return t if FILENAME can be executed by you.\n\
 
 DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
   "Return t if FILENAME can be executed by you.\n\

-For directories this means you can change to that directory.")
+For a directory, this means you can access files in that directory.")

   (filename)
     Lisp_Object filename;
 
   (filename)
     Lisp_Object filename;
 


@@ -2009,22 +2049,46 @@ Otherwise returns NIL.")
       valsize = readlink (XSTRING (filename)->data, buf, bufsize);
       if (valsize < bufsize) break;
       /* Buffer was not long enough */
       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)
     {
       bufsize *= 2;
     }
   if (valsize == -1)
     {

-      free (buf);
+      xfree (buf);

       return Qnil;
     }
   val = make_string (buf, valsize);
       return Qnil;
     }
   val = make_string (buf, valsize);

-  free (buf);
+  xfree (buf);

   return val;
 #else /* not S_IFLNK */
   return Qnil;
 #endif /* not S_IFLNK */
 }
 
   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,
 /* 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,


@@ -2045,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 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 */
   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);
 }
 
          ? Qt : Qnil);
 }
 


@@ -2178,7 +2245,7 @@ Only the 12 low bits of MODE are used.")
   return Qnil;
 }
 
   return Qnil;
 }
 

-DEFUN ("set-default-file-mode", Fset_default_file_mode, Sset_default_file_mode, 1, 1, 0,
+DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,

     "Set the file permission bits for newly created files.\n\
 The argument MODE should be an integer; only the low 9 bits are used.\n\
 This setting is inherited by subprocesses.")
     "Set the file permission bits for newly created files.\n\
 The argument MODE should be an integer; only the low 9 bits are used.\n\
 This setting is inherited by subprocesses.")


@@ -2192,7 +2259,7 @@ This setting is inherited by subprocesses.")
   return Qnil;
 }
 
   return Qnil;
 }
 

-DEFUN ("default-file-mode", Fdefault_file_mode, Sdefault_file_mode, 0, 0, 0,
+DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,

     "Return the default file protection for created files.\n\
 The value is an integer.")
   ()
     "Return the default file protection for created files.\n\
 The value is an integer.")
   ()


@@ -2455,7 +2522,7 @@ to the file, instead of any buffer contents, and END is ignored.")
   unsigned char *fname = 0;    /* If non-0, original filename (must rename) */
 #endif /* VMS */
   Lisp_Object handler;
   unsigned char *fname = 0;    /* If non-0, original filename (must rename) */
 #endif /* VMS */
   Lisp_Object handler;

-  Lisp_Object visit_file = XTYPE (visit) == Lisp_String ? visit : filename;
+  Lisp_Object visit_file;

   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 
   /* Special kludge to simplify auto-saving */
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 
   /* Special kludge to simplify auto-saving */


@@ -2467,8 +2534,13 @@ to the file, instead of any buffer contents, and END is ignored.")
   else if (XTYPE (start) != Lisp_String)
     validate_region (&start, &end);
 
   else if (XTYPE (start) != Lisp_String)
     validate_region (&start, &end);
 

-  GCPRO4 (start, filename, visit, visit_file);

   filename = Fexpand_file_name (filename, Qnil);
   filename = Fexpand_file_name (filename, Qnil);

+  if (XTYPE (visit) == Lisp_String)
+    visit_file = Fexpand_file_name (visit, Qnil);
+  else
+    visit_file = filename;
+
+  GCPRO4 (start, filename, visit, visit_file);

 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */


@@ -2635,15 +2707,11 @@ to the file, instead of any buffer contents, and END is ignored.")
 
   immediate_quit = 0;
 
 
   immediate_quit = 0;
 

-#ifndef USG
-#ifndef VMS
-#ifndef BSD4_1
+#ifdef HAVE_FSYNC

   /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
      Disk full in NFS may be reported here.  */
   if (fsync (desc) < 0)
     failure = 1, save_errno = errno;
   /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
      Disk full in NFS may be reported here.  */
   if (fsync (desc) < 0)
     failure = 1, save_errno = errno;

-#endif
-#endif

 #endif
 
   /* Spurious "file has changed on disk" warnings have been 
 #endif
 
   /* Spurious "file has changed on disk" warnings have been 


@@ -2799,27 +2867,45 @@ Next attempt to save will certainly not complain of a discrepancy.")
   return Qnil;
 }
 
   return Qnil;
 }
 

+DEFUN ("visited-file-modtime", Fvisited_file_modtime,
+  Svisited_file_modtime, 0, 0, 0,
+  "Return the current buffer's recorded visited file modification time.\n\
+The value is a list of the form (HIGH . LOW), like the time values\n\
+that `file-attributes' returns.")
+  ()
+{
+  return long_to_cons (current_buffer->modtime);
+}
+

 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
 DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,

-  Sset_visited_file_modtime, 0, 0, 0,
+  Sset_visited_file_modtime, 0, 1, 0,

   "Update buffer's recorded modification time from the visited file's time.\n\
 Useful if the buffer was not read from the file normally\n\
   "Update buffer's recorded modification time from the visited file's time.\n\
 Useful if the buffer was not read from the file normally\n\

-or if the file itself has been changed for some known benign reason.")
-  ()
+or if the file itself has been changed for some known benign reason.\n\
+An argument specifies the modification time value to use\n\
+\(instead of that of the visited file), in the form of a list\n\
+\(HIGH . LOW) or (HIGH LOW).")
+  (time_list)
+     Lisp_Object time_list;

 {
 {

-  register Lisp_Object filename;
-  struct stat st;
-  Lisp_Object handler;
+  if (!NILP (time_list))
+    current_buffer->modtime = cons_to_long (time_list);
+  else
+    {
+      register Lisp_Object filename;
+      struct stat st;
+      Lisp_Object handler;

 
 

-  filename = Fexpand_file_name (current_buffer->filename, Qnil);
+      filename = Fexpand_file_name (current_buffer->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))
-    current_buffer->modtime = 0;
-  
-  else if (stat (XSTRING (filename)->data, &st) >= 0)
-    current_buffer->modtime = st.st_mtime;
+      /* If the file name has special constructs in it,
+        call the corresponding file handler.  */
+      handler = Ffind_file_name_handler (filename);
+      if (!NILP (handler))
+       return call3 (handler, Qfile_name_directory, filename, Qnil);
+      else if (stat (XSTRING (filename)->data, &st) >= 0)
+       current_buffer->modtime = st.st_mtime;
+    }

 
   return Qnil;
 }
 
   return Qnil;
 }


@@ -2867,72 +2953,87 @@ so that your editing is not lost if the system crashes.\n\
 This file is not the file you visited; that changes only when you save.\n\n\
 Non-nil first argument means do not print any message if successful.\n\
 Non-nil second argument means save only current buffer.")
 This file is not the file you visited; that changes only when you save.\n\n\
 Non-nil first argument means do not print any message if successful.\n\
 Non-nil second argument means save only current buffer.")

-  (nomsg)
-     Lisp_Object nomsg;
+  (no_message, current_only)
+     Lisp_Object no_message, current_only;

 {
   struct buffer *old = current_buffer, *b;
   Lisp_Object tail, buf;
   int auto_saved = 0;
   char *omessage = echo_area_glyphs;
 {
   struct buffer *old = current_buffer, *b;
   Lisp_Object tail, buf;
   int auto_saved = 0;
   char *omessage = echo_area_glyphs;

-  extern minibuf_level;
+  extern int minibuf_level;
+  int do_handled_files;

 
   /* No GCPRO needed, because (when it matters) all Lisp_Object variables
      point to non-strings reached from Vbuffer_alist.  */
 
   auto_saving = 1;
   if (minibuf_level)
 
   /* No GCPRO needed, because (when it matters) all Lisp_Object variables
      point to non-strings reached from Vbuffer_alist.  */
 
   auto_saving = 1;
   if (minibuf_level)

-    nomsg = Qt;
+    no_message = Qt;

 
   /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
      eventually call do-auto-save, so don't err here in that case. */
   if (!NILP (Vrun_hooks))
     call1 (Vrun_hooks, intern ("auto-save-hook"));
 
 
   /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
      eventually call do-auto-save, so don't err here in that case. */
   if (!NILP (Vrun_hooks))
     call1 (Vrun_hooks, intern ("auto-save-hook"));
 

-  for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
-       tail = XCONS (tail)->cdr)
-    {
-      buf = XCONS (XCONS (tail)->car)->cdr;
-      b = XBUFFER (buf);
-      /* Check for auto save enabled
-        and file changed since last auto save
-        and file changed since last real save.  */
-      if (XTYPE (b->auto_save_file_name) == Lisp_String
-         && b->save_modified < BUF_MODIFF (b)
-         && b->auto_save_modified < BUF_MODIFF (b))
-       {
-         if ((XFASTINT (b->save_length) * 10
-              > (BUF_Z (b) - BUF_BEG (b)) * 13)
-             /* A short file is likely to change a large fraction;
-                spare the user annoying messages.  */
-             && XFASTINT (b->save_length) > 5000
-             /* These messages are frequent and annoying for `*mail*'.  */
-             && !EQ (b->filename, Qnil))
-           {
-             /* It has shrunk too much; turn off auto-saving here.  */
-             message ("Buffer %s has shrunk a lot; auto save turned off there",
-                      XSTRING (b->name)->data);
-             /* User can reenable saving with M-x auto-save.  */
-             b->auto_save_file_name = Qnil;
-             /* Prevent warning from repeating if user does so.  */
-             XFASTINT (b->save_length) = 0;
-             Fsleep_for (make_number (1), Qnil);
-             continue;
-           }
-         set_buffer_internal (b);
-         if (!auto_saved && NILP (nomsg))
-           message1 ("Auto-saving...");
-         internal_condition_case (auto_save_1, Qt, auto_save_error);
-         auto_saved++;
-         b->auto_save_modified = BUF_MODIFF (b);
-         XFASTINT (current_buffer->save_length) = Z - BEG;
-         set_buffer_internal (old);
-       }
-    }
+  /* First, save all files which don't have handlers.  If Emacs is
+     crashing, the handlers may tweak what is causing Emacs to crash
+     in the first place, and it would be a shame if Emacs failed to
+     autosave perfectly ordinary files because it couldn't handle some
+     ange-ftp'd file.  */
+  for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
+    for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
+        tail = XCONS (tail)->cdr)
+      {
+       buf = XCONS (XCONS (tail)->car)->cdr;
+       b = XBUFFER (buf);
+
+       if (!NILP (current_only)
+           && b != current_buffer)
+         continue;
+      
+       /* Check for auto save enabled
+          and file changed since last auto save
+          and file changed since last real save.  */
+       if (XTYPE (b->auto_save_file_name) == Lisp_String
+           && b->save_modified < BUF_MODIFF (b)
+           && b->auto_save_modified < BUF_MODIFF (b)
+           && (do_handled_files
+               || NILP (Ffind_file_name_handler (b->auto_save_file_name))))
+         {
+           if ((XFASTINT (b->save_length) * 10
+                > (BUF_Z (b) - BUF_BEG (b)) * 13)
+               /* A short file is likely to change a large fraction;
+                  spare the user annoying messages.  */
+               && XFASTINT (b->save_length) > 5000
+               /* These messages are frequent and annoying for `*mail*'.  */
+               && !EQ (b->filename, Qnil)
+               && NILP (no_message))
+             {
+               /* It has shrunk too much; turn off auto-saving here.  */
+               message ("Buffer %s has shrunk a lot; auto save turned off there",
+                        XSTRING (b->name)->data);
+               /* User can reenable saving with M-x auto-save.  */
+               b->auto_save_file_name = Qnil;
+               /* Prevent warning from repeating if user does so.  */
+               XFASTINT (b->save_length) = 0;
+               Fsleep_for (make_number (1), Qnil);
+               continue;
+             }
+           set_buffer_internal (b);
+           if (!auto_saved && NILP (no_message))
+             message1 ("Auto-saving...");
+           internal_condition_case (auto_save_1, Qt, auto_save_error);
+           auto_saved++;
+           b->auto_save_modified = BUF_MODIFF (b);
+           XFASTINT (current_buffer->save_length) = Z - BEG;
+           set_buffer_internal (old);
+         }
+      }

 
   /* Prevent another auto save till enough input events come in.  */
   record_auto_save ();
 
 
   /* Prevent another auto save till enough input events come in.  */
   record_auto_save ();
 

-  if (auto_saved && NILP (nomsg))
+  if (auto_saved && NILP (no_message))

     message1 (omessage ? omessage : "Auto-saving...done");
 
   auto_saving = 0;
     message1 (omessage ? omessage : "Auto-saving...done");
 
   auto_saving = 0;


@@ -3333,13 +3434,14 @@ for its argument.");
   defsubr (&Sfile_accessible_directory_p);
   defsubr (&Sfile_modes);
   defsubr (&Sset_file_modes);
   defsubr (&Sfile_accessible_directory_p);
   defsubr (&Sfile_modes);
   defsubr (&Sset_file_modes);

-  defsubr (&Sset_default_file_mode);
-  defsubr (&Sdefault_file_mode);
+  defsubr (&Sset_default_file_modes);
+  defsubr (&Sdefault_file_modes);

   defsubr (&Sfile_newer_than_file_p);
   defsubr (&Sinsert_file_contents);
   defsubr (&Swrite_region);
   defsubr (&Sverify_visited_file_modtime);
   defsubr (&Sclear_visited_file_modtime);
   defsubr (&Sfile_newer_than_file_p);
   defsubr (&Sinsert_file_contents);
   defsubr (&Swrite_region);
   defsubr (&Sverify_visited_file_modtime);
   defsubr (&Sclear_visited_file_modtime);

+  defsubr (&Svisited_file_modtime);

   defsubr (&Sset_visited_file_modtime);
   defsubr (&Sdo_auto_save);
   defsubr (&Sset_buffer_auto_saved);
   defsubr (&Sset_visited_file_modtime);
   defsubr (&Sdo_auto_save);
   defsubr (&Sset_buffer_auto_saved);