/* File IO for GNU Emacs.
- Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
- 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+
+Copyright (C) 1985-1988, 1993-2012 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <config.h>
#include <limits.h>
-
-#ifdef HAVE_FCNTL_H
#include <fcntl.h>
-#endif
-
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <setjmp.h>
-
-#ifdef HAVE_UNISTD_H
#include <unistd.h>
-#endif
-
-#if !defined (S_ISLNK) && defined (S_IFLNK)
-# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
-#endif
-
-#if !defined (S_ISFIFO) && defined (S_IFIFO)
-# define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO)
-#endif
-
-#if !defined (S_ISREG) && defined (S_IFREG)
-# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
-#endif
#ifdef HAVE_PWD_H
#include <pwd.h>
#include <ctype.h>
#include <errno.h>
-#ifndef vax11c
-#ifndef USE_CRT_DLL
-extern int errno;
-#endif
+#ifdef HAVE_LIBSELINUX
+#include <selinux/selinux.h>
+#include <selinux/context.h>
#endif
#include "lisp.h"
#include "intervals.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "coding.h"
#include "window.h"
#include "blockinput.h"
#ifdef WINDOWSNT
#define NOMINMAX 1
#include <windows.h>
-#include <stdlib.h>
#include <fcntl.h>
#endif /* not WINDOWSNT */
#ifdef MSDOS
#include "msdos.h"
#include <sys/param.h>
-#if __DJGPP__ >= 2
#include <fcntl.h>
-#include <string.h>
-#endif
#endif
#ifdef DOS_NT
-#define CORRECT_DIR_SEPS(s) \
- do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
- else unixtodos_filename (s); \
- } while (0)
/* On Windows, drive letters must be alphabetic - on DOS, the Netware
- redirector allows the six letters between 'Z' and 'a' as well. */
+ redirector allows the six letters between 'Z' and 'a' as well. */
#ifdef MSDOS
#define IS_DRIVE(x) ((x) >= 'A' && (x) <= 'z')
#endif
#ifdef WINDOWSNT
-#define IS_DRIVE(x) isalpha (x)
+#define IS_DRIVE(x) isalpha ((unsigned char) (x))
#endif
/* Need to lower-case the drive letter, or else expanded
- filenames will sometimes compare inequal, because
+ filenames will sometimes compare unequal, because
`expand-file-name' doesn't always down-case the drive letter. */
-#define DRIVE_LETTER(x) (tolower (x))
+#define DRIVE_LETTER(x) (tolower ((unsigned char) (x)))
#endif
#include "systime.h"
+#include <stat-time.h>
#ifdef HPUX
#include <netio.h>
#endif
#include "commands.h"
-extern int use_dialog_box;
-extern int use_file_dialog;
-
-#ifndef O_WRONLY
-#define O_WRONLY 1
-#endif
-
-#ifndef O_RDONLY
-#define O_RDONLY 0
-#endif
-#ifndef S_ISLNK
-# define lstat stat
-#endif
-
-#ifndef FILE_SYSTEM_CASE
-#define FILE_SYSTEM_CASE(filename) (filename)
-#endif
+/* Nonzero during writing of auto-save files. */
+static int auto_saving;
-/* Nonzero during writing of auto-save files */
-int auto_saving;
+/* Nonzero umask during creation of auto-save directories. */
+static int auto_saving_dir_umask;
/* Set by auto_save_1 to mode of original file so Fwrite_region will create
- a new file with the same mode as the original */
-int auto_save_mode_bits;
+ a new file with the same mode as the original. */
+static int auto_save_mode_bits;
-/* Set by auto_save_1 if an error occurred during the last auto-save. */
-int auto_save_error_occurred;
+/* Set by auto_save_1 if an error occurred during the last auto-save. */
+static int auto_save_error_occurred;
/* The symbol bound to coding-system-for-read when
insert-file-contents is called for recovering a file. This is not
an actual coding system name, but just an indicator to tell
insert-file-contents to use `emacs-mule' with a special flag for
auto saving and recovering a file. */
-Lisp_Object Qauto_save_coding;
-
-/* Coding system for file names, or nil if none. */
-Lisp_Object Vfile_name_coding_system;
-
-/* Coding system for file names used only when
- Vfile_name_coding_system is nil. */
-Lisp_Object Vdefault_file_name_coding_system;
-
-/* Alist of elements (REGEXP . HANDLER) for file names
- whose I/O is done with a special handler. */
-Lisp_Object Vfile_name_handler_alist;
+static Lisp_Object Qauto_save_coding;
/* Property name of a file name handler,
which gives a list of operations it handles.. */
-Lisp_Object Qoperations;
-
-/* Lisp functions for translating file formats */
-Lisp_Object Qformat_decode, Qformat_annotate_function;
-
-/* Function to be called to decide a coding system of a reading file. */
-Lisp_Object Vset_auto_coding_function;
+static Lisp_Object Qoperations;
-/* Functions to be called to process text properties in inserted file. */
-Lisp_Object Vafter_insert_file_functions;
+/* Lisp functions for translating file formats. */
+static Lisp_Object Qformat_decode, Qformat_annotate_function;
/* Lisp function for setting buffer-file-coding-system and the
multibyteness of the current buffer after inserting a file. */
-Lisp_Object Qafter_insert_file_set_coding;
-
-/* Functions to be called to create text property annotations for file. */
-Lisp_Object Vwrite_region_annotate_functions;
-Lisp_Object Qwrite_region_annotate_functions;
-Lisp_Object Vwrite_region_post_annotation_function;
-
-/* During build_annotations, each time an annotation function is called,
- this holds the annotations made by the previous functions. */
-Lisp_Object Vwrite_region_annotations_so_far;
+static Lisp_Object Qafter_insert_file_set_coding;
+static Lisp_Object Qwrite_region_annotate_functions;
/* Each time an annotation function changes the buffer, the new buffer
is added here. */
-Lisp_Object Vwrite_region_annotation_buffers;
-
-/* File name in which we write a list of all our auto save files. */
-Lisp_Object Vauto_save_list_file_name;
-
-/* Whether or not files are auto-saved into themselves. */
-Lisp_Object Vauto_save_visited_file_name;
-
-/* Whether or not to continue auto-saving after a large deletion. */
-Lisp_Object Vauto_save_include_big_deletions;
-
-/* On NT, specifies the directory separator character, used (eg.) when
- expanding file names. This can be bound to / or \. */
-Lisp_Object Vdirectory_sep_char;
+static Lisp_Object Vwrite_region_annotation_buffers;
#ifdef HAVE_FSYNC
-/* Nonzero means skip the call to fsync in Fwrite-region. */
-int write_region_inhibit_fsync;
#endif
-/* Non-zero means call move-file-to-trash in Fdelete_file or
- Fdelete_directory_internal. */
-int delete_by_moving_to_trash;
-
-Lisp_Object Qdelete_by_moving_to_trash;
+static Lisp_Object Qdelete_by_moving_to_trash;
/* Lisp function for moving files to trash. */
-Lisp_Object Qmove_file_to_trash;
+static Lisp_Object Qmove_file_to_trash;
/* Lisp function for recursively copying directories. */
-Lisp_Object Qcopy_directory;
+static Lisp_Object Qcopy_directory;
/* Lisp function for recursively deleting directories. */
-Lisp_Object Qdelete_directory;
-
-extern Lisp_Object Vuser_login_name;
+static Lisp_Object Qdelete_directory;
#ifdef WINDOWSNT
-extern Lisp_Object Vw32_get_true_file_attributes;
#endif
-extern int minibuf_level;
-
-extern int minibuffer_auto_raise;
-
-/* These variables describe handlers that have "already" had a chance
- to handle the current operation.
-
- Vinhibit_file_name_handlers is a list of file name handlers.
- Vinhibit_file_name_operation is the operation being handled.
- If we try to handle that operation, we ignore those handlers. */
-
-static Lisp_Object Vinhibit_file_name_handlers;
-static Lisp_Object Vinhibit_file_name_operation;
-
-Lisp_Object Qfile_error, Qfile_already_exists, Qfile_date_error;
-Lisp_Object Qexcl;
+Lisp_Object Qfile_error;
+static Lisp_Object Qfile_already_exists, Qfile_date_error;
+static Lisp_Object Qexcl;
Lisp_Object Qfile_name_history;
-Lisp_Object Qcar_less_than_car;
+static Lisp_Object Qcar_less_than_car;
-static int a_write P_ ((int, Lisp_Object, int, int,
- Lisp_Object *, struct coding_system *));
-static int e_write P_ ((int, Lisp_Object, int, int, struct coding_system *));
+static int a_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
+ Lisp_Object *, struct coding_system *);
+static int e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t,
+ struct coding_system *);
\f
void
-report_file_error (string, data)
- const char *string;
- Lisp_Object data;
+report_file_error (const char *string, Lisp_Object data)
{
Lisp_Object errstring;
int errorno = errno;
synchronize_system_messages_locale ();
str = strerror (errorno);
- errstring = code_convert_string_norecord (make_unibyte_string (str,
- strlen (str)),
+ errstring = code_convert_string_norecord (build_unibyte_string (str),
Vlocale_coding_system, 0);
while (1)
{
int c;
- str = (char *) SDATA (errstring);
- c = STRING_CHAR (str);
- Faset (errstring, make_number (0), make_number (DOWNCASE (c)));
+ str = SSDATA (errstring);
+ c = STRING_CHAR ((unsigned char *) str);
+ Faset (errstring, make_number (0), make_number (downcase (c)));
}
xsignal (Qfile_error,
}
Lisp_Object
-close_file_unwind (fd)
- Lisp_Object fd;
+close_file_unwind (Lisp_Object fd)
{
emacs_close (XFASTINT (fd));
return Qnil;
/* Restore point, having saved it as a marker. */
Lisp_Object
-restore_point_unwind (location)
- Lisp_Object location;
+restore_point_unwind (Lisp_Object location)
{
Fgoto_char (location);
Fset_marker (location, Qnil, Qnil);
}
\f
-Lisp_Object Qexpand_file_name;
-Lisp_Object Qsubstitute_in_file_name;
-Lisp_Object Qdirectory_file_name;
-Lisp_Object Qfile_name_directory;
-Lisp_Object Qfile_name_nondirectory;
-Lisp_Object Qunhandled_file_name_directory;
-Lisp_Object Qfile_name_as_directory;
-Lisp_Object Qcopy_file;
-Lisp_Object Qmake_directory_internal;
-Lisp_Object Qmake_directory;
-Lisp_Object Qdelete_directory_internal;
+static Lisp_Object Qexpand_file_name;
+static Lisp_Object Qsubstitute_in_file_name;
+static Lisp_Object Qdirectory_file_name;
+static Lisp_Object Qfile_name_directory;
+static Lisp_Object Qfile_name_nondirectory;
+static Lisp_Object Qunhandled_file_name_directory;
+static Lisp_Object Qfile_name_as_directory;
+static Lisp_Object Qcopy_file;
+static Lisp_Object Qmake_directory_internal;
+static Lisp_Object Qmake_directory;
+static Lisp_Object Qdelete_directory_internal;
Lisp_Object Qdelete_file;
-Lisp_Object Qrename_file;
-Lisp_Object Qadd_name_to_file;
-Lisp_Object Qmake_symbolic_link;
+static Lisp_Object Qrename_file;
+static Lisp_Object Qadd_name_to_file;
+static Lisp_Object Qmake_symbolic_link;
Lisp_Object Qfile_exists_p;
-Lisp_Object Qfile_executable_p;
-Lisp_Object Qfile_readable_p;
-Lisp_Object Qfile_writable_p;
-Lisp_Object Qfile_symlink_p;
-Lisp_Object Qaccess_file;
+static Lisp_Object Qfile_executable_p;
+static Lisp_Object Qfile_readable_p;
+static Lisp_Object Qfile_writable_p;
+static Lisp_Object Qfile_symlink_p;
+static Lisp_Object Qaccess_file;
Lisp_Object Qfile_directory_p;
-Lisp_Object Qfile_regular_p;
-Lisp_Object Qfile_accessible_directory_p;
-Lisp_Object Qfile_modes;
-Lisp_Object Qset_file_modes;
-Lisp_Object Qset_file_times;
-Lisp_Object Qfile_newer_than_file_p;
+static Lisp_Object Qfile_regular_p;
+static Lisp_Object Qfile_accessible_directory_p;
+static Lisp_Object Qfile_modes;
+static Lisp_Object Qset_file_modes;
+static Lisp_Object Qset_file_times;
+static Lisp_Object Qfile_selinux_context;
+static Lisp_Object Qset_file_selinux_context;
+static Lisp_Object Qfile_newer_than_file_p;
Lisp_Object Qinsert_file_contents;
Lisp_Object Qwrite_region;
-Lisp_Object Qverify_visited_file_modtime;
-Lisp_Object Qset_visited_file_modtime;
+static Lisp_Object Qverify_visited_file_modtime;
+static Lisp_Object Qset_visited_file_modtime;
-DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 2, 2, 0,
+DEFUN ("find-file-name-handler", Ffind_file_name_handler,
+ Sfind_file_name_handler, 2, 2, 0,
doc: /* Return FILENAME's handler function for OPERATION, if it has one.
Otherwise, return nil.
A file name is handled if one of the regular expressions in
any handlers that are members of `inhibit-file-name-handlers',
but we still do run any other handlers. This lets handlers
use the standard functions without calling themselves recursively. */)
- (filename, operation)
- Lisp_Object filename, operation;
+ (Lisp_Object filename, Lisp_Object operation)
{
/* This function must not munge the match data. */
Lisp_Object chain, inhibited_handlers, result;
- int pos = -1;
+ ptrdiff_t pos = -1;
result = Qnil;
CHECK_STRING (filename);
if (CONSP (elt))
{
Lisp_Object string = XCAR (elt);
- int match_pos;
+ ptrdiff_t match_pos;
Lisp_Object handler = XCDR (elt);
Lisp_Object operations = Qnil;
Return nil if FILENAME does not include a directory.
Otherwise return a directory name.
Given a Unix syntax file name, returns a string ending in slash. */)
- (filename)
- Lisp_Object filename;
+ (Lisp_Object filename)
{
#ifndef DOS_NT
- register const unsigned char *beg;
+ register const char *beg;
#else
- register unsigned char *beg;
+ register char *beg;
#endif
- register const unsigned char *p;
+ register const char *p;
Lisp_Object handler;
CHECK_STRING (filename);
call the corresponding file handler. */
handler = Ffind_file_name_handler (filename, Qfile_name_directory);
if (!NILP (handler))
- return call2 (handler, Qfile_name_directory, filename);
+ {
+ Lisp_Object handled_name = call2 (handler, Qfile_name_directory,
+ filename);
+ return STRINGP (handled_name) ? handled_name : Qnil;
+ }
- filename = FILE_SYSTEM_CASE (filename);
#ifdef DOS_NT
- beg = (unsigned char *) alloca (SBYTES (filename) + 1);
- bcopy (SDATA (filename), beg, SBYTES (filename) + 1);
+ beg = alloca (SBYTES (filename) + 1);
+ memcpy (beg, SSDATA (filename), SBYTES (filename) + 1);
#else
- beg = SDATA (filename);
+ beg = SSDATA (filename);
#endif
p = beg + SBYTES (filename);
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef DOS_NT
- /* only recognise drive specifier at the beginning */
+ /* only recognize drive specifier at the beginning */
&& !(p[-1] == ':'
/* handle the "/:d:foo" and "/:foo" cases correctly */
&& ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
if (p[-1] == ':')
{
/* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
- unsigned char *res = alloca (MAXPATHLEN + 1);
- unsigned char *r = res;
+ char *res = alloca (MAXPATHLEN + 1);
+ char *r = res;
if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
{
- strncpy (res, beg, 2);
+ memcpy (res, beg, 2);
beg += 2;
r += 2;
}
- if (getdefdir (toupper (*beg) - 'A' + 1, r))
+ if (getdefdir (toupper ((unsigned char) *beg) - 'A' + 1, r))
{
if (!IS_DIRECTORY_SEP (res[strlen (res) - 1]))
strcat (res, "/");
p = beg + strlen (beg);
}
}
- CORRECT_DIR_SEPS (beg);
+ dostounix_filename (beg);
#endif /* DOS_NT */
return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename));
For example, in a Unix-syntax file name,
this is everything after the last slash,
or the entire name if it contains no slash. */)
- (filename)
- Lisp_Object filename;
+ (Lisp_Object filename)
{
- register const unsigned char *beg, *p, *end;
+ register const char *beg, *p, *end;
Lisp_Object handler;
CHECK_STRING (filename);
call the corresponding file handler. */
handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
if (!NILP (handler))
- return call2 (handler, Qfile_name_nondirectory, filename);
+ {
+ Lisp_Object handled_name = call2 (handler, Qfile_name_nondirectory,
+ filename);
+ if (STRINGP (handled_name))
+ return handled_name;
+ error ("Invalid handler in `file-name-handler-alist'");
+ }
- beg = SDATA (filename);
+ beg = SSDATA (filename);
end = p = beg + SBYTES (filename);
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef DOS_NT
- /* only recognise drive specifier at beginning */
+ /* only recognize drive specifier at beginning */
&& !(p[-1] == ':'
/* handle the "/:d:foo" case correctly */
&& (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
then this should return nil.
The `call-process' and `start-process' functions use this function to
get a current directory to run processes in. */)
- (filename)
- Lisp_Object filename;
+ (Lisp_Object filename)
{
Lisp_Object handler;
call the corresponding file handler. */
handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
if (!NILP (handler))
- return call2 (handler, Qunhandled_file_name_directory, filename);
+ {
+ Lisp_Object handled_name = call2 (handler, Qunhandled_file_name_directory,
+ filename);
+ return STRINGP (handled_name) ? handled_name : Qnil;
+ }
return Ffile_name_directory (filename);
}
-\f
-char *
-file_name_as_directory (out, in)
- char *out, *in;
-{
- int size = strlen (in) - 1;
-
- strcpy (out, in);
+/* Convert from file name SRC of length SRCLEN to directory name
+ in DST. On UNIX, just make sure there is a terminating /.
+ Return the length of DST. */
- if (size < 0)
+static ptrdiff_t
+file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen)
+{
+ if (srclen == 0)
{
- out[0] = '.';
- out[1] = '/';
- out[2] = 0;
- return out;
+ dst[0] = '.';
+ dst[1] = '/';
+ dst[2] = '\0';
+ return 2;
}
- /* For Unix syntax, Append a slash if necessary */
- if (!IS_DIRECTORY_SEP (out[size]))
+ strcpy (dst, src);
+
+ if (!IS_DIRECTORY_SEP (dst[srclen - 1]))
{
- /* Cannot use DIRECTORY_SEP, which could have any value */
- out[size + 1] = '/';
- out[size + 2] = '\0';
+ dst[srclen] = DIRECTORY_SEP;
+ dst[srclen + 1] = '\0';
+ srclen++;
}
#ifdef DOS_NT
- CORRECT_DIR_SEPS (out);
+ dostounix_filename (dst);
#endif
- return out;
+ return srclen;
}
DEFUN ("file-name-as-directory", Ffile_name_as_directory,
The result can be used as the value of `default-directory'
or passed as second argument to `expand-file-name'.
For a Unix-syntax file name, just appends a slash. */)
- (file)
- Lisp_Object file;
+ (Lisp_Object file)
{
char *buf;
+ ptrdiff_t length;
Lisp_Object handler;
CHECK_STRING (file);
call the corresponding file handler. */
handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
if (!NILP (handler))
- return call2 (handler, Qfile_name_as_directory, file);
+ {
+ Lisp_Object handled_name = call2 (handler, Qfile_name_as_directory,
+ file);
+ if (STRINGP (handled_name))
+ return handled_name;
+ error ("Invalid handler in `file-name-handler-alist'");
+ }
- buf = (char *) alloca (SBYTES (file) + 10);
- file_name_as_directory (buf, SDATA (file));
- return make_specified_string (buf, -1, strlen (buf),
- STRING_MULTIBYTE (file));
+ buf = alloca (SBYTES (file) + 10);
+ length = file_name_as_directory (buf, SSDATA (file), SBYTES (file));
+ return make_specified_string (buf, -1, length, STRING_MULTIBYTE (file));
}
\f
-/*
- * Convert from directory name to filename.
- * On UNIX, it's simple: just make sure there isn't a terminating /
+/* Convert from directory name SRC of length SRCLEN to
+ file name in DST. On UNIX, just make sure there isn't
+ a terminating /. Return the length of DST. */
- * Value is nonzero if the string output is different from the input.
- */
-
-int
-directory_file_name (src, dst)
- char *src, *dst;
+static ptrdiff_t
+directory_file_name (char *dst, char *src, ptrdiff_t srclen)
{
- long slen;
-
- slen = strlen (src);
-
/* Process as Unix format: just remove any final slash.
But leave "/" unchanged; do not change it to "". */
strcpy (dst, src);
- if (slen > 1
- && IS_DIRECTORY_SEP (dst[slen - 1])
+ if (srclen > 1
+ && IS_DIRECTORY_SEP (dst[srclen - 1])
#ifdef DOS_NT
- && !IS_ANY_SEP (dst[slen - 2])
+ && !IS_ANY_SEP (dst[srclen - 2])
#endif
)
- dst[slen - 1] = 0;
+ {
+ dst[srclen - 1] = 0;
+ srclen--;
+ }
#ifdef DOS_NT
- CORRECT_DIR_SEPS (dst);
+ dostounix_filename (dst);
#endif
- return 1;
+ return srclen;
}
DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
This operation exists because a directory is also a file, but its name as
a directory is different from its name as a file.
In Unix-syntax, this function just removes the final slash. */)
- (directory)
- Lisp_Object directory;
+ (Lisp_Object directory)
{
char *buf;
+ ptrdiff_t length;
Lisp_Object handler;
CHECK_STRING (directory);
call the corresponding file handler. */
handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
if (!NILP (handler))
- return call2 (handler, Qdirectory_file_name, directory);
+ {
+ Lisp_Object handled_name = call2 (handler, Qdirectory_file_name,
+ directory);
+ if (STRINGP (handled_name))
+ return handled_name;
+ error ("Invalid handler in `file-name-handler-alist'");
+ }
- buf = (char *) alloca (SBYTES (directory) + 20);
- directory_file_name (SDATA (directory), buf);
- return make_specified_string (buf, -1, strlen (buf),
- STRING_MULTIBYTE (directory));
+ buf = alloca (SBYTES (directory) + 20);
+ length = directory_file_name (buf, SSDATA (directory), SBYTES (directory));
+ return make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory));
}
static const char make_temp_name_tbl[64] =
generated. */
Lisp_Object
-make_temp_name (prefix, base64_p)
- Lisp_Object prefix;
- int base64_p;
+make_temp_name (Lisp_Object prefix, int base64_p)
{
Lisp_Object val;
int len, clen;
- int pid;
- unsigned char *p, *data;
- char pidbuf[20];
+ printmax_t pid;
+ char *p, *data;
+ char pidbuf[INT_BUFSIZE_BOUND (printmax_t)];
int pidlen;
CHECK_STRING (prefix);
three are incremented if the file already exists. This ensures
262144 unique file names per PID per PREFIX. */
- pid = (int) getpid ();
+ pid = getpid ();
if (base64_p)
{
else
{
#ifdef HAVE_LONG_FILE_NAMES
- sprintf (pidbuf, "%d", pid);
- pidlen = strlen (pidbuf);
+ pidlen = sprintf (pidbuf, "%"pMd, pid);
#else
pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
val = make_uninit_multibyte_string (clen + 3 + pidlen, len + 3 + pidlen);
if (!STRING_MULTIBYTE (prefix))
STRING_SET_UNIBYTE (val);
- data = SDATA (val);
- bcopy(SDATA (prefix), data, len);
+ data = SSDATA (val);
+ memcpy (data, SSDATA (prefix), len);
p = data + len;
- bcopy (pidbuf, p, pidlen);
+ memcpy (p, pidbuf, pidlen);
p += pidlen;
/* Here we try to minimize useless stat'ing when this function is
if (!make_temp_name_count_initialized_p)
{
- make_temp_name_count = (unsigned) time (NULL);
+ make_temp_name_count = time (NULL);
make_temp_name_count_initialized_p = 1;
}
as bad as (and in many cases worse than) throwing the
error, or to ignore the error, which will likely result
in looping through 225307 stat's, which is not only
- dog-slow, but also useless since it will fallback to
- the errow below, anyway. */
+ 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));
/* not reached */
}
}
-
- error ("Cannot create temporary name for prefix `%s'",
- SDATA (prefix));
- return Qnil;
}
* If you are creating the file in the user's home directory.
* If you are creating a directory rather than an ordinary file.
* If you are taking special precautions as `make-temp-file' does. */)
- (prefix)
- Lisp_Object prefix;
+ (Lisp_Object prefix)
{
return make_temp_name (prefix, 0);
}
\(expand-file-name ".." "/") returns "/..". For this reason, use
\(directory-file-name (file-name-directory dirname)) to traverse a
filesystem tree, not (expand-file-name ".." dirname). */)
- (name, default_directory)
- Lisp_Object name, default_directory;
+ (Lisp_Object name, Lisp_Object default_directory)
{
/* These point to SDATA and need to be careful with string-relocation
during GC (via DECODE_FILE). */
- unsigned char *nm, *newdir;
+ char *nm;
+ const char *newdir;
/* This should only point to alloca'd data. */
- unsigned char *target;
+ char *target;
- int tlen;
+ ptrdiff_t tlen;
struct passwd *pw;
#ifdef DOS_NT
int drive = 0;
int collapse_newdir = 1;
int is_escaped = 0;
#endif /* DOS_NT */
- int length;
- Lisp_Object handler, result;
+ ptrdiff_t length;
+ Lisp_Object handler, result, handled_name;
int multibyte;
Lisp_Object hdir;
call the corresponding file handler. */
handler = Ffind_file_name_handler (name, Qexpand_file_name);
if (!NILP (handler))
- return call3 (handler, Qexpand_file_name, name, default_directory);
+ {
+ 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'");
+ }
+
/* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
if (NILP (default_directory))
- default_directory = current_buffer->directory;
+ default_directory = BVAR (current_buffer, directory);
if (! STRINGP (default_directory))
{
#ifdef DOS_NT
To avoid this, we set default_directory to the root of the
current drive. */
- extern char *emacs_root_dir (void);
-
default_directory = build_string (emacs_root_dir ());
#else
default_directory = build_string ("/");
{
handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
if (!NILP (handler))
- return call3 (handler, Qexpand_file_name, name, default_directory);
+ {
+ 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'");
+ }
}
{
- unsigned char *o = SDATA (default_directory);
+ char *o = SSDATA (default_directory);
/* Make sure DEFAULT_DIRECTORY is properly expanded.
It would be better to do this down below where we actually use
UNGCPRO;
}
}
- name = FILE_SYSTEM_CASE (name);
multibyte = STRING_MULTIBYTE (name);
if (multibyte != STRING_MULTIBYTE (default_directory))
{
}
}
- /* Make a local copy of nm[] to protect it from GC in DECODE_FILE below. */
- nm = (unsigned char *) alloca (SBYTES (name) + 1);
- bcopy (SDATA (name), nm, SBYTES (name) + 1);
+ /* 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
/* Note if special escape prefix is present, but remove for now. */
drive specifier at the beginning. */
if (IS_DRIVE (nm[0]) && IS_DEVICE_SEP (nm[1]))
{
- drive = nm[0];
+ drive = (unsigned char) nm[0];
nm += 2;
}
if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
nm++;
- /* Discard any previous drive specifier if nm is now in UNC format. */
+ /* Discard any previous drive specifier if nm is now in UNC format. */
if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
{
drive = 0;
non-zero value, that means we've discovered that we can't do
that cool trick. */
int lose = 0;
- unsigned char *p = nm;
+ char *p = nm;
while (*p)
{
if (!lose)
{
#ifdef DOS_NT
- /* Make sure directories are all separated with / or \ as
- desired, but avoid allocation of a new string when not
- required. */
- CORRECT_DIR_SEPS (nm);
+ /* Make sure directories are all separated with /, but
+ avoid allocation of a new string when not required. */
+ dostounix_filename (nm);
#ifdef WINDOWSNT
if (IS_DIRECTORY_SEP (nm[1]))
{
- if (strcmp (nm, SDATA (name)) != 0)
+ if (strcmp (nm, SSDATA (name)) != 0)
name = make_specified_string (nm, -1, strlen (nm), multibyte);
}
else
#endif
- /* drive must be set, so this is okay */
- if (strcmp (nm - 2, SDATA (name)) != 0)
+ /* Drive must be set, so this is okay. */
+ if (strcmp (nm - 2, SSDATA (name)) != 0)
{
char temp[] = " :";
}
return name;
#else /* not DOS_NT */
- if (strcmp (nm, SDATA (name)) == 0)
+ if (strcmp (nm, SSDATA (name)) == 0)
return name;
return make_specified_string (nm, -1, strlen (nm), multibyte);
#endif /* not DOS_NT */
{
Lisp_Object tem;
- if (!(newdir = (unsigned char *) egetenv ("HOME")))
- newdir = (unsigned char *) "";
+ if (!(newdir = egetenv ("HOME")))
+ newdir = "";
nm++;
- /* egetenv may return a unibyte string, which will bite us since
+ /* `egetenv' may return a unibyte string, which will bite us since
we expect the directory to be multibyte. */
tem = build_string (newdir);
if (!STRING_MULTIBYTE (tem))
{
hdir = DECODE_FILE (tem);
- newdir = SDATA (hdir);
+ newdir = SSDATA (hdir);
}
#ifdef DOS_NT
collapse_newdir = 0;
}
else /* ~user/filename */
{
- unsigned char *o, *p;
+ char *o, *p;
for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++);
o = alloca (p - nm + 1);
- bcopy ((char *) nm, o, p - nm);
+ memcpy (o, nm, p - nm);
o [p - nm] = 0;
BLOCK_INPUT;
UNBLOCK_INPUT;
if (pw)
{
- newdir = (unsigned char *) pw -> pw_dir;
+ newdir = pw->pw_dir;
nm = p;
#ifdef DOS_NT
collapse_newdir = 0;
use the drive's current directory as the prefix if needed. */
if (!newdir && drive)
{
- /* Get default directory if needed to make nm absolute. */
+ /* Get default directory if needed to make nm absolute. */
+ char *adir = NULL;
if (!IS_DIRECTORY_SEP (nm[0]))
{
- newdir = alloca (MAXPATHLEN + 1);
- if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
- newdir = NULL;
+ adir = alloca (MAXPATHLEN + 1);
+ if (!getdefdir (toupper (drive) - 'A' + 1, adir))
+ adir = NULL;
}
- if (!newdir)
+ if (!adir)
{
- /* Either nm starts with /, or drive isn't mounted. */
- newdir = alloca (4);
- newdir[0] = DRIVE_LETTER (drive);
- newdir[1] = ':';
- newdir[2] = '/';
- newdir[3] = 0;
+ /* Either nm starts with /, or drive isn't mounted. */
+ adir = alloca (4);
+ adir[0] = DRIVE_LETTER (drive);
+ adir[1] = ':';
+ adir[2] = '/';
+ adir[3] = 0;
}
+ newdir = adir;
}
#endif /* DOS_NT */
/* Finally, if no prefix has been specified and nm is not absolute,
- then it must be expanded relative to default_directory. */
+ then it must be expanded relative to default_directory. */
if (1
#ifndef DOS_NT
- /* /... alone is not absolute on DOS and Windows. */
+ /* /... alone is not absolute on DOS and Windows. */
&& !IS_DIRECTORY_SEP (nm[0])
#endif
#ifdef WINDOWSNT
#endif
&& !newdir)
{
- newdir = SDATA (default_directory);
+ newdir = SSDATA (default_directory);
#ifdef DOS_NT
/* Note if special escape prefix is present, but remove for now. */
if (newdir[0] == '/' && newdir[1] == ':')
#ifdef DOS_NT
if (newdir)
{
- /* First ensure newdir is an absolute name. */
+ /* First ensure newdir is an absolute name. */
if (
/* Detect MSDOS file names with drive specifiers. */
! (IS_DRIVE (newdir[0])
Because of the admonition against calling expand-file-name
when we have pointers into lisp strings, we accomplish this
indirectly by prepending newdir to nm if necessary, and using
- cwd (or the wd of newdir's drive) as the new newdir. */
-
+ cwd (or the wd of newdir's drive) as the new newdir. */
+ char *adir;
if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
{
- drive = newdir[0];
+ drive = (unsigned char) newdir[0];
newdir += 2;
}
if (!IS_DIRECTORY_SEP (nm[0]))
{
- char * tmp = alloca (strlen (newdir) + strlen (nm) + 2);
- file_name_as_directory (tmp, newdir);
+ ptrdiff_t newlen = strlen (newdir);
+ char *tmp = alloca (newlen + strlen (nm) + 2);
+ file_name_as_directory (tmp, newdir, newlen);
strcat (tmp, nm);
nm = tmp;
}
- newdir = alloca (MAXPATHLEN + 1);
+ adir = alloca (MAXPATHLEN + 1);
if (drive)
{
- if (!getdefdir (toupper (drive) - 'A' + 1, newdir))
+ if (!getdefdir (toupper (drive) - 'A' + 1, adir))
newdir = "/";
}
else
- getwd (newdir);
+ getwd (adir);
+ newdir = adir;
}
- /* Strip off drive name from prefix, if present. */
+ /* Strip off drive name from prefix, if present. */
if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
{
drive = newdir[0];
#ifdef WINDOWSNT
if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1]))
{
- unsigned char *p;
- newdir = strcpy (alloca (strlen (newdir) + 1), newdir);
- p = newdir + 2;
+ char *adir = strcpy (alloca (strlen (newdir) + 1), newdir);
+ char *p = adir + 2;
while (*p && !IS_DIRECTORY_SEP (*p)) p++;
p++;
while (*p && !IS_DIRECTORY_SEP (*p)) p++;
*p = 0;
+ newdir = adir;
}
else
#endif
/* Get rid of any slash at the end of newdir, unless newdir is
just / or // (an incomplete UNC name). */
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
)
{
- unsigned char *temp = (unsigned char *) alloca (length);
- bcopy (newdir, temp, length - 1);
+ char *temp = alloca (length);
+ memcpy (temp, newdir, length - 1);
temp[length - 1] = 0;
+ length--;
newdir = temp;
}
- tlen = length + 1;
}
else
- tlen = 0;
+ {
+ length = 0;
+ tlen = 0;
+ }
- /* Now concatenate the directory and name to new space in the stack frame */
+ /* Now concatenate the directory and name to new space in the stack frame. */
tlen += 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
produces incorrect code if the following two lines are combined.) */
- target = (unsigned char *) alloca (tlen + 4);
+ target = alloca (tlen + 4);
target += 4;
#else /* not DOS_NT */
- target = (unsigned char *) alloca (tlen);
+ target = alloca (tlen);
#endif /* not DOS_NT */
*target = 0;
strcpy (target, newdir);
}
else
- file_name_as_directory (target, newdir);
+ file_name_as_directory (target, newdir, length);
}
strcat (target, nm);
/* Now canonicalize by removing `//', `/.' and `/foo/..' if they
appear. */
{
- unsigned char *p = target;
- unsigned char *o = target;
+ char *p = target;
+ char *o = target;
while (*p)
{
&& (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
{
#ifdef WINDOWSNT
- unsigned char *prev_o = o;
+ char *prev_o = o;
#endif
while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
;
}
#ifdef DOS_NT
- /* At last, set drive name. */
+ /* At last, set drive name. */
#ifdef WINDOWSNT
/* Except for network file name. */
if (!(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))
target[0] = '/';
target[1] = ':';
}
- CORRECT_DIR_SEPS (target);
+ dostounix_filename (target);
#endif /* DOS_NT */
result = make_specified_string (target, -1, o - target, multibyte);
and perhaps call the corresponding file handler. This is needed
for filenames such as "/foo/../user@host:/bar/../baz". Expanding
the ".." component gives us "/user@host:/bar/../baz" which needs
- to be expanded again. */
+ to be expanded again. */
handler = Ffind_file_name_handler (result, Qexpand_file_name);
if (!NILP (handler))
- return call3 (handler, Qexpand_file_name, result, default_directory);
+ {
+ 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'");
+ }
return result;
}
unsigned char *nm;
register unsigned char *newdir, *p, *o;
- int tlen;
+ ptrdiff_t tlen;
unsigned char *target;
struct passwd *pw;
int lose;
}
}
- /* Now determine directory to start with and put it in NEWDIR */
+ /* Now determine directory to start with and put it in NEWDIR. */
newdir = 0;
}
else /* ~user/filename */
{
- /* Get past ~ to user */
+ /* Get past ~ to user. */
unsigned char *user = nm + 1;
- /* Find end of name. */
- unsigned char *ptr = (unsigned char *) index (user, '/');
- int len = ptr ? ptr - user : strlen (user);
- /* Copy the user name into temp storage. */
- o = (unsigned char *) alloca (len + 1);
- bcopy ((char *) user, o, len);
+ /* Find end of name. */
+ unsigned char *ptr = (unsigned char *) strchr (user, '/');
+ ptrdiff_t len = ptr ? ptr - user : strlen (user);
+ /* Copy the user name into temp storage. */
+ o = alloca (len + 1);
+ memcpy (o, user, len);
o[len] = 0;
- /* Look up the user name. */
+ /* Look up the user name. */
BLOCK_INPUT;
pw = (struct passwd *) getpwnam (o + 1);
UNBLOCK_INPUT;
newdir = SDATA (defalt);
}
- /* Now concatenate the directory and name to new space in the stack frame */
+ /* Now concatenate the directory and name to new space in the stack frame. */
tlen = (newdir ? strlen (newdir) + 1 : 0) + strlen (nm) + 1;
- target = (unsigned char *) alloca (tlen);
+ target = alloca (tlen);
*target = 0;
if (newdir)
strcat (target, nm);
- /* Now canonicalize by removing /. and /foo/.. if they appear */
+ /* Now canonicalize by removing /. and /foo/.. if they appear. */
p = target;
o = target;
\f
/* If /~ or // appears, discard everything through first slash. */
static int
-file_name_absolute_p (filename)
- const unsigned char *filename;
+file_name_absolute_p (const char *filename)
{
return
(IS_DIRECTORY_SEP (*filename) || *filename == '~'
);
}
-static unsigned char *
-search_embedded_absfilename (nm, endp)
- unsigned char *nm, *endp;
+static char *
+search_embedded_absfilename (char *nm, char *endp)
{
- unsigned char *p, *s;
+ char *p, *s;
for (p = nm + 1; p < endp; p++)
{
if ((0
|| IS_DIRECTORY_SEP (p[-1]))
&& file_name_absolute_p (p)
-#if defined (WINDOWSNT) || defined(CYGWIN)
+#if defined (WINDOWSNT) || defined (CYGWIN)
/* // at start of file name is meaningful in Apollo,
WindowsNT and Cygwin systems. */
&& !(IS_DIRECTORY_SEP (p[0]) && p - 1 == nm)
)
{
for (s = p; *s && (!IS_DIRECTORY_SEP (*s)); s++);
- if (p[0] == '~' && s > p + 1) /* we've got "/~something/" */
+ if (p[0] == '~' && s > p + 1) /* We've got "/~something/". */
{
- unsigned char *o = alloca (s - p + 1);
+ char *o = alloca (s - p + 1);
struct passwd *pw;
- bcopy (p, o, s - p);
+ memcpy (o, p, s - p);
o [s - p] = 0;
/* If we have ~user and `user' exists, discard
If `/~' appears, all of FILENAME through that `/' is discarded.
If `//' appears, everything up to and including the first of
those `/' is discarded. */)
- (filename)
- Lisp_Object filename;
+ (Lisp_Object filename)
{
- unsigned char *nm;
+ char *nm;
- register unsigned char *s, *p, *o, *x, *endp;
- unsigned char *target = NULL;
+ register char *s, *p, *o, *x, *endp;
+ char *target = NULL;
int total = 0;
int substituted = 0;
int multibyte;
- unsigned char *xnm;
+ char *xnm;
Lisp_Object handler;
CHECK_STRING (filename);
call the corresponding file handler. */
handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
if (!NILP (handler))
- return call2 (handler, Qsubstitute_in_file_name, filename);
+ {
+ Lisp_Object handled_name = call2 (handler, Qsubstitute_in_file_name,
+ filename);
+ if (STRINGP (handled_name))
+ return handled_name;
+ error ("Invalid handler in `file-name-handler-alist'");
+ }
/* 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 = (unsigned char *) alloca (SBYTES (filename) + 1);
- bcopy (SDATA (filename), nm, SBYTES (filename) + 1);
+ nm = alloca (SBYTES (filename) + 1);
+ memcpy (nm, SDATA (filename), SBYTES (filename) + 1);
#ifdef DOS_NT
- CORRECT_DIR_SEPS (nm);
+ dostounix_filename (nm);
substituted = (strcmp (nm, SDATA (filename)) != 0);
#endif
endp = nm + SBYTES (filename);
if (p)
/* Start over with the new string, so we check the file-name-handler
again. Important with filenames like "/home/foo//:/hello///there"
- which whould substitute to "/:/hello///there" rather than "/there". */
+ which would substitute to "/:/hello///there" rather than "/there". */
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' */
+ and find the total length of their values in `total'. */
for (p = nm; p != endp;)
if (*p != '$')
goto badsubst;
else if (*p == '$')
{
- /* "$$" means a single "$" */
+ /* "$$" means a single "$". */
p++;
total -= 1;
substituted = 1;
s = p;
}
- /* Copy out the variable name */
- target = (unsigned char *) alloca (s - o + 1);
- strncpy (target, o, s - o);
+ /* 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 */
- /* Get variable value */
- o = (unsigned char *) egetenv (target);
+ /* Get variable value. */
+ o = egetenv (target);
if (o)
{
/* Don't try to guess a maximum length - UTF8 can use up to
env variables twice should be acceptable. Note that
decoding may cause a garbage collect. */
Lisp_Object orig, decoded;
- orig = make_unibyte_string (o, strlen (o));
+ orig = build_unibyte_string (o);
decoded = DECODE_FILE (orig);
total += SBYTES (decoded);
substituted = 1;
if (!substituted)
return filename;
- /* If substitution required, recopy the string and do it */
- /* Make space in stack frame for the new copy */
- xnm = (unsigned char *) alloca (SBYTES (filename) + total + 1);
+ /* 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 */
+ /* Copy the rest of the name through, replacing $ constructs with values. */
for (p = nm; *p;)
if (*p != '$')
*x++ = *p++;
s = p;
}
- /* Copy out the variable name */
- target = (unsigned char *) alloca (s - o + 1);
- strncpy (target, o, s - o);
+ /* 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 */
- /* Get variable value */
- o = (unsigned char *) egetenv (target);
+ /* Get variable value. */
+ o = egetenv (target);
if (!o)
{
*x++ = '$';
else
{
Lisp_Object orig, decoded;
- int orig_length, decoded_length;
+ 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);
- strncpy (x, SDATA (decoded), decoded_length);
+ 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
- || strncmp (SDATA (decoded), o, orig_length))
+ || memcmp (SDATA (decoded), o, orig_length))
multibyte = 1;
}
}
(directory-file-name (expand-file-name FOO)). */
Lisp_Object
-expand_and_dir_to_file (filename, defdir)
- Lisp_Object filename, defdir;
+expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
{
register Lisp_Object absname;
stat behaves differently depending! */
if (SCHARS (absname) > 1
&& IS_DIRECTORY_SEP (SREF (absname, SBYTES (absname) - 1))
- && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname)-2)))
+ && !IS_DEVICE_SEP (SREF (absname, SBYTES (absname) - 2)))
/* We cannot take shortcuts; they might be wrong for magic file names. */
absname = Fdirectory_file_name (absname);
return absname;
If QUICK is nonzero, we ask for y or n, not yes or no. */
-void
-barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick)
- Lisp_Object absname;
- unsigned char *querystring;
- int interactive;
- struct stat *statptr;
- int quick;
+static void
+barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
+ int interactive, struct stat *statptr, int quick)
{
register Lisp_Object tem, encoded_filename;
struct stat statbuf;
encoded_filename = ENCODE_FILE (absname);
- /* stat is a good way to tell whether the file exists,
+ /* `stat' is a good way to tell whether the file exists,
regardless of what access permissions it has. */
- if (lstat (SDATA (encoded_filename), &statbuf) >= 0)
+ if (lstat (SSDATA (encoded_filename), &statbuf) >= 0)
{
+ if (S_ISDIR (statbuf.st_mode))
+ xsignal2 (Qfile_error,
+ build_string ("File is a directory"), absname);
+
if (! interactive)
xsignal2 (Qfile_already_exists,
build_string ("File already exists"), absname);
tem = format2 ("File %s already exists; %s anyway? ",
absname, build_string (querystring));
if (quick)
- tem = Fy_or_n_p (tem);
+ tem = call1 (intern ("y-or-n-p"), tem);
else
tem = do_yes_or_no_p (tem);
UNGCPRO;
return;
}
-DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 5,
+DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6,
"fCopy file: \nGCopy %s to file: \np\nP",
doc: /* Copy FILE to NEWNAME. Both args must be strings.
If NEWNAME names a directory, copy FILE there.
A prefix arg makes KEEP-TIME non-nil.
If PRESERVE-UID-GID is non-nil, we try to transfer the
-uid and gid of FILE to NEWNAME. */)
- (file, newname, ok_if_already_exists, keep_time, preserve_uid_gid)
- Lisp_Object file, newname, ok_if_already_exists, keep_time;
- Lisp_Object preserve_uid_gid;
+uid and gid of FILE to NEWNAME.
+
+If PRESERVE-SELINUX-CONTEXT is non-nil and SELinux is enabled
+on the system, we copy the SELinux context of FILE to NEWNAME. */)
+ (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists, Lisp_Object keep_time, Lisp_Object preserve_uid_gid, Lisp_Object preserve_selinux_context)
{
- int ifd, ofd, n;
+ int ifd, ofd;
+ int n;
char buf[16 * 1024];
struct stat st, out_st;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
int input_file_statable_p;
Lisp_Object encoded_file, encoded_newname;
+#if HAVE_LIBSELINUX
+ security_context_t con;
+ int fail, conlength = 0;
+#endif
encoded_file = encoded_newname = Qnil;
GCPRO4 (file, newname, encoded_file, encoded_newname);
if (NILP (handler))
handler = Ffind_file_name_handler (newname, Qcopy_file);
if (!NILP (handler))
- RETURN_UNGCPRO (call6 (handler, Qcopy_file, file, newname,
- ok_if_already_exists, keep_time, preserve_uid_gid));
+ RETURN_UNGCPRO (call7 (handler, Qcopy_file, file, newname,
+ ok_if_already_exists, keep_time, preserve_uid_gid,
+ preserve_selinux_context));
encoded_file = ENCODE_FILE (file);
encoded_newname = ENCODE_FILE (newname);
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "copy to it",
INTEGERP (ok_if_already_exists), &out_st, 0);
- else if (stat (SDATA (encoded_newname), &out_st) < 0)
+ else if (stat (SSDATA (encoded_newname), &out_st) < 0)
out_st.st_mode = 0;
#ifdef WINDOWSNT
DWORD attributes;
char * filename;
- EMACS_GET_TIME (now);
filename = SDATA (encoded_newname);
/* Ensure file is writable while its modified time is set. */
attributes = GetFileAttributes (filename);
SetFileAttributes (filename, attributes & ~FILE_ATTRIBUTE_READONLY);
- if (set_file_times (filename, now, now))
+ now = current_emacs_time ();
+ if (set_file_times (-1, filename, now, now))
{
/* Restore original attributes. */
SetFileAttributes (filename, attributes);
}
#else /* not WINDOWSNT */
immediate_quit = 1;
- ifd = emacs_open (SDATA (encoded_file), O_RDONLY, 0);
+ ifd = emacs_open (SSDATA (encoded_file), O_RDONLY, 0);
immediate_quit = 0;
if (ifd < 0)
copyable by us. */
input_file_statable_p = (fstat (ifd, &st) >= 0);
-#if !defined (MSDOS) || __DJGPP__ > 1
+#if HAVE_LIBSELINUX
+ if (!NILP (preserve_selinux_context) && is_selinux_enabled ())
+ {
+ conlength = fgetfilecon (ifd, &con);
+ if (conlength == -1)
+ report_file_error ("Doing fgetfilecon", Fcons (file, Qnil));
+ }
+#endif
+
if (out_st.st_mode != 0
&& st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
{
report_file_error ("Input and output files are the same",
Fcons (file, Fcons (newname, Qnil)));
}
-#endif
-#if defined (S_ISREG) && defined (S_ISLNK)
if (input_file_statable_p)
{
if (!(S_ISREG (st.st_mode)) && !(S_ISLNK (st.st_mode)))
report_file_error ("Non-regular file", Fcons (file, Qnil));
}
}
-#endif /* S_ISREG && S_ISLNK */
#ifdef MSDOS
/* System's default file type was set to binary by _fmode in emacs.c. */
| (NILP (ok_if_already_exists) ? O_EXCL : 0),
S_IREAD | S_IWRITE);
#else /* not MSDOS */
- ofd = emacs_open (SDATA (encoded_newname),
- O_WRONLY | O_TRUNC | O_CREAT
- | (NILP (ok_if_already_exists) ? O_EXCL : 0),
- 0666);
+ {
+ int new_mask = 0666;
+ if (input_file_statable_p)
+ {
+ if (!NILP (preserve_uid_gid))
+ new_mask = 0600;
+ new_mask &= st.st_mode;
+ }
+ 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));
owner and group. */
if (input_file_statable_p)
{
- if (! NILP (preserve_uid_gid))
- fchown (ofd, st.st_uid, st.st_gid);
- fchmod (ofd, st.st_mode & 07777);
+ int mode_mask = 07777;
+ if (!NILP (preserve_uid_gid))
+ {
+ /* Attempt to change owner and group. If that doesn't work
+ attempt to change just the group, as that is sometimes allowed.
+ Adjust the mode mask to eliminate setuid or setgid bits
+ that are inappropriate if the owner and group are wrong. */
+ if (fchown (ofd, st.st_uid, st.st_gid) != 0)
+ {
+ mode_mask &= ~06000;
+ if (fchown (ofd, -1, st.st_gid) == 0)
+ mode_mask |= 02000;
+ }
+ }
+ if (fchmod (ofd, st.st_mode & mode_mask) != 0)
+ report_file_error ("Doing chmod", Fcons (newname, Qnil));
}
#endif /* not MSDOS */
- /* Closing the output clobbers the file times on some systems. */
- if (emacs_close (ofd) < 0)
- report_file_error ("I/O error", Fcons (newname, Qnil));
+#if HAVE_LIBSELINUX
+ if (conlength > 0)
+ {
+ /* Set the modified context back to the file. */
+ fail = fsetfilecon (ofd, con);
+ /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
+ if (fail && errno != ENOTSUP)
+ report_file_error ("Doing fsetfilecon", Fcons (newname, Qnil));
+
+ freecon (con);
+ }
+#endif
if (input_file_statable_p)
{
if (!NILP (keep_time))
{
- EMACS_TIME atime, mtime;
- EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
- EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
- if (set_file_times (SDATA (encoded_newname),
- atime, mtime))
+ EMACS_TIME atime = get_stat_atime (&st);
+ EMACS_TIME 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);
}
}
+ if (emacs_close (ofd) < 0)
+ report_file_error ("I/O error", Fcons (newname, Qnil));
+
emacs_close (ifd);
-#if defined (__DJGPP__) && __DJGPP__ > 1
+#ifdef MSDOS
if (input_file_statable_p)
{
/* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
chmod (SDATA (encoded_newname), st.st_mode & 07777);
}
-#endif /* DJGPP version 2 or newer */
+#endif /* MSDOS */
#endif /* not WINDOWSNT */
/* Discard the unwind protects. */
DEFUN ("make-directory-internal", Fmake_directory_internal,
Smake_directory_internal, 1, 1, 0,
doc: /* Create a new directory named DIRECTORY. */)
- (directory)
- Lisp_Object directory;
+ (Lisp_Object directory)
{
- const unsigned char *dir;
+ const char *dir;
Lisp_Object handler;
Lisp_Object encoded_dir;
encoded_dir = ENCODE_FILE (directory);
- dir = SDATA (encoded_dir);
+ dir = SSDATA (encoded_dir);
#ifdef WINDOWSNT
if (mkdir (dir) != 0)
#else
- if (mkdir (dir, 0777) != 0)
+ if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0)
#endif
report_file_error ("Creating directory", list1 (directory));
DEFUN ("delete-directory-internal", Fdelete_directory_internal,
Sdelete_directory_internal, 1, 1, 0,
doc: /* Delete the directory named DIRECTORY. Does not follow symlinks. */)
- (directory)
- Lisp_Object directory;
+ (Lisp_Object directory)
{
- const unsigned char *dir;
- Lisp_Object handler;
+ const char *dir;
Lisp_Object encoded_dir;
CHECK_STRING (directory);
directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil));
-
- if (delete_by_moving_to_trash)
- return call1 (Qmove_file_to_trash, directory);
-
encoded_dir = ENCODE_FILE (directory);
-
- dir = SDATA (encoded_dir);
+ dir = SSDATA (encoded_dir);
if (rmdir (dir) != 0)
report_file_error ("Removing directory", list1 (directory));
return Qnil;
}
-DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
+DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 2,
+ "(list (read-file-name \
+ (if (and delete-by-moving-to-trash (null current-prefix-arg)) \
+ \"Move file to trash: \" \"Delete file: \") \
+ nil default-directory (confirm-nonexistent-file-or-buffer)) \
+ (null current-prefix-arg))",
doc: /* Delete file named FILENAME. If it is a symlink, remove the symlink.
-If file has multiple names, it continues to exist with the other names. */)
- (filename)
- Lisp_Object filename;
+If file has multiple names, it continues to exist with the other names.
+TRASH non-nil means to trash the file instead of deleting, provided
+`delete-by-moving-to-trash' is non-nil.
+
+When called interactively, TRASH is t if no prefix argument is given.
+With a prefix argument, TRASH is nil. */)
+ (Lisp_Object filename, Lisp_Object trash)
{
Lisp_Object handler;
Lisp_Object encoded_file;
handler = Ffind_file_name_handler (filename, Qdelete_file);
if (!NILP (handler))
- return call2 (handler, Qdelete_file, filename);
+ return call3 (handler, Qdelete_file, filename, trash);
- if (delete_by_moving_to_trash)
+ if (delete_by_moving_to_trash && !NILP (trash))
return call1 (Qmove_file_to_trash, filename);
encoded_file = ENCODE_FILE (filename);
- if (0 > unlink (SDATA (encoded_file)))
+ if (0 > unlink (SSDATA (encoded_file)))
report_file_error ("Removing old name", list1 (filename));
return Qnil;
}
static Lisp_Object
-internal_delete_file_1 (ignore)
- Lisp_Object ignore;
+internal_delete_file_1 (Lisp_Object ignore)
{
return Qt;
}
-/* Delete file FILENAME, returning 1 if successful and 0 if failed. */
+/* Delete file FILENAME, returning 1 if successful and 0 if failed.
+ This ignores `delete-by-moving-to-trash'. */
int
-internal_delete_file (filename)
- Lisp_Object filename;
+internal_delete_file (Lisp_Object filename)
{
Lisp_Object tem;
- tem = internal_condition_case_1 (Fdelete_file, filename,
+
+ tem = internal_condition_case_2 (Fdelete_file, filename, Qnil,
Qt, internal_delete_file_1);
return NILP (tem);
}
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
A number as third arg means request confirmation if NEWNAME already exists.
This is what happens in interactive use with M-x. */)
- (file, newname, ok_if_already_exists)
- Lisp_Object file, newname, ok_if_already_exists;
+ (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
{
Lisp_Object handler;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "rename to it",
INTEGERP (ok_if_already_exists), 0, 0);
- if (0 > rename (SDATA (encoded_file), SDATA (encoded_newname)))
+ if (0 > rename (SSDATA (encoded_file), SSDATA (encoded_newname)))
{
if (errno == EXDEV)
{
- int count;
-#ifdef S_IFLNK
+ ptrdiff_t count;
symlink_target = Ffile_symlink_p (file);
if (! NILP (symlink_target))
Fmake_symbolic_link (symlink_target, newname,
NILP (ok_if_already_exists) ? Qnil : Qt);
- else
-#endif
- if (!NILP (Ffile_directory_p (file)))
+ else if (!NILP (Ffile_directory_p (file)))
call4 (Qcopy_directory, file, newname, Qt, Qnil);
else
/* We have already prompted if it was an integer, so don't
have copy-file prompt again. */
Fcopy_file (file, newname,
NILP (ok_if_already_exists) ? Qnil : Qt,
- Qt, Qt);
+ Qt, Qt, Qt);
count = SPECPDL_INDEX ();
specbind (Qdelete_by_moving_to_trash, Qnil);
- if (!NILP (Ffile_directory_p (file))
-#ifdef S_IFLNK
- && NILP (symlink_target)
-#endif
- )
+ if (!NILP (Ffile_directory_p (file)) && NILP (symlink_target))
call2 (Qdelete_directory, file, Qt);
else
- Fdelete_file (file);
+ Fdelete_file (file, Qnil);
unbind_to (count, Qnil);
}
else
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
A number as third arg means request confirmation if NEWNAME already exists.
This is what happens in interactive use with M-x. */)
- (file, newname, ok_if_already_exists)
- Lisp_Object file, newname, ok_if_already_exists;
+ (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
{
Lisp_Object handler;
Lisp_Object encoded_file, encoded_newname;
barf_or_query_if_file_exists (newname, "make it a new name",
INTEGERP (ok_if_already_exists), 0, 0);
- unlink (SDATA (newname));
- if (0 > link (SDATA (encoded_file), SDATA (encoded_newname)))
+ unlink (SSDATA (newname));
+ if (0 > link (SSDATA (encoded_file), SSDATA (encoded_newname)))
report_file_error ("Adding new name", list2 (file, newname));
UNGCPRO;
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
A number as third arg means request confirmation if LINKNAME already exists.
This happens for interactive use with M-x. */)
- (filename, linkname, ok_if_already_exists)
- Lisp_Object filename, linkname, ok_if_already_exists;
+ (Lisp_Object filename, Lisp_Object linkname, Lisp_Object ok_if_already_exists)
{
Lisp_Object handler;
Lisp_Object encoded_filename, encoded_linkname;
RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
linkname, ok_if_already_exists));
-#ifdef S_IFLNK
encoded_filename = ENCODE_FILE (filename);
encoded_linkname = ENCODE_FILE (linkname);
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (linkname, "make it a link",
INTEGERP (ok_if_already_exists), 0, 0);
- if (0 > symlink (SDATA (encoded_filename),
- SDATA (encoded_linkname)))
+ if (0 > symlink (SSDATA (encoded_filename),
+ SSDATA (encoded_linkname)))
{
/* If we didn't complain already, silently delete existing file. */
if (errno == EEXIST)
{
- unlink (SDATA (encoded_linkname));
- if (0 <= symlink (SDATA (encoded_filename),
- SDATA (encoded_linkname)))
+ unlink (SSDATA (encoded_linkname));
+ if (0 <= symlink (SSDATA (encoded_filename),
+ SSDATA (encoded_linkname)))
{
UNGCPRO;
return Qnil;
}
}
+ if (errno == ENOSYS)
+ {
+ UNGCPRO;
+ xsignal1 (Qfile_error,
+ build_string ("Symbolic links are not supported"));
+ }
report_file_error ("Making symbolic link", list2 (filename, linkname));
}
UNGCPRO;
return Qnil;
-
-#else
- UNGCPRO;
- xsignal1 (Qfile_error, build_string ("Symbolic links are not supported"));
-
-#endif /* S_IFLNK */
}
\f
1, 1, 0,
doc: /* Return t if file FILENAME specifies an absolute file name.
On Unix, this is a name starting with a `/' or a `~'. */)
- (filename)
- Lisp_Object filename;
+ (Lisp_Object filename)
{
CHECK_STRING (filename);
- return file_name_absolute_p (SDATA (filename)) ? Qt : Qnil;
+ return file_name_absolute_p (SSDATA (filename)) ? Qt : Qnil;
}
\f
/* Return nonzero if file FILENAME exists and can be executed. */
static int
-check_executable (filename)
- char *filename;
+check_executable (char *filename)
{
#ifdef DOS_NT
- int len = strlen (filename);
- char *suffix;
struct stat st;
if (stat (filename, &st) < 0)
return 0;
-#if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
return ((st.st_mode & S_IEXEC) != 0);
-#else
- return (S_ISREG (st.st_mode)
- && len >= 5
- && (xstrcasecmp ((suffix = filename + len-4), ".com") == 0
- || xstrcasecmp (suffix, ".exe") == 0
- || xstrcasecmp (suffix, ".bat") == 0)
- || (st.st_mode & S_IFMT) == S_IFDIR);
-#endif /* not WINDOWSNT */
#else /* not DOS_NT */
#ifdef HAVE_EUIDACCESS
return (euidaccess (filename, 1) >= 0);
/* Return nonzero if file FILENAME exists and can be written. */
static int
-check_writable (filename)
- char *filename;
+check_writable (const char *filename)
{
#ifdef MSDOS
struct stat st;
if (stat (filename, &st) < 0)
return 0;
- return (st.st_mode & S_IWRITE || (st.st_mode & S_IFMT) == S_IFDIR);
+ return (st.st_mode & S_IWRITE || S_ISDIR (st.st_mode));
#else /* not MSDOS */
#ifdef HAVE_EUIDACCESS
- return (euidaccess (filename, 2) >= 0);
-#else
+ int res = (euidaccess (filename, 2) >= 0);
+#ifdef CYGWIN
+ /* euidaccess may have returned failure because Cygwin couldn't
+ determine the file's UID or GID; if so, we return success. */
+ if (!res)
+ {
+ struct stat st;
+ if (stat (filename, &st) < 0)
+ return 0;
+ res = (st.st_uid == -1 || st.st_gid == -1);
+ }
+#endif /* CYGWIN */
+ return res;
+#else /* not HAVE_EUIDACCESS */
/* Access isn't quite right because it uses the real uid
and we really want to test with the effective uid.
But Unix doesn't give us a right way to do it.
Opening with O_WRONLY could work for an ordinary file,
but would lose for directories. */
return (access (filename, 2) >= 0);
-#endif
+#endif /* not HAVE_EUIDACCESS */
#endif /* not MSDOS */
}
See also `file-readable-p' and `file-attributes'.
This returns nil for a symlink to a nonexistent file.
Use `file-symlink-p' to test for such links. */)
- (filename)
- Lisp_Object filename;
+ (Lisp_Object filename)
{
Lisp_Object absname;
Lisp_Object handler;
absname = ENCODE_FILE (absname);
- return (stat (SDATA (absname), &statbuf) >= 0) ? Qt : Qnil;
+ return (stat (SSDATA (absname), &statbuf) >= 0) ? Qt : Qnil;
}
DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
doc: /* Return t if FILENAME can be executed by you.
For a directory, this means you can access files in that directory. */)
- (filename)
- Lisp_Object filename;
+ (Lisp_Object filename)
{
Lisp_Object absname;
Lisp_Object handler;
absname = ENCODE_FILE (absname);
- return (check_executable (SDATA (absname)) ? Qt : Qnil);
+ return (check_executable (SSDATA (absname)) ? Qt : Qnil);
}
DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
doc: /* Return t if file FILENAME exists and you can read it.
See also `file-exists-p' and `file-attributes'. */)
- (filename)
- Lisp_Object filename;
+ (Lisp_Object filename)
{
Lisp_Object absname;
Lisp_Object handler;
absname = ENCODE_FILE (absname);
-#if defined(DOS_NT) || defined(macintosh)
+#if defined (DOS_NT) || defined (macintosh)
/* Under MS-DOS, Windows, and Macintosh, open does not work for
directories. */
if (access (SDATA (absname), 0) == 0)
return Qnil;
#else /* not DOS_NT and not macintosh */
flags = O_RDONLY;
-#if defined (S_ISFIFO) && defined (O_NONBLOCK)
+#ifdef O_NONBLOCK
/* Opening a fifo without O_NONBLOCK can wait.
We don't want to wait. But we don't want to mess wth O_NONBLOCK
except in the case of a fifo, on a system which handles it. */
- desc = stat (SDATA (absname), &statbuf);
+ desc = stat (SSDATA (absname), &statbuf);
if (desc < 0)
return Qnil;
if (S_ISFIFO (statbuf.st_mode))
flags |= O_NONBLOCK;
#endif
- desc = emacs_open (SDATA (absname), flags, 0);
+ desc = emacs_open (SSDATA (absname), flags, 0);
if (desc < 0)
return Qnil;
emacs_close (desc);
on the RT/PC. */
DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
doc: /* Return t if file FILENAME can be written or created by you. */)
- (filename)
- Lisp_Object filename;
+ (Lisp_Object filename)
{
Lisp_Object absname, dir, encoded;
Lisp_Object handler;
return call2 (handler, Qfile_writable_p, absname);
encoded = ENCODE_FILE (absname);
- if (stat (SDATA (encoded), &statbuf) >= 0)
- return (check_writable (SDATA (encoded))
+ if (stat (SSDATA (encoded), &statbuf) >= 0)
+ return (check_writable (SSDATA (encoded))
? Qt : Qnil);
dir = Ffile_name_directory (absname);
should check ACLs though, which do affect this. */
if (stat (SDATA (dir), &statbuf) < 0)
return Qnil;
- return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
+ return S_ISDIR (statbuf.st_mode) ? Qt : Qnil;
#else
- return (check_writable (!NILP (dir) ? (char *) SDATA (dir) : "")
+ return (check_writable (!NILP (dir) ? SSDATA (dir) : "")
? Qt : Qnil);
#endif
}
doc: /* Access file FILENAME, and get an error if that does not work.
The second argument STRING is used in the error message.
If there is no error, returns nil. */)
- (filename, string)
- Lisp_Object filename, string;
+ (Lisp_Object filename, Lisp_Object string)
{
Lisp_Object handler, encoded_filename, absname;
int fd;
encoded_filename = ENCODE_FILE (absname);
- fd = emacs_open (SDATA (encoded_filename), O_RDONLY, 0);
+ fd = emacs_open (SSDATA (encoded_filename), O_RDONLY, 0);
if (fd < 0)
- report_file_error (SDATA (string), Fcons (filename, Qnil));
+ report_file_error (SSDATA (string), Fcons (filename, Qnil));
emacs_close (fd);
return Qnil;
This function returns t when given the name of a symlink that
points to a nonexistent file. */)
- (filename)
- Lisp_Object filename;
+ (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);
if (!NILP (handler))
return call2 (handler, Qfile_symlink_p, filename);
-#ifdef S_IFLNK
- {
- char *buf;
- int bufsize;
- int valsize;
- Lisp_Object val;
-
filename = ENCODE_FILE (filename);
- bufsize = 50;
- buf = NULL;
- do
- {
- bufsize *= 2;
- buf = (char *) xrealloc (buf, bufsize);
- bzero (buf, bufsize);
-
- errno = 0;
- valsize = readlink (SDATA (filename), buf, bufsize);
- if (valsize == -1)
- {
-#ifdef ERANGE
- /* HP-UX reports ERANGE if buffer is too small. */
- if (errno == ERANGE)
- valsize = bufsize;
- else
-#endif
- {
- xfree (buf);
- return Qnil;
- }
- }
- }
- while (valsize >= bufsize);
+ buf = emacs_readlink (SSDATA (filename), readlink_buf);
+ if (! buf)
+ return Qnil;
- val = make_string (buf, valsize);
- if (buf[0] == '/' && index (buf, ':'))
+ val = build_string (buf);
+ if (buf[0] == '/' && strchr (buf, ':'))
val = concat2 (build_string ("/:"), val);
- xfree (buf);
+ if (buf != readlink_buf)
+ xfree (buf);
val = DECODE_FILE (val);
return val;
- }
-#else /* not S_IFLNK */
- return Qnil;
-#endif /* not S_IFLNK */
}
DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
doc: /* Return t if FILENAME names an existing directory.
Symbolic links to directories count as directories.
See `file-symlink-p' to distinguish symlinks. */)
- (filename)
- Lisp_Object filename;
+ (Lisp_Object filename)
{
register Lisp_Object absname;
struct stat st;
Lisp_Object handler;
- absname = expand_and_dir_to_file (filename, current_buffer->directory);
+ absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
/* If the file name has special constructs in it,
call the corresponding file handler. */
absname = ENCODE_FILE (absname);
- if (stat (SDATA (absname), &st) < 0)
+ if (stat (SSDATA (absname), &st) < 0)
return Qnil;
- return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
+ return S_ISDIR (st.st_mode) ? Qt : Qnil;
}
-DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0,
+DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p,
+ Sfile_accessible_directory_p, 1, 1, 0,
doc: /* Return t if file FILENAME names a directory you can open.
For the value to be t, FILENAME must specify the name of a directory as a file,
and the directory must allow you to open files in it. In order to use a
A directory name spec may be given instead; then the value is t
if the directory so specified exists and really is a readable and
searchable directory. */)
- (filename)
- Lisp_Object filename;
+ (Lisp_Object filename)
{
Lisp_Object handler;
int tem;
This is the sort of file that holds an ordinary stream of data bytes.
Symbolic links to regular files count as regular files.
See `file-symlink-p' to distinguish symlinks. */)
- (filename)
- Lisp_Object filename;
+ (Lisp_Object filename)
{
register Lisp_Object absname;
struct stat st;
Lisp_Object handler;
- absname = expand_and_dir_to_file (filename, current_buffer->directory);
+ absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
/* If the file name has special constructs in it,
call the corresponding file handler. */
if (result < 0)
return Qnil;
- return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
+ return S_ISREG (st.st_mode) ? Qt : Qnil;
}
#else
- if (stat (SDATA (absname), &st) < 0)
+ if (stat (SSDATA (absname), &st) < 0)
return Qnil;
- return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
+ return S_ISREG (st.st_mode) ? Qt : Qnil;
+#endif
+}
+\f
+DEFUN ("file-selinux-context", Ffile_selinux_context,
+ Sfile_selinux_context, 1, 1, 0,
+ doc: /* Return SELinux context of file named FILENAME.
+The return value is a list (USER ROLE TYPE RANGE), where the list
+elements are strings naming the user, role, type, and range of the
+file's SELinux security context.
+
+Return (nil nil nil nil) if the file is nonexistent or inaccessible,
+or if SELinux is disabled, or if Emacs lacks SELinux support. */)
+ (Lisp_Object filename)
+{
+ Lisp_Object absname;
+ Lisp_Object values[4];
+ Lisp_Object handler;
+#if HAVE_LIBSELINUX
+ security_context_t con;
+ int conlength;
+ context_t context;
+#endif
+
+ absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (absname, Qfile_selinux_context);
+ if (!NILP (handler))
+ return call2 (handler, Qfile_selinux_context, absname);
+
+ absname = ENCODE_FILE (absname);
+
+ values[0] = Qnil;
+ values[1] = Qnil;
+ values[2] = Qnil;
+ values[3] = Qnil;
+#if HAVE_LIBSELINUX
+ if (is_selinux_enabled ())
+ {
+ conlength = lgetfilecon (SSDATA (absname), &con);
+ if (conlength > 0)
+ {
+ context = context_new (con);
+ if (context_user_get (context))
+ values[0] = build_string (context_user_get (context));
+ if (context_role_get (context))
+ values[1] = build_string (context_role_get (context));
+ if (context_type_get (context))
+ values[2] = build_string (context_type_get (context));
+ if (context_range_get (context))
+ values[3] = build_string (context_range_get (context));
+ context_free (context);
+ }
+ if (con)
+ freecon (con);
+ }
+#endif
+
+ return Flist (sizeof (values) / sizeof (values[0]), values);
+}
+\f
+DEFUN ("set-file-selinux-context", Fset_file_selinux_context,
+ Sset_file_selinux_context, 2, 2, 0,
+ doc: /* Set SELinux context of file named FILENAME to CONTEXT.
+CONTEXT should be a list (USER ROLE TYPE RANGE), where the list
+elements are strings naming the components of a SELinux context.
+
+This function does nothing if SELinux is disabled, or if Emacs was not
+compiled with SELinux support. */)
+ (Lisp_Object filename, Lisp_Object context)
+{
+ Lisp_Object absname;
+ Lisp_Object handler;
+#if HAVE_LIBSELINUX
+ Lisp_Object encoded_absname;
+ Lisp_Object user = CAR_SAFE (context);
+ Lisp_Object role = CAR_SAFE (CDR_SAFE (context));
+ Lisp_Object type = CAR_SAFE (CDR_SAFE (CDR_SAFE (context)));
+ Lisp_Object range = CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (context))));
+ security_context_t con;
+ int fail, conlength;
+ context_t parsed_con;
+#endif
+
+ absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (absname, Qset_file_selinux_context);
+ if (!NILP (handler))
+ return call3 (handler, Qset_file_selinux_context, absname, context);
+
+#if HAVE_LIBSELINUX
+ if (is_selinux_enabled ())
+ {
+ /* Get current file context. */
+ encoded_absname = ENCODE_FILE (absname);
+ conlength = lgetfilecon (SSDATA (encoded_absname), &con);
+ if (conlength > 0)
+ {
+ parsed_con = context_new (con);
+ /* Change the parts defined in the parameter.*/
+ if (STRINGP (user))
+ {
+ if (context_user_set (parsed_con, SSDATA (user)))
+ error ("Doing context_user_set");
+ }
+ if (STRINGP (role))
+ {
+ if (context_role_set (parsed_con, SSDATA (role)))
+ error ("Doing context_role_set");
+ }
+ if (STRINGP (type))
+ {
+ if (context_type_set (parsed_con, SSDATA (type)))
+ error ("Doing context_type_set");
+ }
+ if (STRINGP (range))
+ {
+ if (context_range_set (parsed_con, SSDATA (range)))
+ error ("Doing context_range_set");
+ }
+
+ /* Set the modified context back to the file. */
+ fail = lsetfilecon (SSDATA (encoded_absname),
+ context_str (parsed_con));
+ /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
+ if (fail && errno != ENOTSUP)
+ report_file_error ("Doing lsetfilecon", Fcons (absname, Qnil));
+
+ context_free (parsed_con);
+ }
+ else
+ report_file_error ("Doing lgetfilecon", Fcons (absname, Qnil));
+
+ if (con)
+ freecon (con);
+ }
#endif
+
+ return Qnil;
}
\f
DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
doc: /* Return mode bits of file named FILENAME, as an integer.
Return nil, if file does not exist or is not accessible. */)
- (filename)
- Lisp_Object filename;
+ (Lisp_Object filename)
{
Lisp_Object absname;
struct stat st;
Lisp_Object handler;
- absname = expand_and_dir_to_file (filename, current_buffer->directory);
+ absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
/* If the file name has special constructs in it,
call the corresponding file handler. */
absname = ENCODE_FILE (absname);
- if (stat (SDATA (absname), &st) < 0)
+ if (stat (SSDATA (absname), &st) < 0)
return Qnil;
-#if defined (MSDOS) && __DJGPP__ < 2
- if (check_executable (SDATA (absname)))
- st.st_mode |= S_IEXEC;
-#endif /* MSDOS && __DJGPP__ < 2 */
return make_number (st.st_mode & 07777);
}
Interactively, mode bits are read by `read-file-modes', which accepts
symbolic notation, like the `chmod' command from GNU Coreutils. */)
- (filename, mode)
- Lisp_Object filename, mode;
+ (Lisp_Object filename, Lisp_Object mode)
{
Lisp_Object absname, encoded_absname;
Lisp_Object handler;
- absname = Fexpand_file_name (filename, current_buffer->directory);
+ absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
CHECK_NUMBER (mode);
/* If the file name has special constructs in it,
encoded_absname = ENCODE_FILE (absname);
- if (chmod (SDATA (encoded_absname), XINT (mode)) < 0)
+ if (chmod (SSDATA (encoded_absname), XINT (mode) & 07777) < 0)
report_file_error ("Doing chmod", Fcons (absname, Qnil));
return Qnil;
doc: /* Set the file permission bits for newly created files.
The argument MODE should be an integer; only the low 9 bits are used.
This setting is inherited by subprocesses. */)
- (mode)
- Lisp_Object mode;
+ (Lisp_Object mode)
{
CHECK_NUMBER (mode);
DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
doc: /* Return the default file protection for created files.
The value is an integer. */)
- ()
+ (void)
{
int realmask;
Lisp_Object value;
+ BLOCK_INPUT;
realmask = umask (0);
umask (realmask);
+ UNBLOCK_INPUT;
XSETINT (value, (~ realmask) & 0777);
return value;
}
\f
-extern int lisp_time_argument P_ ((Lisp_Object, time_t *, int *));
DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0,
- doc: /* Set times of file FILENAME to TIME.
+ doc: /* Set times of file FILENAME to TIMESTAMP.
Set both access and modification times.
Return t on success, else nil.
-Use the current time if TIME is nil. TIME is in the format of
+Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of
`current-time'. */)
- (filename, time)
- Lisp_Object filename, time;
+ (Lisp_Object filename, Lisp_Object timestamp)
{
Lisp_Object absname, encoded_absname;
Lisp_Object handler;
- time_t sec;
- int usec;
+ EMACS_TIME t = lisp_time_argument (timestamp);
- if (! lisp_time_argument (time, &sec, &usec))
- error ("Invalid time specification");
-
- absname = Fexpand_file_name (filename, current_buffer->directory);
+ absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = Ffind_file_name_handler (absname, Qset_file_times);
if (!NILP (handler))
- return call3 (handler, Qset_file_times, absname, time);
+ return call3 (handler, Qset_file_times, absname, timestamp);
encoded_absname = ENCODE_FILE (absname);
{
- EMACS_TIME t;
-
- EMACS_SET_SECS (t, sec);
- EMACS_SET_USECS (t, usec);
-
- if (set_file_times (SDATA (encoded_absname), t, t))
+ if (set_file_times (-1, SSDATA (encoded_absname), t, t))
{
#ifdef DOS_NT
struct stat st;
/* Setting times on a directory always fails. */
- if (stat (SDATA (encoded_absname), &st) == 0
- && (st.st_mode & S_IFMT) == S_IFDIR)
+ if (stat (SSDATA (encoded_absname), &st) == 0 && S_ISDIR (st.st_mode))
return Qnil;
#endif
report_file_error ("Setting file times", Fcons (absname, Qnil));
#ifdef HAVE_SYNC
DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
doc: /* Tell Unix to finish all pending disk updates. */)
- ()
+ (void)
{
sync ();
return Qnil;
doc: /* Return t if file FILE1 is newer than file FILE2.
If FILE1 does not exist, the answer is nil;
otherwise, if FILE2 does not exist, the answer is t. */)
- (file1, file2)
- Lisp_Object file1, file2;
+ (Lisp_Object file1, Lisp_Object file2)
{
Lisp_Object absname1, absname2;
- struct stat st;
- int mtime1;
+ struct stat st1, st2;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
absname1 = Qnil;
GCPRO2 (absname1, file2);
- absname1 = expand_and_dir_to_file (file1, current_buffer->directory);
- absname2 = expand_and_dir_to_file (file2, current_buffer->directory);
+ absname1 = expand_and_dir_to_file (file1, BVAR (current_buffer, directory));
+ absname2 = expand_and_dir_to_file (file2, BVAR (current_buffer, directory));
UNGCPRO;
/* If the file name has special constructs in it,
absname2 = ENCODE_FILE (absname2);
UNGCPRO;
- if (stat (SDATA (absname1), &st) < 0)
+ if (stat (SSDATA (absname1), &st1) < 0)
return Qnil;
- mtime1 = st.st_mtime;
-
- if (stat (SDATA (absname2), &st) < 0)
+ if (stat (SSDATA (absname2), &st2) < 0)
return Qt;
- return (mtime1 > st.st_mtime) ? Qt : Qnil;
+ return (EMACS_TIME_GT (get_stat_mtime (&st1), get_stat_mtime (&st2))
+ ? Qt : Qnil);
}
\f
-#ifdef DOS_NT
-Lisp_Object Qfind_buffer_file_type;
-#endif /* DOS_NT */
-
#ifndef READ_BUF_SIZE
#define READ_BUF_SIZE (64 << 10)
#endif
+/* Some buffer offsets are stored in 'int' variables. */
+verify (READ_BUF_SIZE <= INT_MAX);
/* This function is called after Lisp functions to decide a coding
system are called, or when they cause an error. Before they are
o set back the buffer multibyteness. */
static Lisp_Object
-decide_coding_unwind (unwind_data)
- Lisp_Object unwind_data;
+decide_coding_unwind (Lisp_Object unwind_data)
{
Lisp_Object multibyte, undo_list, buffer;
set_buffer_internal (XBUFFER (buffer));
adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE);
adjust_overlays_for_delete (BEG, Z - BEG);
- BUF_INTERVALS (current_buffer) = 0;
+ buffer_set_intervals (current_buffer, NULL);
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
/* Now we are safe to change the buffer's multibyteness directly. */
- current_buffer->enable_multibyte_characters = multibyte;
- current_buffer->undo_list = undo_list;
+ BSET (current_buffer, enable_multibyte_characters, multibyte);
+ BSET (current_buffer, undo_list, undo_list);
return Qnil;
}
/* Used to pass values from insert-file-contents to read_non_regular. */
static int non_regular_fd;
-static EMACS_INT non_regular_inserted;
-static EMACS_INT non_regular_nbytes;
+static ptrdiff_t non_regular_inserted;
+static int non_regular_nbytes;
/* Read from a non-regular file.
- Read non_regular_trytry bytes max from non_regular_fd.
+ Read non_regular_nbytes bytes max from non_regular_fd.
Non_regular_inserted specifies where to put the read bytes.
Value is the number of bytes read. */
static Lisp_Object
-read_non_regular ()
+read_non_regular (Lisp_Object ignore)
{
- EMACS_INT nbytes;
+ int nbytes;
immediate_quit = 1;
QUIT;
nbytes = emacs_read (non_regular_fd,
- BEG_ADDR + PT_BYTE - BEG_BYTE + non_regular_inserted,
+ ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
+ + non_regular_inserted),
non_regular_nbytes);
immediate_quit = 0;
return make_number (nbytes);
in insert-file-contents. */
static Lisp_Object
-read_non_regular_quit ()
+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. */
+static off_t
+emacs_lseek (int fd, EMACS_INT offset, int whence)
+{
+ /* Use "&" rather than "&&" to suppress a bogus GCC warning; see
+ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43772>. */
+ if (! ((TYPE_MINIMUM (off_t) <= offset) & (offset <= TYPE_MAXIMUM (off_t))))
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ return lseek (fd, offset, whence);
+}
+
+/* Return a special time value indicating the error number ERRNUM. */
+static EMACS_TIME
+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);
+}
DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
1, 5, 0,
This function does code conversion according to the value of
`coding-system-for-read' or `file-coding-system-alist', and sets the
variable `last-coding-system-used' to the coding system actually used. */)
- (filename, visit, beg, end, replace)
- Lisp_Object filename, visit, beg, end, replace;
+ (Lisp_Object filename, Lisp_Object visit, Lisp_Object beg, Lisp_Object end, Lisp_Object replace)
{
struct stat st;
+ int file_status;
+ EMACS_TIME mtime;
register int fd;
- EMACS_INT inserted = 0;
+ ptrdiff_t inserted = 0;
int nochange = 0;
- register EMACS_INT how_much;
- register EMACS_INT unprocessed;
- int count = SPECPDL_INDEX ();
+ register ptrdiff_t how_much;
+ off_t beg_offset, end_offset;
+ register int unprocessed;
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
Lisp_Object handler, val, insval, orig_filename, old_undo;
Lisp_Object p;
- EMACS_INT total = 0;
+ ptrdiff_t total = 0;
int not_regular = 0;
- unsigned char read_buf[READ_BUF_SIZE];
+ int save_errno = 0;
+ char read_buf[READ_BUF_SIZE];
struct coding_system coding;
- unsigned char buffer[1 << 14];
+ char buffer[1 << 14];
int replace_handled = 0;
int set_coding_system = 0;
Lisp_Object coding_system;
if (current_buffer->base_buffer && ! NILP (visit))
error ("Cannot do file visiting in an indirect buffer");
- if (!NILP (current_buffer->read_only))
+ if (!NILP (BVAR (current_buffer, read_only)))
Fbarf_if_buffer_read_only ();
val = Qnil;
{
val = call6 (handler, Qinsert_file_contents, filename,
visit, beg, end, replace);
- if (CONSP (val) && CONSP (XCDR (val)))
+ if (CONSP (val) && CONSP (XCDR (val))
+ && RANGED_INTEGERP (0, XCAR (XCDR (val)), ZV - PT))
inserted = XINT (XCAR (XCDR (val)));
goto handled;
}
/* Tell stat to use expensive method to get accurate info. */
Vw32_get_true_file_attributes = Qt;
- total = stat (SDATA (filename), &st);
+ file_status = stat (SSDATA (filename), &st);
Vw32_get_true_file_attributes = tem;
}
- if (total < 0)
#else
- if (stat (SDATA (filename), &st) < 0)
+ file_status = stat (SSDATA (filename), &st);
#endif /* WINDOWSNT */
+
+ if (file_status == 0)
+ mtime = get_stat_mtime (&st);
+ else
{
- if (fd >= 0) emacs_close (fd);
badopen:
+ save_errno = errno;
if (NILP (visit))
report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
- st.st_mtime = -1;
+ 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;
}
-#ifdef S_IFREG
/* This code will need to be changed in order to work on named
pipes, and it's probably just not worth it. So we should at
least signal an error. */
xsignal2 (Qfile_error,
build_string ("not a regular file"), orig_filename);
}
-#endif
if (fd < 0)
- if ((fd = emacs_open (SDATA (filename), O_RDONLY, 0)) < 0)
+ if ((fd = emacs_open (SSDATA (filename), O_RDONLY, 0)) < 0)
goto badopen;
/* Replacement should preserve point as it preserves markers. */
record_unwind_protect (close_file_unwind, make_number (fd));
- /* Can happen on any platform that uses long as type of off_t, but allows
- file sizes to exceed 2Gb, so give a suitable message. */
- if (! not_regular && st.st_size < 0)
- error ("Maximum buffer size exceeded");
-
- /* Prevent redisplay optimizations. */
- current_buffer->clip_changed = 1;
if (!NILP (visit))
{
}
if (!NILP (beg))
- CHECK_NUMBER (beg);
+ {
+ if (! (RANGED_INTEGERP (0, beg, TYPE_MAXIMUM (off_t))))
+ wrong_type_argument (intern ("file-offset"), beg);
+ beg_offset = XFASTINT (beg);
+ }
else
- XSETFASTINT (beg, 0);
+ beg_offset = 0;
if (!NILP (end))
- CHECK_NUMBER (end);
+ {
+ if (! (RANGED_INTEGERP (0, end, TYPE_MAXIMUM (off_t))))
+ wrong_type_argument (intern ("file-offset"), end);
+ end_offset = XFASTINT (end);
+ }
else
{
- if (! not_regular)
+ if (not_regular)
+ end_offset = TYPE_MAXIMUM (off_t);
+ else
{
- XSETINT (end, st.st_size);
-
- /* Arithmetic overflow can occur if an Emacs integer cannot
- represent the file size, or if the calculations below
- overflow. The calculations below double the file size
- twice, so check that it can be multiplied by 4 safely. */
- if (XINT (end) != st.st_size
- /* Actually, it should test either INT_MAX or LONG_MAX
- depending on which one is used for EMACS_INT. But in
- any case, in practice, this test is redundant with the
- one above.
- || st.st_size > INT_MAX / 4 */)
- error ("Maximum buffer size exceeded");
+ end_offset = st.st_size;
+
+ /* A negative size can happen on a platform that allows file
+ sizes greater than the maximum off_t value. */
+ if (end_offset < 0)
+ buffer_overflow ();
/* The file size returned from stat may be zero, but data
may be readable nonetheless, for example when this is a
file in the /proc filesystem. */
- if (st.st_size == 0)
- XSETINT (end, READ_BUF_SIZE);
+ if (end_offset == 0)
+ end_offset = READ_BUF_SIZE;
+ }
+ }
+
+ /* Check now whether the buffer will become too large,
+ in the likely case where the file's length is not changing.
+ This saves a lot of needless work before a buffer overflow. */
+ if (! not_regular)
+ {
+ /* The likely offset where we will stop reading. We could read
+ more (or less), if the file grows (or shrinks) as we read it. */
+ off_t likely_end = min (end_offset, st.st_size);
+
+ if (beg_offset < likely_end)
+ {
+ ptrdiff_t buf_bytes =
+ Z_BYTE - (!NILP (replace) ? ZV_BYTE - BEGV_BYTE : 0);
+ ptrdiff_t buf_growth_max = BUF_BYTES_MAX - buf_bytes;
+ off_t likely_growth = likely_end - beg_offset;
+ if (buf_growth_max < likely_growth)
+ buffer_overflow ();
}
}
+ /* Prevent redisplay optimizations. */
+ current_buffer->clip_changed = 1;
+
if (EQ (Vcoding_system_for_read, Qauto_save_coding))
{
coding_system = coding_inherit_eol_type (Qutf_8_emacs, Qunix);
We assume that the 1K-byte and 3K-byte for heading
and tailing respectively are sufficient for this
purpose. */
- EMACS_INT nread;
+ int nread;
if (st.st_size <= (1024 * 4))
nread = emacs_read (fd, read_buf, 1024 * 4);
nread = emacs_read (fd, read_buf, 1024);
if (nread >= 0)
{
- if (lseek (fd, st.st_size - (1024 * 3), 0) < 0)
+ if (lseek (fd, st.st_size - (1024 * 3), SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
nread += emacs_read (fd, read_buf + nread, 1024 * 3);
else if (nread > 0)
{
struct buffer *prev = current_buffer;
- Lisp_Object buffer;
+ Lisp_Object workbuf;
struct buffer *buf;
record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
- buffer = Fget_buffer_create (build_string (" *code-converting-work*"));
- buf = XBUFFER (buffer);
+ workbuf = Fget_buffer_create (build_string (" *code-converting-work*"));
+ buf = XBUFFER (workbuf);
delete_all_overlays (buf);
- buf->directory = current_buffer->directory;
- buf->read_only = Qnil;
- buf->filename = Qnil;
- buf->undo_list = Qt;
+ BSET (buf, directory, BVAR (current_buffer, directory));
+ BSET (buf, read_only, Qnil);
+ BSET (buf, filename, Qnil);
+ BSET (buf, undo_list, Qt);
eassert (buf->overlays_before == NULL);
eassert (buf->overlays_after == NULL);
set_buffer_internal (buf);
Ferase_buffer ();
- buf->enable_multibyte_characters = Qnil;
+ BSET (buf, enable_multibyte_characters, Qnil);
- insert_1_both (read_buf, nread, nread, 0, 0, 0);
+ 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));
specpdl_ptr--;
/* Rewind the file for the actual read done later. */
- if (lseek (fd, 0, 0) < 0)
+ if (lseek (fd, 0, SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
}
else
CHECK_CODING_SYSTEM (coding_system);
- if (NILP (current_buffer->enable_multibyte_characters))
+ if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
/* We must suppress all character code conversion except for
end-of-line conversion. */
coding_system = raw_text_coding_system (coding_system);
/* same_at_start and same_at_end count bytes,
because file access counts bytes
and BEG and END count bytes. */
- EMACS_INT same_at_start = BEGV_BYTE;
- EMACS_INT same_at_end = ZV_BYTE;
- EMACS_INT overlap;
+ ptrdiff_t same_at_start = BEGV_BYTE;
+ ptrdiff_t same_at_end = ZV_BYTE;
+ ptrdiff_t overlap;
/* There is still a possibility we will find the need to do code
conversion. If that happens, we set this variable to 1 to
give up on handling REPLACE in the optimized way. */
int giveup_match_end = 0;
- if (XINT (beg) != 0)
+ if (beg_offset != 0)
{
- if (lseek (fd, XINT (beg), 0) < 0)
+ if (lseek (fd, beg_offset, SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
}
match the text at the beginning of the buffer. */
while (1)
{
- EMACS_INT nread, bufpos;
+ int nread, bufpos;
nread = emacs_read (fd, buffer, sizeof buffer);
if (nread < 0)
error ("IO error reading %s: %s",
- SDATA (orig_filename), emacs_strerror (errno));
+ SSDATA (orig_filename), emacs_strerror (errno));
else if (nread == 0)
break;
if (CODING_REQUIRE_DETECTION (&coding))
{
- coding_system = detect_coding_system (buffer, nread, nread, 1, 0,
+ coding_system = detect_coding_system ((unsigned char *) buffer,
+ nread, nread, 1, 0,
coding_system);
setup_coding_system (coding_system, &coding);
}
immediate_quit = 0;
/* If the file matches the buffer completely,
there's no need to replace anything. */
- if (same_at_start - BEGV_BYTE == XINT (end))
+ if (same_at_start - BEGV_BYTE == end_offset - beg_offset)
{
emacs_close (fd);
specpdl_ptr--;
already found that decoding is necessary, don't waste time. */
while (!giveup_match_end)
{
- EMACS_INT total_read, nread, bufpos, curpos, trial;
+ int total_read, nread, bufpos, trial;
+ off_t curpos;
/* At what file position are we now scanning? */
- curpos = XINT (end) - (ZV_BYTE - same_at_end);
+ curpos = end_offset - (ZV_BYTE - same_at_end);
/* If the entire file matches the buffer tail, stop the scan. */
if (curpos == 0)
break;
/* How much can we scan in the next step? */
trial = min (curpos, sizeof buffer);
- if (lseek (fd, curpos - trial, 0) < 0)
+ if (lseek (fd, curpos - trial, SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
we cannot use this method; giveup and try the other. */
if (same_at_end > same_at_start
&& FETCH_BYTE (same_at_end - 1) >= 0200
- && ! NILP (current_buffer->enable_multibyte_characters)
+ && ! NILP (BVAR (current_buffer, enable_multibyte_characters))
&& (CODING_MAY_REQUIRE_DECODING (&coding)))
giveup_match_end = 1;
break;
if (! giveup_match_end)
{
- EMACS_INT temp;
+ ptrdiff_t temp;
/* We win! We can handle REPLACE the optimized way. */
/* Extend the start of non-matching text area to multibyte
character boundary. */
- if (! NILP (current_buffer->enable_multibyte_characters))
+ if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
while (same_at_start > BEGV_BYTE
&& ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
same_at_start--;
/* Extend the end of non-matching text area to multibyte
character boundary. */
- if (! NILP (current_buffer->enable_multibyte_characters))
+ if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
while (same_at_end < ZV_BYTE
&& ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
same_at_end++;
/* Don't try to reuse the same piece of text twice. */
overlap = (same_at_start - BEGV_BYTE
- - (same_at_end + st.st_size - ZV));
+ - (same_at_end
+ + (! NILP (end) ? end_offset : st.st_size) - ZV_BYTE));
if (overlap > 0)
same_at_end += overlap;
/* Arrange to read only the nonmatching middle part of the file. */
- XSETFASTINT (beg, XINT (beg) + (same_at_start - BEGV_BYTE));
- XSETFASTINT (end, XINT (end) - (ZV_BYTE - same_at_end));
+ beg_offset += same_at_start - BEGV_BYTE;
+ end_offset -= ZV_BYTE - same_at_end;
del_range_byte (same_at_start, same_at_end, 0);
/* Insert from the file at the proper position. */
/* If display currently starts at beginning of line,
keep it that way. */
if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
- XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
+ XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
replace_handled = 1;
}
in a more optimized way. */
if (!NILP (replace) && ! replace_handled && BEGV < ZV)
{
- EMACS_INT same_at_start = BEGV_BYTE;
- EMACS_INT same_at_end = ZV_BYTE;
- EMACS_INT same_at_start_charpos;
- EMACS_INT inserted_chars;
- EMACS_INT overlap;
- EMACS_INT bufpos;
+ ptrdiff_t same_at_start = BEGV_BYTE;
+ ptrdiff_t same_at_end = ZV_BYTE;
+ ptrdiff_t same_at_start_charpos;
+ ptrdiff_t inserted_chars;
+ ptrdiff_t overlap;
+ ptrdiff_t bufpos;
unsigned char *decoded;
- EMACS_INT temp;
- int this_count = SPECPDL_INDEX ();
- int multibyte = ! NILP (current_buffer->enable_multibyte_characters);
+ ptrdiff_t temp;
+ ptrdiff_t this = 0;
+ ptrdiff_t this_count = SPECPDL_INDEX ();
+ int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
Lisp_Object conversion_buffer;
+ struct gcpro gcpro1;
conversion_buffer = code_conversion_save (1, multibyte);
/* First read the whole file, performing code conversion into
CONVERSION_BUFFER. */
- if (lseek (fd, XINT (beg), 0) < 0)
+ if (lseek (fd, beg_offset, SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
{
/* 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) */
- EMACS_INT trytry = min (total - how_much,
- READ_BUF_SIZE - unprocessed);
- EMACS_INT this;
+ /* `try'' is reserved in some compilers (Microsoft C). */
+ int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed);
/* Allow quitting out of the actual I/O. */
immediate_quit = 1;
immediate_quit = 0;
if (this <= 0)
- {
- if (this < 0)
- how_much = this;
- break;
- }
+ break;
how_much += this;
BUF_TEMP_SET_PT (XBUFFER (conversion_buffer),
BUF_Z (XBUFFER (conversion_buffer)));
- decode_coding_c_string (&coding, read_buf, unprocessed + this,
- conversion_buffer);
+ decode_coding_c_string (&coding, (unsigned char *) read_buf,
+ unprocessed + this, conversion_buffer);
unprocessed = coding.carryover_bytes;
if (coding.carryover_bytes > 0)
- bcopy (coding.carryover, read_buf, unprocessed);
+ memcpy (read_buf, coding.carryover, unprocessed);
}
UNGCPRO;
emacs_close (fd);
/* At this point, HOW_MUCH should equal TOTAL, or should be <= 0
if we couldn't read the file. */
- if (how_much < 0)
+ if (this < 0)
error ("IO error reading %s: %s",
SDATA (orig_filename), emacs_strerror (errno));
if (unprocessed > 0)
{
coding.mode |= CODING_MODE_LAST_BLOCK;
- decode_coding_c_string (&coding, read_buf, unprocessed,
- conversion_buffer);
+ decode_coding_c_string (&coding, (unsigned char *) read_buf,
+ unprocessed, conversion_buffer);
coding.mode &= ~CODING_MODE_LAST_BLOCK;
}
/* Extend the start of non-matching text area to the previous
multibyte character boundary. */
- if (! NILP (current_buffer->enable_multibyte_characters))
+ if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
while (same_at_start > BEGV_BYTE
&& ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
same_at_start--;
/* Extend the end of non-matching text area to the next
multibyte character boundary. */
- if (! NILP (current_buffer->enable_multibyte_characters))
+ if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
while (same_at_end < ZV_BYTE
&& ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
same_at_end++;
/* If display currently starts at beginning of line,
keep it that way. */
if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
- XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
+ XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ());
/* Replace the chars that we need to replace,
and update INSERTED to equal the number of bytes
}
if (! not_regular)
- {
- register Lisp_Object temp;
-
- total = XINT (end) - XINT (beg);
-
- /* Make sure point-max won't overflow after this insertion. */
- XSETINT (temp, total);
- if (total != XINT (temp))
- error ("Maximum buffer size exceeded");
- }
+ total = end_offset - beg_offset;
else
/* For a special file, all we can do is guess. */
total = READ_BUF_SIZE;
- if (NILP (visit) && inserted > 0)
+ if (NILP (visit) && total > 0)
{
#ifdef CLASH_DETECTION
- if (!NILP (current_buffer->file_truename)
+ if (!NILP (BVAR (current_buffer, file_truename))
/* Make binding buffer-file-name to nil effective. */
- && !NILP (current_buffer->filename)
+ && !NILP (BVAR (current_buffer, filename))
&& SAVE_MODIFF >= MODIFF)
we_locked_file = 1;
#endif /* CLASH_DETECTION */
if (GAP_SIZE < total)
make_gap (total - GAP_SIZE);
- if (XINT (beg) != 0 || !NILP (replace))
+ if (beg_offset != 0 || !NILP (replace))
{
- if (lseek (fd, XINT (beg), 0) < 0)
+ if (lseek (fd, beg_offset, SEEK_SET) < 0)
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
}
/* 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. */
{
- EMACS_INT gap_size = GAP_SIZE;
+ ptrdiff_t gap_size = GAP_SIZE;
while (how_much < total)
{
/* try is reserved in some compilers (Microsoft C) */
- EMACS_INT trytry = min (total - how_much, READ_BUF_SIZE);
- EMACS_INT this;
+ int trytry = min (total - how_much, READ_BUF_SIZE);
+ ptrdiff_t this;
if (not_regular)
{
- Lisp_Object val;
+ Lisp_Object nbytes;
/* Maybe make more room. */
if (gap_size < trytry)
non_regular_fd = fd;
non_regular_inserted = inserted;
non_regular_nbytes = trytry;
- val = internal_condition_case_1 (read_non_regular, Qnil, Qerror,
- read_non_regular_quit);
- if (NILP (val))
+ nbytes = internal_condition_case_1 (read_non_regular,
+ Qnil, Qerror,
+ read_non_regular_quit);
+ if (NILP (nbytes))
{
read_quit = 1;
break;
}
- this = XINT (val);
+ this = XINT (nbytes);
}
else
{
here doesn't do any harm. */
immediate_quit = 1;
QUIT;
- this = emacs_read (fd, BEG_ADDR + PT_BYTE - BEG_BYTE + inserted, trytry);
+ this = emacs_read (fd,
+ ((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
+ + inserted),
+ trytry);
immediate_quit = 0;
}
{
#ifdef CLASH_DETECTION
if (we_locked_file)
- unlock_file (current_buffer->file_truename);
+ unlock_file (BVAR (current_buffer, file_truename));
#endif
Vdeactivate_mark = old_Vdeactivate_mark;
}
care of marker adjustment. By this way, we can run Lisp
program safely before decoding the inserted text. */
Lisp_Object unwind_data;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count1 = SPECPDL_INDEX ();
- unwind_data = Fcons (current_buffer->enable_multibyte_characters,
- Fcons (current_buffer->undo_list,
+ unwind_data = Fcons (BVAR (current_buffer, enable_multibyte_characters),
+ Fcons (BVAR (current_buffer, undo_list),
Fcurrent_buffer ()));
- current_buffer->enable_multibyte_characters = Qnil;
- current_buffer->undo_list = Qt;
+ BSET (current_buffer, enable_multibyte_characters, Qnil);
+ BSET (current_buffer, undo_list, Qt);
record_unwind_protect (decide_coding_unwind, unwind_data);
if (inserted > 0 && ! NILP (Vset_auto_coding_function))
if (CONSP (coding_system))
coding_system = XCAR (coding_system);
}
- unbind_to (count, Qnil);
+ unbind_to (count1, Qnil);
inserted = Z_BYTE - BEG_BYTE;
}
else
CHECK_CODING_SYSTEM (coding_system);
- if (NILP (current_buffer->enable_multibyte_characters))
+ if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
/* We must suppress all character code conversion except for
end-of-line conversion. */
coding_system = raw_text_coding_system (coding_system);
&& NILP (replace))
/* Visiting a file with these coding system makes the buffer
unibyte. */
- current_buffer->enable_multibyte_characters = Qnil;
+ BSET (current_buffer, enable_multibyte_characters, Qnil);
}
- coding.dst_multibyte = ! NILP (current_buffer->enable_multibyte_characters);
+ coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
if (CODING_MAY_REQUIRE_DECODING (&coding)
&& (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding)))
{
adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
inserted);
- /* Now INSERTED is measured in characters. */
+ /* Call after-change hooks for the inserted text, aside from the case
+ of normal visiting (not with REPLACE), which is done in a new buffer
+ "before" the buffer is changed. */
+ if (inserted > 0 && total > 0
+ && (NILP (visit) || !NILP (replace)))
+ {
+ signal_after_change (PT, 0, inserted);
+ update_compositions (PT, PT, CHECK_BORDER);
+ }
-#ifdef DOS_NT
- /* Use the conversion type to determine buffer-file-type
- (find-buffer-file-type is now used to help determine the
- conversion). */
- if ((VECTORP (CODING_ID_EOL_TYPE (coding.id))
- || EQ (CODING_ID_EOL_TYPE (coding.id), Qunix))
- && ! CODING_REQUIRE_DECODING (&coding))
- current_buffer->buffer_file_type = Qt;
- else
- current_buffer->buffer_file_type = Qnil;
-#endif
+ /* Now INSERTED is measured in characters. */
handled:
if (!NILP (visit))
{
- if (!EQ (current_buffer->undo_list, Qt) && !nochange)
- current_buffer->undo_list = Qnil;
+ if (!EQ (BVAR (current_buffer, undo_list), Qt) && !nochange)
+ BSET (current_buffer, undo_list, Qnil);
if (NILP (handler))
{
- current_buffer->modtime = st.st_mtime;
- current_buffer->filename = orig_filename;
+ current_buffer->modtime = mtime;
+ current_buffer->modtime_size = st.st_size;
+ BSET (current_buffer, filename, orig_filename);
}
SAVE_MODIFF = MODIFF;
BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
- XSETFASTINT (current_buffer->save_length, Z - BEG);
+ XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
#ifdef CLASH_DETECTION
if (NILP (handler))
{
- if (!NILP (current_buffer->file_truename))
- unlock_file (current_buffer->file_truename);
+ if (!NILP (BVAR (current_buffer, file_truename)))
+ unlock_file (BVAR (current_buffer, file_truename));
unlock_file (filename);
}
#endif /* CLASH_DETECTION */
visit);
if (! NILP (insval))
{
- CHECK_NUMBER (insval);
+ if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ wrong_type_argument (intern ("inserted-chars"), insval);
inserted = XFASTINT (insval);
}
}
if (inserted > 0)
{
/* Don't run point motion or modification hooks when decoding. */
- int count = SPECPDL_INDEX ();
- EMACS_INT old_inserted = inserted;
+ ptrdiff_t count1 = SPECPDL_INDEX ();
+ ptrdiff_t old_inserted = inserted;
specbind (Qinhibit_point_motion_hooks, Qt);
specbind (Qinhibit_modification_hooks, Qt);
/* Save old undo list and don't record undo for decoding. */
- old_undo = current_buffer->undo_list;
- current_buffer->undo_list = Qt;
+ old_undo = BVAR (current_buffer, undo_list);
+ BSET (current_buffer, undo_list, Qt);
if (NILP (replace))
{
insval = call3 (Qformat_decode,
Qnil, make_number (inserted), visit);
- CHECK_NUMBER (insval);
+ if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ wrong_type_argument (intern ("inserted-chars"), insval);
inserted = XFASTINT (insval);
}
else
/* If REPLACE is non-nil and we succeeded in not replacing the
beginning or end of the buffer text with the file's contents,
call format-decode with `point' positioned at the beginning
- of the buffer and `inserted' equalling the number of
+ of the buffer and `inserted' equaling the number of
characters in the buffer. Otherwise, format-decode might
fail to correctly analyze the beginning or end of the buffer.
Hence we temporarily save `point' and `inserted' here and
restore `point' iff format-decode did not insert or delete
any text. Otherwise we leave `point' at point-min. */
- EMACS_INT opoint = PT;
- EMACS_INT opoint_byte = PT_BYTE;
- EMACS_INT oinserted = ZV - BEGV;
- int ochars_modiff = CHARS_MODIFF;
+ ptrdiff_t opoint = PT;
+ ptrdiff_t opoint_byte = PT_BYTE;
+ ptrdiff_t oinserted = ZV - BEGV;
+ EMACS_INT ochars_modiff = CHARS_MODIFF;
TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
insval = call3 (Qformat_decode,
Qnil, make_number (oinserted), visit);
- CHECK_NUMBER (insval);
+ if (! RANGED_INTEGERP (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
point back to position before inserted text and leave
insval = call1 (XCAR (p), make_number (inserted));
if (!NILP (insval))
{
- CHECK_NUMBER (insval);
+ if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ wrong_type_argument (intern ("inserted-chars"), insval);
inserted = XFASTINT (insval);
}
}
{
/* For the rationale of this see the comment on
format-decode above. */
- EMACS_INT opoint = PT;
- EMACS_INT opoint_byte = PT_BYTE;
- EMACS_INT oinserted = ZV - BEGV;
- int ochars_modiff = CHARS_MODIFF;
+ ptrdiff_t opoint = PT;
+ ptrdiff_t opoint_byte = PT_BYTE;
+ ptrdiff_t oinserted = ZV - BEGV;
+ EMACS_INT ochars_modiff = CHARS_MODIFF;
TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
insval = call1 (XCAR (p), make_number (oinserted));
if (!NILP (insval))
{
- CHECK_NUMBER (insval);
+ if (! RANGED_INTEGERP (0, insval, ZV - PT))
+ wrong_type_argument (intern ("inserted-chars"), insval);
if (ochars_modiff == CHARS_MODIFF)
/* after_insert_file_functions didn't modify
buffer's characters => move point back to
if (NILP (visit))
{
- current_buffer->undo_list = old_undo;
+ BSET (current_buffer, undo_list, old_undo);
if (CONSP (old_undo) && inserted != old_inserted)
{
/* Adjust the last undo record for the size change during
else
/* If undo_list was Qt before, keep it that way.
Otherwise start with an empty undo_list. */
- current_buffer->undo_list = EQ (old_undo, Qt) ? Qt : Qnil;
-
- unbind_to (count, Qnil);
- }
+ BSET (current_buffer, undo_list, EQ (old_undo, Qt) ? Qt : Qnil);
- /* Call after-change hooks for the inserted text, aside from the case
- of normal visiting (not with REPLACE), which is done in a new buffer
- "before" the buffer is changed. */
- if (inserted > 0 && total > 0
- && (NILP (visit) || !NILP (replace)))
- {
- signal_after_change (PT, 0, inserted);
- update_compositions (PT, PT, CHECK_BORDER);
+ unbind_to (count1, Qnil);
}
if (!NILP (visit)
- && current_buffer->modtime == -1)
+ && 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));
}
RETURN_UNGCPRO (unbind_to (count, val));
}
\f
-static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object));
+static Lisp_Object build_annotations (Lisp_Object, Lisp_Object);
static Lisp_Object
-build_annotations_unwind (arg)
- Lisp_Object arg;
+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 (start, end, filename,
- append, visit, lockname, coding)
- Lisp_Object start, end, filename, append, visit, lockname;
- struct coding_system *coding;
+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)
{
Lisp_Object val;
Lisp_Object eol_parent = Qnil;
if (auto_saving
- && NILP (Fstring_equal (current_buffer->filename,
- current_buffer->auto_save_file_name)))
+ && NILP (Fstring_equal (BVAR (current_buffer, filename),
+ BVAR (current_buffer, auto_save_file_name))))
{
val = Qutf_8_emacs;
eol_parent = Qunix;
int using_default_coding = 0;
int force_raw_text = 0;
- val = current_buffer->buffer_file_coding_system;
+ val = BVAR (current_buffer, buffer_file_coding_system);
if (NILP (val)
|| NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
{
val = Qnil;
- if (NILP (current_buffer->enable_multibyte_characters))
+ if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
force_raw_text = 1;
}
{
/* If we still have not decided a coding system, use the
default value of buffer-file-coding-system. */
- val = current_buffer->buffer_file_coding_system;
+ val = BVAR (current_buffer, buffer_file_coding_system);
using_default_coding = 1;
}
format, we use that of
`default-buffer-file-coding-system'. */
if (! using_default_coding
- && ! NILP (buffer_defaults.buffer_file_coding_system))
+ && ! NILP (BVAR (&buffer_defaults, buffer_file_coding_system)))
val = (coding_inherit_eol_type
- (val, buffer_defaults.buffer_file_coding_system));
+ (val, BVAR (&buffer_defaults, buffer_file_coding_system)));
/* If we decide not to encode text, use `raw-text' or one of its
subsidiaries. */
val = coding_inherit_eol_type (val, eol_parent);
setup_coding_system (val, coding);
- if (!STRINGP (start) && !NILP (current_buffer->selective_display))
+ if (!STRINGP (start) && !NILP (BVAR (current_buffer, selective_display)))
coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
return val;
}
This calls `write-region-annotate-functions' at the start, and
`write-region-post-annotation-function' at the end. */)
- (start, end, filename, append, visit, lockname, mustbenew)
- Lisp_Object start, end, filename, append, visit, lockname, mustbenew;
+ (Lisp_Object start, Lisp_Object end, Lisp_Object filename, Lisp_Object append, Lisp_Object visit, Lisp_Object lockname, Lisp_Object mustbenew)
{
register int desc;
int failure;
int save_errno = 0;
- const unsigned char *fn;
+ const char *fn;
struct stat st;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
int count1;
Lisp_Object handler;
Lisp_Object visit_file;
int quietly = !NILP (visit);
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
struct buffer *given_buffer;
-#ifdef DOS_NT
- int buffer_file_type = O_BINARY;
-#endif /* DOS_NT */
struct coding_system coding;
if (current_buffer->base_buffer && visiting)
if (visiting)
{
SAVE_MODIFF = MODIFF;
- XSETFASTINT (current_buffer->save_length, Z - BEG);
- current_buffer->filename = visit_file;
+ XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
+ BSET (current_buffer, filename, visit_file);
}
UNGCPRO;
return val;
encoded_filename = ENCODE_FILE (filename);
- fn = SDATA (encoded_filename);
+ fn = SSDATA (encoded_filename);
desc = -1;
if (!NILP (append))
#ifdef DOS_NT
- desc = emacs_open (fn, O_WRONLY | buffer_file_type, 0);
+ desc = emacs_open (fn, O_WRONLY | O_BINARY, 0);
#else /* not DOS_NT */
desc = emacs_open (fn, O_WRONLY, 0);
#endif /* not DOS_NT */
if (desc < 0 && (NILP (append) || errno == ENOENT))
#ifdef DOS_NT
desc = emacs_open (fn,
- O_WRONLY | O_CREAT | buffer_file_type
+ O_WRONLY | O_CREAT | O_BINARY
| (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC),
S_IREAD | S_IWRITE);
#else /* not DOS_NT */
if (!NILP (append) && !NILP (Ffile_regular_p (filename)))
{
- long ret;
+ off_t ret;
if (NUMBERP (append))
- ret = lseek (desc, XINT (append), 1);
+ ret = emacs_lseek (desc, XINT (append), SEEK_CUR);
else
- ret = lseek (desc, 0, 2);
+ ret = lseek (desc, 0, SEEK_END);
if (ret < 0)
{
#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));
to avoid a "file has changed on disk" warning on
next attempt to save. */
if (visiting)
- current_buffer->modtime = st.st_mtime;
+ {
+ current_buffer->modtime = get_stat_mtime (&st);
+ current_buffer->modtime_size = st.st_size;
+ }
if (failure)
error ("IO error writing %s: %s", SDATA (filename),
if (visiting)
{
SAVE_MODIFF = MODIFF;
- XSETFASTINT (current_buffer->save_length, Z - BEG);
- current_buffer->filename = visit_file;
+ XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
+ BSET (current_buffer, filename, visit_file);
update_mode_lines++;
}
else if (quietly)
{
if (auto_saving
- && ! NILP (Fstring_equal (current_buffer->filename,
- current_buffer->auto_save_file_name)))
+ && ! NILP (Fstring_equal (BVAR (current_buffer, filename),
+ BVAR (current_buffer, auto_save_file_name))))
SAVE_MODIFF = MODIFF;
return Qnil;
return Qnil;
}
\f
-Lisp_Object merge ();
+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). */)
- (a, b)
- Lisp_Object a, b;
+ (Lisp_Object a, Lisp_Object b)
{
return Flss (Fcar (a), Fcar (b));
}
as save-excursion would do. */
static Lisp_Object
-build_annotations (start, end)
- Lisp_Object start, end;
+build_annotations (Lisp_Object start, Lisp_Object end)
{
Lisp_Object annotations;
Lisp_Object p, res;
}
/* Now do the same for annotation functions implied by the file-format */
- if (auto_saving && (!EQ (current_buffer->auto_save_file_format, Qt)))
- p = current_buffer->auto_save_file_format;
+ if (auto_saving && (!EQ (BVAR (current_buffer, auto_save_file_format), Qt)))
+ p = BVAR (current_buffer, auto_save_file_format);
else
- p = current_buffer->file_format;
+ p = BVAR (current_buffer, file_format);
for (i = 0; CONSP (p); p = XCDR (p), ++i)
{
struct buffer *given_buffer = current_buffer;
The return value is negative in case of system call failure. */
static int
-a_write (desc, string, pos, nchars, annot, coding)
- int desc;
- Lisp_Object string;
- register int nchars;
- int pos;
- Lisp_Object *annot;
- struct coding_system *coding;
+a_write (int desc, Lisp_Object string, ptrdiff_t pos,
+ register ptrdiff_t nchars, Lisp_Object *annot,
+ struct coding_system *coding)
{
Lisp_Object tem;
- int nextpos;
- int lastpos = pos + nchars;
+ ptrdiff_t nextpos;
+ ptrdiff_t lastpos = pos + nchars;
while (NILP (*annot) || CONSP (*annot))
{
are indexes to the string STRING. */
static int
-e_write (desc, string, start, end, coding)
- int desc;
- Lisp_Object string;
- int start, end;
- struct coding_system *coding;
+e_write (int desc, Lisp_Object string, ptrdiff_t start, ptrdiff_t end,
+ struct coding_system *coding)
{
if (STRINGP (string))
{
}
else
{
- int start_byte = CHAR_TO_BYTE (start);
- int end_byte = CHAR_TO_BYTE (end);
+ ptrdiff_t start_byte = CHAR_TO_BYTE (start);
+ ptrdiff_t end_byte = CHAR_TO_BYTE (end);
coding->src_multibyte = (end - start) < (end_byte - start_byte);
if (CODING_REQUIRE_ENCODING (coding))
coding->produced -=
emacs_write (desc,
STRINGP (coding->dst_object)
- ? SDATA (coding->dst_object)
- : BYTE_POS_ADDR (coding->dst_pos_byte),
+ ? SSDATA (coding->dst_object)
+ : (char *) BYTE_POS_ADDR (coding->dst_pos_byte),
coding->produced);
if (coding->produced)
}
\f
DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
- Sverify_visited_file_modtime, 1, 1, 0,
+ Sverify_visited_file_modtime, 0, 1, 0,
doc: /* Return t if last mod time of BUF's visited file matches what BUF records.
This means that the file has not been changed since it was visited or saved.
+If BUF is omitted or nil, it defaults to the current buffer.
See Info node `(elisp)Modification Time' for more details. */)
- (buf)
- Lisp_Object buf;
+ (Lisp_Object buf)
{
struct buffer *b;
struct stat st;
Lisp_Object handler;
Lisp_Object filename;
+ EMACS_TIME mtime, diff;
- CHECK_BUFFER (buf);
- b = XBUFFER (buf);
+ if (NILP (buf))
+ b = current_buffer;
+ else
+ {
+ CHECK_BUFFER (buf);
+ b = XBUFFER (buf);
+ }
- if (!STRINGP (b->filename)) return Qt;
- if (b->modtime == 0) return Qt;
+ if (!STRINGP (BVAR (b, filename))) return Qt;
+ if (EMACS_NSECS (b->modtime) == UNKNOWN_MODTIME_NSECS) return Qt;
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (b->filename,
+ handler = Ffind_file_name_handler (BVAR (b, filename),
Qverify_visited_file_modtime);
if (!NILP (handler))
return call2 (handler, Qverify_visited_file_modtime, buf);
- filename = ENCODE_FILE (b->filename);
-
- if (stat (SDATA (filename), &st) < 0)
- {
- /* If the file doesn't exist now and didn't exist before,
- we say that it isn't modified, provided the error is a tame one. */
- if (errno == ENOENT || errno == EACCES || errno == ENOTDIR)
- st.st_mtime = -1;
- else
- st.st_mtime = 0;
- }
- if (st.st_mtime == b->modtime
- /* If both are positive, accept them if they are off by one second. */
- || (st.st_mtime > 0 && b->modtime > 0
- && (st.st_mtime == b->modtime + 1
- || st.st_mtime == b->modtime - 1)))
+ filename = ENCODE_FILE (BVAR (b, filename));
+
+ mtime = (stat (SSDATA (filename), &st) == 0
+ ? get_stat_mtime (&st)
+ : time_error_value (errno));
+ if ((EMACS_TIME_EQ (mtime, b->modtime)
+ /* If both exist, accept them if they are off by one second. */
+ || (EMACS_TIME_VALID_P (mtime) && EMACS_TIME_VALID_P (b->modtime)
+ && ((diff = (EMACS_TIME_LT (mtime, b->modtime)
+ ? sub_emacs_time (b->modtime, mtime)
+ : sub_emacs_time (mtime, b->modtime))),
+ EMACS_TIME_LE (diff, make_emacs_time (1, 0)))))
+ && (st.st_size == b->modtime_size
+ || b->modtime_size < 0))
return Qt;
return Qnil;
}
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 = 0;
+ 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), like the time values
-that `file-attributes' returns. If the current buffer has no recorded
-file modification time, this function returns 0.
+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.
See Info node `(elisp)Modification Time' for more details. */)
- ()
+ (void)
{
- if (! current_buffer->modtime)
+ if (EMACS_NSECS (current_buffer->modtime) < 0)
return make_number (0);
- return make_time ((time_t) current_buffer->modtime);
+ return make_lisp_time (current_buffer->modtime);
}
DEFUN ("set-visited-file-modtime", Fset_visited_file_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) or (HIGH LOW). */)
- (time_list)
- Lisp_Object time_list;
+\(HIGH LOW USEC PSEC) as returned by `current-time'. */)
+ (Lisp_Object time_list)
{
if (!NILP (time_list))
- current_buffer->modtime = cons_to_long (time_list);
+ {
+ current_buffer->modtime = lisp_time_argument (time_list);
+ current_buffer->modtime_size = -1;
+ }
else
{
register Lisp_Object filename;
struct stat st;
Lisp_Object handler;
- filename = Fexpand_file_name (current_buffer->filename, Qnil);
+ filename = Fexpand_file_name (BVAR (current_buffer, filename), Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
filename = ENCODE_FILE (filename);
- if (stat (SDATA (filename), &st) >= 0)
- current_buffer->modtime = st.st_mtime;
+ if (stat (SSDATA (filename), &st) >= 0)
+ {
+ current_buffer->modtime = get_stat_mtime (&st);
+ current_buffer->modtime_size = st.st_size;
+ }
}
return Qnil;
}
\f
-Lisp_Object
-auto_save_error (error)
- Lisp_Object error;
+static Lisp_Object
+auto_save_error (Lisp_Object error_val)
{
Lisp_Object args[3], msg;
int i, nbytes;
ring_bell (XFRAME (selected_frame));
args[0] = build_string ("Auto-saving %s: %s");
- args[1] = current_buffer->name;
- args[2] = Ferror_message_string (error);
+ args[1] = BVAR (current_buffer, name);
+ args[2] = Ferror_message_string (error_val);
msg = Fformat (3, args);
GCPRO1 (msg);
nbytes = SBYTES (msg);
- SAFE_ALLOCA (msgbuf, char *, nbytes);
- bcopy (SDATA (msg), msgbuf, nbytes);
+ msgbuf = SAFE_ALLOCA (nbytes);
+ memcpy (msgbuf, SDATA (msg), nbytes);
for (i = 0; i < 3; ++i)
{
return Qnil;
}
-Lisp_Object
-auto_save_1 ()
+static Lisp_Object
+auto_save_1 (void)
{
struct stat st;
Lisp_Object modes;
auto_save_mode_bits = 0666;
/* Get visited file's mode to become the auto save file's mode. */
- if (! NILP (current_buffer->filename))
+ if (! NILP (BVAR (current_buffer, filename)))
{
- if (stat (SDATA (current_buffer->filename), &st) >= 0)
+ if (stat (SSDATA (BVAR (current_buffer, filename)), &st) >= 0)
/* But make sure we can overwrite it later! */
- auto_save_mode_bits = st.st_mode | 0600;
- else if ((modes = Ffile_modes (current_buffer->filename),
+ auto_save_mode_bits = (st.st_mode | 0600) & 0777;
+ else if ((modes = Ffile_modes (BVAR (current_buffer, filename)),
INTEGERP (modes)))
/* Remote files don't cooperate with stat. */
- auto_save_mode_bits = XINT (modes) | 0600;
+ auto_save_mode_bits = (XINT (modes) | 0600) & 0777;
}
return
- Fwrite_region (Qnil, Qnil, current_buffer->auto_save_file_name, Qnil,
+ Fwrite_region (Qnil, Qnil, BVAR (current_buffer, auto_save_file_name), Qnil,
NILP (Vauto_save_visited_file_name) ? Qlambda : Qt,
Qnil, Qnil);
}
static Lisp_Object
-do_auto_save_unwind (arg) /* used as unwind-protect function */
- Lisp_Object arg;
+do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */
+
{
FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
auto_saving = 0;
}
static Lisp_Object
-do_auto_save_unwind_1 (value) /* used as unwind-protect function */
- Lisp_Object value;
+do_auto_save_unwind_1 (Lisp_Object value) /* used as unwind-protect function */
+
{
minibuffer_auto_raise = XINT (value);
return Qnil;
}
static Lisp_Object
-do_auto_save_make_dir (dir)
- Lisp_Object dir;
+do_auto_save_make_dir (Lisp_Object dir)
{
- Lisp_Object mode;
+ Lisp_Object result;
- call2 (Qmake_directory, dir, Qt);
- XSETFASTINT (mode, 0700);
- return Fset_file_modes (dir, mode);
+ auto_saving_dir_umask = 077;
+ result = call2 (Qmake_directory, dir, Qt);
+ auto_saving_dir_umask = 0;
+ return result;
}
static Lisp_Object
-do_auto_save_eh (ignore)
- Lisp_Object ignore;
+do_auto_save_eh (Lisp_Object ignore)
{
+ auto_saving_dir_umask = 0;
return Qnil;
}
A non-nil NO-MESSAGE argument means do not print any message if successful.
A non-nil CURRENT-ONLY argument means save only current buffer. */)
- (no_message, current_only)
- Lisp_Object no_message, current_only;
+ (Lisp_Object no_message, Lisp_Object current_only)
{
struct buffer *old = current_buffer, *b;
- Lisp_Object tail, buf;
+ Lisp_Object tail, buf, hook;
int auto_saved = 0;
int do_handled_files;
Lisp_Object oquit;
FILE *stream = NULL;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
int orig_minibuffer_auto_raise = minibuffer_auto_raise;
int old_message_p = 0;
struct gcpro gcpro1, gcpro2;
/* No GCPRO needed, because (when it matters) all Lisp_Object variables
point to non-strings reached from Vbuffer_alist. */
- if (!NILP (Vrun_hooks))
- call1 (Vrun_hooks, intern ("auto-save-hook"));
+ hook = intern ("auto-save-hook");
+ Frun_hooks (1, &hook);
if (STRINGP (Vauto_save_list_file_name))
{
dir = Ffile_name_directory (listfile);
if (NILP (Ffile_directory_p (dir)))
internal_condition_case_1 (do_auto_save_make_dir,
- dir, Fcons (Fcons (Qfile_error, Qnil), Qnil),
+ dir, Qt,
do_auto_save_eh);
UNGCPRO;
}
- stream = fopen (SDATA (listfile), "w");
+ stream = fopen (SSDATA (listfile), "w");
}
record_unwind_protect (do_auto_save_unwind,
/* Record all the buffers that have auto save mode
in the special file that lists them. For each of these buffers,
Record visited name (if any) and auto save name. */
- if (STRINGP (b->auto_save_file_name)
+ if (STRINGP (BVAR (b, auto_save_file_name))
&& stream != NULL && do_handled_files == 0)
{
BLOCK_INPUT;
- if (!NILP (b->filename))
+ if (!NILP (BVAR (b, filename)))
{
- fwrite (SDATA (b->filename), 1,
- SBYTES (b->filename), stream);
+ fwrite (SDATA (BVAR (b, filename)), 1,
+ SBYTES (BVAR (b, filename)), stream);
}
putc ('\n', stream);
- fwrite (SDATA (b->auto_save_file_name), 1,
- SBYTES (b->auto_save_file_name), stream);
+ fwrite (SDATA (BVAR (b, auto_save_file_name)), 1,
+ SBYTES (BVAR (b, auto_save_file_name)), stream);
putc ('\n', stream);
UNBLOCK_INPUT;
}
/* Check for auto save enabled
and file changed since last auto save
and file changed since last real save. */
- if (STRINGP (b->auto_save_file_name)
+ if (STRINGP (BVAR (b, auto_save_file_name))
&& 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 (b->save_length) >= 0
+ && XINT (BVAR (b, save_length)) >= 0
&& (do_handled_files
- || NILP (Ffind_file_name_handler (b->auto_save_file_name,
+ || NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name),
Qwrite_region))))
{
- EMACS_TIME before_time, after_time;
-
- EMACS_GET_TIME (before_time);
+ EMACS_TIME before_time = current_emacs_time ();
+ EMACS_TIME after_time;
/* If we had a failure, don't try again for 20 minutes. */
- if (b->auto_save_failure_time >= 0
+ if (b->auto_save_failure_time > 0
&& EMACS_SECS (before_time) - b->auto_save_failure_time < 1200)
continue;
set_buffer_internal (b);
if (NILP (Vauto_save_include_big_deletions)
- && (XFASTINT (b->save_length) * 10
+ && (XFASTINT (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 (b->save_length) > 5000
+ && XFASTINT (BVAR (b, save_length)) > 5000
/* These messages are frequent and annoying for `*mail*'. */
- && !EQ (b->filename, Qnil)
+ && !EQ (BVAR (b, filename), Qnil)
&& NILP (no_message))
{
/* It has shrunk too much; turn off auto-saving here. */
minibuffer_auto_raise = orig_minibuffer_auto_raise;
message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save",
- b->name, 1);
+ BVAR (b, name), 1);
minibuffer_auto_raise = 0;
/* Turn off auto-saving until there's a real save,
and prevent any more warnings. */
- XSETINT (b->save_length, -1);
+ XSETINT (BVAR (b, save_length), -1);
Fsleep_for (make_number (1), Qnil);
continue;
}
internal_condition_case (auto_save_1, Qt, auto_save_error);
auto_saved++;
BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b);
- XSETFASTINT (current_buffer->save_length, Z - BEG);
+ XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
set_buffer_internal (old);
- EMACS_GET_TIME (after_time);
+ after_time = current_emacs_time ();
/* If auto-save took more than 60 seconds,
assume it was an NFS failure that got a timeout. */
Sset_buffer_auto_saved, 0, 0, 0,
doc: /* Mark current buffer as auto-saved with its current text.
No auto-save file will be written until the buffer changes again. */)
- ()
+ (void)
{
/* FIXME: This should not be called in indirect buffers, since
they're not autosaved. */
BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF;
- XSETFASTINT (current_buffer->save_length, Z - BEG);
- current_buffer->auto_save_failure_time = -1;
+ XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG);
+ current_buffer->auto_save_failure_time = 0;
return Qnil;
}
DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure,
Sclear_buffer_auto_save_failure, 0, 0, 0,
doc: /* Clear any record of a recent auto-save failure in the current buffer. */)
- ()
+ (void)
{
- current_buffer->auto_save_failure_time = -1;
+ current_buffer->auto_save_failure_time = 0;
return Qnil;
}
More precisely, if it has been auto-saved since last read from or saved
in the visited file. If the buffer has no visited file,
then any auto-save counts as "recent". */)
- ()
+ (void)
{
/* FIXME: maybe we should return nil for indirect buffers since
they're never autosaved. */
doc: /* Return t if a call to `read-file-name' will use a dialog.
The return value is only relevant for a call to `read-file-name' that happens
before any other event (mouse or keypress) is handled. */)
- ()
+ (void)
{
#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
}
Lisp_Object
-Fread_file_name (prompt, dir, default_filename, mustmatch, initial, predicate)
- Lisp_Object prompt, dir, default_filename, mustmatch, initial, predicate;
+Fread_file_name (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object initial, Lisp_Object predicate)
{
- struct gcpro gcpro1, gcpro2;
+ struct gcpro gcpro1;
Lisp_Object args[7];
GCPRO1 (default_filename);
\f
void
-syms_of_fileio ()
+syms_of_fileio (void)
{
- Qoperations = intern_c_string ("operations");
- Qexpand_file_name = intern_c_string ("expand-file-name");
- Qsubstitute_in_file_name = intern_c_string ("substitute-in-file-name");
- Qdirectory_file_name = intern_c_string ("directory-file-name");
- Qfile_name_directory = intern_c_string ("file-name-directory");
- Qfile_name_nondirectory = intern_c_string ("file-name-nondirectory");
- Qunhandled_file_name_directory = intern_c_string ("unhandled-file-name-directory");
- Qfile_name_as_directory = intern_c_string ("file-name-as-directory");
- Qcopy_file = intern_c_string ("copy-file");
- Qmake_directory_internal = intern_c_string ("make-directory-internal");
- Qmake_directory = intern_c_string ("make-directory");
- Qdelete_directory_internal = intern_c_string ("delete-directory-internal");
- Qdelete_file = intern_c_string ("delete-file");
- Qrename_file = intern_c_string ("rename-file");
- Qadd_name_to_file = intern_c_string ("add-name-to-file");
- Qmake_symbolic_link = intern_c_string ("make-symbolic-link");
- Qfile_exists_p = intern_c_string ("file-exists-p");
- Qfile_executable_p = intern_c_string ("file-executable-p");
- Qfile_readable_p = intern_c_string ("file-readable-p");
- Qfile_writable_p = intern_c_string ("file-writable-p");
- Qfile_symlink_p = intern_c_string ("file-symlink-p");
- Qaccess_file = intern_c_string ("access-file");
- Qfile_directory_p = intern_c_string ("file-directory-p");
- Qfile_regular_p = intern_c_string ("file-regular-p");
- Qfile_accessible_directory_p = intern_c_string ("file-accessible-directory-p");
- Qfile_modes = intern_c_string ("file-modes");
- Qset_file_modes = intern_c_string ("set-file-modes");
- Qset_file_times = intern_c_string ("set-file-times");
- Qfile_newer_than_file_p = intern_c_string ("file-newer-than-file-p");
- Qinsert_file_contents = intern_c_string ("insert-file-contents");
- Qwrite_region = intern_c_string ("write-region");
- Qverify_visited_file_modtime = intern_c_string ("verify-visited-file-modtime");
- Qset_visited_file_modtime = intern_c_string ("set-visited-file-modtime");
- Qauto_save_coding = intern_c_string ("auto-save-coding");
-
- staticpro (&Qoperations);
- staticpro (&Qexpand_file_name);
- staticpro (&Qsubstitute_in_file_name);
- staticpro (&Qdirectory_file_name);
- staticpro (&Qfile_name_directory);
- staticpro (&Qfile_name_nondirectory);
- staticpro (&Qunhandled_file_name_directory);
- staticpro (&Qfile_name_as_directory);
- staticpro (&Qcopy_file);
- staticpro (&Qmake_directory_internal);
- staticpro (&Qmake_directory);
- staticpro (&Qdelete_directory_internal);
- staticpro (&Qdelete_file);
- staticpro (&Qrename_file);
- staticpro (&Qadd_name_to_file);
- staticpro (&Qmake_symbolic_link);
- staticpro (&Qfile_exists_p);
- staticpro (&Qfile_executable_p);
- staticpro (&Qfile_readable_p);
- staticpro (&Qfile_writable_p);
- staticpro (&Qaccess_file);
- staticpro (&Qfile_symlink_p);
- staticpro (&Qfile_directory_p);
- staticpro (&Qfile_regular_p);
- staticpro (&Qfile_accessible_directory_p);
- staticpro (&Qfile_modes);
- staticpro (&Qset_file_modes);
- staticpro (&Qset_file_times);
- staticpro (&Qfile_newer_than_file_p);
- staticpro (&Qinsert_file_contents);
- staticpro (&Qwrite_region);
- staticpro (&Qverify_visited_file_modtime);
- staticpro (&Qset_visited_file_modtime);
- staticpro (&Qauto_save_coding);
-
- Qfile_name_history = intern_c_string ("file-name-history");
+ DEFSYM (Qoperations, "operations");
+ DEFSYM (Qexpand_file_name, "expand-file-name");
+ DEFSYM (Qsubstitute_in_file_name, "substitute-in-file-name");
+ DEFSYM (Qdirectory_file_name, "directory-file-name");
+ DEFSYM (Qfile_name_directory, "file-name-directory");
+ DEFSYM (Qfile_name_nondirectory, "file-name-nondirectory");
+ DEFSYM (Qunhandled_file_name_directory, "unhandled-file-name-directory");
+ DEFSYM (Qfile_name_as_directory, "file-name-as-directory");
+ DEFSYM (Qcopy_file, "copy-file");
+ DEFSYM (Qmake_directory_internal, "make-directory-internal");
+ DEFSYM (Qmake_directory, "make-directory");
+ DEFSYM (Qdelete_directory_internal, "delete-directory-internal");
+ DEFSYM (Qdelete_file, "delete-file");
+ DEFSYM (Qrename_file, "rename-file");
+ DEFSYM (Qadd_name_to_file, "add-name-to-file");
+ DEFSYM (Qmake_symbolic_link, "make-symbolic-link");
+ DEFSYM (Qfile_exists_p, "file-exists-p");
+ DEFSYM (Qfile_executable_p, "file-executable-p");
+ DEFSYM (Qfile_readable_p, "file-readable-p");
+ DEFSYM (Qfile_writable_p, "file-writable-p");
+ DEFSYM (Qfile_symlink_p, "file-symlink-p");
+ DEFSYM (Qaccess_file, "access-file");
+ DEFSYM (Qfile_directory_p, "file-directory-p");
+ DEFSYM (Qfile_regular_p, "file-regular-p");
+ DEFSYM (Qfile_accessible_directory_p, "file-accessible-directory-p");
+ DEFSYM (Qfile_modes, "file-modes");
+ DEFSYM (Qset_file_modes, "set-file-modes");
+ DEFSYM (Qset_file_times, "set-file-times");
+ DEFSYM (Qfile_selinux_context, "file-selinux-context");
+ DEFSYM (Qset_file_selinux_context, "set-file-selinux-context");
+ DEFSYM (Qfile_newer_than_file_p, "file-newer-than-file-p");
+ DEFSYM (Qinsert_file_contents, "insert-file-contents");
+ DEFSYM (Qwrite_region, "write-region");
+ DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime");
+ DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime");
+ DEFSYM (Qauto_save_coding, "auto-save-coding");
+
+ DEFSYM (Qfile_name_history, "file-name-history");
Fset (Qfile_name_history, Qnil);
- staticpro (&Qfile_name_history);
- Qfile_error = intern_c_string ("file-error");
- staticpro (&Qfile_error);
- Qfile_already_exists = intern_c_string ("file-already-exists");
- staticpro (&Qfile_already_exists);
- Qfile_date_error = intern_c_string ("file-date-error");
- staticpro (&Qfile_date_error);
- Qexcl = intern_c_string ("excl");
- staticpro (&Qexcl);
+ DEFSYM (Qfile_error, "file-error");
+ DEFSYM (Qfile_already_exists, "file-already-exists");
+ DEFSYM (Qfile_date_error, "file-date-error");
+ DEFSYM (Qexcl, "excl");
-#ifdef DOS_NT
- Qfind_buffer_file_type = intern_c_string ("find-buffer-file-type");
- staticpro (&Qfind_buffer_file_type);
-#endif /* DOS_NT */
-
- DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system,
- doc: /* *Coding system for encoding file names.
+ DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system,
+ doc: /* Coding system for encoding file names.
If it is nil, `default-file-name-coding-system' (which see) is used. */);
Vfile_name_coding_system = Qnil;
DEFVAR_LISP ("default-file-name-coding-system",
- &Vdefault_file_name_coding_system,
+ Vdefault_file_name_coding_system,
doc: /* Default coding system for encoding file names.
This variable is used only when `file-name-coding-system' is nil.
of file names regardless of the current language environment. */);
Vdefault_file_name_coding_system = Qnil;
- Qformat_decode = intern_c_string ("format-decode");
- staticpro (&Qformat_decode);
- Qformat_annotate_function = intern_c_string ("format-annotate-function");
- staticpro (&Qformat_annotate_function);
- Qafter_insert_file_set_coding = intern_c_string ("after-insert-file-set-coding");
- staticpro (&Qafter_insert_file_set_coding);
-
- Qcar_less_than_car = intern_c_string ("car-less-than-car");
- staticpro (&Qcar_less_than_car);
+ DEFSYM (Qformat_decode, "format-decode");
+ DEFSYM (Qformat_annotate_function, "format-annotate-function");
+ DEFSYM (Qafter_insert_file_set_coding, "after-insert-file-set-coding");
+ DEFSYM (Qcar_less_than_car, "car-less-than-car");
Fput (Qfile_error, Qerror_conditions,
Fpurecopy (list2 (Qfile_error, Qerror)));
Fput (Qfile_error, Qerror_message,
- make_pure_c_string ("File error"));
+ build_pure_c_string ("File error"));
Fput (Qfile_already_exists, Qerror_conditions,
Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror)));
Fput (Qfile_already_exists, Qerror_message,
- make_pure_c_string ("File already exists"));
+ build_pure_c_string ("File already exists"));
Fput (Qfile_date_error, Qerror_conditions,
Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror)));
Fput (Qfile_date_error, Qerror_message,
- make_pure_c_string ("Cannot set file date"));
-
- DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char,
- doc: /* Directory separator character for built-in functions that return file names.
-The value is always ?/. Don't use this variable, just use `/'. */);
- XSETFASTINT (Vdirectory_sep_char, '/');
-
- 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, then all I/O on that file is done by calling
-HANDLER.
-
-The first argument given to HANDLER is the name of the I/O primitive
-to be handled; the remaining arguments are the arguments that were
-passed to that primitive. For example, if you do
- (file-exists-p FILENAME)
-and FILENAME is handled by HANDLER, then HANDLER is called like this:
- (funcall HANDLER 'file-exists-p FILENAME)
-The function `find-file-name-handler' checks this list for a handler
-for its argument. */);
+ build_pure_c_string ("Cannot set file date"));
+
+ 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
+HANDLER. If a file name matches more than one handler, the handler
+whose match starts last in the file name gets precedence. The
+function `find-file-name-handler' checks this list for a handler for
+its argument.
+
+HANDLER should be a function. The first argument given to it is the
+name of the I/O primitive to be handled; the remaining arguments are
+the arguments that were passed to that primitive. For example, if you
+do (file-exists-p FILENAME) and FILENAME is handled by HANDLER, then
+HANDLER is called like this:
+
+ (funcall HANDLER 'file-exists-p FILENAME)
+
+Note that HANDLER must be able to handle all I/O primitives; if it has
+nothing special to do for a primitive, it should reinvoke the
+primitive to handle the operation \"the usual way\".
+See Info node `(elisp)Magic File Names' for more details. */);
Vfile_name_handler_alist = Qnil;
DEFVAR_LISP ("set-auto-coding-function",
- &Vset_auto_coding_function,
+ Vset_auto_coding_function,
doc: /* If non-nil, a function to call to decide a coding system of file.
Two arguments are passed to this function: the file name
and the length of a file contents following the point.
or local variable spec of the tailing lines with `coding:' tag. */);
Vset_auto_coding_function = Qnil;
- DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions,
+ DEFVAR_LISP ("after-insert-file-functions", Vafter_insert_file_functions,
doc: /* A list of functions to be called at the end of `insert-file-contents'.
Each is passed one argument, the number of characters inserted,
with point at the start of the inserted text. Each function
functions in `after-insert-file-functions' if appropriate. */);
Vafter_insert_file_functions = Qnil;
- DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions,
+ DEFVAR_LISP ("write-region-annotate-functions", Vwrite_region_annotate_functions,
doc: /* A list of functions to be called at the start of `write-region'.
Each is passed two arguments, START and END as for `write-region'.
These are usually two numbers but not always; see the documentation
current when building the annotations (i.e., at least once), with that
buffer current. */);
Vwrite_region_annotate_functions = Qnil;
- staticpro (&Qwrite_region_annotate_functions);
- Qwrite_region_annotate_functions
- = intern_c_string ("write-region-annotate-functions");
+ DEFSYM (Qwrite_region_annotate_functions, "write-region-annotate-functions");
DEFVAR_LISP ("write-region-post-annotation-function",
- &Vwrite_region_post_annotation_function,
+ Vwrite_region_post_annotation_function,
doc: /* Function to call after `write-region' completes.
The function is called with no arguments. If one or more of the
annotation functions in `write-region-annotate-functions' changed the
staticpro (&Vwrite_region_annotation_buffers);
DEFVAR_LISP ("write-region-annotations-so-far",
- &Vwrite_region_annotations_so_far,
+ Vwrite_region_annotations_so_far,
doc: /* When an annotation function is called, this holds the previous annotations.
These are the annotations made by other annotation functions
that were already called. See also `write-region-annotate-functions'. */);
Vwrite_region_annotations_so_far = Qnil;
- DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers,
+ DEFVAR_LISP ("inhibit-file-name-handlers", Vinhibit_file_name_handlers,
doc: /* A list of file name handlers that temporarily should not be used.
This applies only to the operation `inhibit-file-name-operation'. */);
Vinhibit_file_name_handlers = Qnil;
- DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation,
+ DEFVAR_LISP ("inhibit-file-name-operation", Vinhibit_file_name_operation,
doc: /* The operation for which `inhibit-file-name-handlers' is applicable. */);
Vinhibit_file_name_operation = Qnil;
- DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name,
+ DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name,
doc: /* File name in which we write a list of all auto save file names.
This variable is initialized automatically from `auto-save-list-file-prefix'
shortly after Emacs reads your `.emacs' file, if you have not yet given it
a non-nil value. */);
Vauto_save_list_file_name = Qnil;
- DEFVAR_LISP ("auto-save-visited-file-name", &Vauto_save_visited_file_name,
+ DEFVAR_LISP ("auto-save-visited-file-name", Vauto_save_visited_file_name,
doc: /* Non-nil says auto-save a buffer in the file it is visiting, when practical.
Normally auto-save files are written under other names. */);
Vauto_save_visited_file_name = Qnil;
- DEFVAR_LISP ("auto-save-include-big-deletions", &Vauto_save_include_big_deletions,
+ DEFVAR_LISP ("auto-save-include-big-deletions", Vauto_save_include_big_deletions,
doc: /* If non-nil, auto-save even if a large part of the text is deleted.
If nil, deleting a substantial portion of the text disables auto-save
in the buffer; this is the default behavior, because the auto-save
Vauto_save_include_big_deletions = Qnil;
#ifdef HAVE_FSYNC
- DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync,
- doc: /* *Non-nil means don't call fsync in `write-region'.
+ 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
- DEFVAR_BOOL ("delete-by-moving-to-trash", &delete_by_moving_to_trash,
+ DEFVAR_BOOL ("delete-by-moving-to-trash", delete_by_moving_to_trash,
doc: /* Specifies whether to use the system's trash can.
-When non-nil, the function `move-file-to-trash' will be used by
-`delete-file' and `delete-directory'. */);
+When non-nil, certain file deletion commands use the function
+`move-file-to-trash' instead of deleting files outright.
+This includes interactive calls to `delete-file' and
+`delete-directory' and the Dired deletion commands. */);
delete_by_moving_to_trash = 0;
Qdelete_by_moving_to_trash = intern_c_string ("delete-by-moving-to-trash");
- Qmove_file_to_trash = intern_c_string ("move-file-to-trash");
- staticpro (&Qmove_file_to_trash);
- Qcopy_directory = intern_c_string ("copy-directory");
- staticpro (&Qcopy_directory);
- Qdelete_directory = intern_c_string ("delete-directory");
- staticpro (&Qdelete_directory);
+
+ DEFSYM (Qmove_file_to_trash, "move-file-to-trash");
+ DEFSYM (Qcopy_directory, "copy-directory");
+ DEFSYM (Qdelete_directory, "delete-directory");
defsubr (&Sfind_file_name_handler);
defsubr (&Sfile_name_directory);
defsubr (&Sfile_modes);
defsubr (&Sset_file_modes);
defsubr (&Sset_file_times);
+ defsubr (&Sfile_selinux_context);
+ defsubr (&Sset_file_selinux_context);
defsubr (&Sset_default_file_modes);
defsubr (&Sdefault_file_modes);
defsubr (&Sfile_newer_than_file_p);
defsubr (&Sunix_sync);
#endif
}
-
-/* arch-tag: 64ba3fd7-f844-4fb2-ba4b-427eb928786c
- (do not change this comment) */
HCoop / bpt / emacs.git / blobdiff