#include <config.h>
+#if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
+#include <fcntl.h>
+#endif
+
#include <sys/types.h>
#include <sys/stat.h>
# 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
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
+#include "charset.h"
+#include "coding.h"
#include "window.h"
#ifdef WINDOWSNT
expanding file names. This can be bound to / or \. */
Lisp_Object Vdirectory_sep_char;
+extern Lisp_Object Vuser_login_name;
+
+extern int minibuf_level;
+
/* These variables describe handlers that have "already" had a chance
to handle the current operation.
static Lisp_Object Vinhibit_file_name_handlers;
static Lisp_Object Vinhibit_file_name_operation;
-Lisp_Object Qfile_error, Qfile_already_exists;
+Lisp_Object Qfile_error, Qfile_already_exists, Qfile_date_error;
Lisp_Object Qfile_name_history;
}
#endif /* DOS_NT */
- /* Handle // and /~ in middle of file name
- by discarding everything through the first / of that sequence. */
- p = nm;
- while (*p)
- {
- /* Since we are expecting the name to be absolute, we can assume
- that each element starts with a "/". */
-
- if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])
-#if defined (APOLLO) || defined (WINDOWSNT)
- /* // at start of filename is meaningful on Apollo
- and WindowsNT systems */
- && nm != p
-#endif /* APOLLO || WINDOWSNT */
- )
- nm = p + 1;
-
- if (IS_DIRECTORY_SEP (p[0]) && p[1] == '~')
- nm = p + 1;
-
- p++;
- }
-
#ifdef WINDOWSNT
/* Discard any previous drive specifier if nm is now in UNC format. */
if (IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
/* Get rid of any slash at the end of newdir, unless newdir is
just // (an incomplete UNC name). */
length = strlen (newdir);
- if (IS_DIRECTORY_SEP (newdir[length - 1])
+ if (length > 0 && IS_DIRECTORY_SEP (newdir[length - 1])
#ifdef WINDOWSNT
&& !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
#endif
{
while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
;
- if (o == target && IS_ANY_SEP (*o))
+ /* Keep initial / only if this is the whole name. */
+ if (o == target && IS_ANY_SEP (*o) && p[3] == 0)
++o;
p += 3;
}
|| IS_DIRECTORY_SEP (p[0])
#endif /* not (APOLLO || WINDOWSNT) */
)
- && p != nm && IS_DIRECTORY_SEP (p[-1]))
+ && p != xnm && IS_DIRECTORY_SEP (p[-1]))
xnm = p;
#ifdef DOS_NT
else if (IS_DRIVE (p[0]) && p[1] == ':'
EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
if (set_file_times (XSTRING (newname)->data, atime, mtime))
- report_file_error ("I/O error", Fcons (newname, Qnil));
+ Fsignal (Qfile_date_error,
+ Fcons (build_string ("Cannot set file date"),
+ Fcons (newname, Qnil)));
}
#ifndef MSDOS
chmod (XSTRING (newname)->data, st.st_mode & 07777);
Lisp_Object absname;
Lisp_Object handler;
int desc;
+ int flags;
+ struct stat statbuf;
CHECK_STRING (filename, 0);
absname = Fexpand_file_name (filename, Qnil);
return Qt;
return Qnil;
#else /* not DOS_NT */
- desc = open (XSTRING (absname)->data, O_RDONLY);
+ flags = O_RDONLY;
+#if defined (S_ISFIFO) && defined (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 (XSTRING (absname)->data, &statbuf);
+ if (desc < 0)
+ return Qnil;
+ if (S_ISFIFO (statbuf.st_mode))
+ flags |= O_NONBLOCK;
+#endif
+ desc = open (XSTRING (absname)->data, flags);
if (desc < 0)
return Qnil;
close (desc);
Lisp_Object Qfind_buffer_file_type;
#endif /* DOS_NT */
+#ifndef READ_BUF_SIZE
+#define READ_BUF_SIZE (64 << 10)
+#endif
+
DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
1, 5, 0,
"Insert contents of file FILENAME after point.\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\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\
If VISIT is non-nil, BEG and END must be nil.\n\
+\n\
If optional fifth argument REPLACE is non-nil,\n\
it means replace the current buffer contents (in the accessible portion)\n\
with the file contents. This is better than simply deleting and inserting\n\
the whole thing because (1) it preserves some marker positions\n\
-and (2) it puts less data in the undo list.")
+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\
+This does code conversion according to the value of\n\
+ `coding-system-for-read' or `coding-system-alist', and sets the variable\n\
+ `last-coding-system-used' to the coding system actually used.")
(filename, visit, beg, end, replace)
Lisp_Object filename, visit, beg, end, replace;
{
register int fd;
register int inserted = 0;
register int how_much;
+ register int unprocessed;
int count = specpdl_ptr - specpdl;
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object handler, val, insval;
Lisp_Object p;
int total;
int not_regular = 0;
+ char read_buf[READ_BUF_SIZE];
+ struct coding_system coding;
+ unsigned char buffer[1 << 14];
+ int replace_handled = 0;
if (current_buffer->base_buffer && ! NILP (visit))
error ("Cannot do file visiting in an indirect buffer");
goto handled;
}
+ /* Decide the coding-system of the file. */
+ {
+ Lisp_Object val = Vcoding_system_for_read;
+ if (NILP (current_buffer->enable_multibyte_characters))
+ val = Qnil;
+ else if (NILP (val))
+ {
+ Lisp_Object args[6], coding_systems;
+
+ args[0] = Qinsert_file_contents, args[1] = filename, args[2] = visit,
+ args[3] = beg, args[4] = end, args[5] = replace;
+ coding_systems = Ffind_coding_system (6, args);
+ val = CONSP (coding_systems) ? XCONS (coding_systems)->car : Qnil;
+ }
+ setup_coding_system (Fcheck_coding_system (val), &coding);
+ }
+
fd = -1;
#ifndef APOLLO
least signal an error. */
if (!S_ISREG (st.st_mode))
{
- if (NILP (visit))
+ not_regular = 1;
+
+ if (! NILP (visit))
+ goto notfound;
+
+ if (! NILP (replace) || ! NILP (beg) || ! NILP (end))
Fsignal (Qfile_error,
Fcons (build_string ("not a regular file"),
Fcons (filename, Qnil)));
-
- not_regular = 1;
- goto notfound;
}
#endif
record_unwind_protect (close_file_unwind, make_number (fd));
/* Supposedly happens on VMS. */
- if (st.st_size < 0)
+ if (! not_regular && st.st_size < 0)
error ("File size is negative");
if (!NILP (beg) || !NILP (end))
CHECK_NUMBER (end, 0);
else
{
- XSETINT (end, st.st_size);
- if (XINT (end) != st.st_size)
- error ("maximum buffer size exceeded");
+ if (! not_regular)
+ {
+ XSETINT (end, st.st_size);
+ if (XINT (end) != st.st_size)
+ error ("Maximum buffer size exceeded");
+ }
}
/* If requested, replace the accessible part of the buffer
with the file contents. Avoid replacing text at the
beginning or end of the buffer that matches the file contents;
- that preserves markers pointing to the unchanged parts. */
-#ifdef DOS_NT
- /* On MSDOS, replace mode doesn't really work, except for binary files,
- and it's not worth supporting just for them. */
- if (!NILP (replace))
- {
- replace = Qnil;
- XSETFASTINT (beg, 0);
- XSETFASTINT (end, st.st_size);
- del_range_1 (BEGV, ZV, 0);
- }
-#else /* not DOS_NT */
- if (!NILP (replace))
+ that preserves markers pointing to the unchanged parts.
+
+ Here we implement this feature in an optimized way
+ for the case where code conversion is NOT needed.
+ The following if-statement handles the case of conversion
+ in a less optimal way.
+
+ If the code conversion is "automatic" then we try using this
+ method and hope for the best.
+ 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_CONVERSION (&coding)
+ || (coding.type == coding_type_automatic
+ && ! CODING_REQUIRE_EOL_CONVERSION (&coding))
+ || (coding.eol_type == CODING_EOL_AUTOMATIC
+ && ! CODING_REQUIRE_TEXT_CONVERSION (&coding))))
{
- unsigned char buffer[1 << 14];
int same_at_start = BEGV;
int same_at_end = ZV;
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
+ give up on handling REPLACE in the optimized way. */
+ int giveup_match_end = 0;
+
+ if (XINT (beg) != 0)
+ {
+ if (lseek (fd, XINT (beg), 0) < 0)
+ report_file_error ("Setting file position",
+ Fcons (filename, Qnil));
+ }
immediate_quit = 1;
QUIT;
XSTRING (filename)->data, strerror (errno));
else if (nread == 0)
break;
+
+ if (coding.type == coding_type_automatic)
+ detect_coding (&coding, buffer, nread);
+ if (CODING_REQUIRE_TEXT_CONVERSION (&coding))
+ /* We found that the file should be decoded somehow.
+ Let's give up here. */
+ {
+ giveup_match_end = 1;
+ break;
+ }
+
+ if (coding.eol_type == CODING_EOL_AUTOMATIC)
+ detect_eol (&coding, buffer, nread);
+ if (CODING_REQUIRE_EOL_CONVERSION (&coding))
+ /* We found that the format of eol should be decoded.
+ Let's give up here. */
+ {
+ giveup_match_end = 1;
+ break;
+ }
+
bufpos = 0;
while (bufpos < nread && same_at_start < ZV
- && FETCH_CHAR (same_at_start) == buffer[bufpos])
+ && FETCH_BYTE (same_at_start) == buffer[bufpos])
same_at_start++, bufpos++;
/* If we found a discrepancy, stop the scan.
Otherwise loop around and scan the next bufferful. */
immediate_quit = 0;
/* If the file matches the buffer completely,
there's no need to replace anything. */
- if (same_at_start - BEGV == st.st_size)
+ if (same_at_start - BEGV == XINT (end))
{
close (fd);
specpdl_ptr--;
immediate_quit = 1;
QUIT;
/* Count how many chars at the end of the file
- match the text at the end of the buffer. */
- while (1)
+ match the text at the end of the buffer. But, if we have
+ already found that decoding is necessary, don't waste time. */
+ while (!giveup_match_end)
{
int total_read, nread, bufpos, curpos, trial;
/* At what file position are we now scanning? */
- curpos = st.st_size - (ZV - same_at_end);
+ curpos = XINT (end) - (ZV - same_at_end);
/* If the entire file matches the buffer tail, stop the scan. */
if (curpos == 0)
break;
/* Compare with same_at_start to avoid counting some buffer text
as matching both at the file's beginning and at the end. */
while (bufpos > 0 && same_at_end > same_at_start
- && FETCH_CHAR (same_at_end - 1) == buffer[bufpos - 1])
+ && FETCH_BYTE (same_at_end - 1) == buffer[bufpos - 1])
same_at_end--, bufpos--;
+
/* If we found a discrepancy, stop the scan.
Otherwise loop around and scan the preceding bufferful. */
if (bufpos != 0)
- break;
- /* If display current starts at beginning of line,
+ {
+ /* If this discrepancy is because of code conversion,
+ 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))
+ giveup_match_end = 1;
+ break;
+ }
+ }
+ immediate_quit = 0;
+
+ if (! giveup_match_end)
+ {
+ /* We win! We can handle REPLACE the optimized way. */
+
+ /* Don't try to reuse the same piece of text twice. */
+ overlap = same_at_start - BEGV - (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));
+
+ del_range_1 (same_at_start, same_at_end, 0);
+ /* Insert from the file at the proper position. */
+ SET_PT (same_at_start);
+
+ /* 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 ();
+
+ replace_handled = 1;
}
- immediate_quit = 0;
+ }
+
+ /* If requested, replace the accessible part of the buffer
+ with the file contents. Avoid replacing text at the
+ beginning or end of the buffer that matches the file contents;
+ that preserves markers pointing to the unchanged parts.
+
+ Here we implement this feature for the case where code conversion
+ 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)
+ {
+ int same_at_start = BEGV;
+ int same_at_end = ZV;
+ 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);
+
+ /* First read the whole file, performing code conversion into
+ CONVERSION_BUFFER. */
+
+ if (lseek (fd, XINT (beg), 0) < 0)
+ {
+ free (conversion_buffer);
+ report_file_error ("Setting file position",
+ Fcons (filename, Qnil));
+ }
+
+ total = st.st_size; /* Total bytes in the file. */
+ how_much = 0; /* Bytes read from file so far. */
+ inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */
+ unprocessed = 0; /* Bytes not processed in previous loop. */
+
+ while (how_much < total)
+ {
+ /* try is reserved in some compilers (Microsoft C) */
+ int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed);
+ char *destination = read_buf + unprocessed;
+ int this;
+
+ /* Allow quitting out of the actual I/O. */
+ immediate_quit = 1;
+ QUIT;
+ this = read (fd, destination, trytry);
+ immediate_quit = 0;
+
+ if (this < 0 || this + unprocessed == 0)
+ {
+ how_much = this;
+ break;
+ }
+
+ how_much += this;
+
+ if (CODING_REQUIRE_CONVERSION (&coding))
+ {
+ int require, produced, consumed;
+
+ this += unprocessed;
+
+ /* If we are using more space than estimated,
+ make CONVERSION_BUFFER bigger. */
+ require = decoding_buffer_size (&coding, this);
+ if (inserted + require + 2 * (total - how_much) > bufsize)
+ {
+ bufsize = inserted + require + 2 * (total - how_much);
+ conversion_buffer = (unsigned char *) xrealloc (conversion_buffer, bufsize);
+ }
+
+ /* 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);
+
+ /* Save for next iteration whatever we didn't convert. */
+ unprocessed = this - consumed;
+ bcopy (read_buf + consumed, read_buf, unprocessed);
+ this = produced;
+ }
+
+ inserted += this;
+ }
+
+ /* At this point, INSERTED is how many characters
+ 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);
+
+ if (how_much == -1)
+ error ("IO error reading %s: %s",
+ XSTRING (filename)->data, strerror (errno));
+ else if (how_much == -2)
+ error ("maximum buffer size exceeded");
+ }
+
+ /* Compare the beginning of the converted file
+ with the buffer text. */
+
+ bufpos = 0;
+ while (bufpos < inserted && same_at_start < same_at_end
+ && FETCH_BYTE (same_at_start) == conversion_buffer[bufpos])
+ same_at_start++, bufpos++;
+
+ /* If the file matches the buffer completely,
+ there's no need to replace anything. */
+
+ if (bufpos == inserted)
+ {
+ free (conversion_buffer);
+ close (fd);
+ specpdl_ptr--;
+ /* Truncate the buffer to the size of the file. */
+ del_range_1 (same_at_start, same_at_end, 0);
+ goto handled;
+ }
+
+ /* Scan this bufferful from the end, comparing with
+ the Emacs buffer. */
+ bufpos = inserted;
+
+ /* Compare with same_at_start to avoid counting some buffer text
+ as matching both at the file's beginning and at the end. */
+ while (bufpos > 0 && same_at_end > same_at_start
+ && FETCH_BYTE (same_at_end - 1) == conversion_buffer[bufpos - 1])
+ same_at_end--, bufpos--;
/* 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 - (same_at_end + inserted - ZV);
if (overlap > 0)
same_at_end += overlap;
- /* Arrange to read only the nonmatching middle part of the file. */
- XSETFASTINT (beg, same_at_start - BEGV);
- XSETFASTINT (end, st.st_size - (ZV - 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 ();
+ /* 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);
- /* Insert from the file at the proper position. */
SET_PT (same_at_start);
+ insert_1 (conversion_buffer + same_at_start - BEG, inserted, 0, 0);
+
+ free (conversion_buffer);
+ close (fd);
+ specpdl_ptr--;
+
+ goto handled;
}
-#endif /* not DOS_NT */
- total = XINT (end) - XINT (beg);
+ if (! not_regular)
+ {
+ register Lisp_Object temp;
- {
- 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");
- }
+ /* Make sure point-max won't overflow after this insertion. */
+ XSETINT (temp, total);
+ if (total != XINT (temp))
+ error ("Maximum buffer size exceeded");
+ }
+ else
+ /* For a special file, all we can do is guess. */
+ total = READ_BUF_SIZE;
if (NILP (visit) && total > 0)
prepare_to_modify_buffer (PT, PT);
report_file_error ("Setting file position", Fcons (filename, Qnil));
}
+ /* 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. */
how_much = 0;
- while (inserted < total)
+ /* Total bytes inserted. */
+ inserted = 0;
+ /* Bytes not processed in the previous loop because short gap size. */
+ unprocessed = 0;
+ while (how_much < total)
{
/* try is reserved in some compilers (Microsoft C) */
- int trytry = min (total - inserted, 64 << 10);
+ int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed);
+ char *destination = (CODING_REQUIRE_CONVERSION (&coding)
+ ? read_buf + unprocessed
+ : (char *) (POS_ADDR (PT + inserted - 1) + 1));
int this;
/* Allow quitting out of the actual I/O. */
immediate_quit = 1;
QUIT;
- this = read (fd, &FETCH_CHAR (PT + inserted - 1) + 1, trytry);
+ this = read (fd, destination, trytry);
immediate_quit = 0;
- if (this <= 0)
+ if (this < 0 || this + unprocessed == 0)
{
how_much = this;
break;
}
+ /* For a regular file, where TOTAL is the real size,
+ count HOW_MUCH to compare with it.
+ For a special file, where TOTAL is just a buffer size,
+ so don't bother counting in HOW_MUCH.
+ (INSERTED is where we count the number of characters inserted.) */
+ if (! not_regular)
+ how_much += this;
+
+ if (CODING_REQUIRE_CONVERSION (&coding))
+ {
+ int require, produced, consumed;
+
+ 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);
+
+ if (! not_regular)
+ {
+ if (how_much >= total) /* This is the last block. */
+ coding.last_block = 1;
+ }
+ else
+ {
+ /* 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;
+ }
+
+ produced = decode_coding (&coding, read_buf,
+ POS_ADDR (PT + inserted - 1) + 1,
+ this, GAP_SIZE, &consumed);
+ if (produced > 0)
+ {
+ Lisp_Object temp;
+
+ XSET (temp, Lisp_Int, Z + produced);
+ if (Z + produced != XINT (temp))
+ {
+ how_much = -2;
+ break;
+ }
+ }
+ unprocessed = this - consumed;
+ bcopy (read_buf + consumed, read_buf, unprocessed);
+ this = produced;
+ }
+
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;
}
+ /* 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
if (NILP (current_buffer->buffer_file_type))
{
int reduced_size
- = inserted - crlf_to_lf (inserted, &FETCH_CHAR (PT - 1) + 1);
+ = inserted - crlf_to_lf (inserted, POS_ADDR (PT - 1) + 1);
ZV -= reduced_size;
Z -= reduced_size;
GPT -= reduced_size;
}
}
#endif /* DOS_NT */
+#endif /* 0 */
if (inserted > 0)
{
/* Discard the unwind protect for closing the file. */
specpdl_ptr--;
- if (how_much < 0)
+ if (how_much == -1)
error ("IO error reading %s: %s",
XSTRING (filename)->data, strerror (errno));
+ else if (how_much == -2)
+ error ("maximum buffer size exceeded");
notfound:
handled:
inserted = XFASTINT (insval);
}
- if (inserted > 0 && NILP (visit) && total > 0)
+ /* 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);
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));
static Lisp_Object build_annotations ();
/* If build_annotations switched buffers, switch back to BUF.
- Kill the temporary buffer that was selected in the meantime. */
+ Kill the temporary buffer that was selected in the meantime.
+
+ Since this kill only the last temporary buffer, some buffers remain
+ not killed if build_annotations switched buffers more than once.
+ -- K.Handa */
static Lisp_Object
build_annotations_unwind (buf)
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\nZCoding system: ",
"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 CODING-SYSTEM, if non-nil, specifies the coding\n\
+ system to be used for encoding characters. For interactive use,\n\
+ you can specify it by giving a prefix argument. If no coding system\n\
+ is specified, the current region is encoded according to the value of\n\
+ `coding-system-for-write' or `coding-system-alist'. The variable\n\
+ `last-coding-system-used' is set the coding system actually used.\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)
+ (start, end, filename, append, visit, lockname, coding_system_symbol)
Lisp_Object start, end, filename, append, visit, lockname;
+ Lisp_Object coding_system_symbol;
{
register int desc;
int failure;
int buffer_file_type
= NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY;
#endif /* DOS_NT */
+ struct coding_system coding;
if (current_buffer->base_buffer && ! NILP (visit))
error ("Cannot do file visiting in an indirect buffer");
if (!NILP (start) && !STRINGP (start))
validate_region (&start, &end);
- GCPRO3 (filename, visit, lockname);
+ GCPRO5 (start, filename, visit, lockname, coding_system_symbol);
+
+ /* Decide the coding-system to be encoded to. */
+ {
+ Lisp_Object val;
+
+ if (auto_saving || NILP (current_buffer->enable_multibyte_characters))
+ val = Qnil;
+ else if (!NILP (coding_system_symbol))
+ val = coding_system_symbol;
+ else if (!NILP (Vcoding_system_for_write))
+ val = Vcoding_system_for_write;
+ else if (!NILP (Flocal_variable_if_set_p (Qbuffer_file_coding_system,
+ Qnil)))
+ val = Fsymbol_value (Qbuffer_file_coding_system);
+ 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_coding_system (7, args);
+ val = (CONSP (coding_systems)
+ ? XCONS (coding_systems)->cdr
+ : Fsymbol_value (Qbuffer_file_coding_system));
+ }
+ setup_coding_system (Fcheck_coding_system (val), &coding);
+ if (!STRINGP (start) && !NILP (current_buffer->selective_display))
+ coding.selective = 1;
+#ifdef DOS_NT
+ if (!NILP (current_buffer->buffer_file_type))
+ coding.eol_type = CODING_EOL_LF;
+#endif /* DOS_NT */
+ }
+
filename = Fexpand_file_name (filename, Qnil);
if (STRINGP (visit))
visit_file = Fexpand_file_name (visit, Qnil);
count1 = specpdl_ptr - specpdl;
given_buffer = current_buffer;
- annotations = build_annotations (start, end);
+ annotations = build_annotations (start, end, coding.pre_write_conversion);
if (current_buffer != given_buffer)
{
start = BEGV;
#ifdef CLASH_DETECTION
if (!auto_saving)
- lock_file (lockname);
+ {
+ /* If we've locked this file for some other buffer,
+ query before proceeding. */
+ if (!visiting && EQ (Ffile_locked_p (lockname), Qt))
+ call2 (intern ("ask-user-about-lock"), fn, Vuser_login_name);
+
+ lock_file (lockname);
+ }
#endif /* CLASH_DETECTION */
fn = XSTRING (filename)->data;
desc = open (fn, O_WRONLY);
#endif /* not DOS_NT */
- if (desc < 0)
+ if (desc < 0 && (NILP (append) || errno == ENOENT) )
#ifdef VMS
if (auto_saving) /* Overwrite any previous version of autosave file */
{
*/
if (GPT > BEG && GPT_ADDR[-1] != '\n')
move_gap (find_next_newline (GPT, 1));
+#else
+ /* Whether VMS or not, we must move the gap to the next of newline
+ when we must put designation sequences at beginning of line. */
+ if (INTEGERP (start)
+ && 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));
#endif
failure = 0;
if (STRINGP (start))
{
failure = 0 > a_write (desc, XSTRING (start)->data,
- XSTRING (start)->size, 0, &annotations);
+ XSTRING (start)->size, 0, &annotations, &coding);
save_errno = errno;
}
else if (XINT (start) != XINT (end))
{
register int end1 = XINT (end);
tem = XINT (start);
- failure = 0 > a_write (desc, &FETCH_CHAR (tem),
- min (GPT, end1) - tem, tem, &annotations);
+ failure = 0 > a_write (desc, POS_ADDR (tem),
+ min (GPT, end1) - tem, tem, &annotations,
+ &coding);
nwritten += min (GPT, end1) - tem;
save_errno = errno;
}
{
tem = XINT (start);
tem = max (tem, GPT);
- failure = 0 > a_write (desc, &FETCH_CHAR (tem), XINT (end) - tem,
- tem, &annotations);
+ failure = 0 > a_write (desc, POS_ADDR (tem), XINT (end) - tem,
+ tem, &annotations, &coding);
nwritten += XINT (end) - tem;
save_errno = errno;
}
else
{
/* If file was empty, still need to write the annotations */
- failure = 0 > a_write (desc, "", 0, XINT (start), &annotations);
+ coding.last_block = 1;
+ failure = 0 > a_write (desc, "", 0, XINT (start), &annotations, &coding);
+ save_errno = errno;
+ }
+
+ if (coding.require_flushing)
+ {
+ /* We have to flush out a data. */
+ coding.last_block = 1;
+ failure = 0 > e_write (desc, "", 0, &coding);
save_errno = errno;
}
as save-excursion would do. */
static Lisp_Object
-build_annotations (start, end)
- Lisp_Object start, end;
+build_annotations (start, end, pre_write_conversion)
+ Lisp_Object start, end, pre_write_conversion;
{
Lisp_Object annotations;
Lisp_Object p, res;
annotations = merge (annotations, res, Qcar_less_than_car);
p = Fcdr (p);
}
+
+ /* At last, do the same for the function PRE_WRITE_CONVERSION
+ implied by the current coding-system. */
+ if (!NILP (pre_write_conversion))
+ {
+ struct buffer *given_buffer = current_buffer;
+ Vwrite_region_annotations_so_far = annotations;
+ res = call2 (pre_write_conversion, start, end);
+ Flength (res);
+ annotations = (current_buffer != given_buffer
+ ? res
+ : merge (annotations, res, Qcar_less_than_car));
+ }
+
UNGCPRO;
return annotations;
}
The return value is negative in case of system call failure. */
int
-a_write (desc, addr, len, pos, annot)
+a_write (desc, addr, len, pos, annot, coding)
int desc;
register char *addr;
register int len;
int pos;
Lisp_Object *annot;
+ struct coding_system *coding;
{
Lisp_Object tem;
int nextpos;
if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos)
nextpos = XFASTINT (tem);
else
- return e_write (desc, addr, lastpos - pos);
+ return e_write (desc, addr, lastpos - pos, coding);
if (nextpos > pos)
{
- if (0 > e_write (desc, addr, nextpos - pos))
+ if (0 > e_write (desc, addr, nextpos - pos, coding))
return -1;
addr += nextpos - pos;
pos = nextpos;
tem = Fcdr (Fcar (*annot));
if (STRINGP (tem))
{
- if (0 > e_write (desc, XSTRING (tem)->data, XSTRING (tem)->size))
+ if (0 > e_write (desc, XSTRING (tem)->data, XSTRING (tem)->size,
+ coding))
return -1;
}
*annot = Fcdr (*annot);
}
}
+#ifndef WRITE_BUF_SIZE
+#define WRITE_BUF_SIZE (16 * 1024)
+#endif
+
int
-e_write (desc, addr, len)
+e_write (desc, addr, len, coding)
int desc;
register char *addr;
register int len;
+ struct coding_system *coding;
{
- char buf[16 * 1024];
- register char *p, *end;
+ char buf[WRITE_BUF_SIZE];
+ int produced, consumed;
- if (!EQ (current_buffer->selective_display, Qt))
- return write (desc, addr, len) - len;
- else
+ /* We used to have a code for handling selective display here. But,
+ now it is handled within encode_coding. */
+ while (1)
{
- p = buf;
- end = p + sizeof buf;
- while (len--)
+ produced = encode_coding (coding, addr, buf, len, WRITE_BUF_SIZE,
+ &consumed);
+ len -= consumed, addr += consumed;
+ if (produced > 0)
{
- if (p == end)
- {
- if (write (desc, buf, sizeof buf) != sizeof buf)
- return -1;
- p = buf;
- }
- *p = *addr++;
- if (*p++ == '\015')
- p[-1] = '\n';
+ produced -= write (desc, buf, produced);
+ if (produced) return -1;
}
- if (p != buf)
- if (write (desc, buf, p - buf) != p - buf)
- return -1;
+ if (len <= 0)
+ break;
}
return 0;
}
return
Fwrite_region (Qnil, Qnil,
current_buffer->auto_save_file_name,
- Qnil, Qlambda, Qnil);
+ Qnil, Qlambda, Qnil, Qnil);
}
static Lisp_Object
int auto_saved = 0;
char *omessage = echo_area_glyphs;
int omessage_length = echo_area_glyphs_length;
- extern int minibuf_level;
int do_handled_files;
Lisp_Object oquit;
int listdesc;
int changed;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+ CHECK_STRING (string, 0);
+
realdir = dir;
name = string;
orig_string = Qnil;
XSTRING (dir)->data[0] = '~';
}
- if (insert_default_directory)
+ if (insert_default_directory && STRINGP (dir))
{
insdef = dir;
if (!NILP (initial))
else
insdef1 = double_dollars (insdef);
}
- else if (!NILP (initial))
+ else if (STRINGP (initial))
{
insdef = initial;
insdef1 = Fcons (double_dollars (insdef), 0);
GCPRO2 (insdef, default_filename);
val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
dir, mustmatch, insdef1,
- Qfile_name_history);
+ Qfile_name_history, default_filename);
#ifdef VMS
unbind_to (count, Qnil);
val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
dir, mustmatch,
insert_default_directory ? insdef : Qnil,
- Qfile_name_history);
+ Qfile_name_history, Qnil);
#ifdef VMS
unbind_to (count, Qnil);
staticpro (&Qfile_error);
Qfile_already_exists = intern ("file-already-exists");
staticpro (&Qfile_already_exists);
+ Qfile_date_error = intern ("file-date-error");
+ staticpro (&Qfile_date_error);
#ifdef DOS_NT
Qfind_buffer_file_type = intern ("find-buffer-file-type");
Fput (Qfile_already_exists, Qerror_message,
build_string ("File already exists"));
+ Fput (Qfile_date_error, Qerror_conditions,
+ Fcons (Qfile_date_error,
+ Fcons (Qfile_error, Fcons (Qerror, Qnil))));
+ Fput (Qfile_date_error, Qerror_message,
+ build_string ("Cannot set file date"));
+
DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
"*Non-nil means when reading a filename start with default dir in minibuffer.");
insert_default_directory = 1;