/* 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,97,98,99,2000, 2001
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
+#define _GNU_SOURCE /* for euidaccess */
+
#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>
#include <pwd.h>
#endif
-#ifdef MSDOS
-#include "msdos.h"
-#include <sys/param.h>
-#if __DJGPP__ >= 2
-#include <fcntl.h>
-#include <string.h>
-#endif
-#endif
-
#include <ctype.h>
#ifdef VMS
#include <errno.h>
#ifndef vax11c
+#ifndef USE_CRT_DLL
extern int errno;
#endif
-
-extern char *strerror ();
+#endif
#ifdef APOLLO
#include <sys/time.h>
#include <fcntl.h>
#endif /* not WINDOWSNT */
+#ifdef MSDOS
+#include "msdos.h"
+#include <sys/param.h>
+#if __DJGPP__ >= 2
+#include <fcntl.h>
+#include <string.h>
+#endif
+#endif
+
#ifdef DOS_NT
#define CORRECT_DIR_SEPS(s) \
do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
#endif
#endif
+#include "commands.h"
+extern int use_dialog_box;
+
#ifndef O_WRONLY
#define O_WRONLY 1
#endif
#define O_RDONLY 0
#endif
+#ifndef S_ISLNK
+# define lstat stat
+#endif
+
#define min(a, b) ((a) < (b) ? (a) : (b))
#define max(a, b) ((a) > (b) ? (a) : (b))
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;
+
+/* Coding system for file names used only when
+ Vfile_name_coding_system is nil. */
+Lisp_Object Vdefault_file_name_coding_system;
+
/* Alist of elements (REGEXP . HANDLER) for file names
whose I/O is done with a special handler. */
Lisp_Object Vfile_name_handler_alist;
/* 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;
extern Lisp_Object Vuser_login_name;
+#ifdef WINDOWSNT
+extern Lisp_Object Vw32_get_true_file_attributes;
+#endif
+
extern int minibuf_level;
+extern int minibuffer_auto_raise;
+
/* These variables describe handlers that have "already" had a chance
to handle the current operation.
static Lisp_Object Vinhibit_file_name_operation;
Lisp_Object Qfile_error, Qfile_already_exists, Qfile_date_error;
-
+Lisp_Object Qexcl;
Lisp_Object Qfile_name_history;
Lisp_Object Qcar_less_than_car;
+static int a_write P_ ((int, Lisp_Object, int, int,
+ Lisp_Object *, struct coding_system *));
+static int e_write P_ ((int, Lisp_Object, int, int, struct coding_system *));
+
+\f
+void
report_file_error (string, data)
char *string;
Lisp_Object data;
{
Lisp_Object errstring;
+ int errorno = errno;
- errstring = build_string (strerror (errno));
-
- /* System error messages are capitalized. Downcase the initial
- unless it is followed by a slash. */
- if (XSTRING (errstring)->data[1] != '/')
- XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
+ synchronize_system_messages_locale ();
+ errstring = code_convert_string_norecord (build_string (strerror (errorno)),
+ Vlocale_coding_system, 0);
while (1)
- Fsignal (Qfile_error,
- Fcons (build_string (string), Fcons (errstring, data)));
+ switch (errorno)
+ {
+ case EEXIST:
+ Fsignal (Qfile_already_exists, Fcons (errstring, data));
+ break;
+ default:
+ /* System error messages are capitalized. Downcase the initial
+ unless it is followed by a slash. */
+ if (XSTRING (errstring)->data[1] != '/')
+ XSTRING (errstring)->data[0] = DOWNCASE (XSTRING (errstring)->data[0]);
+
+ Fsignal (Qfile_error,
+ Fcons (build_string (string), Fcons (errstring, data)));
+ }
}
+Lisp_Object
close_file_unwind (fd)
Lisp_Object fd;
{
- close (XFASTINT (fd));
+ emacs_close (XFASTINT (fd));
+ return Qnil;
}
/* Restore point, having saved it as a marker. */
+static Lisp_Object
restore_point_unwind (location)
Lisp_Object location;
{
- SET_PT (marker_position (location));
+ Fgoto_char (location);
Fset_marker (location, Qnil, Qnil);
+ return Qnil;
}
\f
Lisp_Object Qexpand_file_name;
Lisp_Object Qfile_name_as_directory;
Lisp_Object Qcopy_file;
Lisp_Object Qmake_directory_internal;
+Lisp_Object Qmake_directory;
Lisp_Object Qdelete_directory;
Lisp_Object Qdelete_file;
Lisp_Object Qrename_file;
inhibited_handlers = Qnil;
for (chain = Vfile_name_handler_alist; CONSP (chain);
- chain = XCONS (chain)->cdr)
+ chain = XCDR (chain))
{
Lisp_Object elt;
- elt = XCONS (chain)->car;
+ elt = XCAR (chain);
if (CONSP (elt))
{
Lisp_Object string;
- string = XCONS (elt)->car;
+ string = XCAR (elt);
if (STRINGP (string) && fast_string_match (string, filename) >= 0)
{
Lisp_Object handler, tem;
- handler = XCONS (elt)->cdr;
+ handler = XCDR (elt);
tem = Fmemq (handler, inhibited_handlers);
if (NILP (tem))
return handler;
#ifdef DOS_NT
beg = strcpy (alloca (strlen (beg) + 1), beg);
#endif
- p = beg + XSTRING (filename)->size;
+ p = beg + STRING_BYTES (XSTRING (filename));
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef VMS
&& p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
#endif /* VMS */
#ifdef DOS_NT
- /* only recognise drive specifier at beginning */
- && !(p[-1] == ':' && p == beg + 2)
+ /* only recognise drive specifier at the beginning */
+ && !(p[-1] == ':'
+ /* handle the "/:d:foo" and "/:foo" cases correctly */
+ && ((p == beg + 2 && !IS_DIRECTORY_SEP (*beg))
+ || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
#endif
) p--;
return Qnil;
#ifdef DOS_NT
/* Expansion of "c:" to drive and default directory. */
- if (p == beg + 2 && beg[1] == ':')
+ if (p[-1] == ':')
{
/* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
unsigned char *res = alloca (MAXPATHLEN + 1);
- if (getdefdir (toupper (*beg) - 'A' + 1, res))
+ unsigned char *r = res;
+
+ if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':')
+ {
+ strncpy (res, beg, 2);
+ beg += 2;
+ r += 2;
+ }
+
+ if (getdefdir (toupper (*beg) - 'A' + 1, r))
{
if (!IS_DIRECTORY_SEP (res[strlen (res) - 1]))
strcat (res, "/");
}
CORRECT_DIR_SEPS (beg);
#endif /* DOS_NT */
- return make_string (beg, p - beg);
+
+ if (STRING_MULTIBYTE (filename))
+ return make_string (beg, p - beg);
+ return make_unibyte_string (beg, p - beg);
}
-DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory,
- 1, 1, 0,
+DEFUN ("file-name-nondirectory", Ffile_name_nondirectory,
+ Sfile_name_nondirectory, 1, 1, 0,
"Return file name FILENAME sans its directory.\n\
For example, in a Unix-syntax file name,\n\
this is everything after the last slash,\n\
return call2 (handler, Qfile_name_nondirectory, filename);
beg = XSTRING (filename)->data;
- end = p = beg + XSTRING (filename)->size;
+ end = p = beg + STRING_BYTES (XSTRING (filename));
while (p != beg && !IS_DIRECTORY_SEP (p[-1])
#ifdef VMS
#endif /* VMS */
#ifdef DOS_NT
/* only recognise drive specifier at beginning */
- && !(p[-1] == ':' && p == beg + 2)
+ && !(p[-1] == ':'
+ /* handle the "/:d:foo" case correctly */
+ && (p == beg + 2 || (p == beg + 4 && IS_DIRECTORY_SEP (*beg))))
#endif
- ) p--;
+ )
+ p--;
- return make_string (p, end - p);
+ if (STRING_MULTIBYTE (filename))
+ return make_string (p, end - p);
+ return make_unibyte_string (p, end - p);
}
-DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, Sunhandled_file_name_directory, 1, 1, 0,
+DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory,
+ Sunhandled_file_name_directory, 1, 1, 0,
"Return a directly usable directory name somehow associated with FILENAME.\n\
A `directly usable' directory name is one that may be used without the\n\
intervention of any file handler.\n\
If FILENAME is a directly usable file itself, return\n\
-(file-name-directory FILENAME).\n\
+\(file-name-directory FILENAME).\n\
The `call-process' and `start-process' functions use this function to\n\
get a current directory to run processes in.")
(filename)
strcpy (out, in);
+ if (size < 0)
+ {
+ out[0] = '.';
+ out[1] = '/';
+ out[2] = 0;
+ return out;
+ }
+
#ifdef VMS
/* Is it already a directory string? */
if (in[size] == ':' || in[size] == ']' || in[size] == '>')
if (!NILP (handler))
return call2 (handler, Qfile_name_as_directory, file);
- buf = (char *) alloca (XSTRING (file)->size + 10);
+ buf = (char *) alloca (STRING_BYTES (XSTRING (file)) + 10);
return build_string (file_name_as_directory (buf, XSTRING (file)->data));
}
\f
* Value is nonzero if the string output is different from the input.
*/
+int
directory_file_name (src, dst)
char *src, *dst;
{
/* 20 extra chars is insufficient for VMS, since we might perform a
logical name translation. an equivalence string can be up to 255
chars long, so grab that much extra space... - sss */
- buf = (char *) alloca (XSTRING (directory)->size + 20 + 255);
+ buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20 + 255);
#else
- buf = (char *) alloca (XSTRING (directory)->size + 20);
+ buf = (char *) alloca (STRING_BYTES (XSTRING (directory)) + 20);
#endif
directory_file_name (XSTRING (directory)->data, buf);
return build_string (buf);
}
+static char make_temp_name_tbl[64] =
+{
+ 'A','B','C','D','E','F','G','H',
+ 'I','J','K','L','M','N','O','P',
+ 'Q','R','S','T','U','V','W','X',
+ 'Y','Z','a','b','c','d','e','f',
+ 'g','h','i','j','k','l','m','n',
+ 'o','p','q','r','s','t','u','v',
+ 'w','x','y','z','0','1','2','3',
+ '4','5','6','7','8','9','-','_'
+};
+
+static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
+
+/* Value is a temporary file name starting with PREFIX, a string.
+
+ The Emacs process number forms part of the result, so there is
+ no danger of generating a name being used by another process.
+ In addition, this function makes an attempt to choose a name
+ which has no existing file. To make this work, PREFIX should be
+ an absolute file name.
+
+ BASE64_P non-zero means add the pid as 3 characters in base64
+ encoding. In this case, 6 characters will be added to PREFIX to
+ form the file name. Otherwise, if Emacs is running on a system
+ with long file names, add the pid as a decimal number.
+
+ This function signals an error if no unique file name could be
+ generated. */
+
+Lisp_Object
+make_temp_name (prefix, base64_p)
+ Lisp_Object prefix;
+ int base64_p;
+{
+ Lisp_Object val;
+ int len;
+ int pid;
+ unsigned char *p, *data;
+ char pidbuf[20];
+ int pidlen;
+
+ CHECK_STRING (prefix, 0);
+
+ /* VAL is created by adding 6 characters to PREFIX. The first
+ three are the PID of this process, in base 64, and the second
+ three are incremented if the file already exists. This ensures
+ 262144 unique file names per PID per PREFIX. */
+
+ pid = (int) getpid ();
+
+ if (base64_p)
+ {
+ pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
+ pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
+ pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
+ pidlen = 3;
+ }
+ else
+ {
+#ifdef HAVE_LONG_FILE_NAMES
+ sprintf (pidbuf, "%d", pid);
+ pidlen = strlen (pidbuf);
+#else
+ pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
+ pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
+ pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
+ pidlen = 3;
+#endif
+ }
+
+ len = XSTRING (prefix)->size;
+ val = make_uninit_string (len + 3 + pidlen);
+ data = XSTRING (val)->data;
+ bcopy(XSTRING (prefix)->data, data, len);
+ p = data + len;
+
+ bcopy (pidbuf, p, pidlen);
+ p += pidlen;
+
+ /* Here we try to minimize useless stat'ing when this function is
+ invoked many times successively with the same PREFIX. We achieve
+ this by initializing count to a random value, and incrementing it
+ afterwards.
+
+ We don't want make-temp-name to be called while dumping,
+ because then make_temp_name_count_initialized_p would get set
+ and then make_temp_name_count would not be set when Emacs starts. */
+
+ if (!make_temp_name_count_initialized_p)
+ {
+ make_temp_name_count = (unsigned) time (NULL);
+ make_temp_name_count_initialized_p = 1;
+ }
+
+ while (1)
+ {
+ struct stat ignored;
+ unsigned num = make_temp_name_count;
+
+ p[0] = make_temp_name_tbl[num & 63], num >>= 6;
+ p[1] = make_temp_name_tbl[num & 63], num >>= 6;
+ p[2] = make_temp_name_tbl[num & 63], num >>= 6;
+
+ /* Poor man's congruential RN generator. Replace with
+ ++make_temp_name_count for debugging. */
+ make_temp_name_count += 25229;
+ make_temp_name_count %= 225307;
+
+ if (stat (data, &ignored) < 0)
+ {
+ /* We want to return only if errno is ENOENT. */
+ if (errno == ENOENT)
+ return val;
+ else
+ /* The error here is dubious, but there is little else we
+ can do. The alternatives are to return nil, which is
+ as bad as (and in many cases worse than) throwing the
+ error, or to ignore the error, which will likely result
+ in looping through 225307 stat's, which is not only
+ dog-slow, but also useless since it will fallback to
+ the errow below, anyway. */
+ report_file_error ("Cannot create temporary name for prefix",
+ Fcons (prefix, Qnil));
+ /* not reached */
+ }
+ }
+
+ error ("Cannot create temporary name for prefix `%s'",
+ XSTRING (prefix)->data);
+ return Qnil;
+}
+
+
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\
+\n\
+In addition, this function makes an attempt to choose a name\n\
+which has no existing file. To make this work,\n\
+PREFIX should be an absolute file name.\n\
+\n\
+There is a race condition between calling `make-temp-name' and creating the\n\
+file which opens all kinds of security holes. For that reason, you should\n\
+probably use `make-temp-file' instead.")
(prefix)
Lisp_Object prefix;
{
- Lisp_Object val;
-#ifdef MSDOS
- /* Don't use too many characters of the restricted 8+3 DOS
- filename space. */
- val = concat2 (prefix, build_string ("a.XXX"));
-#else
- val = concat2 (prefix, build_string ("XXXXXX"));
-#endif
- mktemp (XSTRING (val)->data);
-#ifdef DOS_NT
- CORRECT_DIR_SEPS (XSTRING (val)->data);
-#endif
- return val;
+ return make_temp_name (prefix, 0);
}
+
+
\f
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
"Convert filename NAME to absolute, and canonicalize it.\n\
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;
#ifdef DOS_NT
int drive = 0;
int collapse_newdir = 1;
+ int is_escaped = 0;
#endif /* DOS_NT */
int length;
Lisp_Object handler;
/* 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))
{
is needed at all) without requiring it to be expanded now. */
#ifdef DOS_NT
/* Detect MSDOS file names with drive specifiers. */
- && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2])))
+ && ! (IS_DRIVE (o[0]) && IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2]))
#ifdef WINDOWSNT
/* Detect Windows file names in UNC format. */
&& ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1]))
a local copy to modify, even if there ends up being no change. */
nm = strcpy (alloca (strlen (nm) + 1), nm);
+ /* Note if special escape prefix is present, but remove for now. */
+ if (nm[0] == '/' && nm[1] == ':')
+ {
+ is_escaped = 1;
+ nm += 2;
+ }
+
/* Find and remove drive specifier if present; this makes nm absolute
- even if the rest of the name appears to be relative. */
- {
- unsigned char *colon = rindex (nm, ':');
-
- if (colon)
- /* Only recognize colon as part of drive specifier if there is a
- single alphabetic character preceeding the colon (and if the
- character before the drive letter, if present, is a directory
- separator); this is to support the remote system syntax used by
- ange-ftp, and the "po:username" syntax for POP mailboxes. */
- look_again:
- if (nm == colon)
- nm++;
- else if (IS_DRIVE (colon[-1])
- && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2])))
- {
- drive = colon[-1];
- nm = colon + 1;
- }
- else
- {
- while (--colon >= nm)
- if (colon[0] == ':')
- goto look_again;
- }
- }
+ even if the rest of the name appears to be relative. Only look for
+ drive specifier at the beginning. */
+ if (IS_DRIVE (nm[0]) && IS_DEVICE_SEP (nm[1]))
+ {
+ drive = nm[0];
+ nm += 2;
+ }
+
+#ifdef WINDOWSNT
+ /* If we see "c://somedir", we want to strip the first slash after the
+ 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
}
#endif
- /* If nm is absolute, look for /./ or /../ sequences; if none are
- found, we can probably return right away. We will avoid allocating
- a new string if name is already fully expanded. */
+ /* If nm is absolute, look for `/./' or `/../' or `//''sequences; if
+ none are found, we can probably return right away. We will avoid
+ allocating a new string if name is already fully expanded. */
if (
IS_DIRECTORY_SEP (nm[0])
#ifdef MSDOS
- && drive
+ && drive && !is_escaped
#endif
#ifdef WINDOWSNT
- && (drive || IS_DIRECTORY_SEP (nm[1]))
+ && (drive || IS_DIRECTORY_SEP (nm[1])) && !is_escaped
#endif
#ifdef VMS
|| index (nm, ':')
|| (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
|| p[3] == 0))))
lose = 1;
+ /* We want to replace multiple `/' in a row with a single
+ slash. */
+ else if (p > nm
+ && IS_DIRECTORY_SEP (p[0])
+ && IS_DIRECTORY_SEP (p[1]))
+ lose = 1;
+
#ifdef VMS
if (p[0] == '\\')
lose = 1;
&& !newdir)
{
newdir = XSTRING (default_directory)->data;
+#ifdef DOS_NT
+ /* Note if special escape prefix is present, but remove for now. */
+ if (newdir[0] == '/' && newdir[1] == ':')
+ {
+ is_escaped = 1;
+ newdir += 2;
+ }
+#endif
}
#ifdef DOS_NT
}
/* 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 / or // (an incomplete UNC name). */
length = strlen (newdir);
- if (IS_DIRECTORY_SEP (newdir[length - 1])
+ if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1])
#ifdef WINDOWSNT
&& !(length == 2 && IS_DIRECTORY_SEP (newdir[0]))
#endif
/* Now concatenate the directory and name to new space in the stack frame */
tlen += strlen (nm) + 1;
#ifdef DOS_NT
- /* Add reserved space for drive name. (The Microsoft x86 compiler
+ /* Reserve space for drive specifier and escape prefix, since either
+ or both may need to be inserted. (The Microsoft x86 compiler
produces incorrect code if the following two lines are combined.) */
- target = (unsigned char *) alloca (tlen + 2);
- target += 2;
+ target = (unsigned char *) alloca (tlen + 4);
+ target += 4;
#else /* not DOS_NT */
target = (unsigned char *) alloca (tlen);
#endif /* not DOS_NT */
{
#ifndef VMS
if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
- strcpy (target, newdir);
+ {
+#ifdef DOS_NT
+ /* If newdir is effectively "C:/", then the drive letter will have
+ been stripped and newdir will be "/". Concatenating with an
+ absolute directory in nm produces "//", which will then be
+ incorrectly treated as a network share. Ignore newdir in
+ this case (keeping the drive letter). */
+ if (!(drive && nm[0] && IS_DIRECTORY_SEP (newdir[0])
+ && newdir[1] == '\0'))
+#endif
+ strcpy (target, newdir);
+ }
else
#endif
file_name_as_directory (target, newdir);
/* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */
- /* Now canonicalize by removing /. and /foo/.. if they appear. */
+ /* Now canonicalize by removing `//', `/.' and `/foo/..' if they
+ appear. */
p = target;
o = target;
{
*o++ = *p++;
}
- 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 */
- && o != target
-#endif /* APOLLO || WINDOWSNT */
- )
- {
- o = target;
- p++;
- }
else if (IS_DIRECTORY_SEP (p[0])
&& p[1] == '.'
&& (IS_DIRECTORY_SEP (p[2])
{
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;
}
+ else if (p > target
+ && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
+ {
+ /* Collapse multiple `/' in a row. */
+ *o++ = *p++;
+ while (IS_DIRECTORY_SEP (*p))
+ ++p;
+ }
else
{
*o++ = *p++;
target[0] = DRIVE_LETTER (drive);
target[1] = ':';
}
+ /* Reinsert the escape prefix if required. */
+ if (is_escaped)
+ {
+ target -= 2;
+ target[0] = '/';
+ target[1] = ':';
+ }
CORRECT_DIR_SEPS (target);
#endif /* DOS_NT */
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 */
)
unsigned char *nm;
register unsigned char *s, *p, *o, *x, *endp;
- unsigned char *target;
+ unsigned char *target = NULL;
int total = 0;
int substituted = 0;
unsigned char *xnm;
CORRECT_DIR_SEPS (nm);
substituted = (strcmp (nm, XSTRING (filename)->data) != 0);
#endif
- endp = nm + XSTRING (filename)->size;
+ endp = nm + STRING_BYTES (XSTRING (filename));
- /* If /~ or // appears, discard everything through first slash. */
+ /* If /~ 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])
/* If substitution required, recopy the string and do it */
/* Make space in stack frame for the new copy */
- xnm = (unsigned char *) alloca (XSTRING (filename)->size + total + 1);
+ xnm = (unsigned char *) alloca (STRING_BYTES (XSTRING (filename)) + total + 1);
x = xnm;
/* Copy the rest of the name through, replacing $ constructs with values */
if (!o)
goto badvar;
- strcpy (x, o);
- x += strlen (o);
+ if (STRING_MULTIBYTE (filename))
+ {
+ /* If the original string is multibyte,
+ convert what we substitute into multibyte. */
+ while (*o)
+ {
+ int c = unibyte_char_to_multibyte (*o++);
+ x += CHAR_STRING (c, x);
+ }
+ }
+ else
+ {
+ strcpy (x, o);
+ x += strlen (o);
+ }
}
*x = 0;
- /* 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] == ':'
- && p > nm && IS_DIRECTORY_SEP (p[-1]))
+ && p > xnm && IS_DIRECTORY_SEP (p[-1]))
xnm = p;
#endif
- return make_string (xnm, x - xnm);
+ if (STRING_MULTIBYTE (filename))
+ return make_string (xnm, x - xnm);
+ return make_unibyte_string (xnm, x - xnm);
badsubst:
error ("Bad format environment-variable substitution");
/* NOTREACHED */
#endif /* not VMS */
+ return Qnil;
}
\f
/* A slightly faster and more convenient way to get
absname = Fexpand_file_name (filename, defdir);
#ifdef VMS
{
- register int c = XSTRING (absname)->data[XSTRING (absname)->size - 1];
+ register int c = XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1];
if (c == ':' || c == ']' || c == '>')
absname = Fdirectory_file_name (absname);
}
/* Remove final slash, if any (unless this is the root dir).
stat behaves differently depending! */
if (XSTRING (absname)->size > 1
- && IS_DIRECTORY_SEP (XSTRING (absname)->data[XSTRING (absname)->size - 1])
- && !IS_DEVICE_SEP (XSTRING (absname)->data[XSTRING (absname)->size-2]))
+ && IS_DIRECTORY_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname)) - 1])
+ && !IS_DEVICE_SEP (XSTRING (absname)->data[STRING_BYTES (XSTRING (absname))-2]))
/* We cannot take shortcuts; they might be wrong for magic file names. */
absname = Fdirectory_file_name (absname);
#endif
and bypass the error if the user says to go ahead.
QUERYSTRING is a name for the action that is being considered
to alter the file.
+
*STATPTR is used to store the stat information if the file exists.
- If the file does not exist, STATPTR->st_mode is set to 0. */
+ If the file does not exist, STATPTR->st_mode is set to 0.
+ If STATPTR is null, we don't store into it.
+
+ If QUICK is nonzero, we ask for y or n, not yes or no. */
void
-barf_or_query_if_file_exists (absname, querystring, interactive, statptr)
+barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick)
Lisp_Object absname;
unsigned char *querystring;
int interactive;
struct stat *statptr;
+ int quick;
{
- register Lisp_Object tem;
+ register Lisp_Object tem, encoded_filename;
struct stat statbuf;
struct gcpro gcpro1;
+ encoded_filename = ENCODE_FILE (absname);
+
/* stat is a good way to tell whether the file exists,
regardless of what access permissions it has. */
- if (stat (XSTRING (absname)->data, &statbuf) >= 0)
+ if (stat (XSTRING (encoded_filename)->data, &statbuf) >= 0)
{
if (! interactive)
Fsignal (Qfile_already_exists,
Fcons (build_string ("File already exists"),
Fcons (absname, Qnil)));
GCPRO1 (absname);
- tem = do_yes_or_no_p (format1 ("File %s already exists; %s anyway? ",
- XSTRING (absname)->data, querystring));
+ tem = format1 ("File %s already exists; %s anyway? ",
+ XSTRING (absname)->data, querystring);
+ if (quick)
+ tem = Fy_or_n_p (tem);
+ else
+ tem = do_yes_or_no_p (tem);
UNGCPRO;
if (NILP (tem))
Fsignal (Qfile_already_exists,
Fourth arg KEEP-TIME non-nil means give the new file the same\n\
last-modified time as the old one. (This works on only some systems.)\n\
A prefix arg makes KEEP-TIME non-nil.")
- (file, newname, ok_if_already_exists, keep_date)
- Lisp_Object file, newname, ok_if_already_exists, keep_date;
+ (file, newname, ok_if_already_exists, keep_time)
+ Lisp_Object file, newname, ok_if_already_exists, keep_time;
{
int ifd, ofd, n;
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);
handler = Ffind_file_name_handler (newname, Qcopy_file);
if (!NILP (handler))
RETURN_UNGCPRO (call5 (handler, Qcopy_file, file, newname,
- ok_if_already_exists, keep_date));
+ ok_if_already_exists, keep_time));
+
+ 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",
- INTEGERP (ok_if_already_exists), &out_st);
- else if (stat (XSTRING (newname)->data, &out_st) < 0)
+ barf_or_query_if_file_exists (encoded_newname, "copy to it",
+ INTEGERP (ok_if_already_exists), &out_st, 0);
+ else if (stat (XSTRING (encoded_newname)->data, &out_st) < 0)
out_st.st_mode = 0;
- ifd = open (XSTRING (file)->data, O_RDONLY);
+#ifdef WINDOWSNT
+ if (!CopyFile (XSTRING (encoded_file)->data,
+ XSTRING (encoded_newname)->data,
+ FALSE))
+ report_file_error ("Copying file", Fcons (file, Fcons (newname, Qnil)));
+ else if (NILP (keep_time))
+ {
+ EMACS_TIME now;
+ EMACS_GET_TIME (now);
+ if (set_file_times (XSTRING (encoded_newname)->data,
+ now, now))
+ Fsignal (Qfile_date_error,
+ Fcons (build_string ("Cannot set file date"),
+ Fcons (newname, Qnil)));
+ }
+#else /* not WINDOWSNT */
+ ifd = emacs_open (XSTRING (encoded_file)->data, O_RDONLY, 0);
if (ifd < 0)
report_file_error ("Opening input file", Fcons (file, Qnil));
copyable by us. */
input_file_statable_p = (fstat (ifd, &st) >= 0);
-#if !defined (MSDOS) || __DJGPP__ > 1
+#if !defined (DOS_NT) || __DJGPP__ > 1
if (out_st.st_mode != 0
&& st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
{
#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)
immediate_quit = 1;
QUIT;
- while ((n = read (ifd, buf, sizeof buf)) > 0)
- if (write (ofd, buf, n) != n)
+ while ((n = emacs_read (ifd, buf, sizeof buf)) > 0)
+ if (emacs_write (ofd, buf, n) != n)
report_file_error ("I/O error", Fcons (newname, Qnil));
immediate_quit = 0;
/* Closing the output clobbers the file times on some systems. */
- if (close (ofd) < 0)
+ if (emacs_close (ofd) < 0)
report_file_error ("I/O error", Fcons (newname, Qnil));
if (input_file_statable_p)
{
- if (!NILP (keep_date))
+ if (!NILP (keep_time))
{
EMACS_TIME atime, mtime;
EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
- if (set_file_times (XSTRING (newname)->data, atime, mtime))
+ if (set_file_times (XSTRING (encoded_newname)->data,
+ atime, mtime))
Fsignal (Qfile_date_error,
- Fcons (build_string ("File already exists"),
+ 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 */
}
- close (ifd);
+ emacs_close (ifd);
+#endif /* WINDOWSNT */
/* Discard the unwind protects. */
specpdl_ptr = specpdl + count;
{
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);
+
+#ifdef DOS_NT
+ /* If the file names are identical but for the case, don't ask for
+ confirmation: they simply want to change the letter-case of the
+ file name. */
+ if (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
+#endif
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
- barf_or_query_if_file_exists (newname, "rename to it",
- INTEGERP (ok_if_already_exists), 0);
+ barf_or_query_if_file_exists (encoded_newname, "rename to it",
+ INTEGERP (ok_if_already_exists), 0, 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",
- 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 */
+ barf_or_query_if_file_exists (encoded_newname, "make it a new name",
+ INTEGERP (ok_if_already_exists), 0, 0);
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",
- INTEGERP (ok_if_already_exists), 0);
- if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
+ barf_or_query_if_file_exists (encoded_linkname, "make it a link",
+ INTEGERP (ok_if_already_exists), 0, 0);
+ 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);
}
if (!NILP (handler))
return call2 (handler, Qfile_readable_p, absname);
-#ifdef DOS_NT
- /* Under MS-DOS and Windows, open does not work for directories. */
+ absname = ENCODE_FILE (absname);
+
+#if defined(DOS_NT) || defined(macintosh)
+ /* Under MS-DOS, Windows, and Macintosh, open does not work for
+ directories. */
if (access (XSTRING (absname)->data, 0) == 0)
return Qt;
return Qnil;
-#else /* not DOS_NT */
+#else /* not DOS_NT and not macintosh */
flags = O_RDONLY;
#if defined (S_ISFIFO) && defined (O_NONBLOCK)
/* Opening a fifo without O_NONBLOCK can wait.
if (S_ISFIFO (statbuf.st_mode))
flags |= O_NONBLOCK;
#endif
- desc = open (XSTRING (absname)->data, flags);
+ desc = emacs_open (XSTRING (absname)->data, flags, 0);
if (desc < 0)
return Qnil;
- close (desc);
+ emacs_close (desc);
return Qt;
-#endif /* not DOS_NT */
+#endif /* not DOS_NT and not macintosh */
}
/* Having this before file-symlink-p mysteriously caused it to be forgotten
(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);
+#ifdef WINDOWSNT
+ /* The read-only attribute of the parent directory doesn't affect
+ whether a file or directory can be created within it. Some day we
+ should check ACLs though, which do affect this. */
+ if (stat (XSTRING (dir)->data, &statbuf) < 0)
+ return Qnil;
+ return (statbuf.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
+#else
return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "")
? Qt : Qnil);
+#endif
}
\f
DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
(filename, string)
Lisp_Object filename, string;
{
- Lisp_Object handler;
+ Lisp_Object handler, encoded_filename;
int fd;
CHECK_STRING (filename, 0);
+ CHECK_STRING (string, 1);
/* If the file name has special constructs in it,
call the corresponding file handler. */
if (!NILP (handler))
return call3 (handler, Qaccess_file, filename, string);
- fd = open (XSTRING (filename)->data, O_RDONLY);
+ encoded_filename = ENCODE_FILE (filename);
+
+ fd = emacs_open (XSTRING (encoded_filename)->data, O_RDONLY, 0);
if (fd < 0)
report_file_error (XSTRING (string)->data, Fcons (filename, Qnil));
- close (fd);
+ emacs_close (fd);
return Qnil;
}
if (!NILP (handler))
return call2 (handler, Qfile_symlink_p, filename);
- bufsize = 100;
- while (1)
+ filename = ENCODE_FILE (filename);
+
+ bufsize = 50;
+ buf = NULL;
+ do
{
- buf = (char *) xmalloc (bufsize);
+ bufsize *= 2;
+ buf = (char *) xrealloc (buf, bufsize);
bzero (buf, bufsize);
+
+ errno = 0;
valsize = readlink (XSTRING (filename)->data, buf, bufsize);
- if (valsize < bufsize) break;
- /* Buffer was not long enough */
- xfree (buf);
- bufsize *= 2;
- }
- if (valsize == -1)
- {
- xfree (buf);
- return Qnil;
+ if (valsize == -1)
+ {
+#ifdef ERANGE
+ /* HP-UX reports ERANGE if buffer is too small. */
+ if (errno == ERANGE)
+ valsize = bufsize;
+ else
+#endif
+ {
+ xfree (buf);
+ return Qnil;
+ }
+ }
}
+ while (valsize >= bufsize);
+
val = make_string (buf, valsize);
+ if (buf[0] == '/' && index (buf, ':'))
+ val = concat2 (build_string ("/:"), val);
xfree (buf);
+ val = DECODE_FILE (val);
return val;
#else /* not S_IFLNK */
return Qnil;
}
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.\n\
+Symbolic links to directories count as directories.\n\
+See `file-symlink-p' to distinguish symlinks.")
(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);
+
+#ifdef WINDOWSNT
+ {
+ int result;
+ Lisp_Object tem = Vw32_get_true_file_attributes;
+
+ /* Tell stat to use expensive method to get accurate info. */
+ Vw32_get_true_file_attributes = Qt;
+ result = stat (XSTRING (absname)->data, &st);
+ Vw32_get_true_file_attributes = tem;
+
+ if (result < 0)
+ return Qnil;
+ return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
+ }
+#else
if (stat (XSTRING (absname)->data, &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
+#endif
}
\f
DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
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;
XSETINT (value, (~ realmask) & 0777);
return value;
}
+
\f
-#ifdef unix
+#ifdef __NetBSD__
+#define unix 42
+#endif
+#ifdef unix
DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
"Tell Unix to finish all pending disk updates.")
()
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;
#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\
-Returns list of absolute file name and length of data inserted.\n\
-If second argument VISIT is non-nil, the buffer's visited filename\n\
-and last save file modtime are set, and it is marked unmodified.\n\
-If visiting and the file does not exist, visiting is completed\n\
-before the error is signaled.\n\
-The optional third and fourth arguments BEG and END\n\
-specify what portion of the file to insert.\n\
-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.\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;
+extern void adjust_markers_for_delete P_ ((int, int, int, int));
+
+/* This function is called after Lisp functions to decide a coding
+ system are called, or when they cause an error. Before they are
+ called, the current buffer is set unibyte and it contains only a
+ newly inserted text (thus the buffer was empty before the
+ insertion).
+
+ The functions may set markers, overlays, text properties, or even
+ alter the buffer contents, change the current buffer.
+
+ Here, we reset all those changes by:
+ o set back the current buffer.
+ o move all markers and overlays to BEG.
+ o remove all text properties.
+ o set back the buffer multibyteness. */
+
+static Lisp_Object
+decide_coding_unwind (unwind_data)
+ Lisp_Object unwind_data;
{
- struct stat st;
- 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 multibyte, undo_list, buffer;
+
+ multibyte = XCAR (unwind_data);
+ unwind_data = XCDR (unwind_data);
+ undo_list = XCAR (unwind_data);
+ buffer = XCDR (unwind_data);
+
+ if (current_buffer != XBUFFER (buffer))
+ set_buffer_internal (XBUFFER (buffer));
+ adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE);
+ adjust_overlays_for_delete (BEG, Z - BEG);
+ BUF_INTERVALS (current_buffer) = 0;
+ TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
+
+ /* Now we are safe to change the buffer's multibyteness directly. */
+ current_buffer->enable_multibyte_characters = multibyte;
+ current_buffer->undo_list = undo_list;
+
+ return Qnil;
+}
+
+
+/* Used to pass values from insert-file-contents to read_non_regular. */
+
+static int non_regular_fd;
+static int non_regular_inserted;
+static int non_regular_nbytes;
+
+
+/* Read from a non-regular file.
+ Read non_regular_trytry bytes max from non_regular_fd.
+ Non_regular_inserted specifies where to put the read bytes.
+ Value is the number of bytes read. */
+
+static Lisp_Object
+read_non_regular ()
+{
+ int nbytes;
+
+ immediate_quit = 1;
+ QUIT;
+ nbytes = emacs_read (non_regular_fd,
+ BEG_ADDR + PT_BYTE - 1 + non_regular_inserted,
+ non_regular_nbytes);
+ Fsignal (Qquit, Qnil);
+ immediate_quit = 0;
+ return make_number (nbytes);
+}
+
+
+/* Condition-case handler used when reading from non-regular files
+ in insert-file-contents. */
+
+static Lisp_Object
+read_non_regular_quit ()
+{
+ return Qnil;
+}
+
+
+DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
+ 1, 5, 0,
+ "Insert contents of file FILENAME after point.\n\
+Returns list of absolute file name and number of bytes inserted.\n\
+If second argument VISIT is non-nil, the buffer's visited filename\n\
+and last save file modtime are set, and it is marked unmodified.\n\
+If visiting and the file does not exist, visiting is completed\n\
+before the error is signaled.\n\
+The optional third and fourth arguments BEG and END\n\
+specify what portion of the file to insert.\n\
+These arguments count bytes in the file, not characters in the buffer.\n\
+If VISIT is non-nil, BEG and END must be nil.\n\
+\n\
+If optional fifth argument REPLACE is non-nil,\n\
+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.\n\
+When REPLACE is non-nil, the value is the number of characters actually read,\n\
+which is often less than the number of characters to be read.\n\
+\n\
+This does code conversion according to the value of\n\
+`coding-system-for-read' or `file-coding-system-alist',\n\
+and sets the variable `last-coding-system-used' to the coding system\n\
+actually used.")
+ (filename, visit, beg, end, replace)
+ Lisp_Object filename, visit, beg, end, replace;
+{
+ struct stat st;
+ register int fd;
+ int inserted = 0;
+ register int how_much;
+ register int unprocessed;
+ int count = BINDING_STACK_SIZE ();
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ Lisp_Object handler, val, insval, orig_filename;
Lisp_Object p;
- int total;
+ int total = 0;
int not_regular = 0;
- char read_buf[READ_BUF_SIZE];
+ unsigned char read_buf[READ_BUF_SIZE];
struct coding_system coding;
unsigned char buffer[1 << 14];
int replace_handled = 0;
+ int set_coding_system = 0;
+ int coding_system_decided = 0;
+ int gap_size;
+ int read_quit = 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);
{
val = call6 (handler, Qinsert_file_contents, filename,
visit, beg, end, replace);
+ if (CONSP (val) && CONSP (XCDR (val)))
+ inserted = XINT (XCAR (XCDR (val)));
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);
- }
+ orig_filename = filename;
+ filename = ENCODE_FILE (filename);
fd = -1;
+#ifdef WINDOWSNT
+ {
+ Lisp_Object tem = Vw32_get_true_file_attributes;
+
+ /* Tell stat to use expensive method to get accurate info. */
+ Vw32_get_true_file_attributes = Qt;
+ total = stat (XSTRING (filename)->data, &st);
+ Vw32_get_true_file_attributes = tem;
+ }
+ if (total < 0)
+#else
#ifndef APOLLO
if (stat (XSTRING (filename)->data, &st) < 0)
#else
- if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0
+ if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0
|| fstat (fd, &st) < 0)
#endif /* not APOLLO */
+#endif /* WINDOWSNT */
{
- if (fd >= 0) close (fd);
+ if (fd >= 0) emacs_close (fd);
badopen:
if (NILP (visit))
- report_file_error ("Opening input file", Fcons (filename, Qnil));
+ report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
st.st_mtime = -1;
how_much = 0;
+ if (!NILP (Vcoding_system_for_read))
+ Fset (Qbuffer_file_coding_system, Vcoding_system_for_read);
goto notfound;
}
if (! NILP (replace) || ! NILP (beg) || ! NILP (end))
Fsignal (Qfile_error,
Fcons (build_string ("not a regular file"),
- Fcons (filename, Qnil)));
+ Fcons (orig_filename, Qnil)));
}
#endif
if (fd < 0)
- if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0)
+ if ((fd = emacs_open (XSTRING (filename)->data, O_RDONLY, 0)) < 0)
goto badopen;
/* Replacement should preserve point as it preserves markers. */
if (! not_regular && st.st_size < 0)
error ("File size is negative");
- if (!NILP (beg) || !NILP (end))
- if (!NILP (visit))
- error ("Attempt to visit less than an entire file");
+ /* Prevent redisplay optimizations. */
+ current_buffer->clip_changed = 1;
+
+ if (!NILP (visit))
+ {
+ if (!NILP (beg) || !NILP (end))
+ error ("Attempt to visit less than an entire file");
+ if (BEG < Z && NILP (replace))
+ error ("Cannot do file visiting in a non-empty buffer");
+ }
if (!NILP (beg))
CHECK_NUMBER (beg, 0);
if (! not_regular)
{
XSETINT (end, st.st_size);
- if (XINT (end) != st.st_size)
+
+ /* Arithmetic overflow can occur if an Emacs integer cannot
+ represent the file size, or if the calculations below
+ overflow. The calculations below double the file size
+ twice, so check that it can be multiplied by 4 safely. */
+ if (XINT (end) != st.st_size
+ || ((int) st.st_size * 4) / 4 != st.st_size)
error ("Maximum buffer size exceeded");
+
+ /* The file size returned from stat may be zero, but data
+ may be readable nonetheless, for example when this is a
+ file in the /proc filesystem. */
+ if (st.st_size == 0)
+ XSETINT (end, READ_BUF_SIZE);
}
}
+ if (BEG < Z)
+ {
+ /* Decide the coding system to use for reading the file now
+ because we can't use an optimized method for handling
+ `coding:' tag if the current buffer is not empty. */
+ Lisp_Object val;
+ val = Qnil;
+
+ if (!NILP (Vcoding_system_for_read))
+ val = Vcoding_system_for_read;
+ else if (! NILP (replace))
+ /* In REPLACE mode, we can use the same coding system
+ that was used to visit the file. */
+ val = current_buffer->buffer_file_coding_system;
+ else
+ {
+ /* Don't try looking inside a file for a coding system
+ specification if it is not seekable. */
+ if (! not_regular && ! NILP (Vset_auto_coding_function))
+ {
+ /* Find a coding system specified in the heading two
+ lines or in the tailing several lines of the file.
+ We assume that the 1K-byte and 3K-byte for heading
+ and tailing respectively are sufficient for this
+ purpose. */
+ int nread;
+
+ if (st.st_size <= (1024 * 4))
+ nread = emacs_read (fd, read_buf, 1024 * 4);
+ else
+ {
+ nread = emacs_read (fd, read_buf, 1024);
+ if (nread >= 0)
+ {
+ if (lseek (fd, st.st_size - (1024 * 3), 0) < 0)
+ report_file_error ("Setting file position",
+ Fcons (orig_filename, Qnil));
+ nread += emacs_read (fd, read_buf + nread, 1024 * 3);
+ }
+ }
+
+ if (nread < 0)
+ error ("IO error reading %s: %s",
+ XSTRING (orig_filename)->data, emacs_strerror (errno));
+ else if (nread > 0)
+ {
+ struct buffer *prev = current_buffer;
+ int count1;
+
+ record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+
+ /* The call to temp_output_buffer_setup binds
+ standard-output. */
+ count1 = specpdl_ptr - specpdl;
+ temp_output_buffer_setup (" *code-converting-work*");
+
+ set_buffer_internal (XBUFFER (Vstandard_output));
+ current_buffer->enable_multibyte_characters = Qnil;
+ insert_1_both (read_buf, nread, nread, 0, 0, 0);
+ TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
+ val = call2 (Vset_auto_coding_function,
+ filename, make_number (nread));
+ set_buffer_internal (prev);
+
+ /* Remove the binding for standard-output. */
+ unbind_to (count1, Qnil);
+
+ /* Discard the unwind protect for recovering the
+ current buffer. */
+ specpdl_ptr--;
+
+ /* Rewind the file for the actual read done later. */
+ if (lseek (fd, 0, 0) < 0)
+ report_file_error ("Setting file position",
+ Fcons (orig_filename, Qnil));
+ }
+ }
+
+ if (NILP (val))
+ {
+ /* If we have not yet decided a coding system, check
+ file-coding-system-alist. */
+ Lisp_Object args[6], coding_systems;
+
+ args[0] = Qinsert_file_contents, args[1] = orig_filename;
+ args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace;
+ coding_systems = Ffind_operation_coding_system (6, args);
+ if (CONSP (coding_systems))
+ val = XCAR (coding_systems);
+ }
+ }
+
+ setup_coding_system (Fcheck_coding_system (val), &coding);
+ /* Ensure we set Vlast_coding_system_used. */
+ set_coding_system = 1;
+
+ if (NILP (current_buffer->enable_multibyte_characters)
+ && ! NILP (val))
+ /* We must suppress all character code conversion except for
+ end-of-line conversion. */
+ setup_raw_text_coding_system (&coding);
+
+ coding.src_multibyte = 0;
+ coding.dst_multibyte
+ = !NILP (current_buffer->enable_multibyte_characters);
+ coding_system_decided = 1;
+ }
+
/* 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;
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_TEXT_CONVERSION (&coding))
- || (coding.eol_type == CODING_EOL_AUTOMATIC
- && ! CODING_REQUIRE_EOL_CONVERSION (&coding))))
+ && BEGV < ZV
+ && !(coding.common_flags & CODING_REQUIRE_DECODING_MASK))
{
- int same_at_start = BEGV;
- int same_at_end = ZV;
+ /* same_at_start and same_at_end count bytes,
+ because file access counts bytes
+ and BEG and END count bytes. */
+ int same_at_start = BEGV_BYTE;
+ int same_at_end = ZV_BYTE;
int overlap;
/* There is still a possibility we will find the need to do code
conversion. If that happens, we set this variable to 1 to
{
if (lseek (fd, XINT (beg), 0) < 0)
report_file_error ("Setting file position",
- Fcons (filename, Qnil));
+ Fcons (orig_filename, Qnil));
}
immediate_quit = 1;
{
int nread, bufpos;
- nread = read (fd, buffer, sizeof buffer);
+ nread = emacs_read (fd, buffer, sizeof buffer);
if (nread < 0)
error ("IO error reading %s: %s",
- XSTRING (filename)->data, strerror (errno));
+ XSTRING (orig_filename)->data, emacs_strerror (errno));
else if (nread == 0)
break;
- if (coding.type == coding_type_automatic)
+ if (coding.type == coding_type_undecided)
detect_coding (&coding, buffer, nread);
- if (CODING_REQUIRE_TEXT_CONVERSION (&coding))
+ if (coding.common_flags & CODING_REQUIRE_DECODING_MASK)
/* We found that the file should be decoded somehow.
Let's give up here. */
{
break;
}
- if (coding.eol_type == CODING_EOL_AUTOMATIC)
+ if (coding.eol_type == CODING_EOL_UNDECIDED)
detect_eol (&coding, buffer, nread);
- if (CODING_REQUIRE_EOL_CONVERSION (&coding))
+ 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. */
{
}
bufpos = 0;
- while (bufpos < nread && same_at_start < ZV
+ while (bufpos < nread && same_at_start < ZV_BYTE
&& FETCH_BYTE (same_at_start) == buffer[bufpos])
same_at_start++, bufpos++;
/* If we found a discrepancy, stop the scan.
immediate_quit = 0;
/* If the file matches the buffer completely,
there's no need to replace anything. */
- if (same_at_start - BEGV == XINT (end))
+ if (same_at_start - BEGV_BYTE == XINT (end))
{
- close (fd);
+ emacs_close (fd);
specpdl_ptr--;
/* Truncate the buffer to the size of the file. */
- del_range_1 (same_at_start, same_at_end, 0);
+ del_range_1 (same_at_start, same_at_end, 0, 0);
goto handled;
}
immediate_quit = 1;
int total_read, nread, bufpos, curpos, trial;
/* At what file position are we now scanning? */
- curpos = XINT (end) - (ZV - same_at_end);
+ curpos = XINT (end) - (ZV_BYTE - same_at_end);
/* If the entire file matches the buffer tail, stop the scan. */
if (curpos == 0)
break;
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;
+ total_read = nread = 0;
while (total_read < trial)
{
- nread = read (fd, buffer + total_read, trial - total_read);
- if (nread <= 0)
+ nread = emacs_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, emacs_strerror (errno));
+ else if (nread == 0)
+ break;
total_read += nread;
}
+
/* Scan this bufferful from the end, comparing with
the Emacs buffer. */
bufpos = total_read;
+
/* 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
we cannot use this method; giveup and try the other. */
if (same_at_end > same_at_start
&& FETCH_BYTE (same_at_end - 1) >= 0200
- && ! NILP (current_buffer->enable_multibyte_characters))
+ && ! NILP (current_buffer->enable_multibyte_characters)
+ && (CODING_MAY_REQUIRE_DECODING (&coding)))
giveup_match_end = 1;
break;
}
+
+ if (nread == 0)
+ break;
}
immediate_quit = 0;
if (! giveup_match_end)
{
+ int temp;
+
/* We win! We can handle REPLACE the optimized way. */
+ /* Extend the start of non-matching text area to multibyte
+ character boundary. */
+ if (! NILP (current_buffer->enable_multibyte_characters))
+ while (same_at_start > BEGV_BYTE
+ && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
+ same_at_start--;
+
+ /* Extend the end of non-matching text area to multibyte
+ character boundary. */
+ if (! NILP (current_buffer->enable_multibyte_characters))
+ while (same_at_end < ZV_BYTE
+ && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
+ same_at_end++;
+
/* Don't try to reuse the same piece of text twice. */
- overlap = same_at_start - BEGV - (same_at_end + st.st_size - ZV);
+ overlap = (same_at_start - BEGV_BYTE
+ - (same_at_end + st.st_size - ZV));
if (overlap > 0)
same_at_end += overlap;
/* Arrange to read only the nonmatching middle part of the file. */
- XSETFASTINT (beg, XINT (beg) + (same_at_start - BEGV));
- XSETFASTINT (end, XINT (end) - (ZV - same_at_end));
+ XSETFASTINT (beg, XINT (beg) + (same_at_start - BEGV_BYTE));
+ XSETFASTINT (end, XINT (end) - (ZV_BYTE - same_at_end));
- del_range_1 (same_at_start, same_at_end, 0);
+ del_range_byte (same_at_start, same_at_end, 0);
/* Insert from the file at the proper position. */
- SET_PT (same_at_start);
+ temp = BYTE_TO_CHAR (same_at_start);
+ SET_PT_BOTH (temp, same_at_start);
/* If display currently starts at beginning of line,
keep it that way. */
is needed, in a simple way that needs a lot of memory.
The preceding if-statement handles the case of no conversion
in a more optimized way. */
- if (!NILP (replace) && ! replace_handled)
+ if (!NILP (replace) && ! replace_handled && BEGV < ZV)
{
- int same_at_start = BEGV;
- int same_at_end = ZV;
+ int same_at_start = BEGV_BYTE;
+ int same_at_end = ZV_BYTE;
int overlap;
int bufpos;
/* Make sure that the gap is large enough. */
int bufsize = 2 * st.st_size;
- unsigned char *conversion_buffer = (unsigned char *) malloc (bufsize);
+ unsigned char *conversion_buffer = (unsigned char *) xmalloc (bufsize);
+ int temp;
/* First read the whole file, performing code conversion into
CONVERSION_BUFFER. */
if (lseek (fd, XINT (beg), 0) < 0)
{
- free (conversion_buffer);
+ xfree (conversion_buffer);
report_file_error ("Setting file position",
- Fcons (filename, Qnil));
+ Fcons (orig_filename, Qnil));
}
total = st.st_size; /* Total bytes in the file. */
{
/* try is reserved in some compilers (Microsoft C) */
int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed);
- char *destination = read_buf + unprocessed;
+ unsigned char *destination = read_buf + unprocessed;
int this;
/* Allow quitting out of the actual I/O. */
immediate_quit = 1;
QUIT;
- this = read (fd, destination, trytry);
+ this = emacs_read (fd, destination, trytry);
immediate_quit = 0;
if (this < 0 || this + unprocessed == 0)
how_much += this;
- if (CODING_REQUIRE_CONVERSION (&coding))
+ if (CODING_MAY_REQUIRE_DECODING (&coding))
{
- int require, produced, consumed;
+ int require, result;
this += unprocessed;
if (inserted + require + 2 * (total - how_much) > bufsize)
{
bufsize = inserted + require + 2 * (total - how_much);
- conversion_buffer = (unsigned char *) realloc (conversion_buffer, bufsize);
+ 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);
+ coding.mode |= CODING_MODE_LAST_BLOCK;
+ if (coding.composing != COMPOSITION_DISABLED)
+ coding_allocate_composition_data (&coding, BEGV);
+ result = decode_coding (&coding, read_buf,
+ conversion_buffer + inserted,
+ this, bufsize - inserted);
/* Save for next iteration whatever we didn't convert. */
- unprocessed = this - consumed;
- bcopy (read_buf + consumed, read_buf, unprocessed);
- this = produced;
+ unprocessed = this - coding.consumed;
+ bcopy (read_buf + coding.consumed, read_buf, unprocessed);
+ if (!NILP (current_buffer->enable_multibyte_characters))
+ this = coding.produced;
+ else
+ this = str_as_unibyte (conversion_buffer + inserted,
+ coding.produced);
}
inserted += this;
}
- /* At this point, INSERTED is how many characters
+ /* At this point, INSERTED is how many characters (i.e. bytes)
are present in CONVERSION_BUFFER.
HOW_MUCH should equal TOTAL,
or should be <= 0 if we couldn't read the file. */
if (how_much < 0)
{
- free (conversion_buffer);
+ xfree (conversion_buffer);
if (how_much == -1)
error ("IO error reading %s: %s",
- XSTRING (filename)->data, strerror (errno));
+ XSTRING (orig_filename)->data, emacs_strerror (errno));
else if (how_much == -2)
error ("maximum buffer size exceeded");
}
if (bufpos == inserted)
{
- free (conversion_buffer);
- close (fd);
+ xfree (conversion_buffer);
+ emacs_close (fd);
specpdl_ptr--;
/* Truncate the buffer to the size of the file. */
- del_range_1 (same_at_start, same_at_end, 0);
+ del_range_byte (same_at_start, same_at_end, 0);
+ inserted = 0;
goto handled;
}
+ /* Extend the start of non-matching text area to multibyte
+ character boundary. */
+ if (! NILP (current_buffer->enable_multibyte_characters))
+ while (same_at_start > BEGV_BYTE
+ && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start)))
+ same_at_start--;
+
/* Scan this bufferful from the end, comparing with
the Emacs buffer. */
bufpos = inserted;
&& FETCH_BYTE (same_at_end - 1) == conversion_buffer[bufpos - 1])
same_at_end--, bufpos--;
+ /* Extend the end of non-matching text area to multibyte
+ character boundary. */
+ if (! NILP (current_buffer->enable_multibyte_characters))
+ while (same_at_end < ZV_BYTE
+ && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end)))
+ same_at_end++;
+
/* Don't try to reuse the same piece of text twice. */
- overlap = same_at_start - BEGV - (same_at_end + inserted - ZV);
+ overlap = same_at_start - BEGV_BYTE - (same_at_end + inserted - ZV_BYTE);
if (overlap > 0)
same_at_end += overlap;
/* Replace the chars that we need to replace,
and update INSERTED to equal the number of bytes
we are taking from the file. */
- inserted -= (Z - same_at_end) + (same_at_start - BEG);
- move_gap (same_at_start);
- del_range_1 (same_at_start, same_at_end, 0);
- insert (conversion_buffer + same_at_start - BEG, inserted);
+ inserted -= (Z_BYTE - same_at_end) + (same_at_start - BEG_BYTE);
- free (conversion_buffer);
- close (fd);
+ if (same_at_end != same_at_start)
+ {
+ del_range_byte (same_at_start, same_at_end, 0);
+ temp = GPT;
+ same_at_start = GPT_BYTE;
+ }
+ else
+ {
+ temp = BYTE_TO_CHAR (same_at_start);
+ }
+ /* Insert from the file at the proper position. */
+ SET_PT_BOTH (temp, same_at_start);
+ insert_1 (conversion_buffer + same_at_start - BEG_BYTE, inserted,
+ 0, 0, 0);
+ if (coding.cmp_data && coding.cmp_data->used)
+ coding_restore_composition (&coding, Fcurrent_buffer ());
+ coding_free_composition_data (&coding);
+
+ /* Set `inserted' to the number of inserted characters. */
+ inserted = PT - temp;
+
+ xfree (conversion_buffer);
+ emacs_close (fd);
specpdl_ptr--;
goto handled;
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. */
+ far for a regular file, and not changed for a special file. But,
+ before exiting the loop, it is set to a negative value if I/O
+ error occurs. */
how_much = 0;
+
/* Total bytes inserted. */
inserted = 0;
- /* Bytes not processed in the previous loop because short gap size. */
- unprocessed = 0;
- while (how_much < total)
- {
+
+ /* Here, we don't do code conversion in the loop. It is done by
+ code_convert_region after all data are read into the buffer. */
+ {
+ int gap_size = GAP_SIZE;
+
+ while (how_much < total)
+ {
/* try is reserved in some compilers (Microsoft C) */
- int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed);
- char *destination = (CODING_REQUIRE_CONVERSION (&coding)
- ? read_buf + unprocessed
- : (char *) (POS_ADDR (PT + inserted - 1) + 1));
- int this;
+ int trytry = min (total - how_much, READ_BUF_SIZE);
+ int this;
- /* Allow quitting out of the actual I/O. */
- immediate_quit = 1;
- QUIT;
- this = read (fd, destination, trytry);
- immediate_quit = 0;
+ if (not_regular)
+ {
+ Lisp_Object val;
- if (this < 0 || this + unprocessed == 0)
- {
- how_much = this;
- break;
- }
+ /* Maybe make more room. */
+ if (gap_size < trytry)
+ {
+ make_gap (total - gap_size);
+ gap_size = GAP_SIZE;
+ }
- /* 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;
+ /* Read from the file, capturing `quit'. When an
+ error occurs, end the loop, and arrange for a quit
+ to be signaled after decoding the text we read. */
+ non_regular_fd = fd;
+ non_regular_inserted = inserted;
+ non_regular_nbytes = trytry;
+ val = internal_condition_case_1 (read_non_regular, Qnil, Qerror,
+ read_non_regular_quit);
+ if (NILP (val))
+ {
+ read_quit = 1;
+ break;
+ }
- if (CODING_REQUIRE_CONVERSION (&coding))
- {
- int require, produced, consumed;
+ this = XINT (val);
+ }
+ else
+ {
+ /* Allow quitting out of the actual I/O. We don't make text
+ part of the buffer until all the reading is done, so a C-g
+ here doesn't do any harm. */
+ immediate_quit = 1;
+ QUIT;
+ this = emacs_read (fd, BEG_ADDR + PT_BYTE - 1 + inserted, trytry);
+ immediate_quit = 0;
+ }
+
+ if (this <= 0)
+ {
+ how_much = this;
+ break;
+ }
- 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);
+ gap_size -= this;
- if (! not_regular)
- {
- if (how_much >= total) /* This is the last block. */
- coding.last_block = 1;
- }
- else
+ /* 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;
+ inserted += this;
+ }
+ }
+
+ /* Make the text read part of the buffer. */
+ GAP_SIZE -= inserted;
+ GPT += inserted;
+ GPT_BYTE += inserted;
+ ZV += inserted;
+ ZV_BYTE += inserted;
+ Z += inserted;
+ Z_BYTE += inserted;
+
+ if (GAP_SIZE > 0)
+ /* Put an anchor to ensure multi-byte form ends at gap. */
+ *GPT_ADDR = 0;
+
+ emacs_close (fd);
+
+ /* Discard the unwind protect for closing the file. */
+ specpdl_ptr--;
+
+ if (how_much < 0)
+ error ("IO error reading %s: %s",
+ XSTRING (orig_filename)->data, emacs_strerror (errno));
+
+ notfound:
+
+ if (! coding_system_decided)
+ {
+ /* The coding system is not yet decided. Decide it by an
+ optimized method for handling `coding:' tag.
+
+ Note that we can get here only if the buffer was empty
+ before the insertion. */
+ Lisp_Object val;
+ val = Qnil;
+
+ if (!NILP (Vcoding_system_for_read))
+ val = Vcoding_system_for_read;
+ else
+ {
+ /* Since we are sure that the current buffer was empty
+ before the insertion, we can toggle
+ enable-multibyte-characters directly here without taking
+ care of marker adjustment and byte combining problem. By
+ this way, we can run Lisp program safely before decoding
+ the inserted text. */
+ Lisp_Object unwind_data;
+ int count = specpdl_ptr - specpdl;
+
+ unwind_data = Fcons (current_buffer->enable_multibyte_characters,
+ Fcons (current_buffer->undo_list,
+ Fcurrent_buffer ()));
+ current_buffer->enable_multibyte_characters = Qnil;
+ current_buffer->undo_list = Qt;
+ record_unwind_protect (decide_coding_unwind, unwind_data);
+
+ if (inserted > 0 && ! NILP (Vset_auto_coding_function))
{
- /* If we encounter EOF, say it is the last block. (The
- data this will apply to is the UNPROCESSED characters
- carried over from the last batch.) */
- if (this == 0)
- coding.last_block = 1;
+ val = call2 (Vset_auto_coding_function,
+ filename, make_number (inserted));
}
- produced = decode_coding (&coding, read_buf,
- POS_ADDR (PT + inserted - 1) + 1,
- this, GAP_SIZE, &consumed);
- if (produced > 0)
+ if (NILP (val))
{
- Lisp_Object temp;
-
- XSET (temp, Lisp_Int, Z + produced);
- if (Z + produced != XINT (temp))
- {
- how_much = -2;
- break;
- }
+ /* If the coding system is not yet decided, check
+ file-coding-system-alist. */
+ Lisp_Object args[6], coding_systems;
+
+ args[0] = Qinsert_file_contents, args[1] = orig_filename;
+ args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil;
+ coding_systems = Ffind_operation_coding_system (6, args);
+ if (CONSP (coding_systems))
+ val = XCAR (coding_systems);
}
- unprocessed = this - consumed;
- bcopy (read_buf + consumed, read_buf, unprocessed);
- this = produced;
- }
- 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;
- }
+ unbind_to (count, Qnil);
+ inserted = Z_BYTE - BEG_BYTE;
+ }
- /* 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);
- if (NILP (current_buffer->buffer_file_type))
+ /* The following kludgy code is to avoid some compiler bug.
+ We can't simply do
+ setup_coding_system (val, &coding);
+ on some system. */
{
- int reduced_size
- = inserted - crlf_to_lf (inserted, POS_ADDR (PT - 1) + 1);
- ZV -= reduced_size;
- Z -= reduced_size;
- GPT -= reduced_size;
- GAP_SIZE += reduced_size;
- inserted -= reduced_size;
+ struct coding_system temp_coding;
+ setup_coding_system (val, &temp_coding);
+ bcopy (&temp_coding, &coding, sizeof coding);
}
- }
-#endif /* DOS_NT */
-#endif /* 0 */
+ /* Ensure we set Vlast_coding_system_used. */
+ set_coding_system = 1;
+
+ if (NILP (current_buffer->enable_multibyte_characters)
+ && ! NILP (val))
+ /* We must suppress all character code conversion except for
+ end-of-line conversion. */
+ setup_raw_text_coding_system (&coding);
+ coding.src_multibyte = 0;
+ coding.dst_multibyte
+ = !NILP (current_buffer->enable_multibyte_characters);
+ }
- if (inserted > 0)
+ if (!NILP (visit)
+ /* Can't do this if part of the buffer might be preserved. */
+ && NILP (replace)
+ && (coding.type == coding_type_no_conversion
+ || coding.type == coding_type_raw_text))
{
- record_insert (PT, inserted);
-
- /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
- offset_intervals (current_buffer, PT, inserted);
- MODIFF++;
+ /* Visiting a file with these coding system makes the buffer
+ unibyte. */
+ current_buffer->enable_multibyte_characters = Qnil;
+ coding.dst_multibyte = 0;
}
- close (fd);
-
- /* Discard the unwind protect for closing the file. */
- specpdl_ptr--;
+ if (inserted > 0 || coding.type == coding_type_ccl)
+ {
+ if (CODING_MAY_REQUIRE_DECODING (&coding))
+ {
+ code_convert_region (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
+ &coding, 0, 0);
+ inserted = coding.produced_char;
+ }
+ else
+ adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted,
+ inserted);
+ }
- 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");
+#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)
+ && ! CODING_REQUIRE_DECODING (&coding))
+ current_buffer->buffer_file_type = Qt;
+ else
+ current_buffer->buffer_file_type = Qnil;
+#endif
- notfound:
handled:
if (!NILP (visit))
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)));
-
- /* If visiting nonexistent file, return nil. */
- if (current_buffer->modtime == -1)
- report_file_error ("Opening input file", Fcons (filename, Qnil));
+ Fcons (orig_filename, Qnil)));
}
/* Decode file format */
if (inserted > 0)
{
+ int empty_undo_list_p = 0;
+
+ /* If we're anyway going to discard undo information, don't
+ record it in the first place. The buffer's undo list at this
+ point is either nil or t when visiting a file. */
+ if (!NILP (visit))
+ {
+ empty_undo_list_p = NILP (current_buffer->undo_list);
+ current_buffer->undo_list = Qt;
+ }
+
insval = call3 (Qformat_decode,
Qnil, make_number (inserted), visit);
CHECK_NUMBER (insval, 0);
inserted = XFASTINT (insval);
+
+ if (!NILP (visit))
+ current_buffer->undo_list = empty_undo_list_p ? Qnil : Qt;
}
- if (inserted > 0 && NILP (visit) && total > 0)
- signal_after_change (PT, 0, inserted);
+ if (set_coding_system)
+ Vlast_coding_system_used = coding.symbol;
- if (inserted > 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)))
{
- p = Vafter_insert_file_functions;
- if (!NILP (coding.post_read_conversion))
- p = Fcons (coding.post_read_conversion, p);
+ signal_after_change (PT, 0, inserted);
+ update_compositions (PT, PT, CHECK_BORDER);
+ }
- while (!NILP (p))
+ p = Vafter_insert_file_functions;
+ while (!NILP (p))
+ {
+ insval = call1 (Fcar (p), make_number (inserted));
+ if (!NILP (insval))
{
- insval = call1 (Fcar (p), make_number (inserted));
- if (!NILP (insval))
- {
- CHECK_NUMBER (insval, 0);
- inserted = XFASTINT (insval);
- }
- QUIT;
- p = Fcdr (p);
+ CHECK_NUMBER (insval, 0);
+ inserted = XFASTINT (insval);
}
+ QUIT;
+ p = Fcdr (p);
}
+ if (!NILP (visit)
+ && current_buffer->modtime == -1)
+ {
+ /* If visiting nonexistent file, return nil. */
+ report_file_error ("Opening input file", Fcons (orig_filename, Qnil));
+ }
+
+ if (read_quit)
+ Fsignal (Qquit, Qnil);
+
+ /* ??? Retval needs to be dealt with in all cases consistently. */
if (NILP (val))
- val = Fcons (filename,
+ val = Fcons (orig_filename,
Fcons (make_number (inserted),
Qnil));
RETURN_UNGCPRO (unbind_to (count, val));
}
\f
-static Lisp_Object build_annotations ();
+static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object,
+ Lisp_Object));
/* If build_annotations switched buffers, switch back to BUF.
Kill the temporary buffer that was selected in the meantime.
return Qnil;
}
-DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 6,
- "r\nFWrite region to file: ",
+DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7,
+ "r\nFWrite region to file: \ni\ni\ni\np",
"Write current region into specified file.\n\
When called from a program, takes three arguments:\n\
START, END and FILENAME. START and END are buffer positions.\n\
Optional fourth argument APPEND if non-nil means\n\
- append to existing file contents (if any).\n\
+ append to existing file contents (if any). If it is an integer,\n\
+ seek to that offset in the file before writing.\n\
Optional fifth argument VISIT if t means\n\
set the last-save-file-modtime of buffer to this file's modtime\n\
and mark buffer not modified.\n\
that means do not print the \"Wrote file\" message.\n\
The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
use for locking and unlocking, overriding FILENAME and VISIT.\n\
+The optional seventh arg MUSTBENEW, if non-nil, insists on a check\n\
+ for an existing file with the same name. If MUSTBENEW is `excl',\n\
+ that means to get an error if the file already exists; never overwrite.\n\
+ If MUSTBENEW is neither nil nor `excl', that means ask for\n\
+ confirmation before overwriting, but do go ahead and overwrite the file\n\
+ if the user confirms.\n\
Kludgy feature: if START is a string, then that string is written\n\
to the file, instead of any buffer contents, and END is ignored.\n\
+\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;
+`coding-system-for-write', `buffer-file-coding-system', or\n\
+`file-coding-system-alist', and sets the variable\n\
+`last-coding-system-used' to the coding system actually used.")
+
+ (start, end, filename, append, visit, lockname, mustbenew)
+ Lisp_Object start, end, filename, append, visit, lockname, mustbenew;
{
register int desc;
int failure;
- int save_errno;
+ int save_errno = 0;
unsigned char *fn;
struct stat st;
int tem;
Lisp_Object handler;
Lisp_Object visit_file;
Lisp_Object annotations;
- int visiting, quietly;
+ Lisp_Object encoded_filename;
+ int visiting = (EQ (visit, Qt) || STRINGP (visit));
+ int quietly = !NILP (visit);
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))
+ if (current_buffer->base_buffer && visiting)
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 the variable `buffer-file-coding-system' is set locally,
+ it means that the file was read with some kind of code
+ conversion or the variable is explicitly set by users. We
+ had better write it out with the same coding system even if
+ `enable-multibyte-characters' is nil.
+
+ If it is not set locally, we anyway have to convert EOL
+ format if the default value of `buffer-file-coding-system'
+ tells that it is not Unix-like (LF only) format. */
+ int using_default_coding = 0;
+ int force_raw_text = 0;
+
+ val = current_buffer->buffer_file_coding_system;
+ if (NILP (val)
+ || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil)))
+ {
+ val = Qnil;
+ if (NILP (current_buffer->enable_multibyte_characters))
+ force_raw_text = 1;
+ }
+
+ if (NILP (val))
+ {
+ /* Check file-coding-system-alist. */
+ Lisp_Object args[7], coding_systems;
+
+ args[0] = Qwrite_region; args[1] = start; args[2] = end;
+ args[3] = filename; args[4] = append; args[5] = visit;
+ args[6] = lockname;
+ coding_systems = Ffind_operation_coding_system (7, args);
+ if (CONSP (coding_systems) && !NILP (XCDR (coding_systems)))
+ val = XCDR (coding_systems);
+ }
+
+ if (NILP (val)
+ && !NILP (current_buffer->buffer_file_coding_system))
+ {
+ /* If we still have not decided a coding system, use the
+ default value of buffer-file-coding-system. */
+ val = current_buffer->buffer_file_coding_system;
+ using_default_coding = 1;
+ }
+
+ if (!force_raw_text
+ && !NILP (Ffboundp (Vselect_safe_coding_system_function)))
+ /* Confirm that VAL can surely encode the current region. */
+ val = call3 (Vselect_safe_coding_system_function, start, end, val);
+
+ setup_coding_system (Fcheck_coding_system (val), &coding);
+ if (coding.eol_type == CODING_EOL_UNDECIDED
+ && !using_default_coding)
+ {
+ if (! EQ (default_buffer_file_coding.symbol,
+ buffer_defaults.buffer_file_coding_system))
+ setup_coding_system (buffer_defaults.buffer_file_coding_system,
+ &default_buffer_file_coding);
+ if (default_buffer_file_coding.eol_type != CODING_EOL_UNDECIDED)
+ {
+ Lisp_Object subsidiaries;
+
+ coding.eol_type = default_buffer_file_coding.eol_type;
+ subsidiaries = Fget (coding.symbol, Qeol_type);
+ if (VECTORP (subsidiaries)
+ && XVECTOR (subsidiaries)->size == 3)
+ coding.symbol
+ = XVECTOR (subsidiaries)->contents[coding.eol_type];
+ }
+ }
+
+ if (force_raw_text)
+ setup_raw_text_coding_system (&coding);
+ goto done_setup_coding;
+ }
+
+ setup_coding_system (Fcheck_coding_system (val), &coding);
+
+ done_setup_coding:
+ if (!STRINGP (start) && !NILP (current_buffer->selective_display))
+ coding.mode |= CODING_MODE_SELECTIVE_DISPLAY;
+ }
+
+ Vlast_coding_system_used = coding.symbol;
+
filename = Fexpand_file_name (filename, Qnil);
+
+ if (! NILP (mustbenew) && !EQ (mustbenew, Qexcl))
+ barf_or_query_if_file_exists (filename, "overwrite", 1, 0, 1);
+
if (STRINGP (visit))
visit_file = Fexpand_file_name (visit, Qnil);
else
visit_file = filename;
UNGCPRO;
- visiting = (EQ (visit, Qt) || STRINGP (visit));
- quietly = !NILP (visit);
-
annotations = Qnil;
if (NILP (lockname))
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))
{
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)
{
+#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"), fn, Vuser_login_name);
+ 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 | buffer_file_type);
+ desc = emacs_open (fn, O_WRONLY | buffer_file_type, 0);
#else /* not DOS_NT */
- desc = open (fn, O_WRONLY);
+ desc = emacs_open (fn, O_WRONLY, 0);
#endif /* not DOS_NT */
- if (desc < 0 && (NILP (append) || errno == ENOENT) )
+ if (desc < 0 && (NILP (append) || errno == ENOENT))
#ifdef VMS
if (auto_saving) /* Overwrite any previous version of autosave file */
{
vms_truncate (fn); /* if fn exists, truncate to zero length */
- desc = open (fn, O_RDWR);
+ desc = emacs_open (fn, O_RDWR, 0);
if (desc < 0)
desc = creat_copy_attrs (STRINGP (current_buffer->filename)
? XSTRING (current_buffer->filename)->data : 0,
/* We can't make a new version;
try to truncate and rewrite existing version if any. */
vms_truncate (fn);
- desc = open (fn, O_RDWR);
+ desc = emacs_open (fn, O_RDWR, 0);
}
#endif
}
}
#else /* not VMS */
#ifdef DOS_NT
- desc = open (fn,
- O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type,
- S_IREAD | S_IWRITE);
+ desc = emacs_open (fn,
+ O_WRONLY | O_CREAT | buffer_file_type
+ | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC),
+ S_IREAD | S_IWRITE);
#else /* not DOS_NT */
- desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666);
+ desc = emacs_open (fn, O_WRONLY | O_TRUNC | O_CREAT
+ | (EQ (mustbenew, Qexcl) ? O_EXCL : 0),
+ auto_saving ? auto_save_mode_bits : 0666);
#endif /* not DOS_NT */
#endif /* not VMS */
- UNGCPRO;
-
if (desc < 0)
{
#ifdef CLASH_DETECTION
if (!auto_saving) unlock_file (lockname);
errno = save_errno;
#endif /* CLASH_DETECTION */
+ UNGCPRO;
report_file_error ("Opening output file", Fcons (filename, Qnil));
}
record_unwind_protect (close_file_unwind, make_number (desc));
- if (!NILP (append))
- if (lseek (desc, 0, 2) < 0)
- {
+ if (!NILP (append) && !NILP (Ffile_regular_p (filename)))
+ {
+ long ret;
+
+ if (NUMBERP (append))
+ ret = lseek (desc, XINT (append), 1);
+ else
+ ret = lseek (desc, 0, 2);
+ if (ret < 0)
+ {
#ifdef CLASH_DETECTION
- if (!auto_saving) unlock_file (lockname);
+ if (!auto_saving) unlock_file (lockname);
#endif /* CLASH_DETECTION */
- report_file_error ("Lseek error", Fcons (filename, Qnil));
- }
+ UNGCPRO;
+ report_file_error ("Lseek error", Fcons (filename, Qnil));
+ }
+ }
+
+ UNGCPRO;
#ifdef VMS
/*
*/
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')
+ {
+ int opoint = PT, opoint_byte = PT_BYTE;
+ scan_newline (PT, PT_BYTE, ZV, ZV_BYTE, 1, 0);
+ move_gap_both (PT, PT_BYTE);
+ SET_PT_BOTH (opoint, opoint_byte);
+ }
#endif
failure = 0;
if (STRINGP (start))
{
- failure = 0 > a_write (desc, XSTRING (start)->data,
- XSTRING (start)->size, 0, &annotations, &coding);
+ failure = 0 > a_write (desc, start, 0, XSTRING (start)->size,
+ &annotations, &coding);
save_errno = errno;
}
else if (XINT (start) != XINT (end))
{
- int nwritten = 0;
+ tem = CHAR_TO_BYTE (XINT (start));
+
if (XINT (start) < GPT)
{
- register int end1 = XINT (end);
- tem = XINT (start);
- failure = 0 > a_write (desc, POS_ADDR (tem),
- min (GPT, end1) - tem, tem, &annotations,
- &coding);
- nwritten += min (GPT, end1) - tem;
+ failure = 0 > a_write (desc, Qnil, XINT (start),
+ min (GPT, XINT (end)) - XINT (start),
+ &annotations, &coding);
save_errno = errno;
}
if (XINT (end) > GPT && !failure)
{
- tem = XINT (start);
- tem = max (tem, GPT);
- failure = 0 > a_write (desc, POS_ADDR (tem), XINT (end) - tem,
- tem, &annotations, &coding);
- nwritten += XINT (end) - tem;
+ tem = max (XINT (start), GPT);
+ failure = 0 > a_write (desc, Qnil, tem , XINT (end) - tem,
+ &annotations, &coding);
save_errno = errno;
}
}
else
{
/* If file was empty, still need to write the annotations */
- failure = 0 > a_write (desc, "", 0, XINT (start), &annotations, &coding);
+ coding.mode |= CODING_MODE_LAST_BLOCK;
+ failure = 0 > a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
save_errno = errno;
}
- if (coding.require_flushing)
+ if (CODING_REQUIRE_FLUSHING (&coding)
+ && !(coding.mode & CODING_MODE_LAST_BLOCK)
+ && ! failure)
{
/* We have to flush out a data. */
- coding.last_block = 1;
- failure = 0 > e_write (desc, "", 0, &coding);
+ coding.mode |= CODING_MODE_LAST_BLOCK;
+ failure = 0 > e_write (desc, Qnil, 0, 0, &coding);
save_errno = errno;
}
#endif
/* NFS can report a write failure now. */
- if (close (desc) < 0)
+ if (emacs_close (desc) < 0)
failure = 1, save_errno = errno;
#ifdef VMS
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,
+ emacs_strerror (save_errno));
if (visiting)
{
return Qnil;
if (!auto_saving)
- message ("Wrote %s", XSTRING (visit_file)->data);
+ message_with_string ("Wrote %s", visit_file, 1);
return Qnil;
}
-
+\f
Lisp_Object merge ();
DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
Lisp_Object p, res;
struct gcpro gcpro1, gcpro2;
Lisp_Object original_buffer;
+ int i;
XSETBUFFER (original_buffer, current_buffer);
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 */
p = Vauto_save_file_format;
else
p = current_buffer->file_format;
- while (!NILP (p))
+ for (i = 0; !NILP (p); p = Fcdr (p), ++i)
{
struct buffer *given_buffer = current_buffer;
+
Vwrite_region_annotations_so_far = annotations;
- res = call4 (Qformat_annotate_function, Fcar (p), start, end,
- original_buffer);
+
+ /* Value is either a list of annotations or nil if the function
+ has written annotations to a temporary buffer, which is now
+ current. */
+ res = call5 (Qformat_annotate_function, Fcar (p), start, end,
+ original_buffer, make_number (i));
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);
+
+ if (CONSP (res))
+ annotations = merge (annotations, res, Qcar_less_than_car);
}
/* At last, do the same for the function 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);
+ annotations = (current_buffer != given_buffer
+ ? res
+ : merge (annotations, res, Qcar_less_than_car));
}
UNGCPRO;
return annotations;
}
-
-/* Write to descriptor DESC the LEN characters starting at ADDR,
- assuming they start at position POS in the buffer.
+\f
+/* Write to descriptor DESC the NCHARS chars starting at POS of STRING.
+ If STRING is nil, POS is the character position in the current buffer.
Intersperse with them the annotations from *ANNOT
- (those which fall within the range of positions POS to POS + LEN),
+ which fall within the range of POS to POS + NCHARS,
each at its appropriate position.
- Modify *ANNOT by discarding elements as we output them.
+ We modify *ANNOT by discarding elements as we use them up.
+
The return value is negative in case of system call failure. */
-int
-a_write (desc, addr, len, pos, annot, coding)
+static int
+a_write (desc, string, pos, nchars, annot, coding)
int desc;
- register char *addr;
- register int len;
+ Lisp_Object string;
+ register int nchars;
int pos;
Lisp_Object *annot;
struct coding_system *coding;
{
Lisp_Object tem;
int nextpos;
- int lastpos = pos + len;
+ int lastpos = pos + nchars;
while (NILP (*annot) || CONSP (*annot))
{
tem = Fcar_safe (Fcar (*annot));
- if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos)
+ nextpos = pos - 1;
+ if (INTEGERP (tem))
nextpos = XFASTINT (tem);
- else
- return e_write (desc, addr, lastpos - pos, coding);
+
+ /* If there are no more annotations in this range,
+ output the rest of the range all at once. */
+ if (! (nextpos >= pos && nextpos <= lastpos))
+ return e_write (desc, string, pos, lastpos, coding);
+
+ /* Output buffer text up to the next annotation's position. */
if (nextpos > pos)
{
- if (0 > e_write (desc, addr, nextpos - pos, coding))
+ if (0 > e_write (desc, string, pos, nextpos, coding))
return -1;
- addr += nextpos - pos;
pos = nextpos;
}
+ /* Output the annotation. */
tem = Fcdr (Fcar (*annot));
if (STRINGP (tem))
{
- if (0 > e_write (desc, XSTRING (tem)->data, XSTRING (tem)->size,
- coding))
+ if (0 > e_write (desc, tem, 0, XSTRING (tem)->size, coding))
return -1;
}
*annot = Fcdr (*annot);
}
+ return 0;
}
#ifndef WRITE_BUF_SIZE
#define WRITE_BUF_SIZE (16 * 1024)
#endif
-int
-e_write (desc, addr, len, coding)
+/* Write text in the range START and END into descriptor DESC,
+ encoding them with coding system CODING. If STRING is nil, START
+ and END are character positions of the current buffer, else they
+ are indexes to the string STRING. */
+
+static int
+e_write (desc, string, start, end, coding)
int desc;
- register char *addr;
- register int len;
+ Lisp_Object string;
+ int start, end;
struct coding_system *coding;
{
+ register char *addr;
+ register int nbytes;
char buf[WRITE_BUF_SIZE];
- int produced, consumed;
+ int return_val = 0;
+
+ if (start >= end)
+ coding->composing = COMPOSITION_DISABLED;
+ if (coding->composing != COMPOSITION_DISABLED)
+ coding_save_composition (coding, start, end, string);
+
+ if (STRINGP (string))
+ {
+ addr = XSTRING (string)->data;
+ nbytes = STRING_BYTES (XSTRING (string));
+ coding->src_multibyte = STRING_MULTIBYTE (string);
+ }
+ else if (start < end)
+ {
+ /* It is assured that the gap is not in the range START and END-1. */
+ addr = CHAR_POS_ADDR (start);
+ nbytes = CHAR_TO_BYTE (end) - CHAR_TO_BYTE (start);
+ coding->src_multibyte
+ = !NILP (current_buffer->enable_multibyte_characters);
+ }
+ else
+ {
+ addr = "";
+ nbytes = 0;
+ coding->src_multibyte = 1;
+ }
/* We used to have a code for handling selective display here. But,
now it is handled within encode_coding. */
while (1)
{
- produced = encode_coding (coding, addr, buf, len, WRITE_BUF_SIZE,
- &consumed);
- len -= consumed, addr += consumed;
- if (produced == 0 && len > 0)
+ int result;
+
+ result = encode_coding (coding, addr, buf, nbytes, WRITE_BUF_SIZE);
+ if (coding->produced > 0)
{
- /* 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;
+ coding->produced -= emacs_write (desc, buf, coding->produced);
+ if (coding->produced)
+ {
+ return_val = -1;
+ break;
+ }
}
- if (produced > 0)
+ nbytes -= coding->consumed;
+ addr += coding->consumed;
+ if (result == CODING_FINISH_INSUFFICIENT_SRC
+ && nbytes > 0)
{
- produced -= write (desc, buf, produced);
- if (produced) return -1;
+ /* The source text ends by an incomplete multibyte form.
+ There's no way other than write it out as is. */
+ nbytes -= emacs_write (desc, addr, nbytes);
+ if (nbytes)
+ {
+ return_val = -1;
+ break;
+ }
}
- if (len <= 0)
+ if (nbytes <= 0)
break;
+ start += coding->consumed_char;
+ if (coding->cmp_data)
+ coding_adjust_composition_offset (coding, start);
}
- return 0;
-}
+ if (coding->cmp_data)
+ coding_free_composition_data (coding);
+
+ return return_val;
+}
+\f
DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
Sverify_visited_file_modtime, 1, 1, 0,
"Return t if last mod time of BUF's visited file matches what BUF records.\n\
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;
}
}
\f
Lisp_Object
-auto_save_error ()
+auto_save_error (error)
+ Lisp_Object error;
{
+ Lisp_Object args[3], msg;
+ int i, nbytes;
+ struct gcpro gcpro1;
+
ring_bell ();
- message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data);
- Fsleep_for (make_number (1), Qnil);
- message ("Autosaving...error!for %s", XSTRING (current_buffer->name)->data);
- Fsleep_for (make_number (1), Qnil);
- message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data);
- Fsleep_for (make_number (1), Qnil);
+
+ args[0] = build_string ("Auto-saving %s: %s");
+ args[1] = current_buffer->name;
+ args[2] = Ferror_message_string (error);
+ msg = Fformat (3, args);
+ GCPRO1 (msg);
+ nbytes = STRING_BYTES (XSTRING (msg));
+
+ for (i = 0; i < 3; ++i)
+ {
+ if (i == 0)
+ message2 (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));
+ else
+ message2_nolog (XSTRING (msg)->data, nbytes, STRING_MULTIBYTE (msg));
+ Fsleep_for (make_number (1), Qnil);
+ }
+
+ UNGCPRO;
return Qnil;
}
Lisp_Object
auto_save_1 ()
{
- unsigned char *fn;
struct stat st;
/* Get visited file's mode to become the auto save file's mode. */
- if (stat (XSTRING (current_buffer->filename)->data, &st) >= 0)
+ if (! NILP (current_buffer->filename)
+ && stat (XSTRING (current_buffer->filename)->data, &st) >= 0)
/* But make sure we can overwrite it later! */
auto_save_mode_bits = st.st_mode | 0600;
else
return
Fwrite_region (Qnil, Qnil,
current_buffer->auto_save_file_name,
- Qnil, Qlambda, Qnil);
+ Qnil, Qlambda, Qnil, Qnil);
}
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 (XCAR (stream)) << 16
+ | XFASTINT (XCDR (stream))));
+ pop_message ();
+ 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;
}
struct buffer *old = current_buffer, *b;
Lisp_Object tail, buf;
int auto_saved = 0;
- char *omessage = echo_area_glyphs;
- int omessage_length = echo_area_glyphs_length;
int do_handled_files;
Lisp_Object oquit;
- int listdesc;
+ FILE *stream;
+ Lisp_Object lispstream;
int count = specpdl_ptr - specpdl;
- int *ptr;
-
+ int orig_minibuffer_auto_raise = minibuffer_auto_raise;
+ int message_p = push_message ();
+
/* Ordinarily don't quit within this function,
but don't make it impossible to quit (in case we get hung in I/O). */
oquit = Vquit_flag;
if (STRINGP (Vauto_save_list_file_name))
{
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 */
+
+ /* Don't try to create the directory when shutting down Emacs,
+ because creating the directory might signal an error, and
+ that would leave Emacs in a strange state. */
+ if (!NILP (Vrun_hooks))
+ {
+ Lisp_Object dir;
+ dir = Ffile_name_directory (listfile);
+ if (NILP (Ffile_directory_p (dir)))
+ call2 (Qmake_directory, dir, Qt);
+ }
+
+ 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 (XCAR (lispstream), (EMACS_UINT)stream >> 16);
+ XSETFASTINT (XCDR (lispstream), (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
autosave perfectly ordinary files because it couldn't handle some
ange-ftp'd file. */
for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
- for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
+ for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail))
{
- buf = XCONS (XCONS (tail)->car)->cdr;
+ buf = XCDR (XCAR (tail));
b = XBUFFER (buf);
/* Record all the buffers that have auto save mode
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,
+ STRING_BYTES (XSTRING (b->filename)), 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,
+ STRING_BYTES (XSTRING (b->auto_save_file_name)), stream);
+ putc ('\n', stream);
}
if (!NILP (current_only)
&& NILP (no_message))
{
/* It has shrunk too much; turn off auto-saving here. */
- message ("Buffer %s has shrunk a lot; auto save turned off there",
- XSTRING (b->name)->data);
+ minibuffer_auto_raise = orig_minibuffer_auto_raise;
+ message_with_string ("Buffer %s has shrunk a lot; auto save turned off there",
+ b->name, 1);
+ minibuffer_auto_raise = 0;
/* Turn off auto-saving until there's a real save,
and prevent any more warnings. */
XSETINT (b->save_length, -1);
if (auto_saved && NILP (no_message))
{
- if (omessage)
+ if (message_p)
{
- sit_for (1, 0, 0, 0);
- message2 (omessage, omessage_length);
+ sit_for (1, 0, 0, 0, 0);
+ restore_message ();
}
else
message1 ("Auto-saving...done");
register int n;
int osize, count;
- osize = XSTRING (val)->size;
- /* Quote "$" as "$$" to get it past substitute-in-file-name */
+ osize = STRING_BYTES (XSTRING (val));
+
+ /* Count the number of $ characters. */
for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--)
if (*old++ == '$') count++;
if (count > 0)
{
old = XSTRING (val)->data;
- val = Fmake_string (make_number (osize + count), make_number (0));
+ val = make_uninit_multibyte_string (XSTRING (val)->size + count,
+ osize + count);
new = XSTRING (val)->data;
for (n = osize; n > 0; n--)
if (*old != '$')
Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
Non-nil and non-t means also require confirmation after completion.\n\
Fifth arg INITIAL specifies text to start with.\n\
-DIR defaults to current buffer's directory default.")
+DIR defaults to current buffer's directory default.\n\
+\n\
+If this command was invoked with the mouse, use a file dialog box if\n\
+`use-dialog-box' is non-nil, and the window system or X toolkit in use\n\
+provides a file dialog box..")
(prompt, dir, default_filename, mustmatch, initial)
Lisp_Object prompt, dir, default_filename, mustmatch, initial;
{
- Lisp_Object val, insdef, insdef1, tem;
+ Lisp_Object val, insdef, tem;
struct gcpro gcpro1, gcpro2;
register char *homedir;
+ int replace_in_history = 0;
+ int add_to_history = 0;
int count;
if (NILP (dir))
/* If dir starts with user's homedir, change that to ~. */
homedir = (char *) egetenv ("HOME");
#ifdef DOS_NT
- homedir = strcpy (alloca (strlen (homedir) + 1), homedir);
- CORRECT_DIR_SEPS (homedir);
+ /* homedir can be NULL in temacs, since Vprocess_environment is not
+ yet set up. We shouldn't crash in that case. */
+ if (homedir != 0)
+ {
+ homedir = strcpy (alloca (strlen (homedir) + 1), homedir);
+ CORRECT_DIR_SEPS (homedir);
+ }
#endif
if (homedir != 0
&& STRINGP (dir)
&& IS_DIRECTORY_SEP (XSTRING (dir)->data[strlen (homedir)]))
{
dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
- XSTRING (dir)->size - strlen (homedir) + 1);
+ STRING_BYTES (XSTRING (dir)) - strlen (homedir) + 1);
XSTRING (dir)->data[0] = '~';
}
+ /* Likewise for default_filename. */
+ if (homedir != 0
+ && STRINGP (default_filename)
+ && !strncmp (homedir, XSTRING (default_filename)->data, strlen (homedir))
+ && IS_DIRECTORY_SEP (XSTRING (default_filename)->data[strlen (homedir)]))
+ {
+ default_filename
+ = make_string (XSTRING (default_filename)->data + strlen (homedir) - 1,
+ STRING_BYTES (XSTRING (default_filename)) - strlen (homedir) + 1);
+ XSTRING (default_filename)->data[0] = '~';
+ }
+ if (!NILP (default_filename))
+ {
+ CHECK_STRING (default_filename, 3);
+ default_filename = double_dollars (default_filename);
+ }
if (insert_default_directory && STRINGP (dir))
{
args[1] = initial;
insdef = Fconcat (2, args);
pos = make_number (XSTRING (double_dollars (dir))->size);
- insdef1 = Fcons (double_dollars (insdef), pos);
+ insdef = Fcons (double_dollars (insdef), pos);
}
else
- insdef1 = double_dollars (insdef);
+ insdef = double_dollars (insdef);
}
else if (STRINGP (initial))
- {
- insdef = initial;
- insdef1 = Fcons (double_dollars (insdef), 0);
- }
+ insdef = Fcons (double_dollars (initial), make_number (0));
else
- insdef = Qnil, insdef1 = Qnil;
+ insdef = Qnil;
-#ifdef VMS
count = specpdl_ptr - specpdl;
+#ifdef VMS
specbind (intern ("completion-ignore-case"), Qt);
#endif
- GCPRO2 (insdef, default_filename);
- val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
- dir, mustmatch, insdef1,
- Qfile_name_history);
+ specbind (intern ("minibuffer-completing-file-name"), Qt);
-#ifdef VMS
- unbind_to (count, Qnil);
+ GCPRO2 (insdef, default_filename);
+
+#if defined (USE_MOTIF) || defined (HAVE_NTGUI)
+ if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+ && use_dialog_box
+ && have_menus_p ())
+ {
+ /* If DIR contains a file name, split it. */
+ Lisp_Object file;
+ file = Ffile_name_nondirectory (dir);
+ if (XSTRING (file)->size && NILP (default_filename))
+ {
+ default_filename = file;
+ dir = Ffile_name_directory (dir);
+ }
+ if (!NILP(default_filename))
+ default_filename = Fexpand_file_name (default_filename, dir);
+ val = Fx_file_dialog (prompt, dir, default_filename, mustmatch);
+ add_to_history = 1;
+ }
+ else
#endif
+ val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
+ dir, mustmatch, insdef,
+ Qfile_name_history, default_filename, Qnil);
+
+ tem = Fsymbol_value (Qfile_name_history);
+ if (CONSP (tem) && EQ (XCAR (tem), val))
+ replace_in_history = 1;
+
+ /* If Fcompleting_read returned the inserted default string itself
+ (rather than a new string with the same contents),
+ it has to mean that the user typed RET with the minibuffer empty.
+ In that case, we really want to return ""
+ so that commands such as set-visited-file-name can distinguish. */
+ if (EQ (val, default_filename))
+ {
+ /* In this case, Fcompleting_read has not added an element
+ to the history. Maybe we should. */
+ if (! replace_in_history)
+ add_to_history = 1;
+
+ val = build_string ("");
+ }
+ unbind_to (count, Qnil);
UNGCPRO;
if (NILP (val))
error ("No file name specified");
- tem = Fstring_equal (val, insdef);
+
+ tem = Fstring_equal (val, CONSP (insdef) ? XCAR (insdef) : insdef);
+
if (!NILP (tem) && !NILP (default_filename))
- return default_filename;
- if (XSTRING (val)->size == 0 && NILP (insdef))
+ val = default_filename;
+ else if (XSTRING (val)->size == 0 && NILP (insdef))
{
if (!NILP (default_filename))
- return default_filename;
+ val = default_filename;
else
error ("No default file name");
}
- return Fsubstitute_in_file_name (val);
-}
+ val = Fsubstitute_in_file_name (val);
-#if 0 /* Old version */
-DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
- /* Don't confuse make-docfile by having two doc strings for this function.
- make-docfile does not pay attention to #if, for good reason! */
- 0)
- (prompt, dir, defalt, mustmatch, initial)
- Lisp_Object prompt, dir, defalt, mustmatch, initial;
-{
- Lisp_Object val, insdef, tem;
- struct gcpro gcpro1, gcpro2;
- register char *homedir;
- int count;
-
- if (NILP (dir))
- dir = current_buffer->directory;
- if (NILP (defalt))
- defalt = current_buffer->filename;
-
- /* If dir starts with user's homedir, change that to ~. */
- homedir = (char *) egetenv ("HOME");
- if (homedir != 0
- && STRINGP (dir)
- && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
- && XSTRING (dir)->data[strlen (homedir)] == '/')
+ if (replace_in_history)
+ /* Replace what Fcompleting_read added to the history
+ with what we will actually return. */
+ XCAR (Fsymbol_value (Qfile_name_history)) = double_dollars (val);
+ else if (add_to_history)
{
- dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
- XSTRING (dir)->size - strlen (homedir) + 1);
- XSTRING (dir)->data[0] = '~';
+ /* Add the value to the history--but not if it matches
+ the last value already there. */
+ Lisp_Object val1 = double_dollars (val);
+ tem = Fsymbol_value (Qfile_name_history);
+ if (! CONSP (tem) || NILP (Fequal (XCAR (tem), val1)))
+ Fset (Qfile_name_history,
+ Fcons (val1, tem));
}
+
+ return val;
+}
- if (!NILP (initial))
- insdef = initial;
- else if (insert_default_directory)
- insdef = dir;
- else
- insdef = build_string ("");
-
-#ifdef VMS
- count = specpdl_ptr - specpdl;
- specbind (intern ("completion-ignore-case"), Qt);
-#endif
-
- GCPRO2 (insdef, defalt);
- val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
- dir, mustmatch,
- insert_default_directory ? insdef : Qnil,
- Qfile_name_history);
-
-#ifdef VMS
- unbind_to (count, Qnil);
-#endif
-
- UNGCPRO;
- if (NILP (val))
- error ("No file name specified");
- tem = Fstring_equal (val, insdef);
- if (!NILP (tem) && !NILP (defalt))
- return defalt;
- return Fsubstitute_in_file_name (val);
+\f
+void
+init_fileio_once ()
+{
+ /* Must be set before any path manipulation is performed. */
+ XSETFASTINT (Vdirectory_sep_char, '/');
}
-#endif /* Old version */
+
\f
+void
syms_of_fileio ()
{
Qexpand_file_name = intern ("expand-file-name");
Qfile_name_as_directory = intern ("file-name-as-directory");
Qcopy_file = intern ("copy-file");
Qmake_directory_internal = intern ("make-directory-internal");
+ Qmake_directory = intern ("make-directory");
Qdelete_directory = intern ("delete-directory");
Qdelete_file = intern ("delete-file");
Qrename_file = intern ("rename-file");
staticpro (&Qfile_name_as_directory);
staticpro (&Qcopy_file);
staticpro (&Qmake_directory_internal);
+ staticpro (&Qmake_directory);
staticpro (&Qdelete_directory);
staticpro (&Qdelete_file);
staticpro (&Qrename_file);
staticpro (&Qfile_already_exists);
Qfile_date_error = intern ("file-date-error");
staticpro (&Qfile_date_error);
+ Qexcl = intern ("excl");
+ staticpro (&Qexcl);
#ifdef DOS_NT
Qfind_buffer_file_type = intern ("find-buffer-file-type");
staticpro (&Qfind_buffer_file_type);
#endif /* DOS_NT */
+ DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system,
+ "*Coding system for encoding file names.\n\
+If it is nil, default-file-name-coding-system (which see) is used.");
+ Vfile_name_coding_system = Qnil;
+
+ DEFVAR_LISP ("default-file-name-coding-system",
+ &Vdefault_file_name_coding_system,
+ "Default coding system for encoding file names.\n\
+This variable is used only when file-name-coding-system is nil.\n\
+\n\
+This variable is set/changed by the command set-language-environment.\n\
+User should not set this variable manually,\n\
+instead use file-name-coding-system to get a constant encoding\n\
+of file names regardless of the current language environment.");
+ Vdefault_file_name_coding_system = Qnil;
+
DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format,
"*Format in which to write auto-save files.\n\
Should be a list of symbols naming formats that are defined in `format-alist'.\n\
The value should be either ?/ or ?\\ (any other value is treated as ?\\).\n\
This variable affects the built-in functions only on Windows,\n\
on other platforms, it is initialized so that Lisp code can find out\n\
-what the normal separator is.");
- Vdirectory_sep_char = '/';
+what the normal separator is.\n\
+\n\
+WARNING: This variable is deprecated and will be removed in the near\n\
+future. DO NOT USE IT.");
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\
+Two arguments are passed to this function: the file name\n\
+and the length of a file contents following the point.\n\
+This function should return a coding system to decode the file contents.\n\
+It should check the file name against `auto-coding-alist'.\n\
+If no coding system is decided, it should check a coding system\n\
+specified in the heading lines with the format:\n\
+ -*- ... coding: CODING-SYSTEM; ... -*-\n\
+or local variable spec of the tailing lines with `coding:' tag.");
+ 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\
defsubr (&Sunix_sync);
#endif
}
+