X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a0931322f6c257bb4a4a678f62dcb4ae3b253221..4ec52e2f8c1697994618b4bdfd013659f6defb1b:/src/fileio.c diff --git a/src/fileio.c b/src/fileio.c index 28b2dc8472..a0603b490d 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -49,6 +49,7 @@ along with GNU Emacs. If not, see . */ #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 *); + +/* 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 */ +} /* Signal a file-access failure. STRING describes the failure, NAME the file involved, and ERRORNO the errno value. @@ -220,13 +273,20 @@ close_file_unwind (int fd) emacs_close (fd); } +void +fclose_unwind (void *arg) +{ + FILE *stream = arg; + fclose (stream); +} + /* Restore point, having saved it as a marker. */ void restore_point_unwind (Lisp_Object location) { Fgoto_char (location); - Fset_marker (location, Qnil, Qnil); + unchain_marker (XMARKER (location)); } @@ -359,8 +419,7 @@ Given a Unix syntax file name, returns a string ending in slash. */) } #ifdef DOS_NT - beg = alloca (SBYTES (filename) + 1); - memcpy (beg, SSDATA (filename), SBYTES (filename) + 1); + beg = xlispstrdupa (filename); #else beg = SSDATA (filename); #endif @@ -498,6 +557,10 @@ get a current directory to run processes in. */) return Ffile_name_directory (filename); } +/* Maximum number of bytes that DST will be longer than SRC + in file_name_as_directory. This occurs when SRCLEN == 0. */ +enum { file_name_as_directory_slop = 2 }; + /* Convert from file name SRC of length SRCLEN to directory name in DST. MULTIBYTE non-zero means the file name in SRC is a multibyte string. On UNIX, just make sure there is a terminating /. Return @@ -515,14 +578,10 @@ file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen, return 2; } - strcpy (dst, src); - + memcpy (dst, src, srclen); if (!IS_DIRECTORY_SEP (dst[srclen - 1])) - { - dst[srclen] = DIRECTORY_SEP; - dst[srclen + 1] = '\0'; - srclen++; - } + dst[srclen++] = DIRECTORY_SEP; + dst[srclen] = 0; #ifdef DOS_NT dostounix_filename (dst, multibyte); #endif @@ -541,7 +600,8 @@ For a Unix-syntax file name, just appends a slash. */) { char *buf; ptrdiff_t length; - Lisp_Object handler; + Lisp_Object handler, val; + USE_SAFE_ALLOCA; CHECK_STRING (file); if (NILP (file)) @@ -563,10 +623,12 @@ For a Unix-syntax file name, just appends a slash. */) if (!NILP (Vw32_downcase_file_names)) file = Fdowncase (file); #endif - buf = alloca (SBYTES (file) + 10); + buf = SAFE_ALLOCA (SBYTES (file) + file_name_as_directory_slop + 1); length = file_name_as_directory (buf, SSDATA (file), SBYTES (file), STRING_MULTIBYTE (file)); - return make_specified_string (buf, -1, length, STRING_MULTIBYTE (file)); + val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (file)); + SAFE_FREE (); + return val; } /* Convert from directory name SRC of length SRCLEN to file name in @@ -578,18 +640,17 @@ static ptrdiff_t directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte) { /* Process as Unix format: just remove any final slash. - But leave "/" unchanged; do not change it to "". */ - strcpy (dst, src); - if (srclen > 1 - && IS_DIRECTORY_SEP (dst[srclen - 1]) + But leave "/" and "//" unchanged. */ + while (srclen > 1 #ifdef DOS_NT - && !IS_ANY_SEP (dst[srclen - 2]) + && !IS_ANY_SEP (src[srclen - 2]) #endif - ) - { - dst[srclen - 1] = 0; - srclen--; - } + && IS_DIRECTORY_SEP (src[srclen - 1]) + && ! (srclen == 2 && IS_DIRECTORY_SEP (src[0]))) + srclen--; + + memcpy (dst, src, srclen); + dst[srclen] = 0; #ifdef DOS_NT dostounix_filename (dst, multibyte); #endif @@ -607,7 +668,8 @@ In Unix-syntax, this function just removes the final slash. */) { char *buf; ptrdiff_t length; - Lisp_Object handler; + Lisp_Object handler, val; + USE_SAFE_ALLOCA; CHECK_STRING (directory); @@ -630,10 +692,12 @@ In Unix-syntax, this function just removes the final slash. */) if (!NILP (Vw32_downcase_file_names)) directory = Fdowncase (directory); #endif - buf = alloca (SBYTES (directory) + 20); + buf = SAFE_ALLOCA (SBYTES (directory) + 1); length = directory_file_name (buf, SSDATA (directory), SBYTES (directory), STRING_MULTIBYTE (directory)); - return make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory)); + val = make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory)); + SAFE_FREE (); + return val; } static const char make_temp_name_tbl[64] = @@ -669,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)]; @@ -704,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); @@ -747,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 @@ -831,6 +894,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) Lisp_Object handler, result, handled_name; bool multibyte; Lisp_Object hdir; + USE_SAFE_ALLOCA; CHECK_STRING (name); @@ -923,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); @@ -937,8 +1020,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) #endif /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */ - nm = alloca (SBYTES (name) + 1); - memcpy (nm, SSDATA (name), SBYTES (name) + 1); + nm = xlispstrdupa (name); #ifdef DOS_NT /* Note if special escape prefix is present, but remove for now. */ @@ -1006,11 +1088,11 @@ filesystem tree, not (expand-file-name ".." dirname). */) || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0)))) lose = 1; - /* We want to replace multiple `/' in a row with a single - slash. */ - else if (p > nm - && IS_DIRECTORY_SEP (p[0]) - && IS_DIRECTORY_SEP (p[1])) + /* Replace multiple slashes with a single one, except + leave leading "//" alone. */ + else if (IS_DIRECTORY_SEP (p[0]) + && IS_DIRECTORY_SEP (p[1]) + && (p != nm || IS_DIRECTORY_SEP (p[2]))) lose = 1; p++; } @@ -1093,10 +1175,11 @@ filesystem tree, not (expand-file-name ".." dirname). */) else /* ~user/filename */ { char *o, *p; - for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++); - o = alloca (p - nm + 1); + for (p = nm; *p && !IS_DIRECTORY_SEP (*p); p++) + continue; + o = SAFE_ALLOCA (p - nm + 1); memcpy (o, nm, p - nm); - o [p - nm] = 0; + o[p - nm] = 0; block_input (); pw = getpwnam (o + 1); @@ -1212,7 +1295,8 @@ filesystem tree, not (expand-file-name ".." dirname). */) if (!IS_DIRECTORY_SEP (nm[0])) { ptrdiff_t newlen = strlen (newdir); - char *tmp = alloca (newlen + strlen (nm) + 2); + char *tmp = alloca (newlen + file_name_as_directory_slop + + strlen (nm) + 1); file_name_as_directory (tmp, newdir, newlen, multibyte); strcat (tmp, nm); nm = tmp; @@ -1266,31 +1350,18 @@ filesystem tree, not (expand-file-name ".." dirname). */) if (newdir) { - /* Get rid of any slash at the end of newdir, unless newdir is - just / or // (an incomplete UNC name). */ + /* Ignore any slash at the end of newdir, unless newdir is + just "/" or "//". */ length = strlen (newdir); - tlen = length + 1; - if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1]) -#ifdef WINDOWSNT - && !(length == 2 && IS_DIRECTORY_SEP (newdir[0])) -#endif - ) - { - char *temp = alloca (length); - memcpy (temp, newdir, length - 1); - temp[length - 1] = 0; - length--; - newdir = temp; - } + while (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1]) + && ! (length == 2 && IS_DIRECTORY_SEP (newdir[0]))) + length--; } else - { - length = 0; - tlen = 0; - } + length = 0; /* Now concatenate the directory and name to new space in the stack frame. */ - tlen += strlen (nm) + 1; + tlen = length + file_name_as_directory_slop + strlen (nm) + 1; #ifdef DOS_NT /* Reserve space for drive specifier and escape prefix, since either or both may need to be inserted. (The Microsoft x86 compiler @@ -1298,7 +1369,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) target = alloca (tlen + 4); target += 4; #else /* not DOS_NT */ - target = alloca (tlen); + target = SAFE_ALLOCA (tlen); #endif /* not DOS_NT */ *target = 0; @@ -1315,7 +1386,10 @@ filesystem tree, not (expand-file-name ".." dirname). */) if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0]) && newdir[1] == '\0')) #endif - strcpy (target, newdir); + { + memcpy (target, newdir, length); + target[length] = 0; + } } else file_name_as_directory (target, newdir, length, multibyte); @@ -1375,8 +1449,9 @@ filesystem tree, not (expand-file-name ".." dirname). */) ++o; p += 3; } - else if (p > target && IS_DIRECTORY_SEP (p[1])) - /* Collapse multiple `/' in a row. */ + else if (IS_DIRECTORY_SEP (p[1]) + && (p != target || IS_DIRECTORY_SEP (p[2]))) + /* Collapse multiple "/", except leave leading "//" alone. */ p++; else { @@ -1424,11 +1499,12 @@ filesystem tree, not (expand-file-name ".." dirname). */) { handled_name = call3 (handler, Qexpand_file_name, result, default_directory); - if (STRINGP (handled_name)) - return handled_name; - error ("Invalid handler in `file-name-handler-alist'"); + if (! STRINGP (handled_name)) + error ("Invalid handler in `file-name-handler-alist'"); + result = handled_name; } + SAFE_FREE (); return result; } @@ -1659,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; @@ -1686,8 +1760,7 @@ those `/' is discarded. */) /* Always work on a copy of the string, in case GC happens during decode of environment variables, causing the original Lisp_String data to be relocated. */ - nm = alloca (SBYTES (filename) + 1); - memcpy (nm, SDATA (filename), SBYTES (filename) + 1); + nm = xlispstrdupa (filename); #ifdef DOS_NT dostounix_filename (nm, multibyte); @@ -1704,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) { @@ -1774,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) @@ -1858,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)); } /* A slightly faster and more convenient way to get @@ -2041,7 +1998,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; @@ -2050,7 +2007,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. */ @@ -2174,8 +2131,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); @@ -2552,55 +2509,6 @@ On Unix, this is a name starting with a `/' or a `~'. */) return file_name_absolute_p (SSDATA (filename)) ? Qt : Qnil; } -/* 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'. @@ -2626,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, @@ -3282,7 +3190,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)); @@ -3359,7 +3267,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); } @@ -3459,13 +3367,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, @@ -3497,7 +3405,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; @@ -3853,7 +3761,8 @@ by calling `format-decode', which see. */) if (same_at_start - BEGV_BYTE == end_offset - beg_offset) { emacs_close (fd); - specpdl_ptr--; + clear_unwind_protect (fd_index); + /* Truncate the buffer to the size of the file. */ del_range_1 (same_at_start, same_at_end, 0, 0); goto handled; @@ -3949,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); @@ -4059,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); @@ -4107,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); @@ -4208,8 +4128,7 @@ by calling `format-decode', which see. */) to be signaled after decoding the text we read. */ nbytes = internal_condition_case_1 (read_non_regular, - make_save_value (SAVE_TYPE_INT_INT_INT, (ptrdiff_t) fd, - inserted, trytry), + make_save_int_int_int (fd, inserted, trytry), Qerror, read_non_regular_quit); if (NILP (nbytes)) @@ -4563,12 +4482,20 @@ 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); } + /* 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); @@ -4739,25 +4666,39 @@ This does code conversion according to the value of This calls `write-region-annotate-functions' at the start, and `write-region-post-annotation-function' at the end. */) - (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append, Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew) + (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append, + Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew) +{ + return write_region (start, end, filename, append, visit, lockname, mustbenew, + -1); +} + +/* Like Fwrite_region, except that if DESC is nonnegative, it is a file + descriptor for FILENAME, so do not open or close FILENAME. */ + +Lisp_Object +write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, + Lisp_Object append, Lisp_Object visit, Lisp_Object lockname, + Lisp_Object mustbenew, int desc) { - int desc; int open_flags; int mode; off_t offset IF_LINT (= 0); + bool open_and_close_file = desc < 0; bool ok; int save_errno = 0; const char *fn; struct stat st; - EMACS_TIME modtime; + struct timespec modtime; ptrdiff_t count = SPECPDL_INDEX (); - ptrdiff_t count1; + ptrdiff_t count1 IF_LINT (= 0); Lisp_Object handler; Lisp_Object visit_file; Lisp_Object annotations; Lisp_Object encoded_filename; bool visiting = (EQ (visit, Qt) || STRINGP (visit)); bool quietly = !NILP (visit); + bool file_locked = 0; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; struct buffer *given_buffer; struct coding_system coding; @@ -4825,7 +4766,6 @@ This calls `write-region-annotate-functions' at the start, and record_unwind_protect (build_annotations_unwind, Vwrite_region_annotation_buffers); Vwrite_region_annotation_buffers = list1 (Fcurrent_buffer ()); - count1 = SPECPDL_INDEX (); given_buffer = current_buffer; @@ -4864,8 +4804,11 @@ This calls `write-region-annotate-functions' at the start, and coding.mode |= CODING_MODE_SELECTIVE_DISPLAY; #ifdef CLASH_DETECTION - if (!auto_saving) - lock_file (lockname); + if (open_and_close_file && !auto_saving) + { + lock_file (lockname); + file_locked = 1; + } #endif /* CLASH_DETECTION */ encoded_filename = ENCODE_FILE (filename); @@ -4882,19 +4825,23 @@ This calls `write-region-annotate-functions' at the start, and mode = auto_saving ? auto_save_mode_bits : 0666; #endif - desc = emacs_open (fn, open_flags, mode); - - if (desc < 0) + if (open_and_close_file) { - int open_errno = errno; + desc = emacs_open (fn, open_flags, mode); + if (desc < 0) + { + int open_errno = errno; #ifdef CLASH_DETECTION - if (!auto_saving) unlock_file (lockname); + if (file_locked) + unlock_file (lockname); #endif /* CLASH_DETECTION */ - UNGCPRO; - report_file_errno ("Opening output file", filename, open_errno); - } + UNGCPRO; + report_file_errno ("Opening output file", filename, open_errno); + } - record_unwind_protect_int (close_file_unwind, desc); + count1 = SPECPDL_INDEX (); + record_unwind_protect_int (close_file_unwind, desc); + } if (NUMBERP (append)) { @@ -4903,7 +4850,8 @@ This calls `write-region-annotate-functions' at the start, and { int lseek_errno = errno; #ifdef CLASH_DETECTION - if (!auto_saving) unlock_file (lockname); + if (file_locked) + unlock_file (lockname); #endif /* CLASH_DETECTION */ UNGCPRO; report_file_errno ("Lseek error", filename, lseek_errno); @@ -4938,9 +4886,9 @@ This calls `write-region-annotate-functions' at the start, and immediate_quit = 0; - /* fsync is not crucial for auto-save files, since they might lose - some work anyway. */ - if (!auto_saving && !write_region_inhibit_fsync) + /* fsync is not crucial for temporary files. Nor for auto-save + files, since they might lose some work anyway. */ + if (open_and_close_file && !auto_saving && !write_region_inhibit_fsync) { /* Transfer data and metadata to disk, retrying if interrupted. fsync can report a write failure here, e.g., due to disk full @@ -4955,7 +4903,7 @@ This calls `write-region-annotate-functions' at the start, and } } - modtime = invalid_emacs_time (); + modtime = invalid_timespec (); if (visiting) { if (fstat (desc, &st) == 0) @@ -4964,12 +4912,15 @@ This calls `write-region-annotate-functions' at the start, and ok = 0, save_errno = errno; } - /* NFS can report a write failure now. */ - if (emacs_close (desc) < 0) - ok = 0, save_errno = errno; + if (open_and_close_file) + { + /* NFS can report a write failure now. */ + if (emacs_close (desc) < 0) + ok = 0, save_errno = errno; - /* Discard the unwind protect for close_file_unwind. */ - specpdl_ptr = specpdl + count1; + /* Discard the unwind protect for close_file_unwind. */ + specpdl_ptr = specpdl + count1; + } /* Some file systems have a bug where st_mtime is not updated properly after a write. For example, CIFS might not see the @@ -4986,7 +4937,7 @@ This calls `write-region-annotate-functions' at the start, and 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); @@ -5008,11 +4959,11 @@ This calls `write-region-annotate-functions' at the start, and 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; @@ -5045,14 +4996,14 @@ This calls `write-region-annotate-functions' at the start, and unbind_to (count, Qnil); #ifdef CLASH_DETECTION - if (!auto_saving) + if (file_locked) unlock_file (lockname); #endif /* CLASH_DETECTION */ /* 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; @@ -5066,7 +5017,7 @@ This calls `write-region-annotate-functions' at the start, and 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) { @@ -5089,13 +5040,12 @@ This calls `write-region-annotate-functions' at the start, and return Qnil; } -Lisp_Object merge (Lisp_Object, Lisp_Object, Lisp_Object); - 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 @@ -5236,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 @@ -5262,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 { @@ -5281,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 { @@ -5303,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; } @@ -5329,7 +5305,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; @@ -5340,7 +5316,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. */ @@ -5354,7 +5330,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; @@ -5371,7 +5347,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); @@ -5390,11 +5366,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); @@ -5613,9 +5589,8 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) couldn't handle some ange-ftp'd file. */ for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) - for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) + FOR_EACH_LIVE_BUFFER (tail, buf) { - buf = XCDR (XCAR (tail)); b = XBUFFER (buf); /* Record all the buffers that have auto save mode @@ -5658,12 +5633,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); @@ -5696,12 +5671,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; } } @@ -5809,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 @@ -6021,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. @@ -6056,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);