#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;
Lisp_Object Qfile_exists_p;
Lisp_Object Qfile_executable_p;
Lisp_Object Qfile_readable_p;
-Lisp_Object Qfile_symlink_p;
Lisp_Object Qfile_writable_p;
+Lisp_Object Qfile_symlink_p;
+Lisp_Object Qaccess_file;
Lisp_Object Qfile_directory_p;
Lisp_Object Qfile_regular_p;
Lisp_Object Qfile_accessible_directory_p;
}
#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]))
copyable by us. */
input_file_statable_p = (fstat (ifd, &st) >= 0);
-#ifndef MSDOS
+#if !defined (MSDOS) || __DJGPP__ > 1
if (out_st.st_mode != 0
&& st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
{
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 ("File already exists"),
+ Fcons (absname, Qnil)));
}
#ifndef MSDOS
chmod (XSTRING (newname)->data, st.st_mode & 07777);
struct stat st;
if (stat (filename, &st) < 0)
return 0;
-#ifdef WINDOWSNT
+#if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1)
return ((st.st_mode & S_IEXEC) != 0);
#else
return (S_ISREG (st.st_mode)
return 0;
return (st.st_mode & S_IWRITE || (st.st_mode & S_IFMT) == S_IFDIR);
#else /* not MSDOS */
-#ifdef HAVE_EACCESS
- return (eaccess (filename, 2) >= 0);
+#ifdef HAVE_EUIDACCESS
+ return (euidaccess (filename, 2) >= 0);
#else
/* Access isn't quite right because it uses the real uid
and we really want to test with the effective uid.
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);
? Qt : Qnil);
}
\f
+DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
+ "Access file FILENAME, and get an error if that does not work.\n\
+The second argument STRING is used in the error message.\n\
+If there is no error, we return nil.")
+ (filename, string)
+ Lisp_Object filename, string;
+{
+ Lisp_Object handler;
+ int fd;
+
+ CHECK_STRING (filename, 0);
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (filename, Qaccess_file);
+ if (!NILP (handler))
+ return call3 (handler, Qaccess_file, filename, string);
+
+ fd = open (XSTRING (filename)->data, O_RDONLY);
+ if (fd < 0)
+ report_file_error (XSTRING (string)->data, Fcons (filename, Qnil));
+ close (fd);
+
+ return Qnil;
+}
+\f
DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
"Return non-nil if file FILENAME is the name of a symbolic link.\n\
The value is the name of the file to which it is linked.\n\
if (stat (XSTRING (absname)->data, &st) < 0)
return Qnil;
-#ifdef MSDOS
+#if defined (MSDOS) && __DJGPP__ < 2
if (check_executable (XSTRING (absname)->data))
st.st_mode |= S_IEXEC;
-#endif /* MSDOS */
+#endif /* MSDOS && __DJGPP__ < 2 */
return make_number (st.st_mode & 07777);
}
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;
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
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))
+ if (!NILP (replace) && CODING_REQUIRE_CONVERSION (&coding))
{
+ /* We have to decode the input, which means replace mode is
+ quite difficult. We give it up for the moment. */
replace = Qnil;
- XSETFASTINT (beg, 0);
- XSETFASTINT (end, st.st_size);
del_range_1 (BEGV, ZV, 0);
}
-#else /* not DOS_NT */
if (!NILP (replace))
{
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 the REPLACE feature. */
+ 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. */
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));
+ 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);
}
-#endif /* not DOS_NT */
total = XINT (end) - XINT (beg);
}
if (NILP (visit) && total > 0)
- prepare_to_modify_buffer (point, point);
+ prepare_to_modify_buffer (PT, PT);
- move_gap (point);
+ move_gap (PT);
if (GAP_SIZE < total)
make_gap (total - GAP_SIZE);
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 (point + 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;
}
+ 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 (how_much >= total) /* This is the last block. */
+ 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 (point - 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)
{
- record_insert (point, inserted);
+ record_insert (PT, inserted);
/* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
- offset_intervals (current_buffer, point, inserted);
+ offset_intervals (current_buffer, PT, inserted);
MODIFF++;
}
/* 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:
}
if (inserted > 0 && NILP (visit) && total > 0)
- signal_after_change (point, 0, inserted);
+ 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)
The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
use for locking and unlocking, overriding FILENAME and VISIT.\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.")
+to the file, instead of any buffer contents, and END is ignored.\n\
+This does code conversion according to the value of\n\
+ `coding-system-for-write' or `coding-system-alist', and sets the variable\n\
+ `last-coding-system-used' to the coding system actually used.")
(start, end, filename, append, visit, lockname)
Lisp_Object start, end, filename, append, visit, lockname;
{
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");
return val;
}
+ /* 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 (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 */
+ }
+
/* Special kludge to simplify auto-saving. */
if (NILP (start))
{
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 (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);
+ 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;
struct gcpro gcpro1, gcpro2;
+ Lisp_Object original_buffer;
+
+ XSETBUFFER (original_buffer, current_buffer);
annotations = Qnil;
p = Vwrite_region_annotate_functions;
{
struct buffer *given_buffer = current_buffer;
Vwrite_region_annotations_so_far = annotations;
- res = call3 (Qformat_annotate_function, Fcar (p), start, end);
+ res = call4 (Qformat_annotate_function, Fcar (p), start, end,
+ original_buffer);
if (current_buffer != given_buffer)
{
start = BEGV;
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);
+ if (current_buffer != given_buffer)
+ {
+ start = BEGV;
+ end = ZV;
+ annotations = Qnil;
+ }
+ Flength (res);
+ annotations = 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 && len > 0)
{
- if (p == end)
- {
- if (write (desc, buf, sizeof buf) != sizeof buf)
- return -1;
- p = buf;
- }
- *p = *addr++;
- if (*p++ == '\015')
- p[-1] = '\n';
+ /* There was a carry over because of invalid codes in the source.
+ We just write out them as is. */
+ bcopy (addr, buf, len);
+ produced = len;
+ len = 0;
+ }
+ if (produced > 0)
+ {
+ 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;
}
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);
Qfile_exists_p = intern ("file-exists-p");
Qfile_executable_p = intern ("file-executable-p");
Qfile_readable_p = intern ("file-readable-p");
- Qfile_symlink_p = intern ("file-symlink-p");
Qfile_writable_p = intern ("file-writable-p");
+ Qfile_symlink_p = intern ("file-symlink-p");
+ Qaccess_file = intern ("access-file");
Qfile_directory_p = intern ("file-directory-p");
Qfile_regular_p = intern ("file-regular-p");
Qfile_accessible_directory_p = intern ("file-accessible-directory-p");
staticpro (&Qfile_exists_p);
staticpro (&Qfile_executable_p);
staticpro (&Qfile_readable_p);
- staticpro (&Qfile_symlink_p);
staticpro (&Qfile_writable_p);
+ staticpro (&Qaccess_file);
+ staticpro (&Qfile_symlink_p);
staticpro (&Qfile_directory_p);
staticpro (&Qfile_regular_p);
staticpro (&Qfile_accessible_directory_p);
staticpro (&Qinsert_file_contents);
staticpro (&Qwrite_region);
staticpro (&Qverify_visited_file_modtime);
+ staticpro (&Qset_visited_file_modtime);
Qfile_name_history = intern ("file-name-history");
Fset (Qfile_name_history, 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;
defsubr (&Sfile_executable_p);
defsubr (&Sfile_readable_p);
defsubr (&Sfile_writable_p);
+ defsubr (&Saccess_file);
defsubr (&Sfile_symlink_p);
defsubr (&Sfile_directory_p);
defsubr (&Sfile_accessible_directory_p);
HCoop / bpt / emacs.git / blobdiff