/* File IO for GNU Emacs.
- Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994 Free Software Foundation, Inc.
This file is part of GNU Emacs.
along with GNU Emacs; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
-#include "config.h"
+#include <config.h>
#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
+
+#if !defined (S_ISREG) && defined (S_IFREG)
+# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
+#endif
+
#ifdef VMS
#include "vms-pwd.h"
#else
#include <pwd.h>
#endif
+#ifdef MSDOS
+#include "msdos.h"
+#include <sys/param.h>
+#endif
+
#include <ctype.h>
#ifdef VMS
-#include "dir.h"
+#include "vmsdir.h"
#include <perror.h>
#include <stddef.h>
#include <string.h>
-#else
-#include <sys/dir.h>
#endif
#include <errno.h>
#ifndef vax11c
extern int errno;
-extern char *sys_errlist[];
-extern int sys_nerr;
#endif
-#define err_str(a) ((a) < sys_nerr ? sys_errlist[a] : "unknown error")
+extern char *strerror ();
#ifdef APOLLO
#include <sys/time.h>
#endif
+#ifndef USG
+#ifndef VMS
+#ifndef BSD4_1
+#define HAVE_FSYNC
+#endif
+#endif
+#endif
+
#include "lisp.h"
+#include "intervals.h"
#include "buffer.h"
#include "window.h"
#ifdef HPUX
#include <netio.h>
#ifndef HPUX8
+#ifndef HPUX9
#include <errnet.h>
#endif
#endif
+#endif
#ifndef O_WRONLY
#define O_WRONLY 1
a new file with the same mode as the original */
int auto_save_mode_bits;
+/* Alist of elements (REGEXP . HANDLER) for file names
+ whose I/O is done with a special handler. */
+Lisp_Object Vfile_name_handler_alist;
+
+/* 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;
+
/* 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;
+static Lisp_Object Vinhibit_file_name_handlers;
+
Lisp_Object Qfile_error, Qfile_already_exists;
+Lisp_Object Qfile_name_history;
+
+Lisp_Object Qcar_less_than_car;
+
report_file_error (string, data)
char *string;
Lisp_Object data;
{
Lisp_Object errstring;
- if (errno >= 0 && errno < sys_nerr)
- errstring = build_string (sys_errlist[errno]);
- else
- errstring = build_string ("undocumented error code");
+ errstring = build_string (strerror (errno));
/* System error messages are capitalized. Downcase the initial
unless it is followed by a slash. */
{
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 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 Qdelete_directory;
+Lisp_Object Qdelete_file;
+Lisp_Object Qrename_file;
+Lisp_Object Qadd_name_to_file;
+Lisp_Object Qmake_symbolic_link;
+Lisp_Object Qfile_exists_p;
+Lisp_Object Qfile_executable_p;
+Lisp_Object Qfile_readable_p;
+Lisp_Object Qfile_symlink_p;
+Lisp_Object Qfile_writable_p;
+Lisp_Object Qfile_directory_p;
+Lisp_Object Qfile_accessible_directory_p;
+Lisp_Object Qfile_modes;
+Lisp_Object Qset_file_modes;
+Lisp_Object Qfile_newer_than_file_p;
+Lisp_Object Qinsert_file_contents;
+Lisp_Object Qwrite_region;
+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\
+Otherwise, return nil.\n\
+A file name is handled if one of the regular expressions in\n\
+`file-name-handler-alist' matches it.\n\n\
+If FILENAME is a member of `inhibit-file-name-handlers',\n\
+then its handler is not run. This is lets handlers\n\
+use the standard functions without calling themselves recursively.")
+ (filename)
+ Lisp_Object filename;
+{
+ /* This function must not munge the match data. */
+ Lisp_Object chain;
+
+ CHECK_STRING (filename, 0);
+
+ if (! NILP (Vinhibit_file_name_handlers))
+ {
+ Lisp_Object tail;
+ for (tail = Vinhibit_file_name_handlers; CONSP (tail);
+ tail = XCONS (tail)->cdr)
+ {
+ Lisp_Object tem;
+ tem = Fstring_equal (tail, filename);
+ if (!NILP (tem))
+ return Qnil;
+ }
+ }
+
+ for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons;
+ chain = XCONS (chain)->cdr)
+ {
+ Lisp_Object elt;
+ elt = XCONS (chain)->car;
+ if (XTYPE (elt) == Lisp_Cons)
+ {
+ Lisp_Object string;
+ string = XCONS (elt)->car;
+ if (XTYPE (string) == Lisp_String
+ && fast_string_match (string, filename) >= 0)
+ return XCONS (elt)->cdr;
+ }
+
+ QUIT;
+ }
+ return Qnil;
+}
\f
DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory,
1, 1, 0,
{
register unsigned char *beg;
register unsigned char *p;
+ Lisp_Object handler;
CHECK_STRING (file, 0);
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (file);
+ if (!NILP (handler))
+ return call2 (handler, Qfile_name_directory, file);
+
+#ifdef FILE_SYSTEM_CASE
+ file = FILE_SYSTEM_CASE (file);
+#endif
beg = XSTRING (file)->data;
p = beg + XSTRING (file)->size;
#ifdef VMS
&& p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
#endif /* VMS */
+#ifdef MSDOS
+ && p[-1] != ':'
+#endif
) p--;
if (p == beg)
return Qnil;
+#ifdef MSDOS
+ /* Expansion of "c:" to drive and default directory. */
+ 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))
+ {
+ res[0] = drive + 'a';
+ res[1] = ':';
+ if (res[strlen (res) - 1] != '/')
+ strcat (res, "/");
+ beg = res;
+ p = beg + strlen (beg);
+ }
+ }
+#endif
return make_string (beg, p - beg);
}
Lisp_Object file;
{
register unsigned char *beg, *p, *end;
+ Lisp_Object handler;
CHECK_STRING (file, 0);
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (file);
+ if (!NILP (handler))
+ return call2 (handler, Qfile_name_nondirectory, file);
+
beg = XSTRING (file)->data;
end = p = beg + XSTRING (file)->size;
#ifdef VMS
&& p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
#endif /* VMS */
+#ifdef MSDOS
+ && p[-1] != ':'
+#endif
) p--;
return make_string (p, end - p);
}
+
+DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, Sunhandled_file_name_directory, 1, 1, 0,
+ "Return a directly usable directory name somehow associated with FILENAME.\n\
+A `directly usable' directory name is one that may be used without the\n\
+intervention of any file handler.\n\
+If FILENAME is a directly usable file itself, return\n\
+(file-name-directory FILENAME).\n\
+The `call-process' and `start-process' functions use this function to\n\
+get a current directory to run processes in.")
+ (filename)
+ Lisp_Object filename;
+{
+ Lisp_Object handler;
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (filename);
+ if (!NILP (handler))
+ return call2 (handler, Qunhandled_file_name_directory, filename);
+
+ return Ffile_name_directory (filename);
+}
+
\f
char *
file_name_as_directory (out, in)
}
#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, "/");
#endif /* not VMS */
return out;
Lisp_Object file;
{
char *buf;
+ Lisp_Object handler;
CHECK_STRING (file, 0);
if (NILP (file))
return Qnil;
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (file);
+ if (!NILP (handler))
+ return call2 (handler, Qfile_name_as_directory, file);
+
buf = (char *) alloca (XSTRING (file)->size + 10);
return build_string (file_name_as_directory (buf, XSTRING (file)->data));
}
&& (ptr[rlen] == ']' || ptr[rlen] == '>')
&& ptr[rlen - 1] == '.')
{
- ptr[rlen - 1] = ']';
- ptr[rlen] = '\0';
- return directory_file_name (ptr, dst);
+ char * buf = (char *) alloca (strlen (ptr) + 1);
+ strcpy (buf, ptr);
+ buf[rlen - 1] = ']';
+ buf[rlen] = '\0';
+ return directory_file_name (buf, dst);
}
else
dst[slen - 1] = ':';
/* Process as Unix format: just remove any final slash.
But leave "/" unchanged; do not change it to "". */
strcpy (dst, src);
- if (slen > 1 && dst[slen - 1] == '/')
+ if (slen > 1
+ && dst[slen - 1] == '/'
+#ifdef MSDOS
+ && dst[slen - 2] != ':'
+#endif
+ )
dst[slen - 1] = 0;
return 1;
}
Lisp_Object directory;
{
char *buf;
+ Lisp_Object handler;
CHECK_STRING (directory, 0);
if (NILP (directory))
return Qnil;
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (directory);
+ if (!NILP (handler))
+ return call2 (handler, Qdirectory_file_name, directory);
+
#ifdef VMS
/* 20 extra chars is insufficient for VMS, since we might perform a
logical name translation. an equivalence string can be up to 255
int tlen;
unsigned char *target;
struct passwd *pw;
- int lose;
#ifdef VMS
unsigned char * colon = 0;
unsigned char * close = 0;
int lbrack = 0, rbrack = 0;
int dots = 0;
#endif /* VMS */
+#ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida */
+ int drive = -1;
+ int relpath = 0;
+ unsigned char *tmp, *defdir;
+#endif
+ 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);
+ if (!NILP (handler))
+ return call3 (handler, Qexpand_file_name, name, defalt);
+
+ /* Use the buffer's default-directory if DEFALT is omitted. */
+ if (NILP (defalt))
+ defalt = current_buffer->directory;
+ CHECK_STRING (defalt, 1);
+
+ /* Make sure DEFALT is properly expanded.
+ It would be better to do this down below where we actually use
+ defalt. 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
+ the code and forget to adjust them, resulting in intermittent bugs.
+ Putting this call here avoids all that crud.
+
+ The EQ test avoids infinite recursion. */
+ if (! NILP (defalt) && !EQ (defalt, name)
+ /* This saves time in a common case. */
+ && XSTRING (defalt)->data[0] != '/')
+ {
+ struct gcpro gcpro1;
+
+ GCPRO1 (name);
+ defalt = Fexpand_file_name (defalt, Qnil);
+ UNGCPRO;
+ }
+
#ifdef VMS
/* Filenames on VMS are always upper case. */
name = Fupcase (name);
#endif
+#ifdef FILE_SYSTEM_CASE
+ name = FILE_SYSTEM_CASE (name);
+#endif
nm = XSTRING (name)->data;
+#ifdef MSDOS
+ /* firstly, strip drive name. */
+ {
+ unsigned char *colon = rindex (nm, ':');
+ if (colon)
+ if (nm == colon)
+ nm++;
+ else
+ {
+ drive = tolower (colon[-1]) - 'a';
+ nm = colon + 1;
+ if (*nm != '/')
+ {
+ defdir = alloca (MAXPATHLEN + 1);
+ relpath = getdefdir (drive + 1, defdir);
+ }
+ }
+ }
+#endif
+
/* If nm is absolute, flush ...// and detect /./ and /../.
If no /./ or /../ we can return right away. */
if (
#endif /* VMS */
)
{
+ /* If it turns out that the filename we want to return is just a
+ suffix of FILENAME, we don't need to go through and edit
+ things; we just need to construct a new string using data
+ starting at the middle of FILENAME. If we set lose to a
+ non-zero value, that means we've discovered that we can't do
+ that cool trick. */
+ int lose = 0;
+
p = nm;
- lose = 0;
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 (p[0] == '/' && p[1] == '/'
#ifdef APOLLO
/* // at start of filename is meaningful on Apollo system */
#endif /* APOLLO */
)
nm = p + 1;
+
+ /* "~" is hairy as the start of any path element. */
if (p[0] == '/' && p[1] == '~')
nm = p + 1, lose = 1;
- if (p[0] == '/' && p[1] == '.'
- && (p[2] == '/' || p[2] == 0
- || (p[2] == '.' && (p[3] == '/' || p[3] == 0))))
+
+ /* "." and ".." are hairy. */
+ if (p[0] == '/'
+ && p[1] == '.'
+ && (p[2] == '/'
+ || p[2] == 0
+ || (p[2] == '.' && (p[3] == '/'
+ || p[3] == 0))))
lose = 1;
#ifdef VMS
if (p[0] == '\\')
if (index (nm, '/'))
return build_string (sys_translate_unix (nm));
#endif /* VMS */
+#ifndef MSDOS
if (nm == XSTRING (name)->data)
return name;
return build_string (nm);
+#endif
}
}
newdir = 0;
if (nm[0] == '~') /* prefix ~ */
- if (nm[1] == '/'
+ {
+ if (nm[1] == '/'
#ifdef VMS
- || nm[1] == ':'
-#endif /* VMS */
- || nm[1] == 0)/* ~ by itself */
- {
- if (!(newdir = (unsigned char *) egetenv ("HOME")))
- newdir = (unsigned char *) "";
- nm++;
+ || nm[1] == ':'
+#endif /* VMS */
+ || nm[1] == 0) /* ~ by itself */
+ {
+ if (!(newdir = (unsigned char *) egetenv ("HOME")))
+ newdir = (unsigned char *) "";
+#ifdef MSDOS
+ dostounix_filename (newdir);
+#endif
+ nm++;
#ifdef VMS
- nm++; /* Don't leave the slash in nm. */
-#endif /* VMS */
- }
- else /* ~user/filename */
- {
- for (p = nm; *p && (*p != '/'
+ nm++; /* Don't leave the slash in nm. */
+#endif /* VMS */
+ }
+ else /* ~user/filename */
+ {
+ for (p = nm; *p && (*p != '/'
#ifdef VMS
- && *p != ':'
-#endif /* VMS */
- ); p++);
- o = (unsigned char *) alloca (p - nm + 1);
- bcopy ((char *) nm, o, p - nm);
- o [p - nm] = 0;
+ && *p != ':'
+#endif /* VMS */
+ ); p++);
+ o = (unsigned char *) alloca (p - nm + 1);
+ bcopy ((char *) nm, o, p - nm);
+ o [p - nm] = 0;
- pw = (struct passwd *) getpwnam (o + 1);
- if (pw)
- {
- newdir = (unsigned char *) pw -> pw_dir;
+ pw = (struct passwd *) getpwnam (o + 1);
+ if (pw)
+ {
+ newdir = (unsigned char *) pw -> pw_dir;
#ifdef VMS
- nm = p + 1; /* skip the terminator */
+ nm = p + 1; /* skip the terminator */
#else
- nm = p;
-#endif /* VMS */
- }
+ nm = p;
+#endif /* VMS */
+ }
- /* If we don't find a user of that name, leave the name
- unchanged; don't move nm forward to p. */
- }
+ /* If we don't find a user of that name, leave the name
+ unchanged; don't move nm forward to p. */
+ }
+ }
if (nm[0] != '/'
#ifdef VMS
&& !index (nm, ':')
#endif /* not VMS */
+#ifdef MSDOS
+ && drive == -1
+#endif
&& !newdir)
{
- if (NILP (defalt))
- defalt = current_buffer->directory;
- CHECK_STRING (defalt, 1);
newdir = XSTRING (defalt)->data;
}
+#ifdef MSDOS
+ if (newdir == 0 && relpath)
+ newdir = defdir;
+#endif
if (newdir != 0)
{
/* Get rid of any slash at the end of newdir. */
int length = strlen (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
+ if (newdir[1] != ':' && length > 1)
+#endif
if (newdir[length - 1] == '/')
{
unsigned char *temp = (unsigned char *) alloca (length);
/* 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
target = (unsigned char *) alloca (tlen);
+#endif
*target = 0;
if (newdir)
strcpy (target, newdir);
else
#endif
- file_name_as_directory (target, newdir);
+ file_name_as_directory (target, newdir);
}
strcat (target, nm);
strcpy (target, sys_translate_unix (target));
#endif /* VMS */
- /* Now canonicalize by removing /. and /foo/.. if they appear */
+ /* Now canonicalize by removing /. and /foo/.. if they appear. */
p = target;
o = target;
o = target;
p++;
}
- else if (p[0] == '/' && p[1] == '.' &&
- (p[2] == '/' || p[2] == 0))
- p += 2;
+ else if (p[0] == '/'
+ && p[1] == '.'
+ && (p[2] == '/'
+ || p[2] == 0))
+ {
+ /* If "/." is the entire filename, keep the "/". Otherwise,
+ just delete the whole "/.". */
+ if (o == target && p[2] == '\0')
+ *o++ = *p;
+ p += 2;
+ }
else if (!strncmp (p, "/..", 3)
/* `/../' is the "superroot" on certain file systems. */
&& o != target
#endif /* not VMS */
}
+#ifdef MSDOS
+ /* at last, set drive name. */
+ if (target[1] != ':')
+ {
+ target -= 2;
+ target[0] = (drive < 0 ? getdisk () : drive) + 'a';
+ target[1] = ':';
+ }
+#endif
+
return make_string (target, o - target);
}
#if 0
nm = p;
substituted = 1;
}
+#ifdef MSDOS
+ if (p[0] && p[1] == ':')
+ {
+ nm = p;
+ substituted = 1;
+ }
+#endif /* MSDOS */
}
#ifdef VMS
target = (unsigned char *) alloca (s - o + 1);
strncpy (target, o, s - o);
target[s - o] = 0;
+#ifdef MSDOS
+ strupr (target); /* $home == $HOME etc. */
+#endif
/* 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;
target = (unsigned char *) alloca (s - o + 1);
strncpy (target, o, s - o);
target[s - o] = 0;
+#ifdef MSDOS
+ strupr (target); /* $home == $HOME etc. */
+#endif
/* 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;
)
&& p != nm && p[-1] == '/')
xnm = p;
+#ifdef MSDOS
+ else if (p[0] && p[1] == ':')
+ xnm = p;
+#endif
return make_string (xnm, x - xnm);
#endif /* not VMS */
}
\f
+/* A slightly faster and more convenient way to get
+ (directory-file-name (expand-file-name FOO)). */
+
Lisp_Object
expand_and_dir_to_file (filename, defdir)
Lisp_Object filename, defdir;
stat behaves differently depending! */
if (XSTRING (abspath)->size > 1
&& XSTRING (abspath)->data[XSTRING (abspath)->size - 1] == '/')
- {
- if (EQ (abspath, filename))
- abspath = Fcopy_sequence (abspath);
- XSTRING (abspath)->data[XSTRING (abspath)->size - 1] = 0;
- }
+ /* We cannot take shortcuts; they might be wrong for magic file names. */
+ abspath = Fdirectory_file_name (abspath);
#endif
return abspath;
}
int ifd, ofd, n;
char buf[16 * 1024];
struct stat 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);
CHECK_STRING (newname, 1);
filename = Fexpand_file_name (filename, 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);
+ /* Likewise for output file name. */
+ if (NILP (handler))
+ handler = Ffind_file_name_handler (newname);
+ if (!NILP (handler))
+ RETURN_UNGCPRO (call5 (handler, Qcopy_file, filename, newname,
+ ok_if_already_exists, keep_date));
+
if (NILP (ok_if_already_exists)
|| XTYPE (ok_if_already_exists) == Lisp_Int)
barf_or_query_if_file_exists (newname, "copy to it",
record_unwind_protect (close_file_unwind, make_number (ifd));
+ /* We can only copy regular files and symbolic links. Other files are not
+ copyable by us. */
+ input_file_statable_p = (fstat (ifd, &st) >= 0);
+
+#if defined (S_ISREG) && defined (S_ISLNK)
+ if (input_file_statable_p)
+ {
+ if (!(S_ISREG (st.st_mode)) && !(S_ISLNK (st.st_mode)))
+ {
+#if defined (EISDIR)
+ /* Get a better looking error message. */
+ errno = EISDIR;
+#endif /* EISDIR */
+ report_file_error ("Non-regular file", Fcons (filename, Qnil));
+ }
+ }
+#endif /* S_ISREG && S_ISLNK */
+
#ifdef VMS
/* Create the copy file with the same record format as the input file */
ofd = sys_creat (XSTRING (newname)->data, 0666, ifd);
#else
+#ifdef MSDOS
+ /* System's default file type was set to binary by _fmode in emacs.c. */
+ ofd = creat (XSTRING (newname)->data, S_IREAD | S_IWRITE);
+#else /* not MSDOS */
ofd = creat (XSTRING (newname)->data, 0666);
+#endif /* not MSDOS */
#endif /* VMS */
if (ofd < 0)
report_file_error ("Opening output file", Fcons (newname, Qnil));
report_file_error ("I/O error", Fcons (newname, Qnil));
immediate_quit = 0;
- if (fstat (ifd, &st) >= 0)
+ if (input_file_statable_p)
{
if (!NILP (keep_date))
{
return Qnil;
}
-DEFUN ("make-directory", Fmake_directory, Smake_directory, 1, 1, "FMake directory: ",
+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;
{
unsigned char *dir;
+ Lisp_Object handler;
CHECK_STRING (dirname, 0);
dirname = Fexpand_file_name (dirname, Qnil);
+
+ handler = Ffind_file_name_handler (dirname);
+ if (!NILP (handler))
+ return call3 (handler, Qmake_directory, dirname, Qnil);
+
dir = XSTRING (dirname)->data;
if (mkdir (dir, 0777) != 0)
report_file_error ("Creating directory", Flist (1, &dirname));
- return Qnil;
+ return Qnil;
}
DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",
Lisp_Object dirname;
{
unsigned char *dir;
+ Lisp_Object handler;
CHECK_STRING (dirname, 0);
dirname = Fexpand_file_name (dirname, Qnil);
dir = XSTRING (dirname)->data;
+ handler = Ffind_file_name_handler (dirname);
+ if (!NILP (handler))
+ return call2 (handler, Qdelete_directory, dirname);
+
if (rmdir (dir) != 0)
report_file_error ("Removing directory", Flist (1, &dirname));
(filename)
Lisp_Object filename;
{
+ Lisp_Object handler;
CHECK_STRING (filename, 0);
filename = Fexpand_file_name (filename, Qnil);
+
+ handler = Ffind_file_name_handler (filename);
+ if (!NILP (handler))
+ return call2 (handler, Qdelete_file, filename);
+
if (0 > unlink (XSTRING (filename)->data))
report_file_error ("Removing old name", Flist (1, &filename));
return Qnil;
#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
#endif
+ Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
GCPRO2 (filename, newname);
CHECK_STRING (newname, 1);
filename = Fexpand_file_name (filename, 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);
+ if (NILP (handler))
+ handler = Ffind_file_name_handler (newname);
+ if (!NILP (handler))
+ RETURN_UNGCPRO (call4 (handler, Qrename_file,
+ filename, newname, ok_if_already_exists));
+
if (NILP (ok_if_already_exists)
|| XTYPE (ok_if_already_exists) == Lisp_Int)
barf_or_query_if_file_exists (newname, "rename to it",
{
if (errno == EXDEV)
{
- Fcopy_file (filename, newname, ok_if_already_exists, Qt);
+ Fcopy_file (filename, 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);
}
else
#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
#endif
+ Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
GCPRO2 (filename, newname);
CHECK_STRING (newname, 1);
filename = Fexpand_file_name (filename, 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);
+ if (!NILP (handler))
+ RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
+ newname, ok_if_already_exists));
+
if (NILP (ok_if_already_exists)
|| XTYPE (ok_if_already_exists) == Lisp_Int)
barf_or_query_if_file_exists (newname, "make it a new name",
#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
#endif
+ Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
GCPRO2 (filename, linkname);
CHECK_STRING (filename, 0);
CHECK_STRING (linkname, 1);
-#if 0 /* This made it impossible to make a link to a relative name. */
- filename = Fexpand_file_name (filename, Qnil);
-#endif
+ /* If the link target has a ~, we must expand it to get
+ a truly valid file name. Otherwise, do not expand;
+ we want to permit links to relative file names. */
+ if (XSTRING (filename)->data[0] == '~')
+ filename = Fexpand_file_name (filename, Qnil);
linkname = Fexpand_file_name (linkname, Qnil);
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (filename);
+ 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)
barf_or_query_if_file_exists (linkname, "make it a link",
/* If we didn't complain already, silently delete existing file. */
if (errno == EEXIST)
{
- unlink (XSTRING (filename)->data);
+ unlink (XSTRING (linkname)->data);
if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
return Qnil;
}
|| (*ptr == '[' && (ptr[1] != '-' || (ptr[2] != '.' && ptr[2] != ']'))
&& ptr[1] != '.')
#endif /* VMS */
+#ifdef MSDOS
+ || (*ptr != 0 && ptr[1] == ':' && ptr[2] == '/')
+#endif
)
return Qt;
else
Lisp_Object filename;
{
Lisp_Object abspath;
+ 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_exists_p, abspath);
+
return (access (XSTRING (abspath)->data, 0) >= 0) ? Qt : Qnil;
}
DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
"Return t if FILENAME can be executed by you.\n\
-For directories this means you can change to that directory.")
+For a directory, this means you can access files in that directory.")
(filename)
Lisp_Object filename;
{
Lisp_Object abspath;
+ 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_executable_p, abspath);
+
return (access (XSTRING (abspath)->data, 1) >= 0) ? Qt : Qnil;
}
Lisp_Object filename;
{
Lisp_Object abspath;
+ 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_readable_p, abspath);
+
return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil;
}
DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0,
- "If file FILENAME is the name of a symbolic link\n\
-returns the name of the file to which it is linked.\n\
-Otherwise returns NIL.")
+ "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\
+Otherwise returns nil.")
(filename)
Lisp_Object filename;
{
int bufsize;
int valsize;
Lisp_Object val;
+ Lisp_Object handler;
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);
+ if (!NILP (handler))
+ return call2 (handler, Qfile_symlink_p, filename);
+
bufsize = 100;
while (1)
{
valsize = readlink (XSTRING (filename)->data, buf, bufsize);
if (valsize < bufsize) break;
/* Buffer was not long enough */
- free (buf);
+ xfree (buf);
bufsize *= 2;
}
if (valsize == -1)
{
- free (buf);
+ xfree (buf);
return Qnil;
}
val = make_string (buf, valsize);
- free (buf);
+ xfree (buf);
return val;
#else /* not S_IFLNK */
return Qnil;
#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,
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) ? Qt : Qnil;
+ 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 */
- return (access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0
+#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);
}
{
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);
+ if (!NILP (handler))
+ return call2 (handler, Qfile_directory_p, abspath);
+
if (stat (XSTRING (abspath)->data, &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
(filename)
Lisp_Object filename;
{
+ Lisp_Object handler;
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (filename);
+ if (!NILP (handler))
+ return call2 (handler, Qfile_accessible_directory_p, filename);
+
if (NILP (Ffile_directory_p (filename))
|| NILP (Ffile_executable_p (filename)))
return Qnil;
{
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);
+ if (!NILP (handler))
+ return call2 (handler, Qfile_modes, abspath);
+
if (stat (XSTRING (abspath)->data, &st) < 0)
return Qnil;
+#ifdef MSDOS
+ {
+ int len;
+ char *suffix;
+ if (S_ISREG (st.st_mode)
+ && (len = XSTRING (abspath)->size) >= 5
+ && (stricmp ((suffix = XSTRING (abspath)->data + len-4), ".com") == 0
+ || stricmp (suffix, ".exe") == 0
+ || stricmp (suffix, ".bat") == 0))
+ st.st_mode |= S_IEXEC;
+ }
+#endif /* MSDOS */
+
return make_number (st.st_mode & 07777);
}
Lisp_Object filename, mode;
{
Lisp_Object abspath;
+ Lisp_Object handler;
abspath = Fexpand_file_name (filename, current_buffer->directory);
CHECK_NUMBER (mode, 1);
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (abspath);
+ 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));
return Qnil;
}
-DEFUN ("set-umask", Fset_umask, Sset_umask, 1, 1, 0,
- "Select which permission bits to disable in newly created files.\n\
-MASK should be an integer; if a permission's bit in MASK is 1,\n\
-subsequently created files will not have that permission enabled.\n\
-Only the low 9 bits are used.\n\
+DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
+ "Set the file permission bits for newly created files.\n\
+The argument MODE should be an integer; only the low 9 bits are used.\n\
This setting is inherited by subprocesses.")
- (mask)
- Lisp_Object mask;
+ (mode)
+ Lisp_Object mode;
{
- CHECK_NUMBER (mask, 0);
+ CHECK_NUMBER (mode, 0);
- umask (XINT (mask) & 0777);
+ umask ((~ XINT (mode)) & 0777);
return Qnil;
}
-DEFUN ("umask", Fumask, Sumask, 0, 0, 0,
- "Return the current umask value.\n\
-The umask value determines which permissions are enabled in newly\n\
-created files. If a permission's bit in the umask is 1, subsequently\n\
-created files will not have that permission enabled.")
+DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
+ "Return the default file protection for created files.\n\
+The value is an integer.")
()
{
- Lisp_Object mask;
+ int realmask;
+ Lisp_Object value;
- XSET (mask, Lisp_Int, umask (0));
- umask (XINT (mask));
+ realmask = umask (0);
+ umask (realmask);
- return mask;
+ XSET (value, Lisp_Int, (~ realmask) & 0777);
+ return value;
}
#ifdef unix
(file1, file2)
Lisp_Object file1, file2;
{
- Lisp_Object abspath;
+ Lisp_Object abspath1, abspath2;
struct stat st;
int mtime1;
+ Lisp_Object handler;
+ struct gcpro gcpro1, gcpro2;
CHECK_STRING (file1, 0);
CHECK_STRING (file2, 0);
- abspath = expand_and_dir_to_file (file1, current_buffer->directory);
+ abspath1 = Qnil;
+ GCPRO2 (abspath1, file2);
+ abspath1 = expand_and_dir_to_file (file1, current_buffer->directory);
+ abspath2 = expand_and_dir_to_file (file2, current_buffer->directory);
+ UNGCPRO;
- if (stat (XSTRING (abspath)->data, &st) < 0)
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (abspath1);
+ if (NILP (handler))
+ handler = Ffind_file_name_handler (abspath2);
+ if (!NILP (handler))
+ return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2);
+
+ if (stat (XSTRING (abspath1)->data, &st) < 0)
return Qnil;
mtime1 = st.st_mtime;
- abspath = expand_and_dir_to_file (file2, current_buffer->directory);
-
- if (stat (XSTRING (abspath)->data, &st) < 0)
+ if (stat (XSTRING (abspath2)->data, &st) < 0)
return Qt;
return (mtime1 > st.st_mtime) ? Qt : Qnil;
}
\f
+#ifdef MSDOS
+Lisp_Object Qfind_buffer_file_type;
+#endif
+
DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
- 1, 2, 0,
+ 1, 5, 0,
"Insert contents of file FILENAME after point.\n\
-Returns list of absolute pathname and length of data inserted.\n\
+Returns list of absolute file name and length of data inserted.\n\
If second argument VISIT is non-nil, the buffer's visited filename\n\
and last save file modtime are set, and it is marked unmodified.\n\
If visiting and the file does not exist, visiting is completed\n\
-before the error is signaled.")
- (filename, visit)
- Lisp_Object filename, visit;
+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.\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;
-
- GCPRO1 (filename);
+ struct gcpro gcpro1, gcpro2;
+ Lisp_Object handler, val, insval;
+ Lisp_Object p;
+ int total;
+
+ val = Qnil;
+ p = Qnil;
+
+ GCPRO2 (filename, p);
if (!NILP (current_buffer->read_only))
Fbarf_if_buffer_read_only();
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);
+ if (!NILP (handler))
+ {
+ val = call6 (handler, Qinsert_file_contents, filename,
+ visit, beg, end, replace);
+ goto handled;
+ }
+
fd = -1;
#ifndef APOLLO
goto notfound;
}
+ /* 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));
#ifdef S_IFSOCK
if (st.st_size < 0)
error ("File size is negative");
+ if (!NILP (beg) || !NILP (end))
+ if (!NILP (visit))
+ error ("Attempt to visit less than an entire file");
+
+ if (!NILP (beg))
+ CHECK_NUMBER (beg, 0);
+ else
+ XFASTINT (beg) = 0;
+
+ if (!NILP (end))
+ CHECK_NUMBER (end, 0);
+ else
+ {
+ XSETINT (end, st.st_size);
+ if (XINT (end) != st.st_size)
+ 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. */
+ if (!NILP (replace))
+ {
+ 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 bufferfull. */
+ 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 == ZV)
+ {
+ close (fd);
+ specpdl_ptr--;
+ 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);
+ /* 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 bufferfull 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 bufferfull. */
+ if (bufpos != 0)
+ break;
+ }
+ 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. */
+ XFASTINT (beg) = same_at_start - BEGV;
+ XFASTINT (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);
+ }
+
+ total = XINT (end) - XINT (beg);
+
{
register Lisp_Object temp;
/* Make sure point-max won't overflow after this insertion. */
- XSET (temp, Lisp_Int, st.st_size + Z);
- if (st.st_size + Z != XINT (temp))
+ XSET (temp, Lisp_Int, total);
+ if (total != XINT (temp))
error ("maximum buffer size exceeded");
}
- if (NILP (visit))
+ if (NILP (visit) && total > 0)
prepare_to_modify_buffer (point, point);
move_gap (point);
- if (GAP_SIZE < st.st_size)
- make_gap (st.st_size - GAP_SIZE);
-
- while (1)
+ if (GAP_SIZE < total)
+ make_gap (total - GAP_SIZE);
+
+ if (XINT (beg) != 0 || !NILP (replace))
{
- int try = min (st.st_size - inserted, 64 << 10);
+ if (lseek (fd, XINT (beg), 0) < 0)
+ report_file_error ("Setting file position", Fcons (filename, Qnil));
+ }
+
+ how_much = 0;
+ while (inserted < total)
+ {
+ int try = min (total - inserted, 64 << 10);
int this;
/* Allow quitting out of the actual I/O. */
inserted += this;
}
+#ifdef MSDOS
+ /* 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;
+ 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)
+ {
+ int reduced_size
+ = inserted - crlf_to_lf (inserted, &FETCH_CHAR (point - 1) + 1);
+ ZV -= reduced_size;
+ Z -= reduced_size;
+ GPT -= reduced_size;
+ GAP_SIZE += reduced_size;
+ inserted -= reduced_size;
+ }
+ }
+#endif
+
if (inserted > 0)
- MODIFF++;
- record_insert (point, inserted);
+ {
+ record_insert (point, inserted);
+
+ /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */
+ offset_intervals (current_buffer, point, inserted);
+ MODIFF++;
+ }
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",
- XSTRING (filename)->data, err_str (errno));
+ XSTRING (filename)->data, strerror (errno));
notfound:
+ handled:
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->modtime = st.st_mtime;
+
+ if (NILP (handler))
+ {
+ current_buffer->modtime = st.st_mtime;
+ current_buffer->filename = filename;
+ }
+
current_buffer->save_modified = MODIFF;
current_buffer->auto_save_modified = MODIFF;
XFASTINT (current_buffer->save_length) = Z - BEG;
#ifdef CLASH_DETECTION
- if (!NILP (current_buffer->filename))
- unlock_file (current_buffer->filename);
- unlock_file (filename);
+ if (NILP (handler))
+ {
+ if (!NILP (current_buffer->filename))
+ unlock_file (current_buffer->filename);
+ unlock_file (filename);
+ }
#endif /* CLASH_DETECTION */
- current_buffer->filename = filename;
/* If visiting nonexistent file, return nil. */
- if (st.st_mtime == -1)
+ if (current_buffer->modtime == -1)
report_file_error ("Opening input file", Fcons (filename, Qnil));
}
- signal_after_change (point, 0, inserted);
+ if (inserted > 0 && NILP (visit) && total > 0)
+ signal_after_change (point, 0, inserted);
- RETURN_UNGCPRO (Fcons (filename,
- Fcons (make_number (inserted),
- Qnil)));
+ if (inserted > 0)
+ {
+ p = Vafter_insert_file_functions;
+ while (!NILP (p))
+ {
+ insval = call1 (Fcar (p), make_number (inserted));
+ if (!NILP (insval))
+ {
+ CHECK_NUMBER (insval, 0);
+ inserted = XFASTINT (insval);
+ }
+ QUIT;
+ p = Fcdr (p);
+ }
+ }
+
+ 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,
"r\nFWrite region to file: ",
Optional fifth argument VISIT if t means\n\
set the last-save-file-modtime of buffer to this file's modtime\n\
and mark buffer not modified.\n\
-If VISIT is neither t nor nil, it means do not print\n\
- the \"Wrote file\" message.\n\
+If VISIT is a string, it is a second file name;\n\
+ the output goes to FILENAME, but the buffer is marked as visiting VISIT.\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\
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)
#ifdef VMS
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
+ int buffer_file_type
+ = NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY;
+#endif
+
+ if (!NILP (start) && !STRINGP (start))
+ validate_region (&start, &end);
+
+ filename = Fexpand_file_name (filename, Qnil);
+ if (STRINGP (visit))
+ visit_file = Fexpand_file_name (visit, Qnil);
+ else
+ visit_file = filename;
+
+ visiting = (EQ (visit, Qt) || STRINGP (visit));
+ quietly = !NILP (visit);
+
+ annotations = Qnil;
+
+ GCPRO4 (start, filename, annotations, visit_file);
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (filename);
+ /* 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))
+ {
+ Lisp_Object val;
+ val = call6 (handler, Qwrite_region, start, end,
+ filename, append, visit);
+
+ if (visiting)
+ {
+ current_buffer->save_modified = MODIFF;
+ XFASTINT (current_buffer->save_length) = Z - BEG;
+ current_buffer->filename = visit_file;
+ }
+ UNGCPRO;
+ return val;
+ }
- /* Special kludge to simplify auto-saving */
+ /* Special kludge to simplify auto-saving. */
if (NILP (start))
{
XFASTINT (start) = BEG;
XFASTINT (end) = Z;
}
- else if (XTYPE (start) != Lisp_String)
- validate_region (&start, &end);
- filename = Fexpand_file_name (filename, Qnil);
- fn = XSTRING (filename)->data;
+ annotations = build_annotations (start, end);
#ifdef CLASH_DETECTION
if (!auto_saving)
- lock_file (filename);
+ lock_file (visit_file);
#endif /* CLASH_DETECTION */
+ fn = XSTRING (filename)->data;
desc = -1;
if (!NILP (append))
+#ifdef MSDOS
+ desc = open (fn, O_WRONLY | buffer_file_type);
+#else
desc = open (fn, O_WRONLY);
+#endif
if (desc < 0)
#ifdef VMS
vms_truncate (fn); /* if fn exists, truncate to zero length */
desc = open (fn, O_RDWR);
if (desc < 0)
- desc = creat_copy_attrs (XTYPE (current_buffer->filename) == Lisp_String
+ desc = creat_copy_attrs (STRINGP (current_buffer->filename)
? XSTRING (current_buffer->filename)->data : 0,
fn);
}
desc = creat (fn, 0666);
}
#else /* not VMS */
+#ifdef MSDOS
+ desc = open (fn,
+ O_WRONLY | O_TRUNC | O_CREAT | buffer_file_type,
+ S_IREAD | S_IWRITE);
+#else /* not MSDOS */
desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666);
+#endif /* not MSDOS */
#endif /* not VMS */
+ UNGCPRO;
+
if (desc < 0)
{
#ifdef CLASH_DETECTION
save_errno = errno;
- if (!auto_saving) unlock_file (filename);
+ if (!auto_saving) unlock_file (visit_file);
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 (filename);
+ if (!auto_saving) unlock_file (visit_file);
#endif /* CLASH_DETECTION */
report_file_error ("Lseek error", Fcons (filename, Qnil));
}
failure = 0;
immediate_quit = 1;
- if (XTYPE (start) == Lisp_String)
+ if (STRINGP (start))
{
- failure = 0 > e_write (desc, XSTRING (start)->data,
- XSTRING (start)->size);
+ failure = 0 > a_write (desc, XSTRING (start)->data,
+ XSTRING (start)->size, 0, &annotations);
save_errno = errno;
}
else if (XINT (start) != XINT (end))
{
+ int nwritten = 0;
if (XINT (start) < GPT)
{
register int end1 = XINT (end);
tem = XINT (start);
- failure = 0 > e_write (desc, &FETCH_CHAR (tem),
- min (GPT, end1) - tem);
+ failure = 0 > a_write (desc, &FETCH_CHAR (tem),
+ min (GPT, end1) - tem, tem, &annotations);
+ nwritten += min (GPT, end1) - tem;
save_errno = errno;
}
{
tem = XINT (start);
tem = max (tem, GPT);
- failure = 0 > e_write (desc, &FETCH_CHAR (tem), XINT (end) - tem);
+ failure = 0 > a_write (desc, &FETCH_CHAR (tem), XINT (end) - tem,
+ tem, &annotations);
+ 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;
}
}
immediate_quit = 0;
-#ifndef USG
-#ifndef VMS
-#ifndef BSD4_1
+#ifdef HAVE_FSYNC
/* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
Disk full in NFS may be reported here. */
- if (fsync (desc) < 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;
-#endif
-#endif
#endif
/* Spurious "file has changed on disk" warnings have been
#ifdef CLASH_DETECTION
if (!auto_saving)
- unlock_file (filename);
+ unlock_file (visit_file);
#endif /* CLASH_DETECTION */
/* Do this before reporting IO error
to avoid a "file has changed on disk" warning on
next attempt to save. */
- if (EQ (visit, Qt))
+ if (visiting)
current_buffer->modtime = st.st_mtime;
if (failure)
- error ("IO error writing %s: %s", fn, err_str (save_errno));
+ error ("IO error writing %s: %s", fn, strerror (save_errno));
- if (EQ (visit, Qt))
+ if (visiting)
{
current_buffer->save_modified = MODIFF;
XFASTINT (current_buffer->save_length) = Z - BEG;
- current_buffer->filename = filename;
+ current_buffer->filename = visit_file;
}
- else if (!NILP (visit))
+ else if (quietly)
return Qnil;
if (!auto_saving)
- message ("Wrote %s", fn);
+ message ("Wrote %s", XSTRING (visit_file)->data);
return Qnil;
}
+Lisp_Object merge ();
+
+DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
+ "Return t if (car A) is numerically less than (car B).")
+ (a, b)
+ Lisp_Object a, b;
+{
+ return Flss (Fcar (a), Fcar (b));
+}
+
+/* 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. */
+
+static Lisp_Object
+build_annotations (start, end)
+ Lisp_Object start, end;
+{
+ Lisp_Object annotations;
+ Lisp_Object p, res;
+ struct gcpro gcpro1, gcpro2;
+
+ annotations = Qnil;
+ p = Vwrite_region_annotate_functions;
+ GCPRO2 (annotations, p);
+ while (!NILP (p))
+ {
+ res = call2 (Fcar (p), start, end);
+ Flength (res); /* Check basic validity of return value */
+ annotations = merge (annotations, res, Qcar_less_than_car);
+ p = Fcdr (p);
+ }
+ UNGCPRO;
+ return annotations;
+}
+
+/* Write to descriptor DESC the LEN characters starting at ADDR,
+ assuming they start at position POS in the buffer.
+ Intersperse with them the annotations from *ANNOT
+ (those which fall within the range of positions POS to POS + LEN),
+ each at its appropriate position.
+
+ Modify *ANNOT by discarding elements as we output them.
+ The return value is negative in case of system call failure. */
+
+int
+a_write (desc, addr, len, pos, annot)
+ int desc;
+ register char *addr;
+ register int len;
+ int pos;
+ Lisp_Object *annot;
+{
+ Lisp_Object tem;
+ int nextpos;
+ int lastpos = pos + len;
+
+ while (1)
+ {
+ tem = Fcar_safe (Fcar (*annot));
+ if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos)
+ nextpos = XFASTINT (tem);
+ else
+ return e_write (desc, addr, lastpos - pos);
+ if (nextpos > pos)
+ {
+ if (0 > e_write (desc, addr, nextpos - pos))
+ return -1;
+ addr += nextpos - pos;
+ pos = nextpos;
+ }
+ tem = Fcdr (Fcar (*annot));
+ if (STRINGP (tem))
+ {
+ if (0 > e_write (desc, XSTRING (tem)->data, XSTRING (tem)->size))
+ return -1;
+ }
+ *annot = Fcdr (*annot);
+ }
+}
+
int
e_write (desc, addr, len)
int desc;
{
struct buffer *b;
struct stat st;
+ Lisp_Object handler;
CHECK_BUFFER (buf, 0);
b = XBUFFER (buf);
if (XTYPE (b->filename) != Lisp_String) 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);
+ if (!NILP (handler))
+ return call2 (handler, Qverify_visited_file_modtime, buf);
+
if (stat (XSTRING (b->filename)->data, &st) < 0)
{
/* If the file doesn't exist now and didn't exist before,
return Qnil;
}
+DEFUN ("visited-file-modtime", Fvisited_file_modtime,
+ Svisited_file_modtime, 0, 0, 0,
+ "Return the current buffer's recorded visited file modification time.\n\
+The value is a list of the form (HIGH . LOW), like the time values\n\
+that `file-attributes' returns.")
+ ()
+{
+ return long_to_cons (current_buffer->modtime);
+}
+
DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
- Sset_visited_file_modtime, 0, 0, 0,
+ Sset_visited_file_modtime, 0, 1, 0,
"Update buffer's recorded modification time from the visited file's time.\n\
Useful if the buffer was not read from the file normally\n\
-or if the file itself has been changed for some known benign reason.")
- ()
+or if the file itself has been changed for some known benign reason.\n\
+An argument specifies the modification time value to use\n\
+\(instead of that of the visited file), in the form of a list\n\
+\(HIGH . LOW) or (HIGH LOW).")
+ (time_list)
+ Lisp_Object time_list;
{
- register Lisp_Object filename;
- struct stat st;
-
- filename = Fexpand_file_name (current_buffer->filename, Qnil);
-
- if (stat (XSTRING (filename)->data, &st) >= 0)
- current_buffer->modtime = st.st_mtime;
+ if (!NILP (time_list))
+ current_buffer->modtime = cons_to_long (time_list);
+ else
+ {
+ register Lisp_Object filename;
+ struct stat st;
+ Lisp_Object handler;
+
+ filename = Fexpand_file_name (current_buffer->filename, Qnil);
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (filename);
+ if (!NILP (handler))
+ /* The handler can find the file name the same way we did. */
+ return call2 (handler, Qset_visited_file_modtime, Qnil);
+ else if (stat (XSTRING (filename)->data, &st) >= 0)
+ current_buffer->modtime = st.st_mtime;
+ }
return Qnil;
}
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\
+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\
Non-nil first argument means do not print any message if successful.\n\
Non-nil second argument means save only current buffer.")
- (nomsg)
- Lisp_Object nomsg;
+ (no_message, current_only)
+ Lisp_Object no_message, current_only;
{
struct buffer *old = current_buffer, *b;
Lisp_Object tail, buf;
int auto_saved = 0;
char *omessage = echo_area_glyphs;
- extern minibuf_level;
+ int omessage_length = echo_area_glyphs_length;
+ extern int minibuf_level;
+ int do_handled_files;
+ Lisp_Object oquit;
+
+ /* Ordinarily don't quit within this function,
+ but don't make it impossible to quit (in case we get hung in I/O). */
+ oquit = Vquit_flag;
+ Vquit_flag = Qnil;
/* 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)
- nomsg = Qt;
+ 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"));
- for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
- tail = XCONS (tail)->cdr)
- {
- buf = XCONS (XCONS (tail)->car)->cdr;
- b = XBUFFER (buf);
- /* 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)
- && b->auto_save_modified < BUF_MODIFF (b))
- {
- if ((XFASTINT (b->save_length) * 10
- > (BUF_Z (b) - BUF_BEG (b)) * 13)
- /* A short file is likely to change a large fraction;
- spare the user annoying messages. */
- && XFASTINT (b->save_length) > 5000
- /* These messages are frequent and annoying for `*mail*'. */
- && !EQ (b->filename, Qnil))
- {
- /* 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;
- Fsleep_for (make_number (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)
+ {
+ buf = XCONS (XCONS (tail)->car)->cdr;
+ b = XBUFFER (buf);
+
+ if (!NILP (current_only)
+ && b != current_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)
+ && 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))))
+ {
+ EMACS_TIME before_time, after_time;
+
+ EMACS_GET_TIME (before_time);
+
+ /* If we had a failure, don't try again for 20 minutes. */
+ if (b->auto_save_failure_time >= 0
+ && EMACS_SECS (before_time) - b->auto_save_failure_time < 1200)
continue;
- }
- set_buffer_internal (b);
- if (!auto_saved && NILP (nomsg))
- message1 ("Auto-saving...");
- 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;
- set_buffer_internal (old);
- }
- }
- if (auto_saved)
- record_auto_save ();
+ if ((XFASTINT (b->save_length) * 10
+ > (BUF_Z (b) - BUF_BEG (b)) * 13)
+ /* A short file is likely to change a large fraction;
+ spare the user annoying messages. */
+ && XFASTINT (b->save_length) > 5000
+ /* These messages are frequent and annoying for `*mail*'. */
+ && !EQ (b->filename, Qnil)
+ && NILP (no_message))
+ {
+ /* It has shrunk too much; turn off auto-saving here. */
+ message ("Buffer %s has shrunk a lot; auto save turned off there",
+ XSTRING (b->name)->data);
+ /* Turn off auto-saving until there's a real save,
+ and prevent any more warnings. */
+ XSET (b->save_length, Lisp_Int, -1);
+ Fsleep_for (make_number (1), Qnil);
+ continue;
+ }
+ set_buffer_internal (b);
+ if (!auto_saved && NILP (no_message))
+ message1 ("Auto-saving...");
+ 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;
+ set_buffer_internal (old);
+
+ EMACS_GET_TIME (after_time);
+
+ /* If auto-save took more than 60 seconds,
+ assume it was an NFS failure that got a timeout. */
+ if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60)
+ b->auto_save_failure_time = EMACS_SECS (after_time);
+ }
+ }
+
+ /* Prevent another auto save till enough input events come in. */
+ record_auto_save ();
- if (auto_saved && NILP (nomsg))
- message1 (omessage ? omessage : "Auto-saving...done");
+ if (auto_saved && NILP (no_message))
+ {
+ if (omessage)
+ message2 (omessage, omessage_length);
+ else
+ message1 ("Auto-saving...done");
+ }
+
+ Vquit_flag = oquit;
auto_saving = 0;
return Qnil;
{
current_buffer->auto_save_modified = MODIFF;
XFASTINT (current_buffer->save_length) = Z - BEG;
+ current_buffer->auto_save_failure_time = -1;
+ return Qnil;
+}
+
+DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure,
+ Sclear_buffer_auto_save_failure, 0, 0, 0,
+ "Clear any record of a recent auto-save failure in the current buffer.")
+ ()
+{
+ current_buffer->auto_save_failure_time = -1;
return Qnil;
}
/* Reading and completing file names */
extern Lisp_Object Ffile_name_completion (), Ffile_name_all_completions ();
+/* In the string VAL, change each $ to $$ and return the result. */
+
+static Lisp_Object
+double_dollars (val)
+ Lisp_Object val;
+{
+ register unsigned char *old, *new;
+ register int n;
+ int osize, count;
+
+ osize = XSTRING (val)->size;
+ /* Quote "$" as "$$" to get it past substitute-in-file-name */
+ for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--)
+ if (*old++ == '$') count++;
+ if (count > 0)
+ {
+ old = XSTRING (val)->data;
+ val = Fmake_string (make_number (osize + count), make_number (0));
+ new = XSTRING (val)->data;
+ for (n = osize; n > 0; n--)
+ if (*old != '$')
+ *new++ = *old++;
+ else
+ {
+ *new++ = '$';
+ *new++ = '$';
+ old++;
+ }
+ }
+ return val;
+}
+
DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_internal,
3, 3, 0,
"Internal subroutine for read-file-name. Do not call this.")
lambda for verify final value */
{
Lisp_Object name, specdir, realdir, val, orig_string;
+ int changed;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+
+ realdir = dir;
+ name = string;
+ orig_string = Qnil;
+ specdir = Qnil;
+ changed = 0;
+ /* No need to protect ACTION--we only compare it with t and nil. */
+ GCPRO4 (string, realdir, name, specdir);
if (XSTRING (string)->size == 0)
{
- orig_string = Qnil;
- name = string;
- realdir = dir;
if (EQ (action, Qlambda))
- return Qnil;
+ {
+ UNGCPRO;
+ return Qnil;
+ }
}
else
{
orig_string = string;
string = Fsubstitute_in_file_name (string);
+ changed = NILP (Fstring_equal (string, orig_string));
name = Ffile_name_nondirectory (string);
- realdir = Ffile_name_directory (string);
- if (NILP (realdir))
- realdir = dir;
- else
- realdir = Fexpand_file_name (realdir, dir);
+ val = Ffile_name_directory (string);
+ if (! NILP (val))
+ realdir = Fexpand_file_name (val, realdir);
}
if (NILP (action))
{
specdir = Ffile_name_directory (string);
val = Ffile_name_completion (name, realdir);
+ UNGCPRO;
if (XTYPE (val) != Lisp_String)
{
- if (NILP (Fstring_equal (string, orig_string)))
+ if (changed)
return string;
- return (val);
+ return val;
}
if (!NILP (specdir))
val = concat2 (specdir, val);
#ifndef VMS
- {
- register unsigned char *old, *new;
- register int n;
- int osize, count;
-
- osize = XSTRING (val)->size;
- /* Quote "$" as "$$" to get it past substitute-in-file-name */
- for (n = osize, count = 0, old = XSTRING (val)->data; n > 0; n--)
- if (*old++ == '$') count++;
- if (count > 0)
- {
- old = XSTRING (val)->data;
- val = Fmake_string (make_number (osize + count), make_number (0));
- new = XSTRING (val)->data;
- for (n = osize; n > 0; n--)
- if (*old != '$')
- *new++ = *old++;
- else
- {
- *new++ = '$';
- *new++ = '$';
- old++;
- }
- }
- }
-#endif /* Not VMS */
- return (val);
+ return double_dollars (val);
+#else /* not VMS */
+ return val;
+#endif /* not VMS */
}
+ UNGCPRO;
if (EQ (action, Qt))
return Ffile_name_all_completions (name, realdir);
(prompt, dir, defalt, mustmatch, initial)
Lisp_Object prompt, dir, defalt, mustmatch, initial;
{
- Lisp_Object val, insdef, tem, backup_n;
+ Lisp_Object val, insdef, insdef1, tem;
struct gcpro gcpro1, gcpro2;
register char *homedir;
int count;
insdef = dir;
if (!NILP (initial))
{
- Lisp_Object args[2];
+ Lisp_Object args[2], pos;
args[0] = insdef;
args[1] = initial;
insdef = Fconcat (2, args);
- backup_n = make_number (- (XSTRING (initial)->size));
+ pos = make_number (XSTRING (double_dollars (dir))->size);
+ insdef1 = Fcons (double_dollars (insdef), pos);
}
else
- backup_n = Qnil;
+ insdef1 = double_dollars (insdef);
}
- else
+ else if (!NILP (initial))
{
- insdef = build_string ("");
- backup_n = Qnil;
+ insdef = initial;
+ insdef1 = Fcons (double_dollars (insdef), 0);
}
+ else
+ insdef = Qnil, insdef1 = Qnil;
#ifdef VMS
count = specpdl_ptr - specpdl;
GCPRO2 (insdef, defalt);
val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
- dir, mustmatch,
- insert_default_directory ? insdef : Qnil, backup_n);
+ dir, mustmatch, insdef1,
+ Qfile_name_history);
#ifdef VMS
unbind_to (count, Qnil);
tem = Fstring_equal (val, insdef);
if (!NILP (tem) && !NILP (defalt))
return defalt;
+ if (XSTRING (val)->size == 0 && NILP (insdef))
+ {
+ if (!NILP (defalt))
+ return defalt;
+ else
+ error ("No default file name");
+ }
return Fsubstitute_in_file_name (val);
}
#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;
{
GCPRO2 (insdef, defalt);
val = Fcompleting_read (prompt, intern ("read-file-name-internal"),
dir, mustmatch,
- insert_default_directory ? insdef : Qnil, Qnil);
+ insert_default_directory ? insdef : Qnil,
+ Qfile_name_history);
#ifdef VMS
unbind_to (count, Qnil);
\f
syms_of_fileio ()
{
+ Qexpand_file_name = intern ("expand-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");
+ Qdelete_directory = intern ("delete-directory");
+ Qdelete_file = intern ("delete-file");
+ Qrename_file = intern ("rename-file");
+ Qadd_name_to_file = intern ("add-name-to-file");
+ Qmake_symbolic_link = intern ("make-symbolic-link");
+ Qfile_exists_p = intern ("file-exists-p");
+ Qfile_executable_p = intern ("file-executable-p");
+ Qfile_readable_p = intern ("file-readable-p");
+ Qfile_symlink_p = intern ("file-symlink-p");
+ Qfile_writable_p = intern ("file-writable-p");
+ Qfile_directory_p = intern ("file-directory-p");
+ Qfile_accessible_directory_p = intern ("file-accessible-directory-p");
+ Qfile_modes = intern ("file-modes");
+ Qset_file_modes = intern ("set-file-modes");
+ Qfile_newer_than_file_p = intern ("file-newer-than-file-p");
+ Qinsert_file_contents = intern ("insert-file-contents");
+ Qwrite_region = intern ("write-region");
+ Qverify_visited_file_modtime = intern ("verify-visited-file-modtime");
+ Qset_visited_file_modtime = intern ("set-visited-file-modtime");
+
+ staticpro (&Qexpand_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 (&Qdelete_directory);
+ staticpro (&Qdelete_file);
+ staticpro (&Qrename_file);
+ staticpro (&Qadd_name_to_file);
+ staticpro (&Qmake_symbolic_link);
+ staticpro (&Qfile_exists_p);
+ staticpro (&Qfile_executable_p);
+ staticpro (&Qfile_readable_p);
+ staticpro (&Qfile_symlink_p);
+ staticpro (&Qfile_writable_p);
+ staticpro (&Qfile_directory_p);
+ staticpro (&Qfile_accessible_directory_p);
+ staticpro (&Qfile_modes);
+ staticpro (&Qset_file_modes);
+ staticpro (&Qfile_newer_than_file_p);
+ staticpro (&Qinsert_file_contents);
+ staticpro (&Qwrite_region);
+ staticpro (&Qverify_visited_file_modtime);
+
+ Qfile_name_history = intern ("file-name-history");
+ Fset (Qfile_name_history, Qnil);
+ staticpro (&Qfile_name_history);
+
Qfile_error = intern ("file-error");
staticpro (&Qfile_error);
Qfile_already_exists = intern("file-already-exists");
staticpro (&Qfile_already_exists);
+#ifdef MSDOS
+ Qfind_buffer_file_type = intern ("find-buffer-file-type");
+ staticpro (&Qfind_buffer_file_type);
+#endif
+
+ Qcar_less_than_car = intern ("car-less-than-car");
+ staticpro (&Qcar_less_than_car);
+
Fput (Qfile_error, Qerror_conditions,
Fcons (Qfile_error, Fcons (Qerror, Qnil)));
Fput (Qfile_error, Qerror_message,
nil means use format `var'. This variable is meaningful only on VMS.");
vms_stmlf_recfm = 0;
+ DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist,
+ "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\
+If a file name matches REGEXP, then all I/O on that file is done by calling\n\
+HANDLER.\n\
+\n\
+The first argument given to HANDLER is the name of the I/O primitive\n\
+to be handled; the remaining arguments are the arguments that were\n\
+passed to that primitive. For example, if you do\n\
+ (file-exists-p FILENAME)\n\
+and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\
+ (funcall HANDLER 'file-exists-p FILENAME)\n\
+The function `find-file-name-handler' checks this list for a handler\n\
+for its argument.");
+ Vfile_name_handler_alist = Qnil;
+
+ DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions,
+ "A list of functions to be called at the end of `insert-file-contents'.\n\
+Each is passed one argument, the number of bytes inserted. It should return\n\
+the new byte count, and leave point the same. If `insert-file-contents' is\n\
+intercepted by a handler from `file-name-handler-alist', that handler is\n\
+responsible for calling the after-insert-file-functions if appropriate.");
+ Vafter_insert_file_functions = Qnil;
+
+ DEFVAR_LISP ("write-region-annotate-functions", &Vwrite_region_annotate_functions,
+ "A list of functions to be called at the start of `write-region'.\n\
+Each is passed two arguments, START and END as for `write-region'. It should\n\
+return a list of pairs (POSITION . STRING) of strings to be effectively\n\
+inserted at the specified positions of the file being written (1 means to\n\
+insert before the first byte written). The POSITIONs must be sorted into\n\
+increasing order. If there are several functions in the list, the several\n\
+lists are merged destructively.");
+ Vwrite_region_annotate_functions = Qnil;
+
+ DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers,
+ "A list of file names for which handlers should not be used.");
+ Vinhibit_file_name_handlers = Qnil;
+
+ defsubr (&Sfind_file_name_handler);
defsubr (&Sfile_name_directory);
defsubr (&Sfile_name_nondirectory);
+ defsubr (&Sunhandled_file_name_directory);
defsubr (&Sfile_name_as_directory);
defsubr (&Sdirectory_file_name);
defsubr (&Smake_temp_name);
defsubr (&Sexpand_file_name);
defsubr (&Ssubstitute_in_file_name);
defsubr (&Scopy_file);
- defsubr (&Smake_directory);
+ defsubr (&Smake_directory_internal);
defsubr (&Sdelete_directory);
defsubr (&Sdelete_file);
defsubr (&Srename_file);
defsubr (&Sfile_accessible_directory_p);
defsubr (&Sfile_modes);
defsubr (&Sset_file_modes);
- defsubr (&Sset_umask);
- defsubr (&Sumask);
+ defsubr (&Sset_default_file_modes);
+ defsubr (&Sdefault_file_modes);
defsubr (&Sfile_newer_than_file_p);
defsubr (&Sinsert_file_contents);
defsubr (&Swrite_region);
+ defsubr (&Scar_less_than_car);
defsubr (&Sverify_visited_file_modtime);
defsubr (&Sclear_visited_file_modtime);
+ defsubr (&Svisited_file_modtime);
defsubr (&Sset_visited_file_modtime);
defsubr (&Sdo_auto_save);
defsubr (&Sset_buffer_auto_saved);
+ defsubr (&Sclear_buffer_auto_save_failure);
defsubr (&Srecent_auto_save_p);
defsubr (&Sread_file_name_internal);
defsubr (&Sread_file_name);
+#ifdef unix
defsubr (&Sunix_sync);
+#endif
}