/* File IO for GNU Emacs.
- Copyright (C) 1985,86,87,88,93,94,95,96,1997 Free Software Foundation, Inc.
+ Copyright (C) 1985,86,87,88,93,94,95,96,97,98,1999 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <pwd.h>
#endif
-#ifdef MSDOS
-#include "msdos.h"
-#include <sys/param.h>
-#if __DJGPP__ >= 2
-#include <fcntl.h>
-#include <string.h>
-#endif
-#endif
-
#include <ctype.h>
#ifdef VMS
extern int errno;
#endif
-extern char *strerror ();
-
#ifdef APOLLO
#include <sys/time.h>
#endif
#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); \
#endif
#endif
+#include "commands.h"
+extern int use_dialog_box;
+
#ifndef O_WRONLY
#define O_WRONLY 1
#endif
#define O_RDONLY 0
#endif
+#ifndef S_ISLNK
+# define lstat stat
+#endif
+
#define min(a, b) ((a) < (b) ? (a) : (b))
#define max(a, b) ((a) > (b) ? (a) : (b))
-/* Encode the file name NAME using the specified coding system
- for file names, if any. */
-#define ENCODE_FILE(name) \
- (! NILP (Vfile_name_coding_system) \
- && XFASTINT (Vfile_name_coding_system) != 0 \
- ? Fencode_coding_string (name, Vfile_name_coding_system, Qt) \
- : name)
-
/* Nonzero during writing of auto-save files */
int auto_saving;
/* 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;
extern Lisp_Object Vuser_login_name;
+#ifdef WINDOWSNT
+extern Lisp_Object Vw32_get_true_file_attributes;
+#endif
+
extern int minibuf_level;
extern int minibuffer_auto_raise;
static Lisp_Object Vinhibit_file_name_operation;
Lisp_Object Qfile_error, Qfile_already_exists, Qfile_date_error;
-
+Lisp_Object Qexcl;
Lisp_Object Qfile_name_history;
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 *));
+
+\f
void
report_file_error (string, data)
char *string;
Lisp_Object data;
{
Lisp_Object errstring;
+ int errorno = errno;
- errstring = build_string (strerror (errno));
-
- /* System error messages are capitalized. Downcase the initial
- unless it is followed by a slash. */
- if (XSTRING (errstring)->data[1] != '/')
- XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
+ synchronize_system_messages_locale ();
+ errstring = code_convert_string_norecord (build_string (strerror (errorno)),
+ Vlocale_coding_system, 0);
while (1)
- Fsignal (Qfile_error,
- Fcons (build_string (string), Fcons (errstring, data)));
+ switch (errorno)
+ {
+ case EEXIST:
+ Fsignal (Qfile_already_exists, Fcons (errstring, data));
+ break;
+ default:
+ /* System error messages are capitalized. Downcase the initial
+ unless it is followed by a slash. */
+ if (XSTRING (errstring)->data[1] != '/')
+ XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
+
+ Fsignal (Qfile_error,
+ Fcons (build_string (string), Fcons (errstring, data)));
+ }
}
Lisp_Object
close_file_unwind (fd)
Lisp_Object fd;
{
- close (XFASTINT (fd));
+ emacs_close (XFASTINT (fd));
return Qnil;
}
/* Restore point, having saved it as a marker. */
-Lisp_Object
+static Lisp_Object
restore_point_unwind (location)
Lisp_Object location;
{
- SET_PT (marker_position (location));
+ Fgoto_char (location);
Fset_marker (location, Qnil, Qnil);
return Qnil;
}
inhibited_handlers = Qnil;
for (chain = Vfile_name_handler_alist; CONSP (chain);
- chain = XCONS (chain)->cdr)
+ chain = XCDR (chain))
{
Lisp_Object elt;
- elt = XCONS (chain)->car;
+ elt = XCAR (chain);
if (CONSP (elt))
{
Lisp_Object string;
- string = XCONS (elt)->car;
+ string = XCAR (elt);
if (STRINGP (string) && fast_string_match (string, filename) >= 0)
{
Lisp_Object handler, tem;
- handler = XCONS (elt)->cdr;
+ handler = XCDR (elt);
tem = Fmemq (handler, inhibited_handlers);
if (NILP (tem))
return handler;
#ifdef DOS_NT
beg = strcpy (alloca (strlen (beg) + 1), beg);
#endif
- p = beg + XSTRING (filename)->size;
+ p = beg + STRING_BYTES (XSTRING (filename));
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef VMS
&& p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
#endif /* VMS */
#ifdef DOS_NT
- /* only recognise drive specifier at beginning */
- && !(p[-1] == ':' && p == beg + 2)
+ /* only recognise drive specifier at the beginning */
+ && !(p[-1] == ':'
+ /* handle the "/:d:foo" and "/:foo" cases correctly */
+ && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
+ || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
#endif
) p--;
return Qnil;
#ifdef DOS_NT
/* Expansion of "c:" to drive and default directory. */
- if (p == beg + 2 && beg[1] == ':')
+ if (p[-1] == ':')
{
/* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
unsigned char *res = alloca (MAXPATHLEN + 1);
- if (getdefdir (toupper (*beg) - 'A' + 1, res))
+ unsigned char *r = res;
+
+ if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
+ {
+ strncpy (res, beg, 2);
+ beg += 2;
+ r += 2;
+ }
+
+ if (getdefdir (toupper (*beg) - 'A' + 1, r))
{
if (!IS_DIRECTORY_SEP (res[strlen (res) - 1]))
strcat (res, "/");
}
CORRECT_DIR_SEPS (beg);
#endif /* DOS_NT */
- return make_string (beg, p - beg);
+
+ if (STRING_MULTIBYTE (filename))
+ return make_string (beg, p - beg);
+ return make_unibyte_string (beg, p - beg);
}
-DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory,
- 1, 1, 0,
+DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
+ Sfile_name_nondirectory, 1, 1, 0,
"Return file name FILENAME sans its directory.\n\
For example, in a Unix-syntax file name,\n\
this is everything after the last slash,\n\
return call2 (handler, Qfile_name_nondirectory, filename);
beg = XSTRING (filename)->data;
- end = p = beg + XSTRING (filename)->size;
+ end = p = beg + STRING_BYTES (XSTRING (filename));
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef VMS
#endif /* VMS */
#ifdef DOS_NT
/* only recognise drive specifier at beginning */
- && !(p[-1] == ':' && p == beg + 2)
+ && !(p[-1] == ':'
+ /* handle the "/:d:foo" case correctly */
+ && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
#endif
- ) p--;
+ )
+ p--;
- return make_string (p, end - p);
+ if (STRING_MULTIBYTE (filename))
+ return make_string (p, end - p);
+ return make_unibyte_string (p, end - p);
}
-DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, Sunhandled_file_name_directory, 1, 1, 0,
+DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
+ Sunhandled_file_name_directory, 1, 1, 0,
"Return a directly usable directory name somehow associated with FILENAME.\n\
A `directly usable' directory name is one that may be used without the\n\
intervention of any file handler.\n\
If FILENAME is a directly usable file itself, return\n\
-(file-name-directory FILENAME).\n\
+\(file-name-directory FILENAME).\n\
The `call-process' and `start-process' functions use this function to\n\
get a current directory to run processes in.")
(filename)
strcpy (out, in);
+ if (size < 0)
+ {
+ out[0] = '.';
+ out[1] = '/';
+ out[2] = 0;
+ return out;
+ }
+
#ifdef VMS
/* Is it already a directory string? */
if (in[size] == ':' || in[size] == ']' || in[size] == '>')
if (!NILP (handler))
return call2 (handler, Qfile_name_as_directory, file);
- buf = (char *) alloca (XSTRING (file)->size + 10);
+ buf = (char *) alloca (STRING_BYTES (XSTRING (file)) + 10);
return build_string (file_name_as_directory (buf, XSTRING (file)->data));
}
\f
* Value is nonzero if the string output is different from the input.
*/
+int
directory_file_name (src, dst)
char *src, *dst;
{
/* 20 extra chars is insufficient for VMS, since we might perform a
logical name translation. an equivalence string can be up to 255
chars long, so grab that much extra space... - sss */
- buf = (char *) alloca (XSTRING (directory)->size + 20 + 255);
+ buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20 + 255);
#else
- buf = (char *) alloca (XSTRING (directory)->size + 20);
+ buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20);
#endif
directory_file_name (XSTRING (directory)->data, buf);
return build_string (buf);
}
+static char make_temp_name_tbl[64] =
+{
+ 'A','B','C','D','E','F','G','H',
+ 'I','J','K','L','M','N','O','P',
+ 'Q','R','S','T','U','V','W','X',
+ 'Y','Z','a','b','c','d','e','f',
+ 'g','h','i','j','k','l','m','n',
+ 'o','p','q','r','s','t','u','v',
+ 'w','x','y','z','0','1','2','3',
+ '4','5','6','7','8','9','-','_'
+};
+static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
+
DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
"Generate temporary file name (string) starting with PREFIX (a string).\n\
The Emacs process number forms part of the result,\n\
so there is no danger of generating a name being used by another process.\n\
+\n\
In addition, this function makes an attempt to choose a name\n\
-which has no existing file.")
+which has no existing file. To make this work,\n\
+PREFIX should be an absolute file name.\n\
+\n\
+There is a race condition between calling `make-temp-name' and creating the\n\
+file which opens all kinds of security holes. For that reason, you should\n\
+probably use `make-temp-file' instead.")
(prefix)
Lisp_Object prefix;
{
Lisp_Object val;
-#ifdef MSDOS
- /* Don't use too many characters of the restricted 8+3 DOS
- filename space. */
- val = concat2 (prefix, build_string ("a.XXX"));
+ int len;
+ int pid;
+ unsigned char *p, *data;
+ char pidbuf[20];
+ int pidlen;
+
+ CHECK_STRING (prefix, 0);
+
+ /* VAL is created by adding 6 characters to PREFIX. The first
+ three are the PID of this process, in base 64, and the second
+ three are incremented if the file already exists. This ensures
+ 262144 unique file names per PID per PREFIX. */
+
+ pid = (int) getpid ();
+
+#ifdef HAVE_LONG_FILE_NAMES
+ sprintf (pidbuf, "%d", pid);
+ pidlen = strlen (pidbuf);
#else
- val = concat2 (prefix, build_string ("XXXXXX"));
+ pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
+ pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
+ pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
+ pidlen = 3;
#endif
- mktemp (XSTRING (val)->data);
-#ifdef DOS_NT
- CORRECT_DIR_SEPS (XSTRING (val)->data);
-#endif
- return val;
+
+ len = XSTRING (prefix)->size;
+ val = make_uninit_string (len + 3 + pidlen);
+ data = XSTRING (val)->data;
+ bcopy(XSTRING (prefix)->data, data, len);
+ p = data + len;
+
+ bcopy (pidbuf, p, pidlen);
+ p += pidlen;
+
+ /* Here we try to minimize useless stat'ing when this function is
+ invoked many times successively with the same PREFIX. We achieve
+ this by initializing count to a random value, and incrementing it
+ afterwards.
+
+ We don't want make-temp-name to be called while dumping,
+ because then make_temp_name_count_initialized_p would get set
+ and then make_temp_name_count would not be set when Emacs starts. */
+
+ if (!make_temp_name_count_initialized_p)
+ {
+ make_temp_name_count = (unsigned) time (NULL);
+ make_temp_name_count_initialized_p = 1;
+ }
+
+ while (1)
+ {
+ struct stat ignored;
+ unsigned num = make_temp_name_count;
+
+ p[0] = make_temp_name_tbl[num & 63], num >>= 6;
+ p[1] = make_temp_name_tbl[num & 63], num >>= 6;
+ p[2] = make_temp_name_tbl[num & 63], num >>= 6;
+
+ /* Poor man's congruential RN generator. Replace with
+ ++make_temp_name_count for debugging. */
+ make_temp_name_count += 25229;
+ make_temp_name_count %= 225307;
+
+ if (stat (data, &ignored) < 0)
+ {
+ /* We want to return only if errno is ENOENT. */
+ if (errno == ENOENT)
+ return val;
+ else
+ /* The error here is dubious, but there is little else we
+ can do. The alternatives are to return nil, which is
+ 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. */
+ report_file_error ("Cannot create temporary name for prefix `%s'",
+ Fcons (prefix, Qnil));
+ /* not reached */
+ }
+ }
+
+ error ("Cannot create temporary name for prefix `%s'",
+ XSTRING (prefix)->data);
+ return Qnil;
}
+
\f
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
"Convert filename NAME to absolute, and canonicalize it.\n\
#ifdef DOS_NT
int drive = 0;
int collapse_newdir = 1;
+ int is_escaped = 0;
#endif /* DOS_NT */
int length;
Lisp_Object handler;
is needed at all) without requiring it to be expanded now. */
#ifdef DOS_NT
/* Detect MSDOS file names with drive specifiers. */
- && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])))
+ && ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2]))
#ifdef WINDOWSNT
/* Detect Windows file names in UNC format. */
&& ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
a local copy to modify, even if there ends up being no change. */
nm = strcpy (alloca (strlen (nm) + 1), nm);
+ /* Note if special escape prefix is present, but remove for now. */
+ if (nm[0] == '/' && nm[1] == ':')
+ {
+ is_escaped = 1;
+ nm += 2;
+ }
+
/* Find and remove drive specifier if present; this makes nm absolute
- even if the rest of the name appears to be relative. */
- {
- unsigned char *colon = rindex (nm, ':');
-
- if (colon)
- /* Only recognize colon as part of drive specifier if there is a
- single alphabetic character preceeding the colon (and if the
- character before the drive letter, if present, is a directory
- separator); this is to support the remote system syntax used by
- ange-ftp, and the "po:username" syntax for POP mailboxes. */
- look_again:
- if (nm == colon)
- nm++;
- else if (IS_DRIVE (colon[-1])
- && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
- {
- drive = colon[-1];
- nm = colon + 1;
- }
- else
- {
- while (--colon >= nm)
- if (colon[0] == ':')
- goto look_again;
- }
- }
+ even if the rest of the name appears to be relative. Only look for
+ drive specifier at the beginning. */
+ if (IS_DRIVE (nm[0]) && IS_DEVICE_SEP (nm[1]))
+ {
+ drive = nm[0];
+ nm += 2;
+ }
#ifdef WINDOWSNT
/* If we see "c://somedir", we want to strip the first slash after the
if (
IS_DIRECTORY_SEP (nm[0])
#ifdef MSDOS
- && drive
+ && drive && !is_escaped
#endif
#ifdef WINDOWSNT
- && (drive || IS_DIRECTORY_SEP (nm[1]))
+ && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
#endif
#ifdef VMS
|| index (nm, ':')
&& !newdir)
{
newdir = XSTRING (default_directory)->data;
+#ifdef DOS_NT
+ /* Note if special escape prefix is present, but remove for now. */
+ if (newdir[0] == '/' && newdir[1] == ':')
+ {
+ is_escaped = 1;
+ newdir += 2;
+ }
+#endif
}
#ifdef DOS_NT
if (newdir)
{
/* Get rid of any slash at the end of newdir, unless newdir is
- just // (an incomplete UNC name). */
+ just / or // (an incomplete UNC name). */
length = strlen (newdir);
- if (length > 0 && IS_DIRECTORY_SEP (newdir[length - 1])
+ if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
#ifdef WINDOWSNT
&& !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
#endif
/* Now concatenate the directory and name to new space in the stack frame */
tlen += strlen (nm) + 1;
#ifdef DOS_NT
- /* Add reserved space for drive name. (The Microsoft x86 compiler
+ /* 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 + 2);
- target += 2;
+ target = (unsigned char *) alloca (tlen + 4);
+ target += 4;
#else /* not DOS_NT */
target = (unsigned char *) alloca (tlen);
#endif /* not DOS_NT */
{
#ifndef VMS
if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
- strcpy (target, newdir);
+ {
+#ifdef DOS_NT
+ /* If newdir is effectively "C:/", then the drive letter will have
+ been stripped and newdir will be "/". Concatenating with an
+ absolute directory in nm produces "//", which will then be
+ incorrectly treated as a network share. Ignore newdir in
+ this case (keeping the drive letter). */
+ if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
+ && newdir[1] == '\0'))
+#endif
+ strcpy (target, newdir);
+ }
else
#endif
file_name_as_directory (target, newdir);
target[0] = DRIVE_LETTER (drive);
target[1] = ':';
}
+ /* Reinsert the escape prefix if required. */
+ if (is_escaped)
+ {
+ target -= 2;
+ target[0] = '/';
+ target[1] = ':';
+ }
CORRECT_DIR_SEPS (target);
#endif /* DOS_NT */
CORRECT_DIR_SEPS (nm);
substituted = (strcmp (nm, XSTRING (filename)->data) != 0);
#endif
- endp = nm + XSTRING (filename)->size;
+ endp = nm + STRING_BYTES (XSTRING (filename));
/* If /~ or // appears, discard everything through first slash. */
/* If substitution required, recopy the string and do it */
/* Make space in stack frame for the new copy */
- xnm = (unsigned char *) alloca (XSTRING (filename)->size + total + 1);
+ xnm = (unsigned char *) alloca (STRING_BYTES (XSTRING (filename)) + total + 1);
x = xnm;
/* Copy the rest of the name through, replacing $ constructs with values */
if (!o)
goto badvar;
- strcpy (x, o);
- x += strlen (o);
+ if (STRING_MULTIBYTE (filename))
+ {
+ /* If the original string is multibyte,
+ convert what we substitute into multibyte. */
+ while (*o)
+ {
+ int c = unibyte_char_to_multibyte (*o++);
+ x += CHAR_STRING (c, x);
+ }
+ }
+ else
+ {
+ strcpy (x, o);
+ x += strlen (o);
+ }
}
*x = 0;
xnm = p;
#ifdef DOS_NT
else if (IS_DRIVE (p[0]) && p[1] == ':'
- && p > nm && IS_DIRECTORY_SEP (p[-1]))
+ && p > xnm && IS_DIRECTORY_SEP (p[-1]))
xnm = p;
#endif
- return make_string (xnm, x - xnm);
+ if (STRING_MULTIBYTE (filename))
+ return make_string (xnm, x - xnm);
+ return make_unibyte_string (xnm, x - xnm);
badsubst:
error ("Bad format environment-variable substitution");
absname = Fexpand_file_name (filename, defdir);
#ifdef VMS
{
- register int c = XSTRING (absname)->data[XSTRING (absname)->size - 1];
+ register int c = XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1];
if (c == ':' || c == ']' || c == '>')
absname = Fdirectory_file_name (absname);
}
/* Remove final slash, if any (unless this is the root dir).
stat behaves differently depending! */
if (XSTRING (absname)->size > 1
- && IS_DIRECTORY_SEP (XSTRING (absname)->data[XSTRING (absname)->size - 1])
- && !IS_DEVICE_SEP (XSTRING (absname)->data[XSTRING (absname)->size-2]))
+ && IS_DIRECTORY_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1])
+ && !IS_DEVICE_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname))-2]))
/* We cannot take shortcuts; they might be wrong for magic file names. */
absname = Fdirectory_file_name (absname);
#endif
and bypass the error if the user says to go ahead.
QUERYSTRING is a name for the action that is being considered
to alter the file.
+
*STATPTR is used to store the stat information if the file exists.
- If the file does not exist, STATPTR->st_mode is set to 0. */
+ If the file does not exist, STATPTR->st_mode is set to 0.
+ If STATPTR is null, we don't store into it.
+
+ 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)
+barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick)
Lisp_Object absname;
unsigned char *querystring;
int interactive;
struct stat *statptr;
+ int quick;
{
- register Lisp_Object tem;
+ register Lisp_Object tem, encoded_filename;
struct stat statbuf;
struct gcpro gcpro1;
+ encoded_filename = ENCODE_FILE (absname);
+
/* stat is a good way to tell whether the file exists,
regardless of what access permissions it has. */
- if (stat (XSTRING (absname)->data, &statbuf) >= 0)
+ if (stat (XSTRING (encoded_filename)->data, &statbuf) >= 0)
{
if (! interactive)
Fsignal (Qfile_already_exists,
Fcons (build_string ("File already exists"),
Fcons (absname, Qnil)));
GCPRO1 (absname);
- tem = do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
- XSTRING (absname)->data, querystring));
+ tem = format1 ("File %s already exists; %s anyway? ",
+ XSTRING (absname)->data, querystring);
+ if (quick)
+ tem = Fy_or_n_p (tem);
+ else
+ tem = do_yes_or_no_p (tem);
UNGCPRO;
if (NILP (tem))
Fsignal (Qfile_already_exists,
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (encoded_newname, "copy to it",
- INTEGERP (ok_if_already_exists), &out_st);
+ INTEGERP (ok_if_already_exists), &out_st, 0);
else if (stat (XSTRING (encoded_newname)->data, &out_st) < 0)
out_st.st_mode = 0;
- ifd = open (XSTRING (encoded_file)->data, O_RDONLY);
+ ifd = emacs_open (XSTRING (encoded_file)->data, O_RDONLY, 0);
if (ifd < 0)
report_file_error ("Opening input file", Fcons (file, Qnil));
copyable by us. */
input_file_statable_p = (fstat (ifd, &st) >= 0);
-#if !defined (MSDOS) || __DJGPP__ > 1
+#if !defined (DOS_NT) || __DJGPP__ > 1
if (out_st.st_mode != 0
&& st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
{
immediate_quit = 1;
QUIT;
- while ((n = read (ifd, buf, sizeof buf)) > 0)
- if (write (ofd, buf, n) != n)
+ while ((n = emacs_read (ifd, buf, sizeof buf)) > 0)
+ if (emacs_write (ofd, buf, n) != n)
report_file_error ("I/O error", Fcons (newname, Qnil));
immediate_quit = 0;
/* Closing the output clobbers the file times on some systems. */
- if (close (ofd) < 0)
+ if (emacs_close (ofd) < 0)
report_file_error ("I/O error", Fcons (newname, Qnil));
if (input_file_statable_p)
#endif /* MSDOS */
}
- close (ifd);
+ emacs_close (ifd);
/* Discard the unwind protects. */
specpdl_ptr = specpdl + count;
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (encoded_newname, "rename to it",
- INTEGERP (ok_if_already_exists), 0);
+ INTEGERP (ok_if_already_exists), 0, 0);
#ifndef BSD4_1
if (0 > rename (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data))
#else
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (encoded_newname, "make it a new name",
- INTEGERP (ok_if_already_exists), 0);
+ INTEGERP (ok_if_already_exists), 0, 0);
unlink (XSTRING (newname)->data);
if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data))
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (encoded_linkname, "make it a link",
- INTEGERP (ok_if_already_exists), 0);
+ INTEGERP (ok_if_already_exists), 0, 0);
if (0 > symlink (XSTRING (encoded_filename)->data,
XSTRING (encoded_linkname)->data))
{
if (S_ISFIFO (statbuf.st_mode))
flags |= O_NONBLOCK;
#endif
- desc = open (XSTRING (absname)->data, flags);
+ desc = emacs_open (XSTRING (absname)->data, flags, 0);
if (desc < 0)
return Qnil;
- close (desc);
+ emacs_close (desc);
return Qt;
#endif /* not DOS_NT */
}
int fd;
CHECK_STRING (filename, 0);
+ CHECK_STRING (string, 1);
/* If the file name has special constructs in it,
call the corresponding file handler. */
encoded_filename = ENCODE_FILE (filename);
- fd = open (XSTRING (encoded_filename)->data, O_RDONLY);
+ fd = emacs_open (XSTRING (encoded_filename)->data, O_RDONLY, 0);
if (fd < 0)
report_file_error (XSTRING (string)->data, Fcons (filename, Qnil));
- close (fd);
+ emacs_close (fd);
return Qnil;
}
}
val = make_string (buf, valsize);
xfree (buf);
- return Fdecode_coding_string (val, Vfile_name_coding_system, Qt);
+ 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,
- "Return t if FILENAME names an existing directory.")
+ "Return t if FILENAME names an existing directory.\n\
+Symbolic links to directories count as directories.\n\
+See `file-symlink-p' to distinguish symlinks.")
(filename)
Lisp_Object filename;
{
absname = ENCODE_FILE (absname);
+#ifdef WINDOWSNT
+ {
+ int result;
+ Lisp_Object tem = Vw32_get_true_file_attributes;
+
+ /* Tell stat to use expensive method to get accurate info. */
+ Vw32_get_true_file_attributes = Qt;
+ result = stat (XSTRING (absname)->data, &st);
+ Vw32_get_true_file_attributes = tem;
+
+ if (result < 0)
+ return Qnil;
+ return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
+ }
+#else
if (stat (XSTRING (absname)->data, &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
+#endif
}
\f
DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
#define READ_BUF_SIZE (64 << 10)
#endif
+extern void adjust_markers_for_delete P_ ((int, int, int, int));
+
+/* This function is called after Lisp functions to decide a coding
+ system are called, or when they cause an error. Before they are
+ called, the current buffer is set unibyte and it contains only a
+ newly inserted text (thus the buffer was empty before the
+ insertion).
+
+ The functions may set markers, overlays, text properties, or even
+ alter the buffer contents, change the current buffer.
+
+ Here, we reset all those changes by:
+ o set back the current buffer.
+ o move all markers and overlays to BEG.
+ o remove all text properties.
+ o set back the buffer multibyteness. */
+
+static Lisp_Object
+decide_coding_unwind (unwind_data)
+ Lisp_Object unwind_data;
+{
+ Lisp_Object multibyte, undo_list, buffer;
+
+ multibyte = XCAR (unwind_data);
+ unwind_data = XCDR (unwind_data);
+ undo_list = XCAR (unwind_data);
+ buffer = XCDR (unwind_data);
+
+ if (current_buffer != XBUFFER (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;
+ 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;
+
+ return Qnil;
+}
+
DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
1, 5, 0,
"Insert contents of file FILENAME after point.\n\
-Returns list of absolute file name and length of data inserted.\n\
+Returns list of absolute file name and number of bytes inserted.\n\
If second argument VISIT is non-nil, the buffer's visited filename\n\
and last save file modtime are set, and it is marked unmodified.\n\
If visiting and the file does not exist, visiting is completed\n\
before the error is signaled.\n\
The optional third and fourth arguments BEG and END\n\
specify what portion of the file to insert.\n\
+These arguments count bytes in the file, not characters in the buffer.\n\
If VISIT is non-nil, BEG and END must be nil.\n\
\n\
If optional fifth argument REPLACE is non-nil,\n\
and (2) it puts less data in the undo list.\n\
When REPLACE is non-nil, the value is the number of characters actually read,\n\
which is often less than the number of characters to be read.\n\
+\n\
This does code conversion according to the value of\n\
- `coding-system-for-read' or `file-coding-system-alist',\n\
- and sets the variable `last-coding-system-used' to the coding system\n\
- actually used.")
+`coding-system-for-read' or `file-coding-system-alist',\n\
+and sets the variable `last-coding-system-used' to the coding system\n\
+actually used.")
(filename, visit, beg, end, replace)
Lisp_Object filename, visit, beg, end, replace;
{
struct stat st;
register int fd;
- register int inserted = 0;
+ int inserted = 0;
register int how_much;
register int unprocessed;
int count = specpdl_ptr - specpdl;
Lisp_Object p;
int total;
int not_regular = 0;
- char read_buf[READ_BUF_SIZE];
+ unsigned char read_buf[READ_BUF_SIZE];
struct coding_system coding;
unsigned char buffer[1 << 14];
int replace_handled = 0;
+ int set_coding_system = 0;
+ int coding_system_decided = 0;
if (current_buffer->base_buffer && ! NILP (visit))
error ("Cannot do file visiting in an indirect buffer");
{
val = call6 (handler, Qinsert_file_contents, filename,
visit, beg, end, replace);
+ if (CONSP (val) && CONSP (XCDR (val)))
+ inserted = XINT (XCAR (XCDR (val)));
goto handled;
}
fd = -1;
+#ifdef WINDOWSNT
+ {
+ Lisp_Object tem = Vw32_get_true_file_attributes;
+
+ /* Tell stat to use expensive method to get accurate info. */
+ Vw32_get_true_file_attributes = Qt;
+ total = stat (XSTRING (filename)->data, &st);
+ Vw32_get_true_file_attributes = tem;
+ }
+ if (total < 0)
+#else
#ifndef APOLLO
if (stat (XSTRING (filename)->data, &st) < 0)
#else
- if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0
+ if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0
|| fstat (fd, &st) < 0)
#endif /* not APOLLO */
+#endif /* WINDOWSNT */
{
- if (fd >= 0) close (fd);
+ if (fd >= 0) emacs_close (fd);
badopen:
if (NILP (visit))
report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
st.st_mtime = -1;
how_much = 0;
if (!NILP (Vcoding_system_for_read))
- current_buffer->buffer_file_coding_system = Vcoding_system_for_read;
+ Fset (Qbuffer_file_coding_system, Vcoding_system_for_read);
goto notfound;
}
#endif
if (fd < 0)
- if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0)
+ if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0)
goto badopen;
/* Replacement should preserve point as it preserves markers. */
if (! not_regular && st.st_size < 0)
error ("File size is negative");
+ /* Prevent redisplay optimizations. */
+ current_buffer->clip_changed = 1;
+
if (!NILP (beg) || !NILP (end))
if (!NILP (visit))
error ("Attempt to visit less than an entire file");
if (! not_regular)
{
XSETINT (end, st.st_size);
- if (XINT (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
+ || ((int) st.st_size * 4) / 4 != st.st_size)
error ("Maximum buffer size exceeded");
}
}
- /* Decide the coding-system of the file. */
- {
- Lisp_Object val = Qnil;
+ if (BEG < Z)
+ {
+ /* Decide the coding system to use for reading the file now
+ because we can't use an optimized method for handling
+ `coding:' tag if the current buffer is not empty. */
+ Lisp_Object val;
+ val = Qnil;
- if (!NILP (Vcoding_system_for_read))
- val = Vcoding_system_for_read;
- else if (NILP (current_buffer->enable_multibyte_characters))
- val = Qemacs_mule;
- else
- {
- if (! NILP (Vset_auto_coding_function))
- {
- /* Find a coding system specified in the heading two lines
- or in the tailing several lines of the file. We assume
- that the 1K-byte and 3K-byte for heading and tailing
- respectively are sufficient fot this purpose. */
- int how_many, nread;
-
- if (st.st_size <= (1024 * 4))
- nread = read (fd, read_buf, 1024 * 4);
- else
- {
- nread = read (fd, read_buf, 1024);
- if (nread >= 0)
- {
- if (lseek (fd, st.st_size - (1024 * 3), 0) < 0)
- report_file_error ("Setting file position",
- Fcons (orig_filename, Qnil));
- nread += read (fd, read_buf + nread, 1024 * 3);
- }
- }
-
- if (nread < 0)
- error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, strerror (errno));
- else if (nread > 0)
- {
- val = call1 (Vset_auto_coding_function,
- make_string (read_buf, nread));
- /* Rewind the file for the actual read done later. */
- if (lseek (fd, 0, 0) < 0)
- report_file_error ("Setting file position",
- Fcons (orig_filename, Qnil));
- }
- }
- if (NILP (val))
- {
- Lisp_Object args[6], coding_systems;
+ if (!NILP (Vcoding_system_for_read))
+ val = Vcoding_system_for_read;
+ else if (! NILP (replace))
+ /* In REPLACE mode, we can use the same coding system
+ that was used to visit the file. */
+ val = current_buffer->buffer_file_coding_system;
+ else
+ {
+ /* Don't try looking inside a file for a coding system
+ specification if it is not seekable. */
+ if (! not_regular && ! NILP (Vset_auto_coding_function))
+ {
+ /* Find a coding system specified in the heading two
+ lines or in the tailing several lines of the file.
+ We assume that the 1K-byte and 3K-byte for heading
+ and tailing respectively are sufficient for this
+ purpose. */
+ int how_many, nread;
+
+ if (st.st_size <= (1024 * 4))
+ nread = emacs_read (fd, read_buf, 1024 * 4);
+ else
+ {
+ nread = emacs_read (fd, read_buf, 1024);
+ if (nread >= 0)
+ {
+ if (lseek (fd, st.st_size - (1024 * 3), 0) < 0)
+ report_file_error ("Setting file position",
+ Fcons (orig_filename, Qnil));
+ nread += emacs_read (fd, read_buf + nread, 1024 * 3);
+ }
+ }
+
+ if (nread < 0)
+ error ("IO error reading %s: %s",
+ XSTRING (orig_filename)->data, emacs_strerror (errno));
+ else if (nread > 0)
+ {
+ int count = specpdl_ptr - specpdl;
+ struct buffer *prev = current_buffer;
+
+ record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ temp_output_buffer_setup (" *code-converting-work*");
+ set_buffer_internal (XBUFFER (Vstandard_output));
+ current_buffer->enable_multibyte_characters = Qnil;
+ insert_1_both (read_buf, nread, nread, 0, 0, 0);
+ TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
+ val = call2 (Vset_auto_coding_function,
+ filename, make_number (nread));
+ set_buffer_internal (prev);
+ /* Discard the unwind protect for recovering the
+ current buffer. */
+ specpdl_ptr--;
+
+ /* Rewind the file for the actual read done later. */
+ if (lseek (fd, 0, 0) < 0)
+ report_file_error ("Setting file position",
+ Fcons (orig_filename, Qnil));
+ }
+ }
+
+ if (NILP (val))
+ {
+ /* If we have not yet decided a coding system, check
+ file-coding-system-alist. */
+ Lisp_Object args[6], coding_systems;
- args[0] = Qinsert_file_contents, args[1] = orig_filename,
+ args[0] = Qinsert_file_contents, args[1] = orig_filename;
args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace;
- coding_systems = Ffind_operation_coding_system (6, args);
- if (CONSP (coding_systems)) val = XCONS (coding_systems)->car;
- }
- }
- setup_coding_system (Fcheck_coding_system (val), &coding);
- }
+ coding_systems = Ffind_operation_coding_system (6, args);
+ if (CONSP (coding_systems))
+ val = XCAR (coding_systems);
+ }
+ }
+
+ setup_coding_system (Fcheck_coding_system (val), &coding);
+
+ if (NILP (current_buffer->enable_multibyte_characters)
+ && ! NILP (val))
+ /* We must suppress all character code conversion except for
+ end-of-line conversion. */
+ setup_raw_text_coding_system (&coding);
+
+ coding_system_decided = 1;
+ }
+
+ /* Ensure we always set Vlast_coding_system_used. */
+ set_coding_system = 1;
/* If requested, replace the accessible part of the buffer
with the file contents. Avoid replacing text at the
But if we discover the need for conversion, we give up on this method
and let the following if-statement handle the replace job. */
if (!NILP (replace)
- && ! CODING_REQUIRE_DECODING (&coding))
+ && BEGV < ZV
+ && ! CODING_REQUIRE_DECODING (&coding)
+ && (coding.eol_type == CODING_EOL_UNDECIDED
+ || coding.eol_type == CODING_EOL_LF))
{
- int same_at_start = BEGV;
- int same_at_end = ZV;
+ /* same_at_start and same_at_end count bytes,
+ because file access counts bytes
+ and BEG and END count bytes. */
+ int same_at_start = BEGV_BYTE;
+ int same_at_end = ZV_BYTE;
int 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
{
int nread, bufpos;
- nread = read (fd, buffer, sizeof buffer);
+ nread = emacs_read (fd, buffer, sizeof buffer);
if (nread < 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, strerror (errno));
+ XSTRING (orig_filename)->data, emacs_strerror (errno));
else if (nread == 0)
break;
}
bufpos = 0;
- while (bufpos < nread && same_at_start < ZV
+ while (bufpos < nread && same_at_start < ZV_BYTE
&& FETCH_BYTE (same_at_start) == buffer[bufpos])
same_at_start++, bufpos++;
/* If we found a discrepancy, stop the scan.
immediate_quit = 0;
/* If the file matches the buffer completely,
there's no need to replace anything. */
- if (same_at_start - BEGV == XINT (end))
+ if (same_at_start - BEGV_BYTE == XINT (end))
{
- close (fd);
+ emacs_close (fd);
specpdl_ptr--;
/* Truncate the buffer to the size of the file. */
- del_range_1 (same_at_start, same_at_end, 0);
+ del_range_1 (same_at_start, same_at_end, 0, 0);
goto handled;
}
immediate_quit = 1;
int total_read, nread, bufpos, curpos, trial;
/* At what file position are we now scanning? */
- curpos = XINT (end) - (ZV - same_at_end);
+ curpos = XINT (end) - (ZV_BYTE - same_at_end);
/* If the entire file matches the buffer tail, stop the scan. */
if (curpos == 0)
break;
total_read = 0;
while (total_read < trial)
{
- nread = read (fd, buffer + total_read, trial - total_read);
+ nread = emacs_read (fd, buffer + total_read, trial - total_read);
if (nread <= 0)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, strerror (errno));
+ XSTRING (orig_filename)->data, emacs_strerror (errno));
total_read += nread;
}
/* Scan this bufferful from the end, comparing with
if (same_at_end > same_at_start
&& FETCH_BYTE (same_at_end - 1) >= 0200
&& ! NILP (current_buffer->enable_multibyte_characters)
- && (CODING_REQUIRE_DECODING (&coding)
- || CODING_REQUIRE_DETECTION (&coding)))
+ && (CODING_MAY_REQUIRE_DECODING (&coding)))
giveup_match_end = 1;
break;
}
if (! giveup_match_end)
{
+ int temp;
+
/* We win! We can handle REPLACE the optimized way. */
- /* Extends the end of non-matching text area to multibyte
+ /* Extend the start of non-matching text area to multibyte
character boundary. */
if (! NILP (current_buffer->enable_multibyte_characters))
- while (same_at_end < ZV && ! CHAR_HEAD_P (POS_ADDR (same_at_end)))
+ 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))
+ 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 - (same_at_end + st.st_size - ZV);
+ overlap = (same_at_start - BEGV_BYTE
+ - (same_at_end + st.st_size - ZV));
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));
- XSETFASTINT (end, XINT (end) - (ZV - same_at_end));
+ XSETFASTINT (beg, XINT (beg) + (same_at_start - BEGV_BYTE));
+ XSETFASTINT (end, XINT (end) - (ZV_BYTE - same_at_end));
- del_range_1 (same_at_start, same_at_end, 0);
+ del_range_byte (same_at_start, same_at_end, 0);
/* Insert from the file at the proper position. */
- SET_PT (same_at_start);
+ temp = BYTE_TO_CHAR (same_at_start);
+ SET_PT_BOTH (temp, same_at_start);
/* If display currently starts at beginning of line,
keep it that way. */
is needed, in a simple way that needs a lot of memory.
The preceding if-statement handles the case of no conversion
in a more optimized way. */
- if (!NILP (replace) && ! replace_handled)
+ if (!NILP (replace) && ! replace_handled && BEGV < ZV)
{
- int same_at_start = BEGV;
- int same_at_end = ZV;
+ int same_at_start = BEGV_BYTE;
+ int same_at_end = ZV_BYTE;
int overlap;
int bufpos;
/* Make sure that the gap is large enough. */
int bufsize = 2 * st.st_size;
unsigned char *conversion_buffer = (unsigned char *) xmalloc (bufsize);
+ int temp;
/* First read the whole file, performing code conversion into
CONVERSION_BUFFER. */
if (lseek (fd, XINT (beg), 0) < 0)
{
- free (conversion_buffer);
+ xfree (conversion_buffer);
report_file_error ("Setting file position",
Fcons (orig_filename, Qnil));
}
{
/* try is reserved in some compilers (Microsoft C) */
int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed);
- char *destination = read_buf + unprocessed;
+ unsigned char *destination = read_buf + unprocessed;
int this;
/* Allow quitting out of the actual I/O. */
immediate_quit = 1;
QUIT;
- this = read (fd, destination, trytry);
+ this = emacs_read (fd, destination, trytry);
immediate_quit = 0;
if (this < 0 || this + unprocessed == 0)
how_much += this;
- if (CODING_REQUIRE_DECODING (&coding)
- || CODING_REQUIRE_DETECTION (&coding))
+ if (CODING_MAY_REQUIRE_DECODING (&coding))
{
- int require, produced, consumed;
+ int require, result;
this += unprocessed;
/* Convert this batch with results in CONVERSION_BUFFER. */
if (how_much >= total) /* This is the last block. */
- coding.last_block = 1;
- produced = decode_coding (&coding, read_buf,
- conversion_buffer + inserted,
- this, bufsize - inserted,
- &consumed);
+ coding.mode |= CODING_MODE_LAST_BLOCK;
+ result = decode_coding (&coding, read_buf,
+ conversion_buffer + inserted,
+ this, bufsize - inserted);
/* Save for next iteration whatever we didn't convert. */
- unprocessed = this - consumed;
- bcopy (read_buf + consumed, read_buf, unprocessed);
- this = produced;
+ unprocessed = this - coding.consumed;
+ bcopy (read_buf + coding.consumed, read_buf, unprocessed);
+ this = coding.produced;
}
inserted += this;
}
- /* At this point, INSERTED is how many characters
+ /* At this point, INSERTED is how many characters (i.e. bytes)
are present in CONVERSION_BUFFER.
HOW_MUCH should equal TOTAL,
or should be <= 0 if we couldn't read the file. */
if (how_much < 0)
{
- free (conversion_buffer);
+ xfree (conversion_buffer);
if (how_much == -1)
error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, strerror (errno));
+ XSTRING (orig_filename)->data, emacs_strerror (errno));
else if (how_much == -2)
error ("maximum buffer size exceeded");
}
if (bufpos == inserted)
{
- free (conversion_buffer);
- close (fd);
+ xfree (conversion_buffer);
+ emacs_close (fd);
specpdl_ptr--;
/* Truncate the buffer to the size of the file. */
- del_range_1 (same_at_start, same_at_end, 0);
+ del_range_byte (same_at_start, same_at_end, 0);
+ inserted = 0;
goto handled;
}
+ /* Extend the start of non-matching text area to multibyte
+ character boundary. */
+ if (! NILP (current_buffer->enable_multibyte_characters))
+ while (same_at_start > BEGV_BYTE
+ && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
+ same_at_start--;
+
/* Scan this bufferful from the end, comparing with
the Emacs buffer. */
bufpos = inserted;
&& FETCH_BYTE (same_at_end - 1) == conversion_buffer[bufpos - 1])
same_at_end--, bufpos--;
+ /* Extend the end of non-matching text area to multibyte
+ character boundary. */
+ if (! NILP (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 - (same_at_end + inserted - ZV);
+ overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE);
if (overlap > 0)
same_at_end += overlap;
/* Replace the chars that we need to replace,
and update INSERTED to equal the number of bytes
we are taking from the file. */
- inserted -= (Z - same_at_end) + (same_at_start - BEG);
- move_gap (same_at_start);
- del_range_1 (same_at_start, same_at_end, 0);
- SET_PT (same_at_start);
- insert_1 (conversion_buffer + same_at_start - BEG, inserted, 0, 0);
+ inserted -= (Z_BYTE - same_at_end) + (same_at_start - BEG_BYTE);
+
+ if (same_at_end != same_at_start)
+ {
+ del_range_byte (same_at_start, same_at_end, 0);
+ temp = GPT;
+ same_at_start = GPT_BYTE;
+ }
+ else
+ {
+ temp = BYTE_TO_CHAR (same_at_start);
+ }
+ /* Insert from the file at the proper position. */
+ SET_PT_BOTH (temp, same_at_start);
+ insert_1 (conversion_buffer + same_at_start - BEG_BYTE, inserted,
+ 0, 0, 0);
+ /* Set `inserted' to the number of inserted characters. */
+ inserted = PT - temp;
free (conversion_buffer);
- close (fd);
+ emacs_close (fd);
specpdl_ptr--;
goto handled;
}
/* In the following loop, HOW_MUCH contains the total bytes read so
- far. Before exiting the loop, it is set to -1 if I/O error
- occurs, set to -2 if the maximum buffer size is exceeded. */
+ far for a regular file, and not changed for a special file. But,
+ before exiting the loop, it is set to a negative value if I/O
+ error occurs. */
how_much = 0;
/* Total bytes inserted. */
inserted = 0;
- /* Bytes not processed in the previous loop because short gap size. */
- unprocessed = 0;
+ /* Here, we don't do code conversion in the loop. It is done by
+ code_convert_region after all data are read into the buffer. */
while (how_much < total)
{
/* try is reserved in some compilers (Microsoft C) */
- int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed);
- char *destination = (! (CODING_REQUIRE_DECODING (&coding)
- || CODING_REQUIRE_DETECTION (&coding))
- ? (char *) (POS_ADDR (PT + inserted - 1) + 1)
- : read_buf + unprocessed);
+ int trytry = min (total - how_much, READ_BUF_SIZE);
int this;
+ /* For a special file, GAP_SIZE should be checked every time. */
+ if (not_regular && GAP_SIZE < trytry)
+ make_gap (total - GAP_SIZE);
+
/* Allow quitting out of the actual I/O. */
immediate_quit = 1;
QUIT;
- this = read (fd, destination, trytry);
+ this = emacs_read (fd, BYTE_POS_ADDR (PT_BYTE + inserted - 1) + 1,
+ trytry);
immediate_quit = 0;
- if (this < 0 || this + unprocessed == 0)
+ if (this <= 0)
{
how_much = this;
break;
}
+ GAP_SIZE -= this;
+ GPT_BYTE += this;
+ ZV_BYTE += this;
+ Z_BYTE += this;
+ GPT += this;
+ ZV += this;
+ Z += this;
+
/* For a regular file, where TOTAL is the real size,
count HOW_MUCH to compare with it.
For a special file, where TOTAL is just a buffer size,
(INSERTED is where we count the number of characters inserted.) */
if (! not_regular)
how_much += this;
+ inserted += this;
+ }
- if (CODING_REQUIRE_DECODING (&coding)
- || CODING_REQUIRE_DETECTION (&coding))
- {
- int require, produced, consumed;
+ if (GAP_SIZE > 0)
+ /* Put an anchor to ensure multi-byte form ends at gap. */
+ *GPT_ADDR = 0;
- this += unprocessed;
- /* Make sure that the gap is large enough. */
- require = decoding_buffer_size (&coding, this);
- if (GAP_SIZE < require)
- make_gap (require - GAP_SIZE);
+ emacs_close (fd);
- if (! not_regular)
- {
- if (how_much >= total) /* This is the last block. */
- coding.last_block = 1;
- }
- else
+ /* Discard the unwind protect for closing the file. */
+ specpdl_ptr--;
+
+ if (how_much < 0)
+ error ("IO error reading %s: %s",
+ XSTRING (orig_filename)->data, emacs_strerror (errno));
+
+ if (! coding_system_decided)
+ {
+ /* The coding system is not yet decided. Decide it by an
+ optimized method for handling `coding:' tag.
+
+ Note that we can get here only if the buffer was empty
+ before the insertion. */
+ Lisp_Object val;
+ val = Qnil;
+
+ if (!NILP (Vcoding_system_for_read))
+ val = Vcoding_system_for_read;
+ else
+ {
+ /* Since we are sure that the current buffer was empty
+ before the insertion, we can toggle
+ enable-multibyte-characters directly here without taking
+ care of marker adjustment and byte combining problem. By
+ this way, we can run Lisp program safely before decoding
+ the inserted text. */
+ Lisp_Object unwind_data;
+ int count = specpdl_ptr - specpdl;
+
+ unwind_data = Fcons (current_buffer->enable_multibyte_characters,
+ Fcons (current_buffer->undo_list,
+ Fcurrent_buffer ()));
+ current_buffer->enable_multibyte_characters = Qnil;
+ current_buffer->undo_list = Qt;
+ record_unwind_protect (decide_coding_unwind, unwind_data);
+
+ if (inserted > 0 && ! NILP (Vset_auto_coding_function))
{
- /* If we encounter EOF, say it is the last block. (The
- data this will apply to is the UNPROCESSED characters
- carried over from the last batch.) */
- if (this == 0)
- coding.last_block = 1;
+ val = call2 (Vset_auto_coding_function,
+ filename, make_number (inserted));
}
- produced = decode_coding (&coding, read_buf,
- POS_ADDR (PT + inserted - 1) + 1,
- this, GAP_SIZE, &consumed);
- if (produced > 0)
+ if (NILP (val))
{
- Lisp_Object temp;
-
- XSET (temp, Lisp_Int, Z + produced);
- if (Z + produced != XINT (temp))
- {
- how_much = -2;
- break;
- }
+ /* If the coding system is not yet decided, check
+ file-coding-system-alist. */
+ Lisp_Object args[6], coding_systems;
+
+ args[0] = Qinsert_file_contents, args[1] = orig_filename;
+ args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil;
+ coding_systems = Ffind_operation_coding_system (6, args);
+ if (CONSP (coding_systems))
+ val = XCAR (coding_systems);
}
- unprocessed = this - consumed;
- bcopy (read_buf + consumed, read_buf, unprocessed);
- this = produced;
+
+ unbind_to (count, Qnil);
+ inserted = Z_BYTE - BEG_BYTE;
}
- GPT += this;
- GAP_SIZE -= this;
- ZV += this;
- Z += this;
- if (GAP_SIZE > 0)
- /* Put an anchor to ensure multi-byte form ends at gap. */
- *GPT_ADDR = 0;
- inserted += this;
+ /* The following kludgy code is to avoid some compiler bug.
+ We can't simply do
+ setup_coding_system (val, &coding);
+ on some system. */
+ {
+ struct coding_system temp_coding;
+ setup_coding_system (val, &temp_coding);
+ bcopy (&temp_coding, &coding, sizeof coding);
+ }
+
+ if (NILP (current_buffer->enable_multibyte_characters)
+ && ! NILP (val))
+ /* We must suppress all character code conversion except for
+ end-of-line conversion. */
+ setup_raw_text_coding_system (&coding);
}
+ if (inserted > 0 || coding.type == coding_type_ccl)
+ {
+ if (CODING_MAY_REQUIRE_DECODING (&coding))
+ {
+ /* Here, we don't have to consider byte combining (see the
+ comment below) because code_convert_region takes care of
+ it. */
+ code_convert_region (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
+ &coding, 0, 0);
+ inserted = (NILP (current_buffer->enable_multibyte_characters)
+ ? coding.produced : coding.produced_char);
+ }
+ else if (!NILP (current_buffer->enable_multibyte_characters))
+ {
+ int inserted_byte = inserted;
+
+ /* There's a possibility that we must combine bytes at the
+ head (resp. the tail) of the just inserted text with the
+ bytes before (resp. after) the gap to form a single
+ character. */
+ inserted = multibyte_chars_in_text (GPT_ADDR - inserted, inserted);
+ adjust_after_insert (PT, PT_BYTE,
+ PT + inserted_byte, PT_BYTE + inserted_byte,
+ inserted);
+ }
+ else
+ adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
+ inserted);
+ }
#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 (coding.eol_type != CODING_EOL_UNDECIDED
- && coding.eol_type != CODING_EOL_LF)
- current_buffer->buffer_file_type = Qnil;
- else
+ if ((coding.eol_type == CODING_EOL_UNDECIDED
+ || coding.eol_type == CODING_EOL_LF)
+ && ! CODING_REQUIRE_DECODING (&coding))
current_buffer->buffer_file_type = Qt;
+ else
+ current_buffer->buffer_file_type = Qnil;
#endif
- /* We don't have to consider file type of MSDOS because all files
- are read as binary and end-of-line format has already been
- decoded appropriately. */
-#if 0
-#ifdef DOS_NT
- /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
- /* Determine file type from name and remove LFs from CR-LFs if the file
- is deemed to be a text file. */
- {
- current_buffer->buffer_file_type
- = call1 (Qfind_buffer_file_type, orig_filename);
- if (NILP (current_buffer->buffer_file_type))
- {
- int reduced_size
- = inserted - crlf_to_lf (inserted, POS_ADDR (PT - 1) + 1);
- ZV -= reduced_size;
- Z -= reduced_size;
- GPT -= reduced_size;
- GAP_SIZE += reduced_size;
- inserted -= reduced_size;
- }
- }
-#endif /* DOS_NT */
-#endif /* 0 */
-
- if (inserted > 0)
- {
- record_insert (PT, inserted);
-
- /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
- offset_intervals (current_buffer, PT, inserted);
- MODIFF++;
- }
-
- close (fd);
-
- /* Discard the unwind protect for closing the file. */
- specpdl_ptr--;
-
- if (how_much == -1)
- error ("IO error reading %s: %s",
- XSTRING (orig_filename)->data, strerror (errno));
- else if (how_much == -2)
- error ("maximum buffer size exceeded");
-
notfound:
handled:
inserted = XFASTINT (insval);
}
+ if (set_coding_system)
+ Vlast_coding_system_used = coding.symbol;
+
/* 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);
-
- Vlast_coding_system_used = coding.symbol;
+ {
+ signal_after_change (PT, 0, inserted);
+ update_compositions (PT, PT, CHECK_BORDER);
+ }
if (inserted > 0)
{
p = Vafter_insert_file_functions;
- if (!NILP (coding.post_read_conversion))
- p = Fcons (coding.post_read_conversion, p);
-
while (!NILP (p))
{
insval = call1 (Fcar (p), make_number (inserted));
}
}
+ /* ??? Retval needs to be dealt with in all cases consistently. */
if (NILP (val))
val = Fcons (orig_filename,
Fcons (make_number (inserted),
RETURN_UNGCPRO (unbind_to (count, val));
}
\f
-static Lisp_Object build_annotations ();
-extern Lisp_Object Ffile_locked_p ();
+static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object,
+ Lisp_Object));
/* If build_annotations switched buffers, switch back to BUF.
Kill the temporary buffer that was selected in the meantime.
return Qnil;
}
-DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 6,
- "r\nFWrite region to file: ",
+DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
+ "r\nFWrite region to file: \ni\ni\ni\np",
"Write current region into specified file.\n\
When called from a program, takes three arguments:\n\
START, END and FILENAME. START and END are buffer positions.\n\
that means do not print the \"Wrote file\" message.\n\
The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
use for locking and unlocking, overriding FILENAME and VISIT.\n\
+The optional seventh arg MUSTBENEW, if non-nil, insists on a check\n\
+ for an existing file with the same name. If MUSTBENEW is `excl',\n\
+ that means to get an error if the file already exists; never overwrite.\n\
+ If MUSTBENEW is neither nil nor `excl', that means ask for\n\
+ confirmation before overwriting, but do go ahead and overwrite the file\n\
+ if the user confirms.\n\
Kludgy feature: if START is a string, then that string is written\n\
-to the file, instead of any buffer contents, and END is ignored.")
- (start, end, filename, append, visit, lockname)
- Lisp_Object start, end, filename, append, visit, lockname;
+to the file, instead of any buffer contents, and END is ignored.\n\
+\n\
+This does code conversion according to the value of\n\
+`coding-system-for-write', `buffer-file-coding-system', or\n\
+`file-coding-system-alist', and sets the variable\n\
+`last-coding-system-used' to the coding system actually used.")
+
+ (start, end, filename, append, visit, lockname, mustbenew)
+ Lisp_Object start, end, filename, append, visit, lockname, mustbenew;
{
register int desc;
int failure;
val = Qnil;
else if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
- else if (NILP (current_buffer->enable_multibyte_characters))
+ else
{
/* If the variable `buffer-file-coding-system' is set locally,
it means that the file was read with some kind of code
had better write it out with the same coding system even if
`enable-multibyte-characters' is nil.
- If is is not set locally, we anyway have to convert EOL
+ If it is not set locally, we anyway have to convert EOL
format if the default value of `buffer-file-coding-system'
tells that it is not Unix-like (LF only) format. */
+ int using_default_coding = 0;
+ int force_raw_text = 0;
+
val = current_buffer->buffer_file_coding_system;
- if (NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
+ if (NILP (val)
+ || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
+ {
+ val = Qnil;
+ if (NILP (current_buffer->enable_multibyte_characters))
+ force_raw_text = 1;
+ }
+
+ if (NILP (val))
{
- struct coding_system coding_temp;
+ /* Check file-coding-system-alist. */
+ Lisp_Object args[7], coding_systems;
+
+ args[0] = Qwrite_region; args[1] = start; args[2] = end;
+ args[3] = filename; args[4] = append; args[5] = visit;
+ args[6] = lockname;
+ coding_systems = Ffind_operation_coding_system (7, args);
+ if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
+ val = XCDR (coding_systems);
+ }
- setup_coding_system (Fcheck_coding_system (val), &coding_temp);
- if (coding_temp.eol_type == CODING_EOL_CRLF
- || coding_temp.eol_type == CODING_EOL_CR)
+ if (NILP (val)
+ && !NILP (current_buffer->buffer_file_coding_system))
+ {
+ /* 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;
+ using_default_coding = 1;
+ }
+
+ if (!force_raw_text
+ && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
+ /* Confirm that VAL can surely encode the current region. */
+ val = call3 (Vselect_safe_coding_system_function, start, end, val);
+
+ setup_coding_system (Fcheck_coding_system (val), &coding);
+ if (coding.eol_type == CODING_EOL_UNDECIDED
+ && !using_default_coding)
+ {
+ if (! EQ (default_buffer_file_coding.symbol,
+ buffer_defaults.buffer_file_coding_system))
+ setup_coding_system (buffer_defaults.buffer_file_coding_system,
+ &default_buffer_file_coding);
+ if (default_buffer_file_coding.eol_type != CODING_EOL_UNDECIDED)
{
- setup_coding_system (Qemacs_mule, &coding);
- coding.eol_type = coding_temp.eol_type;
- goto done_setup_coding;
+ Lisp_Object subsidiaries;
+
+ coding.eol_type = default_buffer_file_coding.eol_type;
+ subsidiaries = Fget (coding.symbol, Qeol_type);
+ if (VECTORP (subsidiaries)
+ && XVECTOR (subsidiaries)->size == 3)
+ coding.symbol
+ = XVECTOR (subsidiaries)->contents[coding.eol_type];
}
- val = Qnil;
}
+
+ if (force_raw_text)
+ setup_raw_text_coding_system (&coding);
+ goto done_setup_coding;
}
- else
- {
- Lisp_Object args[7], coding_systems;
-
- args[0] = Qwrite_region, args[1] = start, args[2] = end,
- args[3] = filename, args[4] = append, args[5] = visit,
- args[6] = lockname;
- coding_systems = Ffind_operation_coding_system (7, args);
- val = (CONSP (coding_systems) && !NILP (XCONS (coding_systems)->cdr)
- ? XCONS (coding_systems)->cdr
- : current_buffer->buffer_file_coding_system);
- }
- setup_coding_system (Fcheck_coding_system (val), &coding);
+
+ setup_coding_system (Fcheck_coding_system (val), &coding);
done_setup_coding:
if (!STRINGP (start) && !NILP (current_buffer->selective_display))
- coding.selective = 1;
+ coding.mode |= CODING_MODE_SELECTIVE_DISPLAY;
}
Vlast_coding_system_used = coding.symbol;
filename = Fexpand_file_name (filename, Qnil);
+
+ if (! NILP (mustbenew) && mustbenew != Qexcl)
+ barf_or_query_if_file_exists (filename, "overwrite", 1, 0, 1);
+
if (STRINGP (visit))
visit_file = Fexpand_file_name (visit, Qnil);
else
desc = -1;
if (!NILP (append))
#ifdef DOS_NT
- desc = open (fn, O_WRONLY | buffer_file_type);
+ desc = emacs_open (fn, O_WRONLY | buffer_file_type, 0);
#else /* not DOS_NT */
- desc = open (fn, O_WRONLY);
+ desc = emacs_open (fn, O_WRONLY, 0);
#endif /* not DOS_NT */
if (desc < 0 && (NILP (append) || errno == ENOENT))
if (auto_saving) /* Overwrite any previous version of autosave file */
{
vms_truncate (fn); /* if fn exists, truncate to zero length */
- desc = open (fn, O_RDWR);
+ desc = emacs_open (fn, O_RDWR, 0);
if (desc < 0)
desc = creat_copy_attrs (STRINGP (current_buffer->filename)
? XSTRING (current_buffer->filename)->data : 0,
/* We can't make a new version;
try to truncate and rewrite existing version if any. */
vms_truncate (fn);
- desc = open (fn, O_RDWR);
+ desc = emacs_open (fn, O_RDWR, 0);
}
#endif
}
}
#else /* not VMS */
#ifdef DOS_NT
- desc = open (fn,
- O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type,
- S_IREAD | S_IWRITE);
+ desc = emacs_open (fn,
+ O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type
+ | (mustbenew == Qexcl ? O_EXCL : 0),
+ S_IREAD | S_IWRITE);
#else /* not DOS_NT */
- desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666);
+ desc = emacs_open (fn, O_WRONLY | O_TRUNC | O_CREAT
+ | (mustbenew == Qexcl ? O_EXCL : 0),
+ auto_saving ? auto_save_mode_bits : 0666);
#endif /* not DOS_NT */
#endif /* not VMS */
record_unwind_protect (close_file_unwind, make_number (desc));
- if (!NILP (append))
+ if (!NILP (append) && !NILP (Ffile_regular_p (filename)))
if (lseek (desc, 0, 2) < 0)
{
#ifdef CLASH_DETECTION
&& coding.type == coding_type_iso2022
&& coding.flags & CODING_FLAG_ISO_DESIGNATE_AT_BOL
&& GPT > BEG && GPT_ADDR[-1] != '\n')
- move_gap (find_next_newline (GPT, 1));
+ {
+ int opoint = PT, opoint_byte = PT_BYTE;
+ scan_newline (PT, PT_BYTE, ZV, ZV_BYTE, 1, 0);
+ move_gap_both (PT, PT_BYTE);
+ SET_PT_BOTH (opoint, opoint_byte);
+ }
#endif
failure = 0;
if (STRINGP (start))
{
- failure = 0 > a_write (desc, XSTRING (start)->data,
- XSTRING (start)->size, 0, &annotations, &coding);
+ failure = 0 > a_write (desc, start, 0, XSTRING (start)->size,
+ &annotations, &coding);
save_errno = errno;
}
else if (XINT (start) != XINT (end))
{
- int nwritten = 0;
+ register int end1 = CHAR_TO_BYTE (XINT (end));
+
+ tem = CHAR_TO_BYTE (XINT (start));
+
if (XINT (start) < GPT)
{
- register int end1 = XINT (end);
- tem = XINT (start);
- failure = 0 > a_write (desc, POS_ADDR (tem),
- min (GPT, end1) - tem, tem, &annotations,
- &coding);
- nwritten += min (GPT, end1) - tem;
+ failure = 0 > a_write (desc, Qnil, XINT (start),
+ min (GPT, XINT (end)) - XINT (start),
+ &annotations, &coding);
save_errno = errno;
}
if (XINT (end) > GPT && !failure)
{
- tem = XINT (start);
- tem = max (tem, GPT);
- failure = 0 > a_write (desc, POS_ADDR (tem), XINT (end) - tem,
- tem, &annotations, &coding);
- nwritten += XINT (end) - tem;
+ tem = max (XINT (start), GPT);
+ failure = 0 > a_write (desc, Qnil, tem , XINT (end) - tem,
+ &annotations, &coding);
save_errno = errno;
}
}
else
{
/* If file was empty, still need to write the annotations */
- coding.last_block = 1;
- failure = 0 > a_write (desc, "", 0, XINT (start), &annotations, &coding);
+ coding.mode |= CODING_MODE_LAST_BLOCK;
+ failure = 0 > a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
save_errno = errno;
}
- if (CODING_REQUIRE_FLUSHING (&coding) && !coding.last_block)
+ if (CODING_REQUIRE_FLUSHING (&coding)
+ && !(coding.mode & CODING_MODE_LAST_BLOCK)
+ && ! failure)
{
/* We have to flush out a data. */
- coding.last_block = 1;
- failure = 0 > e_write (desc, "", 0, &coding);
+ coding.mode |= CODING_MODE_LAST_BLOCK;
+ failure = 0 > e_write (desc, Qnil, 0, 0, &coding);
save_errno = errno;
}
#endif
/* NFS can report a write failure now. */
- if (close (desc) < 0)
+ if (emacs_close (desc) < 0)
failure = 1, save_errno = errno;
#ifdef VMS
if (failure)
error ("IO error writing %s: %s", XSTRING (filename)->data,
- strerror (save_errno));
+ emacs_strerror (save_errno));
if (visiting)
{
return Qnil;
if (!auto_saving)
- message ("Wrote %s", XSTRING (visit_file)->data);
+ message_with_string ("Wrote %s", visit_file, 1);
return Qnil;
}
-
+\f
Lisp_Object merge ();
DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
UNGCPRO;
return annotations;
}
-
-/* Write to descriptor DESC the LEN characters starting at ADDR,
- assuming they start at position POS in the buffer.
+\f
+/* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
+ If STRING is nil, POS is the character position in the current buffer.
Intersperse with them the annotations from *ANNOT
- (those which fall within the range of positions POS to POS + LEN),
+ which fall within the range of POS to POS + NCHARS,
each at its appropriate position.
- Modify *ANNOT by discarding elements as we output them.
+ We modify *ANNOT by discarding elements as we use them up.
+
The return value is negative in case of system call failure. */
-int
-a_write (desc, addr, len, pos, annot, coding)
+static int
+a_write (desc, string, pos, nchars, annot, coding)
int desc;
- register char *addr;
- register int len;
+ Lisp_Object string;
+ register int nchars;
int pos;
Lisp_Object *annot;
struct coding_system *coding;
{
Lisp_Object tem;
int nextpos;
- int lastpos = pos + len;
+ int lastpos = pos + nchars;
while (NILP (*annot) || CONSP (*annot))
{
tem = Fcar_safe (Fcar (*annot));
- if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos)
+ nextpos = pos - 1;
+ if (INTEGERP (tem))
nextpos = XFASTINT (tem);
- else
- return e_write (desc, addr, lastpos - pos, coding);
+
+ /* If there are no more annotations in this range,
+ output the rest of the range all at once. */
+ if (! (nextpos >= pos && nextpos <= lastpos))
+ return e_write (desc, string, pos, lastpos, coding);
+
+ /* Output buffer text up to the next annotation's position. */
if (nextpos > pos)
{
- if (0 > e_write (desc, addr, nextpos - pos, coding))
+ if (0 > e_write (desc, string, pos, nextpos, coding));
return -1;
- addr += nextpos - pos;
pos = nextpos;
}
+ /* Output the annotation. */
tem = Fcdr (Fcar (*annot));
if (STRINGP (tem))
{
- if (0 > e_write (desc, XSTRING (tem)->data, XSTRING (tem)->size,
- coding))
+ if (0 > e_write (desc, tem, 0, XSTRING (tem)->size, coding));
return -1;
}
*annot = Fcdr (*annot);
}
+ return 0;
}
#ifndef WRITE_BUF_SIZE
#define WRITE_BUF_SIZE (16 * 1024)
#endif
-int
-e_write (desc, addr, len, coding)
+/* Write text in the range START and END into descriptor DESC,
+ encoding them with coding system CODING. If STRING is nil, START
+ and END are character positions of the current buffer, else they
+ are indexes to the string STRING. */
+
+static int
+e_write (desc, string, start, end, coding)
int desc;
- register char *addr;
- register int len;
+ Lisp_Object string;
+ int start, end;
struct coding_system *coding;
{
+ register char *addr;
+ register int nbytes;
char buf[WRITE_BUF_SIZE];
- int produced, consumed;
+ int composing = coding->composing;
+ int return_val = 0;
+
+ if (start >= end)
+ coding->composing = COMPOSITION_DISABLED;
+ if (coding->composing != COMPOSITION_DISABLED)
+ coding_save_composition (coding, start, end, string);
+
+ if (STRINGP (string))
+ {
+ addr = XSTRING (string)->data;
+ nbytes = STRING_BYTES (XSTRING (string));
+ }
+ else if (start < end)
+ {
+ /* It is assured that the gap is not in the range START and END-1. */
+ addr = CHAR_POS_ADDR (start);
+ nbytes = CHAR_TO_BYTE (end) - CHAR_TO_BYTE (start);
+ }
+ else
+ {
+ addr = "";
+ nbytes = 0;
+ }
/* We used to have a code for handling selective display here. But,
now it is handled within encode_coding. */
while (1)
{
- produced = encode_coding (coding, addr, buf, len, WRITE_BUF_SIZE,
- &consumed);
- len -= consumed, addr += consumed;
- if (produced > 0)
+ int result;
+
+ result = encode_coding (coding, addr, buf, nbytes, WRITE_BUF_SIZE);
+ if (coding->produced > 0)
+ {
+ coding->produced -= emacs_write (desc, buf, coding->produced);
+ if (coding->produced)
+ {
+ return_val = -1;
+ break;
+ }
+ }
+ if (result == CODING_FINISH_INSUFFICIENT_SRC)
{
- produced -= write (desc, buf, produced);
- if (produced) return -1;
+ /* The source text ends by an incomplete multibyte form.
+ There's no way other than write it out as is. */
+ nbytes -= emacs_write (desc, addr, nbytes);
+ if (nbytes)
+ {
+ return_val = -1;
+ break;
+ }
}
- if (len <= 0)
+ if (nbytes <= 0)
break;
+ nbytes -= coding->consumed;
+ addr += coding->consumed;
+ start += coding->consumed_char;
+ if (coding->cmp_data)
+ coding_adjust_composition_offset (coding, start);
}
return 0;
}
-
+\f
DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
Sverify_visited_file_modtime, 1, 1, 0,
"Return t if last mod time of BUF's visited file matches what BUF records.\n\
auto_save_error ()
{
ring_bell ();
- message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data);
+ message_with_string ("Autosaving...error for %s", current_buffer->name, 1);
Fsleep_for (make_number (1), Qnil);
- message ("Autosaving...error!for %s", XSTRING (current_buffer->name)->data);
+ message_with_string ("Autosaving...error for %s", current_buffer->name, 0);
Fsleep_for (make_number (1), Qnil);
- message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data);
+ message_with_string ("Autosaving...error for %s", current_buffer->name, 0);
Fsleep_for (make_number (1), Qnil);
return Qnil;
}
return
Fwrite_region (Qnil, Qnil,
current_buffer->auto_save_file_name,
- Qnil, Qlambda, Qnil);
+ Qnil, Qlambda, Qnil, Qnil);
}
static Lisp_Object
{
auto_saving = 0;
if (!NILP (stream))
- fclose ((FILE *) (XFASTINT (XCONS (stream)->car) << 16
- | XFASTINT (XCONS (stream)->cdr)));
+ fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16
+ | XFASTINT (XCDR (stream))));
return Qnil;
}
struct buffer *old = current_buffer, *b;
Lisp_Object tail, buf;
int auto_saved = 0;
- char *omessage = echo_area_glyphs;
- int omessage_length = echo_area_glyphs_length;
int do_handled_files;
Lisp_Object oquit;
FILE *stream;
int count = specpdl_ptr - specpdl;
int *ptr;
int orig_minibuffer_auto_raise = minibuffer_auto_raise;
-
+ int message_p = push_message ();
+
/* Ordinarily don't quit within this function,
but don't make it impossible to quit (in case we get hung in I/O). */
oquit = Vquit_flag;
/* Arrange to close that file whether or not we get an error.
Also reset auto_saving to 0. */
lispstream = Fcons (Qnil, Qnil);
- XSETFASTINT (XCONS (lispstream)->car, (EMACS_UINT)stream >> 16);
- XSETFASTINT (XCONS (lispstream)->cdr, (EMACS_UINT)stream & 0xffff);
+ XSETFASTINT (XCAR (lispstream), (EMACS_UINT)stream >> 16);
+ XSETFASTINT (XCDR (lispstream), (EMACS_UINT)stream & 0xffff);
}
else
lispstream = Qnil;
autosave perfectly ordinary files because it couldn't handle some
ange-ftp'd file. */
for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
- for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
+ for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail))
{
- buf = XCONS (XCONS (tail)->car)->cdr;
+ buf = XCDR (XCAR (tail));
b = XBUFFER (buf);
/* Record all the buffers that have auto save mode
if (!NILP (b->filename))
{
fwrite (XSTRING (b->filename)->data, 1,
- XSTRING (b->filename)->size, stream);
+ STRING_BYTES (XSTRING (b->filename)), stream);
}
putc ('\n', stream);
fwrite (XSTRING (b->auto_save_file_name)->data, 1,
- XSTRING (b->auto_save_file_name)->size, stream);
+ STRING_BYTES (XSTRING (b->auto_save_file_name)), stream);
putc ('\n', stream);
}
{
/* It has shrunk too much; turn off auto-saving here. */
minibuffer_auto_raise = orig_minibuffer_auto_raise;
- message ("Buffer %s has shrunk a lot; auto save turned off there",
- XSTRING (b->name)->data);
+ message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
+ b->name, 1);
minibuffer_auto_raise = 0;
/* Turn off auto-saving until there's a real save,
and prevent any more warnings. */
if (auto_saved && NILP (no_message))
{
- if (omessage)
+ if (message_p)
{
sit_for (1, 0, 0, 0, 0);
- message2 (omessage, omessage_length);
+ restore_message ();
}
else
message1 ("Auto-saving...done");
Vquit_flag = oquit;
+ pop_message ();
unbind_to (count, Qnil);
return Qnil;
}
register int n;
int osize, count;
- osize = XSTRING (val)->size;
- /* Quote "$" as "$$" to get it past substitute-in-file-name */
+ osize = STRING_BYTES (XSTRING (val));
+
+ /* Count the number of $ characters. */
for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--)
if (*old++ == '$') count++;
if (count > 0)
{
old = XSTRING (val)->data;
- val = Fmake_string (make_number (osize + count), make_number (0));
+ val = make_uninit_multibyte_string (XSTRING (val)->size + count,
+ osize + count);
new = XSTRING (val)->data;
for (n = osize; n > 0; n--)
if (*old != '$')
(prompt, dir, default_filename, mustmatch, initial)
Lisp_Object prompt, dir, default_filename, mustmatch, initial;
{
- Lisp_Object val, insdef, insdef1, tem;
+ Lisp_Object val, insdef, tem;
struct gcpro gcpro1, gcpro2;
register char *homedir;
+ int replace_in_history = 0;
+ int add_to_history = 0;
int count;
if (NILP (dir))
&& IS_DIRECTORY_SEP (XSTRING (dir)->data[strlen (homedir)]))
{
dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
- XSTRING (dir)->size - strlen (homedir) + 1);
+ STRING_BYTES (XSTRING (dir)) - strlen (homedir) + 1);
XSTRING (dir)->data[0] = '~';
}
+ /* Likewise for default_filename. */
+ if (homedir != 0
+ && STRINGP (default_filename)
+ && !strncmp (homedir, XSTRING (default_filename)->data, strlen (homedir))
+ && IS_DIRECTORY_SEP (XSTRING (default_filename)->data[strlen (homedir)]))
+ {
+ default_filename
+ = make_string (XSTRING (default_filename)->data + strlen (homedir) - 1,
+ STRING_BYTES (XSTRING (default_filename)) - strlen (homedir) + 1);
+ XSTRING (default_filename)->data[0] = '~';
+ }
+ if (!NILP (default_filename))
+ {
+ CHECK_STRING (default_filename, 3);
+ default_filename = double_dollars (default_filename);
+ }
if (insert_default_directory && STRINGP (dir))
{
args[1] = initial;
insdef = Fconcat (2, args);
pos = make_number (XSTRING (double_dollars (dir))->size);
- insdef1 = Fcons (double_dollars (insdef), pos);
+ insdef = Fcons (double_dollars (insdef), pos);
}
else
- insdef1 = double_dollars (insdef);
+ insdef = double_dollars (insdef);
}
else if (STRINGP (initial))
- {
- insdef = initial;
- insdef1 = Fcons (double_dollars (insdef), make_number (0));
- }
+ insdef = Fcons (double_dollars (initial), make_number (0));
else
- insdef = Qnil, insdef1 = Qnil;
+ insdef = Qnil;
-#ifdef VMS
count = specpdl_ptr - specpdl;
+#ifdef VMS
specbind (intern ("completion-ignore-case"), Qt);
#endif
+ specbind (intern ("minibuffer-completing-file-name"), Qt);
+
GCPRO2 (insdef, default_filename);
- val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
- dir, mustmatch, insdef1,
- Qfile_name_history, default_filename, Qnil);
- /* If Fcompleting_read returned the default string itself
+
+#ifdef USE_MOTIF
+ if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+ && use_dialog_box
+ && have_menus_p ())
+ {
+ val = Fx_file_dialog (prompt, dir, default_filename, mustmatch);
+ add_to_history = 1;
+ }
+ else
+#endif
+ val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
+ dir, mustmatch, insdef,
+ Qfile_name_history, default_filename, Qnil);
+
+ tem = Fsymbol_value (Qfile_name_history);
+ if (CONSP (tem) && EQ (XCAR (tem), val))
+ replace_in_history = 1;
+
+ /* If Fcompleting_read returned the inserted default string itself
(rather than a new string with the same contents),
it has to mean that the user typed RET with the minibuffer empty.
In that case, we really want to return ""
so that commands such as set-visited-file-name can distinguish. */
if (EQ (val, default_filename))
- val = build_string ("");
+ {
+ /* In this case, Fcompleting_read has not added an element
+ to the history. Maybe we should. */
+ if (! replace_in_history)
+ add_to_history = 1;
-#ifdef VMS
- unbind_to (count, Qnil);
-#endif
+ val = build_string ("");
+ }
+ unbind_to (count, Qnil);
UNGCPRO;
if (NILP (val))
error ("No file name specified");
- tem = Fstring_equal (val, insdef);
+
+ tem = Fstring_equal (val, CONSP (insdef) ? XCAR (insdef) : insdef);
+
if (!NILP (tem) && !NILP (default_filename))
- return default_filename;
- if (XSTRING (val)->size == 0 && NILP (insdef))
+ val = default_filename;
+ else if (XSTRING (val)->size == 0 && NILP (insdef))
{
if (!NILP (default_filename))
- return default_filename;
+ val = default_filename;
else
error ("No default file name");
}
- return Fsubstitute_in_file_name (val);
-}
-
-#if 0 /* Old version */
-DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
- /* Don't confuse make-docfile by having two doc strings for this function.
- make-docfile does not pay attention to #if, for good reason! */
- 0)
- (prompt, dir, defalt, mustmatch, initial)
- Lisp_Object prompt, dir, defalt, mustmatch, initial;
-{
- Lisp_Object val, insdef, tem;
- struct gcpro gcpro1, gcpro2;
- register char *homedir;
- int count;
+ val = Fsubstitute_in_file_name (val);
- if (NILP (dir))
- dir = current_buffer->directory;
- if (NILP (defalt))
- defalt = current_buffer->filename;
-
- /* If dir starts with user's homedir, change that to ~. */
- homedir = (char *) egetenv ("HOME");
- if (homedir != 0
- && STRINGP (dir)
- && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
- && XSTRING (dir)->data[strlen (homedir)] == '/')
+ if (replace_in_history)
+ /* Replace what Fcompleting_read added to the history
+ with what we will actually return. */
+ XCAR (Fsymbol_value (Qfile_name_history)) = double_dollars (val);
+ else if (add_to_history)
{
- dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
- XSTRING (dir)->size - strlen (homedir) + 1);
- XSTRING (dir)->data[0] = '~';
+ /* Add the value to the history--but not if it matches
+ the last value already there. */
+ Lisp_Object val1 = double_dollars (val);
+ tem = Fsymbol_value (Qfile_name_history);
+ if (! CONSP (tem) || NILP (Fequal (XCAR (tem), val1)))
+ Fset (Qfile_name_history,
+ Fcons (val1, tem));
}
+
+ return val;
+}
- if (!NILP (initial))
- insdef = initial;
- else if (insert_default_directory)
- insdef = dir;
- else
- insdef = build_string ("");
-
-#ifdef VMS
- count = specpdl_ptr - specpdl;
- specbind (intern ("completion-ignore-case"), Qt);
-#endif
-
- GCPRO2 (insdef, defalt);
- val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
- dir, mustmatch,
- insert_default_directory ? insdef : Qnil,
- Qfile_name_history, Qnil, Qnil);
-
-#ifdef VMS
- unbind_to (count, Qnil);
-#endif
-
- UNGCPRO;
- if (NILP (val))
- error ("No file name specified");
- tem = Fstring_equal (val, insdef);
- if (!NILP (tem) && !NILP (defalt))
- return defalt;
- return Fsubstitute_in_file_name (val);
+\f
+void
+init_fileio_once ()
+{
+ /* Must be set before any path manipulation is performed. */
+ XSETFASTINT (Vdirectory_sep_char, '/');
}
-#endif /* Old version */
+
\f
+void
syms_of_fileio ()
{
Qexpand_file_name = intern ("expand-file-name");
staticpro (&Qfile_already_exists);
Qfile_date_error = intern ("file-date-error");
staticpro (&Qfile_date_error);
+ Qexcl = intern ("excl");
+ staticpro (&Qexcl);
#ifdef DOS_NT
Qfind_buffer_file_type = intern ("find-buffer-file-type");
#endif /* DOS_NT */
DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system,
- "*Coding system for encoding file names.");
+ "*Coding system for encoding file names.\n\
+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,
+ "Default coding system for encoding file names.\n\
+This variable is used only when file-name-coding-system is nil.\n\
+\n\
+This variable is set/changed by the command set-language-environment.\n\
+User should not set this variable manually,\n\
+instead use file-name-coding-system to get a constant encoding\n\
+of file names regardless of the current language environment.");
+ Vdefault_file_name_coding_system = Qnil;
+
DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format,
"*Format in which to write auto-save files.\n\
Should be a list of symbols naming formats that are defined in `format-alist'.\n\
This variable affects the built-in functions only on Windows,\n\
on other platforms, it is initialized so that Lisp code can find out\n\
what the normal separator is.");
- XSETFASTINT (Vdirectory_sep_char, '/');
DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
"*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
DEFVAR_LISP ("set-auto-coding-function",
&Vset_auto_coding_function,
"If non-nil, a function to call to decide a coding system of file.\n\
-One argument is passed to this function: the string of concatination\n\
-or the heading 1K-byte and the tailing 3K-byte of a file to be read.\n\
-This function should return a coding system to decode the file contents\n\
+Two arguments are passed to this function: the file name\n\
+and the length of a file contents following the point.\n\
+This function should return a coding system to decode the file contents.\n\
+It should check the file name against `auto-coding-alist'.\n\
+If no coding system is decided, it should check a coding system\n\
specified in the heading lines with the format:\n\
-*- ... coding: CODING-SYSTEM; ... -*-\n\
or local variable spec of the tailing lines with `coding:' tag.");
HCoop / bpt / emacs.git / blobdiff