/* File IO for GNU Emacs.
- Copyright (C) 1985,86,87,88,93,94,95,96,97,98,99,2000,01,03,2004
- Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996,
+ 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+ 2005, 2006 Free Software Foundation, Inc.
This file is part of GNU Emacs.
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
# 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;
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.
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 */
+#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 */
}
}
&& !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
{
-#ifndef VMS4_4
+#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\
}
#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. */
+ if ((pw = getpwnam (o + 1)))
+ return p;
+ else
+ xfree (pw);
+ }
+ 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));
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, 6,
+ "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
+Always sets the file modes of the output file to match the input 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)
- Lisp_Object file, newname, ok_if_already_exists, keep_time;
+
+The optional fifth arg MUSTBENEW, if non-nil, insists on a check
+for an existing file with the same name. If MUSTBENEW is `excl',
+that means to get an error if the file already exists; never overwrite.
+If MUSTBENEW is neither nil nor `excl', that means ask for
+confirmation before overwriting, but do go ahead and overwrite the file
+if the user confirms.
+
+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, mustbenew, preserve_uid_gid)
+ Lisp_Object file, newname, ok_if_already_exists, keep_time, mustbenew;
+ Lisp_Object preserve_uid_gid;
{
int ifd, ofd, n;
char buf[16 * 1024];
CHECK_STRING (file);
CHECK_STRING (newname);
+ if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl))
+ barf_or_query_if_file_exists (newname, "overwrite", 1, 0, 1);
+
if (!NILP (Ffile_directory_p (newname)))
newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
else
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
+ | (EQ (mustbenew, Qexcl) ? O_EXCL : 0),
+ S_IREAD | S_IWRITE);
+#else /* not MSDOS */
+ ofd = emacs_open (SDATA (encoded_newname),
+ O_WRONLY | O_TRUNC | O_CREAT
+ | (EQ (mustbenew, Qexcl) ? 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));
Fcons (build_string ("Cannot set file date"),
Fcons (newname, Qnil)));
}
-#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;
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.
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. */
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);
+ 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, Qnil, Qt);
+
Fdelete_file (file);
}
else
}
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.
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. */
#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.
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. */
(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;
{
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");
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);
-
+ coding_free_composition_data (&coding);
if (how_much == -1)
error ("IO error reading %s: %s",
SDATA (orig_filename), emacs_strerror (errno));
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. */
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);
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);
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 ("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
+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);
+ Lisp_Object tcons;
+ tcons = long_to_cons ((unsigned long) current_buffer->modtime);
+ if (CONSP (tcons))
+ return list2 (XCAR (tcons), XCDR (tcons));
+ return tcons;
}
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)
+ fclose (stream);
return Qnil;
}
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;
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;
#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;
{
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");
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);
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");
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 (&Sread_file_name_internal);
defsubr (&Sread_file_name);
+ defsubr (&Snext_read_file_uses_dialog_p);
#ifdef unix
defsubr (&Sunix_sync);