/* File IO for GNU Emacs.
- Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 1, or (at your option)
+the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
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 <sys/types.h>
#include <sys/stat.h>
#ifdef VMS
-#include "pwd.h"
+#include "vms-pwd.h"
#else
#include <pwd.h>
#endif
#include <perror.h>
#include <stddef.h>
#include <string.h>
-#else
-#include <sys/dir.h>
#endif
#include <errno.h>
#include <sys/time.h>
#endif
-#include "config.h"
#include "lisp.h"
+#include "intervals.h"
#include "buffer.h"
#include "window.h"
#include <nam.h>
#endif
-#ifdef NEED_TIME_H
-#include <time.h>
-#else /* not NEED_TIME_H */
-#ifdef HAVE_TIMEVAL
-#include <sys/time.h>
-#endif /* HAVE_TIMEVAL */
-#endif /* not NEED_TIME_H */
+#include "systime.h"
#ifdef HPUX
#include <netio.h>
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;
+
/* Nonzero means, when reading a filename in the minibuffer,
start out by inserting the default directory into the minibuffer. */
int insert_default_directory;
Lisp_Object Qfile_error, Qfile_already_exists;
+Lisp_Object Qfile_name_history;
+
report_file_error (string, data)
char *string;
Lisp_Object data;
Fsignal (Qfile_error,
Fcons (build_string (string), Fcons (errstring, data)));
}
+
+close_file_unwind (fd)
+ Lisp_Object fd;
+{
+ close (XFASTINT (fd));
+}
+\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;
+
+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.")
+ (filename)
+ Lisp_Object filename;
+{
+ /* This function must not munge the match data. */
+
+ Lisp_Object chain;
+ 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);
+
beg = XSTRING (file)->data;
p = beg + XSTRING (file)->size;
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;
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)
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 (dst[slen - 1] == '/' && slen > 1)
+ if (slen > 1 && dst[slen - 1] == '/')
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 lbrack = 0, rbrack = 0;
int dots = 0;
#endif /* VMS */
+ 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);
+
#ifdef VMS
/* Filenames on VMS are always upper case. */
name = Fupcase (name);
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] == '\\')
newdir = 0;
if (nm[0] == '~') /* prefix ~ */
- if (nm[1] == '/'
+ {
+ if (nm[1] == '/'
#ifdef VMS
- || nm[1] == ':'
-#endif /* VMS */
- || nm[1] == 0)/* ~/filename */
- {
- 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 *) "";
+ 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;
-
- pw = (struct passwd *) getpwnam (o + 1);
- if (!pw)
- error ("\"%s\" isn't a registered user", o + 1);
+ && *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;
#ifdef VMS
- nm = p + 1; /* skip the terminator */
+ nm = p + 1; /* skip the terminator */
#else
- nm = p;
-#endif /* VMS */
- newdir = (unsigned char *) pw -> pw_dir;
- }
+ 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 (nm[0] != '/'
#ifdef VMS
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
return make_string (target, o - target);
}
#if 0
-DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
+/* 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\
(does not start with slash); if DEFAULT is nil or missing,\n\
#endif /* not VMS */
}
\f
+/* A slightly faster and more convenient way to get
+ (directory-file-name (expand-file-name FOO)). The return value may
+ have had its last character zapped with a '\0' character, meaning
+ that it is acceptable to system calls, but not to other lisp
+ functions. Callers should make sure that the return value doesn't
+ escape. */
+
Lisp_Object
expand_and_dir_to_file (filename, defdir)
Lisp_Object filename, defdir;
int ifd, ofd, n;
char buf[16 * 1024];
struct stat st;
+ Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
+ int count = specpdl_ptr - specpdl;
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);
+ if (!NILP (handler))
+ return call3 (handler, Qcopy_file, filename, newname);
+ /* Likewise for output file name. */
+ handler = Ffind_file_name_handler (newname);
+ if (!NILP (handler))
+ return call3 (handler, Qcopy_file, filename, newname);
+
if (NILP (ok_if_already_exists)
|| XTYPE (ok_if_already_exists) == Lisp_Int)
barf_or_query_if_file_exists (newname, "copy to it",
if (ifd < 0)
report_file_error ("Opening input file", Fcons (filename, Qnil));
+ record_unwind_protect (close_file_unwind, make_number (ifd));
+
#ifdef VMS
/* Create the copy file with the same record format as the input file */
ofd = sys_creat (XSTRING (newname)->data, 0666, ifd);
ofd = creat (XSTRING (newname)->data, 0666);
#endif /* VMS */
if (ofd < 0)
- {
- close (ifd);
report_file_error ("Opening output file", Fcons (newname, Qnil));
- }
+ record_unwind_protect (close_file_unwind, make_number (ofd));
+
+ immediate_quit = 1;
+ QUIT;
while ((n = read (ifd, buf, sizeof buf)) > 0)
if (write (ofd, buf, n) != n)
- {
- close (ifd);
- close (ofd);
report_file_error ("I/O error", Fcons (newname, Qnil));
- }
+ immediate_quit = 0;
if (fstat (ifd, &st) >= 0)
{
-#ifdef HAVE_TIMEVAL
if (!NILP (keep_date))
{
-#ifdef USE_UTIME
-/* AIX has utimes() in compatibility package, but it dies. So use good old
- utime interface instead. */
- struct {
- time_t atime;
- time_t mtime;
- } tv;
- tv.atime = st.st_atime;
- tv.mtime = st.st_mtime;
- utime (XSTRING (newname)->data, &tv);
-#else /* not USE_UTIME */
- struct timeval timevals[2];
- timevals[0].tv_sec = st.st_atime;
- timevals[1].tv_sec = st.st_mtime;
- timevals[0].tv_usec = timevals[1].tv_usec = 0;
- utimes (XSTRING (newname)->data, timevals);
-#endif /* not USE_UTIME */
+ 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);
}
-#endif /* HAVE_TIMEVALS */
-
#ifdef APOLLO
if (!egetenv ("USE_DOMAIN_ACLS"))
#endif
- chmod (XSTRING (newname)->data, st.st_mode & 07777);
+ chmod (XSTRING (newname)->data, st.st_mode & 07777);
}
+ /* Discard the unwind protects. */
+ specpdl_ptr = specpdl + count;
+
close (ifd);
if (close (ofd) < 0)
report_file_error ("I/O error", Fcons (newname, Qnil));
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 ("remove-directory", Fremove_directory, Sremove_directory, 1, 1, "FRemove directory: ",
- "Remove a directory. One argument, a file name string.")
+DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",
+ "Delete 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);
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))
+ return call3 (handler, Qrename_file, filename, newname);
+
if (NILP (ok_if_already_exists)
|| XTYPE (ok_if_already_exists) == Lisp_Int)
barf_or_query_if_file_exists (newname, "rename to it",
#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 call3 (handler, Qadd_name_to_file, filename, newname);
+
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",
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 happens for interactive use with M-x.")
- (filename, newname, ok_if_already_exists)
- Lisp_Object filename, newname, ok_if_already_exists;
+ (filename, linkname, ok_if_already_exists)
+ Lisp_Object filename, linkname, ok_if_already_exists;
{
#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
#endif
+ Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
- GCPRO2 (filename, newname);
+ GCPRO2 (filename, linkname);
CHECK_STRING (filename, 0);
- CHECK_STRING (newname, 1);
+ 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
- newname = Fexpand_file_name (newname, 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 call3 (handler, Qmake_symbolic_link, filename, linkname);
+
if (NILP (ok_if_already_exists)
|| XTYPE (ok_if_already_exists) == Lisp_Int)
- barf_or_query_if_file_exists (newname, "make it a link",
+ barf_or_query_if_file_exists (linkname, "make it a link",
XTYPE (ok_if_already_exists) == Lisp_Int);
- if (0 > symlink (XSTRING (filename)->data, XSTRING (newname)->data))
+ if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
{
/* If we didn't complain already, silently delete existing file. */
if (errno == EEXIST)
{
unlink (XSTRING (filename)->data);
- if (0 <= symlink (XSTRING (filename)->data, XSTRING (newname)->data))
+ if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
return Qnil;
}
#ifdef NO_ARG_ARRAY
args[0] = filename;
- args[1] = newname;
+ args[1] = linkname;
report_file_error ("Making symbolic link", Flist (2, args));
#else
report_file_error ("Making symbolic link", Flist (2, &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_exists_p, abspath);
+
return (access (XSTRING (abspath)->data, 0) >= 0) ? Qt : Qnil;
}
{
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;
}
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)
{
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;
dir = Ffile_name_directory (abspath);
{
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;
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 mask;
}
+#ifdef unix
+
+DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "",
+ "Tell Unix to finish all pending disk updates.")
+ ()
+{
+ sync ();
+ return Qnil;
+}
+
+#endif /* unix */
+
DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0,
"Return t if file FILE1 is newer than file FILE2.\n\
If FILE1 does not exist, the answer is nil;\n\
(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))
+ 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
-close_file_unwind (fd)
- Lisp_Object fd;
-{
- close (XFASTINT (fd));
-}
-
DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
1, 2, 0,
"Insert contents of file FILENAME after point.\n\
register int how_much;
int count = specpdl_ptr - specpdl;
struct gcpro gcpro1;
-
+ Lisp_Object handler, val;
+
+ val = Qnil;
+
GCPRO1 (filename);
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 = call3 (handler, Qinsert_file_contents, filename, visit);
+ st.st_mtime = 0;
+ goto handled;
+ }
+
fd = -1;
#ifndef APOLLO
record_unwind_protect (close_file_unwind, make_number (fd));
+#ifdef S_IFSOCK
+ /* 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)));
+#endif
+
/* Supposedly happens on VMS. */
if (st.st_size < 0)
error ("File size is negative");
+
{
register Lisp_Object temp;
while (1)
{
int try = min (st.st_size - inserted, 64 << 10);
- int this = read (fd, &FETCH_CHAR (point + inserted - 1) + 1, try);
+ int this;
+
+ /* Allow quitting out of the actual I/O. */
+ immediate_quit = 1;
+ QUIT;
+ this = read (fd, &FETCH_CHAR (point + inserted - 1) + 1, try);
+ immediate_quit = 0;
if (this <= 0)
{
}
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);
XSTRING (filename)->data, err_str (errno));
notfound:
+ handled:
if (!NILP (visit))
{
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 (!NILP (val))
+ RETURN_UNGCPRO (val);
RETURN_UNGCPRO (Fcons (filename,
Fcons (make_number (inserted),
Qnil)));
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\
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 = XTYPE (visit) == Lisp_String ? visit : filename;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
/* Special kludge to simplify auto-saving */
if (NILP (start))
else if (XTYPE (start) != Lisp_String)
validate_region (&start, &end);
+ GCPRO4 (start, filename, visit, visit_file);
filename = Fexpand_file_name (filename, Qnil);
- fn = XSTRING (filename)->data;
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ handler = Ffind_file_name_handler (filename);
+
+ if (!NILP (handler))
+ {
+ Lisp_Object args[7];
+ Lisp_Object val;
+ args[0] = handler;
+ args[1] = Qwrite_region;
+ args[2] = start;
+ args[3] = end;
+ args[4] = filename;
+ args[5] = append;
+ args[6] = visit;
+ val = Ffuncall (7, args);
+
+ /* Do this before reporting IO error
+ to avoid a "file has changed on disk" warning on
+ next attempt to save. */
+ if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
+ {
+ current_buffer->modtime = 0;
+ current_buffer->save_modified = MODIFF;
+ XFASTINT (current_buffer->save_length) = Z - BEG;
+ current_buffer->filename = visit_file;
+ }
+ UNGCPRO;
+ return val;
+ }
#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))
desc = open (fn, O_WRONLY);
desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666);
#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));
}
#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 (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
current_buffer->modtime = st.st_mtime;
if (failure)
error ("IO error writing %s: %s", fn, err_str (save_errno));
- if (EQ (visit, Qt))
+ if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String)
{
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))
return Qnil;
if (!auto_saving)
- message ("Wrote %s", fn);
+ message ("Wrote %s", XSTRING (visit_file)->data);
return Qnil;
}
{
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,
{
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))
+ current_buffer->modtime = 0;
- if (stat (XSTRING (filename)->data, &st) >= 0)
+ else if (stat (XSTRING (filename)->data, &st) >= 0)
current_buffer->modtime = st.st_mtime;
return Qnil;
ring_bell ();
message ("Autosaving...error for %s", name);
- Fsleep_for (make_number (1));
+ Fsleep_for (make_number (1), Qnil);
message ("Autosaving...error!for %s", name);
- Fsleep_for (make_number (1));
+ Fsleep_for (make_number (1), Qnil);
message ("Autosaving...error for %s", name);
- Fsleep_for (make_number (1));
+ Fsleep_for (make_number (1), Qnil);
return Qnil;
}
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 argumet means save only current buffer.")
+Non-nil second argument means save only current buffer.")
(nomsg)
Lisp_Object nomsg;
{
b->auto_save_file_name = Qnil;
/* Prevent warning from repeating if user does so. */
XFASTINT (b->save_length) = 0;
- Fsleep_for (make_number (1));
+ Fsleep_for (make_number (1), Qnil);
continue;
}
set_buffer_internal (b);
}
}
- if (auto_saved)
- record_auto_save ();
+ /* Prevent another auto save till enough input events come in. */
+ record_auto_save ();
if (auto_saved && NILP (nomsg))
message1 (omessage ? omessage : "Auto-saving...done");
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))
}
}
#endif /* Not VMS */
- return (val);
+ return val;
}
+ 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;
if (insert_default_directory)
{
insdef = dir;
+ insdef1 = 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 (dir)->size);
+ insdef1 = Fcons (insdef, pos);
}
- else
- backup_n = Qnil;
}
else
- {
- insdef = build_string ("");
- backup_n = Qnil;
- }
+ 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);
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");
+
+ 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");
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;
+
+ 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 (&Sremove_directory);
+ defsubr (&Smake_directory_internal);
+ defsubr (&Sdelete_directory);
defsubr (&Sdelete_file);
defsubr (&Srename_file);
defsubr (&Sadd_name_to_file);
defsubr (&Sread_file_name_internal);
defsubr (&Sread_file_name);
+
+#ifdef unix
+ defsubr (&Sunix_sync);
+#endif
}
HCoop / bpt / emacs.git / blobdiff