/* File IO for GNU Emacs.
- Copyright (C) 1985,86,87,88,93,94,95,96 Free Software Foundation, Inc.
+ Copyright (C) 1985,86,87,88,93,94,95,96,1997 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <config.h>
+#if defined (USG5) || defined (BSD_SYSTEM) || defined (LINUX)
+#include <fcntl.h>
+#endif
+
+#include <stdio.h>
#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
#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;
a new file with the same mode as the original */
int auto_save_mode_bits;
+/* Coding system for file names, or nil if none. */
+Lisp_Object Vfile_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;
/* Lisp functions for translating file formats */
Lisp_Object Qformat_decode, Qformat_annotate_function;
+/* Function to be called to decide a coding system of a reading file. */
+Lisp_Object Vset_auto_coding_function;
+
/* Functions to be called to process text properties in inserted file. */
Lisp_Object Vafter_insert_file_functions;
expanding file names. This can be bound to / or \. */
Lisp_Object Vdirectory_sep_char;
+extern Lisp_Object Vuser_login_name;
+
+extern int minibuf_level;
+
+extern int minibuffer_auto_raise;
+
/* 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;
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.")
+so there is no danger of generating a name being used by another process.\n\
+In addition, this function makes an attempt to choose a name\n\
+which has no existing file.")
(prefix)
Lisp_Object prefix;
{
An initial `~/' expands to your home directory.\n\
An initial `~USER/' expands to USER's home directory.\n\
See also the function `substitute-in-file-name'.")
- (name, default_directory)
+ (name, default_directory)
Lisp_Object name, default_directory;
{
unsigned char *nm;
/* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
if (NILP (default_directory))
default_directory = current_buffer->directory;
- CHECK_STRING (default_directory, 1);
+ if (! STRINGP (default_directory))
+ default_directory = build_string ("/");
if (!NILP (default_directory))
{
goto look_again;
}
}
-#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
+ /* If we see "c://somedir", we want to strip the first slash after the
+ colon when stripping the drive letter. Otherwise, this expands to
+ "//somedir". */
+ if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1]))
+ nm++;
+#endif /* WINDOWSNT */
+#endif /* DOS_NT */
#ifdef WINDOWSNT
/* Discard any previous drive specifier if nm is now in UNC format. */
}
/* Keep only a prefix from newdir if nm starts with slash
- (//server/share for UNC, nothing otherwise). */
+ (//server/share for UNC, nothing otherwise). */
if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir)
{
#ifdef WINDOWSNT
if (newdir)
{
/* Get rid of any slash at the end of newdir, unless newdir is
- just // (an incomplete UNC name). */
+ 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
else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])
#if defined (APOLLO) || defined (WINDOWSNT)
/* // at start of filename is meaningful in Apollo
- and WindowsNT systems */
+ and WindowsNT systems. */
&& o != target
#endif /* APOLLO || WINDOWSNT */
)
{
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;
}
nm = XSTRING (name)->data;
/* If nm is absolute, flush ...// and detect /./ and /../.
- If no /./ or /../ we can return right away. */
+ If no /./ or /../ we can return right away. */
if (
nm[0] == '/'
#ifdef VMS
{
if (p[0] == '/' && p[1] == '/'
#ifdef APOLLO
- /* // at start of filename is meaningful on Apollo system */
+ /* // at start of filename is meaningful on Apollo system. */
&& nm != p
#endif /* APOLLO */
)
}
else if (!strncmp (p, "//", 2)
#ifdef APOLLO
- /* // at start of filename is meaningful in Apollo system */
+ /* // at start of filename is meaningful in Apollo system. */
&& o != target
#endif /* APOLLO */
)
#endif
endp = nm + XSTRING (filename)->size;
- /* If /~ or // appears, discard everything through first slash. */
+ /* If /~ or // appears, discard everything through first slash. */
for (p = nm; p != endp; p++)
{
if ((p[0] == '~'
#if defined (APOLLO) || defined (WINDOWSNT)
/* // at start of file name is meaningful in Apollo and
- WindowsNT systems */
+ WindowsNT systems. */
|| (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
#else /* not (APOLLO || WINDOWSNT) */
|| IS_DIRECTORY_SEP (p[0])
*x = 0;
- /* If /~ or // appears, discard everything through first slash. */
+ /* If /~ or // appears, discard everything through first slash. */
for (p = xnm; p != x; p++)
if ((p[0] == '~'
|| 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] == ':'
char buf[16 * 1024];
struct stat st, out_st;
Lisp_Object handler;
- struct gcpro gcpro1, gcpro2;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
int count = specpdl_ptr - specpdl;
int input_file_statable_p;
+ Lisp_Object encoded_file, encoded_newname;
- GCPRO2 (file, newname);
+ encoded_file = encoded_newname = Qnil;
+ GCPRO4 (file, newname, encoded_file, encoded_newname);
CHECK_STRING (file, 0);
CHECK_STRING (newname, 1);
+
file = Fexpand_file_name (file, Qnil);
newname = Fexpand_file_name (newname, Qnil);
RETURN_UNGCPRO (call5 (handler, Qcopy_file, file, newname,
ok_if_already_exists, keep_date));
+ encoded_file = ENCODE_FILE (file);
+ encoded_newname = ENCODE_FILE (newname);
+
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
- barf_or_query_if_file_exists (newname, "copy to it",
+ barf_or_query_if_file_exists (encoded_newname, "copy to it",
INTEGERP (ok_if_already_exists), &out_st);
- else if (stat (XSTRING (newname)->data, &out_st) < 0)
+ else if (stat (XSTRING (encoded_newname)->data, &out_st) < 0)
out_st.st_mode = 0;
- ifd = open (XSTRING (file)->data, O_RDONLY);
+ ifd = open (XSTRING (encoded_file)->data, O_RDONLY);
if (ifd < 0)
report_file_error ("Opening input file", Fcons (file, Qnil));
#ifdef VMS
/* Create the copy file with the same record format as the input file */
- ofd = sys_creat (XSTRING (newname)->data, 0666, ifd);
+ ofd = sys_creat (XSTRING (encoded_newname)->data, 0666, ifd);
#else
#ifdef MSDOS
/* System's default file type was set to binary by _fmode in emacs.c. */
- ofd = creat (XSTRING (newname)->data, S_IREAD | S_IWRITE);
+ ofd = creat (XSTRING (encoded_newname)->data, S_IREAD | S_IWRITE);
#else /* not MSDOS */
- ofd = creat (XSTRING (newname)->data, 0666);
+ ofd = creat (XSTRING (encoded_newname)->data, 0666);
#endif /* not MSDOS */
#endif /* VMS */
if (ofd < 0)
EMACS_TIME atime, mtime;
EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
- if (set_file_times (XSTRING (newname)->data, atime, mtime))
- report_file_error ("I/O error", Fcons (newname, Qnil));
+ if (set_file_times (XSTRING (encoded_newname)->data,
+ atime, mtime))
+ Fsignal (Qfile_date_error,
+ Fcons (build_string ("Cannot set file date"),
+ Fcons (newname, Qnil)));
}
#ifndef MSDOS
- chmod (XSTRING (newname)->data, st.st_mode & 07777);
+ chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777);
#else /* MSDOS */
#if defined (__DJGPP__) && __DJGPP__ > 1
/* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
get only the READ bit, which will make the copied file read-only,
so it's better not to chmod at all. */
if ((_djstat_flags & _STFAIL_WRITEBIT) == 0)
- chmod (XSTRING (newname)->data, st.st_mode & 07777);
+ chmod (XSTRING (encoded_newname)->data, st.st_mode & 07777);
#endif /* DJGPP version 2 or newer */
#endif /* MSDOS */
}
{
unsigned char *dir;
Lisp_Object handler;
+ Lisp_Object encoded_dir;
CHECK_STRING (directory, 0);
directory = Fexpand_file_name (directory, Qnil);
if (!NILP (handler))
return call2 (handler, Qmake_directory_internal, directory);
- dir = XSTRING (directory)->data;
+ encoded_dir = ENCODE_FILE (directory);
+
+ dir = XSTRING (encoded_dir)->data;
#ifdef WINDOWSNT
if (mkdir (dir) != 0)
{
unsigned char *dir;
Lisp_Object handler;
+ Lisp_Object encoded_dir;
CHECK_STRING (directory, 0);
directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil));
- dir = XSTRING (directory)->data;
handler = Ffind_file_name_handler (directory, Qdelete_directory);
if (!NILP (handler))
return call2 (handler, Qdelete_directory, directory);
+ encoded_dir = ENCODE_FILE (directory);
+
+ dir = XSTRING (encoded_dir)->data;
+
if (rmdir (dir) != 0)
report_file_error ("Removing directory", Flist (1, &directory));
Lisp_Object filename;
{
Lisp_Object handler;
+ Lisp_Object encoded_file;
+
CHECK_STRING (filename, 0);
filename = Fexpand_file_name (filename, Qnil);
if (!NILP (handler))
return call2 (handler, Qdelete_file, filename);
- if (0 > unlink (XSTRING (filename)->data))
+ encoded_file = ENCODE_FILE (filename);
+
+ if (0 > unlink (XSTRING (encoded_file)->data))
report_file_error ("Removing old name", Flist (1, &filename));
return Qnil;
}
Lisp_Object args[2];
#endif
Lisp_Object handler;
- struct gcpro gcpro1, gcpro2;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ Lisp_Object encoded_file, encoded_newname;
- GCPRO2 (file, newname);
+ encoded_file = encoded_newname = Qnil;
+ GCPRO4 (file, newname, encoded_file, encoded_newname);
CHECK_STRING (file, 0);
CHECK_STRING (newname, 1);
file = Fexpand_file_name (file, Qnil);
RETURN_UNGCPRO (call4 (handler, Qrename_file,
file, newname, ok_if_already_exists));
+ encoded_file = ENCODE_FILE (file);
+ encoded_newname = ENCODE_FILE (newname);
+
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
- barf_or_query_if_file_exists (newname, "rename to it",
+ barf_or_query_if_file_exists (encoded_newname, "rename to it",
INTEGERP (ok_if_already_exists), 0);
#ifndef BSD4_1
- if (0 > rename (XSTRING (file)->data, XSTRING (newname)->data))
+ if (0 > rename (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data))
#else
- if (0 > link (XSTRING (file)->data, XSTRING (newname)->data)
- || 0 > unlink (XSTRING (file)->data))
+ if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data)
+ || 0 > unlink (XSTRING (encoded_file)->data))
#endif
{
if (errno == EXDEV)
Lisp_Object args[2];
#endif
Lisp_Object handler;
- struct gcpro gcpro1, gcpro2;
+ Lisp_Object encoded_file, encoded_newname;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- GCPRO2 (file, newname);
+ GCPRO4 (file, newname, encoded_file, encoded_newname);
+ encoded_file = encoded_newname = Qnil;
CHECK_STRING (file, 0);
CHECK_STRING (newname, 1);
file = Fexpand_file_name (file, Qnil);
RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
newname, ok_if_already_exists));
+ encoded_file = ENCODE_FILE (file);
+ encoded_newname = ENCODE_FILE (newname);
+
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
- barf_or_query_if_file_exists (newname, "make it a new name",
+ barf_or_query_if_file_exists (encoded_newname, "make it a new name",
INTEGERP (ok_if_already_exists), 0);
-#ifdef WINDOWSNT
- /* Windows does not support this operation. */
- report_file_error ("Adding new name", Flist (2, &file));
-#else /* not WINDOWSNT */
unlink (XSTRING (newname)->data);
- if (0 > link (XSTRING (file)->data, XSTRING (newname)->data))
+ if (0 > link (XSTRING (encoded_file)->data, XSTRING (encoded_newname)->data))
{
#ifdef NO_ARG_ARRAY
args[0] = file;
report_file_error ("Adding new name", Flist (2, &file));
#endif
}
-#endif /* not WINDOWSNT */
UNGCPRO;
return Qnil;
Lisp_Object args[2];
#endif
Lisp_Object handler;
- struct gcpro gcpro1, gcpro2;
+ Lisp_Object encoded_filename, encoded_linkname;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- GCPRO2 (filename, linkname);
+ GCPRO4 (filename, linkname, encoded_filename, encoded_linkname);
+ encoded_filename = encoded_linkname = Qnil;
CHECK_STRING (filename, 0);
CHECK_STRING (linkname, 1);
/* If the link target has a ~, we must expand it to get
RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
linkname, ok_if_already_exists));
+ encoded_filename = ENCODE_FILE (filename);
+ encoded_linkname = ENCODE_FILE (linkname);
+
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
- barf_or_query_if_file_exists (linkname, "make it a link",
+ barf_or_query_if_file_exists (encoded_linkname, "make it a link",
INTEGERP (ok_if_already_exists), 0);
- if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
+ if (0 > symlink (XSTRING (encoded_filename)->data,
+ XSTRING (encoded_linkname)->data))
{
/* If we didn't complain already, silently delete existing file. */
if (errno == EEXIST)
{
- unlink (XSTRING (linkname)->data);
- if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
+ unlink (XSTRING (encoded_linkname)->data);
+ if (0 <= symlink (XSTRING (encoded_filename)->data,
+ XSTRING (encoded_linkname)->data))
{
UNGCPRO;
return Qnil;
if (!NILP (handler))
return call2 (handler, Qfile_exists_p, absname);
+ absname = ENCODE_FILE (absname);
+
return (stat (XSTRING (absname)->data, &statbuf) >= 0) ? Qt : Qnil;
}
if (!NILP (handler))
return call2 (handler, Qfile_executable_p, absname);
+ absname = ENCODE_FILE (absname);
+
return (check_executable (XSTRING (absname)->data) ? Qt : Qnil);
}
Lisp_Object absname;
Lisp_Object handler;
int desc;
+ int flags;
+ struct stat statbuf;
CHECK_STRING (filename, 0);
absname = Fexpand_file_name (filename, Qnil);
if (!NILP (handler))
return call2 (handler, Qfile_readable_p, absname);
+ absname = ENCODE_FILE (absname);
+
#ifdef DOS_NT
/* Under MS-DOS and Windows, open does not work for directories. */
if (access (XSTRING (absname)->data, 0) == 0)
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);
(filename)
Lisp_Object filename;
{
- Lisp_Object absname, dir;
+ Lisp_Object absname, dir, encoded;
Lisp_Object handler;
struct stat statbuf;
if (!NILP (handler))
return call2 (handler, Qfile_writable_p, absname);
- if (stat (XSTRING (absname)->data, &statbuf) >= 0)
- return (check_writable (XSTRING (absname)->data)
+ encoded = ENCODE_FILE (absname);
+ if (stat (XSTRING (encoded)->data, &statbuf) >= 0)
+ return (check_writable (XSTRING (encoded)->data)
? Qt : Qnil);
+
dir = Ffile_name_directory (absname);
#ifdef VMS
if (!NILP (dir))
if (!NILP (dir))
dir = Fdirectory_file_name (dir);
#endif /* MSDOS */
+
+ dir = ENCODE_FILE (dir);
return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "")
? Qt : Qnil);
}
(filename, string)
Lisp_Object filename, string;
{
- Lisp_Object handler;
+ Lisp_Object handler, encoded_filename;
int fd;
CHECK_STRING (filename, 0);
if (!NILP (handler))
return call3 (handler, Qaccess_file, filename, string);
- fd = open (XSTRING (filename)->data, O_RDONLY);
+ encoded_filename = ENCODE_FILE (filename);
+
+ fd = open (XSTRING (encoded_filename)->data, O_RDONLY);
if (fd < 0)
report_file_error (XSTRING (string)->data, Fcons (filename, Qnil));
close (fd);
if (!NILP (handler))
return call2 (handler, Qfile_symlink_p, filename);
+ filename = ENCODE_FILE (filename);
+
bufsize = 100;
while (1)
{
}
val = make_string (buf, valsize);
xfree (buf);
- return val;
+ return Fdecode_coding_string (val, Vfile_name_coding_system, Qt);
#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 file FILENAME is the name of a directory as a file.\n\
-A directory name spec may be given instead; then the value is t\n\
-if the directory so specified exists and really is a directory.")
+ "Return t if FILENAME names an existing directory.")
(filename)
Lisp_Object filename;
{
if (!NILP (handler))
return call2 (handler, Qfile_directory_p, absname);
+ absname = ENCODE_FILE (absname);
+
if (stat (XSTRING (absname)->data, &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
if (!NILP (handler))
return call2 (handler, Qfile_regular_p, absname);
+ absname = ENCODE_FILE (absname);
+
if (stat (XSTRING (absname)->data, &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
if (!NILP (handler))
return call2 (handler, Qfile_modes, absname);
+ absname = ENCODE_FILE (absname);
+
if (stat (XSTRING (absname)->data, &st) < 0)
return Qnil;
#if defined (MSDOS) && __DJGPP__ < 2
(filename, mode)
Lisp_Object filename, mode;
{
- Lisp_Object absname;
+ Lisp_Object absname, encoded_absname;
Lisp_Object handler;
absname = Fexpand_file_name (filename, current_buffer->directory);
if (!NILP (handler))
return call3 (handler, Qset_file_modes, absname, mode);
- if (chmod (XSTRING (absname)->data, XINT (mode)) < 0)
+ encoded_absname = ENCODE_FILE (absname);
+
+ if (chmod (XSTRING (encoded_absname)->data, XINT (mode)) < 0)
report_file_error ("Doing chmod", Fcons (absname, Qnil));
return Qnil;
if (!NILP (handler))
return call3 (handler, Qfile_newer_than_file_p, absname1, absname2);
+ GCPRO2 (absname1, absname2);
+ absname1 = ENCODE_FILE (absname1);
+ absname2 = ENCODE_FILE (absname2);
+ UNGCPRO;
+
if (stat (XSTRING (absname1)->data, &st) < 0)
return Qnil;
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 `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;
{
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;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ Lisp_Object handler, val, insval, orig_filename;
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");
val = Qnil;
p = Qnil;
+ orig_filename = Qnil;
- GCPRO3 (filename, val, p);
+ GCPRO4 (filename, val, p, orig_filename);
CHECK_STRING (filename, 0);
filename = Fexpand_file_name (filename, Qnil);
goto handled;
}
+ orig_filename = filename;
+ filename = ENCODE_FILE (filename);
+
fd = -1;
#ifndef APOLLO
if (fd >= 0) close (fd);
badopen:
if (NILP (visit))
- report_file_error ("Opening input file", Fcons (filename, Qnil));
+ report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
st.st_mtime = -1;
how_much = 0;
goto notfound;
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;
+ Fcons (orig_filename, Qnil)));
}
#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");
+ }
}
+ /* Decide the coding-system of the file. */
+ {
+ Lisp_Object 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;
+
+ 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);
+ }
+
/* 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_MAY_REQUIRE_NO_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 (orig_filename, Qnil));
+ }
immediate_quit = 1;
QUIT;
nread = read (fd, buffer, sizeof buffer);
if (nread < 0)
error ("IO error reading %s: %s",
- XSTRING (filename)->data, strerror (errno));
+ XSTRING (orig_filename)->data, strerror (errno));
else if (nread == 0)
break;
+
+ if (coding.type == coding_type_undecided)
+ detect_coding (&coding, buffer, nread);
+ if (coding.type != coding_type_undecided
+ && coding.type != coding_type_no_conversion
+ && coding.type != coding_type_emacs_mule)
+ /* 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_UNDECIDED)
+ detect_eol (&coding, buffer, nread);
+ if (coding.eol_type != CODING_EOL_UNDECIDED
+ && coding.eol_type != CODING_EOL_LF)
+ /* 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;
trial = min (curpos, sizeof buffer);
if (lseek (fd, curpos - trial, 0) < 0)
report_file_error ("Setting file position",
- Fcons (filename, Qnil));
+ Fcons (orig_filename, Qnil));
total_read = 0;
while (total_read < trial)
nread = read (fd, buffer + total_read, trial - total_read);
if (nread <= 0)
error ("IO error reading %s: %s",
- XSTRING (filename)->data, strerror (errno));
+ XSTRING (orig_filename)->data, strerror (errno));
total_read += nread;
}
/* Scan this bufferful from the end, comparing with
/* 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)
+ && ! CODING_REQUIRE_NO_CONVERSION (&coding))
+ giveup_match_end = 1;
+ break;
+ }
+ }
+ immediate_quit = 0;
+
+ if (! giveup_match_end)
+ {
+ /* We win! We can handle REPLACE the optimized way. */
+
+ /* Extends the end 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)))
+ 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);
+ 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 (orig_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_NO_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 (orig_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);
+ prepare_to_modify_buffer (PT, PT, NULL);
move_gap (PT);
if (GAP_SIZE < total)
if (XINT (beg) != 0 || !NILP (replace))
{
if (lseek (fd, XINT (beg), 0) < 0)
- report_file_error ("Setting file position", Fcons (filename, Qnil));
+ report_file_error ("Setting file position",
+ Fcons (orig_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_NO_CONVERSION (&coding)
+ ? (char *) (POS_ADDR (PT + inserted - 1) + 1)
+ : read_buf + unprocessed);
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_NO_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;
}
+
+#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
+ current_buffer->buffer_file_type = Qt;
+#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, filename);
+ = call1 (Qfind_buffer_file_type, orig_filename);
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));
+ XSTRING (orig_filename)->data, strerror (errno));
+ else if (how_much == -2)
+ error ("maximum buffer size exceeded");
notfound:
handled:
if (NILP (handler))
{
current_buffer->modtime = st.st_mtime;
- current_buffer->filename = filename;
+ current_buffer->filename = orig_filename;
}
SAVE_MODIFF = MODIFF;
if (not_regular)
Fsignal (Qfile_error,
Fcons (build_string ("not a regular file"),
- Fcons (filename, Qnil)));
+ Fcons (orig_filename, Qnil)));
/* If visiting nonexistent file, return nil. */
if (current_buffer->modtime == -1)
- report_file_error ("Opening input file", Fcons (filename, Qnil));
+ report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
}
/* Decode file format */
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));
}
if (NILP (val))
- val = Fcons (filename,
+ val = Fcons (orig_filename,
Fcons (make_number (inserted),
Qnil));
}
\f
static Lisp_Object build_annotations ();
+extern Lisp_Object Ffile_locked_p ();
/* 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)
Lisp_Object handler;
Lisp_Object visit_file;
Lisp_Object annotations;
+ Lisp_Object encoded_filename;
int visiting, quietly;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
struct buffer *given_buffer;
#ifdef DOS_NT
- int buffer_file_type
- = NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY;
+ int buffer_file_type = 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);
+ GCPRO4 (start, filename, visit, lockname);
+
+ /* Decide the coding-system to encode the data with. */
+ {
+ Lisp_Object val;
+
+ if (auto_saving)
+ val = Qnil;
+ else if (!NILP (Vcoding_system_for_write))
+ val = Vcoding_system_for_write;
+ else if (NILP (current_buffer->enable_multibyte_characters))
+ {
+ /* If the variable `buffer-file-coding-system' is set locally,
+ it means that the file was read with some kind of code
+ conversion or the varialbe is explicitely set by users. We
+ 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
+ format if the default value of `buffer-file-coding-system'
+ tells that it is not Unix-like (LF only) format. */
+ val = current_buffer->buffer_file_coding_system;
+ if (NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
+ {
+ struct coding_system coding_temp;
+
+ setup_coding_system (Fcheck_coding_system (val), &coding_temp);
+ if (coding_temp.eol_type == CODING_EOL_CRLF
+ || coding_temp.eol_type == CODING_EOL_CR)
+ {
+ setup_coding_system (Qemacs_mule, &coding);
+ coding.eol_type = coding_temp.eol_type;
+ goto done_setup_coding;
+ }
+ val = Qnil;
+ }
+ }
+ 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);
+
+ done_setup_coding:
+ if (!STRINGP (start) && !NILP (current_buffer->selective_display))
+ coding.selective = 1;
+ }
+
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;
- end = ZV;
+ XSETFASTINT (start, BEGV);
+ XSETFASTINT (end, ZV);
}
#ifdef CLASH_DETECTION
if (!auto_saving)
- lock_file (lockname);
+ {
+#if 0 /* This causes trouble for GNUS. */
+ /* 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"), filename, Vuser_login_name);
+#endif
+
+ lock_file (lockname);
+ }
#endif /* CLASH_DETECTION */
- fn = XSTRING (filename)->data;
+ encoded_filename = ENCODE_FILE (filename);
+
+ fn = XSTRING (encoded_filename)->data;
desc = -1;
if (!NILP (append))
#ifdef DOS_NT
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 && !coding.last_block)
+ {
+ /* We have to flush out a data. */
+ coding.last_block = 1;
+ failure = 0 > e_write (desc, "", 0, &coding);
save_errno = errno;
}
current_buffer->modtime = st.st_mtime;
if (failure)
- error ("IO error writing %s: %s", fn, strerror (save_errno));
+ error ("IO error writing %s: %s", XSTRING (filename)->data,
+ strerror (save_errno));
if (visiting)
{
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;
been dealt with by this function. */
if (current_buffer != given_buffer)
{
- start = BEGV;
- end = ZV;
+ XSETFASTINT (start, BEGV);
+ XSETFASTINT (end, ZV);
annotations = Qnil;
}
Flength (res); /* Check basic validity of return value */
original_buffer);
if (current_buffer != given_buffer)
{
- start = BEGV;
- end = ZV;
+ XSETFASTINT (start, BEGV);
+ XSETFASTINT (end, ZV);
annotations = Qnil;
}
Flength (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;
}
struct buffer *b;
struct stat st;
Lisp_Object handler;
+ Lisp_Object filename;
CHECK_BUFFER (buf, 0);
b = XBUFFER (buf);
if (!NILP (handler))
return call2 (handler, Qverify_visited_file_modtime, buf);
- if (stat (XSTRING (b->filename)->data, &st) < 0)
+ filename = ENCODE_FILE (b->filename);
+
+ if (stat (XSTRING (filename)->data, &st) < 0)
{
/* If the file doesn't exist now and didn't exist before,
we say that it isn't modified, provided the error is a tame one. */
if (!NILP (handler))
/* The handler can find the file name the same way we did. */
return call2 (handler, Qset_visited_file_modtime, Qnil);
- else if (stat (XSTRING (filename)->data, &st) >= 0)
+
+ filename = ENCODE_FILE (filename);
+
+ if (stat (XSTRING (filename)->data, &st) >= 0)
current_buffer->modtime = st.st_mtime;
}
}
static Lisp_Object
-do_auto_save_unwind (desc) /* used as unwind-protect function */
- Lisp_Object desc;
+do_auto_save_unwind (stream) /* used as unwind-protect function */
+ Lisp_Object stream;
{
auto_saving = 0;
- if (XINT (desc) >= 0)
- close (XINT (desc));
+ if (!NILP (stream))
+ fclose ((FILE *) (XFASTINT (XCONS (stream)->car) << 16
+ | XFASTINT (XCONS (stream)->cdr)));
+ return Qnil;
+}
+
+static Lisp_Object
+do_auto_save_unwind_1 (value) /* used as unwind-protect function */
+ Lisp_Object value;
+{
+ minibuffer_auto_raise = XINT (value);
return Qnil;
}
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;
+ FILE *stream;
+ Lisp_Object lispstream;
int count = specpdl_ptr - specpdl;
int *ptr;
+ int orig_minibuffer_auto_raise = minibuffer_auto_raise;
/* Ordinarily don't quit within this function,
but don't make it impossible to quit (in case we get hung in I/O). */
{
Lisp_Object listfile;
listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
-#ifdef DOS_NT
- listdesc = open (XSTRING (listfile)->data,
- O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
- S_IREAD | S_IWRITE);
-#else /* not DOS_NT */
- listdesc = creat (XSTRING (listfile)->data, 0666);
-#endif /* not DOS_NT */
+ stream = fopen (XSTRING (listfile)->data, "w");
+ if (stream != NULL)
+ {
+ /* 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);
+ }
+ else
+ lispstream = Qnil;
}
else
- listdesc = -1;
-
- /* Arrange to close that file whether or not we get an error.
- Also reset auto_saving to 0. */
- record_unwind_protect (do_auto_save_unwind, make_number (listdesc));
+ {
+ stream = NULL;
+ lispstream = Qnil;
+ }
+ record_unwind_protect (do_auto_save_unwind, lispstream);
+ record_unwind_protect (do_auto_save_unwind_1,
+ make_number (minibuffer_auto_raise));
+ minibuffer_auto_raise = 0;
auto_saving = 1;
/* First, save all files which don't have handlers. If Emacs is
in the special file that lists them. For each of these buffers,
Record visited name (if any) and auto save name. */
if (STRINGP (b->auto_save_file_name)
- && listdesc >= 0 && do_handled_files == 0)
+ && stream != NULL && do_handled_files == 0)
{
if (!NILP (b->filename))
{
- write (listdesc, XSTRING (b->filename)->data,
- XSTRING (b->filename)->size);
+ fwrite (XSTRING (b->filename)->data, 1,
+ XSTRING (b->filename)->size, stream);
}
- write (listdesc, "\n", 1);
- write (listdesc, XSTRING (b->auto_save_file_name)->data,
- XSTRING (b->auto_save_file_name)->size);
- write (listdesc, "\n", 1);
+ putc ('\n', stream);
+ fwrite (XSTRING (b->auto_save_file_name)->data, 1,
+ XSTRING (b->auto_save_file_name)->size, stream);
+ putc ('\n', stream);
}
if (!NILP (current_only)
&& NILP (no_message))
{
/* 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);
+ minibuffer_auto_raise = 0;
/* Turn off auto-saving until there's a real save,
and prevent any more warnings. */
XSETINT (b->save_length, -1);
{
if (omessage)
{
- sit_for (1, 0, 0, 0);
+ sit_for (1, 0, 0, 0, 0);
message2 (omessage, omessage_length);
}
else
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);
+ insdef1 = Fcons (double_dollars (insdef), make_number (0));
}
else
insdef = Qnil, insdef1 = Qnil;
GCPRO2 (insdef, default_filename);
val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
dir, mustmatch, insdef1,
- Qfile_name_history);
+ Qfile_name_history, default_filename, Qnil);
+ /* If Fcompleting_read returned the 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 ("");
#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, Qnil);
#ifdef VMS
unbind_to (count, Qnil);
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");
staticpro (&Qfind_buffer_file_type);
#endif /* DOS_NT */
+ DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system,
+ "*Coding system for encoding file names.");
+ Vfile_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\
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;
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.");
- Vdirectory_sep_char = '/';
+ 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\
for its argument.");
Vfile_name_handler_alist = Qnil;
+ 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\
+specified in the heading lines with the format:\n\
+ -*- ... coding: CODING-SYSTEM; ... -*-\n\
+or local variable spec of the tailing lines with `coding:' tag.");
+ Vset_auto_coding_function = Qnil;
+
DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions,
"A list of functions to be called at the end of `insert-file-contents'.\n\
Each is passed one argument, the number of bytes inserted. It should return\n\