]> code.delx.au - gnu-emacs/blobdiff - src/fileio.c
Fix docstring of format-time-string to include %F.
[gnu-emacs] / src / fileio.c
index 1a2bdfa237c83499247e5b74c5f0257344dfbf62..a0603b490d9f523c6d52ae71474bb21002eacac3 100644 (file)
@@ -49,6 +49,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "coding.h"
 #include "window.h"
 #include "blockinput.h"
+#include "region-cache.h"
 #include "frame.h"
 #include "dispextern.h"
 
@@ -143,6 +144,8 @@ static Lisp_Object Qcopy_directory;
 /* Lisp function for recursively deleting directories.  */
 static Lisp_Object Qdelete_directory;
 
+static Lisp_Object Qsubstitute_env_in_file_name;
+
 #ifdef WINDOWSNT
 #endif
 
@@ -158,6 +161,56 @@ static bool a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
 static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
                     struct coding_system *);
 
+\f
+/* Return true if FILENAME exists.  */
+
+static bool
+check_existing (const char *filename)
+{
+  return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0;
+}
+
+/* Return true if file FILENAME exists and can be executed.  */
+
+static bool
+check_executable (char *filename)
+{
+  return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0;
+}
+
+/* Return true if file FILENAME exists and can be accessed
+   according to AMODE, which should include W_OK.
+   On failure, return false and set errno.  */
+
+static bool
+check_writable (const char *filename, int amode)
+{
+#ifdef MSDOS
+  /* FIXME: an faccessat implementation should be added to the
+     DOS/Windows ports and this #ifdef branch should be removed.  */
+  struct stat st;
+  if (stat (filename, &st) < 0)
+    return 0;
+  errno = EPERM;
+  return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode));
+#else /* not MSDOS */
+  bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0;
+#ifdef CYGWIN
+  /* faccessat may have returned failure because Cygwin couldn't
+     determine the file's UID or GID; if so, we return success. */
+  if (!res)
+    {
+      int faccessat_errno = errno;
+      struct stat st;
+      if (stat (filename, &st) < 0)
+        return 0;
+      res = (st.st_uid == -1 || st.st_gid == -1);
+      errno = faccessat_errno;
+    }
+#endif /* CYGWIN */
+  return res;
+#endif /* not MSDOS */
+}
 \f
 /* Signal a file-access failure.  STRING describes the failure,
    NAME the file involved, and ERRORNO the errno value.
@@ -680,8 +733,8 @@ static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
 Lisp_Object
 make_temp_name (Lisp_Object prefix, bool base64_p)
 {
-  Lisp_Object val;
-  int len, clen;
+  Lisp_Object val, encoded_prefix;
+  int len;
   printmax_t pid;
   char *p, *data;
   char pidbuf[INT_BUFSIZE_BOUND (printmax_t)];
@@ -715,12 +768,11 @@ make_temp_name (Lisp_Object prefix, bool base64_p)
 #endif
     }
 
-  len = SBYTES (prefix); clen = SCHARS (prefix);
-  val = make_uninit_multibyte_string (clen + 3 + pidlen, len + 3 + pidlen);
-  if (!STRING_MULTIBYTE (prefix))
-    STRING_SET_UNIBYTE (val);
+  encoded_prefix = ENCODE_FILE (prefix);
+  len = SBYTES (encoded_prefix);
+  val = make_uninit_string (len + 3 + pidlen);
   data = SSDATA (val);
-  memcpy (data, SSDATA (prefix), len);
+  memcpy (data, SSDATA (encoded_prefix), len);
   p = data + len;
 
   memcpy (p, pidbuf, pidlen);
@@ -758,7 +810,7 @@ make_temp_name (Lisp_Object prefix, bool base64_p)
        {
          /* We want to return only if errno is ENOENT.  */
          if (errno == ENOENT)
-           return val;
+           return DECODE_FILE (val);
          else
            /* The error here is dubious, but there is little else we
               can do.  The alternatives are to return nil, which is
@@ -935,7 +987,26 @@ filesystem tree, not (expand-file-name ".."  dirname).  */)
   if (multibyte != STRING_MULTIBYTE (default_directory))
     {
       if (multibyte)
-       default_directory = string_to_multibyte (default_directory);
+       {
+         unsigned char *p = SDATA (name);
+
+         while (*p && ASCII_BYTE_P (*p))
+           p++;
+         if (*p == '\0')
+           {
+             /* NAME is a pure ASCII string, and DEFAULT_DIRECTORY is
+                unibyte.  Do not convert DEFAULT_DIRECTORY to
+                multibyte; instead, convert NAME to a unibyte string,
+                so that the result of this function is also a unibyte
+                string.  This is needed during bootstrapping and
+                dumping, when Emacs cannot decode file names, because
+                the locale environment is not set up.  */
+             name = make_unibyte_string (SSDATA (name), SBYTES (name));
+             multibyte = 0;
+           }
+         else
+           default_directory = string_to_multibyte (default_directory);
+       }
       else
        {
          name = string_to_multibyte (name);
@@ -1664,10 +1735,8 @@ If `//' appears, everything up to and including the first of
 those `/' is discarded.  */)
   (Lisp_Object filename)
 {
-  char *nm, *s, *p, *o, *x, *endp;
-  char *target = NULL;
-  ptrdiff_t total = 0;
-  bool substituted = 0;
+  char *nm, *p, *x, *endp;
+  bool substituted = false;
   bool multibyte;
   char *xnm;
   Lisp_Object handler;
@@ -1708,66 +1777,19 @@ those `/' is discarded.  */)
     return Fsubstitute_in_file_name
       (make_specified_string (p, -1, endp - p, multibyte));
 
-  /* See if any variables are substituted into the string
-     and find the total length of their values in `total'.  */
-
-  for (p = nm; p != endp;)
-    if (*p != '$')
-      p++;
-    else
-      {
-       p++;
-       if (p == endp)
-         goto badsubst;
-       else if (*p == '$')
-         {
-           /* "$$" means a single "$".  */
-           p++;
-           total -= 1;
-           substituted = 1;
-           continue;
-         }
-       else if (*p == '{')
-         {
-           o = ++p;
-           p = memchr (p, '}', endp - p);
-           if (! p)
-             goto missingclose;
-           s = p;
-         }
-       else
-         {
-           o = p;
-           while (p != endp && (c_isalnum (*p) || *p == '_')) p++;
-           s = p;
-         }
-
-       /* Copy out the variable name.  */
-       target = alloca (s - o + 1);
-       memcpy (target, o, s - o);
-       target[s - o] = 0;
-#ifdef DOS_NT
-       strupr (target); /* $home == $HOME etc.  */
-#endif /* DOS_NT */
+  /* See if any variables are substituted into the string.  */
 
-       /* Get variable value.  */
-       o = egetenv (target);
-       if (o)
-         {
-           /* Don't try to guess a maximum length - UTF8 can use up to
-              four bytes per character.  This code is unlikely to run
-              in a situation that requires performance, so decoding the
-              env variables twice should be acceptable. Note that
-              decoding may cause a garbage collect.  */
-           Lisp_Object orig, decoded;
-           orig = build_unibyte_string (o);
-           decoded = DECODE_FILE (orig);
-           total += SBYTES (decoded);
-           substituted = 1;
-         }
-       else if (*p == '}')
-         goto badvar;
-      }
+  if (!NILP (Ffboundp (Qsubstitute_env_in_file_name)))
+    {
+      Lisp_Object name
+       = (!substituted ? filename
+          : make_specified_string (nm, -1, endp - nm, multibyte));
+      Lisp_Object tmp = call1 (Qsubstitute_env_in_file_name, name);
+      CHECK_STRING (tmp);
+      if (!EQ (tmp, name))
+       substituted = true;
+      filename = tmp;
+    }
 
   if (!substituted)
     {
@@ -1778,72 +1800,8 @@ those `/' is discarded.  */)
       return filename;
     }
 
-  /* If substitution required, recopy the string and do it.  */
-  /* Make space in stack frame for the new copy.  */
-  xnm = alloca (SBYTES (filename) + total + 1);
-  x = xnm;
-
-  /* Copy the rest of the name through, replacing $ constructs with values.  */
-  for (p = nm; *p;)
-    if (*p != '$')
-      *x++ = *p++;
-    else
-      {
-       p++;
-       if (p == endp)
-         goto badsubst;
-       else if (*p == '$')
-         {
-           *x++ = *p++;
-           continue;
-         }
-       else if (*p == '{')
-         {
-           o = ++p;
-           p = memchr (p, '}', endp - p);
-           if (! p)
-             goto missingclose;
-           s = p++;
-         }
-       else
-         {
-           o = p;
-           while (p != endp && (c_isalnum (*p) || *p == '_')) p++;
-           s = p;
-         }
-
-       /* Copy out the variable name.  */
-       target = alloca (s - o + 1);
-       memcpy (target, o, s - o);
-       target[s - o] = 0;
-
-       /* Get variable value.  */
-       o = egetenv (target);
-       if (!o)
-         {
-           *x++ = '$';
-           strcpy (x, target); x+= strlen (target);
-         }
-       else
-         {
-           Lisp_Object orig, decoded;
-           ptrdiff_t orig_length, decoded_length;
-           orig_length = strlen (o);
-           orig = make_unibyte_string (o, orig_length);
-           decoded = DECODE_FILE (orig);
-           decoded_length = SBYTES (decoded);
-           memcpy (x, SDATA (decoded), decoded_length);
-           x += decoded_length;
-
-           /* If environment variable needed decoding, return value
-              needs to be multibyte.  */
-           if (decoded_length != orig_length
-               || memcmp (SDATA (decoded), o, orig_length))
-             multibyte = 1;
-         }
-      }
-
-  *x = 0;
+  xnm = SSDATA (filename);
+  x = xnm + SBYTES (filename);
 
   /* If /~ or // appears, discard everything through first slash.  */
   while ((p = search_embedded_absfilename (xnm, x)) != NULL)
@@ -1862,14 +1820,9 @@ those `/' is discarded.  */)
     }
   else
 #endif
-  return make_specified_string (xnm, -1, x - xnm, multibyte);
-
- badsubst:
-  error ("Bad format environment-variable substitution");
- missingclose:
-  error ("Missing \"}\" in environment-variable substitution");
- badvar:
-  error ("Substituting nonexistent environment variable \"%s\"", target);
+  return (xnm == SSDATA (filename)
+         ? filename
+         : make_specified_string (xnm, -1, x - xnm, multibyte));
 }
 \f
 /* A slightly faster and more convenient way to get
@@ -2556,55 +2509,6 @@ On Unix, this is a name starting with a `/' or a `~'.  */)
   return file_name_absolute_p (SSDATA (filename)) ? Qt : Qnil;
 }
 \f
-/* Return true if FILENAME exists.  */
-bool
-check_existing (const char *filename)
-{
-  return faccessat (AT_FDCWD, filename, F_OK, AT_EACCESS) == 0;
-}
-
-/* Return true if file FILENAME exists and can be executed.  */
-
-static bool
-check_executable (char *filename)
-{
-  return faccessat (AT_FDCWD, filename, X_OK, AT_EACCESS) == 0;
-}
-
-/* Return true if file FILENAME exists and can be accessed
-   according to AMODE, which should include W_OK.
-   On failure, return false and set errno.  */
-
-static bool
-check_writable (const char *filename, int amode)
-{
-#ifdef MSDOS
-  /* FIXME: an faccessat implementation should be added to the
-     DOS/Windows ports and this #ifdef branch should be removed.  */
-  struct stat st;
-  if (stat (filename, &st) < 0)
-    return 0;
-  errno = EPERM;
-  return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode));
-#else /* not MSDOS */
-  bool res = faccessat (AT_FDCWD, filename, amode, AT_EACCESS) == 0;
-#ifdef CYGWIN
-  /* faccessat may have returned failure because Cygwin couldn't
-     determine the file's UID or GID; if so, we return success. */
-  if (!res)
-    {
-      int faccessat_errno = errno;
-      struct stat st;
-      if (stat (filename, &st) < 0)
-        return 0;
-      res = (st.st_uid == -1 || st.st_gid == -1);
-      errno = faccessat_errno;
-    }
-#endif /* CYGWIN */
-  return res;
-#endif /* not MSDOS */
-}
-
 DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
        doc: /* Return t if file FILENAME exists (whether or not you can read it.)
 See also `file-readable-p' and `file-attributes'.
@@ -2630,7 +2534,7 @@ Use `file-symlink-p' to test for such links.  */)
 
   absname = ENCODE_FILE (absname);
 
-  return (check_existing (SSDATA (absname))) ? Qt : Qnil;
+  return check_existing (SSDATA (absname)) ? Qt : Qnil;
 }
 
 DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
@@ -3954,6 +3858,9 @@ by calling `format-decode', which see.  */)
          beg_offset += same_at_start - BEGV_BYTE;
          end_offset -= ZV_BYTE - same_at_end;
 
+         invalidate_buffer_caches (current_buffer,
+                                   BYTE_TO_CHAR (same_at_start),
+                                   BYTE_TO_CHAR (same_at_end));
          del_range_byte (same_at_start, same_at_end, 0);
          /* Insert from the file at the proper position.  */
          temp = BYTE_TO_CHAR (same_at_start);
@@ -4064,7 +3971,12 @@ by calling `format-decode', which see.  */)
        {
          /* Truncate the buffer to the size of the file.  */
          if (same_at_start != same_at_end)
-           del_range_byte (same_at_start, same_at_end, 0);
+           {
+             invalidate_buffer_caches (current_buffer,
+                                       BYTE_TO_CHAR (same_at_start),
+                                       BYTE_TO_CHAR (same_at_end));
+             del_range_byte (same_at_start, same_at_end, 0);
+           }
          inserted = 0;
 
          unbind_to (this_count, Qnil);
@@ -4112,6 +4024,9 @@ by calling `format-decode', which see.  */)
 
       if (same_at_end != same_at_start)
        {
+         invalidate_buffer_caches (current_buffer,
+                                   BYTE_TO_CHAR (same_at_start),
+                                   BYTE_TO_CHAR (same_at_end));
          del_range_byte (same_at_start, same_at_end, 0);
          temp = GPT;
          eassert (same_at_start == GPT_BYTE);
@@ -4573,6 +4488,14 @@ by calling `format-decode', which see.  */)
       report_file_errno ("Opening input file", orig_filename, save_errno);
     }
 
+  /* We made a lot of deletions and insertions above, so invalidate
+     the newline cache for the entire region of the inserted
+     characters.  */
+  if (current_buffer->newline_cache)
+    invalidate_region_cache (current_buffer,
+                             current_buffer->newline_cache,
+                             PT - BEG, Z - PT - inserted);
+
   if (read_quit)
     Fsignal (Qquit, Qnil);
 
@@ -5094,7 +5017,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
       SAVE_MODIFF = MODIFF;
       XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
       bset_filename (current_buffer, visit_file);
-      update_mode_lines++;
+      update_mode_lines = 14;
     }
   else if (quietly)
     {
@@ -5263,6 +5186,10 @@ a_write (int desc, Lisp_Object string, ptrdiff_t pos,
   return 1;
 }
 
+/* Maximum number of characters that the next
+   function encodes per one loop iteration.  */
+
+enum { E_WRITE_MAX = 8 * 1024 * 1024 };
 
 /* Write text in the range START and END into descriptor DESC,
    encoding them with coding system CODING.  If STRING is nil, START
@@ -5289,9 +5216,16 @@ e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
          coding->src_multibyte = SCHARS (string) < SBYTES (string);
          if (CODING_REQUIRE_ENCODING (coding))
            {
-             encode_coding_object (coding, string,
-                                   start, string_char_to_byte (string, start),
-                                   end, string_char_to_byte (string, end), Qt);
+             ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
+
+             /* Avoid creating huge Lisp string in encode_coding_object.  */
+             if (nchars == E_WRITE_MAX)
+               coding->raw_destination = 1;
+
+             encode_coding_object
+               (coding, string, start, string_char_to_byte (string, start),
+                start + nchars, string_char_to_byte (string, start + nchars),
+                Qt);
            }
          else
            {
@@ -5308,8 +5242,15 @@ e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
          coding->src_multibyte = (end - start) < (end_byte - start_byte);
          if (CODING_REQUIRE_ENCODING (coding))
            {
-             encode_coding_object (coding, Fcurrent_buffer (),
-                                   start, start_byte, end, end_byte, Qt);
+             ptrdiff_t nchars = min (end - start, E_WRITE_MAX);
+
+             /* Likewise.  */
+             if (nchars == E_WRITE_MAX)
+               coding->raw_destination = 1;
+
+             encode_coding_object
+               (coding, Fcurrent_buffer (), start, start_byte,
+                start + nchars, CHAR_TO_BYTE (start + nchars), Qt);
            }
          else
            {
@@ -5330,11 +5271,19 @@ e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
 
       if (coding->produced > 0)
        {
-         char *buf = (STRINGP (coding->dst_object)
-                      ? SSDATA (coding->dst_object)
-                      : (char *) BYTE_POS_ADDR (coding->dst_pos_byte));
+         char *buf = (coding->raw_destination ? (char *) coding->destination
+                      : (STRINGP (coding->dst_object)
+                         ? SSDATA (coding->dst_object)
+                         : (char *) BYTE_POS_ADDR (coding->dst_pos_byte)));
          coding->produced -= emacs_write_sig (desc, buf, coding->produced);
 
+         if (coding->raw_destination)
+           {
+             /* We're responsible for freeing this, see
+                encode_coding_object to check why.  */
+             xfree (coding->destination);
+             coding->raw_destination = 0;
+           }
          if (coding->produced)
            return 0;
        }
@@ -5835,6 +5784,24 @@ void
 init_fileio (void)
 {
   valid_timestamp_file_system = 0;
+
+  /* fsync can be a significant performance hit.  Often it doesn't
+     suffice to make the file-save operation survive a crash.  For
+     batch scripts, which are typically part of larger shell commands
+     that don't fsync other files, its effect on performance can be
+     significant so its utility is particularly questionable.
+     Hence, for now by default fsync is used only when interactive.
+
+     For more on why fsync often fails to work on today's hardware, see:
+     Zheng M et al. Understanding the robustness of SSDs under power fault.
+     11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84
+     http://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf
+
+     For more on why fsync does not suffice even if it works properly, see:
+     Roche X. Necessary step(s) to synchronize filename operations on disk.
+     Austin Group Defect 672, 2013-03-19
+     http://austingroupbugs.net/view.php?id=672  */
+  write_region_inhibit_fsync = noninteractive;
 }
 
 void
@@ -6047,28 +6014,12 @@ in the buffer; this is the default behavior, because the auto-save
 file is usually more useful if it contains the deleted text.  */);
   Vauto_save_include_big_deletions = Qnil;
 
-  /* fsync can be a significant performance hit.  Often it doesn't
-     suffice to make the file-save operation survive a crash.  For
-     batch scripts, which are typically part of larger shell commands
-     that don't fsync other files, its effect on performance can be
-     significant so its utility is particularly questionable.
-     Hence, for now by default fsync is used only when interactive.
-
-     For more on why fsync often fails to work on today's hardware, see:
-     Zheng M et al. Understanding the robustness of SSDs under power fault.
-     11th USENIX Conf. on File and Storage Technologies, 2013 (FAST '13), 271-84
-     http://www.usenix.org/system/files/conference/fast13/fast13-final80.pdf
-
-     For more on why fsync does not suffice even if it works properly, see:
-     Roche X. Necessary step(s) to synchronize filename operations on disk.
-     Austin Group Defect 672, 2013-03-19
-     http://austingroupbugs.net/view.php?id=672  */
   DEFVAR_BOOL ("write-region-inhibit-fsync", write_region_inhibit_fsync,
               doc: /* Non-nil means don't call fsync in `write-region'.
 This variable affects calls to `write-region' as well as save commands.
 Setting this to nil may avoid data loss if the system loses power or
 the operating system crashes.  */);
-  write_region_inhibit_fsync = noninteractive;
+  write_region_inhibit_fsync = 0; /* See also `init_fileio' above.  */
 
   DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash,
                doc: /* Specifies whether to use the system's trash can.
@@ -6082,6 +6033,7 @@ This includes interactive calls to `delete-file' and
   DEFSYM (Qmove_file_to_trash, "move-file-to-trash");
   DEFSYM (Qcopy_directory, "copy-directory");
   DEFSYM (Qdelete_directory, "delete-directory");
+  DEFSYM (Qsubstitute_env_in_file_name, "substitute-env-in-file-name");
 
   defsubr (&Sfind_file_name_handler);
   defsubr (&Sfile_name_directory);