#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
#include <ctype.h>
#ifdef VMS
-#include "dir.h"
+#include "vmsdir.h"
#include <perror.h>
#include <stddef.h>
#include <string.h>
#define O_WRONLY 1
#endif
+#ifndef O_RDONLY
+#define O_RDONLY 0
+#endif
+
#define min(a, b) ((a) < (b) ? (a) : (b))
#define max(a, b) ((a) > (b) ? (a) : (b))
/* Functions to be called to create text property annotations for file. */
Lisp_Object Vwrite_region_annotate_functions;
+/* During build_annotations, each time an annotation function is called,
+ this holds the annotations made by the previous functions. */
+Lisp_Object Vwrite_region_annotations_so_far;
+
+/* File name in which we write a list of all our auto save files. */
+Lisp_Object Vauto_save_list_file_name;
+
/* Nonzero means, when reading a filename in the minibuffer,
start out by inserting the default directory into the minibuffer. */
int insert_default_directory;
Zero means use var format. */
int vms_stmlf_recfm;
+/* These variables describe handlers that have "already" had a chance
+ to handle the current operation.
+
+ Vinhibit_file_name_handlers is a list of file name handlers.
+ Vinhibit_file_name_operation is the operation being handled.
+ If we try to handle that operation, we ignore those handlers. */
+
+static Lisp_Object Vinhibit_file_name_handlers;
+static Lisp_Object Vinhibit_file_name_operation;
+
Lisp_Object Qfile_error, Qfile_already_exists;
Lisp_Object Qfile_name_history;
{
close (XFASTINT (fd));
}
+
+/* Restore point, having saved it as a marker. */
+
+restore_point_unwind (location)
+ Lisp_Object location;
+{
+ SET_PT (marker_position (location));
+ Fset_marker (location, Qnil, Qnil);
+}
\f
Lisp_Object Qexpand_file_name;
Lisp_Object Qdirectory_file_name;
Lisp_Object Qunhandled_file_name_directory;
Lisp_Object Qfile_name_as_directory;
Lisp_Object Qcopy_file;
-Lisp_Object Qmake_directory;
+Lisp_Object Qmake_directory_internal;
Lisp_Object Qdelete_directory;
Lisp_Object Qdelete_file;
Lisp_Object Qrename_file;
Lisp_Object Qverify_visited_file_modtime;
Lisp_Object Qset_visited_file_modtime;
-DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 1, 1, 0,
- "Return FILENAME's handler function, if its syntax is handled specially.\n\
+DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 2, 2, 0,
+ "Return FILENAME's handler function for OPERATION, if it has one.\n\
Otherwise, return nil.\n\
A file name is handled if one of the regular expressions in\n\
-`file-name-handler-alist' matches it.")
- (filename)
- Lisp_Object filename;
+`file-name-handler-alist' matches it.\n\n\
+If OPERATION equals `inhibit-file-name-operation', then we ignore\n\
+any handlers that are members of `inhibit-file-name-handlers',\n\
+but we still do run any other handlers. This lets handlers\n\
+use the standard functions without calling themselves recursively.")
+ (filename, operation)
+ Lisp_Object filename, operation;
{
/* This function must not munge the match data. */
- Lisp_Object chain;
+ Lisp_Object chain, inhibited_handlers;
CHECK_STRING (filename, 0);
- for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons;
+ if (EQ (operation, Vinhibit_file_name_operation))
+ inhibited_handlers = Vinhibit_file_name_handlers;
+ else
+ inhibited_handlers = Qnil;
+
+ for (chain = Vfile_name_handler_alist; CONSP (chain);
chain = XCONS (chain)->cdr)
{
Lisp_Object elt;
elt = XCONS (chain)->car;
- if (XTYPE (elt) == Lisp_Cons)
+ if (CONSP (elt))
{
Lisp_Object string;
string = XCONS (elt)->car;
- if (XTYPE (string) == Lisp_String
- && fast_string_match (string, filename) >= 0)
- return XCONS (elt)->cdr;
+ if (STRINGP (string) && fast_string_match (string, filename) >= 0)
+ {
+ Lisp_Object handler, tem;
+
+ handler = XCONS (elt)->cdr;
+ tem = Fmemq (handler, inhibited_handlers);
+ if (NILP (tem))
+ return handler;
+ }
}
QUIT;
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (file);
+ handler = Ffind_file_name_handler (file, Qfile_name_directory);
if (!NILP (handler))
return call2 (handler, Qfile_name_directory, file);
&& p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
#endif /* VMS */
#ifdef MSDOS
- && p[-1] != ':'
+ && p[-1] != ':' && p[-1] != '\\'
#endif
) p--;
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (file);
+ handler = Ffind_file_name_handler (file, Qfile_name_nondirectory);
if (!NILP (handler))
return call2 (handler, Qfile_name_nondirectory, file);
&& p[-1] != ':' && p[-1] != ']' && p[-1] != '>'
#endif /* VMS */
#ifdef MSDOS
- && p[-1] != ':'
+ && p[-1] != ':' && p[-1] != '\\'
#endif
) p--;
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory);
if (!NILP (handler))
return call2 (handler, Qunhandled_file_name_directory, filename);
#else /* not VMS */
/* For Unix syntax, Append a slash if necessary */
#ifdef MSDOS
- if (out[size] != ':' && out[size] != '/')
+ if (out[size] != ':' && out[size] != '/' && out[size] != '\\')
#else
if (out[size] != '/')
#endif
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (file);
+ handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
if (!NILP (handler))
return call2 (handler, Qfile_name_as_directory, file);
But leave "/" unchanged; do not change it to "". */
strcpy (dst, src);
if (slen > 1
- && dst[slen - 1] == '/'
#ifdef MSDOS
+ && (dst[slen - 1] == '/' || dst[slen - 1] == '/')
&& dst[slen - 2] != ':'
+#else
+ && dst[slen - 1] == '/'
#endif
)
dst[slen - 1] = 0;
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (directory);
+ handler = Ffind_file_name_handler (directory, Qdirectory_file_name);
if (!NILP (handler))
return call2 (handler, Qdirectory_file_name, directory);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (name);
+ handler = Ffind_file_name_handler (name, Qexpand_file_name);
if (!NILP (handler))
return call3 (handler, Qexpand_file_name, name, defalt);
nm = XSTRING (name)->data;
#ifdef MSDOS
- /* firstly, strip drive name. */
+ /* First map all backslashes to slashes. */
+ dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm));
+
+ /* Now strip drive name. */
{
unsigned char *colon = rindex (nm, ':');
if (colon)
CHECK_STRING (string, 0);
nm = XSTRING (string)->data;
+#ifdef MSDOS
+ dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm));
+ substituted = !strcmp (nm, XSTRING (string)->data);
+#endif
endp = nm + XSTRING (string)->size;
/* If /~ or // appears, discard everything through first slash. */
/* 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;
/* 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;
return abspath;
}
\f
+void
barf_or_query_if_file_exists (absname, querystring, interactive)
Lisp_Object absname;
unsigned char *querystring;
int interactive;
{
register Lisp_Object tem;
+ struct stat statbuf;
struct gcpro gcpro1;
- if (access (XSTRING (absname)->data, 4) >= 0)
+ /* stat is a good way to tell whether the file exists,
+ regardless of what access permissions it has. */
+ if (stat (XSTRING (absname)->data, &statbuf) >= 0)
{
if (! interactive)
Fsignal (Qfile_already_exists,
Lisp_Object handler;
struct gcpro gcpro1, gcpro2;
int count = specpdl_ptr - specpdl;
- Lisp_Object args[6];
int input_file_statable_p;
GCPRO2 (filename, newname);
/* If the input file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qcopy_file);
/* Likewise for output file name. */
if (NILP (handler))
- handler = Ffind_file_name_handler (newname);
+ handler = Ffind_file_name_handler (newname, Qcopy_file);
if (!NILP (handler))
- return call5 (handler, Qcopy_file, filename, newname,
- ok_if_already_exists, keep_date);
+ RETURN_UNGCPRO (call5 (handler, Qcopy_file, filename, newname,
+ ok_if_already_exists, keep_date));
if (NILP (ok_if_already_exists)
- || XTYPE (ok_if_already_exists) == Lisp_Int)
+ || INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "copy to it",
- XTYPE (ok_if_already_exists) == Lisp_Int);
+ INTEGERP (ok_if_already_exists));
- ifd = open (XSTRING (filename)->data, 0);
+ ifd = open (XSTRING (filename)->data, O_RDONLY);
if (ifd < 0)
report_file_error ("Opening input file", Fcons (filename, Qnil));
report_file_error ("I/O error", Fcons (newname, Qnil));
immediate_quit = 0;
+ /* Closing the output clobbers the file times on some systems. */
+ if (close (ofd) < 0)
+ report_file_error ("I/O error", Fcons (newname, Qnil));
+
if (input_file_statable_p)
{
if (!NILP (keep_date))
EMACS_TIME atime, mtime;
EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
- EMACS_SET_UTIMES (XSTRING (newname)->data, atime, mtime);
+ if (set_file_times (XSTRING (newname)->data, atime, mtime))
+ report_file_error ("I/O error", Fcons (newname, Qnil));
}
#ifdef APOLLO
if (!egetenv ("USE_DOMAIN_ACLS"))
chmod (XSTRING (newname)->data, st.st_mode & 07777);
}
+ close (ifd);
+
/* Discard the unwind protects. */
specpdl_ptr = specpdl + count;
- close (ifd);
- if (close (ofd) < 0)
- report_file_error ("I/O error", Fcons (newname, Qnil));
-
UNGCPRO;
return Qnil;
}
CHECK_STRING (dirname, 0);
dirname = Fexpand_file_name (dirname, Qnil);
- handler = Ffind_file_name_handler (dirname);
+ handler = Ffind_file_name_handler (dirname, Qmake_directory_internal);
if (!NILP (handler))
- return call3 (handler, Qmake_directory, dirname, Qnil);
+ return call2 (handler, Qmake_directory_internal, dirname);
dir = XSTRING (dirname)->data;
}
DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ",
- "Delete a directory. One argument, a file name string.")
+ "Delete a directory. One argument, a file name or directory name string.")
(dirname)
Lisp_Object dirname;
{
Lisp_Object handler;
CHECK_STRING (dirname, 0);
- dirname = Fexpand_file_name (dirname, Qnil);
+ dirname = Fdirectory_file_name (Fexpand_file_name (dirname, Qnil));
dir = XSTRING (dirname)->data;
- handler = Ffind_file_name_handler (dirname);
+ handler = Ffind_file_name_handler (dirname, Qdelete_directory);
if (!NILP (handler))
return call2 (handler, Qdelete_directory, dirname);
CHECK_STRING (filename, 0);
filename = Fexpand_file_name (filename, Qnil);
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qdelete_file);
if (!NILP (handler))
return call2 (handler, Qdelete_file, filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qrename_file);
if (NILP (handler))
- handler = Ffind_file_name_handler (newname);
+ handler = Ffind_file_name_handler (newname, Qrename_file);
if (!NILP (handler))
- return call4 (handler, Qrename_file,
- filename, newname, ok_if_already_exists);
+ RETURN_UNGCPRO (call4 (handler, Qrename_file,
+ filename, newname, ok_if_already_exists));
if (NILP (ok_if_already_exists)
- || XTYPE (ok_if_already_exists) == Lisp_Int)
+ || INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "rename to it",
- XTYPE (ok_if_already_exists) == Lisp_Int);
+ INTEGERP (ok_if_already_exists));
#ifndef BSD4_1
if (0 > rename (XSTRING (filename)->data, XSTRING (newname)->data))
#else
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qadd_name_to_file);
if (!NILP (handler))
- return call4 (handler, Qadd_name_to_file, filename, newname,
- ok_if_already_exists);
+ RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename,
+ newname, ok_if_already_exists));
if (NILP (ok_if_already_exists)
- || XTYPE (ok_if_already_exists) == Lisp_Int)
+ || INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "make it a new name",
- XTYPE (ok_if_already_exists) == Lisp_Int);
+ INTEGERP (ok_if_already_exists));
unlink (XSTRING (newname)->data);
if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data))
{
DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
"FMake symbolic link to file: \nFMake symbolic link to file %s: \np",
"Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\
-Signals a `file-already-exists' error if a file NEWNAME already exists\n\
+Signals a `file-already-exists' error if a file LINKNAME already exists\n\
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.\n\
-A number as third arg means request confirmation if NEWNAME already exists.\n\
+A number as third arg means request confirmation if LINKNAME already exists.\n\
This happens for interactive use with M-x.")
(filename, linkname, ok_if_already_exists)
Lisp_Object filename, linkname, ok_if_already_exists;
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qmake_symbolic_link);
if (!NILP (handler))
- return call4 (handler, Qmake_symbolic_link, filename, linkname,
- ok_if_already_exists);
+ RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename,
+ linkname, ok_if_already_exists));
if (NILP (ok_if_already_exists)
- || XTYPE (ok_if_already_exists) == Lisp_Int)
+ || INTEGERP (ok_if_already_exists))
barf_or_query_if_file_exists (linkname, "make it a link",
- XTYPE (ok_if_already_exists) == Lisp_Int);
+ INTEGERP (ok_if_already_exists));
if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
{
/* If we didn't complain already, silently delete existing file. */
{
unlink (XSTRING (linkname)->data);
if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
- return Qnil;
+ {
+ UNGCPRO;
+ return Qnil;
+ }
}
#ifdef NO_ARG_ARRAY
&& ptr[1] != '.')
#endif /* VMS */
#ifdef MSDOS
- || (*ptr != 0 && ptr[1] == ':' && ptr[2] == '/')
+ || (*ptr != 0 && ptr[1] == ':' && (ptr[2] == '/' || ptr[2] == '\\'))
#endif
)
return Qt;
else
return Qnil;
}
+\f
+/* Return nonzero if file FILENAME exists and can be executed. */
+
+static int
+check_executable (filename)
+ char *filename;
+{
+#ifdef __HURD__
+ mach_port_t file;
+ int access_mode;
+
+ file = path_lookup (filename, 0, 0);
+ if (file == MACH_PORT_NULL)
+ /* File can't be opened. */
+ access_mode = 0;
+ else
+ {
+ file_access (file, &access_mode);
+ mach_port_deallocate (mach_task_self (), file);
+ }
+ return !!(access_mode & O_EXEC);
+#else
+ /* Access isn't quite right because it uses the real uid
+ and we really want to test with the effective uid.
+ But Unix doesn't give us a right way to do it. */
+ return (access (filename, 1) >= 0);
+#endif
+}
+
+/* Return nonzero if file FILENAME exists and can be written. */
+
+static int
+check_writable (filename)
+ char *filename;
+{
+#ifdef __HURD__
+ mach_port_t file;
+ int access_mode;
+
+ file = path_lookup (filename, 0, 0);
+ if (file == MACH_PORT_NULL)
+ /* File can't be opened. */
+ access_mode = 0;
+ else
+ {
+ file_access (file, &access_mode);
+ mach_port_deallocate (mach_task_self (), file);
+ }
+ return !!(access_mode & O_WRITE);
+#else
+ /* Access isn't quite right because it uses the real uid
+ and we really want to test with the effective uid.
+ But Unix doesn't give us a right way to do it.
+ Opening with O_WRONLY could work for an ordinary file,
+ but would lose for directories. */
+ return (access (filename, 2) >= 0);
+#endif
+}
DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0,
"Return t if file FILENAME exists. (This does not mean you can read it.)\n\
{
Lisp_Object abspath;
Lisp_Object handler;
+ struct stat statbuf;
CHECK_STRING (filename, 0);
abspath = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath);
+ handler = Ffind_file_name_handler (abspath, Qfile_exists_p);
if (!NILP (handler))
return call2 (handler, Qfile_exists_p, abspath);
- return (access (XSTRING (abspath)->data, 0) >= 0) ? Qt : Qnil;
+ return (stat (XSTRING (abspath)->data, &statbuf) >= 0) ? Qt : Qnil;
}
DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath);
+ handler = Ffind_file_name_handler (abspath, Qfile_executable_p);
if (!NILP (handler))
return call2 (handler, Qfile_executable_p, abspath);
- return (access (XSTRING (abspath)->data, 1) >= 0) ? Qt : Qnil;
+ return (check_executable (XSTRING (abspath)->data) ? Qt : Qnil);
}
DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0,
{
Lisp_Object abspath;
Lisp_Object handler;
+ int desc;
CHECK_STRING (filename, 0);
abspath = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath);
+ handler = Ffind_file_name_handler (abspath, Qfile_readable_p);
if (!NILP (handler))
return call2 (handler, Qfile_readable_p, abspath);
- return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil;
+ desc = open (XSTRING (abspath)->data, O_RDONLY);
+ if (desc < 0)
+ return Qnil;
+ close (desc);
+ return Qt;
}
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;
{
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qfile_symlink_p);
if (!NILP (handler))
return call2 (handler, Qfile_symlink_p, filename);
#endif /* not S_IFLNK */
}
-#ifdef SOLARIS_BROKEN_ACCESS
-/* In Solaris 2.1, the readonly-ness of the filesystem is not
- considered by the access system call. This is Sun's bug, but we
- still have to make Emacs work. */
-
-#include <sys/statvfs.h>
-
-static int
-ro_fsys (path)
- char *path;
-{
- struct statvfs statvfsb;
-
- if (statvfs(path, &statvfsb))
- return 1; /* error from statvfs, be conservative and say not wrtable */
- else
- /* Otherwise, fsys is ro if bit is set. */
- return statvfsb.f_flag & ST_RDONLY;
-}
-#else
-/* But on every other os, access has already done the right thing. */
-#define ro_fsys(path) 0
-#endif
-
/* Having this before file-symlink-p mysteriously caused it to be forgotten
on the RT/PC. */
DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
{
Lisp_Object abspath, dir;
Lisp_Object handler;
+ struct stat statbuf;
CHECK_STRING (filename, 0);
abspath = Fexpand_file_name (filename, Qnil);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath);
+ handler = Ffind_file_name_handler (abspath, Qfile_writable_p);
if (!NILP (handler))
return call2 (handler, Qfile_writable_p, abspath);
- if (access (XSTRING (abspath)->data, 0) >= 0)
- return ((access (XSTRING (abspath)->data, 2) >= 0
- && ! ro_fsys ((char *) XSTRING (abspath)->data))
+ if (stat (XSTRING (abspath)->data, &statbuf) >= 0)
+ return (check_writable (XSTRING (abspath)->data)
? Qt : Qnil);
dir = Ffile_name_directory (abspath);
#ifdef VMS
if (!NILP (dir))
dir = Fdirectory_file_name (dir);
#endif /* MSDOS */
- return ((access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0
- && ! ro_fsys ((char *) XSTRING (dir)->data))
+ return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "")
? Qt : Qnil);
}
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath);
+ handler = Ffind_file_name_handler (abspath, Qfile_directory_p);
if (!NILP (handler))
return call2 (handler, Qfile_directory_p, abspath);
Lisp_Object filename;
{
Lisp_Object handler;
+ int tem;
+ struct gcpro gcpro1;
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p);
if (!NILP (handler))
return call2 (handler, Qfile_accessible_directory_p, filename);
- if (NILP (Ffile_directory_p (filename))
- || NILP (Ffile_executable_p (filename)))
- return Qnil;
- else
- return Qt;
+ /* It's an unlikely combination, but yes we really do need to gcpro:
+ Suppose that file-accessible-directory-p has no handler, but
+ file-directory-p does have a handler; this handler causes a GC which
+ relocates the string in `filename'; and finally file-directory-p
+ returns non-nil. Then we would end up passing a garbaged string
+ to file-executable-p. */
+ GCPRO1 (filename);
+ tem = (NILP (Ffile_directory_p (filename))
+ || NILP (Ffile_executable_p (filename)));
+ UNGCPRO;
+ return tem ? Qnil : Qt;
}
DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath);
+ handler = Ffind_file_name_handler (abspath, Qfile_modes);
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);
}
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath);
+ handler = Ffind_file_name_handler (abspath, Qset_file_modes);
if (!NILP (handler))
return call3 (handler, Qset_file_modes, abspath, mode);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (abspath1);
+ handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p);
if (NILP (handler))
- handler = Ffind_file_name_handler (abspath2);
+ handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p);
if (!NILP (handler))
return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2);
#endif
DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents,
- 1, 4, 0,
+ 1, 5, 0,
"Insert contents of file FILENAME after point.\n\
Returns list of absolute file name and length of data inserted.\n\
If second argument VISIT is non-nil, the buffer's visited filename\n\
before the error is signaled.\n\n\
The optional third and fourth arguments BEG and END\n\
specify what portion of the file to insert.\n\
-If VISIT is non-nil, BEG and END must be nil.")
- (filename, visit, beg, end)
- Lisp_Object filename, visit, beg, end;
+If VISIT is non-nil, BEG and END must be nil.\n\
+If optional fifth argument REPLACE is non-nil,\n\
+it means replace the current buffer contents (in the accessible portion)\n\
+with the file contents. This is better than simply deleting and inserting\n\
+the whole thing because (1) it preserves some marker positions\n\
+and (2) it puts less data in the undo list.")
+ (filename, visit, beg, end, replace)
+ Lisp_Object filename, visit, beg, end, replace;
{
struct stat st;
register int fd;
register int inserted = 0;
register int how_much;
int count = specpdl_ptr - specpdl;
- struct gcpro gcpro1, gcpro2;
+ struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object handler, val, insval;
Lisp_Object p;
int total;
val = Qnil;
p = Qnil;
- GCPRO2 (filename, p);
+ GCPRO3 (filename, val, p);
if (!NILP (current_buffer->read_only))
Fbarf_if_buffer_read_only();
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qinsert_file_contents);
if (!NILP (handler))
{
- val = call5 (handler, Qinsert_file_contents, filename, visit, beg, end);
+ val = call6 (handler, Qinsert_file_contents, filename,
+ visit, beg, end, replace);
goto handled;
}
fd = -1;
#ifndef APOLLO
- if (stat (XSTRING (filename)->data, &st) < 0
- || (fd = open (XSTRING (filename)->data, 0)) < 0)
+ if (stat (XSTRING (filename)->data, &st) < 0)
#else
- if ((fd = open (XSTRING (filename)->data, 0)) < 0
+ if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0
|| fstat (fd, &st) < 0)
#endif /* not APOLLO */
{
if (fd >= 0) close (fd);
+ badopen:
if (NILP (visit))
report_file_error ("Opening input file", Fcons (filename, Qnil));
st.st_mtime = -1;
goto notfound;
}
- record_unwind_protect (close_file_unwind, make_number (fd));
-
-#ifdef S_IFSOCK
+#ifdef S_IFREG
/* This code will need to be changed in order to work on named
pipes, and it's probably just not worth it. So we should at
least signal an error. */
- if ((st.st_mode & S_IFMT) == S_IFSOCK)
+ if (!S_ISREG (st.st_mode))
Fsignal (Qfile_error,
- Fcons (build_string ("reading from named pipe"),
+ Fcons (build_string ("not a regular file"),
Fcons (filename, Qnil)));
#endif
+ if (fd < 0)
+ if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0)
+ goto badopen;
+
+ /* Replacement should preserve point as it preserves markers. */
+ if (!NILP (replace))
+ record_unwind_protect (restore_point_unwind, Fpoint_marker ());
+
+ record_unwind_protect (close_file_unwind, make_number (fd));
+
/* Supposedly happens on VMS. */
if (st.st_size < 0)
error ("File size is negative");
error ("maximum buffer size exceeded");
}
+ /* If requested, replace the accessible part of the buffer
+ with the file contents. Avoid replacing text at the
+ beginning or end of the buffer that matches the file contents;
+ that preserves markers pointing to the unchanged parts. */
+#ifdef MSDOS
+ /* On MSDOS, replace mode doesn't really work, except for binary files,
+ and it's not worth supporting just for them. */
+ if (!NILP (replace))
+ {
+ replace = Qnil;
+ XFASTINT (beg) = 0;
+ XFASTINT (end) = st.st_size;
+ del_range_1 (BEGV, ZV, 0);
+ }
+#else /* MSDOS */
+ if (!NILP (replace))
+ {
+ unsigned char buffer[1 << 14];
+ int same_at_start = BEGV;
+ int same_at_end = ZV;
+ int overlap;
+
+ immediate_quit = 1;
+ QUIT;
+ /* Count how many chars at the start of the file
+ match the text at the beginning of the buffer. */
+ while (1)
+ {
+ int nread, bufpos;
+
+ nread = read (fd, buffer, sizeof buffer);
+ if (nread < 0)
+ error ("IO error reading %s: %s",
+ XSTRING (filename)->data, strerror (errno));
+ else if (nread == 0)
+ break;
+ bufpos = 0;
+ while (bufpos < nread && same_at_start < ZV
+ && FETCH_CHAR (same_at_start) == buffer[bufpos])
+ same_at_start++, bufpos++;
+ /* If we found a discrepancy, stop the scan.
+ Otherwise loop around and scan the next 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 - BEGV == st.st_size)
+ {
+ close (fd);
+ specpdl_ptr--;
+ /* Truncate the buffer to the size of the file. */
+ del_range_1 (same_at_start, same_at_end, 0);
+ goto handled;
+ }
+ immediate_quit = 1;
+ QUIT;
+ /* Count how many chars at the end of the file
+ match the text at the end of the buffer. */
+ while (1)
+ {
+ int total_read, nread, bufpos, curpos, trial;
+
+ /* At what file position are we now scanning? */
+ curpos = st.st_size - (ZV - same_at_end);
+ /* If the entire file matches the buffer tail, stop the scan. */
+ if (curpos == 0)
+ break;
+ /* How much can we scan in the next step? */
+ trial = min (curpos, sizeof buffer);
+ if (lseek (fd, curpos - trial, 0) < 0)
+ report_file_error ("Setting file position",
+ Fcons (filename, Qnil));
+
+ total_read = 0;
+ while (total_read < trial)
+ {
+ nread = read (fd, buffer + total_read, trial - total_read);
+ if (nread <= 0)
+ error ("IO error reading %s: %s",
+ XSTRING (filename)->data, strerror (errno));
+ total_read += nread;
+ }
+ /* Scan this 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);
+ }
+#endif /* MSDOS */
+
total = XINT (end) - XINT (beg);
{
if (GAP_SIZE < total)
make_gap (total - GAP_SIZE);
- if (XINT (beg) != 0)
+ if (XINT (beg) != 0 || !NILP (replace))
{
if (lseek (fd, XINT (beg), 0) < 0)
report_file_error ("Setting file position", Fcons (filename, Qnil));
}
- while (1)
+ how_much = 0;
+ while (inserted < total)
{
int try = min (total - inserted, 64 << 10);
int this;
/* Determine file type from name and remove LFs from CR-LFs if the file
is deemed to be a text file. */
{
- struct gcpro gcpro1;
- Lisp_Object code = Qnil;
- GCPRO1 (filename);
- code = call1 (Qfind_buffer_file_type, filename);
- UNGCPRO;
- if (XTYPE (code) == Lisp_Int)
- XFASTINT (current_buffer->buffer_file_type) = XFASTINT (code);
- if (XFASTINT (current_buffer->buffer_file_type) == 0)
+ current_buffer->buffer_file_type
+ = call1 (Qfind_buffer_file_type, filename);
+ if (NILP (current_buffer->buffer_file_type))
{
- int reduced_size =
- inserted - crlf_to_lf (inserted, &FETCH_CHAR (point - 1) + 1);
+ int reduced_size
+ = inserted - crlf_to_lf (inserted, &FETCH_CHAR (point - 1) + 1);
ZV -= reduced_size;
Z -= reduced_size;
GPT -= reduced_size;
close (fd);
- /* Discard the unwind protect */
- specpdl_ptr = specpdl + count;
+ /* Discard the unwind protect for closing the file. */
+ specpdl_ptr--;
if (how_much < 0)
error ("IO error reading %s: %s",
if (!NILP (visit))
{
- current_buffer->undo_list = Qnil;
+ if (!EQ (current_buffer->undo_list, Qt))
+ current_buffer->undo_list = Qnil;
#ifdef APOLLO
stat (XSTRING (filename)->data, &st);
#endif
}
}
- if (!NILP (val))
- RETURN_UNGCPRO (val);
- RETURN_UNGCPRO (Fcons (filename,
- Fcons (make_number (inserted),
- Qnil)));
+ if (NILP (val))
+ val = Fcons (filename,
+ Fcons (make_number (inserted),
+ Qnil));
+
+ RETURN_UNGCPRO (unbind_to (count, val));
}
\f
static Lisp_Object build_annotations ();
+/* If build_annotations switched buffers, switch back to BUF.
+ Kill the temporary buffer that was selected in the meantime. */
+
+static Lisp_Object
+build_annotations_unwind (buf)
+ Lisp_Object buf;
+{
+ Lisp_Object tembuf;
+
+ if (XBUFFER (buf) == current_buffer)
+ return Qnil;
+ tembuf = Fcurrent_buffer ();
+ Fset_buffer (buf);
+ Fkill_buffer (tembuf);
+ return Qnil;
+}
+
DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 5,
"r\nFWrite region to file: ",
"Write current region into specified file.\n\
struct stat st;
int tem;
int count = specpdl_ptr - specpdl;
+ int count1;
#ifdef VMS
unsigned char *fname = 0; /* If non-0, original filename (must rename) */
#endif /* VMS */
Lisp_Object annotations;
int visiting, quietly;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ struct buffer *given_buffer;
#ifdef MSDOS
int buffer_file_type
= NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY;
if (!NILP (start) && !STRINGP (start))
validate_region (&start, &end);
+ GCPRO2 (filename, visit);
filename = Fexpand_file_name (filename, Qnil);
if (STRINGP (visit))
visit_file = Fexpand_file_name (visit, Qnil);
else
visit_file = filename;
+ UNGCPRO;
visiting = (EQ (visit, Qt) || STRINGP (visit));
quietly = !NILP (visit);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qwrite_region);
+ /* If FILENAME has no handler, see if VISIT has one. */
+ if (NILP (handler) && STRINGP (visit))
+ handler = Ffind_file_name_handler (visit, Qwrite_region);
if (!NILP (handler))
{
XFASTINT (end) = Z;
}
+ record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ());
+ count1 = specpdl_ptr - specpdl;
+
+ given_buffer = current_buffer;
annotations = build_annotations (start, end);
+ if (current_buffer != given_buffer)
+ {
+ start = BEGV;
+ end = ZV;
+ }
#ifdef CLASH_DETECTION
if (!auto_saving)
#ifndef FOO
stat (fn, &st);
#endif
- /* Discard the unwind protect */
- specpdl_ptr = specpdl + count;
+ /* Discard the unwind protect for close_file_unwind. */
+ specpdl_ptr = specpdl + count1;
+ /* Restore the original current buffer. */
+ visit_file = unbind_to (count, visit_file);
#ifdef CLASH_DETECTION
if (!auto_saving)
current_buffer->save_modified = MODIFF;
XFASTINT (current_buffer->save_length) = Z - BEG;
current_buffer->filename = visit_file;
+ update_mode_lines++;
}
else if (quietly)
return Qnil;
/* Build the complete list of annotations appropriate for writing out
the text between START and END, by calling all the functions in
- write-region-annotate-functions and merging the lists they return. */
+ write-region-annotate-functions and merging the lists they return.
+ If one of these functions switches to a different buffer, we assume
+ that buffer contains altered text. Therefore, the caller must
+ make sure to restore the current buffer in all cases,
+ as save-excursion would do. */
static Lisp_Object
build_annotations (start, end)
GCPRO2 (annotations, p);
while (!NILP (p))
{
+ struct buffer *given_buffer = current_buffer;
+ Vwrite_region_annotations_so_far = annotations;
res = call2 (Fcar (p), start, end);
+ /* If the function makes a different buffer current,
+ assume that means this buffer contains altered text to be output.
+ Reset START and END from the buffer bounds
+ and discard all previous annotations because they should have
+ been dealt with by this function. */
+ if (current_buffer != given_buffer)
+ {
+ start = BEGV;
+ end = ZV;
+ annotations = Qnil;
+ }
Flength (res); /* Check basic validity of return value */
annotations = merge (annotations, res, Qcar_less_than_car);
p = Fcdr (p);
int nextpos;
int lastpos = pos + len;
- while (1)
+ while (NILP (*annot) || CONSP (*annot))
{
tem = Fcar_safe (Fcar (*annot));
if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos)
CHECK_BUFFER (buf, 0);
b = XBUFFER (buf);
- if (XTYPE (b->filename) != Lisp_String) return Qt;
+ if (!STRINGP (b->filename)) return Qt;
if (b->modtime == 0) return Qt;
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (b->filename);
+ handler = Ffind_file_name_handler (b->filename,
+ Qverify_visited_file_modtime);
if (!NILP (handler))
return call2 (handler, Qverify_visited_file_modtime, buf);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (filename);
+ handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime);
if (!NILP (handler))
/* The handler can find the file name the same way we did. */
return call2 (handler, Qset_visited_file_modtime, Qnil);
Lisp_Object
auto_save_error ()
{
- unsigned char *name = XSTRING (current_buffer->name)->data;
-
ring_bell ();
- message ("Autosaving...error for %s", name);
+ message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data);
Fsleep_for (make_number (1), Qnil);
- message ("Autosaving...error!for %s", name);
+ message ("Autosaving...error!for %s", XSTRING (current_buffer->name)->data);
Fsleep_for (make_number (1), Qnil);
- message ("Autosaving...error for %s", name);
+ message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data);
Fsleep_for (make_number (1), Qnil);
return Qnil;
}
Qnil, Qlambda);
}
+static Lisp_Object
+do_auto_save_unwind (desc) /* used as unwind-protect function */
+ Lisp_Object desc;
+{
+ close (XINT (desc));
+ return Qnil;
+}
+
DEFUN ("do-auto-save", Fdo_auto_save, Sdo_auto_save, 0, 2, "",
"Auto-save all buffers that need it.\n\
This is all buffers that have auto-saving enabled\n\
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.")
(no_message, current_only)
Lisp_Object tail, buf;
int auto_saved = 0;
char *omessage = echo_area_glyphs;
+ int omessage_length = echo_area_glyphs_length;
extern int minibuf_level;
int do_handled_files;
Lisp_Object oquit;
+ int listdesc;
+ int count = specpdl_ptr - specpdl;
+ int *ptr;
/* Ordinarily don't quit within this function,
but don't make it impossible to quit (in case we get hung in I/O). */
if (minibuf_level)
no_message = Qt;
- /* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
- eventually call do-auto-save, so don't err here in that case. */
if (!NILP (Vrun_hooks))
call1 (Vrun_hooks, intern ("auto-save-hook"));
+ if (STRINGP (Vauto_save_list_file_name))
+ {
+#ifdef MSDOS
+ listdesc = open (XSTRING (Vauto_save_list_file_name)->data,
+ O_WRONLY | O_TRUNC | O_CREAT | O_TEXT,
+ S_IREAD | S_IWRITE);
+#else /* not MSDOS */
+ listdesc = creat (XSTRING (Vauto_save_list_file_name)->data, 0666);
+#endif /* not MSDOS */
+ }
+ else
+ listdesc = -1;
+
+ /* Arrange to close that file whether or not we get an error. */
+ if (listdesc >= 0)
+ record_unwind_protect (do_auto_save_unwind, make_number (listdesc));
+
/* 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
{
buf = XCONS (XCONS (tail)->car)->cdr;
b = XBUFFER (buf);
+
+ /* Record all the buffers that have auto save mode
+ in the special file that lists them. */
+ if (STRINGP (b->auto_save_file_name)
+ && listdesc >= 0 && do_handled_files == 0)
+ {
+ write (listdesc, XSTRING (b->auto_save_file_name)->data,
+ XSTRING (b->auto_save_file_name)->size);
+ write (listdesc, "\n", 1);
+ }
if (!NILP (current_only)
&& b != current_buffer)
continue;
-
+
/* 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
+ if (STRINGP (b->auto_save_file_name)
&& 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))))
+ || NILP (Ffind_file_name_handler (b->auto_save_file_name,
+ Qwrite_region))))
{
+ 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;
+
if ((XFASTINT (b->save_length) * 10
> (BUF_Z (b) - BUF_BEG (b)) * 13)
/* A short file is likely to change a large fraction;
/* It has shrunk too much; turn off auto-saving here. */
message ("Buffer %s has shrunk a lot; auto save turned off there",
XSTRING (b->name)->data);
- /* User can reenable saving with M-x auto-save. */
- b->auto_save_file_name = Qnil;
- /* Prevent warning from repeating if user does so. */
- XFASTINT (b->save_length) = 0;
+ /* Turn off auto-saving until there's a real save,
+ and prevent any more warnings. */
+ XSET (b->save_length, Lisp_Int, -1);
Fsleep_for (make_number (1), Qnil);
continue;
}
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);
}
}
record_auto_save ();
if (auto_saved && NILP (no_message))
- message1 (omessage ? omessage : "Auto-saving...done");
+ {
+ if (omessage)
+ message2 (omessage, omessage_length);
+ else
+ message1 ("Auto-saving...done");
+ }
Vquit_flag = oquit;
auto_saving = 0;
+ unbind_to (count, Qnil);
return Qnil;
}
{
current_buffer->auto_save_modified = MODIFF;
XFASTINT (current_buffer->save_length) = Z - BEG;
+ 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.")
specdir = Ffile_name_directory (string);
val = Ffile_name_completion (name, realdir);
UNGCPRO;
- if (XTYPE (val) != Lisp_String)
+ if (!STRINGP (val))
{
if (changed)
- return string;
+ return double_dollars (string);
return val;
}
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 double_dollars (val);
+#else /* not VMS */
return val;
+#endif /* not VMS */
}
UNGCPRO;
"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\
+ (If DEFAULT is omitted, the visited file name is used,\n\
+ except that if INITIAL is specified, that combined with DIR is used.)\n\
Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
Non-nil and non-t means also require confirmation after completion.\n\
Fifth arg INITIAL specifies text to start with.\n\
if (NILP (dir))
dir = current_buffer->directory;
if (NILP (defalt))
- defalt = current_buffer->filename;
+ {
+ if (! NILP (initial))
+ defalt = Fexpand_file_name (initial, dir);
+ else
+ defalt = current_buffer->filename;
+ }
/* If dir starts with user's homedir, change that to ~. */
homedir = (char *) egetenv ("HOME");
if (homedir != 0
- && XTYPE (dir) == Lisp_String
+ && STRINGP (dir)
&& !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
&& XSTRING (dir)->data[strlen (homedir)] == '/')
{
if (insert_default_directory)
{
insdef = dir;
- insdef1 = dir;
if (!NILP (initial))
{
Lisp_Object args[2], pos;
args[0] = insdef;
args[1] = initial;
insdef = Fconcat (2, args);
- pos = make_number (XSTRING (dir)->size);
- insdef1 = Fcons (insdef, pos);
+ pos = make_number (XSTRING (double_dollars (dir))->size);
+ insdef1 = Fcons (double_dollars (insdef), pos);
}
+ else
+ insdef1 = double_dollars (insdef);
+ }
+ else if (!NILP (initial))
+ {
+ insdef = initial;
+ insdef1 = Fcons (double_dollars (insdef), 0);
}
else
insdef = Qnil, insdef1 = Qnil;
#if 0 /* Old version */
DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0,
- "Read file name, prompting with PROMPT and completing in directory DIR.\n\
-Value is not expanded---you must call `expand-file-name' yourself.\n\
-Default name to DEFAULT if user enters a null string.\n\
- (If DEFAULT is omitted, the visited file name is used.)\n\
-Fourth arg MUSTMATCH non-nil means require existing file's name.\n\
- Non-nil and non-t means also require confirmation after completion.\n\
-Fifth arg INITIAL specifies text to start with.\n\
-DIR defaults to current buffer's directory default.")
+ /* Don't confuse make-docfile by having two doc strings for this function.
+ make-docfile does not pay attention to #if, for good reason! */
+ 0)
(prompt, dir, defalt, mustmatch, initial)
Lisp_Object prompt, dir, defalt, mustmatch, initial;
{
/* If dir starts with user's homedir, change that to ~. */
homedir = (char *) egetenv ("HOME");
if (homedir != 0
- && XTYPE (dir) == Lisp_String
+ && STRINGP (dir)
&& !strncmp (homedir, XSTRING (dir)->data, strlen (homedir))
&& XSTRING (dir)->data[strlen (homedir)] == '/')
{
Qunhandled_file_name_directory = intern ("unhandled-file-name-directory");
Qfile_name_as_directory = intern ("file-name-as-directory");
Qcopy_file = intern ("copy-file");
- Qmake_directory = intern ("make-directory");
+ Qmake_directory_internal = intern ("make-directory-internal");
Qdelete_directory = intern ("delete-directory");
Qdelete_file = intern ("delete-file");
Qrename_file = intern ("rename-file");
staticpro (&Qunhandled_file_name_directory);
staticpro (&Qfile_name_as_directory);
staticpro (&Qcopy_file);
- staticpro (&Qmake_directory);
+ staticpro (&Qmake_directory_internal);
staticpro (&Qdelete_directory);
staticpro (&Qdelete_file);
staticpro (&Qrename_file);
lists are merged destructively.");
Vwrite_region_annotate_functions = Qnil;
+ DEFVAR_LISP ("write-region-annotations-so-far",
+ &Vwrite_region_annotations_so_far,
+ "When an annotation function is called, this holds the previous annotations.\n\
+These are the annotations made by other annotation functions\n\
+that were already called. See also `write-region-annotate-functions'.");
+ Vwrite_region_annotations_so_far = Qnil;
+
+ DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers,
+ "A list of file name handlers that temporarily should not be used.\n\
+This applies only to the operation `inhibit-file-name-operation'.");
+ Vinhibit_file_name_handlers = Qnil;
+
+ DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation,
+ "The operation for which `inhibit-file-name-handlers' is applicable.");
+ Vinhibit_file_name_operation = Qnil;
+
+ DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name,
+ "File name in which we write a list of all auto save file names.");
+ Vauto_save_list_file_name = Qnil;
+
defsubr (&Sfind_file_name_handler);
defsubr (&Sfile_name_directory);
defsubr (&Sfile_name_nondirectory);
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);
HCoop / bpt / emacs.git / blobdiff