/* File IO for GNU Emacs.
- Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000,01,2003
- Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
+ 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+ 2005, 2006, 2007 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
#include <config.h>
# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
#endif
-#ifdef VMS
-#include "vms-pwd.h"
-#else
+#ifdef HAVE_PWD_H
#include <pwd.h>
#endif
#include "charset.h"
#include "coding.h"
#include "window.h"
+#include "blockinput.h"
#ifdef WINDOWSNT
#define NOMINMAX 1
# define lstat stat
#endif
+#ifndef FILE_SYSTEM_CASE
+#define FILE_SYSTEM_CASE(filename) (filename)
+#endif
+
/* Nonzero during writing of auto-save files */
int auto_saving;
whose I/O is done with a special handler. */
Lisp_Object Vfile_name_handler_alist;
-/* Format for auto-save files */
-Lisp_Object Vauto_save_file_format;
+/* Property name of a file name handler,
+ which gives a list of operations it handles.. */
+Lisp_Object Qoperations;
/* Lisp functions for translating file formats */
Lisp_Object Qformat_decode, Qformat_annotate_function;
/* Current predicate used by read_file_name_internal. */
Lisp_Object Vread_file_name_predicate;
+/* Nonzero means completion ignores case when reading file name. */
+int read_file_name_completion_ignore_case;
+
/* Nonzero means, when reading a filename in the minibuffer,
start out by inserting the default directory into the minibuffer. */
int insert_default_directory;
expanding file names. This can be bound to / or \. */
Lisp_Object Vdirectory_sep_char;
+#ifdef HAVE_FSYNC
+/* Nonzero means skip the call to fsync in Fwrite-region. */
+int write_region_inhibit_fsync;
+#endif
+
extern Lisp_Object Vuser_login_name;
#ifdef WINDOWSNT
extern int minibuffer_auto_raise;
+extern int history_delete_duplicates;
+
/* These variables describe handlers that have "already" had a chance
to handle the current operation.
switch (errorno)
{
case EEXIST:
- Fsignal (Qfile_already_exists, Fcons (errstring, data));
+ xsignal (Qfile_already_exists, Fcons (errstring, data));
break;
default:
/* System error messages are capitalized. Downcase the initial
if (SREF (errstring, 1) != '/')
SSET (errstring, 0, DOWNCASE (SREF (errstring, 0)));
- Fsignal (Qfile_error,
+ xsignal (Qfile_error,
Fcons (build_string (string), Fcons (errstring, data)));
}
}
Lisp_Object Qfile_accessible_directory_p;
Lisp_Object Qfile_modes;
Lisp_Object Qset_file_modes;
+Lisp_Object Qset_file_times;
Lisp_Object Qfile_newer_than_file_p;
Lisp_Object Qinsert_file_contents;
Lisp_Object Qwrite_region;
elt = XCAR (chain);
if (CONSP (elt))
{
- Lisp_Object string;
+ Lisp_Object string = XCAR (elt);
int match_pos;
- string = XCAR (elt);
+ Lisp_Object handler = XCDR (elt);
+ Lisp_Object operations = Qnil;
+
+ if (SYMBOLP (handler))
+ operations = Fget (handler, Qoperations);
+
if (STRINGP (string)
- && (match_pos = fast_string_match (string, filename)) > pos)
+ && (match_pos = fast_string_match (string, filename)) > pos
+ && (NILP (operations) || ! NILP (Fmemq (operation, operations))))
{
- Lisp_Object handler, tem;
+ Lisp_Object tem;
handler = XCDR (elt);
tem = Fmemq (handler, inhibited_handlers);
if (!NILP (handler))
return call2 (handler, Qfile_name_directory, filename);
-#ifdef FILE_SYSTEM_CASE
filename = FILE_SYSTEM_CASE (filename);
-#endif
beg = SDATA (filename);
#ifdef DOS_NT
beg = strcpy (alloca (strlen (beg) + 1), beg);
int base64_p;
{
Lisp_Object val;
- int len;
+ int len, clen;
int pid;
unsigned char *p, *data;
char pidbuf[20];
#endif
}
- len = SCHARS (prefix);
- val = make_uninit_string (len + 3 + pidlen);
+ len = SBYTES (prefix); clen = SCHARS (prefix);
+ val = make_uninit_multibyte_string (clen + 3 + pidlen, len + 3 + pidlen);
+ if (!STRING_MULTIBYTE (prefix))
+ STRING_SET_UNIBYTE (val);
data = SDATA (val);
bcopy(SDATA (prefix), data, len);
p = data + len;
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
doc: /* Convert filename NAME to absolute, and canonicalize it.
Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
- (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
-the current buffer's value of default-directory is used.
+\(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
+the current buffer's value of `default-directory' is used.
File name components that are `.' are removed, and
so are file name components followed by `..', along with the `..' itself;
note that these simplifications are done without checking the resulting
#endif /* DOS_NT */
int length;
Lisp_Object handler, result;
+ int multibyte;
CHECK_STRING (name);
UNGCPRO;
}
-#ifdef VMS
- /* Filenames on VMS are always upper case. */
- name = Fupcase (name);
-#endif
-#ifdef FILE_SYSTEM_CASE
name = FILE_SYSTEM_CASE (name);
-#endif
-
nm = SDATA (name);
+ multibyte = STRING_MULTIBYTE (name);
#ifdef DOS_NT
/* We will force directory separators to be either all \ or /, so make
slash = p;
}
if (p[0] == '-')
-#ifndef VMS4_4
- /* VMS pre V4.4,convert '-'s in filenames. */
+#ifdef NO_HYPHENS_IN_FILENAMES
if (lbrack == rbrack)
{
- if (dots < 2) /* this is to allow negative version numbers */
+ /* Avoid clobbering negative version numbers. */
+ if (dots < 2)
p[0] = '_';
}
else
-#endif /* VMS4_4 */
- if (lbrack > rbrack &&
- ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') &&
- (p[1] == '.' || p[1] == ']' || p[1] == '>')))
+#endif /* NO_HYPHENS_IN_FILENAMES */
+ if (lbrack > rbrack
+ && ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<')
+ && (p[1] == '.' || p[1] == ']' || p[1] == '>')))
lose = 1;
-#ifndef VMS4_4
+#ifdef NO_HYPHENS_IN_FILENAMES
else
p[0] = '_';
-#endif /* VMS4_4 */
+#endif /* NO_HYPHENS_IN_FILENAMES */
/* count open brackets, reset close bracket pointer */
if (p[0] == '[' || p[0] == '<')
lbrack++, brack = 0;
if (index (nm, '/'))
{
nm = sys_translate_unix (nm);
- return make_specified_string (nm, -1, strlen (nm),
- STRING_MULTIBYTE (name));
+ return make_specified_string (nm, -1, strlen (nm), multibyte);
}
#endif /* VMS */
#ifdef DOS_NT
if (IS_DIRECTORY_SEP (nm[1]))
{
if (strcmp (nm, SDATA (name)) != 0)
- name = make_specified_string (nm, -1, strlen (nm),
- STRING_MULTIBYTE (name));
+ name = make_specified_string (nm, -1, strlen (nm), multibyte);
}
else
#endif
{
char temp[] = " :";
- name = make_specified_string (nm, -1, p - nm,
- STRING_MULTIBYTE (name));
+ name = make_specified_string (nm, -1, p - nm, multibyte);
temp[0] = DRIVE_LETTER (drive);
name = concat2 (build_string (temp), name);
}
#else /* not DOS_NT */
if (nm == SDATA (name))
return name;
- return make_specified_string (nm, -1, strlen (nm),
- STRING_MULTIBYTE (name));
+ return make_specified_string (nm, -1, strlen (nm), multibyte);
#endif /* not DOS_NT */
}
}
bcopy ((char *) nm, o, p - nm);
o [p - nm] = 0;
+ BLOCK_INPUT;
pw = (struct passwd *) getpwnam (o + 1);
+ UNBLOCK_INPUT;
if (pw)
{
newdir = (unsigned char *) pw -> pw_dir;
&& !newdir)
{
newdir = SDATA (default_directory);
+ multibyte |= STRING_MULTIBYTE (default_directory);
#ifdef DOS_NT
/* Note if special escape prefix is present, but remove for now. */
if (newdir[0] == '/' && newdir[1] == ':')
indirectly by prepending newdir to nm if necessary, and using
cwd (or the wd of newdir's drive) as the new newdir. */
- if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
+ if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
{
drive = newdir[0];
newdir += 2;
}
/* Strip off drive name from prefix, if present. */
- if (IS_DRIVE (newdir[0]) && newdir[1] == ':')
+ if (IS_DRIVE (newdir[0]) && IS_DEVICE_SEP (newdir[1]))
{
drive = newdir[0];
newdir += 2;
else if (*p == '-' && *o != '.')
*--p = '.';
}
- else if (p[0] == '-' && o[-1] == '.' &&
- (p[1] == '.' || p[1] == ']' || p[1] == '>'))
+ else if (p[0] == '-' && o[-1] == '.'
+ && (p[1] == '.' || p[1] == ']' || p[1] == '>'))
/* flush .foo.- ; leave - if stopped by '[' or '<' */
{
do
}
else
{
-#ifndef VMS4_4
- if (*p == '-' &&
- o[-1] != '[' && o[-1] != '<' && o[-1] != '.' &&
- p[1] != ']' && p[1] != '>' && p[1] != '.')
+#ifdef NO_HYPHENS_IN_FILENAMES
+ if (*p == '-'
+ && o[-1] != '[' && o[-1] != '<' && o[-1] != '.'
+ && p[1] != ']' && p[1] != '>' && p[1] != '.')
*p = '_';
-#endif /* VMS4_4 */
+#endif /* NO_HYPHENS_IN_FILENAMES */
*o++ = *p++;
}
#else /* not VMS */
{
*o++ = *p++;
}
- else if (IS_DIRECTORY_SEP (p[0])
- && p[1] == '.'
+ else if (p[1] == '.'
&& (IS_DIRECTORY_SEP (p[2])
|| p[2] == 0))
{
*o++ = *p;
p += 2;
}
- else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
- /* `/../' is the "superroot" on certain file systems. */
+ else if (p[1] == '.' && p[2] == '.'
+ /* `/../' is the "superroot" on certain file systems.
+ Turned off on DOS_NT systems because they have no
+ "superroot" and because this causes us to produce
+ file names like "d:/../foo" which fail file-related
+ functions of the underlying OS. (To reproduce, try a
+ long series of "../../" in default_directory, longer
+ than the number of levels from the root.) */
+#ifndef DOS_NT
&& o != target
+#endif
&& (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
{
while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
++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 if (p > target && IS_DIRECTORY_SEP (p[1]))
+ /* Collapse multiple `/' in a row. */
+ p++;
else
{
*o++ = *p++;
CORRECT_DIR_SEPS (target);
#endif /* DOS_NT */
- result = make_specified_string (target, -1, o - target,
- STRING_MULTIBYTE (name));
+ result = make_specified_string (target, -1, o - target, multibyte);
/* Again look to see if the file name has special constructs in it
and perhaps call the corresponding file handler. This is needed
DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
"Convert FILENAME to absolute, and canonicalize it.\n\
Second arg DEFAULT is directory to start with if FILENAME is relative\n\
- (does not start with slash); if DEFAULT is nil or missing,\n\
+\(does not start with slash); if DEFAULT is nil or missing,\n\
the current buffer's value of default-directory is used.\n\
Filenames containing `.' or `..' as components are simplified;\n\
initial `~/' expands to your home directory.\n\
}
else
#endif /* VMS4_4 */
- if (lbrack > rbrack &&
- ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<') &&
- (p[1] == '.' || p[1] == ']' || p[1] == '>')))
+ if (lbrack > rbrack
+ && ((p[-1] == '.' || p[-1] == '[' || p[-1] == '<')
+ && (p[1] == '.' || p[1] == ']' || p[1] == '>')))
lose = 1;
#ifndef VMS4_4
else
o[len] = 0;
/* Look up the user name. */
+ BLOCK_INPUT;
pw = (struct passwd *) getpwnam (o + 1);
+ UNBLOCK_INPUT;
if (!pw)
error ("\"%s\" isn't a registered user", o + 1);
else if (*p == '-' && *o != '.')
*--p = '.';
}
- else if (p[0] == '-' && o[-1] == '.' &&
- (p[1] == '.' || p[1] == ']' || p[1] == '>'))
+ else if (p[0] == '-' && o[-1] == '.'
+ && (p[1] == '.' || p[1] == ']' || p[1] == '>'))
/* flush .foo.- ; leave - if stopped by '[' or '<' */
{
do
else
{
#ifndef VMS4_4
- if (*p == '-' &&
- o[-1] != '[' && o[-1] != '<' && o[-1] != '.' &&
- p[1] != ']' && p[1] != '>' && p[1] != '.')
+ if (*p == '-'
+ && o[-1] != '[' && o[-1] != '<' && o[-1] != '.'
+ && p[1] != ']' && p[1] != '>' && p[1] != '.')
*p = '_';
#endif /* VMS4_4 */
*o++ = *p++;
o = target;
p++;
}
- else if (p[0] == '/' && p[1] == '.' &&
- (p[2] == '/' || p[2] == 0))
+ else if (p[0] == '/' && p[1] == '.'
+ && (p[2] == '/' || p[2] == 0))
p += 2;
else if (!strncmp (p, "/..", 3)
/* `/../' is the "superroot" on certain file systems. */
}
#endif
\f
+/* If /~ or // appears, discard everything through first slash. */
+static int
+file_name_absolute_p (filename)
+ const unsigned char *filename;
+{
+ return
+ (IS_DIRECTORY_SEP (*filename) || *filename == '~'
+#ifdef VMS
+ /* ??? This criterion is probably wrong for '<'. */
+ || index (filename, ':') || index (filename, '<')
+ || (*filename == '[' && (filename[1] != '-'
+ || (filename[2] != '.' && filename[2] != ']'))
+ && filename[1] != '.')
+#endif /* VMS */
+#ifdef DOS_NT
+ || (IS_DRIVE (*filename) && IS_DEVICE_SEP (filename[1])
+ && IS_DIRECTORY_SEP (filename[2]))
+#endif
+ );
+}
+
+static unsigned char *
+search_embedded_absfilename (nm, endp)
+ unsigned char *nm, *endp;
+{
+ unsigned char *p, *s;
+
+ for (p = nm + 1; p < endp; p++)
+ {
+ if ((0
+#ifdef VMS
+ || p[-1] == ':' || p[-1] == ']' || p[-1] == '>'
+#endif /* VMS */
+ || IS_DIRECTORY_SEP (p[-1]))
+ && file_name_absolute_p (p)
+#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
+ /* // at start of file name is meaningful in Apollo,
+ WindowsNT and Cygwin systems. */
+ && !(IS_DIRECTORY_SEP (p[0]) && p - 1 == nm)
+#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
+ )
+ {
+ for (s = p; *s && (!IS_DIRECTORY_SEP (*s)
+#ifdef VMS
+ && *s != ':'
+#endif /* VMS */
+ ); s++);
+ if (p[0] == '~' && s > p + 1) /* we've got "/~something/" */
+ {
+ unsigned char *o = alloca (s - p + 1);
+ struct passwd *pw;
+ bcopy (p, o, s - p);
+ o [s - p] = 0;
+
+ /* If we have ~user and `user' exists, discard
+ everything up to ~. But if `user' does not exist, leave
+ ~user alone, it might be a literal file name. */
+ BLOCK_INPUT;
+ pw = getpwnam (o + 1);
+ UNBLOCK_INPUT;
+ if (pw)
+ return p;
+ }
+ else
+ return p;
+ }
+ }
+ return NULL;
+}
+
DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name,
Ssubstitute_in_file_name, 1, 1, 0,
doc: /* Substitute environment variables referred to in FILENAME.
int total = 0;
int substituted = 0;
unsigned char *xnm;
- struct passwd *pw;
Lisp_Object handler;
CHECK_STRING (filename);
endp = nm + SBYTES (filename);
/* If /~ or // appears, discard everything through first slash. */
-
- for (p = nm; p != endp; p++)
- {
- if ((p[0] == '~'
-#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
- /* // at start of file name is meaningful in Apollo,
- WindowsNT and Cygwin systems. */
- || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
-#else /* not (APOLLO || WINDOWSNT || CYGWIN) */
- || IS_DIRECTORY_SEP (p[0])
-#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
- )
- && p != nm
- && (0
-#ifdef VMS
- || p[-1] == ':' || p[-1] == ']' || p[-1] == '>'
-#endif /* VMS */
- || IS_DIRECTORY_SEP (p[-1])))
- {
- for (s = p; *s && (!IS_DIRECTORY_SEP (*s)
-#ifdef VMS
- && *s != ':'
-#endif /* VMS */
- ); s++);
- if (p[0] == '~' && s > p + 1) /* we've got "/~something/" */
- {
- o = (unsigned char *) alloca (s - p + 1);
- bcopy ((char *) p, o, s - p);
- o [s - p] = 0;
-
- pw = (struct passwd *) getpwnam (o + 1);
- }
- /* If we have ~/ or ~user and `user' exists, discard
- everything up to ~. But if `user' does not exist, leave
- ~user alone, it might be a literal file name. */
- if (IS_DIRECTORY_SEP (p[0]) || s == p + 1 || pw)
- {
- nm = p;
- substituted = 1;
- }
- }
-#ifdef DOS_NT
- /* see comment in expand-file-name about drive specifiers */
- else if (IS_DRIVE (p[0]) && p[1] == ':'
- && p > nm && IS_DIRECTORY_SEP (p[-1]))
- {
- nm = p;
- substituted = 1;
- }
-#endif /* DOS_NT */
- }
+ p = search_embedded_absfilename (nm, endp);
+ if (p)
+ /* Start over with the new string, so we check the file-name-handler
+ again. Important with filenames like "/home/foo//:/hello///there"
+ which whould substitute to "/:/hello///there" rather than "/there". */
+ return Fsubstitute_in_file_name
+ (make_specified_string (p, -1, endp - p,
+ STRING_MULTIBYTE (filename)));
#ifdef VMS
- return make_specified_string (nm, -1, strlen (nm),
- STRING_MULTIBYTE (filename));
+ return filename;
#else
/* See if any variables are substituted into the string
*x = 0;
/* If /~ or // appears, discard everything through first slash. */
-
- for (p = xnm; p != x; p++)
- if ((p[0] == '~'
-#if defined (APOLLO) || defined (WINDOWSNT) || defined(CYGWIN)
- || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
-#else /* not (APOLLO || WINDOWSNT || CYGWIN) */
- || IS_DIRECTORY_SEP (p[0])
-#endif /* not (APOLLO || WINDOWSNT || CYGWIN) */
- )
- && p != xnm && IS_DIRECTORY_SEP (p[-1]))
- xnm = p;
-#ifdef DOS_NT
- else if (IS_DRIVE (p[0]) && p[1] == ':'
- && p > xnm && IS_DIRECTORY_SEP (p[-1]))
- xnm = p;
-#endif
+ while ((p = search_embedded_absfilename (xnm, x)))
+ /* This time we do not start over because we've already expanded envvars
+ and replaced $$ with $. Maybe we should start over as well, but we'd
+ need to quote some $ to $$ first. */
+ xnm = p;
return make_specified_string (xnm, -1, x - xnm, STRING_MULTIBYTE (filename));
/* stat is a good way to tell whether the file exists,
regardless of what access permissions it has. */
- if (stat (SDATA (encoded_filename), &statbuf) >= 0)
+ if (lstat (SDATA (encoded_filename), &statbuf) >= 0)
{
if (! interactive)
- Fsignal (Qfile_already_exists,
- Fcons (build_string ("File already exists"),
- Fcons (absname, Qnil)));
+ xsignal2 (Qfile_already_exists,
+ build_string ("File already exists"), absname);
GCPRO1 (absname);
tem = format2 ("File %s already exists; %s anyway? ",
absname, build_string (querystring));
tem = do_yes_or_no_p (tem);
UNGCPRO;
if (NILP (tem))
- Fsignal (Qfile_already_exists,
- Fcons (build_string ("File already exists"),
- Fcons (absname, Qnil)));
+ xsignal2 (Qfile_already_exists,
+ build_string ("File already exists"), absname);
if (statptr)
*statptr = statbuf;
}
return;
}
-DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 4,
- "fCopy file: \nFCopy %s to file: \np\nP",
+DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 5,
+ "fCopy file: \nGCopy %s to file: \np\nP",
doc: /* Copy FILE to NEWNAME. Both args must be strings.
If NEWNAME names a directory, copy FILE there.
-Signals a `file-already-exists' error if file NEWNAME already exists,
-unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
-A number as third arg means request confirmation if NEWNAME already exists.
-This is what happens in interactive use with M-x.
-Fourth arg KEEP-TIME non-nil means give the new file the same
+
+This function always sets the file modes of the output file to match
+the input file.
+
+The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
+if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
+signal a `file-already-exists' error without overwriting. If
+OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
+about overwriting; this is what happens in interactive use with M-x.
+Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
+existing file.
+
+Fourth arg KEEP-TIME non-nil means give the output file the same
last-modified time as the old one. (This works on only some systems.)
+
A prefix arg makes KEEP-TIME non-nil.
-Also set the file modes of the target file to match the source file. */)
- (file, newname, ok_if_already_exists, keep_time)
+
+If PRESERVE-UID-GID is non-nil, we try to transfer the
+uid and gid of FILE to NEWNAME. */)
+ (file, newname, ok_if_already_exists, keep_time, preserve_uid_gid)
Lisp_Object file, newname, ok_if_already_exists, keep_time;
+ Lisp_Object preserve_uid_gid;
{
int ifd, ofd, n;
char buf[16 * 1024];
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
- barf_or_query_if_file_exists (encoded_newname, "copy to it",
+ barf_or_query_if_file_exists (newname, "copy to it",
INTEGERP (ok_if_already_exists), &out_st, 0);
else if (stat (SDATA (encoded_newname), &out_st) < 0)
out_st.st_mode = 0;
{
/* Restore original attributes. */
SetFileAttributes (filename, attributes);
- Fsignal (Qfile_date_error,
- Fcons (build_string ("Cannot set file date"),
- Fcons (newname, Qnil)));
+ xsignal2 (Qfile_date_error,
+ build_string ("Cannot set file date"), newname);
}
/* Restore original attributes. */
SetFileAttributes (filename, attributes);
copyable by us. */
input_file_statable_p = (fstat (ifd, &st) >= 0);
-#if !defined (DOS_NT) || __DJGPP__ > 1
+#if !defined (MSDOS) || __DJGPP__ > 1
if (out_st.st_mode != 0
&& st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
{
#else
#ifdef MSDOS
/* System's default file type was set to binary by _fmode in emacs.c. */
- ofd = creat (SDATA (encoded_newname), S_IREAD | S_IWRITE);
-#else /* not MSDOS */
- ofd = creat (SDATA (encoded_newname), 0666);
+ ofd = emacs_open (SDATA (encoded_newname),
+ O_WRONLY | O_TRUNC | O_CREAT
+ | (NILP (ok_if_already_exists) ? O_EXCL : 0),
+ S_IREAD | S_IWRITE);
+#else /* not MSDOS */
+ ofd = emacs_open (SDATA (encoded_newname),
+ O_WRONLY | O_TRUNC | O_CREAT
+ | (NILP (ok_if_already_exists) ? O_EXCL : 0),
+ 0666);
#endif /* not MSDOS */
#endif /* VMS */
if (ofd < 0)
report_file_error ("I/O error", Fcons (newname, Qnil));
immediate_quit = 0;
+#ifndef MSDOS
+ /* Preserve the original file modes, and if requested, also its
+ owner and group. */
+ if (input_file_statable_p)
+ {
+ if (! NILP (preserve_uid_gid))
+ fchown (ofd, st.st_uid, st.st_gid);
+ fchmod (ofd, st.st_mode & 07777);
+ }
+#endif /* not MSDOS */
+
/* Closing the output clobbers the file times on some systems. */
if (emacs_close (ofd) < 0)
report_file_error ("I/O error", Fcons (newname, Qnil));
EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
if (set_file_times (SDATA (encoded_newname),
atime, mtime))
- Fsignal (Qfile_date_error,
- Fcons (build_string ("Cannot set file date"),
- Fcons (newname, Qnil)));
+ xsignal2 (Qfile_date_error,
+ build_string ("Cannot set file date"), newname);
}
-#ifndef MSDOS
- chmod (SDATA (encoded_newname), st.st_mode & 07777);
-#else /* MSDOS */
+ }
+
+ emacs_close (ifd);
+
#if defined (__DJGPP__) && __DJGPP__ > 1
+ if (input_file_statable_p)
+ {
/* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
and if it can't, it tells so. Otherwise, under MSDOS we usually
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 (SDATA (encoded_newname), st.st_mode & 07777);
-#endif /* DJGPP version 2 or newer */
-#endif /* MSDOS */
}
-
- emacs_close (ifd);
-#endif /* WINDOWSNT */
+#endif /* DJGPP version 2 or newer */
+#endif /* not WINDOWSNT */
/* Discard the unwind protects. */
specpdl_ptr = specpdl + count;
#else
if (mkdir (dir, 0777) != 0)
#endif
- report_file_error ("Creating directory", Flist (1, &directory));
+ report_file_error ("Creating directory", list1 (directory));
return Qnil;
}
dir = SDATA (encoded_dir);
if (rmdir (dir) != 0)
- report_file_error ("Removing directory", Flist (1, &directory));
+ report_file_error ("Removing directory", list1 (directory));
return Qnil;
}
GCPRO1 (filename);
if (!NILP (Ffile_directory_p (filename))
&& NILP (Ffile_symlink_p (filename)))
- Fsignal (Qfile_error,
- Fcons (build_string ("Removing old name: is a directory"),
- Fcons (filename, Qnil)));
+ xsignal2 (Qfile_error,
+ build_string ("Removing old name: is a directory"),
+ filename);
UNGCPRO;
filename = Fexpand_file_name (filename, Qnil);
encoded_file = ENCODE_FILE (filename);
if (0 > unlink (SDATA (encoded_file)))
- report_file_error ("Removing old name", Flist (1, &filename));
+ report_file_error ("Removing old name", list1 (filename));
return Qnil;
}
internal_delete_file (filename)
Lisp_Object filename;
{
- return NILP (internal_condition_case_1 (Fdelete_file, filename,
- Qt, internal_delete_file_1));
+ Lisp_Object tem;
+ tem = internal_condition_case_1 (Fdelete_file, filename,
+ Qt, internal_delete_file_1);
+ return NILP (tem);
}
\f
DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
- "fRename file: \nFRename %s to file: \np",
- doc: /* Rename FILE as NEWNAME. Both args strings.
+ "fRename file: \nGRename %s to file: \np",
+ doc: /* Rename FILE as NEWNAME. Both args must be strings.
If file has names other than FILE, it continues to have those names.
Signals a `file-already-exists' error if a file NEWNAME already exists
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
(file, newname, ok_if_already_exists)
Lisp_Object file, newname, ok_if_already_exists;
{
-#ifdef NO_ARG_ARRAY
- Lisp_Object args[2];
-#endif
Lisp_Object handler;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
- Lisp_Object encoded_file, encoded_newname;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+ Lisp_Object encoded_file, encoded_newname, symlink_target;
- encoded_file = encoded_newname = Qnil;
- GCPRO4 (file, newname, encoded_file, encoded_newname);
+ symlink_target = encoded_file = encoded_newname = Qnil;
+ GCPRO5 (file, newname, encoded_file, encoded_newname, symlink_target);
CHECK_STRING (file);
CHECK_STRING (newname);
file = Fexpand_file_name (file, Qnil);
- newname = Fexpand_file_name (newname, Qnil);
+
+ if ((!NILP (Ffile_directory_p (newname)))
+#ifdef DOS_NT
+ /* If the file names are identical but for the case,
+ don't attempt to move directory to itself. */
+ && (NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
+#endif
+ )
+ newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
+ else
+ newname = Fexpand_file_name (newname, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
#endif
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
- barf_or_query_if_file_exists (encoded_newname, "rename to it",
+ barf_or_query_if_file_exists (newname, "rename to it",
INTEGERP (ok_if_already_exists), 0, 0);
#ifndef BSD4_1
if (0 > rename (SDATA (encoded_file), SDATA (encoded_newname)))
{
if (errno == EXDEV)
{
- Fcopy_file (file, newname,
- /* We have already prompted if it was an integer,
- so don't have copy-file prompt again. */
- NILP (ok_if_already_exists) ? Qnil : Qt, Qt);
+#ifdef S_IFLNK
+ symlink_target = Ffile_symlink_p (file);
+ if (! NILP (symlink_target))
+ Fmake_symbolic_link (symlink_target, newname,
+ NILP (ok_if_already_exists) ? Qnil : Qt);
+ else
+#endif
+ Fcopy_file (file, newname,
+ /* We have already prompted if it was an integer,
+ so don't have copy-file prompt again. */
+ NILP (ok_if_already_exists) ? Qnil : Qt,
+ Qt, Qt);
+
Fdelete_file (file);
}
else
-#ifdef NO_ARG_ARRAY
- {
- args[0] = file;
- args[1] = newname;
- report_file_error ("Renaming", Flist (2, args));
- }
-#else
- report_file_error ("Renaming", Flist (2, &file));
-#endif
+ report_file_error ("Renaming", list2 (file, newname));
}
UNGCPRO;
return Qnil;
}
DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
- "fAdd name to file: \nFName to add to %s: \np",
- doc: /* Give FILE additional name NEWNAME. Both args strings.
+ "fAdd name to file: \nGName to add to %s: \np",
+ doc: /* Give FILE additional name NEWNAME. Both args must be strings.
Signals a `file-already-exists' error if a file NEWNAME already exists
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
A number as third arg means request confirmation if NEWNAME already exists.
(file, newname, ok_if_already_exists)
Lisp_Object file, newname, ok_if_already_exists;
{
-#ifdef NO_ARG_ARRAY
- Lisp_Object args[2];
-#endif
Lisp_Object handler;
Lisp_Object encoded_file, encoded_newname;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
CHECK_STRING (file);
CHECK_STRING (newname);
file = Fexpand_file_name (file, Qnil);
- newname = Fexpand_file_name (newname, Qnil);
+
+ if (!NILP (Ffile_directory_p (newname)))
+ newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
+ else
+ newname = Fexpand_file_name (newname, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
- barf_or_query_if_file_exists (encoded_newname, "make it a new name",
+ barf_or_query_if_file_exists (newname, "make it a new name",
INTEGERP (ok_if_already_exists), 0, 0);
unlink (SDATA (newname));
if (0 > link (SDATA (encoded_file), SDATA (encoded_newname)))
- {
-#ifdef NO_ARG_ARRAY
- args[0] = file;
- args[1] = newname;
- report_file_error ("Adding new name", Flist (2, args));
-#else
- report_file_error ("Adding new name", Flist (2, &file));
-#endif
- }
+ report_file_error ("Adding new name", list2 (file, newname));
UNGCPRO;
return Qnil;
#ifdef S_IFLNK
DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
- "FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
- doc: /* Make a symbolic link to FILENAME, named LINKNAME. Both args strings.
+ "FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
+ doc: /* Make a symbolic link to FILENAME, named LINKNAME.
+Both args must be strings.
Signals a `file-already-exists' error if a file LINKNAME already exists
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
A number as third arg means request confirmation if LINKNAME already exists.
(filename, linkname, ok_if_already_exists)
Lisp_Object filename, linkname, ok_if_already_exists;
{
-#ifdef NO_ARG_ARRAY
- Lisp_Object args[2];
-#endif
Lisp_Object handler;
Lisp_Object encoded_filename, encoded_linkname;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
we want to permit links to relative file names. */
if (SREF (filename, 0) == '~')
filename = Fexpand_file_name (filename, Qnil);
- linkname = Fexpand_file_name (linkname, Qnil);
+
+ if (!NILP (Ffile_directory_p (linkname)))
+ linkname = Fexpand_file_name (Ffile_name_nondirectory (filename), linkname);
+ else
+ linkname = Fexpand_file_name (linkname, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
- barf_or_query_if_file_exists (encoded_linkname, "make it a link",
+ barf_or_query_if_file_exists (linkname, "make it a link",
INTEGERP (ok_if_already_exists), 0, 0);
if (0 > symlink (SDATA (encoded_filename),
SDATA (encoded_linkname)))
}
}
-#ifdef NO_ARG_ARRAY
- args[0] = filename;
- args[1] = linkname;
- report_file_error ("Making symbolic link", Flist (2, args));
-#else
- report_file_error ("Making symbolic link", Flist (2, &filename));
-#endif
+ report_file_error ("Making symbolic link", list2 (filename, linkname));
}
UNGCPRO;
return Qnil;
(filename)
Lisp_Object filename;
{
- const unsigned char *ptr;
-
CHECK_STRING (filename);
- ptr = SDATA (filename);
- if (IS_DIRECTORY_SEP (*ptr) || *ptr == '~'
-#ifdef VMS
-/* ??? This criterion is probably wrong for '<'. */
- || index (ptr, ':') || index (ptr, '<')
- || (*ptr == '[' && (ptr[1] != '-' || (ptr[2] != '.' && ptr[2] != ']'))
- && ptr[1] != '.')
-#endif /* VMS */
-#ifdef DOS_NT
- || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2]))
-#endif
- )
- return Qt;
- else
- return Qnil;
+ return file_name_absolute_p (SDATA (filename)) ? Qt : Qnil;
}
\f
/* Return nonzero if file FILENAME exists and can be executed. */
}
DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
- doc: /* Return t if file FILENAME exists. (This does not mean you can read it.)
-See also `file-readable-p' and `file-attributes'. */)
+ doc: /* Return t if file FILENAME exists (whether or not you can read it.)
+See also `file-readable-p' and `file-attributes'.
+This returns nil for a symlink to a nonexistent file.
+Use `file-symlink-p' to test for such links. */)
(filename)
Lisp_Object filename;
{
DEFUN ("access-file", Faccess_file, Saccess_file, 2, 2, 0,
doc: /* Access file FILENAME, and get an error if that does not work.
The second argument STRING is used in the error message.
-If there is no error, we return nil. */)
+If there is no error, returns nil. */)
(filename, string)
Lisp_Object filename, string;
{
DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
doc: /* Return non-nil if file FILENAME is the name of a symbolic link.
The value is the link target, as a string.
-Otherwise returns nil. */)
+Otherwise it returns nil.
+
+This function returns t when given the name of a symlink that
+points to a nonexistent file. */)
(filename)
Lisp_Object filename;
{
}
DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
- doc: /* Return t if file FILENAME is the name of a regular file.
-This is the sort of file that holds an ordinary stream of data bytes. */)
+ doc: /* Return t if FILENAME names a regular file.
+This is the sort of file that holds an ordinary stream of data bytes.
+Symbolic links to regular files count as regular files.
+See `file-symlink-p' to distinguish symlinks. */)
(filename)
Lisp_Object filename;
{
}
\f
DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
- doc: /* Return mode bits of file named FILENAME, as an integer. */)
+ doc: /* Return mode bits of file named FILENAME, as an integer.
+Return nil, if file does not exist or is not accessible. */)
(filename)
Lisp_Object filename;
{
XSETINT (value, (~ realmask) & 0777);
return value;
}
-
\f
-#ifdef __NetBSD__
-#define unix 42
+extern int lisp_time_argument P_ ((Lisp_Object, time_t *, int *));
+
+DEFUN ("set-file-times", Fset_file_times, Sset_file_times, 1, 2, 0,
+ doc: /* Set times of file FILENAME to TIME.
+Set both access and modification times.
+Return t on success, else nil.
+Use the current time if TIME is nil. TIME is in the format of
+`current-time'. */)
+ (filename, time)
+ Lisp_Object filename, time;
+{
+ Lisp_Object absname, encoded_absname;
+ Lisp_Object handler;
+ time_t sec;
+ int usec;
+
+ if (! lisp_time_argument (time, &sec, &usec))
+ error ("Invalid time specification");
+
+ absname = Fexpand_file_name (filename, current_buffer->directory);
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (absname, Qset_file_times);
+ if (!NILP (handler))
+ return call3 (handler, Qset_file_times, absname, time);
+
+ encoded_absname = ENCODE_FILE (absname);
+
+ {
+ EMACS_TIME t;
+
+ EMACS_SET_SECS (t, sec);
+ EMACS_SET_USECS (t, usec);
+
+ if (set_file_times (SDATA (encoded_absname), t, t))
+ {
+#ifdef DOS_NT
+ struct stat st;
+
+ /* Setting times on a directory always fails. */
+ if (stat (SDATA (encoded_absname), &st) == 0
+ && (st.st_mode & S_IFMT) == S_IFDIR)
+ return Qnil;
#endif
+ report_file_error ("Setting file times", Fcons (absname, Qnil));
+ return Qnil;
+ }
+ }
-#ifdef unix
+ return Qt;
+}
+\f
+#ifdef HAVE_SYNC
DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
doc: /* Tell Unix to finish all pending disk updates. */)
()
return Qnil;
}
-#endif /* unix */
+#endif /* HAVE_SYNC */
DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
doc: /* Return t if file FILE1 is newer than file FILE2.
int set_coding_system = 0;
int coding_system_decided = 0;
int read_quit = 0;
+ Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark;
+ int we_locked_file = 0;
if (current_buffer->base_buffer && ! NILP (visit))
error ("Cannot do file visiting in an indirect buffer");
goto notfound;
if (! NILP (replace) || ! NILP (beg) || ! NILP (end))
- Fsignal (Qfile_error,
- Fcons (build_string ("not a regular file"),
- Fcons (orig_filename, Qnil)));
+ xsignal2 (Qfile_error,
+ build_string ("not a regular file"), orig_filename);
}
#endif
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
if (how_much < 0)
{
xfree (conversion_buffer);
-
- if (how_much == -1)
- error ("IO error reading %s: %s",
- SDATA (orig_filename), emacs_strerror (errno));
- else if (how_much == -2)
- error ("maximum buffer size exceeded");
+ coding_free_composition_data (&coding);
+ error ("IO error reading %s: %s",
+ SDATA (orig_filename), emacs_strerror (errno));
}
/* Compare the beginning of the converted file
if (bufpos == inserted)
{
xfree (conversion_buffer);
+ coding_free_composition_data (&coding);
emacs_close (fd);
specpdl_ptr--;
/* Truncate the buffer to the size of the file. */
/* 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_BYTE - same_at_end) + (same_at_start - BEG_BYTE);
+ inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE);
if (same_at_end != 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,
+ insert_1 (conversion_buffer + same_at_start - BEGV_BYTE, inserted,
0, 0, 0);
if (coding.cmp_data && coding.cmp_data->used)
coding_restore_composition (&coding, Fcurrent_buffer ());
/* Set `inserted' to the number of inserted characters. */
inserted = PT - temp;
+ /* Set point before the inserted characters. */
+ SET_PT_BOTH (temp, same_at_start);
xfree (conversion_buffer);
emacs_close (fd);
/* For a special file, all we can do is guess. */
total = READ_BUF_SIZE;
- if (NILP (visit) && total > 0)
- prepare_to_modify_buffer (PT, PT, NULL);
+ if (NILP (visit) && inserted > 0)
+ {
+#ifdef CLASH_DETECTION
+ if (!NILP (current_buffer->file_truename)
+ /* Make binding buffer-file-name to nil effective. */
+ && !NILP (current_buffer->filename)
+ && SAVE_MODIFF >= MODIFF)
+ we_locked_file = 1;
+#endif /* CLASH_DETECTION */
+ prepare_to_modify_buffer (GPT, GPT, NULL);
+ }
move_gap (PT);
if (GAP_SIZE < total)
}
}
+ /* Now we have read all the file data into the gap.
+ If it was empty, undo marking the buffer modified. */
+
+ if (inserted == 0)
+ {
+#ifdef CLASH_DETECTION
+ if (we_locked_file)
+ unlock_file (current_buffer->file_truename);
+#endif
+ Vdeactivate_mark = old_Vdeactivate_mark;
+ }
+ else
+ Vdeactivate_mark = Qt;
+
/* Make the text read part of the buffer. */
GAP_SIZE -= inserted;
GPT += inserted;
this way, we can run Lisp program safely before decoding
the inserted text. */
Lisp_Object unwind_data;
- int count = SPECPDL_INDEX ();
+ int count = SPECPDL_INDEX ();
unwind_data = Fcons (current_buffer->enable_multibyte_characters,
Fcons (current_buffer->undo_list,
Fcurrent_buffer ()));
- current_buffer->enable_multibyte_characters = Qnil;
+ current_buffer->enable_multibyte_characters = Qnil;
current_buffer->undo_list = Qt;
record_unwind_protect (decide_coding_unwind, unwind_data);
if (CONSP (coding_systems))
val = XCAR (coding_systems);
}
-
unbind_to (count, Qnil);
inserted = Z_BYTE - BEG_BYTE;
}
on some system. */
{
struct coding_system temp_coding;
- setup_coding_system (val, &temp_coding);
+ setup_coding_system (Fcheck_coding_system (val), &temp_coding);
bcopy (&temp_coding, &coding, sizeof coding);
}
/* Ensure we set Vlast_coding_system_used. */
}
#endif /* CLASH_DETECTION */
if (not_regular)
- Fsignal (Qfile_error,
- Fcons (build_string ("not a regular file"),
- Fcons (orig_filename, Qnil)));
+ xsignal2 (Qfile_error,
+ build_string ("not a regular file"), orig_filename);
}
if (set_coding_system)
if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
{
- insval = call1 (Qafter_insert_file_set_coding, make_number (inserted));
+ insval = call2 (Qafter_insert_file_set_coding, make_number (inserted),
+ visit);
if (! NILP (insval))
{
CHECK_NUMBER (insval);
/* ... but with the special flag to indicate not to strip off
leading code of eight-bit-control chars. */
coding->flags = 1;
+ /* We force LF for end-of-line because that is faster. */
+ coding->eol_type = CODING_EOL_LF;
goto done_setup_coding;
}
else if (!NILP (Vcoding_system_for_write))
setup_coding_system (Fcheck_coding_system (val), coding);
done_setup_coding:
+ if (coding->eol_type == CODING_EOL_UNDECIDED)
+ coding->eol_type = system_eol_type;
if (!STRINGP (start) && !NILP (current_buffer->selective_display))
coding->mode |= CODING_MODE_SELECTIVE_DISPLAY;
}
Optional fourth argument APPEND if non-nil means
append to existing file contents (if any). If it is an integer,
seek to that offset in the file before writing.
-Optional fifth argument VISIT if t means
+Optional fifth argument VISIT, if t or a string, means
set the last-save-file-modtime of buffer to this file's modtime
and mark buffer not modified.
If VISIT is a string, it is a second file name;
if (!NILP (start) && !STRINGP (start))
validate_region (&start, &end);
+ visit_file = Qnil;
GCPRO5 (start, filename, visit, visit_file, lockname);
filename = Fexpand_file_name (filename, Qnil);
* if we do writes that don't end with a carriage return. Furthermore
* it cannot handle writes of more then 16K. The modified
* version of "sys_write" in SYSDEP.C (see comment there) copes with
- * this EXCEPT for the last record (iff it doesn't end with a carriage
+ * this EXCEPT for the last record (if it doesn't end with a carriage
* return). This implies that if your buffer doesn't end with a carriage
* return, you get one free... tough. However it also means that if
* we make two calls to sys_write (a la the following code) you can
Disk full in NFS may be reported here. */
/* mib says that closing the file will try to write as fast as NFS can do
it, and that means the fsync here is not crucial for autosave files. */
- if (!auto_saving && fsync (desc) < 0)
+ if (!auto_saving && !write_region_inhibit_fsync && fsync (desc) < 0)
{
/* If fsync fails with EINTR, don't treat that as serious. */
if (errno != EINTR)
}
/* Now do the same for annotation functions implied by the file-format */
- if (auto_saving && (!EQ (Vauto_save_file_format, Qt)))
- p = Vauto_save_file_format;
+ if (auto_saving && (!EQ (current_buffer->auto_save_file_format, Qt)))
+ p = current_buffer->auto_save_file_format;
else
p = current_buffer->file_format;
for (i = 0; CONSP (p); p = XCDR (p), ++i)
DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime,
Sverify_visited_file_modtime, 1, 1, 0,
doc: /* Return t if last mod time of BUF's visited file matches what BUF records.
-This means that the file has not been changed since it was visited or saved. */)
+This means that the file has not been changed since it was visited or saved.
+See Info node `(elisp)Modification Time' for more details. */)
(buf)
Lisp_Object buf;
{
DEFUN ("visited-file-modtime", Fvisited_file_modtime,
Svisited_file_modtime, 0, 0, 0,
doc: /* Return the current buffer's recorded visited file modification time.
-The value is a list of the form (HIGH . LOW), like the time values
-that `file-attributes' returns. */)
+The value is a list of the form (HIGH LOW), like the time values
+that `file-attributes' returns. If the current buffer has no recorded
+file modification time, this function returns 0.
+See Info node `(elisp)Modification Time' for more details. */)
()
{
- return long_to_cons ((unsigned long) current_buffer->modtime);
+ if (! current_buffer->modtime)
+ return make_number (0);
+ return make_time ((time_t) current_buffer->modtime);
}
DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
Lisp_Object args[3], msg;
int i, nbytes;
struct gcpro gcpro1;
+ char *msgbuf;
+ USE_SAFE_ALLOCA;
ring_bell ();
msg = Fformat (3, args);
GCPRO1 (msg);
nbytes = SBYTES (msg);
+ SAFE_ALLOCA (msgbuf, char *, nbytes);
+ bcopy (SDATA (msg), msgbuf, nbytes);
for (i = 0; i < 3; ++i)
{
if (i == 0)
- message2 (SDATA (msg), nbytes, STRING_MULTIBYTE (msg));
+ message2 (msgbuf, nbytes, STRING_MULTIBYTE (msg));
else
- message2_nolog (SDATA (msg), nbytes, STRING_MULTIBYTE (msg));
+ message2_nolog (msgbuf, nbytes, STRING_MULTIBYTE (msg));
Fsleep_for (make_number (1), Qnil);
}
+ SAFE_FREE ();
UNGCPRO;
return Qnil;
}
auto_save_1 ()
{
struct stat st;
+ Lisp_Object modes;
+
+ auto_save_mode_bits = 0666;
/* Get visited file's mode to become the auto save file's mode. */
- if (! NILP (current_buffer->filename)
- && stat (SDATA (current_buffer->filename), &st) >= 0)
- /* But make sure we can overwrite it later! */
- auto_save_mode_bits = st.st_mode | 0600;
- else
- auto_save_mode_bits = 0666;
+ if (! NILP (current_buffer->filename))
+ {
+ if (stat (SDATA (current_buffer->filename), &st) >= 0)
+ /* But make sure we can overwrite it later! */
+ auto_save_mode_bits = st.st_mode | 0600;
+ else if ((modes = Ffile_modes (current_buffer->filename),
+ INTEGERP (modes)))
+ /* Remote files don't cooperate with stat. */
+ auto_save_mode_bits = XINT (modes) | 0600;
+ }
return
Fwrite_region (Qnil, Qnil,
}
static Lisp_Object
-do_auto_save_unwind (stream) /* used as unwind-protect function */
- Lisp_Object stream;
+do_auto_save_unwind (arg) /* used as unwind-protect function */
+ Lisp_Object arg;
{
+ FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
auto_saving = 0;
- if (!NILP (stream))
- fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16
- | XFASTINT (XCDR (stream))));
+ if (stream != NULL)
+ {
+ BLOCK_INPUT;
+ fclose (stream);
+ UNBLOCK_INPUT;
+ }
return Qnil;
}
do_auto_save_make_dir (dir)
Lisp_Object dir;
{
- return call2 (Qmake_directory, dir, Qt);
+ Lisp_Object mode;
+
+ call2 (Qmake_directory, dir, Qt);
+ XSETFASTINT (mode, 0700);
+ return Fset_file_modes (dir, mode);
}
static Lisp_Object
int auto_saved = 0;
int do_handled_files;
Lisp_Object oquit;
- FILE *stream;
- Lisp_Object lispstream;
+ FILE *stream = NULL;
int count = SPECPDL_INDEX ();
int orig_minibuffer_auto_raise = minibuffer_auto_raise;
int old_message_p = 0;
}
stream = fopen (SDATA (listfile), "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);
- XSETCARFASTINT (lispstream, (EMACS_UINT)stream >> 16);
- XSETCDRFASTINT (lispstream, (EMACS_UINT)stream & 0xffff);
- }
- else
- lispstream = Qnil;
- }
- else
- {
- stream = NULL;
- lispstream = Qnil;
}
- record_unwind_protect (do_auto_save_unwind, lispstream);
+ record_unwind_protect (do_auto_save_unwind,
+ make_save_value (stream, 0));
record_unwind_protect (do_auto_save_unwind_1,
make_number (minibuffer_auto_raise));
minibuffer_auto_raise = 0;
if (STRINGP (b->auto_save_file_name)
&& stream != NULL && do_handled_files == 0)
{
+ BLOCK_INPUT;
if (!NILP (b->filename))
{
fwrite (SDATA (b->filename), 1,
fwrite (SDATA (b->auto_save_file_name), 1,
SBYTES (b->auto_save_file_name), stream);
putc ('\n', stream);
+ UNBLOCK_INPUT;
}
if (!NILP (current_only)
{
/* If we are going to restore an old message,
give time to read ours. */
- sit_for (1, 0, 0, 0, 0);
+ sit_for (make_number (1), 0, 0);
restore_message ();
}
else
DEFUN ("recent-auto-save-p", Frecent_auto_save_p, Srecent_auto_save_p,
0, 0, 0,
- doc: /* Return t if buffer has been auto-saved since last read in or saved. */)
+ doc: /* Return t if current buffer has been auto-saved recently.
+More precisely, if it has been auto-saved since last read from or saved
+in the visited file. If the buffer has no visited file,
+then any auto-save counts as "recent". */)
()
{
return (SAVE_MODIFF < current_buffer->auto_save_modified) ? Qt : Qnil;
if (NILP (action))
{
specdir = Ffile_name_directory (string);
- val = Ffile_name_completion (name, realdir);
+ val = Ffile_name_completion (name, realdir, Vread_file_name_predicate);
UNGCPRO;
if (!STRINGP (val))
{
{
Lisp_Object tem = XCAR (all);
int len;
- if (STRINGP (tem) &&
- (len = SCHARS (tem), len > 0) &&
- IS_DIRECTORY_SEP (SREF (tem, len-1)))
+ if (STRINGP (tem)
+ && (len = SBYTES (tem), len > 0)
+ && IS_DIRECTORY_SEP (SREF (tem, len-1)))
comp = Fcons (tem, comp);
}
}
#endif
{
/* Must do it the hard (and slow) way. */
+ Lisp_Object tem;
GCPRO3 (all, comp, specdir);
count = SPECPDL_INDEX ();
record_unwind_protect (read_file_name_cleanup, current_buffer->directory);
current_buffer->directory = realdir;
for (comp = Qnil; CONSP (all); all = XCDR (all))
- if (!NILP (call1 (Vread_file_name_predicate, XCAR (all))))
- comp = Fcons (XCAR (all), comp);
+ {
+ tem = call1 (Vread_file_name_predicate, XCAR (all));
+ if (!NILP (tem))
+ comp = Fcons (XCAR (all), comp);
+ }
unbind_to (count, Qnil);
UNGCPRO;
}
return Ffile_exists_p (string);
}
+DEFUN ("next-read-file-uses-dialog-p", Fnext_read_file_uses_dialog_p,
+ Snext_read_file_uses_dialog_p, 0, 0, 0,
+ doc: /* Return t if a call to `read-file-name' will use a dialog.
+The return value is only relevant for a call to `read-file-name' that happens
+before any other event (mouse or keypress) is handeled. */)
+ ()
+{
+#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
+ if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
+ && use_dialog_box
+ && use_file_dialog
+ && have_menus_p ())
+ return Qt;
+#endif
+ return Qnil;
+}
+
DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 6, 0,
doc: /* Read file name, prompting with PROMPT and completing in directory DIR.
Value is not expanded---you must call `expand-file-name' yourself.
If this command was invoked with the mouse, use a file dialog box if
`use-dialog-box' is non-nil, and the window system or X toolkit in use
-provides a file dialog box. */)
+provides a file dialog box.
+
+See also `read-file-name-completion-ignore-case'
+and `read-file-name-function'. */)
(prompt, dir, default_filename, mustmatch, initial, predicate)
Lisp_Object prompt, dir, default_filename, mustmatch, initial, predicate;
{
if (NILP (dir))
dir = current_buffer->directory;
+ if (NILP (Ffile_name_absolute_p (dir)))
+ dir = Fexpand_file_name (dir, Qnil);
if (NILP (default_filename))
- default_filename = !NILP (initial)
- ? Fexpand_file_name (initial, dir)
- : current_buffer->filename;
+ default_filename
+ = (!NILP (initial)
+ ? Fexpand_file_name (initial, dir)
+ : current_buffer->filename);
/* If dir starts with user's homedir, change that to ~. */
homedir = (char *) egetenv ("HOME");
}
count = SPECPDL_INDEX ();
-#if defined VMS || defined DOS_NT || defined MAC_OSX
- specbind (intern ("completion-ignore-case"), Qt);
-#endif
-
+ specbind (intern ("completion-ignore-case"),
+ read_file_name_completion_ignore_case ? Qt : Qnil);
specbind (intern ("minibuffer-completing-file-name"), Qt);
specbind (intern ("read-file-name-predicate"),
(NILP (predicate) ? Qfile_exists_p : predicate));
GCPRO2 (insdef, default_filename);
-#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK)
- if ((NILP (last_nonmenu_event) || CONSP (last_nonmenu_event))
- && use_dialog_box
- && use_file_dialog
- && have_menus_p ())
+#if defined (USE_MOTIF) || defined (HAVE_NTGUI) || defined (USE_GTK) || defined (HAVE_CARBON)
+ if (! NILP (Fnext_read_file_uses_dialog_p ()))
{
/* If DIR contains a file name, split it. */
Lisp_Object file;
}
if (!NILP(default_filename))
default_filename = Fexpand_file_name (default_filename, dir);
- val = Fx_file_dialog (prompt, dir, default_filename, mustmatch);
+ val = Fx_file_dialog (prompt, dir, default_filename, mustmatch,
+ EQ (predicate, Qfile_directory_p) ? Qt : Qnil);
add_to_history = 1;
}
else
if (replace_in_history)
/* Replace what Fcompleting_read added to the history
with what we will actually return. */
- XSETCAR (Fsymbol_value (Qfile_name_history), double_dollars (val));
+ {
+ Lisp_Object val1 = double_dollars (val);
+ tem = Fsymbol_value (Qfile_name_history);
+ if (history_delete_duplicates)
+ XSETCDR (tem, Fdelete (val1, XCDR(tem)));
+ XSETCAR (tem, val1);
+ }
else if (add_to_history)
{
/* Add the value to the history--but not if it matches
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));
+ {
+ if (history_delete_duplicates) tem = Fdelete (val1, tem);
+ Fset (Qfile_name_history, Fcons (val1, tem));
+ }
}
return val;
void
syms_of_fileio ()
{
+ Qoperations = intern ("operations");
Qexpand_file_name = intern ("expand-file-name");
Qsubstitute_in_file_name = intern ("substitute-in-file-name");
Qdirectory_file_name = intern ("directory-file-name");
Qfile_accessible_directory_p = intern ("file-accessible-directory-p");
Qfile_modes = intern ("file-modes");
Qset_file_modes = intern ("set-file-modes");
+ Qset_file_times = intern ("set-file-times");
Qfile_newer_than_file_p = intern ("file-newer-than-file-p");
Qinsert_file_contents = intern ("insert-file-contents");
Qwrite_region = intern ("write-region");
Qset_visited_file_modtime = intern ("set-visited-file-modtime");
Qauto_save_coding = intern ("auto-save-coding");
+ staticpro (&Qoperations);
staticpro (&Qexpand_file_name);
staticpro (&Qsubstitute_in_file_name);
staticpro (&Qdirectory_file_name);
staticpro (&Qfile_accessible_directory_p);
staticpro (&Qfile_modes);
staticpro (&Qset_file_modes);
+ staticpro (&Qset_file_times);
staticpro (&Qfile_newer_than_file_p);
staticpro (&Qinsert_file_contents);
staticpro (&Qwrite_region);
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,
- doc: /* *Format in which to write auto-save files.
-Should be a list of symbols naming formats that are defined in `format-alist'.
-If it is t, which is the default, auto-save files are written in the
-same format as a regular save would use. */);
- Vauto_save_file_format = Qt;
-
Qformat_decode = intern ("format-decode");
staticpro (&Qformat_decode);
Qformat_annotate_function = intern ("format-annotate-function");
staticpro (&Qcar_less_than_car);
Fput (Qfile_error, Qerror_conditions,
- Fcons (Qfile_error, Fcons (Qerror, Qnil)));
+ list2 (Qfile_error, Qerror));
Fput (Qfile_error, Qerror_message,
build_string ("File error"));
Fput (Qfile_already_exists, Qerror_conditions,
- Fcons (Qfile_already_exists,
- Fcons (Qfile_error, Fcons (Qerror, Qnil))));
+ list3 (Qfile_already_exists, Qfile_error, Qerror));
Fput (Qfile_already_exists, Qerror_message,
build_string ("File already exists"));
Fput (Qfile_date_error, Qerror_conditions,
- Fcons (Qfile_date_error,
- Fcons (Qfile_error, Fcons (Qerror, Qnil))));
+ list3 (Qfile_date_error, Qfile_error, Qerror));
Fput (Qfile_date_error, Qerror_message,
build_string ("Cannot set file date"));
doc: /* Current predicate used by `read-file-name-internal'. */);
Vread_file_name_predicate = Qnil;
+ DEFVAR_BOOL ("read-file-name-completion-ignore-case", &read_file_name_completion_ignore_case,
+ doc: /* *Non-nil means when reading a file name completion ignores case. */);
+#if defined VMS || defined DOS_NT || defined MAC_OS
+ read_file_name_completion_ignore_case = 1;
+#else
+ read_file_name_completion_ignore_case = 0;
+#endif
+
DEFVAR_BOOL ("insert-default-directory", &insert_default_directory,
doc: /* *Non-nil means when reading a filename start with default dir in minibuffer.
If the initial minibuffer contents are non-empty, you can usually
a non-nil value. */);
Vauto_save_list_file_name = Qnil;
+#ifdef HAVE_FSYNC
+ DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync,
+ doc: /* *Non-nil means don't call fsync in `write-region'.
+This variable affects calls to `write-region' as well as save commands.
+A non-nil value may result in data loss! */);
+ write_region_inhibit_fsync = 0;
+#endif
+
defsubr (&Sfind_file_name_handler);
defsubr (&Sfile_name_directory);
defsubr (&Sfile_name_nondirectory);
defsubr (&Sfile_regular_p);
defsubr (&Sfile_modes);
defsubr (&Sset_file_modes);
+ defsubr (&Sset_file_times);
defsubr (&Sset_default_file_modes);
defsubr (&Sdefault_file_modes);
defsubr (&Sfile_newer_than_file_p);
defsubr (&Sread_file_name_internal);
defsubr (&Sread_file_name);
+ defsubr (&Snext_read_file_uses_dialog_p);
-#ifdef unix
+#ifdef HAVE_SYNC
defsubr (&Sunix_sync);
#endif
}
HCoop / bpt / emacs.git / blobdiff