/* File IO for GNU Emacs.
- Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 Free Software Foundation, Inc.
+ Copyright (C) 1985, 86, 87, 88, 93, 94, 95 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <sys/types.h>
#include <sys/stat.h>
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
#if !defined (S_ISLNK) && defined (S_IFLNK)
# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK)
#endif
#ifndef USG
#ifndef VMS
#ifndef BSD4_1
+#ifndef WINDOWSNT
#define HAVE_FSYNC
#endif
#endif
#endif
+#endif
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
#include "window.h"
+#ifdef WINDOWSNT
+#define NOMINMAX 1
+#include <windows.h>
+#include <stdlib.h>
+#include <fcntl.h>
+#endif /* not WINDOWSNT */
+
#ifdef VMS
#include <file.h>
#include <rmsdef.h>
#define O_WRONLY 1
#endif
+#ifndef O_RDONLY
+#define O_RDONLY 0
+#endif
+
#define min(a, b) ((a) < (b) ? (a) : (b))
#define max(a, b) ((a) > (b) ? (a) : (b))
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;
+
+/* Lisp functions for translating file formats */
+Lisp_Object Qformat_decode, Qformat_annotate_function;
+
/* Functions to be called to process text properties in inserted file. */
Lisp_Object Vafter_insert_file_functions;
/* Functions to be called to create text property annotations for file. */
Lisp_Object Vwrite_region_annotate_functions;
+/* During build_annotations, each time an annotation function is called,
+ this holds the annotations made by the previous functions. */
+Lisp_Object Vwrite_region_annotations_so_far;
+
+/* File name in which we write a list of all our auto save files. */
+Lisp_Object Vauto_save_list_file_name;
+
/* Nonzero means, when reading a filename in the minibuffer,
start out by inserting the default directory into the minibuffer. */
int insert_default_directory;
Zero means use var format. */
int vms_stmlf_recfm;
+/* These variables describe handlers that have "already" had a chance
+ to handle the current operation.
+
+ Vinhibit_file_name_handlers is a list of file name handlers.
+ Vinhibit_file_name_operation is the operation being handled.
+ If we try to handle that operation, we ignore those handlers. */
+
+static Lisp_Object Vinhibit_file_name_handlers;
+static Lisp_Object Vinhibit_file_name_operation;
+
Lisp_Object Qfile_error, Qfile_already_exists;
Lisp_Object Qfile_name_history;
{
close (XFASTINT (fd));
}
+
+/* Restore point, having saved it as a marker. */
+
+restore_point_unwind (location)
+ Lisp_Object location;
+{
+ SET_PT (marker_position (location));
+ Fset_marker (location, Qnil, Qnil);
+}
\f
Lisp_Object Qexpand_file_name;
+Lisp_Object Qsubstitute_in_file_name;
Lisp_Object Qdirectory_file_name;
Lisp_Object Qfile_name_directory;
Lisp_Object Qfile_name_nondirectory;
Lisp_Object Qunhandled_file_name_directory;
Lisp_Object Qfile_name_as_directory;
Lisp_Object Qcopy_file;
-Lisp_Object Qmake_directory;
+Lisp_Object Qmake_directory_internal;
Lisp_Object Qdelete_directory;
Lisp_Object Qdelete_file;
Lisp_Object Qrename_file;
Lisp_Object Qfile_symlink_p;
Lisp_Object Qfile_writable_p;
Lisp_Object Qfile_directory_p;
+Lisp_Object Qfile_regular_p;
Lisp_Object Qfile_accessible_directory_p;
Lisp_Object Qfile_modes;
Lisp_Object Qset_file_modes;
Lisp_Object Qverify_visited_file_modtime;
Lisp_Object Qset_visited_file_modtime;
-DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 1, 1, 0,
- "Return FILENAME's handler function, if its syntax is handled specially.\n\
+DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 2, 2, 0,
+ "Return FILENAME's handler function for OPERATION, if it has one.\n\
Otherwise, return nil.\n\
A file name is handled if one of the regular expressions in\n\
-`file-name-handler-alist' matches it.")
- (filename)
- Lisp_Object filename;
+`file-name-handler-alist' matches it.\n\n\
+If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
+any handlers that are members of `inhibit-file-name-handlers',\n\
+but we still do run any other handlers. This lets handlers\n\
+use the standard functions without calling themselves recursively.")
+ (filename, operation)
+ Lisp_Object filename, operation;
{
/* This function must not munge the match data. */
- Lisp_Object chain;
+ Lisp_Object chain, inhibited_handlers;
CHECK_STRING (filename, 0);
- for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons;
+ if (EQ (operation, Vinhibit_file_name_operation))
+ inhibited_handlers = Vinhibit_file_name_handlers;
+ else
+ inhibited_handlers = Qnil;
+
+ for (chain = Vfile_name_handler_alist; CONSP (chain);
chain = XCONS (chain)->cdr)
{
Lisp_Object elt;
elt = XCONS (chain)->car;
- if (XTYPE (elt) == Lisp_Cons)
+ if (CONSP (elt))
{
Lisp_Object string;
string = XCONS (elt)->car;
- if (XTYPE (string) == Lisp_String
- && fast_string_match (string, filename) >= 0)
- return XCONS (elt)->cdr;
+ if (STRINGP (string) && fast_string_match (string, filename) >= 0)
+ {
+ Lisp_Object handler, tem;
+
+ handler = XCONS (elt)->cdr;
+ tem = Fmemq (handler, inhibited_handlers);
+ if (NILP (tem))
+ return handler;
+ }
}
QUIT;
\f
DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
1, 1, 0,
- "Return the directory component in file name NAME.\n\
-Return nil if NAME does not include a directory.\n\
+ "Return the directory component in file name FILENAME.\n\
+Return nil if FILENAME does not include a directory.\n\
Otherwise return a directory spec.\n\
Given a Unix syntax file name, returns a string ending in slash;\n\
on VMS, perhaps instead a string ending in `:', `]' or `>'.")
- (file)
- Lisp_Object file;
+ (filename)
+ Lisp_Object filename;
{
register unsigned char *beg;
register unsigned char *p;
Lisp_Object handler;
- CHECK_STRING (file, 0);
+ CHECK_STRING (filename, 0);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (file);
+ handler = Ffind_file_name_handler (filename, Qfile_name_directory);
if (!NILP (handler))
- return call2 (handler, Qfile_name_directory, file);
+ return call2 (handler, Qfile_name_directory, filename);
#ifdef FILE_SYSTEM_CASE
- file = FILE_SYSTEM_CASE (file);
+ filename = FILE_SYSTEM_CASE (filename);
#endif
- beg = XSTRING (file)->data;
- p = beg + XSTRING (file)->size;
+ beg = XSTRING (filename)->data;
+ p = beg + XSTRING (filename)->size;
- while (p != beg && p[-1] != '/'
+ while (p != beg && !IS_ANY_SEP (p[-1])
#ifdef VMS
&& p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
#endif /* VMS */
-#ifdef MSDOS
- && p[-1] != ':'
-#endif
) p--;
if (p == beg)
return Qnil;
-#ifdef MSDOS
+#ifdef DOS_NT
/* Expansion of "c:" to drive and default directory. */
+ /* (NT does the right thing.) */
if (p == beg + 2 && beg[1] == ':')
{
int drive = (*beg) - 'a';
/* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */
unsigned char *res = alloca (MAXPATHLEN + 5);
- if (getdefdir (drive + 1, res + 2))
+ unsigned char *res1;
+#ifdef WINDOWSNT
+ res1 = res;
+ /* The NT version places the drive letter at the beginning already. */
+#else /* not WINDOWSNT */
+ /* On MSDOG we must put the drive letter in by hand. */
+ res1 = res + 2;
+#endif /* not WINDOWSNT */
+ if (getdefdir (drive + 1, res))
{
+#ifdef MSDOS
res[0] = drive + 'a';
res[1] = ':';
- if (res[strlen (res) - 1] != '/')
+#endif /* MSDOS */
+ if (IS_DIRECTORY_SEP (res[strlen (res) - 1]))
strcat (res, "/");
beg = res;
p = beg + strlen (beg);
}
}
-#endif
+#endif /* DOS_NT */
return make_string (beg, p - beg);
}
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, Sfile_name_nondirectory,
1, 1, 0,
- "Return file name NAME sans its directory.\n\
+ "Return file name FILENAME sans its directory.\n\
For example, in a Unix-syntax file name,\n\
this is everything after the last slash,\n\
or the entire name if it contains no slash.")
- (file)
- Lisp_Object file;
+ (filename)
+ Lisp_Object filename;
{
register unsigned char *beg, *p, *end;
Lisp_Object handler;
- CHECK_STRING (file, 0);
+ CHECK_STRING (filename, 0);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (file);
+ handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
if (!NILP (handler))
- return call2 (handler, Qfile_name_nondirectory, file);
+ return call2 (handler, Qfile_name_nondirectory, filename);
- beg = XSTRING (file)->data;
- end = p = beg + XSTRING (file)->size;
+ beg = XSTRING (filename)->data;
+ end = p = beg + XSTRING (filename)->size;
- while (p != beg && p[-1] != '/'
+ while (p != beg && !IS_ANY_SEP (p[-1])
#ifdef VMS
&& p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
#endif /* VMS */
-#ifdef MSDOS
- && p[-1] != ':'
-#endif
) p--;
return make_string (p, end - p);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
if (!NILP (handler))
return call2 (handler, Qunhandled_file_name_directory, filename);
}
#else /* not VMS */
/* For Unix syntax, Append a slash if necessary */
-#ifdef MSDOS
- if (out[size] != ':' && out[size] != '/')
-#else
- if (out[size] != '/')
-#endif
- strcat (out, "/");
+ if (!IS_ANY_SEP (out[size]))
+ {
+ out[size + 1] = DIRECTORY_SEP;
+ out[size + 2] = '\0';
+ }
#endif /* not VMS */
return out;
}
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (file);
+ handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
if (!NILP (handler))
return call2 (handler, Qfile_name_as_directory, file);
{
/* what about when we have logical_name:???? */
if (src[slen - 1] == ':')
- { /* Xlate logical name and see what we get */
+ { /* Xlate logical name and see what we get */
ptr = strcpy (dst, src); /* upper case for getenv */
while (*ptr)
{
*ptr -= 040;
ptr++;
}
- dst[slen - 1] = 0; /* remove colon */
+ dst[slen - 1] = 0; /* remove colon */
if (!(src = egetenv (dst)))
return 0;
/* should we jump to the beginning of this procedure?
}
}
else
- { /* not a directory spec */
+ { /* not a directory spec */
strcpy (dst, src);
return 0;
}
/* If we have the top-level of a rooted directory (i.e. xx:[000000]),
then translate the device and recurse. */
if (dst[slen - 1] == ':'
- && dst[slen - 2] != ':' /* skip decnet nodes */
+ && dst[slen - 2] != ':' /* skip decnet nodes */
&& strcmp(src + slen, "[000000]") == 0)
{
dst[slen - 1] = '\0';
/* Process as Unix format: just remove any final slash.
But leave "/" unchanged; do not change it to "". */
strcpy (dst, src);
+#ifdef APOLLO
+ /* Handle // as root for apollo's. */
+ if ((slen > 2 && dst[slen - 1] == '/')
+ || (slen > 1 && dst[0] != '/' && dst[slen - 1] == '/'))
+ dst[slen - 1] = 0;
+#else
if (slen > 1
- && dst[slen - 1] == '/'
-#ifdef MSDOS
- && dst[slen - 2] != ':'
+ && IS_DIRECTORY_SEP (dst[slen - 1])
+#ifdef DOS_NT
+ && !IS_ANY_SEP (dst[slen - 2])
#endif
)
dst[slen - 1] = 0;
+#endif
return 1;
}
DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
1, 1, 0,
- "Returns the file name of the directory named DIR.\n\
-This is the name of the file that holds the data for the directory DIR.\n\
+ "Returns the file name of the directory named DIRECTORY.\n\
+This is the name of the file that holds the data for the directory DIRECTORY.\n\
This operation exists because a directory is also a file, but its name as\n\
a directory is different from its name as a file.\n\
In Unix-syntax, this function just removes the final slash.\n\
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (directory);
+ handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
if (!NILP (handler))
return call2 (handler, Qdirectory_file_name, directory);
}
\f
DEFUN ("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\
+ "Convert filename NAME to absolute, and canonicalize it.\n\
+Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative\n\
+ (does not start with slash); if DEFAULT-DIRECTORY is nil or missing,\n\
the current buffer's value of default-directory is used.\n\
Path components that are `.' are removed, and \n\
path components followed by `..' are removed, along with the `..' itself;\n\
An initial `~/' expands to your home directory.\n\
An initial `~USER/' expands to USER's home directory.\n\
See also the function `substitute-in-file-name'.")
- (name, defalt)
- Lisp_Object name, defalt;
+ (name, default_directory)
+ Lisp_Object name, default_directory;
{
unsigned char *nm;
int lbrack = 0, rbrack = 0;
int dots = 0;
#endif /* VMS */
-#ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */
+#ifdef DOS_NT
+ /* Demacs 1.1.2 91/10/20 Manabu Higashida */
int drive = -1;
int relpath = 0;
unsigned char *tmp, *defdir;
-#endif
+#endif /* DOS_NT */
Lisp_Object handler;
CHECK_STRING (name, 0);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (name);
+ handler = Ffind_file_name_handler (name, Qexpand_file_name);
if (!NILP (handler))
- return call3 (handler, Qexpand_file_name, name, defalt);
+ return call3 (handler, Qexpand_file_name, name, default_directory);
- /* Use the buffer's default-directory if DEFALT is omitted. */
- if (NILP (defalt))
- defalt = current_buffer->directory;
- CHECK_STRING (defalt, 1);
+ /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
+ if (NILP (default_directory))
+ default_directory = current_buffer->directory;
+ CHECK_STRING (default_directory, 1);
- /* Make sure DEFALT is properly expanded.
+ if (!NILP (default_directory))
+ {
+ handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
+ if (!NILP (handler))
+ return call3 (handler, Qexpand_file_name, name, default_directory);
+ }
+
+ o = XSTRING (default_directory)->data;
+
+ /* Make sure DEFAULT_DIRECTORY is properly expanded.
It would be better to do this down below where we actually use
- defalt. Unfortunately, calling Fexpand_file_name recursively
+ default_directory. Unfortunately, calling Fexpand_file_name recursively
could invoke GC, and the strings might be relocated. This would
be annoying because we have pointers into strings lying around
that would need adjusting, and people would add new pointers to
Putting this call here avoids all that crud.
The EQ test avoids infinite recursion. */
- if (! NILP (defalt) && !EQ (defalt, name)
+ if (! NILP (default_directory) && !EQ (default_directory, name)
/* This saves time in a common case. */
- && XSTRING (defalt)->data[0] != '/')
+ && ! (XSTRING (default_directory)->size >= 3
+ && IS_DIRECTORY_SEP (XSTRING (default_directory)->data[0])
+ && IS_DEVICE_SEP (XSTRING (default_directory)->data[1])))
{
struct gcpro gcpro1;
GCPRO1 (name);
- defalt = Fexpand_file_name (defalt, Qnil);
+ default_directory = Fexpand_file_name (default_directory, Qnil);
UNGCPRO;
}
nm = XSTRING (name)->data;
#ifdef MSDOS
- /* firstly, strip drive name. */
+ /* First map all backslashes to slashes. */
+ dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm));
+#endif
+
+#ifdef DOS_NT
+ /* Now strip drive name. */
{
unsigned char *colon = rindex (nm, ':');
if (colon)
nm++;
else
{
- drive = tolower (colon[-1]) - 'a';
+ drive = colon[-1];
nm = colon + 1;
- if (*nm != '/')
+ if (!IS_DIRECTORY_SEP (*nm))
{
defdir = alloca (MAXPATHLEN + 1);
- relpath = getdefdir (drive + 1, defdir);
+ relpath = getdefdir (tolower (drive) - 'a' + 1, defdir);
}
- }
+ }
}
-#endif
+#endif /* DOS_NT */
+
+ /* Handle // and /~ in middle of file name
+ by discarding everything through the first / of that sequence. */
+ p = nm;
+ while (*p)
+ {
+ /* Since we know the path is absolute, we can assume that each
+ element starts with a "/". */
+
+ /* "//" anywhere isn't necessarily hairy; we just start afresh
+ with the second slash. */
+ if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])
+#if defined (APOLLO) || defined (WINDOWSNT)
+ /* // at start of filename is meaningful on Apollo
+ and WindowsNT systems */
+ && nm != p
+#endif /* APOLLO || WINDOWSNT */
+ )
+ nm = p + 1;
+
+ /* "~" is hairy as the start of any path element. */
+ if (IS_DIRECTORY_SEP (p[0]) && p[1] == '~')
+ nm = p + 1;
+
+ p++;
+ }
/* If nm is absolute, flush ...// and detect /./ and /../.
If no /./ or /../ we can return right away. */
if (
- nm[0] == '/'
+ IS_DIRECTORY_SEP (nm[0])
#ifdef VMS
|| index (nm, ':')
#endif /* VMS */
/* Since we know the path is absolute, we can assume that each
element starts with a "/". */
- /* "//" anywhere isn't necessarily hairy; we just start afresh
- with the second slash. */
- if (p[0] == '/' && p[1] == '/'
-#ifdef APOLLO
- /* // at start of filename is meaningful on Apollo system */
- && nm != p
-#endif /* APOLLO */
- )
- nm = p + 1;
-
- /* "~" is hairy as the start of any path element. */
- if (p[0] == '/' && p[1] == '~')
- nm = p + 1, lose = 1;
-
/* "." and ".." are hairy. */
- if (p[0] == '/'
+ if (IS_DIRECTORY_SEP (p[0])
&& p[1] == '.'
- && (p[2] == '/'
+ && (IS_DIRECTORY_SEP (p[2])
|| p[2] == 0
- || (p[2] == '.' && (p[3] == '/'
+ || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3])
|| p[3] == 0))))
lose = 1;
#ifdef VMS
/* VMS pre V4.4,convert '-'s in filenames. */
if (lbrack == rbrack)
{
- if (dots < 2) /* this is to allow negative version numbers */
+ if (dots < 2) /* this is to allow negative version numbers */
p[0] = '_';
}
else
if (index (nm, '/'))
return build_string (sys_translate_unix (nm));
#endif /* VMS */
-#ifndef MSDOS
+#ifndef DOS_NT
if (nm == XSTRING (name)->data)
return name;
return build_string (nm);
-#endif
+#endif /* not DOS_NT */
}
}
if (nm[0] == '~') /* prefix ~ */
{
- if (nm[1] == '/'
+ if (IS_DIRECTORY_SEP (nm[1])
#ifdef VMS
|| nm[1] == ':'
-#endif /* VMS */
+#endif /* VMS */
|| nm[1] == 0) /* ~ by itself */
{
if (!(newdir = (unsigned char *) egetenv ("HOME")))
newdir = (unsigned char *) "";
-#ifdef MSDOS
+#ifdef DOS_NT
+ /* Problem when expanding "~\" if HOME is not on current drive.
+ Ulrich Leodolter, Wed Jan 11 10:20:35 1995 */
+ if (newdir[1] == ':')
+ drive = newdir[0];
dostounix_filename (newdir);
#endif
nm++;
#ifdef VMS
nm++; /* Don't leave the slash in nm. */
-#endif /* VMS */
+#endif /* VMS */
}
else /* ~user/filename */
{
- for (p = nm; *p && (*p != '/'
+ for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)
#ifdef VMS
&& *p != ':'
-#endif /* VMS */
+#endif /* VMS */
); p++);
o = (unsigned char *) alloca (p - nm + 1);
bcopy ((char *) nm, o, p - nm);
o [p - nm] = 0;
+#ifdef WINDOWSNT
+ newdir = (unsigned char *) egetenv ("HOME");
+ dostounix_filename (newdir);
+#else /* not WINDOWSNT */
pw = (struct passwd *) getpwnam (o + 1);
if (pw)
{
nm = p + 1; /* skip the terminator */
#else
nm = p;
-#endif /* VMS */
+#endif /* VMS */
}
+#endif /* not WINDOWSNT */
/* If we don't find a user of that name, leave the name
unchanged; don't move nm forward to p. */
}
}
- if (nm[0] != '/'
+ if (!IS_ANY_SEP (nm[0])
#ifdef VMS
&& !index (nm, ':')
#endif /* not VMS */
-#ifdef MSDOS
+#ifdef DOS_NT
&& drive == -1
-#endif
+#endif /* DOS_NT */
&& !newdir)
{
- newdir = XSTRING (defalt)->data;
+ newdir = XSTRING (default_directory)->data;
}
-#ifdef MSDOS
+#ifdef DOS_NT
if (newdir == 0 && relpath)
newdir = defdir;
-#endif
+#endif /* DOS_NT */
if (newdir != 0)
{
/* Get rid of any slash at the end of newdir. */
/* Adding `length > 1 &&' makes ~ expand into / when homedir
is the root dir. People disagree about whether that is right.
Anyway, we can't take the risk of this change now. */
-#ifdef MSDOS
+#ifdef DOS_NT
if (newdir[1] != ':' && length > 1)
#endif
- if (newdir[length - 1] == '/')
+ if (IS_DIRECTORY_SEP (newdir[length - 1]))
{
unsigned char *temp = (unsigned char *) alloca (length);
bcopy (newdir, temp, length - 1);
/* Now concatenate the directory and name to new space in the stack frame */
tlen += strlen (nm) + 1;
-#ifdef MSDOS
- /* Add reserved space for drive name. */
- target = (unsigned char *) alloca (tlen + 2) + 2;
-#else
+#ifdef DOS_NT
+ /* Add reserved space for drive name. (The Microsoft x86 compiler
+ produces incorrect code if the following two lines are combined.) */
+ target = (unsigned char *) alloca (tlen + 2);
+ target += 2;
+#else /* not DOS_NT */
target = (unsigned char *) alloca (tlen);
-#endif
+#endif /* not DOS_NT */
*target = 0;
if (newdir)
{
#ifndef VMS
- if (nm[0] == 0 || nm[0] == '/')
+ if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0]))
strcpy (target, newdir);
else
#endif
do
o--;
while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
- if (p[1] == '.') /* foo.-.bar ==> bar*/
+ if (p[1] == '.') /* foo.-.bar ==> bar. */
p += 2;
else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
p++, o--;
*o++ = *p++;
}
#else /* not VMS */
- if (*p != '/')
- {
+ if (!IS_DIRECTORY_SEP (*p))
+ {
*o++ = *p++;
}
- else if (!strncmp (p, "//", 2)
-#ifdef APOLLO
- /* // at start of filename is meaningful in Apollo system */
+ else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])
+#if defined (APOLLO) || defined (WINDOWSNT)
+ /* // at start of filename is meaningful in Apollo
+ and WindowsNT systems */
&& o != target
#endif /* APOLLO */
)
o = target;
p++;
}
- else if (p[0] == '/'
+ else if (IS_DIRECTORY_SEP (p[0])
&& p[1] == '.'
- && (p[2] == '/'
+ && (IS_DIRECTORY_SEP (p[2])
|| p[2] == 0))
{
/* If "/." is the entire filename, keep the "/". Otherwise,
*o++ = *p;
p += 2;
}
- else if (!strncmp (p, "/..", 3)
+ else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.'
/* `/../' is the "superroot" on certain file systems. */
&& o != target
- && (p[3] == '/' || p[3] == 0))
+ && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0))
{
- while (o != target && *--o != '/')
+ while (o != target && (--o) && !IS_DIRECTORY_SEP (*o))
;
-#ifdef APOLLO
- if (o == target + 1 && o[-1] == '/' && o[0] == '/')
+#if defined (APOLLO) || defined (WINDOWSNT)
+ if (o == target + 1
+ && IS_DIRECTORY_SEP (o[-1]) && IS_DIRECTORY_SEP (o[0]))
++o;
else
-#endif /* APOLLO */
- if (o == target && *o == '/')
+#endif /* APOLLO || WINDOWSNT */
+ if (o == target && IS_ANY_SEP (*o))
++o;
p += 3;
}
else
- {
+ {
*o++ = *p++;
}
#endif /* not VMS */
}
-#ifdef MSDOS
+#ifdef DOS_NT
/* at last, set drive name. */
- if (target[1] != ':')
+ if (target[1] != ':'
+#ifdef WINDOWSNT
+ /* Allow network paths that look like "\\foo" */
+ && !(IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1]))
+#endif /* WINDOWSNT */
+ )
{
target -= 2;
- target[0] = (drive < 0 ? getdisk () : drive) + 'a';
+ target[0] = (drive < 0 ? getdisk () + 'A' : drive);
target[1] = ':';
}
-#endif
+#endif /* DOS_NT */
return make_string (target, o - target);
}
+
#if 0
-/* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'.
+/* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. */
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\
/* VMS pre V4.4,convert '-'s in filenames. */
if (lbrack == rbrack)
{
- if (dots < 2) /* this is to allow negative version numbers */
+ if (dots < 2) /* this is to allow negative version numbers */
p[0] = '_';
}
else
newdir = 0;
- if (nm[0] == '~') /* prefix ~ */
+ if (nm[0] == '~') /* prefix ~ */
if (nm[1] == '/'
#ifdef VMS
|| nm[1] == ':'
newdir = (unsigned char *) "";
nm++;
#ifdef VMS
- nm++; /* Don't leave the slash in nm. */
+ nm++; /* Don't leave the slash in nm. */
#endif /* VMS */
}
else /* ~user/filename */
unsigned char *ptr1 = index (user, ':');
if (ptr1 != 0 && ptr1 - user < len)
len = ptr1 - user;
-#endif /* VMS */
+#endif /* VMS */
/* Copy the user name into temp storage. */
o = (unsigned char *) alloca (len + 1);
bcopy ((char *) user, o, len);
do
o--;
while (o[-1] != '.' && o[-1] != '[' && o[-1] != '<');
- if (p[1] == '.') /* foo.-.bar ==> bar*/
+ if (p[1] == '.') /* foo.-.bar ==> bar. */
p += 2;
else if (o[-1] == '.') /* '.foo.-]' ==> ']' */
p++, o--;
}
#else /* not VMS */
if (*p != '/')
- {
+ {
*o++ = *p++;
}
else if (!strncmp (p, "//", 2)
p += 3;
}
else
- {
+ {
*o++ = *p++;
}
#endif /* not VMS */
If `/~' appears, all of FILENAME through that `/' is discarded.\n\n\
On VMS, `$' substitution is not done; this function does little and only\n\
duplicates what `expand-file-name' does.")
- (string)
- Lisp_Object string;
+ (filename)
+ Lisp_Object filename;
{
unsigned char *nm;
int total = 0;
int substituted = 0;
unsigned char *xnm;
+ Lisp_Object handler;
- CHECK_STRING (string, 0);
+ CHECK_STRING (filename, 0);
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
+ if (!NILP (handler))
+ return call2 (handler, Qsubstitute_in_file_name, filename);
- nm = XSTRING (string)->data;
- endp = nm + XSTRING (string)->size;
+ nm = XSTRING (filename)->data;
+#ifdef MSDOS
+ dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm));
+ substituted = !strcmp (nm, XSTRING (filename)->data);
+#endif
+ endp = nm + XSTRING (filename)->size;
/* If /~ or // appears, discard everything through first slash. */
/* // at start of file name is meaningful in Apollo system */
(p[0] == '/' && p - 1 != nm)
#else /* not APOLLO */
+#ifdef WINDOWSNT
+ (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm)
+#else /* not WINDOWSNT */
p[0] == '/'
+#endif /* not WINDOWSNT */
#endif /* not APOLLO */
)
- && p != nm &&
+ && p != nm
+ && (0
#ifdef VMS
- (p[-1] == ':' || p[-1] == ']' || p[-1] == '>' ||
-#endif /* VMS */
- p[-1] == '/')
-#ifdef VMS
- )
+ || p[-1] == ':' || p[-1] == ']' || p[-1] == '>'
#endif /* VMS */
+ || IS_DIRECTORY_SEP (p[-1])))
{
nm = p;
substituted = 1;
}
-#ifdef MSDOS
+#ifdef DOS_NT
if (p[0] && p[1] == ':')
{
nm = p;
substituted = 1;
}
-#endif /* MSDOS */
+#endif /* DOS_NT */
}
#ifdef VMS
target = (unsigned char *) alloca (s - o + 1);
strncpy (target, o, s - o);
target[s - o] = 0;
-#ifdef MSDOS
+#ifdef DOS_NT
strupr (target); /* $home == $HOME etc. */
-#endif
+#endif /* DOS_NT */
/* Get variable value */
o = (unsigned char *) egetenv (target);
-/* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
-#if 0
-#ifdef USG
- if (!o && !strcmp (target, "USER"))
- o = egetenv ("LOGNAME");
-#endif /* USG */
-#endif /* 0 */
if (!o) goto badvar;
total += strlen (o);
substituted = 1;
}
if (!substituted)
- return string;
+ return filename;
/* If substitution required, recopy the string and do it */
/* Make space in stack frame for the new copy */
- xnm = (unsigned char *) alloca (XSTRING (string)->size + total + 1);
+ xnm = (unsigned char *) alloca (XSTRING (filename)->size + total + 1);
x = xnm;
/* Copy the rest of the name through, replacing $ constructs with values */
target = (unsigned char *) alloca (s - o + 1);
strncpy (target, o, s - o);
target[s - o] = 0;
-#ifdef MSDOS
+#ifdef DOS_NT
strupr (target); /* $home == $HOME etc. */
-#endif
+#endif /* DOS_NT */
/* Get variable value */
o = (unsigned char *) egetenv (target);
-/* The presence of this code makes vax 5.0 crash, for reasons yet unknown */
-#if 0
-#ifdef USG
- if (!o && !strcmp (target, "USER"))
- o = egetenv ("LOGNAME");
-#endif /* USG */
-#endif /* 0 */
if (!o)
goto badvar;
/* If /~ or // appears, discard everything through first slash. */
for (p = xnm; p != x; p++)
- if ((p[0] == '~' ||
+ if ((p[0] == '~'
#ifdef APOLLO
/* // at start of file name is meaningful in Apollo system */
- (p[0] == '/' && p - 1 != xnm)
+ || (p[0] == '/' && p - 1 != xnm)
#else /* not APOLLO */
- p[0] == '/'
+#ifdef WINDOWSNT
+ || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm)
+#else /* not WINDOWSNT */
+ || p[0] == '/'
+#endif /* not WINDOWSNT */
#endif /* not APOLLO */
)
- && p != nm && p[-1] == '/')
+ && p != nm && IS_DIRECTORY_SEP (p[-1]))
xnm = p;
-#ifdef MSDOS
+#ifdef DOS_NT
else if (p[0] && p[1] == ':')
xnm = p;
#endif
/* Remove final slash, if any (unless path is root).
stat behaves differently depending! */
if (XSTRING (abspath)->size > 1
- && XSTRING (abspath)->data[XSTRING (abspath)->size - 1] == '/')
+ && IS_DIRECTORY_SEP (XSTRING (abspath)->data[XSTRING (abspath)->size - 1])
+ && !IS_DEVICE_SEP (XSTRING (abspath)->data[XSTRING (abspath)->size-2]))
/* We cannot take shortcuts; they might be wrong for magic file names. */
abspath = Fdirectory_file_name (abspath);
#endif
return abspath;
}
\f
-barf_or_query_if_file_exists (absname, querystring, interactive)
+/* Signal an error if the file ABSNAME already exists.
+ If INTERACTIVE is nonzero, ask the user whether to proceed,
+ and bypass the error if the user says to go ahead.
+ QUERYSTRING is a name for the action that is being considered
+ to alter the file.
+ *STATPTR is used to store the stat information if the file exists.
+ If the file does not exist, STATPTR->st_mode is set to 0. */
+
+void
+barf_or_query_if_file_exists (absname, querystring, interactive, statptr)
Lisp_Object absname;
unsigned char *querystring;
int interactive;
+ struct stat *statptr;
{
register Lisp_Object tem;
+ struct stat statbuf;
struct gcpro gcpro1;
- if (access (XSTRING (absname)->data, 4) >= 0)
+ /* stat is a good way to tell whether the file exists,
+ regardless of what access permissions it has. */
+ if (stat (XSTRING (absname)->data, &statbuf) >= 0)
{
if (! interactive)
Fsignal (Qfile_already_exists,
Fsignal (Qfile_already_exists,
Fcons (build_string ("File already exists"),
Fcons (absname, Qnil)));
+ if (statptr)
+ *statptr = statbuf;
+ }
+ else
+ {
+ if (statptr)
+ statptr->st_mode = 0;
}
return;
}
Fourth arg KEEP-TIME non-nil means give the new file the same\n\
last-modified time as the old one. (This works on only some systems.)\n\
A prefix arg makes KEEP-TIME non-nil.")
- (filename, newname, ok_if_already_exists, keep_date)
- Lisp_Object filename, newname, ok_if_already_exists, keep_date;
+ (file, newname, ok_if_already_exists, keep_date)
+ Lisp_Object file, newname, ok_if_already_exists, keep_date;
{
int ifd, ofd, n;
char buf[16 * 1024];
- struct stat st;
+ struct stat st, out_st;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
int count = specpdl_ptr - specpdl;
- Lisp_Object args[6];
int input_file_statable_p;
- GCPRO2 (filename, newname);
- CHECK_STRING (filename, 0);
+ GCPRO2 (file, newname);
+ CHECK_STRING (file, 0);
CHECK_STRING (newname, 1);
- filename = Fexpand_file_name (filename, Qnil);
+ file = Fexpand_file_name (file, Qnil);
newname = Fexpand_file_name (newname, Qnil);
/* If the input file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (file, Qcopy_file);
/* Likewise for output file name. */
if (NILP (handler))
- handler = Ffind_file_name_handler (newname);
+ handler = Ffind_file_name_handler (newname, Qcopy_file);
if (!NILP (handler))
- return call5 (handler, Qcopy_file, filename, newname,
- ok_if_already_exists, keep_date);
+ RETURN_UNGCPRO (call5 (handler, Qcopy_file, file, newname,
+ ok_if_already_exists, keep_date));
if (NILP (ok_if_already_exists)
- || XTYPE (ok_if_already_exists) == Lisp_Int)
+ || INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "copy to it",
- XTYPE (ok_if_already_exists) == Lisp_Int);
+ INTEGERP (ok_if_already_exists), &out_st);
+ else if (stat (XSTRING (newname)->data, &out_st) < 0)
+ out_st.st_mode = 0;
- ifd = open (XSTRING (filename)->data, 0);
+ ifd = open (XSTRING (file)->data, O_RDONLY);
if (ifd < 0)
- report_file_error ("Opening input file", Fcons (filename, Qnil));
+ report_file_error ("Opening input file", Fcons (file, Qnil));
record_unwind_protect (close_file_unwind, make_number (ifd));
copyable by us. */
input_file_statable_p = (fstat (ifd, &st) >= 0);
+#ifndef DOS_NT
+ if (out_st.st_mode != 0
+ && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino)
+ {
+ errno = 0;
+ report_file_error ("Input and output files are the same",
+ Fcons (file, Fcons (newname, Qnil)));
+ }
+#endif
+
#if defined (S_ISREG) && defined (S_ISLNK)
if (input_file_statable_p)
{
/* Get a better looking error message. */
errno = EISDIR;
#endif /* EISDIR */
- report_file_error ("Non-regular file", Fcons (filename, Qnil));
+ report_file_error ("Non-regular file", Fcons (file, Qnil));
}
}
#endif /* S_ISREG && S_ISLNK */
#endif /* not MSDOS */
#endif /* VMS */
if (ofd < 0)
- report_file_error ("Opening output file", Fcons (newname, Qnil));
+ report_file_error ("Opening output file", Fcons (newname, Qnil));
record_unwind_protect (close_file_unwind, make_number (ofd));
QUIT;
while ((n = read (ifd, buf, sizeof buf)) > 0)
if (write (ofd, buf, n) != n)
- report_file_error ("I/O error", Fcons (newname, Qnil));
+ report_file_error ("I/O error", Fcons (newname, Qnil));
immediate_quit = 0;
+ /* Closing the output clobbers the file times on some systems. */
+ if (close (ofd) < 0)
+ report_file_error ("I/O error", Fcons (newname, Qnil));
+
if (input_file_statable_p)
{
if (!NILP (keep_date))
EMACS_TIME atime, mtime;
EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
- EMACS_SET_UTIMES (XSTRING (newname)->data, atime, mtime);
+ if (set_file_times (XSTRING (newname)->data, atime, mtime))
+ report_file_error ("I/O error", Fcons (newname, Qnil));
}
-#ifdef APOLLO
- if (!egetenv ("USE_DOMAIN_ACLS"))
-#endif
+#ifndef MSDOS
+ chmod (XSTRING (newname)->data, st.st_mode & 07777);
+#else /* MSDOS */
+#if defined (__DJGPP__) && __DJGPP__ > 1
+ /* In DJGPP v2.0 and later, fstat usually returns true file mode bits,
+ 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 (XSTRING (newname)->data, st.st_mode & 07777);
+#endif /* DJGPP version 2 or newer */
+#endif /* MSDOS */
}
+ close (ifd);
+
/* Discard the unwind protects. */
specpdl_ptr = specpdl + count;
- close (ifd);
- if (close (ofd) < 0)
- report_file_error ("I/O error", Fcons (newname, Qnil));
-
UNGCPRO;
return Qnil;
}
-
+\f
DEFUN ("make-directory-internal", Fmake_directory_internal,
Smake_directory_internal, 1, 1, 0,
- "Create a directory. One argument, a file name string.")
- (dirname)
- Lisp_Object dirname;
+ "Create a new directory named DIRECTORY.")
+ (directory)
+ Lisp_Object directory;
{
unsigned char *dir;
Lisp_Object handler;
- CHECK_STRING (dirname, 0);
- dirname = Fexpand_file_name (dirname, Qnil);
+ CHECK_STRING (directory, 0);
+ directory = Fexpand_file_name (directory, Qnil);
- handler = Ffind_file_name_handler (dirname);
+ handler = Ffind_file_name_handler (directory, Qmake_directory_internal);
if (!NILP (handler))
- return call3 (handler, Qmake_directory, dirname, Qnil);
+ return call2 (handler, Qmake_directory_internal, directory);
- dir = XSTRING (dirname)->data;
+ dir = XSTRING (directory)->data;
+#ifdef WINDOWSNT
+ if (mkdir (dir) != 0)
+#else
if (mkdir (dir, 0777) != 0)
- report_file_error ("Creating directory", Flist (1, &dirname));
+#endif
+ report_file_error ("Creating directory", Flist (1, &directory));
return Qnil;
}
DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",
- "Delete a directory. One argument, a file name string.")
- (dirname)
- Lisp_Object dirname;
+ "Delete the directory named DIRECTORY.")
+ (directory)
+ Lisp_Object directory;
{
unsigned char *dir;
Lisp_Object handler;
- CHECK_STRING (dirname, 0);
- dirname = Fexpand_file_name (dirname, Qnil);
- dir = XSTRING (dirname)->data;
+ CHECK_STRING (directory, 0);
+ directory = Fdirectory_file_name (Fexpand_file_name (directory, Qnil));
+ dir = XSTRING (directory)->data;
- handler = Ffind_file_name_handler (dirname);
+ handler = Ffind_file_name_handler (directory, Qdelete_directory);
if (!NILP (handler))
- return call2 (handler, Qdelete_directory, dirname);
+ return call2 (handler, Qdelete_directory, directory);
if (rmdir (dir) != 0)
- report_file_error ("Removing directory", Flist (1, &dirname));
+ report_file_error ("Removing directory", Flist (1, &directory));
return Qnil;
}
DEFUN ("delete-file", Fdelete_file, Sdelete_file, 1, 1, "fDelete file: ",
- "Delete specified file. One argument, a file name string.\n\
+ "Delete file named FILENAME.\n\
If file has multiple names, it continues to exist with the other names.")
(filename)
Lisp_Object filename;
CHECK_STRING (filename, 0);
filename = Fexpand_file_name (filename, Qnil);
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qdelete_file);
if (!NILP (handler))
return call2 (handler, Qdelete_file, filename);
return Qnil;
}
+static Lisp_Object
+internal_delete_file_1 (ignore)
+ Lisp_Object ignore;
+{
+ return Qt;
+}
+
+/* Delete file FILENAME, returning 1 if successful and 0 if failed. */
+
+int
+internal_delete_file (filename)
+ Lisp_Object filename;
+{
+ return NILP (internal_condition_case_1 (Fdelete_file, filename,
+ Qt, internal_delete_file_1));
+}
+\f
DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
"fRename file: \nFRename %s to file: \np",
"Rename FILE as NEWNAME. Both args strings.\n\
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
A number as third arg means request confirmation if NEWNAME already exists.\n\
This is what happens in interactive use with M-x.")
- (filename, newname, ok_if_already_exists)
- Lisp_Object filename, newname, ok_if_already_exists;
+ (file, newname, ok_if_already_exists)
+ Lisp_Object file, newname, ok_if_already_exists;
{
#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
- GCPRO2 (filename, newname);
- CHECK_STRING (filename, 0);
+ GCPRO2 (file, newname);
+ CHECK_STRING (file, 0);
CHECK_STRING (newname, 1);
- filename = Fexpand_file_name (filename, Qnil);
+ file = Fexpand_file_name (file, Qnil);
newname = Fexpand_file_name (newname, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (file, Qrename_file);
if (NILP (handler))
- handler = Ffind_file_name_handler (newname);
+ handler = Ffind_file_name_handler (newname, Qrename_file);
if (!NILP (handler))
- return call4 (handler, Qrename_file,
- filename, newname, ok_if_already_exists);
+ RETURN_UNGCPRO (call4 (handler, Qrename_file,
+ file, newname, ok_if_already_exists));
if (NILP (ok_if_already_exists)
- || XTYPE (ok_if_already_exists) == Lisp_Int)
+ || INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "rename to it",
- XTYPE (ok_if_already_exists) == Lisp_Int);
+ INTEGERP (ok_if_already_exists), 0);
#ifndef BSD4_1
- if (0 > rename (XSTRING (filename)->data, XSTRING (newname)->data))
+ if (0 > rename (XSTRING (file)->data, XSTRING (newname)->data))
#else
- if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data)
- || 0 > unlink (XSTRING (filename)->data))
+#ifdef WINDOWSNT
+ if (!MoveFile (XSTRING (file)->data, XSTRING (newname)->data))
+#else /* not WINDOWSNT */
+ if (0 > link (XSTRING (file)->data, XSTRING (newname)->data)
+ || 0 > unlink (XSTRING (file)->data))
+#endif /* not WINDOWSNT */
#endif
{
+#ifdef WINDOWSNT
+ /* Why two? And why doesn't MS document what MoveFile will return? */
+ if (GetLastError () == ERROR_FILE_EXISTS
+ || GetLastError () == ERROR_ALREADY_EXISTS)
+#else /* not WINDOWSNT */
if (errno == EXDEV)
+#endif /* not WINDOWSNT */
{
- Fcopy_file (filename, newname,
+ 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);
- Fdelete_file (filename);
+ Fdelete_file (file);
}
else
#ifdef NO_ARG_ARRAY
{
- args[0] = filename;
+ args[0] = file;
args[1] = newname;
report_file_error ("Renaming", Flist (2, args));
}
#else
- report_file_error ("Renaming", Flist (2, &filename));
+ report_file_error ("Renaming", Flist (2, &file));
#endif
}
UNGCPRO;
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
A number as third arg means request confirmation if NEWNAME already exists.\n\
This is what happens in interactive use with M-x.")
- (filename, newname, ok_if_already_exists)
- Lisp_Object filename, newname, ok_if_already_exists;
+ (file, newname, ok_if_already_exists)
+ Lisp_Object file, newname, ok_if_already_exists;
{
#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
- GCPRO2 (filename, newname);
- CHECK_STRING (filename, 0);
+ GCPRO2 (file, newname);
+ CHECK_STRING (file, 0);
CHECK_STRING (newname, 1);
- filename = Fexpand_file_name (filename, Qnil);
+ file = Fexpand_file_name (file, Qnil);
newname = Fexpand_file_name (newname, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (file, Qadd_name_to_file);
if (!NILP (handler))
- return call4 (handler, Qadd_name_to_file, filename, newname,
- ok_if_already_exists);
+ RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
+ newname, ok_if_already_exists));
+
+ /* If the new name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (newname, Qadd_name_to_file);
+ if (!NILP (handler))
+ RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, file,
+ newname, ok_if_already_exists));
if (NILP (ok_if_already_exists)
- || XTYPE (ok_if_already_exists) == Lisp_Int)
+ || INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "make it a new name",
- XTYPE (ok_if_already_exists) == Lisp_Int);
+ INTEGERP (ok_if_already_exists), 0);
+#ifdef WINDOWSNT
+ /* Windows does not support this operation. */
+ report_file_error ("Adding new name", Flist (2, &file));
+#else /* not WINDOWSNT */
+
unlink (XSTRING (newname)->data);
- if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data))
+ if (0 > link (XSTRING (file)->data, XSTRING (newname)->data))
{
#ifdef NO_ARG_ARRAY
- args[0] = filename;
+ args[0] = file;
args[1] = newname;
report_file_error ("Adding new name", Flist (2, args));
#else
- report_file_error ("Adding new name", Flist (2, &filename));
+ report_file_error ("Adding new name", Flist (2, &file));
#endif
}
+#endif /* not WINDOWSNT */
UNGCPRO;
return Qnil;
DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
"FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
"Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
-Signals a `file-already-exists' error if a file NEWNAME already exists\n\
+Signals a `file-already-exists' error if a file LINKNAME already exists\n\
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
-A number as third arg means request confirmation if NEWNAME already exists.\n\
+A number as third arg means request confirmation if LINKNAME already exists.\n\
This happens for interactive use with M-x.")
(filename, linkname, ok_if_already_exists)
Lisp_Object filename, linkname, ok_if_already_exists;
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
if (!NILP (handler))
- return call4 (handler, Qmake_symbolic_link, filename, linkname,
- ok_if_already_exists);
+ RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
+ linkname, ok_if_already_exists));
+
+ /* If the new link name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link);
+ if (!NILP (handler))
+ RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
+ linkname, ok_if_already_exists));
if (NILP (ok_if_already_exists)
- || XTYPE (ok_if_already_exists) == Lisp_Int)
+ || INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (linkname, "make it a link",
- XTYPE (ok_if_already_exists) == Lisp_Int);
+ INTEGERP (ok_if_already_exists), 0);
if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
{
/* If we didn't complain already, silently delete existing file. */
{
unlink (XSTRING (linkname)->data);
if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
- return Qnil;
+ {
+ UNGCPRO;
+ return Qnil;
+ }
}
#ifdef NO_ARG_ARRAY
2, 2, "sDefine logical name: \nsDefine logical name %s as: ",
"Define the job-wide logical name NAME to have the value STRING.\n\
If STRING is nil or a null string, the logical name NAME is deleted.")
- (varname, string)
- Lisp_Object varname;
+ (name, string)
+ Lisp_Object name;
Lisp_Object string;
{
- CHECK_STRING (varname, 0);
+ CHECK_STRING (name, 0);
if (NILP (string))
- delete_logical_name (XSTRING (varname)->data);
+ delete_logical_name (XSTRING (name)->data);
else
{
CHECK_STRING (string, 1);
if (XSTRING (string)->size == 0)
- delete_logical_name (XSTRING (varname)->data);
+ delete_logical_name (XSTRING (name)->data);
else
- define_logical_name (XSTRING (varname)->data, XSTRING (string)->data);
+ define_logical_name (XSTRING (name)->data, XSTRING (string)->data);
}
return string;
CHECK_STRING (filename, 0);
ptr = XSTRING (filename)->data;
- if (*ptr == '/' || *ptr == '~'
+ 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 MSDOS
- || (*ptr != 0 && ptr[1] == ':' && ptr[2] == '/')
+#ifdef DOS_NT
+ || (*ptr != 0 && ptr[1] == ':' && (ptr[2] == '/' || ptr[2] == '\\'))
#endif
)
return Qt;
else
return Qnil;
}
+\f
+/* Return nonzero if file FILENAME exists and can be executed. */
+
+static int
+check_executable (filename)
+ char *filename;
+{
+#ifdef DOS_NT
+ int len = strlen (filename);
+ char *suffix;
+ struct stat st;
+ if (stat (filename, &st) < 0)
+ return 0;
+ return (S_ISREG (st.st_mode)
+ && len >= 5
+ && (stricmp ((suffix = filename + len-4), ".com") == 0
+ || stricmp (suffix, ".exe") == 0
+ || stricmp (suffix, ".bat") == 0)
+ || (st.st_mode & S_IFMT) == S_IFDIR);
+#else /* not DOS_NT */
+#ifdef HAVE_EACCESS
+ return (eaccess (filename, 1) >= 0);
+#else
+ /* Access isn't quite right because it uses the real uid
+ and we really want to test with the effective uid.
+ But Unix doesn't give us a right way to do it. */
+ return (access (filename, 1) >= 0);
+#endif
+#endif /* not DOS_NT */
+}
+
+/* Return nonzero if file FILENAME exists and can be written. */
+
+static int
+check_writable (filename)
+ char *filename;
+{
+#ifdef MSDOS
+ struct stat st;
+ if (stat (filename, &st) < 0)
+ return 0;
+ return (st.st_mode & S_IWRITE || (st.st_mode & S_IFMT) == S_IFDIR);
+#else /* not MSDOS */
+#ifdef HAVE_EACCESS
+ return (eaccess (filename, 2) >= 0);
+#else
+ /* Access isn't quite right because it uses the real uid
+ and we really want to test with the effective uid.
+ But Unix doesn't give us a right way to do it.
+ Opening with O_WRONLY could work for an ordinary file,
+ but would lose for directories. */
+ return (access (filename, 2) >= 0);
+#endif
+#endif /* not MSDOS */
+}
DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
"Return t if file FILENAME exists. (This does not mean you can read it.)\n\
{
Lisp_Object abspath;
Lisp_Object handler;
+ struct stat statbuf;
CHECK_STRING (filename, 0);
abspath = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath);
+ handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
if (!NILP (handler))
return call2 (handler, Qfile_exists_p, abspath);
- return (access (XSTRING (abspath)->data, 0) >= 0) ? Qt : Qnil;
+ return (stat (XSTRING (abspath)->data, &statbuf) >= 0) ? Qt : Qnil;
}
DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath);
+ handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
if (!NILP (handler))
return call2 (handler, Qfile_executable_p, abspath);
- return (access (XSTRING (abspath)->data, 1) >= 0) ? Qt : Qnil;
+ return (check_executable (XSTRING (abspath)->data) ? Qt : Qnil);
}
DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
{
Lisp_Object abspath;
Lisp_Object handler;
+ int desc;
CHECK_STRING (filename, 0);
abspath = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath);
+ handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
if (!NILP (handler))
return call2 (handler, Qfile_readable_p, abspath);
- return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil;
+#ifdef MSDOS
+ /* Under MS-DOS, open does not work't right, because it doesn't work for
+ directories (MS-DOS won't let you open a directory). */
+ if (access (XSTRING (abspath)->data, 0) == 0)
+ return Qt;
+ return Qnil;
+#else /* not MSDOS */
+ desc = open (XSTRING (abspath)->data, O_RDONLY);
+ if (desc < 0)
+ return Qnil;
+ close (desc);
+ return Qt;
+#endif /* not MSDOS */
}
+/* Having this before file-symlink-p mysteriously caused it to be forgotten
+ on the RT/PC. */
+DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
+ "Return t if file FILENAME can be written or created by you.")
+ (filename)
+ Lisp_Object filename;
+{
+ Lisp_Object abspath, dir;
+ Lisp_Object handler;
+ struct stat statbuf;
+
+ CHECK_STRING (filename, 0);
+ abspath = Fexpand_file_name (filename, Qnil);
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
+ if (!NILP (handler))
+ return call2 (handler, Qfile_writable_p, abspath);
+
+ if (stat (XSTRING (abspath)->data, &statbuf) >= 0)
+ return (check_writable (XSTRING (abspath)->data)
+ ? Qt : Qnil);
+ dir = Ffile_name_directory (abspath);
+#ifdef VMS
+ if (!NILP (dir))
+ dir = Fdirectory_file_name (dir);
+#endif /* VMS */
+#ifdef MSDOS
+ if (!NILP (dir))
+ dir = Fdirectory_file_name (dir);
+#endif /* MSDOS */
+ return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "")
+ ? Qt : Qnil);
+}
+\f
DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
"Return non-nil if file FILENAME is the name of a symbolic link.\n\
The value is the name of the file to which it is linked.\n\
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
if (!NILP (handler))
return call2 (handler, Qfile_symlink_p, filename);
#endif /* not S_IFLNK */
}
-#ifdef SOLARIS_BROKEN_ACCESS
-/* In Solaris 2.1, the readonly-ness of the filesystem is not
- considered by the access system call. This is Sun's bug, but we
- still have to make Emacs work. */
-
-#include <sys/statvfs.h>
-
-static int
-ro_fsys (path)
- char *path;
-{
- struct statvfs statvfsb;
-
- if (statvfs(path, &statvfsb))
- return 1; /* error from statvfs, be conservative and say not wrtable */
- else
- /* Otherwise, fsys is ro if bit is set. */
- return statvfsb.f_flag & ST_RDONLY;
-}
-#else
-/* But on every other os, access has already done the right thing. */
-#define ro_fsys(path) 0
-#endif
-
-/* Having this before file-symlink-p mysteriously caused it to be forgotten
- on the RT/PC. */
-DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
- "Return t if file FILENAME can be written or created by you.")
- (filename)
- Lisp_Object filename;
-{
- Lisp_Object abspath, dir;
- Lisp_Object handler;
-
- CHECK_STRING (filename, 0);
- abspath = Fexpand_file_name (filename, Qnil);
-
- /* If the file name has special constructs in it,
- call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath);
- if (!NILP (handler))
- return call2 (handler, Qfile_writable_p, abspath);
-
- if (access (XSTRING (abspath)->data, 0) >= 0)
- return ((access (XSTRING (abspath)->data, 2) >= 0
- && ! ro_fsys ((char *) XSTRING (abspath)->data))
- ? Qt : Qnil);
- dir = Ffile_name_directory (abspath);
-#ifdef VMS
- if (!NILP (dir))
- dir = Fdirectory_file_name (dir);
-#endif /* VMS */
-#ifdef MSDOS
- if (!NILP (dir))
- dir = Fdirectory_file_name (dir);
-#endif /* MSDOS */
- return ((access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0
- && ! ro_fsys ((char *) XSTRING (dir)->data))
- ? Qt : Qnil);
-}
-
DEFUN ("file-directory-p", Ffile_directory_p, Sfile_directory_p, 1, 1, 0,
"Return t if file FILENAME is the name of a directory as a file.\n\
A directory name spec may be given instead; then the value is t\n\
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath);
+ handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
if (!NILP (handler))
return call2 (handler, Qfile_directory_p, abspath);
Lisp_Object filename;
{
Lisp_Object handler;
+ int tem;
+ struct gcpro gcpro1;
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
if (!NILP (handler))
return call2 (handler, Qfile_accessible_directory_p, filename);
- if (NILP (Ffile_directory_p (filename))
- || NILP (Ffile_executable_p (filename)))
- return Qnil;
- else
- return Qt;
+ /* It's an unlikely combination, but yes we really do need to gcpro:
+ Suppose that file-accessible-directory-p has no handler, but
+ file-directory-p does have a handler; this handler causes a GC which
+ relocates the string in `filename'; and finally file-directory-p
+ returns non-nil. Then we would end up passing a garbaged string
+ to file-executable-p. */
+ GCPRO1 (filename);
+ tem = (NILP (Ffile_directory_p (filename))
+ || NILP (Ffile_executable_p (filename)));
+ UNGCPRO;
+ return tem ? Qnil : Qt;
}
+DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0,
+ "Return t if file FILENAME is the name of a regular file.\n\
+This is the sort of file that holds an ordinary stream of data bytes.")
+ (filename)
+ Lisp_Object filename;
+{
+ register Lisp_Object abspath;
+ struct stat st;
+ Lisp_Object handler;
+
+ abspath = expand_and_dir_to_file (filename, current_buffer->directory);
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (abspath, Qfile_regular_p);
+ if (!NILP (handler))
+ return call2 (handler, Qfile_regular_p, abspath);
+
+ if (stat (XSTRING (abspath)->data, &st) < 0)
+ return Qnil;
+ return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
+}
+\f
DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
- "Return mode bits of FILE, as an integer.")
+ "Return mode bits of file named FILENAME, as an integer.")
(filename)
Lisp_Object filename;
{
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath);
+ handler = Ffind_file_name_handler (abspath, Qfile_modes);
if (!NILP (handler))
return call2 (handler, Qfile_modes, abspath);
if (stat (XSTRING (abspath)->data, &st) < 0)
return Qnil;
+#ifdef DOS_NT
+ if (check_executable (XSTRING (abspath)->data))
+ st.st_mode |= S_IEXEC;
+#endif /* DOS_NT */
+
return make_number (st.st_mode & 07777);
}
DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2, 0,
- "Set mode bits of FILE to MODE (an integer).\n\
+ "Set mode bits of file named FILENAME to MODE (an integer).\n\
Only the 12 low bits of MODE are used.")
(filename, mode)
Lisp_Object filename, mode;
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath);
+ handler = Ffind_file_name_handler (abspath, Qset_file_modes);
if (!NILP (handler))
return call3 (handler, Qset_file_modes, abspath, mode);
-#ifndef APOLLO
if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
report_file_error ("Doing chmod", Fcons (abspath, Qnil));
-#else /* APOLLO */
- if (!egetenv ("USE_DOMAIN_ACLS"))
- {
- struct stat st;
- struct timeval tvp[2];
-
- /* chmod on apollo also change the file's modtime; need to save the
- modtime and then restore it. */
- if (stat (XSTRING (abspath)->data, &st) < 0)
- {
- report_file_error ("Doing chmod", Fcons (abspath, Qnil));
- return (Qnil);
- }
-
- if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0)
- report_file_error ("Doing chmod", Fcons (abspath, Qnil));
-
- /* reset the old accessed and modified times. */
- tvp[0].tv_sec = st.st_atime + 1; /* +1 due to an Apollo roundoff bug */
- tvp[0].tv_usec = 0;
- tvp[1].tv_sec = st.st_mtime + 1; /* +1 due to an Apollo roundoff bug */
- tvp[1].tv_usec = 0;
-
- if (utimes (XSTRING (abspath)->data, tvp) < 0)
- report_file_error ("Doing utimes", Fcons (abspath, Qnil));
- }
-#endif /* APOLLO */
return Qnil;
}
realmask = umask (0);
umask (realmask);
- XSET (value, Lisp_Int, (~ realmask) & 0777);
+ XSETINT (value, (~ realmask) & 0777);
return value;
}
-
+\f
#ifdef unix
DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath1);
+ handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
if (NILP (handler))
- handler = Ffind_file_name_handler (abspath2);
+ handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
if (!NILP (handler))
return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2);
return (mtime1 > st.st_mtime) ? Qt : Qnil;
}
\f
-#ifdef MSDOS
+#ifdef DOS_NT
Lisp_Object Qfind_buffer_file_type;
-#endif
+#endif /* DOS_NT */
DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
- 1, 4, 0,
+ 1, 5, 0,
"Insert contents of file FILENAME after point.\n\
Returns list of absolute file name and length of data inserted.\n\
If second argument VISIT is non-nil, the buffer's visited filename\n\
before the error is signaled.\n\n\
The optional third and fourth arguments BEG and END\n\
specify what portion of the file to insert.\n\
-If VISIT is non-nil, BEG and END must be nil.")
- (filename, visit, beg, end)
- Lisp_Object filename, visit, beg, end;
+If VISIT is non-nil, BEG and END must be nil.\n\
+If optional fifth argument REPLACE is non-nil,\n\
+it means replace the current buffer contents (in the accessible portion)\n\
+with the file contents. This is better than simply deleting and inserting\n\
+the whole thing because (1) it preserves some marker positions\n\
+and (2) it puts less data in the undo list.")
+ (filename, visit, beg, end, replace)
+ Lisp_Object filename, visit, beg, end, replace;
{
struct stat st;
register int fd;
register int inserted = 0;
register int how_much;
int count = specpdl_ptr - specpdl;
- struct gcpro gcpro1, gcpro2;
+ struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object handler, val, insval;
Lisp_Object p;
int total;
+ int not_regular = 0;
+
+ if (current_buffer->base_buffer && ! NILP (visit))
+ error ("Cannot do file visiting in an indirect buffer");
+
+ if (!NILP (current_buffer->read_only))
+ Fbarf_if_buffer_read_only ();
val = Qnil;
p = Qnil;
- GCPRO2 (filename, p);
- if (!NILP (current_buffer->read_only))
- Fbarf_if_buffer_read_only();
+ GCPRO3 (filename, val, p);
CHECK_STRING (filename, 0);
filename = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
if (!NILP (handler))
{
- val = call5 (handler, Qinsert_file_contents, filename, visit, beg, end);
+ val = call6 (handler, Qinsert_file_contents, filename,
+ visit, beg, end, replace);
goto handled;
}
fd = -1;
#ifndef APOLLO
- if (stat (XSTRING (filename)->data, &st) < 0
- || (fd = open (XSTRING (filename)->data, 0)) < 0)
+ if (stat (XSTRING (filename)->data, &st) < 0)
#else
- if ((fd = open (XSTRING (filename)->data, 0)) < 0
+ if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0
|| fstat (fd, &st) < 0)
#endif /* not APOLLO */
{
if (fd >= 0) close (fd);
+ badopen:
if (NILP (visit))
report_file_error ("Opening input file", Fcons (filename, Qnil));
st.st_mtime = -1;
goto notfound;
}
- record_unwind_protect (close_file_unwind, make_number (fd));
-
-#ifdef S_IFSOCK
+#ifdef S_IFREG
/* This code will need to be changed in order to work on named
pipes, and it's probably just not worth it. So we should at
least signal an error. */
- if ((st.st_mode & S_IFMT) == S_IFSOCK)
- Fsignal (Qfile_error,
- Fcons (build_string ("reading from named pipe"),
- Fcons (filename, Qnil)));
+ if (!S_ISREG (st.st_mode))
+ {
+ if (NILP (visit))
+ Fsignal (Qfile_error,
+ Fcons (build_string ("not a regular file"),
+ Fcons (filename, Qnil)));
+
+ not_regular = 1;
+ goto notfound;
+ }
#endif
+ if (fd < 0)
+ if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0)
+ goto badopen;
+
+ /* Replacement should preserve point as it preserves markers. */
+ if (!NILP (replace))
+ record_unwind_protect (restore_point_unwind, Fpoint_marker ());
+
+ record_unwind_protect (close_file_unwind, make_number (fd));
+
/* Supposedly happens on VMS. */
if (st.st_size < 0)
error ("File size is negative");
if (!NILP (beg))
CHECK_NUMBER (beg, 0);
else
- XFASTINT (beg) = 0;
+ XSETFASTINT (beg, 0);
if (!NILP (end))
CHECK_NUMBER (end, 0);
error ("maximum buffer size exceeded");
}
+ /* If requested, replace the accessible part of the buffer
+ with the file contents. Avoid replacing text at the
+ beginning or end of the buffer that matches the file contents;
+ that preserves markers pointing to the unchanged parts. */
+#ifdef DOS_NT
+ /* On MSDOS, replace mode doesn't really work, except for binary files,
+ and it's not worth supporting just for them. */
+ if (!NILP (replace))
+ {
+ replace = Qnil;
+ XSETFASTINT (beg, 0);
+ XSETFASTINT (end, st.st_size);
+ del_range_1 (BEGV, ZV, 0);
+ }
+#else /* not DOS_NT */
+ if (!NILP (replace))
+ {
+ unsigned char buffer[1 << 14];
+ int same_at_start = BEGV;
+ int same_at_end = ZV;
+ int overlap;
+
+ immediate_quit = 1;
+ QUIT;
+ /* Count how many chars at the start of the file
+ match the text at the beginning of the buffer. */
+ while (1)
+ {
+ int nread, bufpos;
+
+ nread = read (fd, buffer, sizeof buffer);
+ if (nread < 0)
+ error ("IO error reading %s: %s",
+ XSTRING (filename)->data, strerror (errno));
+ else if (nread == 0)
+ break;
+ bufpos = 0;
+ while (bufpos < nread && same_at_start < ZV
+ && FETCH_CHAR (same_at_start) == buffer[bufpos])
+ same_at_start++, bufpos++;
+ /* If we found a discrepancy, stop the scan.
+ Otherwise loop around and scan the next bufferful. */
+ if (bufpos != nread)
+ break;
+ }
+ immediate_quit = 0;
+ /* If the file matches the buffer completely,
+ there's no need to replace anything. */
+ if (same_at_start - BEGV == st.st_size)
+ {
+ close (fd);
+ specpdl_ptr--;
+ /* Truncate the buffer to the size of the file. */
+ del_range_1 (same_at_start, same_at_end, 0);
+ goto handled;
+ }
+ immediate_quit = 1;
+ QUIT;
+ /* Count how many chars at the end of the file
+ match the text at the end of the buffer. */
+ while (1)
+ {
+ int total_read, nread, bufpos, curpos, trial;
+
+ /* At what file position are we now scanning? */
+ curpos = st.st_size - (ZV - same_at_end);
+ /* If the entire file matches the buffer tail, stop the scan. */
+ if (curpos == 0)
+ break;
+ /* How much can we scan in the next step? */
+ trial = min (curpos, sizeof buffer);
+ if (lseek (fd, curpos - trial, 0) < 0)
+ report_file_error ("Setting file position",
+ Fcons (filename, Qnil));
+
+ total_read = 0;
+ while (total_read < trial)
+ {
+ nread = read (fd, buffer + total_read, trial - total_read);
+ if (nread <= 0)
+ error ("IO error reading %s: %s",
+ XSTRING (filename)->data, strerror (errno));
+ total_read += nread;
+ }
+ /* Scan this bufferful from the end, comparing with
+ the Emacs buffer. */
+ bufpos = total_read;
+ /* Compare with same_at_start to avoid counting some buffer text
+ as matching both at the file's beginning and at the end. */
+ while (bufpos > 0 && same_at_end > same_at_start
+ && FETCH_CHAR (same_at_end - 1) == buffer[bufpos - 1])
+ same_at_end--, bufpos--;
+ /* If we found a discrepancy, stop the scan.
+ Otherwise loop around and scan the preceding bufferful. */
+ if (bufpos != 0)
+ break;
+ /* If display current starts at beginning of line,
+ keep it that way. */
+ if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer)
+ XWINDOW (selected_window)->start_at_line_beg = Fbolp ();
+ }
+ immediate_quit = 0;
+
+ /* Don't try to reuse the same piece of text twice. */
+ overlap = same_at_start - BEGV - (same_at_end + st.st_size - ZV);
+ if (overlap > 0)
+ same_at_end += overlap;
+
+ /* Arrange to read only the nonmatching middle part of the file. */
+ XSETFASTINT (beg, same_at_start - BEGV);
+ XSETFASTINT (end, st.st_size - (ZV - same_at_end));
+
+ del_range_1 (same_at_start, same_at_end, 0);
+ /* Insert from the file at the proper position. */
+ SET_PT (same_at_start);
+ }
+#endif /* not DOS_NT */
+
total = XINT (end) - XINT (beg);
{
register Lisp_Object temp;
/* Make sure point-max won't overflow after this insertion. */
- XSET (temp, Lisp_Int, total);
+ XSETINT (temp, total);
if (total != XINT (temp))
error ("maximum buffer size exceeded");
}
if (GAP_SIZE < total)
make_gap (total - GAP_SIZE);
- if (XINT (beg) != 0)
+ if (XINT (beg) != 0 || !NILP (replace))
{
if (lseek (fd, XINT (beg), 0) < 0)
report_file_error ("Setting file position", Fcons (filename, Qnil));
}
- while (1)
+ how_much = 0;
+ while (inserted < total)
{
- int try = min (total - inserted, 64 << 10);
+ /* try is reserved in some compilers (Microsoft C) */
+ int trytry = min (total - inserted, 64 << 10);
int this;
/* Allow quitting out of the actual I/O. */
immediate_quit = 1;
QUIT;
- this = read (fd, &FETCH_CHAR (point + inserted - 1) + 1, try);
+ this = read (fd, &FETCH_CHAR (point + inserted - 1) + 1, trytry);
immediate_quit = 0;
if (this <= 0)
inserted += this;
}
-#ifdef MSDOS
+#ifdef DOS_NT
/* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */
/* Determine file type from name and remove LFs from CR-LFs if the file
is deemed to be a text file. */
{
- struct gcpro gcpro1;
- Lisp_Object code = Qnil;
- GCPRO1 (filename);
- code = call1 (Qfind_buffer_file_type, filename);
- UNGCPRO;
- if (XTYPE (code) == Lisp_Int)
- XFASTINT (current_buffer->buffer_file_type) = XFASTINT (code);
- if (XFASTINT (current_buffer->buffer_file_type) == 0)
+ current_buffer->buffer_file_type
+ = call1 (Qfind_buffer_file_type, filename);
+ if (NILP (current_buffer->buffer_file_type))
{
- int reduced_size =
- inserted - crlf_to_lf (inserted, &FETCH_CHAR (point - 1) + 1);
+ int reduced_size
+ = inserted - crlf_to_lf (inserted, &FETCH_CHAR (point - 1) + 1);
ZV -= reduced_size;
Z -= reduced_size;
GPT -= reduced_size;
inserted -= reduced_size;
}
}
-#endif
+#endif /* DOS_NT */
if (inserted > 0)
{
close (fd);
- /* Discard the unwind protect */
- specpdl_ptr = specpdl + count;
+ /* Discard the unwind protect for closing the file. */
+ specpdl_ptr--;
if (how_much < 0)
error ("IO error reading %s: %s",
if (!NILP (visit))
{
- current_buffer->undo_list = Qnil;
+ if (!EQ (current_buffer->undo_list, Qt))
+ current_buffer->undo_list = Qnil;
#ifdef APOLLO
stat (XSTRING (filename)->data, &st);
#endif
current_buffer->filename = filename;
}
- current_buffer->save_modified = MODIFF;
+ SAVE_MODIFF = MODIFF;
current_buffer->auto_save_modified = MODIFF;
- XFASTINT (current_buffer->save_length) = Z - BEG;
+ XSETFASTINT (current_buffer->save_length, Z - BEG);
#ifdef CLASH_DETECTION
if (NILP (handler))
{
- if (!NILP (current_buffer->filename))
- unlock_file (current_buffer->filename);
+ if (!NILP (current_buffer->file_truename))
+ unlock_file (current_buffer->file_truename);
unlock_file (filename);
}
#endif /* CLASH_DETECTION */
+ if (not_regular)
+ Fsignal (Qfile_error,
+ Fcons (build_string ("not a regular file"),
+ Fcons (filename, Qnil)));
+
/* If visiting nonexistent file, return nil. */
if (current_buffer->modtime == -1)
report_file_error ("Opening input file", Fcons (filename, Qnil));
}
+ /* Decode file format */
+ if (inserted > 0)
+ {
+ insval = call3 (Qformat_decode,
+ Qnil, make_number (inserted), visit);
+ CHECK_NUMBER (insval, 0);
+ inserted = XFASTINT (insval);
+ }
+
if (inserted > 0 && NILP (visit) && total > 0)
signal_after_change (point, 0, inserted);
}
}
- if (!NILP (val))
- RETURN_UNGCPRO (val);
- RETURN_UNGCPRO (Fcons (filename,
- Fcons (make_number (inserted),
- Qnil)));
+ if (NILP (val))
+ val = Fcons (filename,
+ Fcons (make_number (inserted),
+ Qnil));
+
+ RETURN_UNGCPRO (unbind_to (count, val));
}
\f
static Lisp_Object build_annotations ();
-DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 5,
+/* If build_annotations switched buffers, switch back to BUF.
+ Kill the temporary buffer that was selected in the meantime. */
+
+static Lisp_Object
+build_annotations_unwind (buf)
+ Lisp_Object buf;
+{
+ Lisp_Object tembuf;
+
+ if (XBUFFER (buf) == current_buffer)
+ return Qnil;
+ tembuf = Fcurrent_buffer ();
+ Fset_buffer (buf);
+ Fkill_buffer (tembuf);
+ return Qnil;
+}
+
+DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 6,
"r\nFWrite region to file: ",
"Write current region into specified file.\n\
When called from a program, takes three arguments:\n\
VISIT is also the file name to lock and unlock for clash detection.\n\
If VISIT is neither t nor nil nor a string,\n\
that means do not print the \"Wrote file\" message.\n\
+The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\
+ use for locking and unlocking, overriding FILENAME and VISIT.\n\
Kludgy feature: if START is a string, then that string is written\n\
to the file, instead of any buffer contents, and END is ignored.")
- (start, end, filename, append, visit)
- Lisp_Object start, end, filename, append, visit;
+ (start, end, filename, append, visit, lockname)
+ Lisp_Object start, end, filename, append, visit, lockname;
{
register int desc;
int failure;
struct stat st;
int tem;
int count = specpdl_ptr - specpdl;
+ int count1;
#ifdef VMS
- unsigned char *fname = 0; /* If non-0, original filename (must rename) */
+ unsigned char *fname = 0; /* If non-0, original filename (must rename) */
#endif /* VMS */
Lisp_Object handler;
Lisp_Object visit_file;
Lisp_Object annotations;
int visiting, quietly;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-#ifdef MSDOS
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+ struct buffer *given_buffer;
+#ifdef DOS_NT
int buffer_file_type
= NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY;
-#endif
+#endif /* DOS_NT */
+
+ if (current_buffer->base_buffer && ! NILP (visit))
+ error ("Cannot do file visiting in an indirect buffer");
if (!NILP (start) && !STRINGP (start))
validate_region (&start, &end);
+ GCPRO3 (filename, visit, lockname);
filename = Fexpand_file_name (filename, Qnil);
if (STRINGP (visit))
visit_file = Fexpand_file_name (visit, Qnil);
else
visit_file = filename;
+ UNGCPRO;
visiting = (EQ (visit, Qt) || STRINGP (visit));
quietly = !NILP (visit);
annotations = Qnil;
- GCPRO4 (start, filename, annotations, visit_file);
+ if (NILP (lockname))
+ lockname = visit_file;
+
+ GCPRO5 (start, filename, annotations, visit_file, lockname);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qwrite_region);
/* If FILENAME has no handler, see if VISIT has one. */
- if (NILP (handler) && XTYPE (visit) == Lisp_String)
- handler = Ffind_file_name_handler (visit);
+ if (NILP (handler) && STRINGP (visit))
+ handler = Ffind_file_name_handler (visit, Qwrite_region);
if (!NILP (handler))
{
if (visiting)
{
- current_buffer->save_modified = MODIFF;
- XFASTINT (current_buffer->save_length) = Z - BEG;
+ SAVE_MODIFF = MODIFF;
+ XSETFASTINT (current_buffer->save_length, Z - BEG);
current_buffer->filename = visit_file;
}
UNGCPRO;
/* Special kludge to simplify auto-saving. */
if (NILP (start))
{
- XFASTINT (start) = BEG;
- XFASTINT (end) = Z;
+ XSETFASTINT (start, BEG);
+ XSETFASTINT (end, Z);
}
+ record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
+ count1 = specpdl_ptr - specpdl;
+
+ given_buffer = current_buffer;
annotations = build_annotations (start, end);
+ if (current_buffer != given_buffer)
+ {
+ start = BEGV;
+ end = ZV;
+ }
#ifdef CLASH_DETECTION
if (!auto_saving)
- lock_file (visit_file);
+ lock_file (lockname);
#endif /* CLASH_DETECTION */
fn = XSTRING (filename)->data;
desc = -1;
if (!NILP (append))
-#ifdef MSDOS
+#ifdef DOS_NT
desc = open (fn, O_WRONLY | buffer_file_type);
-#else
+#else /* not DOS_NT */
desc = open (fn, O_WRONLY);
-#endif
+#endif /* not DOS_NT */
if (desc < 0)
#ifdef VMS
- if (auto_saving) /* Overwrite any previous version of autosave file */
+ if (auto_saving) /* Overwrite any previous version of autosave file */
{
- vms_truncate (fn); /* if fn exists, truncate to zero length */
+ vms_truncate (fn); /* if fn exists, truncate to zero length */
desc = open (fn, O_RDWR);
if (desc < 0)
desc = creat_copy_attrs (STRINGP (current_buffer->filename)
? XSTRING (current_buffer->filename)->data : 0,
fn);
}
- else /* Write to temporary name and rename if no errors */
+ else /* Write to temporary name and rename if no errors */
{
Lisp_Object temp_name;
temp_name = Ffile_name_directory (filename);
desc = creat (fn, 0666);
}
#else /* not VMS */
-#ifdef MSDOS
+#ifdef DOS_NT
desc = open (fn,
O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type,
S_IREAD | S_IWRITE);
-#else /* not MSDOS */
+#else /* not DOS_NT */
desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666);
-#endif /* not MSDOS */
+#endif /* not DOS_NT */
#endif /* not VMS */
UNGCPRO;
{
#ifdef CLASH_DETECTION
save_errno = errno;
- if (!auto_saving) unlock_file (visit_file);
+ if (!auto_saving) unlock_file (lockname);
errno = save_errno;
#endif /* CLASH_DETECTION */
report_file_error ("Opening output file", Fcons (filename, Qnil));
if (lseek (desc, 0, 2) < 0)
{
#ifdef CLASH_DETECTION
- if (!auto_saving) unlock_file (visit_file);
+ if (!auto_saving) unlock_file (lockname);
#endif /* CLASH_DETECTION */
report_file_error ("Lseek error", Fcons (filename, Qnil));
}
nwritten += XINT (end) - tem;
save_errno = errno;
}
-
- if (nwritten == 0)
- {
- /* If file was empty, still need to write the annotations */
- failure = 0 > a_write (desc, "", 0, XINT (start), &annotations);
- save_errno = errno;
- }
+ }
+ else
+ {
+ /* If file was empty, still need to write the annotations */
+ failure = 0 > a_write (desc, "", 0, XINT (start), &annotations);
+ save_errno = errno;
}
immediate_quit = 0;
/* 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)
- failure = 1, save_errno = errno;
+ {
+ /* If fsync fails with EINTR, don't treat that as serious. */
+ if (errno != EINTR)
+ failure = 1, save_errno = errno;
+ }
#endif
/* Spurious "file has changed on disk" warnings have been
#ifndef FOO
stat (fn, &st);
#endif
- /* Discard the unwind protect */
- specpdl_ptr = specpdl + count;
+ /* Discard the unwind protect for close_file_unwind. */
+ specpdl_ptr = specpdl + count1;
+ /* Restore the original current buffer. */
+ visit_file = unbind_to (count, visit_file);
#ifdef CLASH_DETECTION
if (!auto_saving)
- unlock_file (visit_file);
+ unlock_file (lockname);
#endif /* CLASH_DETECTION */
/* Do this before reporting IO error
if (visiting)
{
- current_buffer->save_modified = MODIFF;
- XFASTINT (current_buffer->save_length) = Z - BEG;
+ SAVE_MODIFF = MODIFF;
+ XSETFASTINT (current_buffer->save_length, Z - BEG);
current_buffer->filename = visit_file;
+ update_mode_lines++;
}
else if (quietly)
return Qnil;
/* Build the complete list of annotations appropriate for writing out
the text between START and END, by calling all the functions in
- write-region-annotate-functions and merging the lists they return. */
+ write-region-annotate-functions and merging the lists they return.
+ If one of these functions switches to a different buffer, we assume
+ that buffer contains altered text. Therefore, the caller must
+ make sure to restore the current buffer in all cases,
+ as save-excursion would do. */
static Lisp_Object
build_annotations (start, end)
GCPRO2 (annotations, p);
while (!NILP (p))
{
+ struct buffer *given_buffer = current_buffer;
+ Vwrite_region_annotations_so_far = annotations;
res = call2 (Fcar (p), start, end);
+ /* If the function makes a different buffer current,
+ assume that means this buffer contains altered text to be output.
+ Reset START and END from the buffer bounds
+ and discard all previous annotations because they should have
+ been dealt with by this function. */
+ if (current_buffer != given_buffer)
+ {
+ start = BEGV;
+ end = ZV;
+ annotations = Qnil;
+ }
Flength (res); /* Check basic validity of return value */
annotations = merge (annotations, res, Qcar_less_than_car);
p = Fcdr (p);
}
+
+ /* 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;
+ else
+ p = current_buffer->file_format;
+ while (!NILP (p))
+ {
+ struct buffer *given_buffer = current_buffer;
+ Vwrite_region_annotations_so_far = annotations;
+ res = call3 (Qformat_annotate_function, Fcar (p), start, end);
+ if (current_buffer != given_buffer)
+ {
+ start = BEGV;
+ end = ZV;
+ annotations = Qnil;
+ }
+ Flength (res);
+ annotations = merge (annotations, res, Qcar_less_than_car);
+ p = Fcdr (p);
+ }
UNGCPRO;
return annotations;
}
int nextpos;
int lastpos = pos + len;
- while (1)
+ while (NILP (*annot) || CONSP (*annot))
{
tem = Fcar_safe (Fcar (*annot));
if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos)
CHECK_BUFFER (buf, 0);
b = XBUFFER (buf);
- if (XTYPE (b->filename) != Lisp_String) return Qt;
+ if (!STRINGP (b->filename)) return Qt;
if (b->modtime == 0) return Qt;
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (b->filename);
+ handler = Ffind_file_name_handler (b->filename,
+ Qverify_visited_file_modtime);
if (!NILP (handler))
return call2 (handler, Qverify_visited_file_modtime, buf);
that `file-attributes' returns.")
()
{
- return long_to_cons (current_buffer->modtime);
+ return long_to_cons ((unsigned long) current_buffer->modtime);
}
DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
if (!NILP (handler))
/* The handler can find the file name the same way we did. */
return call2 (handler, Qset_visited_file_modtime, Qnil);
Lisp_Object
auto_save_error ()
{
- unsigned char *name = XSTRING (current_buffer->name)->data;
-
ring_bell ();
- message ("Autosaving...error for %s", name);
+ message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data);
Fsleep_for (make_number (1), Qnil);
- message ("Autosaving...error!for %s", name);
+ message ("Autosaving...error!for %s", XSTRING (current_buffer->name)->data);
Fsleep_for (make_number (1), Qnil);
- message ("Autosaving...error for %s", name);
+ message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data);
Fsleep_for (make_number (1), Qnil);
return Qnil;
}
return
Fwrite_region (Qnil, Qnil,
current_buffer->auto_save_file_name,
- Qnil, Qlambda);
+ Qnil, Qlambda, Qnil);
+}
+
+static Lisp_Object
+do_auto_save_unwind (desc) /* used as unwind-protect function */
+ Lisp_Object desc;
+{
+ auto_saving = 0;
+ close (XINT (desc));
+ return Qnil;
}
DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
and are changed since last auto-saved.\n\
Auto-saving writes the buffer into a file\n\
so that your editing is not lost if the system crashes.\n\
-This file is not the file you visited; that changes only when you save.\n\n\
-Non-nil first argument means do not print any message if successful.\n\
-Non-nil second argument means save only current buffer.")
+This file is not the file you visited; that changes only when you save.\n\
+Normally we run the normal hook `auto-save-hook' before saving.\n\n\
+A non-nil NO-MESSAGE argument means do not print any message if successful.\n\
+A non-nil CURRENT-ONLY argument means save only current buffer.")
(no_message, current_only)
Lisp_Object no_message, current_only;
{
extern int minibuf_level;
int do_handled_files;
Lisp_Object oquit;
+ int listdesc;
+ int count = specpdl_ptr - specpdl;
+ int *ptr;
/* Ordinarily don't quit within this function,
but don't make it impossible to quit (in case we get hung in I/O). */
/* No GCPRO needed, because (when it matters) all Lisp_Object variables
point to non-strings reached from Vbuffer_alist. */
- auto_saving = 1;
if (minibuf_level)
no_message = Qt;
- /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
- eventually call do-auto-save, so don't err here in that case. */
if (!NILP (Vrun_hooks))
call1 (Vrun_hooks, intern ("auto-save-hook"));
+ if (STRINGP (Vauto_save_list_file_name))
+ {
+ Lisp_Object listfile;
+ listfile = Fexpand_file_name (Vauto_save_list_file_name, Qnil);
+#ifdef DOS_NT
+ listdesc = open (XSTRING (listfile)->data,
+ O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
+ S_IREAD | S_IWRITE);
+#else /* not DOS_NT */
+ listdesc = creat (XSTRING (listfile)->data, 0666);
+#endif /* not DOS_NT */
+ }
+ else
+ listdesc = -1;
+
+ /* Arrange to close that file whether or not we get an error.
+ Also reset auto_saving to 0. */
+ if (listdesc >= 0)
+ record_unwind_protect (do_auto_save_unwind, make_number (listdesc));
+
+ auto_saving = 1;
+
/* First, save all files which don't have handlers. If Emacs is
crashing, the handlers may tweak what is causing Emacs to crash
in the first place, and it would be a shame if Emacs failed to
autosave perfectly ordinary files because it couldn't handle some
ange-ftp'd file. */
for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
- for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
- tail = XCONS (tail)->cdr)
+ for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCONS (tail)->cdr)
{
buf = XCONS (XCONS (tail)->car)->cdr;
b = XBUFFER (buf);
+
+ /* Record all the buffers that have auto save mode
+ in the special file that lists them. For each of these buffers,
+ Record visited name (if any) and auto save name. */
+ if (STRINGP (b->auto_save_file_name)
+ && listdesc >= 0 && do_handled_files == 0)
+ {
+ if (!NILP (b->filename))
+ {
+ write (listdesc, XSTRING (b->filename)->data,
+ XSTRING (b->filename)->size);
+ }
+ write (listdesc, "\n", 1);
+ write (listdesc, XSTRING (b->auto_save_file_name)->data,
+ XSTRING (b->auto_save_file_name)->size);
+ write (listdesc, "\n", 1);
+ }
if (!NILP (current_only)
&& b != current_buffer)
continue;
-
+
+ /* Don't auto-save indirect buffers.
+ The base buffer takes care of it. */
+ if (b->base_buffer)
+ continue;
+
/* Check for auto save enabled
and file changed since last auto save
and file changed since last real save. */
- if (XTYPE (b->auto_save_file_name) == Lisp_String
- && b->save_modified < BUF_MODIFF (b)
+ if (STRINGP (b->auto_save_file_name)
+ && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
&& b->auto_save_modified < BUF_MODIFF (b)
+ /* -1 means we've turned off autosaving for a while--see below. */
+ && XINT (b->save_length) >= 0
&& (do_handled_files
- || NILP (Ffind_file_name_handler (b->auto_save_file_name))))
+ || NILP (Ffind_file_name_handler (b->auto_save_file_name,
+ Qwrite_region))))
{
EMACS_TIME before_time, after_time;
/* It has shrunk too much; turn off auto-saving here. */
message ("Buffer %s has shrunk a lot; auto save turned off there",
XSTRING (b->name)->data);
- /* User can reenable saving with M-x auto-save. */
- b->auto_save_file_name = Qnil;
- /* Prevent warning from repeating if user does so. */
- XFASTINT (b->save_length) = 0;
+ /* Turn off auto-saving until there's a real save,
+ and prevent any more warnings. */
+ XSETINT (b->save_length, -1);
Fsleep_for (make_number (1), Qnil);
continue;
}
internal_condition_case (auto_save_1, Qt, auto_save_error);
auto_saved++;
b->auto_save_modified = BUF_MODIFF (b);
- XFASTINT (current_buffer->save_length) = Z - BEG;
+ XSETFASTINT (current_buffer->save_length, Z - BEG);
set_buffer_internal (old);
EMACS_GET_TIME (after_time);
Vquit_flag = oquit;
- auto_saving = 0;
+ unbind_to (count, Qnil);
return Qnil;
}
()
{
current_buffer->auto_save_modified = MODIFF;
- XFASTINT (current_buffer->save_length) = Z - BEG;
+ XSETFASTINT (current_buffer->save_length, Z - BEG);
current_buffer->auto_save_failure_time = -1;
return Qnil;
}
"Return t if buffer has been auto-saved since last read in or saved.")
()
{
- return (current_buffer->save_modified < current_buffer->auto_save_modified) ? Qt : Qnil;
+ return (SAVE_MODIFF < current_buffer->auto_save_modified) ? Qt : Qnil;
}
\f
/* Reading and completing file names */
{
Lisp_Object name, specdir, realdir, val, orig_string;
int changed;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
realdir = dir;
name = string;
specdir = Qnil;
changed = 0;
/* No need to protect ACTION--we only compare it with t and nil. */
- GCPRO4 (string, realdir, name, specdir);
+ GCPRO5 (string, realdir, name, specdir, orig_string);
if (XSTRING (string)->size == 0)
{
specdir = Ffile_name_directory (string);
val = Ffile_name_completion (name, realdir);
UNGCPRO;
- if (XTYPE (val) != Lisp_String)
+ if (!STRINGP (val))
{
if (changed)
- return string;
+ return double_dollars (string);
return val;
}
DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
"Read file name, prompting with PROMPT and completing in directory DIR.\n\
Value is not expanded---you must call `expand-file-name' yourself.\n\
-Default name to DEFAULT if user enters a null string.\n\
- (If DEFAULT is omitted, the visited file name is used.)\n\
+Default name to DEFAULT-FILENAME if user enters a null string.\n\
+ (If DEFAULT-FILENAME is omitted, the visited file name is used,\n\
+ except that if INITIAL is specified, that combined with DIR is used.)\n\
Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
Non-nil and non-t means also require confirmation after completion.\n\
Fifth arg INITIAL specifies text to start with.\n\
DIR defaults to current buffer's directory default.")
- (prompt, dir, defalt, mustmatch, initial)
- Lisp_Object prompt, dir, defalt, mustmatch, initial;
+ (prompt, dir, default_filename, mustmatch, initial)
+ Lisp_Object prompt, dir, default_filename, mustmatch, initial;
{
Lisp_Object val, insdef, insdef1, tem;
struct gcpro gcpro1, gcpro2;
if (NILP (dir))
dir = current_buffer->directory;
- if (NILP (defalt))
- defalt = current_buffer->filename;
+ if (NILP (default_filename))
+ {
+ if (! NILP (initial))
+ default_filename = Fexpand_file_name (initial, dir);
+ else
+ default_filename = current_buffer->filename;
+ }
/* If dir starts with user's homedir, change that to ~. */
homedir = (char *) egetenv ("HOME");
if (homedir != 0
- && XTYPE (dir) == Lisp_String
+ && STRINGP (dir)
&& !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
- && XSTRING (dir)->data[strlen (homedir)] == '/')
+ && IS_DIRECTORY_SEP (XSTRING (dir)->data[strlen (homedir)]))
{
dir = make_string (XSTRING (dir)->data + strlen (homedir) - 1,
XSTRING (dir)->size - strlen (homedir) + 1);
if (insert_default_directory)
{
insdef = dir;
- insdef1 = dir;
if (!NILP (initial))
{
Lisp_Object args[2], pos;
args[0] = insdef;
args[1] = initial;
insdef = Fconcat (2, args);
- pos = make_number (XSTRING (dir)->size);
+ pos = make_number (XSTRING (double_dollars (dir))->size);
insdef1 = Fcons (double_dollars (insdef), pos);
}
else
insdef1 = double_dollars (insdef);
}
+ else if (!NILP (initial))
+ {
+ insdef = initial;
+ insdef1 = Fcons (double_dollars (insdef), 0);
+ }
else
insdef = Qnil, insdef1 = Qnil;
specbind (intern ("completion-ignore-case"), Qt);
#endif
- GCPRO2 (insdef, defalt);
+ GCPRO2 (insdef, default_filename);
val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
dir, mustmatch, insdef1,
Qfile_name_history);
if (NILP (val))
error ("No file name specified");
tem = Fstring_equal (val, insdef);
- if (!NILP (tem) && !NILP (defalt))
- return defalt;
+ if (!NILP (tem) && !NILP (default_filename))
+ return default_filename;
if (XSTRING (val)->size == 0 && NILP (insdef))
{
- if (!NILP (defalt))
- return defalt;
+ if (!NILP (default_filename))
+ return default_filename;
else
error ("No default file name");
}
return Fsubstitute_in_file_name (val);
}
-#if 0 /* Old version */
+#if 0 /* Old version */
DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
- "Read file name, prompting with PROMPT and completing in directory DIR.\n\
-Value is not expanded---you must call `expand-file-name' yourself.\n\
-Default name to DEFAULT if user enters a null string.\n\
- (If DEFAULT is omitted, the visited file name is used.)\n\
-Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
- Non-nil and non-t means also require confirmation after completion.\n\
-Fifth arg INITIAL specifies text to start with.\n\
-DIR defaults to current buffer's directory default.")
+ /* Don't confuse make-docfile by having two doc strings for this function.
+ make-docfile does not pay attention to #if, for good reason! */
+ 0)
(prompt, dir, defalt, mustmatch, initial)
Lisp_Object prompt, dir, defalt, mustmatch, initial;
{
/* If dir starts with user's homedir, change that to ~. */
homedir = (char *) egetenv ("HOME");
if (homedir != 0
- && XTYPE (dir) == Lisp_String
+ && STRINGP (dir)
&& !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
&& XSTRING (dir)->data[strlen (homedir)] == '/')
{
syms_of_fileio ()
{
Qexpand_file_name = intern ("expand-file-name");
+ Qsubstitute_in_file_name = intern ("substitute-in-file-name");
Qdirectory_file_name = intern ("directory-file-name");
Qfile_name_directory = intern ("file-name-directory");
Qfile_name_nondirectory = intern ("file-name-nondirectory");
Qunhandled_file_name_directory = intern ("unhandled-file-name-directory");
Qfile_name_as_directory = intern ("file-name-as-directory");
Qcopy_file = intern ("copy-file");
- Qmake_directory = intern ("make-directory");
+ Qmake_directory_internal = intern ("make-directory-internal");
Qdelete_directory = intern ("delete-directory");
Qdelete_file = intern ("delete-file");
Qrename_file = intern ("rename-file");
Qfile_symlink_p = intern ("file-symlink-p");
Qfile_writable_p = intern ("file-writable-p");
Qfile_directory_p = intern ("file-directory-p");
+ Qfile_regular_p = intern ("file-regular-p");
Qfile_accessible_directory_p = intern ("file-accessible-directory-p");
Qfile_modes = intern ("file-modes");
Qset_file_modes = intern ("set-file-modes");
Qset_visited_file_modtime = intern ("set-visited-file-modtime");
staticpro (&Qexpand_file_name);
+ staticpro (&Qsubstitute_in_file_name);
staticpro (&Qdirectory_file_name);
staticpro (&Qfile_name_directory);
staticpro (&Qfile_name_nondirectory);
staticpro (&Qunhandled_file_name_directory);
staticpro (&Qfile_name_as_directory);
staticpro (&Qcopy_file);
- staticpro (&Qmake_directory);
+ staticpro (&Qmake_directory_internal);
staticpro (&Qdelete_directory);
staticpro (&Qdelete_file);
staticpro (&Qrename_file);
staticpro (&Qfile_symlink_p);
staticpro (&Qfile_writable_p);
staticpro (&Qfile_directory_p);
+ staticpro (&Qfile_regular_p);
staticpro (&Qfile_accessible_directory_p);
staticpro (&Qfile_modes);
staticpro (&Qset_file_modes);
Qfile_already_exists = intern("file-already-exists");
staticpro (&Qfile_already_exists);
-#ifdef MSDOS
+#ifdef DOS_NT
Qfind_buffer_file_type = intern ("find-buffer-file-type");
staticpro (&Qfind_buffer_file_type);
-#endif
-
+#endif /* DOS_NT */
+
+ DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format,
+ "*Format in which to write auto-save files.\n\
+Should be a list of symbols naming formats that are defined in `format-alist'.\n\
+If it is t, which is the default, auto-save files are written in the\n\
+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 (&Qformat_annotate_function);
+
Qcar_less_than_car = intern ("car-less-than-car");
staticpro (&Qcar_less_than_car);
lists are merged destructively.");
Vwrite_region_annotate_functions = Qnil;
+ DEFVAR_LISP ("write-region-annotations-so-far",
+ &Vwrite_region_annotations_so_far,
+ "When an annotation function is called, this holds the previous annotations.\n\
+These are the annotations made by other annotation functions\n\
+that were already called. See also `write-region-annotate-functions'.");
+ Vwrite_region_annotations_so_far = Qnil;
+
+ DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers,
+ "A list of file name handlers that temporarily should not be used.\n\
+This applies only to the operation `inhibit-file-name-operation'.");
+ Vinhibit_file_name_handlers = Qnil;
+
+ DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation,
+ "The operation for which `inhibit-file-name-handlers' is applicable.");
+ Vinhibit_file_name_operation = Qnil;
+
+ DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name,
+ "File name in which we write a list of all auto save file names.\n\
+This variable is initialized automatically from `auto-save-list-file-prefix'\n\
+shortly after Emacs reads your `.emacs' file, if you have not yet given it\n\
+a non-nil value.");
+ Vauto_save_list_file_name = Qnil;
+
defsubr (&Sfind_file_name_handler);
defsubr (&Sfile_name_directory);
defsubr (&Sfile_name_nondirectory);
defsubr (&Sfile_symlink_p);
defsubr (&Sfile_directory_p);
defsubr (&Sfile_accessible_directory_p);
+ defsubr (&Sfile_regular_p);
defsubr (&Sfile_modes);
defsubr (&Sset_file_modes);
defsubr (&Sset_default_file_modes);