summaryrefslogtreecommitdiff
path: root/src/fileio.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/fileio.c')
-rw-r--r--src/fileio.c336
1 files changed, 220 insertions, 116 deletions
diff --git a/src/fileio.c b/src/fileio.c
index e2be7fe2c69..7fb865809f5 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -96,6 +96,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <acl.h>
#include <allocator.h>
#include <careadlinkat.h>
+#include <fsusage.h>
#include <stat-time.h>
#include <tempname.h>
@@ -138,7 +139,7 @@ static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
struct coding_system *);
-/* Return true if FILENAME exists. */
+/* Return true if FILENAME exists, otherwise return false and set errno. */
static bool
check_existing (const char *filename)
@@ -231,6 +232,7 @@ report_file_error (char const *string, Lisp_Object name)
report_file_errno (string, name, errno);
}
+#ifdef USE_FILE_NOTIFY
/* Like report_file_error, but reports a file-notify-error instead. */
void
@@ -245,6 +247,7 @@ report_file_notify_error (const char *string, Lisp_Object name)
xsignal (Qfile_notify_error, Fcons (build_string (string), errdata));
}
+#endif
void
close_file_unwind (int fd)
@@ -688,7 +691,7 @@ This function does not grok magic file names. */)
memset (data + prefix_len, 'X', nX);
memcpy (data + prefix_len + nX, SSDATA (encoded_suffix), suffix_len);
int kind = (NILP (dir_flag) ? GT_FILE
- : EQ (dir_flag, make_number (0)) ? GT_NOCREATE
+ : EQ (dir_flag, make_fixnum (0)) ? GT_NOCREATE
: GT_DIR);
int fd = gen_tempname (data, suffix_len, O_BINARY | O_CLOEXEC, kind);
bool failed = fd < 0;
@@ -729,7 +732,7 @@ later creating the file, which opens all kinds of security holes.
For that reason, you should normally use `make-temp-file' instead. */)
(Lisp_Object prefix)
{
- return Fmake_temp_file_internal (prefix, make_number (0),
+ return Fmake_temp_file_internal (prefix, make_fixnum (0),
empty_unibyte_string, Qnil);
}
@@ -818,17 +821,14 @@ the root directory. */)
#endif
}
- if (!NILP (default_directory))
+ handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
+ if (!NILP (handler))
{
- handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
- if (!NILP (handler))
- {
- handled_name = call3 (handler, Qexpand_file_name,
- name, default_directory);
- if (STRINGP (handled_name))
- return handled_name;
- error ("Invalid handler in `file-name-handler-alist'");
- }
+ handled_name = call3 (handler, Qexpand_file_name,
+ name, default_directory);
+ if (STRINGP (handled_name))
+ return handled_name;
+ error ("Invalid handler in `file-name-handler-alist'");
}
{
@@ -1945,9 +1945,9 @@ permissions. */)
#ifdef WINDOWSNT
if (NILP (ok_if_already_exists)
- || INTEGERP (ok_if_already_exists))
+ || FIXNUMP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, false, "copy to it",
- INTEGERP (ok_if_already_exists), false);
+ FIXNUMP (ok_if_already_exists), false);
result = w32_copy_file (SSDATA (encoded_file), SSDATA (encoded_newname),
!NILP (keep_time), !NILP (preserve_uid_gid),
@@ -2002,9 +2002,9 @@ permissions. */)
new_mask);
if (ofd < 0 && errno == EEXIST)
{
- if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists))
+ if (NILP (ok_if_already_exists) || FIXNUMP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, true, "copy to it",
- INTEGERP (ok_if_already_exists), false);
+ FIXNUMP (ok_if_already_exists), false);
already_exists = true;
ofd = emacs_open (SSDATA (encoded_newname), O_WRONLY, 0);
}
@@ -2296,6 +2296,21 @@ The arg must be a string. */)
if (!NILP (handler))
return call2 (handler, Qfile_name_case_insensitive_p, filename);
+ /* If the file doesn't exist, move up the filesystem tree until we
+ reach an existing directory or the root. */
+ if (NILP (Ffile_exists_p (filename)))
+ {
+ filename = Ffile_name_directory (filename);
+ while (NILP (Ffile_exists_p (filename)))
+ {
+ Lisp_Object newname = expand_and_dir_to_file (filename);
+ /* Avoid infinite loop if the root is reported as non-existing
+ (impossible?). */
+ if (!NILP (Fstring_equal (newname, filename)))
+ break;
+ filename = newname;
+ }
+ }
filename = ENCODE_FILE (filename);
return file_name_case_insensitive_p (SSDATA (filename)) ? Qt : Qnil;
}
@@ -2350,7 +2365,7 @@ This is what happens in interactive use with M-x. */)
bool plain_rename = (case_only_rename
|| (!NILP (ok_if_already_exists)
- && !INTEGERP (ok_if_already_exists)));
+ && !FIXNUMP (ok_if_already_exists)));
int rename_errno UNINIT;
if (!plain_rename)
{
@@ -2368,7 +2383,7 @@ This is what happens in interactive use with M-x. */)
#endif
barf_or_query_if_file_exists (newname, rename_errno == EEXIST,
"rename to it",
- INTEGERP (ok_if_already_exists),
+ FIXNUMP (ok_if_already_exists),
false);
plain_rename = true;
break;
@@ -2461,9 +2476,9 @@ This is what happens in interactive use with M-x. */)
if (errno == EEXIST)
{
if (NILP (ok_if_already_exists)
- || INTEGERP (ok_if_already_exists))
+ || FIXNUMP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, true, "make it a new name",
- INTEGERP (ok_if_already_exists), false);
+ FIXNUMP (ok_if_already_exists), false);
unlink (SSDATA (newname));
if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
return Qnil;
@@ -2489,12 +2504,12 @@ This happens for interactive use with M-x. */)
Lisp_Object encoded_target, encoded_linkname;
CHECK_STRING (target);
- if (INTEGERP (ok_if_already_exists))
+ if (FIXNUMP (ok_if_already_exists))
{
if (SREF (target, 0) == '~')
target = Fexpand_file_name (target, Qnil);
else if (SREF (target, 0) == '/' && SREF (target, 1) == ':')
- target = Fsubstring_no_properties (target, make_number (2), Qnil);
+ target = Fsubstring_no_properties (target, make_fixnum (2), Qnil);
}
linkname = expand_cp_target (target, linkname);
@@ -2518,9 +2533,9 @@ This happens for interactive use with M-x. */)
if (errno == EEXIST)
{
if (NILP (ok_if_already_exists)
- || INTEGERP (ok_if_already_exists))
+ || FIXNUMP (ok_if_already_exists))
barf_or_query_if_file_exists (linkname, true, "make it a link",
- INTEGERP (ok_if_already_exists), false);
+ FIXNUMP (ok_if_already_exists), false);
unlink (SSDATA (encoded_linkname));
if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0)
return Qnil;
@@ -2647,7 +2662,7 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
/* The read-only attribute of the parent directory doesn't affect
whether a file or directory can be created within it. Some day we
should check ACLs though, which do affect this. */
- return file_directory_p (SSDATA (dir)) ? Qt : Qnil;
+ return file_directory_p (dir) ? Qt : Qnil;
#else
return check_writable (SSDATA (dir), W_OK | X_OK) ? Qt : Qnil;
#endif
@@ -2741,19 +2756,47 @@ See `file-symlink-p' to distinguish symlinks. */)
absname = ENCODE_FILE (absname);
- return file_directory_p (SSDATA (absname)) ? Qt : Qnil;
+ return file_directory_p (absname) ? Qt : Qnil;
}
-/* Return true if FILE is a directory or a symlink to a directory. */
+/* Return true if FILE is a directory or a symlink to a directory.
+ Otherwise return false and set errno. */
bool
-file_directory_p (char const *file)
+file_directory_p (Lisp_Object file)
{
-#ifdef WINDOWSNT
+#ifdef DOS_NT
/* This is cheaper than 'stat'. */
- return faccessat (AT_FDCWD, file, D_OK, AT_EACCESS) == 0;
+ return faccessat (AT_FDCWD, SSDATA (file), D_OK, AT_EACCESS) == 0;
#else
+# ifdef O_PATH
+ /* Use O_PATH if available, as it avoids races and EOVERFLOW issues. */
+ int fd = openat (AT_FDCWD, SSDATA (file), O_PATH | O_CLOEXEC | O_DIRECTORY);
+ if (0 <= fd)
+ {
+ emacs_close (fd);
+ return true;
+ }
+ if (errno != EINVAL)
+ return false;
+ /* O_PATH is defined but evidently this Linux kernel predates 2.6.39.
+ Fall back on generic POSIX code. */
+# endif
+ /* Use file_accessible_directory, as it avoids stat EOVERFLOW
+ problems and could be cheaper. However, if it fails because FILE
+ is inaccessible, fall back on stat; if the latter fails with
+ EOVERFLOW then FILE must have been a directory unless a race
+ condition occurred (a problem hard to work around portably). */
+ if (file_accessible_directory_p (file))
+ return true;
+ if (errno != EACCES)
+ return false;
struct stat st;
- return stat (file, &st) == 0 && S_ISDIR (st.st_mode);
+ if (stat (SSDATA (file), &st) != 0)
+ return errno == EOVERFLOW;
+ if (S_ISDIR (st.st_mode))
+ return true;
+ errno = ENOTDIR;
+ return false;
#endif
}
@@ -2814,7 +2857,7 @@ file_accessible_directory_p (Lisp_Object file)
return (SBYTES (file) == 0
|| w32_accessible_directory_p (SSDATA (file), SBYTES (file)));
# else /* MSDOS */
- return file_directory_p (SSDATA (file));
+ return file_directory_p (file);
# endif /* MSDOS */
#else /* !DOS_NT */
/* On POSIXish platforms, use just one system call; this avoids a
@@ -2835,12 +2878,15 @@ file_accessible_directory_p (Lisp_Object file)
dir = data;
else
{
- /* Just check for trailing '/' when deciding whether to append '/'.
- That's simpler than testing the two special cases "/" and "//",
- and it's a safe optimization here. */
- char *buf = SAFE_ALLOCA (len + 3);
+ /* Just check for trailing '/' when deciding whether append '/'
+ before appending '.'. That's simpler than testing the two
+ special cases "/" and "//", and it's a safe optimization
+ here. After appending '.', append another '/' to work around
+ a macOS bug (Bug#30350). */
+ static char const appended[] = "/./";
+ char *buf = SAFE_ALLOCA (len + sizeof appended);
memcpy (buf, data, len);
- strcpy (buf + len, &"/."[data[len - 1] == '/']);
+ strcpy (buf + len, &appended[data[len - 1] == '/']);
dir = buf;
}
@@ -3145,7 +3191,7 @@ Return nil, if file does not exist or is not accessible. */)
if (stat (SSDATA (absname), &st) < 0)
return Qnil;
- return make_number (st.st_mode & 07777);
+ return make_fixnum (st.st_mode & 07777);
}
DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2,
@@ -3162,7 +3208,7 @@ symbolic notation, like the `chmod' command from GNU Coreutils. */)
Lisp_Object handler;
absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
- CHECK_NUMBER (mode);
+ CHECK_FIXNUM (mode);
/* If the file name has special constructs in it,
call the corresponding file handler. */
@@ -3172,7 +3218,7 @@ symbolic notation, like the `chmod' command from GNU Coreutils. */)
encoded_absname = ENCODE_FILE (absname);
- if (chmod (SSDATA (encoded_absname), XINT (mode) & 07777) < 0)
+ if (chmod (SSDATA (encoded_absname), XFIXNUM (mode) & 07777) < 0)
report_file_error ("Doing chmod", absname);
return Qnil;
@@ -3193,9 +3239,9 @@ by having the corresponding bit in the mask reset. */)
(Lisp_Object mode)
{
mode_t oldrealmask, oldumask, newumask;
- CHECK_NUMBER (mode);
+ CHECK_FIXNUM (mode);
oldrealmask = realmask;
- newumask = ~ XINT (mode) & 0777;
+ newumask = ~ XFIXNUM (mode) & 0777;
block_input ();
realmask = newumask;
@@ -3244,7 +3290,7 @@ Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
{
#ifdef MSDOS
/* Setting times on a directory always fails. */
- if (file_directory_p (SSDATA (encoded_absname)))
+ if (file_directory_p (encoded_absname))
return Qnil;
#endif
report_file_error ("Setting file times", absname);
@@ -3339,21 +3385,28 @@ decide_coding_unwind (Lisp_Object unwind_data)
bset_undo_list (current_buffer, undo_list);
}
-/* 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. */
+/* Read from a non-regular file. Return the number of bytes read. */
+
+union read_non_regular
+{
+ struct
+ {
+ int fd;
+ ptrdiff_t inserted, trytry;
+ } s;
+ GCALIGNED_UNION_MEMBER
+};
+verify (GCALIGNED (union read_non_regular));
static Lisp_Object
read_non_regular (Lisp_Object state)
{
- int nbytes = emacs_read_quit (XSAVE_INTEGER (state, 0),
+ union read_non_regular *data = XFIXNUMPTR (state);
+ int nbytes = emacs_read_quit (data->s.fd,
((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
- + XSAVE_INTEGER (state, 1)),
- XSAVE_INTEGER (state, 2));
- /* Fast recycle this object for the likely next call. */
- free_misc (state);
- return make_number (nbytes);
+ + data->s.inserted),
+ data->s.trytry);
+ return make_fixnum (nbytes);
}
@@ -3371,10 +3424,13 @@ read_non_regular_quit (Lisp_Object ignore)
static off_t
file_offset (Lisp_Object val)
{
- if (RANGED_INTEGERP (0, val, TYPE_MAXIMUM (off_t)))
- return XINT (val);
-
- if (FLOATP (val))
+ if (INTEGERP (val))
+ {
+ intmax_t v;
+ if (integer_to_intmax (val, &v) && 0 <= v && v <= TYPE_MAXIMUM (off_t))
+ return v;
+ }
+ else if (FLOATP (val))
{
double v = XFLOAT_DATA (val);
if (0 <= v && v < 1.0 + TYPE_MAXIMUM (off_t))
@@ -3431,16 +3487,16 @@ restore_window_points (Lisp_Object window_markers, ptrdiff_t inserted,
Lisp_Object car = XCAR (window_markers);
Lisp_Object marker = XCAR (car);
Lisp_Object oldpos = XCDR (car);
- if (MARKERP (marker) && INTEGERP (oldpos)
- && XINT (oldpos) > same_at_start
- && XINT (oldpos) < same_at_end)
+ if (MARKERP (marker) && FIXNUMP (oldpos)
+ && XFIXNUM (oldpos) > same_at_start
+ && XFIXNUM (oldpos) < same_at_end)
{
ptrdiff_t oldsize = same_at_end - same_at_start;
ptrdiff_t newsize = inserted;
double growth = newsize / (double)oldsize;
ptrdiff_t newpos
- = same_at_start + growth * (XINT (oldpos) - same_at_start);
- Fset_marker (marker, make_number (newpos), Qnil);
+ = same_at_start + growth * (XFIXNUM (oldpos) - same_at_start);
+ Fset_marker (marker, make_fixnum (newpos), Qnil);
}
}
}
@@ -3553,8 +3609,8 @@ by calling `format-decode', which see. */)
val = call6 (handler, Qinsert_file_contents, filename,
visit, beg, end, replace);
if (CONSP (val) && CONSP (XCDR (val))
- && RANGED_INTEGERP (0, XCAR (XCDR (val)), ZV - PT))
- inserted = XINT (XCAR (XCDR (val)));
+ && RANGED_FIXNUMP (0, XCAR (XCDR (val)), ZV - PT))
+ inserted = XFIXNUM (XCAR (XCDR (val)));
goto handled;
}
@@ -3739,7 +3795,7 @@ by calling `format-decode', which see. */)
insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0);
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
coding_system = call2 (Vset_auto_coding_function,
- filename, make_number (nread));
+ filename, make_fixnum (nread));
set_buffer_internal (prev);
/* Discard the unwind protect for recovering the
@@ -4207,9 +4263,9 @@ by calling `format-decode', which see. */)
/* 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. */
+ union read_non_regular data = {{fd, inserted, trytry}};
nbytes = internal_condition_case_1
- (read_non_regular,
- make_save_int_int_int (fd, inserted, trytry),
+ (read_non_regular, make_pointer_integer (&data),
Qerror, read_non_regular_quit);
if (NILP (nbytes))
@@ -4218,7 +4274,7 @@ by calling `format-decode', which see. */)
break;
}
- this = XINT (nbytes);
+ this = XFIXNUM (nbytes);
}
else
{
@@ -4314,7 +4370,7 @@ by calling `format-decode', which see. */)
if (inserted > 0 && ! NILP (Vset_auto_coding_function))
{
coding_system = call2 (Vset_auto_coding_function,
- filename, make_number (inserted));
+ filename, make_fixnum (inserted));
}
if (NILP (coding_system))
@@ -4433,13 +4489,13 @@ by calling `format-decode', which see. */)
if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
{
- insval = call2 (Qafter_insert_file_set_coding, make_number (inserted),
+ insval = call2 (Qafter_insert_file_set_coding, make_fixnum (inserted),
visit);
if (! NILP (insval))
{
- if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ if (! RANGED_FIXNUMP (0, insval, ZV - PT))
wrong_type_argument (intern ("inserted-chars"), insval);
- inserted = XFASTINT (insval);
+ inserted = XFIXNAT (insval);
}
}
@@ -4459,10 +4515,10 @@ by calling `format-decode', which see. */)
if (NILP (replace))
{
insval = call3 (Qformat_decode,
- Qnil, make_number (inserted), visit);
- if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ Qnil, make_fixnum (inserted), visit);
+ if (! RANGED_FIXNUMP (0, insval, ZV - PT))
wrong_type_argument (intern ("inserted-chars"), insval);
- inserted = XFASTINT (insval);
+ inserted = XFIXNAT (insval);
}
else
{
@@ -4482,8 +4538,8 @@ by calling `format-decode', which see. */)
TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
insval = call3 (Qformat_decode,
- Qnil, make_number (oinserted), visit);
- if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ Qnil, make_fixnum (oinserted), visit);
+ if (! RANGED_FIXNUMP (0, insval, ZV - PT))
wrong_type_argument (intern ("inserted-chars"), insval);
if (ochars_modiff == CHARS_MODIFF)
/* format_decode didn't modify buffer's characters => move
@@ -4493,7 +4549,7 @@ by calling `format-decode', which see. */)
else
/* format_decode modified buffer's characters => consider
entire buffer changed and leave point at point-min. */
- inserted = XFASTINT (insval);
+ inserted = XFIXNAT (insval);
}
/* For consistency with format-decode call these now iff inserted > 0
@@ -4503,12 +4559,12 @@ by calling `format-decode', which see. */)
{
if (NILP (replace))
{
- insval = call1 (XCAR (p), make_number (inserted));
+ insval = call1 (XCAR (p), make_fixnum (inserted));
if (!NILP (insval))
{
- if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ if (! RANGED_FIXNUMP (0, insval, ZV - PT))
wrong_type_argument (intern ("inserted-chars"), insval);
- inserted = XFASTINT (insval);
+ inserted = XFIXNAT (insval);
}
}
else
@@ -4521,10 +4577,10 @@ by calling `format-decode', which see. */)
EMACS_INT ochars_modiff = CHARS_MODIFF;
TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
- insval = call1 (XCAR (p), make_number (oinserted));
+ insval = call1 (XCAR (p), make_fixnum (oinserted));
if (!NILP (insval))
{
- if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ if (! RANGED_FIXNUMP (0, insval, ZV - PT))
wrong_type_argument (intern ("inserted-chars"), insval);
if (ochars_modiff == CHARS_MODIFF)
/* after_insert_file_functions didn't modify
@@ -4536,7 +4592,7 @@ by calling `format-decode', which see. */)
/* after_insert_file_functions did modify buffer's
characters => consider entire buffer changed and
leave point at point-min. */
- inserted = XFASTINT (insval);
+ inserted = XFIXNAT (insval);
}
}
@@ -4552,10 +4608,10 @@ by calling `format-decode', which see. */)
/* Adjust the last undo record for the size change during
the format conversion. */
Lisp_Object tem = XCAR (old_undo);
- if (CONSP (tem) && INTEGERP (XCAR (tem))
- && INTEGERP (XCDR (tem))
- && XFASTINT (XCDR (tem)) == PT + old_inserted)
- XSETCDR (tem, make_number (PT + inserted));
+ if (CONSP (tem) && FIXNUMP (XCAR (tem))
+ && FIXNUMP (XCDR (tem))
+ && XFIXNAT (XCDR (tem)) == PT + old_inserted)
+ XSETCDR (tem, make_fixnum (PT + inserted));
}
}
else
@@ -4590,7 +4646,7 @@ by calling `format-decode', which see. */)
/* Retval needs to be dealt with in all cases consistently. */
if (NILP (val))
- val = list2 (orig_filename, make_number (inserted));
+ val = list2 (orig_filename, make_fixnum (inserted));
return unbind_to (count, val);
}
@@ -4932,14 +4988,14 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
if (STRINGP (start))
ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
- else if (XINT (start) != XINT (end))
- ok = a_write (desc, Qnil, XINT (start), XINT (end) - XINT (start),
+ else if (XFIXNUM (start) != XFIXNUM (end))
+ ok = a_write (desc, Qnil, XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start),
&annotations, &coding);
else
{
/* If file was empty, still need to write the annotations. */
coding.mode |= CODING_MODE_LAST_BLOCK;
- ok = a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
+ ok = a_write (desc, Qnil, XFIXNUM (end), 0, &annotations, &coding);
}
save_errno = errno;
@@ -5186,7 +5242,7 @@ build_annotations (Lisp_Object start, Lisp_Object end)
has written annotations to a temporary buffer, which is now
current. */
res = call5 (Qformat_annotate_function, XCAR (p), start, end,
- original_buffer, make_number (i));
+ original_buffer, make_fixnum (i));
if (current_buffer != given_buffer)
{
XSETFASTINT (start, BEGV);
@@ -5225,8 +5281,8 @@ a_write (int desc, Lisp_Object string, ptrdiff_t pos,
{
tem = Fcar_safe (Fcar (*annot));
nextpos = pos - 1;
- if (INTEGERP (tem))
- nextpos = XFASTINT (tem);
+ if (FIXNUMP (tem))
+ nextpos = XFIXNAT (tem);
/* If there are no more annotations in this range,
output the rest of the range all at once. */
@@ -5398,16 +5454,15 @@ See Info node `(elisp)Modification Time' for more details. */)
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, return -1.
+Return a Lisp timestamp (as in `current-time') if the current buffer
+has a recorded file modification time, 0 if it doesn't, and -1 if the
+visited file doesn't exist.
See Info node `(elisp)Modification Time' for more details. */)
(void)
{
int ns = current_buffer->modtime.tv_nsec;
if (ns < 0)
- return make_number (UNKNOWN_MODTIME_NSECS - ns);
+ return make_fixnum (UNKNOWN_MODTIME_NSECS - ns);
return make_lisp_time (current_buffer->modtime);
}
@@ -5417,18 +5472,17 @@ DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
Useful if the buffer was not read from the file normally
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) or an integer flag as returned by
-`visited-file-modtime'. */)
+\(instead of that of the visited file), in the form of a time value as
+in `current-time' or an integer flag as returned by `visited-file-modtime'. */)
(Lisp_Object time_flag)
{
if (!NILP (time_flag))
{
struct timespec mtime;
- if (INTEGERP (time_flag))
+ if (FIXNUMP (time_flag))
{
CHECK_RANGED_INTEGER (time_flag, -1, 0);
- mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XINT (time_flag));
+ mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XFIXNUM (time_flag));
}
else
mtime = lisp_time_argument (time_flag);
@@ -5494,9 +5548,9 @@ auto_save_1 (void)
/* But make sure we can overwrite it later! */
auto_save_mode_bits = (st.st_mode | 0600) & 0777;
else if (modes = Ffile_modes (BVAR (current_buffer, filename)),
- INTEGERP (modes))
+ FIXNUMP (modes))
/* Remote files don't cooperate with stat. */
- auto_save_mode_bits = (XINT (modes) | 0600) & 0777;
+ auto_save_mode_bits = (XFIXNUM (modes) | 0600) & 0777;
}
return
@@ -5663,7 +5717,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
&& BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
&& BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b)
/* -1 means we've turned off autosaving for a while--see below. */
- && XINT (BVAR (b, save_length)) >= 0
+ && XFIXNUM (BVAR (b, save_length)) >= 0
&& (do_handled_files
|| NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name),
Qwrite_region))))
@@ -5678,13 +5732,13 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
set_buffer_internal (b);
if (NILP (Vauto_save_include_big_deletions)
- && (XFASTINT (BVAR (b, save_length)) * 10
+ && (XFIXNAT (BVAR (b, save_length)) * 10
> (BUF_Z (b) - BUF_BEG (b)) * 13)
/* A short file is likely to change a large fraction;
spare the user annoying messages. */
- && XFASTINT (BVAR (b, save_length)) > 5000
+ && XFIXNAT (BVAR (b, save_length)) > 5000
/* These messages are frequent and annoying for `*mail*'. */
- && !EQ (BVAR (b, filename), Qnil)
+ && !NILP (BVAR (b, filename))
&& NILP (no_message))
{
/* It has shrunk too much; turn off auto-saving here. */
@@ -5695,7 +5749,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
/* Turn off auto-saving until there's a real save,
and prevent any more warnings. */
XSETINT (BVAR (b, save_length), -1);
- Fsleep_for (make_number (1), Qnil);
+ Fsleep_for (make_fixnum (1), Qnil);
continue;
}
if (!auto_saved && NILP (no_message))
@@ -5724,7 +5778,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
{
/* If we are going to restore an old message,
give time to read ours. */
- sit_for (make_number (1), 0, 0);
+ sit_for (make_fixnum (1), 0, 0);
restore_message ();
}
else if (!auto_save_error_occurred)
@@ -5737,8 +5791,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
Vquit_flag = oquit;
/* This restores the message-stack status. */
- unbind_to (count, Qnil);
- return Qnil;
+ return unbind_to (count, Qnil);
}
DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved,
@@ -5839,6 +5892,52 @@ effect except for flushing STREAM's data. */)
return (set_binary_mode (fileno (fp), binmode) == O_BINARY) ? Qt : Qnil;
}
+#ifndef DOS_NT
+
+/* Yield a Lisp float as close as possible to BLOCKSIZE * BLOCKS, with
+ the result negated if NEGATE. */
+static Lisp_Object
+blocks_to_bytes (uintmax_t blocksize, uintmax_t blocks, bool negate)
+{
+ /* On typical platforms the following code is accurate to 53 bits,
+ which is close enough. BLOCKSIZE is invariably a power of 2, so
+ converting it to double does not lose information. */
+ double bs = blocksize;
+ return make_float (negate ? -bs * -blocks : bs * blocks);
+}
+
+DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
+ doc: /* Return storage information about the file system FILENAME is on.
+Value is a list of numbers (TOTAL FREE AVAIL), where TOTAL is the total
+storage of the file system, FREE is the free storage, and AVAIL is the
+storage available to a non-superuser. All 3 numbers are in bytes.
+If the underlying system call fails, value is nil. */)
+ (Lisp_Object filename)
+{
+ Lisp_Object encoded = ENCODE_FILE (Fexpand_file_name (filename, Qnil));
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ Lisp_Object handler = Ffind_file_name_handler (encoded, Qfile_system_info);
+ if (!NILP (handler))
+ {
+ Lisp_Object result = call2 (handler, Qfile_system_info, encoded);
+ if (CONSP (result) || NILP (result))
+ return result;
+ error ("Invalid handler in `file-name-handler-alist'");
+ }
+
+ struct fs_usage u;
+ if (get_fs_usage (SSDATA (encoded), NULL, &u) != 0)
+ return Qnil;
+ return list3 (blocks_to_bytes (u.fsu_blocksize, u.fsu_blocks, false),
+ blocks_to_bytes (u.fsu_blocksize, u.fsu_bfree, false),
+ blocks_to_bytes (u.fsu_blocksize, u.fsu_bavail,
+ u.fsu_bavail_top_bit_set));
+}
+
+#endif /* !DOS_NT */
+
void
init_fileio (void)
{
@@ -5909,6 +6008,7 @@ syms_of_fileio (void)
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_system_info, "file-system-info");
/* The symbol bound to coding-system-for-read when
insert-file-contents is called for recovering a file. This is not
@@ -6189,6 +6289,10 @@ This includes interactive calls to `delete-file' and
defsubr (&Sset_binary_mode);
+#ifndef DOS_NT
+ defsubr (&Sfile_system_info);
+#endif
+
#ifdef HAVE_SYNC
defsubr (&Sunix_sync);
#endif