* src/fileio.c (Fsubstitute_in_file_name): Use substitute-env-in-file-name.
[bpt/emacs.git] / src / fileio.c
index 7cad8d2..a80145a 100644 (file)
@@ -143,6 +143,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
 
@@ -233,7 +235,7 @@ void
 restore_point_unwind (Lisp_Object location)
 {
   Fgoto_char (location);
-  Fset_marker (location, Qnil, Qnil);
+  unchain_marker (XMARKER (location));
 }
 
 \f
@@ -1664,10 +1666,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 +1708,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,73 +1731,9 @@ 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)
     /* This time we do not start over because we've already expanded envvars
@@ -1862,14 +1751,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
@@ -2045,7 +1929,7 @@ entries (depending on how Emacs was built).  */)
   /* CopyFile retains the timestamp by default.  */
   else if (NILP (keep_time))
     {
-      EMACS_TIME now;
+      struct timespec now;
       DWORD attributes;
       char * filename;
 
@@ -2054,7 +1938,7 @@ entries (depending on how Emacs was built).  */)
       /* Ensure file is writable while its modified time is set.  */
       attributes = GetFileAttributes (filename);
       SetFileAttributes (filename, attributes & ~FILE_ATTRIBUTE_READONLY);
-      now = current_emacs_time ();
+      now = current_timespec ();
       if (set_file_times (-1, filename, now, now))
        {
          /* Restore original attributes.  */
@@ -2178,8 +2062,8 @@ entries (depending on how Emacs was built).  */)
 
   if (!NILP (keep_time))
     {
-      EMACS_TIME atime = get_stat_atime (&st);
-      EMACS_TIME mtime = get_stat_mtime (&st);
+      struct timespec atime = get_stat_atime (&st);
+      struct timespec mtime = get_stat_mtime (&st);
       if (set_file_times (ofd, SSDATA (encoded_newname), atime, mtime))
        xsignal2 (Qfile_date_error,
                  build_string ("Cannot set file date"), newname);
@@ -3286,7 +3170,7 @@ Use the current time if TIMESTAMP is nil.  TIMESTAMP is in the format of
 {
   Lisp_Object absname, encoded_absname;
   Lisp_Object handler;
-  EMACS_TIME t = lisp_time_argument (timestamp);
+  struct timespec t = lisp_time_argument (timestamp);
 
   absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
 
@@ -3363,7 +3247,7 @@ otherwise, if FILE2 does not exist, the answer is t.  */)
   if (stat (SSDATA (absname2), &st2) < 0)
     return Qt;
 
-  return (EMACS_TIME_LT (get_stat_mtime (&st2), get_stat_mtime (&st1))
+  return (timespec_cmp (get_stat_mtime (&st2), get_stat_mtime (&st1)) < 0
          ? Qt : Qnil);
 }
 \f
@@ -3463,13 +3347,13 @@ file_offset (Lisp_Object val)
 }
 
 /* Return a special time value indicating the error number ERRNUM.  */
-static EMACS_TIME
+static struct timespec
 time_error_value (int errnum)
 {
   int ns = (errnum == ENOENT || errnum == EACCES || errnum == ENOTDIR
            ? NONEXISTENT_MODTIME_NSECS
            : UNKNOWN_MODTIME_NSECS);
-  return make_emacs_time (0, ns);
+  return make_timespec (0, ns);
 }
 
 DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
@@ -3501,7 +3385,7 @@ by calling `format-decode', which see.  */)
   (Lisp_Object filename, Lisp_Object visit, Lisp_Object beg, Lisp_Object end, Lisp_Object replace)
 {
   struct stat st;
-  EMACS_TIME mtime;
+  struct timespec mtime;
   int fd;
   ptrdiff_t inserted = 0;
   ptrdiff_t how_much;
@@ -4567,7 +4451,7 @@ by calling `format-decode', which see.  */)
     }
 
   if (!NILP (visit)
-      && EMACS_NSECS (current_buffer->modtime) == NONEXISTENT_MODTIME_NSECS)
+      && current_buffer->modtime.tv_nsec == NONEXISTENT_MODTIME_NSECS)
     {
       /* If visiting nonexistent file, return nil.  */
       report_file_errno ("Opening input file", orig_filename, save_errno);
@@ -4766,7 +4650,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
   int save_errno = 0;
   const char *fn;
   struct stat st;
-  EMACS_TIME modtime;
+  struct timespec modtime;
   ptrdiff_t count = SPECPDL_INDEX ();
   ptrdiff_t count1 IF_LINT (= 0);
   Lisp_Object handler;
@@ -4980,7 +4864,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
          }
     }
 
-  modtime = invalid_emacs_time ();
+  modtime = invalid_timespec ();
   if (visiting)
     {
       if (fstat (desc, &st) == 0)
@@ -5014,7 +4898,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
      unlikely and a similar race between the last write and the fstat
      above cannot possibly be closed anyway.  */
 
-  if (EMACS_TIME_VALID_P (modtime)
+  if (timespec_valid_p (modtime)
       && ! (valid_timestamp_file_system && st.st_dev == timestamp_file_system))
     {
       int desc1 = emacs_open (fn, O_WRONLY | O_BINARY, 0);
@@ -5036,11 +4920,11 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
              bool use_heuristic
                = ((open_flags & (O_EXCL | O_TRUNC)) != 0
                   && st.st_size != 0
-                  && EMACS_NSECS (modtime) % 100 != 0);
+                  && modtime.tv_nsec % 100 != 0);
 
-             EMACS_TIME modtime1 = get_stat_mtime (&st1);
+             struct timespec modtime1 = get_stat_mtime (&st1);
              if (use_heuristic
-                 && EMACS_TIME_EQ (modtime, modtime1)
+                 && timespec_cmp (modtime, modtime1) == 0
                  && st.st_size == st1.st_size)
                {
                  timestamp_file_system = st.st_dev;
@@ -5080,7 +4964,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
   /* Do this before reporting IO error
      to avoid a "file has changed on disk" warning on
      next attempt to save.  */
-  if (EMACS_TIME_VALID_P (modtime))
+  if (timespec_valid_p (modtime))
     {
       current_buffer->modtime = modtime;
       current_buffer->modtime_size = st.st_size;
@@ -5121,7 +5005,8 @@ DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
        doc: /* Return t if (car A) is numerically less than (car B).  */)
   (Lisp_Object a, Lisp_Object b)
 {
-  return Flss (Fcar (a), Fcar (b));
+  Lisp_Object args[2] = { Fcar (a), Fcar (b), };
+  return Flss (2, args);
 }
 
 /* Build the complete list of annotations appropriate for writing out
@@ -5262,6 +5147,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
@@ -5288,9 +5177,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
            {
@@ -5307,8 +5203,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
            {
@@ -5329,11 +5232,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;
        }
@@ -5355,7 +5266,7 @@ See Info node `(elisp)Modification Time' for more details.  */)
   struct stat st;
   Lisp_Object handler;
   Lisp_Object filename;
-  EMACS_TIME mtime;
+  struct timespec mtime;
 
   if (NILP (buf))
     b = current_buffer;
@@ -5366,7 +5277,7 @@ See Info node `(elisp)Modification Time' for more details.  */)
     }
 
   if (!STRINGP (BVAR (b, filename))) return Qt;
-  if (EMACS_NSECS (b->modtime) == UNKNOWN_MODTIME_NSECS) return Qt;
+  if (b->modtime.tv_nsec == UNKNOWN_MODTIME_NSECS) return Qt;
 
   /* If the file name has special constructs in it,
      call the corresponding file handler.  */
@@ -5380,7 +5291,7 @@ See Info node `(elisp)Modification Time' for more details.  */)
   mtime = (stat (SSDATA (filename), &st) == 0
           ? get_stat_mtime (&st)
           : time_error_value (errno));
-  if (EMACS_TIME_EQ (mtime, b->modtime)
+  if (timespec_cmp (mtime, b->modtime) == 0
       && (b->modtime_size < 0
          || st.st_size == b->modtime_size))
     return Qt;
@@ -5397,7 +5308,7 @@ doesn't exist, return -1.
 See Info node `(elisp)Modification Time' for more details.  */)
   (void)
 {
-  int ns = EMACS_NSECS (current_buffer->modtime);
+  int ns = current_buffer->modtime.tv_nsec;
   if (ns < 0)
     return make_number (UNKNOWN_MODTIME_NSECS - ns);
   return make_lisp_time (current_buffer->modtime);
@@ -5416,11 +5327,11 @@ An argument specifies the modification time value to use
 {
   if (!NILP (time_flag))
     {
-      EMACS_TIME mtime;
+      struct timespec mtime;
       if (INTEGERP (time_flag))
        {
          CHECK_RANGED_INTEGER (time_flag, -1, 0);
-         mtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS - XINT (time_flag));
+         mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XINT (time_flag));
        }
       else
        mtime = lisp_time_argument (time_flag);
@@ -5683,12 +5594,12 @@ A non-nil CURRENT-ONLY argument means save only current buffer.  */)
                || NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name),
                                                  Qwrite_region))))
          {
-           EMACS_TIME before_time = current_emacs_time ();
-           EMACS_TIME after_time;
+           struct timespec before_time = current_timespec ();
+           struct timespec after_time;
 
            /* If we had a failure, don't try again for 20 minutes.  */
            if (b->auto_save_failure_time > 0
-               && EMACS_SECS (before_time) - b->auto_save_failure_time < 1200)
+               && before_time.tv_sec - b->auto_save_failure_time < 1200)
              continue;
 
            set_buffer_internal (b);
@@ -5721,12 +5632,12 @@ A non-nil CURRENT-ONLY argument means save only current buffer.  */)
            XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
            set_buffer_internal (old);
 
-           after_time = current_emacs_time ();
+           after_time = current_timespec ();
 
            /* If auto-save took more than 60 seconds,
               assume it was an NFS failure that got a timeout.  */
-           if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
-             b->auto_save_failure_time = EMACS_SECS (after_time);
+           if (after_time.tv_sec - before_time.tv_sec > 60)
+             b->auto_save_failure_time = after_time.tv_sec;
          }
       }
 
@@ -6081,6 +5992,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);