#include <config.h>
#include <limits.h>
#include <fcntl.h>
-#include <stdio.h>
+#include "sysstdio.h"
#include <sys/types.h>
#include <sys/stat.h>
#include <unistd.h>
#include <selinux/context.h>
#endif
-#ifdef HAVE_POSIX_ACL
+#ifdef HAVE_ACL_SET_FILE
#include <sys/acl.h>
#endif
#ifdef WINDOWSNT
#define NOMINMAX 1
#include <windows.h>
-#include <fcntl.h>
#include <sys/file.h>
#include "w32.h"
#endif /* not WINDOWSNT */
#ifdef MSDOS
#include "msdos.h"
#include <sys/param.h>
-#include <fcntl.h>
#endif
#ifdef DOS_NT
#endif
#include "systime.h"
+#include <acl.h>
+#include <allocator.h>
+#include <careadlinkat.h>
#include <stat-time.h>
#ifdef HPUX
is added here. */
static Lisp_Object Vwrite_region_annotation_buffers;
-#ifdef HAVE_FSYNC
-#endif
-
static Lisp_Object Qdelete_by_moving_to_trash;
/* Lisp function for moving files to trash. */
#ifdef WINDOWSNT
#endif
-Lisp_Object Qfile_error;
+Lisp_Object Qfile_error, Qfile_notify_error;
static Lisp_Object Qfile_already_exists, Qfile_date_error;
static Lisp_Object Qexcl;
Lisp_Object Qfile_name_history;
struct coding_system *);
\f
+/* Signal a file-access failure. STRING describes the failure,
+ NAME the file involved, and ERRORNO the errno value.
+
+ If NAME is neither null nor a pair, package it up as a singleton
+ list before reporting it; this saves report_file_errno's caller the
+ trouble of preserving errno before calling list1. */
+
void
-report_file_error (const char *string, Lisp_Object data)
+report_file_errno (char const *string, Lisp_Object name, int errorno)
{
+ Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name);
Lisp_Object errstring;
- int errorno = errno;
char *str;
synchronize_system_messages_locale ();
}
}
-Lisp_Object
-close_file_unwind (Lisp_Object fd)
+/* Signal a file-access failure that set errno. STRING describes the
+ failure, NAME the file involved. */
+
+void
+report_file_error (char const *string, Lisp_Object name)
{
- emacs_close (XFASTINT (fd));
- return Qnil;
+ report_file_errno (string, name, errno);
+}
+
+void
+close_file_unwind (int fd)
+{
+ if (0 <= fd)
+ emacs_close (fd);
}
/* Restore point, having saved it as a marker. */
-Lisp_Object
+void
restore_point_unwind (Lisp_Object location)
{
Fgoto_char (location);
Fset_marker (location, Qnil, Qnil);
- return Qnil;
}
\f
static Lisp_Object Qset_file_acl;
static Lisp_Object Qfile_newer_than_file_p;
Lisp_Object Qinsert_file_contents;
+static Lisp_Object Qchoose_write_coding_system;
Lisp_Object Qwrite_region;
static Lisp_Object Qverify_visited_file_modtime;
static Lisp_Object Qset_visited_file_modtime;
if (getdefdir (c_toupper (*beg) - 'A' + 1, r))
{
- if (!IS_DIRECTORY_SEP (res[strlen (res) - 1]))
+ size_t l = strlen (res);
+
+ if (l > 3 || !IS_DIRECTORY_SEP (res[l - 1]))
strcat (res, "/");
beg = res;
p = beg + strlen (beg);
- dostounix_filename (beg);
+ dostounix_filename (beg, 0);
tem_fn = make_specified_string (beg, -1, p - beg,
STRING_MULTIBYTE (filename));
}
}
else if (STRING_MULTIBYTE (filename))
{
- tem_fn = ENCODE_FILE (make_specified_string (beg, -1, p - beg, 1));
- dostounix_filename (SSDATA (tem_fn));
- tem_fn = DECODE_FILE (tem_fn);
+ tem_fn = make_specified_string (beg, -1, p - beg, 1);
+ dostounix_filename (SSDATA (tem_fn), 1);
+#ifdef WINDOWSNT
+ if (!NILP (Vw32_downcase_file_names))
+ tem_fn = Fdowncase (tem_fn);
+#endif
}
else
{
- dostounix_filename (beg);
+ dostounix_filename (beg, 0);
tem_fn = make_specified_string (beg, -1, p - beg, 0);
}
return tem_fn;
srclen++;
}
#ifdef DOS_NT
- if (multibyte)
- {
- Lisp_Object tem_fn = make_specified_string (dst, -1, srclen, 1);
-
- tem_fn = ENCODE_FILE (tem_fn);
- dostounix_filename (SSDATA (tem_fn));
- tem_fn = DECODE_FILE (tem_fn);
- memcpy (dst, SSDATA (tem_fn), (srclen = SBYTES (tem_fn)) + 1);
- }
- else
- dostounix_filename (dst);
+ dostounix_filename (dst, multibyte);
#endif
return srclen;
}
error ("Invalid handler in `file-name-handler-alist'");
}
+#ifdef WINDOWSNT
+ if (!NILP (Vw32_downcase_file_names))
+ file = Fdowncase (file);
+#endif
buf = alloca (SBYTES (file) + 10);
length = file_name_as_directory (buf, SSDATA (file), SBYTES (file),
STRING_MULTIBYTE (file));
srclen--;
}
#ifdef DOS_NT
- if (multibyte)
- {
- Lisp_Object tem_fn = make_specified_string (dst, -1, srclen, 1);
-
- tem_fn = ENCODE_FILE (tem_fn);
- dostounix_filename (SSDATA (tem_fn));
- tem_fn = DECODE_FILE (tem_fn);
- memcpy (dst, SSDATA (tem_fn), (srclen = SBYTES (tem_fn)) + 1);
- }
- else
- dostounix_filename (dst);
+ dostounix_filename (dst, multibyte);
#endif
return srclen;
}
error ("Invalid handler in `file-name-handler-alist'");
}
+#ifdef WINDOWSNT
+ if (!NILP (Vw32_downcase_file_names))
+ directory = Fdowncase (directory);
+#endif
buf = alloca (SBYTES (directory) + 20);
length = directory_file_name (buf, SSDATA (directory), SBYTES (directory),
STRING_MULTIBYTE (directory));
dog-slow, but also useless since eventually nil would
have to be returned anyway. */
report_file_error ("Cannot create temporary name for prefix",
- Fcons (prefix, Qnil));
+ prefix);
/* not reached */
}
}
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
doc: /* Convert filename NAME to absolute, and canonicalize it.
Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
-\(does not start with slash or tilde); if DEFAULT-DIRECTORY is nil or missing,
-the current buffer's value of `default-directory' is used.
+\(does not start with slash or tilde); both the directory name and
+a directory's file name are accepted. If DEFAULT-DIRECTORY is nil or
+missing, the current buffer's value of `default-directory' is used.
NAME should be a string that is a valid file name for the underlying
filesystem.
File name components that are `.' are removed, and
}
}
+#ifdef WINDOWSNT
+ if (!NILP (Vw32_downcase_file_names))
+ default_directory = Fdowncase (default_directory);
+#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);
#ifdef DOS_NT
/* Make sure directories are all separated with /, but
avoid allocation of a new string when not required. */
- if (multibyte)
- {
- Lisp_Object tem_name = make_specified_string (nm, -1, strlen (nm),
- multibyte);
-
- tem_name = ENCODE_FILE (tem_name);
- dostounix_filename (SSDATA (tem_name));
- tem_name = DECODE_FILE (tem_name);
- memcpy (nm, SSDATA (tem_name), SBYTES (tem_name) + 1);
- }
- else
- dostounix_filename (nm);
+ dostounix_filename (nm, multibyte);
#ifdef WINDOWSNT
if (IS_DIRECTORY_SEP (nm[1]))
{
temp[0] = DRIVE_LETTER (drive);
name = concat2 (build_string (temp), name);
}
+#ifdef WINDOWSNT
+ if (!NILP (Vw32_downcase_file_names))
+ name = Fdowncase (name);
+#endif
return name;
#else /* not DOS_NT */
if (strcmp (nm, SSDATA (name)) == 0)
#ifdef WINDOWSNT
char *prev_o = o;
#endif
- while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
- ;
+ while (o != target && (--o, !IS_DIRECTORY_SEP (*o)))
+ continue;
#ifdef WINDOWSNT
/* Don't go below server level in UNC filenames. */
if (o == target + 1 && IS_DIRECTORY_SEP (*o)
target[1] = ':';
}
result = make_specified_string (target, -1, o - target, multibyte);
- if (multibyte)
- {
- result = ENCODE_FILE (result);
- dostounix_filename (SSDATA (result));
- result = DECODE_FILE (result);
- }
- else
- dostounix_filename (SSDATA (result));
+ dostounix_filename (SSDATA (result), multibyte);
+#ifdef WINDOWSNT
+ if (!NILP (Vw32_downcase_file_names))
+ result = Fdowncase (result);
+#endif
#else /* !DOS_NT */
result = make_specified_string (target, -1, o - target, multibyte);
#endif /* !DOS_NT */
memcpy (nm, SDATA (filename), SBYTES (filename) + 1);
#ifdef DOS_NT
- if (multibyte)
- {
- Lisp_Object encoded_filename = ENCODE_FILE (filename);
- Lisp_Object tem_fn;
-
- dostounix_filename (SDATA (encoded_filename));
- tem_fn = DECODE_FILE (encoded_filename);
- nm = alloca (SBYTES (tem_fn) + 1);
- memcpy (nm, SDATA (tem_fn), SBYTES (tem_fn) + 1);
- substituted = (memcmp (nm, SDATA (filename), SBYTES (filename)) != 0);
- if (substituted)
- filename = tem_fn;
- }
- else
- {
- dostounix_filename (nm);
- substituted = (memcmp (nm, SDATA (filename), SBYTES (filename)) != 0);
- }
+ dostounix_filename (nm, multibyte);
+ substituted = (memcmp (nm, SDATA (filename), SBYTES (filename)) != 0);
#endif
endp = nm + SBYTES (filename);
else if (*p == '{')
{
o = ++p;
- while (p != endp && *p != '}') p++;
- if (*p != '}') goto missingclose;
+ p = memchr (p, '}', endp - p);
+ if (! p)
+ goto missingclose;
s = p;
}
else
}
if (!substituted)
- return filename;
+ {
+#ifdef WINDOWSNT
+ if (!NILP (Vw32_downcase_file_names))
+ filename = Fdowncase (filename);
+#endif
+ return filename;
+ }
/* If substitution required, recopy the string and do it. */
/* Make space in stack frame for the new copy. */
else if (*p == '{')
{
o = ++p;
- while (p != endp && *p != '}') p++;
- if (*p != '}') goto missingclose;
+ p = memchr (p, '}', endp - p);
+ if (! p)
+ goto missingclose;
s = p++;
}
else
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 */
/* Get variable value. */
o = egetenv (target);
need to quote some $ to $$ first. */
xnm = p;
+#ifdef WINDOWSNT
+ if (!NILP (Vw32_downcase_file_names))
+ {
+ Lisp_Object xname = make_specified_string (xnm, -1, x - xnm, multibyte);
+
+ xname = Fdowncase (xname);
+ return xname;
+ }
+ else
+#endif
return make_specified_string (xnm, -1, x - xnm, multibyte);
badsubst:
error ("Missing \"}\" in environment-variable substitution");
badvar:
error ("Substituting nonexistent environment variable \"%s\"", target);
-
- /* NOTREACHED */
- return Qnil;
}
\f
/* A slightly faster and more convenient way to get
security_context_t con;
int conlength = 0;
#endif
-#ifdef HAVE_POSIX_ACL
+#ifdef WINDOWSNT
acl_t acl = NULL;
#endif
#ifdef WINDOWSNT
if (!NILP (preserve_extended_attributes))
{
-#ifdef HAVE_POSIX_ACL
acl = acl_get_file (SDATA (encoded_file), ACL_TYPE_ACCESS);
- if (acl == NULL && errno != ENOTSUP)
- report_file_error ("Getting ACL", Fcons (file, Qnil));
-#endif
+ if (acl == NULL && acl_errno_valid (errno))
+ report_file_error ("Getting ACL", file);
}
if (!CopyFile (SDATA (encoded_file),
SDATA (encoded_newname),
{
/* CopyFile doesn't set errno when it fails. By far the most
"popular" reason is that the target is read-only. */
- if (GetLastError () == 5)
- errno = EACCES;
- else
- errno = EPERM;
- report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil)));
+ report_file_errno ("Copying file", list2 (file, newname),
+ GetLastError () == 5 ? EACCES : EPERM);
}
/* CopyFile retains the timestamp by default. */
else if (NILP (keep_time))
/* Restore original attributes. */
SetFileAttributes (filename, attributes);
}
-#ifdef HAVE_POSIX_ACL
if (acl != NULL)
{
bool fail =
acl_set_file (SDATA (encoded_newname), ACL_TYPE_ACCESS, acl) != 0;
- if (fail && errno != ENOTSUP)
- report_file_error ("Setting ACL", Fcons (newname, Qnil));
+ if (fail && acl_errno_valid (errno))
+ report_file_error ("Setting ACL", newname);
acl_free (acl);
}
-#endif
#else /* not WINDOWSNT */
immediate_quit = 1;
ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
immediate_quit = 0;
if (ifd < 0)
- report_file_error ("Opening input file", Fcons (file, Qnil));
+ report_file_error ("Opening input file", file);
- record_unwind_protect (close_file_unwind, make_number (ifd));
+ record_unwind_protect_int (close_file_unwind, ifd);
if (fstat (ifd, &st) != 0)
- report_file_error ("Input file status", Fcons (file, Qnil));
+ report_file_error ("Input file status", file);
if (!NILP (preserve_extended_attributes))
{
{
conlength = fgetfilecon (ifd, &con);
if (conlength == -1)
- report_file_error ("Doing fgetfilecon", Fcons (file, Qnil));
+ report_file_error ("Doing fgetfilecon", file);
}
#endif
-
-#ifdef HAVE_POSIX_ACL
- acl = acl_get_fd (ifd);
- if (acl == NULL && errno != ENOTSUP)
- report_file_error ("Getting ACL", Fcons (file, Qnil));
-#endif
}
if (out_st.st_mode != 0
&& st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
- {
- errno = 0;
- report_file_error ("Input and output files are the same",
- Fcons (file, Fcons (newname, Qnil)));
- }
+ report_file_errno ("Input and output files are the same",
+ list2 (file, newname), 0);
/* We can copy only regular files. */
if (!S_ISREG (st.st_mode))
- {
- /* Get a better looking error message. */
- errno = S_ISDIR (st.st_mode) ? EISDIR : EINVAL;
- report_file_error ("Non-regular file", Fcons (file, Qnil));
- }
+ report_file_errno ("Non-regular file", file,
+ S_ISDIR (st.st_mode) ? EISDIR : EINVAL);
-#ifdef MSDOS
- /* System's default file type was set to binary by _fmode in emacs.c. */
- ofd = emacs_open (SDATA (encoded_newname),
- O_WRONLY | O_TRUNC | O_CREAT
- | (NILP (ok_if_already_exists) ? O_EXCL : 0),
- S_IREAD | S_IWRITE);
-#else /* not MSDOS */
{
- mode_t new_mask = !NILP (preserve_uid_gid) ? 0600 : 0666;
- new_mask &= st.st_mode;
+#ifndef MSDOS
+ int new_mask = st.st_mode & (!NILP (preserve_uid_gid) ? 0600 : 0666);
+#else
+ int new_mask = S_IREAD | S_IWRITE;
+#endif
ofd = emacs_open (SSDATA (encoded_newname),
(O_WRONLY | O_TRUNC | O_CREAT
| (NILP (ok_if_already_exists) ? O_EXCL : 0)),
new_mask);
}
-#endif /* not MSDOS */
if (ofd < 0)
- report_file_error ("Opening output file", Fcons (newname, Qnil));
+ report_file_error ("Opening output file", newname);
- record_unwind_protect (close_file_unwind, make_number (ofd));
+ record_unwind_protect_int (close_file_unwind, ofd);
immediate_quit = 1;
QUIT;
while ((n = emacs_read (ifd, buf, sizeof buf)) > 0)
- if (emacs_write (ofd, buf, n) != n)
- report_file_error ("I/O error", Fcons (newname, Qnil));
+ if (emacs_write_sig (ofd, buf, n) != n)
+ report_file_error ("Write error", newname);
immediate_quit = 0;
#ifndef MSDOS
- /* Preserve the original file modes, and if requested, also its
+ /* Preserve the original file permissions, and if requested, also its
owner and group. */
{
mode_t mode_mask = 07777;
mode_mask |= 02000;
}
}
- if (fchmod (ofd, st.st_mode & mode_mask) != 0)
- report_file_error ("Doing chmod", Fcons (newname, Qnil));
+
+ switch (!NILP (preserve_extended_attributes)
+ ? qcopy_acl (SSDATA (encoded_file), ifd,
+ SSDATA (encoded_newname), ofd,
+ st.st_mode & mode_mask)
+ : fchmod (ofd, st.st_mode & mode_mask))
+ {
+ case -2: report_file_error ("Copying permissions from", file);
+ case -1: report_file_error ("Copying permissions to", newname);
+ }
}
#endif /* not MSDOS */
bool fail = fsetfilecon (ofd, con) != 0;
/* See http://debbugs.gnu.org/11245 for ENOTSUP. */
if (fail && errno != ENOTSUP)
- report_file_error ("Doing fsetfilecon", Fcons (newname, Qnil));
+ report_file_error ("Doing fsetfilecon", newname);
freecon (con);
}
#endif
-#ifdef HAVE_POSIX_ACL
- if (acl != NULL)
- {
- bool fail = acl_set_fd (ofd, acl) != 0;
- if (fail && errno != ENOTSUP)
- report_file_error ("Setting ACL", Fcons (newname, Qnil));
-
- acl_free (acl);
- }
-#endif
-
if (!NILP (keep_time))
{
EMACS_TIME atime = get_stat_atime (&st);
}
if (emacs_close (ofd) < 0)
- report_file_error ("I/O error", Fcons (newname, Qnil));
+ report_file_error ("Write error", newname);
emacs_close (ifd);
#else
if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0)
#endif
- report_file_error ("Creating directory", list1 (directory));
+ report_file_error ("Creating directory", directory);
return Qnil;
}
dir = SSDATA (encoded_dir);
if (rmdir (dir) != 0)
- report_file_error ("Removing directory", list1 (directory));
+ report_file_error ("Removing directory", directory);
return Qnil;
}
encoded_file = ENCODE_FILE (filename);
if (unlink (SSDATA (encoded_file)) < 0)
- report_file_error ("Removing old name", list1 (filename));
+ report_file_error ("Removing old name", filename);
return Qnil;
}
call the corresponding file handler. */
handler = Ffind_file_name_handler (absname, Qfile_exists_p);
if (!NILP (handler))
- return call2 (handler, Qfile_exists_p, absname);
+ {
+ Lisp_Object result = call2 (handler, Qfile_exists_p, absname);
+ errno = 0;
+ return result;
+ }
absname = ENCODE_FILE (absname);
(Lisp_Object filename, Lisp_Object string)
{
Lisp_Object handler, encoded_filename, absname;
- int fd;
CHECK_STRING (filename);
absname = Fexpand_file_name (filename, Qnil);
encoded_filename = ENCODE_FILE (absname);
- fd = emacs_open (SSDATA (encoded_filename), O_RDONLY, 0);
- if (fd < 0)
- report_file_error (SSDATA (string), Fcons (filename, Qnil));
- emacs_close (fd);
+ if (faccessat (AT_FDCWD, SSDATA (encoded_filename), R_OK, AT_EACCESS) != 0)
+ report_file_error (SSDATA (string), filename);
return Qnil;
}
\f
+/* Relative to directory FD, return the symbolic link value of FILENAME.
+ On failure, return nil. */
+Lisp_Object
+emacs_readlinkat (int fd, char const *filename)
+{
+ static struct allocator const emacs_norealloc_allocator =
+ { xmalloc, NULL, xfree, memory_full };
+ Lisp_Object val;
+ char readlink_buf[1024];
+ char *buf = careadlinkat (fd, filename, readlink_buf, sizeof readlink_buf,
+ &emacs_norealloc_allocator, readlinkat);
+ if (!buf)
+ return Qnil;
+
+ val = build_string (buf);
+ if (buf[0] == '/' && strchr (buf, ':'))
+ val = concat2 (build_string ("/:"), val);
+ if (buf != readlink_buf)
+ xfree (buf);
+ val = DECODE_FILE (val);
+ return val;
+}
+
DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
The value is the link target, as a string.
(Lisp_Object filename)
{
Lisp_Object handler;
- char *buf;
- Lisp_Object val;
- char readlink_buf[READLINK_BUFSIZE];
CHECK_STRING (filename);
filename = Fexpand_file_name (filename, Qnil);
filename = ENCODE_FILE (filename);
- buf = emacs_readlink (SSDATA (filename), readlink_buf);
- if (! buf)
- return Qnil;
-
- val = build_string (buf);
- if (buf[0] == '/' && strchr (buf, ':'))
- val = concat2 (build_string ("/:"), val);
- if (buf != readlink_buf)
- xfree (buf);
- val = DECODE_FILE (val);
- return val;
+ return emacs_readlinkat (AT_FDCWD, SSDATA (filename));
}
DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
call the corresponding file handler. */
handler = Ffind_file_name_handler (absname, Qfile_accessible_directory_p);
if (!NILP (handler))
- return call2 (handler, Qfile_accessible_directory_p, absname);
+ {
+ Lisp_Object r = call2 (handler, Qfile_accessible_directory_p, absname);
+ errno = 0;
+ return r;
+ }
absname = ENCODE_FILE (absname);
return file_accessible_directory_p (SSDATA (absname)) ? Qt : Qnil;
and it's a safe optimization here. */
char *buf = SAFE_ALLOCA (len + 3);
memcpy (buf, file, len);
- strcpy (buf + len, "/." + (file[len - 1] == '/'));
+ strcpy (buf + len, &"/."[file[len - 1] == '/']);
dir = buf;
}
!= 0);
/* See http://debbugs.gnu.org/11245 for ENOTSUP. */
if (fail && errno != ENOTSUP)
- report_file_error ("Doing lsetfilecon", Fcons (absname, Qnil));
+ report_file_error ("Doing lsetfilecon", absname);
context_free (parsed_con);
freecon (con);
return fail ? Qnil : Qt;
}
else
- report_file_error ("Doing lgetfilecon", Fcons (absname, Qnil));
+ report_file_error ("Doing lgetfilecon", absname);
}
#endif
{
Lisp_Object absname;
Lisp_Object handler;
-#ifdef HAVE_POSIX_ACL
+#ifdef HAVE_ACL_SET_FILE
acl_t acl;
Lisp_Object acl_string;
char *str;
if (!NILP (handler))
return call2 (handler, Qfile_acl, absname);
-#ifdef HAVE_POSIX_ACL
+#ifdef HAVE_ACL_SET_FILE
absname = ENCODE_FILE (absname);
acl = acl_get_file (SSDATA (absname), ACL_TYPE_ACCESS);
{
Lisp_Object absname;
Lisp_Object handler;
-#ifdef HAVE_POSIX_ACL
+#ifdef HAVE_ACL_SET_FILE
Lisp_Object encoded_absname;
acl_t acl;
bool fail;
if (!NILP (handler))
return call3 (handler, Qset_file_acl, absname, acl_string);
-#ifdef HAVE_POSIX_ACL
+#ifdef HAVE_ACL_SET_FILE
if (STRINGP (acl_string))
{
acl = acl_from_text (SSDATA (acl_string));
if (acl == NULL)
{
- report_file_error ("Converting ACL", Fcons (absname, Qnil));
+ report_file_error ("Converting ACL", absname);
return Qnil;
}
fail = (acl_set_file (SSDATA (encoded_absname), ACL_TYPE_ACCESS,
acl)
!= 0);
- if (fail && errno != ENOTSUP)
- report_file_error ("Setting ACL", Fcons (absname, Qnil));
+ if (fail && acl_errno_valid (errno))
+ report_file_error ("Setting ACL", absname);
acl_free (acl);
return fail ? Qnil : Qt;
encoded_absname = ENCODE_FILE (absname);
if (chmod (SSDATA (encoded_absname), XINT (mode) & 07777) < 0)
- report_file_error ("Doing chmod", Fcons (absname, Qnil));
+ report_file_error ("Doing chmod", absname);
return Qnil;
}
if (file_directory_p (SSDATA (encoded_absname)))
return Qnil;
#endif
- report_file_error ("Setting file times", Fcons (absname, Qnil));
- return Qnil;
+ report_file_error ("Setting file times", absname);
}
}
if (stat (SSDATA (absname2), &st2) < 0)
return Qt;
- return (EMACS_TIME_GT (get_stat_mtime (&st1), get_stat_mtime (&st2))
+ return (EMACS_TIME_LT (get_stat_mtime (&st2), get_stat_mtime (&st1))
? Qt : Qnil);
}
\f
o remove all text properties.
o set back the buffer multibyteness. */
-static Lisp_Object
+static void
decide_coding_unwind (Lisp_Object unwind_data)
{
Lisp_Object multibyte, undo_list, buffer;
/* Now we are safe to change the buffer's multibyteness directly. */
bset_enable_multibyte_characters (current_buffer, multibyte);
bset_undo_list (current_buffer, undo_list);
-
- return Qnil;
}
-/* Check quit and read from the file. STATE is a Lisp_Save_Value
+/* Read from a non-regular file. STATE is a Lisp_Save_Value
object where slot 0 is the file descriptor, slot 1 specifies
an offset to put the read bytes, and slot 2 is the maximum
amount of bytes to read. Value is the number of bytes read. */
static Lisp_Object
-read_contents (Lisp_Object state)
+read_non_regular (Lisp_Object state)
{
int nbytes;
return make_number (nbytes);
}
-/* Condition-case handler used when reading files in insert-file-contents. */
+
+/* Condition-case handler used when reading from non-regular files
+ in insert-file-contents. */
static Lisp_Object
-read_contents_quit (Lisp_Object ignore)
+read_non_regular_quit (Lisp_Object ignore)
{
return Qnil;
}
-/* Reposition FD to OFFSET, based on WHENCE. This acts like lseek
- except that it also tests for OFFSET being out of lseek's range. */
+/* Return the file offset that VAL represents, checking for type
+ errors and overflow. */
static off_t
-emacs_lseek (int fd, EMACS_INT offset, int whence)
+file_offset (Lisp_Object val)
{
- /* Use "&" rather than "&&" to suppress a bogus GCC warning; see
- <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43772>. */
- if (! ((offset >= TYPE_MINIMUM (off_t)) & (offset <= TYPE_MAXIMUM (off_t))))
+ if (RANGED_INTEGERP (0, val, TYPE_MAXIMUM (off_t)))
+ return XINT (val);
+
+ if (FLOATP (val))
{
- errno = EINVAL;
- return -1;
+ double v = XFLOAT_DATA (val);
+ if (0 <= v
+ && (sizeof (off_t) < sizeof v
+ ? v <= TYPE_MAXIMUM (off_t)
+ : v < TYPE_MAXIMUM (off_t)))
+ return v;
}
- return lseek (fd, offset, whence);
+
+ wrong_type_argument (intern ("file-offset"), val);
}
/* Return a special time value indicating the error number ERRNUM. */
EMACS_TIME mtime;
int fd;
ptrdiff_t inserted = 0;
- bool nochange = 0;
ptrdiff_t how_much;
off_t beg_offset, end_offset;
int unprocessed;
Lisp_Object p;
ptrdiff_t total = 0;
bool not_regular = 0;
- int save_errno = 0, read_errno = 0;
+ int save_errno = 0;
char read_buf[READ_BUF_SIZE];
struct coding_system coding;
- char buffer[1 << 14];
bool replace_handled = 0;
bool set_coding_system = 0;
Lisp_Object coding_system;
bool read_quit = 0;
+ /* If the undo log only contains the insertion, there's no point
+ keeping it. It's typically when we first fill a file-buffer. */
+ bool empty_undo_list_p
+ = (!NILP (visit) && NILP (BVAR (current_buffer, undo_list))
+ && BEG == Z);
Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
bool we_locked_file = 0;
- bool deferred_remove_unwind_protect = 0;
+ ptrdiff_t fd_index;
if (current_buffer->base_buffer && ! NILP (visit))
error ("Cannot do file visiting in an indirect buffer");
{
save_errno = errno;
if (NILP (visit))
- report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
+ report_file_error ("Opening input file", orig_filename);
mtime = time_error_value (save_errno);
st.st_size = -1;
- how_much = 0;
if (!NILP (Vcoding_system_for_read))
Fset (Qbuffer_file_coding_system, Vcoding_system_for_read);
goto notfound;
}
+ fd_index = SPECPDL_INDEX ();
+ record_unwind_protect_int (close_file_unwind, fd);
+
/* Replacement should preserve point as it preserves markers. */
if (!NILP (replace))
record_unwind_protect (restore_point_unwind, Fpoint_marker ());
- record_unwind_protect (close_file_unwind, make_number (fd));
-
if (fstat (fd, &st) != 0)
- report_file_error ("Input file status", Fcons (orig_filename, Qnil));
+ report_file_error ("Input file status", orig_filename);
mtime = get_stat_mtime (&st);
/* This code will need to be changed in order to work on named
}
if (!NILP (beg))
- {
- if (! RANGED_INTEGERP (0, beg, TYPE_MAXIMUM (off_t)))
- wrong_type_argument (intern ("file-offset"), beg);
- beg_offset = XFASTINT (beg);
- }
+ beg_offset = file_offset (beg);
else
beg_offset = 0;
if (!NILP (end))
- {
- if (! RANGED_INTEGERP (0, end, TYPE_MAXIMUM (off_t)))
- wrong_type_argument (intern ("file-offset"), end);
- end_offset = XFASTINT (end);
- }
+ end_offset = file_offset (end);
else
{
if (not_regular)
int ntail;
if (lseek (fd, - (1024 * 3), SEEK_END) < 0)
report_file_error ("Setting file position",
- Fcons (orig_filename, Qnil));
+ orig_filename);
ntail = emacs_read (fd, read_buf + nread, 1024 * 3);
nread = ntail < 0 ? ntail : nread + ntail;
}
}
if (nread < 0)
- error ("IO error reading %s: %s",
- SDATA (orig_filename), emacs_strerror (errno));
+ report_file_error ("Read error", orig_filename);
else if (nread > 0)
{
struct buffer *prev = current_buffer;
/* Rewind the file for the actual read done later. */
if (lseek (fd, 0, SEEK_SET) < 0)
- report_file_error ("Setting file position",
- Fcons (orig_filename, Qnil));
+ report_file_error ("Setting file position", orig_filename);
}
}
if (beg_offset != 0)
{
if (lseek (fd, beg_offset, SEEK_SET) < 0)
- report_file_error ("Setting file position",
- Fcons (orig_filename, Qnil));
+ report_file_error ("Setting file position", orig_filename);
}
immediate_quit = 1;
{
int nread, bufpos;
- nread = emacs_read (fd, buffer, sizeof buffer);
+ nread = emacs_read (fd, read_buf, sizeof read_buf);
if (nread < 0)
- error ("IO error reading %s: %s",
- SSDATA (orig_filename), emacs_strerror (errno));
+ report_file_error ("Read error", orig_filename);
else if (nread == 0)
break;
if (CODING_REQUIRE_DETECTION (&coding))
{
- coding_system = detect_coding_system ((unsigned char *) buffer,
+ coding_system = detect_coding_system ((unsigned char *) read_buf,
nread, nread, 1, 0,
coding_system);
setup_coding_system (coding_system, &coding);
bufpos = 0;
while (bufpos < nread && same_at_start < ZV_BYTE
- && FETCH_BYTE (same_at_start) == buffer[bufpos])
+ && FETCH_BYTE (same_at_start) == read_buf[bufpos])
same_at_start++, bufpos++;
/* If we found a discrepancy, stop the scan.
Otherwise loop around and scan the next bufferful. */
if (curpos == 0)
break;
/* How much can we scan in the next step? */
- trial = min (curpos, sizeof buffer);
+ trial = min (curpos, sizeof read_buf);
if (lseek (fd, curpos - trial, SEEK_SET) < 0)
- report_file_error ("Setting file position",
- Fcons (orig_filename, Qnil));
+ report_file_error ("Setting file position", orig_filename);
total_read = nread = 0;
while (total_read < trial)
{
- nread = emacs_read (fd, buffer + total_read, trial - total_read);
+ nread = emacs_read (fd, read_buf + total_read, trial - total_read);
if (nread < 0)
- error ("IO error reading %s: %s",
- SDATA (orig_filename), emacs_strerror (errno));
+ report_file_error ("Read error", orig_filename);
else if (nread == 0)
break;
total_read += nread;
/* Compare with same_at_start to avoid counting some buffer text
as matching both at the file's beginning and at the end. */
while (bufpos > 0 && same_at_end > same_at_start
- && FETCH_BYTE (same_at_end - 1) == buffer[bufpos - 1])
+ && FETCH_BYTE (same_at_end - 1) == read_buf[bufpos - 1])
same_at_end--, bufpos--;
/* If we found a discrepancy, stop the scan.
/* If display currently starts at beginning of line,
keep it that way. */
- if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
+ if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
replace_handled = 1;
CONVERSION_BUFFER. */
if (lseek (fd, beg_offset, SEEK_SET) < 0)
- report_file_error ("Setting file position",
- Fcons (orig_filename, Qnil));
+ report_file_error ("Setting file position", orig_filename);
- total = st.st_size; /* Total bytes in the file. */
- how_much = 0; /* Bytes read from file so far. */
inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
unprocessed = 0; /* Bytes not processed in previous loop. */
GCPRO1 (conversion_buffer);
- while (how_much < total)
+ while (1)
{
- /* We read one bunch by one (READ_BUF_SIZE bytes) to allow
- quitting while reading a huge while. */
- /* `try'' is reserved in some compilers (Microsoft C). */
- int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed);
+ /* Read at most READ_BUF_SIZE bytes at a time, to allow
+ quitting while reading a huge file. */
/* Allow quitting out of the actual I/O. */
immediate_quit = 1;
QUIT;
- this = emacs_read (fd, read_buf + unprocessed, trytry);
+ this = emacs_read (fd, read_buf + unprocessed,
+ READ_BUF_SIZE - unprocessed);
immediate_quit = 0;
if (this <= 0)
break;
- how_much += this;
-
BUF_TEMP_SET_PT (XBUFFER (conversion_buffer),
BUF_Z (XBUFFER (conversion_buffer)));
decode_coding_c_string (&coding, (unsigned char *) read_buf,
memcpy (read_buf, coding.carryover, unprocessed);
}
UNGCPRO;
- emacs_close (fd);
-
- /* We should remove the unwind_protect calling
- close_file_unwind, but other stuff has been added the stack,
- so defer the removal till we reach the `handled' label. */
- deferred_remove_unwind_protect = 1;
-
- /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
- if we couldn't read the file. */
-
if (this < 0)
- error ("IO error reading %s: %s",
- SDATA (orig_filename), emacs_strerror (errno));
+ report_file_error ("Read error", orig_filename);
+ emacs_close (fd);
+ set_unwind_protect_int (fd_index, -1);
if (unprocessed > 0)
{
if (bufpos == inserted)
{
/* Truncate the buffer to the size of the file. */
- if (same_at_start == same_at_end)
- nochange = 1;
- else
+ if (same_at_start != same_at_end)
del_range_byte (same_at_start, same_at_end, 0);
inserted = 0;
/* If display currently starts at beginning of line,
keep it that way. */
- if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
+ if (XBUFFER (XWINDOW (selected_window)->contents) == current_buffer)
XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
/* Replace the chars that we need to replace,
{
del_range_byte (same_at_start, same_at_end, 0);
temp = GPT;
+ eassert (same_at_start == GPT_BYTE);
same_at_start = GPT_BYTE;
}
else
= buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
same_at_start - BEGV_BYTE
+ BUF_BEG_BYTE (XBUFFER (conversion_buffer)));
+ eassert (same_at_start_charpos == temp - (BEGV - BEG));
inserted_chars
= (buf_bytepos_to_charpos (XBUFFER (conversion_buffer),
same_at_start + inserted - BEGV_BYTE
if (beg_offset != 0 || !NILP (replace))
{
if (lseek (fd, beg_offset, SEEK_SET) < 0)
- report_file_error ("Setting file position",
- Fcons (orig_filename, Qnil));
+ report_file_error ("Setting file position", orig_filename);
}
- /* In the following loop, HOW_MUCH contains the total bytes read
- so far for a regular file, and not changed for a special file. */
+ /* In the following loop, HOW_MUCH contains the total bytes read so
+ far for a regular file, and not changed for a special file. But,
+ before exiting the loop, it is set to a negative value if I/O
+ error occurs. */
how_much = 0;
/* Total bytes inserted. */
inserted = 0;
- /* Here we don't do code conversion in the loop. It is done by
- decode_coding_gap after all data are read into the buffer, or
- reading loop is interrupted with quit or due to I/O error. */
+ /* Here, we don't do code conversion in the loop. It is done by
+ decode_coding_gap after all data are read into the buffer. */
+ {
+ ptrdiff_t gap_size = GAP_SIZE;
- while (how_much < total)
- {
- ptrdiff_t nread, maxread = min (total - how_much, READ_BUF_SIZE);
- Lisp_Object result;
-
- /* For a special file, gap is enlarged as we read,
- so GAP_SIZE should be checked every time. */
- if (not_regular && (GAP_SIZE < maxread))
- make_gap (maxread - GAP_SIZE);
-
- /* Read from the file, capturing `quit'. */
- result = internal_condition_case_1
- (read_contents,
- make_save_value ("iii", (ptrdiff_t) fd, inserted, maxread),
- Qerror, read_contents_quit);
- if (NILP (result))
- {
- /* Quit is signaled. End the loop and arrange
- real quit after decoding the text we read. */
- read_quit = 1;
- break;
- }
- nread = XINT (result);
- if (nread <= 0)
- {
- /* End of file or I/O error. End the loop and
- save error code in case of I/O error. */
- if (nread < 0)
- read_errno = errno;
- break;
- }
+ while (how_much < total)
+ {
+ /* try is reserved in some compilers (Microsoft C) */
+ ptrdiff_t trytry = min (total - how_much, READ_BUF_SIZE);
+ ptrdiff_t this;
- /* Adjust gap and end positions. */
- GAP_SIZE -= nread;
- GPT += nread;
- ZV += nread;
- Z += nread;
- GPT_BYTE += nread;
- ZV_BYTE += nread;
- Z_BYTE += nread;
- if (GAP_SIZE > 0)
- *(GPT_ADDR) = 0;
-
- /* For a regular file, where TOTAL is the real size, count HOW_MUCH to
- compare with it. For a special file, where TOTAL is just a buffer
- size, don't bother counting in HOW_MUCH, but always accumulate the
- number of bytes read in INSERTED. */
- if (!not_regular)
- how_much += nread;
- inserted += nread;
- }
+ if (not_regular)
+ {
+ Lisp_Object nbytes;
+
+ /* Maybe make more room. */
+ if (gap_size < trytry)
+ {
+ make_gap (trytry - gap_size);
+ gap_size = GAP_SIZE - inserted;
+ }
+
+ /* Read from the file, capturing `quit'. When an
+ error occurs, end the loop, and arrange for a quit
+ 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),
+ Qerror, read_non_regular_quit);
+
+ if (NILP (nbytes))
+ {
+ read_quit = 1;
+ break;
+ }
+
+ this = XINT (nbytes);
+ }
+ else
+ {
+ /* Allow quitting out of the actual I/O. We don't make text
+ part of the buffer until all the reading is done, so a C-g
+ here doesn't do any harm. */
+ immediate_quit = 1;
+ QUIT;
+ this = emacs_read (fd,
+ ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
+ + inserted),
+ trytry);
+ immediate_quit = 0;
+ }
+
+ if (this <= 0)
+ {
+ how_much = this;
+ break;
+ }
+
+ gap_size -= this;
+
+ /* For a regular file, where TOTAL is the real size,
+ count HOW_MUCH to compare with it.
+ For a special file, where TOTAL is just a buffer size,
+ so don't bother counting in HOW_MUCH.
+ (INSERTED is where we count the number of characters inserted.) */
+ if (! not_regular)
+ how_much += this;
+ inserted += this;
+ }
+ }
/* Now we have either read all the file data into the gap,
or stop reading on I/O error or quit. If nothing was
Vdeactivate_mark = Qt;
emacs_close (fd);
+ set_unwind_protect_int (fd_index, -1);
- /* Discard the unwind protect for closing the file. */
- specpdl_ptr--;
+ if (how_much < 0)
+ report_file_error ("Read error", orig_filename);
+
+ /* Make the text read part of the buffer. */
+ GAP_SIZE -= inserted;
+ GPT += inserted;
+ GPT_BYTE += inserted;
+ ZV += inserted;
+ ZV_BYTE += inserted;
+ Z += inserted;
+ Z_BYTE += inserted;
+
+ if (GAP_SIZE > 0)
+ /* Put an anchor to ensure multi-byte form ends at gap. */
+ *GPT_ADDR = 0;
notfound:
handled:
- if (deferred_remove_unwind_protect)
- /* If requested above, discard the unwind protect for closing the
- file. */
- specpdl_ptr--;
-
if (!NILP (visit))
{
- if (!EQ (BVAR (current_buffer, undo_list), Qt) && !nochange)
+ if (empty_undo_list_p)
bset_undo_list (current_buffer, Qnil);
if (NILP (handler))
p = XCDR (p);
}
- if (NILP (visit))
+ if (!empty_undo_list_p)
{
bset_undo_list (current_buffer, old_undo);
if (CONSP (old_undo) && inserted != old_inserted)
&& EMACS_NSECS (current_buffer->modtime) == NONEXISTENT_MODTIME_NSECS)
{
/* If visiting nonexistent file, return nil. */
- errno = save_errno;
- report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
+ report_file_errno ("Opening input file", orig_filename, save_errno);
}
- /* There was an error reading file. */
- if (read_errno)
- error ("IO error reading %s: %s",
- SDATA (orig_filename), emacs_strerror (read_errno));
-
- /* Quit was signaled. */
if (read_quit)
Fsignal (Qquit, Qnil);
+ /* Retval needs to be dealt with in all cases consistently. */
if (NILP (val))
val = list2 (orig_filename, make_number (inserted));
\f
static Lisp_Object build_annotations (Lisp_Object, Lisp_Object);
-static Lisp_Object
+static void
build_annotations_unwind (Lisp_Object arg)
{
Vwrite_region_annotation_buffers = arg;
- return Qnil;
}
/* Decide the coding-system to encode the data with. */
-static Lisp_Object
-choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
- Lisp_Object append, Lisp_Object visit, Lisp_Object lockname,
- struct coding_system *coding)
+DEFUN ("choose-write-coding-system", Fchoose_write_coding_system,
+ Schoose_write_coding_system, 3, 6, 0,
+ doc: /* Choose the coding system for writing a file.
+Arguments are as for `write-region'.
+This function is for internal use only. It may prompt the user. */ )
+ (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
+ Lisp_Object append, Lisp_Object visit, Lisp_Object lockname)
{
Lisp_Object val;
Lisp_Object eol_parent = Qnil;
+ /* Mimic write-region behavior. */
+ if (NILP (start))
+ {
+ XSETFASTINT (start, BEGV);
+ XSETFASTINT (end, ZV);
+ }
+
if (auto_saving
&& NILP (Fstring_equal (BVAR (current_buffer, filename),
BVAR (current_buffer, auto_save_file_name))))
&& !NILP (Ffboundp (Vselect_safe_coding_system_function)))
/* Confirm that VAL can surely encode the current region. */
val = call5 (Vselect_safe_coding_system_function,
- start, end, Fcons (Qt, Fcons (val, Qnil)),
+ start, end, list2 (Qt, val),
Qnil, filename);
}
else
}
val = coding_inherit_eol_type (val, eol_parent);
- setup_coding_system (val, coding);
-
- if (!STRINGP (start) && !NILP (BVAR (current_buffer, selective_display)))
- coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
return val;
}
instead of any buffer contents; END is ignored.
Optional fourth argument APPEND if non-nil means
- append to existing file contents (if any). If it is an integer,
+ append to existing file contents (if any). If it is a number,
seek to that offset in the file before writing.
Optional fifth argument VISIT, if t or a string, means
set the last-save-file-modtime of buffer to this file's modtime
(Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append, Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew)
{
int desc;
+ int open_flags;
+ int mode;
+ off_t offset IF_LINT (= 0);
bool ok;
int save_errno = 0;
const char *fn;
struct stat st;
EMACS_TIME modtime;
ptrdiff_t count = SPECPDL_INDEX ();
- int count1;
+ ptrdiff_t count1;
Lisp_Object handler;
Lisp_Object visit_file;
Lisp_Object annotations;
record_unwind_protect (build_annotations_unwind,
Vwrite_region_annotation_buffers);
- Vwrite_region_annotation_buffers = Fcons (Fcurrent_buffer (), Qnil);
+ Vwrite_region_annotation_buffers = list1 (Fcurrent_buffer ());
count1 = SPECPDL_INDEX ();
given_buffer = current_buffer;
We used to make this choice before calling build_annotations, but that
leads to problems when a write-annotate-function takes care of
unsavable chars (as was the case with X-Symbol). */
- Vlast_coding_system_used
- = choose_write_coding_system (start, end, filename,
- append, visit, lockname, &coding);
+ Vlast_coding_system_used =
+ Fchoose_write_coding_system (start, end, filename,
+ append, visit, lockname);
+
+ setup_coding_system (Vlast_coding_system_used, &coding);
+
+ if (!STRINGP (start) && !NILP (BVAR (current_buffer, selective_display)))
+ coding.mode |= CODING_MODE_SELECTIVE_DISPLAY;
#ifdef CLASH_DETECTION
if (!auto_saving)
#endif /* CLASH_DETECTION */
encoded_filename = ENCODE_FILE (filename);
-
fn = SSDATA (encoded_filename);
- desc = -1;
- if (!NILP (append))
+ open_flags = O_WRONLY | O_BINARY | O_CREAT;
+ open_flags |= EQ (mustbenew, Qexcl) ? O_EXCL : !NILP (append) ? 0 : O_TRUNC;
+ if (NUMBERP (append))
+ offset = file_offset (append);
+ else if (!NILP (append))
+ open_flags |= O_APPEND;
#ifdef DOS_NT
- desc = emacs_open (fn, O_WRONLY | O_BINARY, 0);
-#else /* not DOS_NT */
- desc = emacs_open (fn, O_WRONLY, 0);
-#endif /* not DOS_NT */
+ mode = S_IREAD | S_IWRITE;
+#else
+ mode = auto_saving ? auto_save_mode_bits : 0666;
+#endif
- if (desc < 0 && (NILP (append) || errno == ENOENT))
-#ifdef DOS_NT
- desc = emacs_open (fn,
- O_WRONLY | O_CREAT | O_BINARY
- | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC),
- S_IREAD | S_IWRITE);
-#else /* not DOS_NT */
- desc = emacs_open (fn, O_WRONLY | O_TRUNC | O_CREAT
- | (EQ (mustbenew, Qexcl) ? O_EXCL : 0),
- auto_saving ? auto_save_mode_bits : 0666);
-#endif /* not DOS_NT */
+ desc = emacs_open (fn, open_flags, mode);
if (desc < 0)
{
+ int open_errno = errno;
#ifdef CLASH_DETECTION
- save_errno = errno;
if (!auto_saving) unlock_file (lockname);
- errno = save_errno;
#endif /* CLASH_DETECTION */
UNGCPRO;
- report_file_error ("Opening output file", Fcons (filename, Qnil));
+ report_file_errno ("Opening output file", filename, open_errno);
}
- record_unwind_protect (close_file_unwind, make_number (desc));
+ record_unwind_protect_int (close_file_unwind, desc);
- if (!NILP (append) && !NILP (Ffile_regular_p (filename)))
+ if (NUMBERP (append))
{
- off_t ret;
-
- if (NUMBERP (append))
- ret = emacs_lseek (desc, XINT (append), SEEK_CUR);
- else
- ret = lseek (desc, 0, SEEK_END);
+ off_t ret = lseek (desc, offset, SEEK_SET);
if (ret < 0)
{
+ int lseek_errno = errno;
#ifdef CLASH_DETECTION
- save_errno = errno;
if (!auto_saving) unlock_file (lockname);
- errno = save_errno;
#endif /* CLASH_DETECTION */
UNGCPRO;
- report_file_error ("Lseek error", Fcons (filename, Qnil));
+ report_file_errno ("Lseek error", filename, lseek_errno);
}
}
immediate_quit = 0;
-#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. */
- /* mib says that closing the file will try to write as fast as NFS can do
- it, and that means the fsync here is not crucial for autosave files. */
- if (!auto_saving && !write_region_inhibit_fsync && fsync (desc) < 0)
+ /* fsync is not crucial for auto-save files, since they might lose
+ some work anyway. */
+ if (!auto_saving && !write_region_inhibit_fsync)
{
- /* If fsync fails with EINTR, don't treat that as serious. Also
- ignore EINVAL which happens when fsync is not supported on this
- file. */
- if (errno != EINTR && errno != EINVAL)
- ok = 0, save_errno = errno;
+ /* Transfer data and metadata to disk, retrying if interrupted.
+ fsync can report a write failure here, e.g., due to disk full
+ under NFS. But ignore EINVAL, which means fsync is not
+ supported on this file. */
+ while (fsync (desc) != 0)
+ if (errno != EINTR)
+ {
+ if (errno != EINVAL)
+ ok = 0, save_errno = errno;
+ break;
+ }
}
-#endif
modtime = invalid_emacs_time ();
if (visiting)
if (EMACS_TIME_VALID_P (modtime)
&& ! (valid_timestamp_file_system && st.st_dev == timestamp_file_system))
{
- int desc1 = emacs_open (fn, O_WRONLY, 0);
- if (0 <= desc1)
+ int desc1 = emacs_open (fn, O_WRONLY | O_BINARY, 0);
+ if (desc1 >= 0)
{
struct stat st1;
if (fstat (desc1, &st1) == 0
&& st.st_dev == st1.st_dev && st.st_ino == st1.st_ino)
{
+ /* Use the heuristic if it appears to be valid. With neither
+ O_EXCL nor O_TRUNC, if Emacs happened to write nothing to the
+ file, the time stamp won't change. Also, some non-POSIX
+ systems don't update an empty file's time stamp when
+ truncating it. Finally, file systems with 100 ns or worse
+ resolution sometimes seem to have bugs: on a system with ns
+ resolution, checking ns % 100 incorrectly avoids the heuristic
+ 1% of the time, but the problem should be temporary as we will
+ try again on the next time stamp. */
+ bool use_heuristic
+ = ((open_flags & (O_EXCL | O_TRUNC)) != 0
+ && st.st_size != 0
+ && EMACS_NSECS (modtime) % 100 != 0);
+
EMACS_TIME modtime1 = get_stat_mtime (&st1);
- if (EMACS_TIME_EQ (modtime, modtime1)
+ if (use_heuristic
+ && EMACS_TIME_EQ (modtime, modtime1)
&& st.st_size == st1.st_size)
{
timestamp_file_system = st.st_dev;
}
if (! ok)
- error ("IO error writing %s: %s", SDATA (filename),
- emacs_strerror (save_errno));
+ report_file_errno ("Write error", filename, save_errno);
if (visiting)
{
}
if (!auto_saving)
- message_with_string ((INTEGERP (append)
+ message_with_string ((NUMBERP (append)
? "Updated %s"
: ! NILP (append)
? "Added to %s"
if (coding->produced > 0)
{
- coding->produced
- -= emacs_write (desc,
- STRINGP (coding->dst_object)
- ? SSDATA (coding->dst_object)
- : (char *) BYTE_POS_ADDR (coding->dst_pos_byte),
- coding->produced);
+ char *buf = (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->produced)
return 0;
return Qnil;
}
-DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime,
- Sclear_visited_file_modtime, 0, 0, 0,
- doc: /* Clear out records of last mod time of visited file.
-Next attempt to save will certainly not complain of a discrepancy. */)
- (void)
-{
- current_buffer->modtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS);
- current_buffer->modtime_size = -1;
- return Qnil;
-}
-
DEFUN ("visited-file-modtime", Fvisited_file_modtime,
Svisited_file_modtime, 0, 0, 0,
doc: /* Return the current buffer's recorded visited file modification time.
The value is a list of the form (HIGH LOW USEC PSEC), like the time values that
`file-attributes' returns. If the current buffer has no recorded file
modification time, this function returns 0. If the visited file
-doesn't exist, HIGH will be -1.
+doesn't exist, return -1.
See Info node `(elisp)Modification Time' for more details. */)
(void)
{
- if (EMACS_NSECS (current_buffer->modtime) < 0)
- {
- if (EMACS_NSECS (current_buffer->modtime) == NONEXISTENT_MODTIME_NSECS)
- {
- /* make_lisp_time won't work here if time_t is unsigned. */
- return list4 (make_number (-1), make_number (65535),
- make_number (0), make_number (0));
- }
- return make_number (0);
- }
+ int ns = EMACS_NSECS (current_buffer->modtime);
+ if (ns < 0)
+ return make_number (UNKNOWN_MODTIME_NSECS - ns);
return make_lisp_time (current_buffer->modtime);
}
or if the file itself has been changed for some known benign reason.
An argument specifies the modification time value to use
\(instead of that of the visited file), in the form of a list
-\(HIGH LOW USEC PSEC) as returned by `current-time'. */)
- (Lisp_Object time_list)
+\(HIGH LOW USEC PSEC) or an integer flag as returned by
+`visited-file-modtime'. */)
+ (Lisp_Object time_flag)
{
- if (!NILP (time_list))
+ if (!NILP (time_flag))
{
- current_buffer->modtime = lisp_time_argument (time_list);
+ EMACS_TIME mtime;
+ if (INTEGERP (time_flag))
+ {
+ CHECK_RANGED_INTEGER (time_flag, -1, 0);
+ mtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS - XINT (time_flag));
+ }
+ else
+ mtime = lisp_time_argument (time_flag);
+
+ current_buffer->modtime = mtime;
current_buffer->modtime_size = -1;
}
else
auto_save_error (Lisp_Object error_val)
{
Lisp_Object args[3], msg;
- int i, nbytes;
+ int i;
struct gcpro gcpro1;
- char *msgbuf;
- USE_SAFE_ALLOCA;
auto_save_error_occurred = 1;
args[2] = Ferror_message_string (error_val);
msg = Fformat (3, args);
GCPRO1 (msg);
- nbytes = SBYTES (msg);
- msgbuf = SAFE_ALLOCA (nbytes);
- memcpy (msgbuf, SDATA (msg), nbytes);
for (i = 0; i < 3; ++i)
{
if (i == 0)
- message2 (msgbuf, nbytes, STRING_MULTIBYTE (msg));
+ message3 (msg);
else
- message2_nolog (msgbuf, nbytes, STRING_MULTIBYTE (msg));
+ message3_nolog (msg);
Fsleep_for (make_number (1), Qnil);
}
- SAFE_FREE ();
UNGCPRO;
return Qnil;
}
Qnil, Qnil);
}
-static Lisp_Object
-do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */
+struct auto_save_unwind
+{
+ FILE *stream;
+ bool auto_raise;
+};
+static void
+do_auto_save_unwind (void *arg)
{
- FILE *stream = XSAVE_POINTER (arg, 0);
+ struct auto_save_unwind *p = arg;
+ FILE *stream = p->stream;
+ minibuffer_auto_raise = p->auto_raise;
auto_saving = 0;
if (stream != NULL)
{
fclose (stream);
unblock_input ();
}
- return Qnil;
-}
-
-static Lisp_Object
-do_auto_save_unwind_1 (Lisp_Object value) /* used as unwind-protect function */
-
-{
- minibuffer_auto_raise = XINT (value);
- return Qnil;
}
static Lisp_Object
ptrdiff_t count = SPECPDL_INDEX ();
bool orig_minibuffer_auto_raise = minibuffer_auto_raise;
bool old_message_p = 0;
+ struct auto_save_unwind auto_save_unwind;
struct gcpro gcpro1, gcpro2;
if (max_specpdl_size < specpdl_size + 40)
if (NILP (no_message))
{
old_message_p = push_message ();
- record_unwind_protect (pop_message_unwind, Qnil);
+ record_unwind_protect_void (pop_message_unwind);
}
/* Ordinarily don't quit within this function,
point to non-strings reached from Vbuffer_alist. */
hook = intern ("auto-save-hook");
- Frun_hooks (1, &hook);
+ safe_run_hooks (hook);
if (STRINGP (Vauto_save_list_file_name))
{
UNGCPRO;
}
- stream = fopen (SSDATA (listfile), "w");
+ stream = emacs_fopen (SSDATA (listfile), "w");
}
- record_unwind_protect (do_auto_save_unwind,
- make_save_pointer (stream));
- record_unwind_protect (do_auto_save_unwind_1,
- make_number (minibuffer_auto_raise));
+ auto_save_unwind.stream = stream;
+ auto_save_unwind.auto_raise = minibuffer_auto_raise;
+ record_unwind_protect_ptr (do_auto_save_unwind, &auto_save_unwind);
minibuffer_auto_raise = 0;
auto_saving = 1;
auto_save_error_occurred = 0;
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
&& use_dialog_box
&& use_file_dialog
- && have_menus_p ())
+ && window_system_available (SELECTED_FRAME ()))
return Qt;
#endif
return Qnil;
DEFSYM (Qset_file_acl, "set-file-acl");
DEFSYM (Qfile_newer_than_file_p, "file-newer-than-file-p");
DEFSYM (Qinsert_file_contents, "insert-file-contents");
+ DEFSYM (Qchoose_write_coding_system, "choose-write-coding-system");
DEFSYM (Qwrite_region, "write-region");
DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime");
DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime");
DEFSYM (Qfile_error, "file-error");
DEFSYM (Qfile_already_exists, "file-already-exists");
DEFSYM (Qfile_date_error, "file-date-error");
+ DEFSYM (Qfile_notify_error, "file-notify-error");
DEFSYM (Qexcl, "excl");
DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system,
Fput (Qfile_date_error, Qerror_message,
build_pure_c_string ("Cannot set file date"));
+ Fput (Qfile_notify_error, Qerror_conditions,
+ Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror)));
+ Fput (Qfile_notify_error, Qerror_message,
+ build_pure_c_string ("File notification error"));
+
DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist,
doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
If a file name matches REGEXP, all I/O on that file is done by calling
file is usually more useful if it contains the deleted text. */);
Vauto_save_include_big_deletions = Qnil;
-#ifdef HAVE_FSYNC
+ /* 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.
-A non-nil value may result in data loss! */);
- write_region_inhibit_fsync = 0;
-#endif
+Setting this to nil may avoid data loss if the system loses power or
+the operating system crashes. */);
+ write_region_inhibit_fsync = noninteractive;
DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash,
doc: /* Specifies whether to use the system's trash can.
defsubr (&Sdefault_file_modes);
defsubr (&Sfile_newer_than_file_p);
defsubr (&Sinsert_file_contents);
+ defsubr (&Schoose_write_coding_system);
defsubr (&Swrite_region);
defsubr (&Scar_less_than_car);
defsubr (&Sverify_visited_file_modtime);
- defsubr (&Sclear_visited_file_modtime);
defsubr (&Svisited_file_modtime);
defsubr (&Sset_visited_file_modtime);
defsubr (&Sdo_auto_save);