/* File name in which we write a list of all our auto save files. */
Lisp_Object Vauto_save_list_file_name;
+/* Prefix used to construct Vauto_save_list_file_name. */
+Lisp_Object Vauto_save_list_file_prefix;
+
+/* When non-nil, it prevents auto-save list file creation. */
+int inhibit_auto_save_session;
+
int disable_auto_save_when_buffer_shrinks;
Lisp_Object Vdirectory_sep_char;
\f
DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /*
-Return the directory component in file name NAME.
-Return nil if NAME does not include a directory.
+Return the directory component in file name FILENAME.
+Return nil if FILENAME does not include a directory.
Otherwise return a directory spec.
Given a Unix syntax file name, returns a string ending in slash.
*/
- (file))
+ (filename))
{
- /* This function can GC. GC checked 1997.04.06. */
+ /* This function can GC. GC checked 2000-07-28 ben */
Bufbyte *beg;
Bufbyte *p;
Lisp_Object handler;
- CHECK_STRING (file);
+ CHECK_STRING (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (file, Qfile_name_directory);
+ handler = Ffind_file_name_handler (filename, Qfile_name_directory);
if (!NILP (handler))
- return call2_check_string_or_nil (handler, Qfile_name_directory, file);
+ return call2_check_string_or_nil (handler, Qfile_name_directory, filename);
#ifdef FILE_SYSTEM_CASE
- file = FILE_SYSTEM_CASE (file);
+ filename = FILE_SYSTEM_CASE (filename);
#endif
- beg = XSTRING_DATA (file);
- p = beg + XSTRING_LENGTH (file);
+ beg = XSTRING_DATA (filename);
+ p = beg + XSTRING_LENGTH (filename);
while (p != beg && !IS_ANY_SEP (p[-1])
#ifdef WIN32_NATIVE
}
DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /*
-Return file name NAME sans its directory.
+Return file name FILENAME sans its directory.
For example, in a Unix-syntax file name,
this is everything after the last slash,
or the entire name if it contains no slash.
*/
- (file))
+ (filename))
{
- /* This function can GC. GC checked 1997.04.06. */
+ /* This function can GC. GC checked 2000-07-28 ben */
Bufbyte *beg, *p, *end;
Lisp_Object handler;
- CHECK_STRING (file);
+ CHECK_STRING (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (file, Qfile_name_nondirectory);
+ handler = Ffind_file_name_handler (filename, Qfile_name_nondirectory);
if (!NILP (handler))
- return call2_check_string (handler, Qfile_name_nondirectory, file);
+ return call2_check_string (handler, Qfile_name_nondirectory, filename);
- beg = XSTRING_DATA (file);
- end = p = beg + XSTRING_LENGTH (file);
+ beg = XSTRING_DATA (filename);
+ end = p = beg + XSTRING_LENGTH (filename);
while (p != beg && !IS_ANY_SEP (p[-1])
#ifdef WIN32_NATIVE
The `call-process' and `start-process' functions use this function to
get a current directory to run processes in.
*/
- (filename))
+ (filename))
{
- /* This function can GC. GC checked 1997.04.06. */
+ /* This function can GC. GC checked 2000-07-28 ben */
Lisp_Object handler;
/* If the file name has special constructs in it,
static char *
file_name_as_directory (char *out, char *in)
{
+ /* This function cannot GC */
int size = strlen (in);
if (size == 0)
For a Unix-syntax file name, just appends a slash,
except for (file-name-as-directory \"\") => \"./\".
*/
- (file))
+ (filename))
{
- /* This function can GC. GC checked 1997.04.06. */
+ /* This function can GC. GC checked 2000-07-28 ben */
char *buf;
Lisp_Object handler;
- CHECK_STRING (file);
+ CHECK_STRING (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (file, Qfile_name_as_directory);
+ handler = Ffind_file_name_handler (filename, Qfile_name_as_directory);
if (!NILP (handler))
- return call2_check_string (handler, Qfile_name_as_directory, file);
+ return call2_check_string (handler, Qfile_name_as_directory, filename);
- buf = (char *) alloca (XSTRING_LENGTH (file) + 10);
+ buf = (char *) alloca (XSTRING_LENGTH (filename) + 10);
return build_string (file_name_as_directory
- (buf, (char *) XSTRING_DATA (file)));
+ (buf, (char *) XSTRING_DATA (filename)));
}
\f
/*
static int
directory_file_name (const char *src, char *dst)
{
+ /* This function cannot GC */
long slen = strlen (src);
/* Process as Unix format: just remove any final slash.
But leave "/" unchanged; do not change it to "". */
}
DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /*
-Return the file name of the directory named DIR.
-This is the name of the file that holds the data for the directory DIR.
+Return the file name of the directory named DIRECTORY.
+This is the name of the file that holds the data for the directory.
This operation exists because a directory is also a file, but its name as
a directory is different from its name as a file.
In Unix-syntax, this function just removes the final slash.
*/
(directory))
{
- /* This function can GC. GC checked 1997.04.06. */
+ /* This function can GC. GC checked 2000-07-28 ben */
char *buf;
Lisp_Object handler;
QUIT;
- if (stat ((const char *) data, &ignored) < 0)
+ if (xemacs_stat ((const char *) data, &ignored) < 0)
{
/* We want to return only if errno is ENOENT. */
if (errno == ENOENT)
Convert filename NAME to absolute, and canonicalize it.
Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative
(does not start with slash); if DEFAULT-DIRECTORY is nil or missing,
-the current buffer's value of default-directory is used.
+the current buffer's value of `default-directory' is used.
File name components that are `.' are removed, and
so are file name components followed by `..', along with the `..' itself;
note that these simplifications are done without checking the resulting
*/
(name, default_directory))
{
- /* This function can GC */
+ /* This function can GC. GC-checked 2000-11-18 */
Bufbyte *nm;
Bufbyte *newdir, *p, *o;
struct passwd *pw;
#endif /* WIN32_NATIVE */
int length;
- Lisp_Object handler;
+ Lisp_Object handler = Qnil;
#ifdef CYGWIN
char *user;
#endif
+ struct gcpro gcpro1, gcpro2, gcpro3;
+
+ /* both of these get set below */
+ GCPRO3 (name, default_directory, handler);
CHECK_STRING (name);
call the corresponding file handler. */
handler = Ffind_file_name_handler (name, Qexpand_file_name);
if (!NILP (handler))
- return call3_check_string (handler, Qexpand_file_name, name,
- default_directory);
+ RETURN_UNGCPRO (call3_check_string (handler, Qexpand_file_name,
+ name, default_directory));
/* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */
if (NILP (default_directory))
{
handler = Ffind_file_name_handler (default_directory, Qexpand_file_name);
if (!NILP (handler))
- return call3 (handler, Qexpand_file_name, name, default_directory);
+ RETURN_UNGCPRO (call3 (handler, Qexpand_file_name,
+ name, default_directory));
}
o = XSTRING_DATA (default_directory);
&& ! (IS_DIRECTORY_SEP (o[0]))
#endif /* not WIN32_NATIVE */
)
- {
- struct gcpro gcpro1;
- GCPRO1 (name);
- default_directory = Fexpand_file_name (default_directory, Qnil);
- UNGCPRO;
- }
+ default_directory = Fexpand_file_name (default_directory, Qnil);
#ifdef FILE_SYSTEM_CASE
name = FILE_SYSTEM_CASE (name);
XSTRING_DATA (name)[0] = DRIVE_LETTER (drive);
XSTRING_DATA (name)[1] = ':';
}
- return name;
+ RETURN_UNGCPRO (name);
#else /* not WIN32_NATIVE */
if (nm == XSTRING_DATA (name))
- return name;
- return build_string ((char *) nm);
+ RETURN_UNGCPRO (name);
+ RETURN_UNGCPRO (build_string ((char *) nm));
#endif /* not WIN32_NATIVE */
}
}
CORRECT_DIR_SEPS (target);
#endif /* WIN32_NATIVE */
- return make_string (target, o - target);
+ RETURN_UNGCPRO (make_string (target, o - target));
}
DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /*
-Return the canonical name of the given FILE.
-Second arg DEFAULT is directory to start with if FILE is relative
+Return the canonical name of FILENAME.
+Second arg DEFAULT is directory to start with if FILENAME is relative
(does not start with slash); if DEFAULT is nil or missing,
- the current buffer's value of default-directory is used.
+ the current buffer's value of `default-directory' is used.
No component of the resulting pathname will be a symbolic link, as
in the realpath() function.
*/
(filename, default_))
{
- /* This function can GC. */
+ /* This function can GC. GC checked 2000-07-28 ben. */
Lisp_Object expanded_name;
struct gcpro gcpro1;
expanded_name = Fexpand_file_name (filename, default_);
- GCPRO1 (expanded_name);
-
if (!STRINGP (expanded_name))
return Qnil;
+ GCPRO1 (expanded_name);
+
{
Lisp_Object handler =
Ffind_file_name_handler (expanded_name, Qfile_truename);
we just use our own version in realpath.c. */
for (;;)
{
- p = (Extbyte *) memchr (p + 1, '/', elen - (p + 1 - path));
- if (p)
- *p = 0;
+ Extbyte *pos;
+
+#ifdef WIN32_NATIVE
+ if (IS_DRIVE (p[0]) && IS_DEVICE_SEP (p[1])
+ && IS_DIRECTORY_SEP (p[2]))
+ /* don't test c: on windows */
+ p = p+2;
+ else if (IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1]))
+ /* start after // */
+ p = p+1;
+#endif
+ for (pos = p + 1; pos < path + elen; pos++)
+ if (IS_DIRECTORY_SEP (*pos))
+ {
+ *(p = pos) = 0;
+ break;
+ }
+ if (p != pos)
+ p = 0;
if (xrealpath ((char *) path, resolved_path))
{
if (p)
- *p = '/';
+ *p = DIRECTORY_SEP;
else
break;
{
int plen = elen - (p - path);
- if (rlen > 1 && resolved_path[rlen - 1] == '/')
+ if (rlen > 1 && IS_DIRECTORY_SEP (resolved_path[rlen - 1]))
rlen = rlen - 1;
if (plen + rlen + 1 > countof (resolved_path))
goto toolong;
- resolved_path[rlen] = '/';
+ resolved_path[rlen] = DIRECTORY_SEP;
memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1);
}
break;
{
Lisp_Object resolved_name;
int rlen = strlen (resolved_path);
- if (elen > 0 && XSTRING_BYTE (expanded_name, elen - 1) == '/'
- && !(rlen > 0 && resolved_path[rlen - 1] == '/'))
+ if (elen > 0 && IS_DIRECTORY_SEP (XSTRING_BYTE (expanded_name, elen - 1))
+ && !(rlen > 0 && IS_DIRECTORY_SEP (resolved_path[rlen - 1])))
{
if (rlen + 1 > countof (resolved_path))
goto toolong;
- resolved_path[rlen++] = '/';
+ resolved_path[rlen++] = DIRECTORY_SEP;
resolved_path[rlen] = '\0';
}
TO_INTERNAL_FORMAT (DATA, (resolved_path, rlen),
Substitute environment variables referred to in FILENAME.
`$FOO' where FOO is an environment variable name means to substitute
the value of that variable. The variable name should be terminated
-with a character not a letter, digit or underscore; otherwise, enclose
+with a character, not a letter, digit or underscore; otherwise, enclose
the entire variable name in braces.
If `/~' appears, all of FILENAME through that `/' is discarded.
-
*/
- (string))
+ (filename))
{
- /* This function can GC. GC checked 1997.04.06. */
+ /* This function can GC. GC checked 2000-07-28 ben. */
Bufbyte *nm;
Bufbyte *s, *p, *o, *x, *endp;
Bufbyte *xnm;
Lisp_Object handler;
- CHECK_STRING (string);
+ CHECK_STRING (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (string, Qsubstitute_in_file_name);
+ handler = Ffind_file_name_handler (filename, Qsubstitute_in_file_name);
if (!NILP (handler))
return call2_check_string_or_nil (handler, Qsubstitute_in_file_name,
- string);
+ filename);
- nm = XSTRING_DATA (string);
- endp = nm + XSTRING_LENGTH (string);
+ nm = XSTRING_DATA (filename);
+ endp = nm + XSTRING_LENGTH (filename);
/* If /~ or // appears, discard everything through first slash. */
}
if (!substituted)
- return string;
+ return filename;
- /* If substitution required, recopy the string and do it */
+ /* If substitution required, recopy the filename and do it */
/* Make space in stack frame for the new copy */
- xnm = (Bufbyte *) alloca (XSTRING_LENGTH (string) + total + 1);
+ xnm = (Bufbyte *) alloca (XSTRING_LENGTH (filename) + total + 1);
x = xnm;
/* Copy the rest of the name through, replacing $ constructs with values */
return make_string (xnm, x - xnm);
badsubst:
- error ("Bad format environment-variable substitution");
+ syntax_error ("Bad format environment-variable substitution", filename);
missingclose:
- error ("Missing \"}\" in environment-variable substitution");
+ syntax_error ("Missing \"}\" in environment-variable substitution",
+ filename);
badvar:
- error ("Substituting nonexistent environment variable \"%s\"",
- target);
+ syntax_error_2 ("Substituting nonexistent environment variable",
+ filename, build_string ((char *) target));
/* NOTREACHED */
return Qnil; /* suppress compiler warning */
Lisp_Object
expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
{
- /* This function can call lisp */
+ /* This function can call Lisp. GC checked 2000-07-28 ben */
Lisp_Object abspath;
struct gcpro gcpro1;
barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring,
int interactive, struct stat *statptr)
{
- /* This function can GC. GC checked 1997.04.06. */
+ /* This function can call Lisp. GC checked 2000-07-28 ben */
struct stat statbuf;
/* stat is a good way to tell whether the file exists,
regardless of what access permissions it has. */
- if (stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
+ if (xemacs_stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0)
{
Lisp_Object tem;
DEFUN ("copy-file", Fcopy_file, 2, 4,
"fCopy file: \nFCopy %s to file: \np\nP", /*
-Copy FILE to NEWNAME. Both args must be strings.
+Copy FILENAME to NEWNAME. Both args must be strings.
Signals a `file-already-exists' error if file NEWNAME already exists,
unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil.
A number as third arg means request confirmation if NEWNAME already exists.
*/
(filename, newname, ok_if_already_exists, keep_time))
{
- /* This function can GC. GC checked 1997.04.06. */
+ /* This function can call Lisp. GC checked 2000-07-28 ben */
int ifd, ofd, n;
char buf[16 * 1024];
struct stat st, out_st;
args[1] = Qnil; args[2] = Qnil;
NGCPRO1 (*args);
ngcpro1.nvars = 3;
- if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/')
- args[i++] = build_string ("/");
+ if (!IS_DIRECTORY_SEP (XSTRING_BYTE (newname,
+ XSTRING_LENGTH (newname) - 1)))
+
+ args[i++] = Fchar_to_string (Vdirectory_sep_char);
args[i++] = Ffile_name_nondirectory (filename);
newname = Fconcat (i, args);
NUNGCPRO;
|| INTP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, "copy to it",
INTP (ok_if_already_exists), &out_st);
- else if (stat ((const char *) XSTRING_DATA (newname), &out_st) < 0)
+ else if (xemacs_stat ((const char *) XSTRING_DATA (newname), &out_st) < 0)
out_st.st_mode = 0;
ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0);
report_file_error ("I/O error", list1 (newname));
if (input_file_statable_p)
- {
- if (!NILP (keep_time))
{
- EMACS_TIME atime, mtime;
- EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
- EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
- if (set_file_times ((char *) XSTRING_DATA (newname), atime,
- mtime))
- report_file_error ("I/O error", list1 (newname));
+ if (!NILP (keep_time))
+ {
+ EMACS_TIME atime, mtime;
+ EMACS_SET_SECS_USECS (atime, st.st_atime, 0);
+ EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0);
+ if (set_file_times ((char *) XSTRING_DATA (newname), atime,
+ mtime))
+ report_file_error ("I/O error", list1 (newname));
+ }
+ chmod ((const char *) XSTRING_DATA (newname),
+ st.st_mode & 07777);
}
- chmod ((const char *) XSTRING_DATA (newname),
- st.st_mode & 07777);
- }
/* We'll close it by hand */
XCAR (ofd_locative) = Qnil;
\f
DEFUN ("rename-file", Frename_file, 2, 3,
"fRename file: \nFRename %s to file: \np", /*
-Rename FILE as NEWNAME. Both args strings.
-If file has names other than FILE, it continues to have those names.
+Rename FILENAME as NEWNAME. Both args must be strings.
+If file has names other than FILENAME, it continues to have those names.
Signals a `file-already-exists' error if a file NEWNAME already exists
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
A number as third arg means request confirmation if NEWNAME already exists.
DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3,
"fAdd name to file: \nFName to add to %s: \np", /*
-Give FILE additional name NEWNAME. Both args strings.
+Give FILENAME additional name NEWNAME. Both args must be strings.
Signals a `file-already-exists' error if a file NEWNAME already exists
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
A number as third arg means request confirmation if NEWNAME already exists.
/* netunam, being a strange-o system call only used once, is not
encapsulated. */
- TO_EXTERNAL_FORMAT (LISP_STRING, path, C_STRING_ALLOCA, path_ext, Qfile_name);
- TO_EXTERNAL_FORMAT (LISP_STRING, login, C_STRING_ALLOCA, login_ext, Qnative);
+ LISP_STRING_TO_EXTERNAL (path, path_ext, Qfile_name);
+ LISP_STRING_TO_EXTERNAL (login, login_ext, Qnative);
netresult = netunam (path_ext, login_ext);
{
#ifdef WIN32_NATIVE
struct stat st;
- if (stat (filename, &st) < 0)
+ if (xemacs_stat (filename, &st) < 0)
return 0;
return ((st.st_mode & S_IEXEC) != 0);
#else /* not WIN32_NATIVE */
#ifdef HAVE_EACCESS
- return eaccess (filename, 1) >= 0;
+ return eaccess (filename, X_OK) >= 0;
#else
/* Access isn't quite right because it uses the real uid
and we really want to test with the effective uid.
But Unix doesn't give us a right way to do it. */
- return access (filename, 1) >= 0;
+ return access (filename, X_OK) >= 0;
#endif /* HAVE_EACCESS */
#endif /* not WIN32_NATIVE */
}
check_writable (const char *filename)
{
#ifdef HAVE_EACCESS
- return (eaccess (filename, 2) >= 0);
+ return (eaccess (filename, W_OK) >= 0);
#else
/* Access isn't quite right because it uses the real uid
and we really want to test with the effective uid.
But Unix doesn't give us a right way to do it.
Opening with O_WRONLY could work for an ordinary file,
but would lose for directories. */
- return (access (filename, 2) >= 0);
+ return (access (filename, W_OK) >= 0);
#endif
}
*/
(filename))
{
- /* This function can call lisp */
+ /* This function can call lisp; GC checked 2000-07-11 ben */
Lisp_Object abspath;
Lisp_Object handler;
struct stat statbuf;
if (!NILP (handler))
return call2 (handler, Qfile_exists_p, abspath);
- return stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
+ return xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil;
}
DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /*
(filename))
{
- /* This function can GC. GC checked 1997.04.10. */
+ /* This function can GC. GC checked 07-11-2000 ben. */
Lisp_Object abspath;
Lisp_Object handler;
struct gcpro gcpro1;
if (!NILP (handler))
return call2 (handler, Qfile_writable_p, abspath);
- if (stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
+ if (xemacs_stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0)
return (check_writable ((char *) XSTRING_DATA (abspath))
? Qt : Qnil);
if (!NILP (handler))
return call2 (handler, Qfile_directory_p, abspath);
- if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
+ if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil;
}
if (!NILP (handler))
return call2 (handler, Qfile_regular_p, abspath);
- if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
+ if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
return Qnil;
return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil;
}
\f
DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /*
-Return mode bits of FILE, as an integer.
+Return mode bits of file named FILENAME, as an integer.
*/
(filename))
{
if (!NILP (handler))
return call2 (handler, Qfile_modes, abspath);
- if (stat ((char *) XSTRING_DATA (abspath), &st) < 0)
+ if (xemacs_stat ((char *) XSTRING_DATA (abspath), &st) < 0)
return Qnil;
/* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */
#if 0
}
DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /*
-Set mode bits of FILE to MODE (an integer).
+Set mode bits of file named FILENAME to MODE (an integer).
Only the 12 low bits of MODE are used.
*/
(filename, mode))
DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /*
Set the file permission bits for newly created files.
-MASK should be an integer; if a permission's bit in MASK is 1,
-subsequently created files will not have that permission enabled.
-Only the low 9 bits are used.
+The argument MODE should be an integer; if a bit in MODE is 1,
+subsequently created files will not have the permission corresponding
+to that bit enabled. Only the low 9 bits are used.
This setting is inherited by subprocesses.
*/
(mode))
return call3 (handler, Qfile_newer_than_file_p, abspath1,
abspath2);
- if (stat ((char *) XSTRING_DATA (abspath1), &st) < 0)
+ if (xemacs_stat ((char *) XSTRING_DATA (abspath1), &st) < 0)
return Qnil;
mtime1 = st.st_mtime;
- if (stat ((char *) XSTRING_DATA (abspath2), &st) < 0)
+ if (xemacs_stat ((char *) XSTRING_DATA (abspath2), &st) < 0)
return Qt;
return (mtime1 > st.st_mtime) ? Qt : Qnil;
decoding is stored into it. It will in general be different from CODESYS
if CODESYS specifies automatic encoding detection or end-of-line detection.
-Currently BEG and END refer to byte positions (as opposed to character
+Currently START and END refer to byte positions (as opposed to character
positions), even in Mule. (Fixing this is very difficult.)
*/
- (filename, visit, beg, end, replace, codesys, used_codesys))
+ (filename, visit, start, end, replace, codesys, used_codesys))
{
/* This function can call lisp */
- /* #### dmoore - this function hasn't been checked for gc recently */
struct stat st;
int fd;
int saverrno = 0;
if (!NILP (handler))
{
val = call6 (handler, Qinsert_file_contents, filename,
- visit, beg, end, replace);
+ visit, start, end, replace);
goto handled;
}
CHECK_SYMBOL (used_codesys);
#endif
- if ( (!NILP (beg) || !NILP (end)) && !NILP (visit) )
+ if ( (!NILP (start) || !NILP (end)) && !NILP (visit) )
error ("Attempt to visit less than an entire file");
fd = -1;
- if (stat ((char *) XSTRING_DATA (filename), &st) < 0)
+ if (xemacs_stat ((char *) XSTRING_DATA (filename), &st) < 0)
{
if (fd >= 0) close (fd);
badopen:
#ifdef S_IFREG
/* Signal an error if we are accessing a non-regular file, with
- REPLACE, BEG or END being non-nil. */
+ REPLACE, START or END being non-nil. */
if (!S_ISREG (st.st_mode))
{
not_regular = 1;
if (!NILP (visit))
goto notfound;
- if (!NILP (replace) || !NILP (beg) || !NILP (end))
+ if (!NILP (replace) || !NILP (start) || !NILP (end))
{
end_multiple_change (buf, mc_count);
- return Fsignal (Qfile_error,
- list2 (build_translated_string("not a regular file"),
- filename));
+ RETURN_UNGCPRO
+ (Fsignal (Qfile_error,
+ list2 (build_translated_string("not a regular file"),
+ filename)));
}
}
#endif /* S_IFREG */
- if (!NILP (beg))
- CHECK_INT (beg);
+ if (!NILP (start))
+ CHECK_INT (start);
else
- beg = Qzero;
+ start = Qzero;
if (!NILP (end))
CHECK_INT (end);
same_at_end += overlap;
/* Arrange to read only the nonmatching middle part of the file. */
- beg = make_int (same_at_start - BUF_BEGV (buf));
+ start = make_int (same_at_start - BUF_BEGV (buf));
end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end));
buffer_delete_range (buf, same_at_start, same_at_end,
if (!not_regular)
{
- total = XINT (end) - XINT (beg);
+ total = XINT (end) - XINT (start);
/* Make sure point-max won't overflow after this insertion. */
if (total != XINT (make_int (total)))
will make the stream functions read as much as possible. */
total = -1;
- if (XINT (beg) != 0
+ if (XINT (start) != 0
#ifdef FSFMACS_SPEEDY_INSERT
/* why was this here? asked jwz. The reason is that the replace-mode
connivings above will normally put the file pointer other than
#endif /* !FSFMACS_SPEEDY_INSERT */
)
{
- if (lseek (fd, XINT (beg), 0) < 0)
+ if (lseek (fd, XINT (start), 0) < 0)
report_file_error ("Setting file position", list1 (filename));
}
it could be called here. But that's just silly.
There's no reason C code can't call out to Lisp
code, and it's a lot cleaner this way. */
+ /* Note: compute-buffer-file-truename is called for
+ side-effect! Its return value is intentionally
+ ignored. */
if (!NILP (Ffboundp (Qcompute_buffer_file_truename)))
call1 (Qcompute_buffer_file_truename, make_buffer (buf));
}
*/
(start, end, filename, append, visit, lockname, codesys))
{
- /* This function can call lisp */
+ /* This function can call lisp. GC checked 2000-07-28 ben */
int desc;
int failure;
int save_errno = 0;
struct stat st;
- Lisp_Object fn;
+ Lisp_Object fn = Qnil;
int speccount = specpdl_depth ();
int visiting_other = STRINGP (visit);
int visiting = (EQ (visit, Qt) || visiting_other);
Lisp_Object annotations = Qnil;
struct buffer *given_buffer;
Bufpos start1, end1;
+ struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+ struct gcpro ngcpro1, ngcpro2;
+ Lisp_Object curbuf;
+
+ XSETBUFFER (curbuf, current_buffer);
+
+ /* start, end, visit, and append are never modified in this fun
+ so we don't protect them. */
+ GCPRO5 (visit_file, filename, codesys, lockname, annotations);
+ NGCPRO2 (curbuf, fn);
- /* #### dmoore - if Fexpand_file_name or handlers kill the buffer,
+ /* [[ dmoore - if Fexpand_file_name or handlers kill the buffer,
we should signal an error rather than blissfully continuing
along. ARGH, this function is going to lose lose lose. We need
to protect the current_buffer from being destroyed, but the
- multiple return points make this a pain in the butt. */
+ multiple return points make this a pain in the butt. ]] we do
+ protect curbuf now. --ben */
#ifdef FILE_CODING
codesys = Fget_coding_system (codesys);
#endif /* FILE_CODING */
if (current_buffer->base_buffer && ! NILP (visit))
- error ("Cannot do file visiting in an indirect buffer");
+ invalid_operation ("Cannot do file visiting in an indirect buffer",
+ curbuf);
if (!NILP (start) && !STRINGP (start))
get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0);
{
Lisp_Object handler;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-
- GCPRO5 (start, filename, visit, visit_file, lockname);
if (visiting_other)
visit_file = Fexpand_file_name (visit, Qnil);
visit_file = filename;
filename = Fexpand_file_name (filename, Qnil);
- UNGCPRO;
-
if (NILP (lockname))
lockname = visit_file;
+ /* We used to UNGCPRO here. BAD! visit_file is used below after
+ more Lisp calling. */
/* If the file name has special constructs in it,
call the corresponding file handler. */
handler = Ffind_file_name_handler (filename, Qwrite_region);
current_buffer->filename = visit_file;
MARK_MODELINE_CHANGED;
}
+ NUNGCPRO;
+ UNGCPRO;
return val;
}
}
#ifdef CLASH_DETECTION
if (!auto_saving)
- {
- Lisp_Object curbuf;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
-
- XSETBUFFER (curbuf, current_buffer);
- GCPRO5 (start, filename, visit_file, lockname, curbuf);
- lock_file (lockname);
- UNGCPRO;
- }
+ lock_file (lockname);
#endif /* CLASH_DETECTION */
/* Special kludge to simplify auto-saving. */
{
Lisp_Object desc_locative = Fcons (make_int (desc), Qnil);
Lisp_Object instream = Qnil, outstream = Qnil;
- struct gcpro gcpro1, gcpro2;
+ struct gcpro nngcpro1, nngcpro2;
/* need to gcpro; QUIT could happen out of call to write() */
- GCPRO2 (instream, outstream);
+ NNGCPRO2 (instream, outstream);
record_unwind_protect (close_file_unwind, desc_locative);
save_errno = errno;
}
Lstream_close (XLSTREAM (instream));
- UNGCPRO;
#ifdef HAVE_FSYNC
/* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
systems where close() can change the modtime. This is known to
happen on various NFS file systems, on Windows, and on Linux.
Rather than handling this on a per-system basis, we
- unconditionally do the stat() after the close(). */
+ unconditionally do the xemacs_stat() after the close(). */
/* NFS can report a write failure now. */
if (close (desc) < 0)
as necessary). */
XCAR (desc_locative) = Qnil;
unbind_to (speccount, Qnil);
+
+ NNUNGCPRO;
}
- stat ((char *) XSTRING_DATA (fn), &st);
+ xemacs_stat ((char *) XSTRING_DATA (fn), &st);
#ifdef CLASH_DETECTION
if (!auto_saving)
current_buffer->modtime = st.st_mtime;
if (failure)
- error ("IO error writing %s: %s",
- XSTRING_DATA (fn),
- strerror (save_errno));
+ {
+ errno = save_errno;
+ report_file_error ("Writing file", list1 (fn));
+ }
if (visiting)
{
}
else if (quietly)
{
+ NUNGCPRO;
+ UNGCPRO;
return Qnil;
}
message ("Wrote %s", XSTRING_DATA (visit_file));
else
{
- struct gcpro gcpro1;
- Lisp_Object fsp;
- GCPRO1 (fn);
+ Lisp_Object fsp = Qnil;
+ struct gcpro nngcpro1;
+ NNGCPRO1 (fsp);
fsp = Ffile_symlink_p (fn);
if (NILP (fsp))
message ("Wrote %s", XSTRING_DATA (fn));
else
message ("Wrote %s (symlink to %s)",
XSTRING_DATA (fn), XSTRING_DATA (fsp));
- UNGCPRO;
+ NNUNGCPRO;
}
}
+ NUNGCPRO;
+ UNGCPRO;
return Qnil;
}
\f
DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /*
-Return t if last mod time of BUF's visited file matches what BUF records.
+Return t if last mod time of BUFFER's visited file matches what BUFFER records.
This means that the file has not been changed since it was visited or saved.
*/
- (buf))
+ (buffer))
{
- /* This function can call lisp */
+ /* This function can call lisp; GC checked 2000-07-11 ben */
struct buffer *b;
struct stat st;
Lisp_Object handler;
- CHECK_BUFFER (buf);
- b = XBUFFER (buf);
+ CHECK_BUFFER (buffer);
+ b = XBUFFER (buffer);
if (!STRINGP (b->filename)) return Qt;
if (b->modtime == 0) return Qt;
handler = Ffind_file_name_handler (b->filename,
Qverify_visited_file_modtime);
if (!NILP (handler))
- return call2 (handler, Qverify_visited_file_modtime, buf);
+ return call2 (handler, Qverify_visited_file_modtime, buffer);
- if (stat ((char *) XSTRING_DATA (b->filename), &st) < 0)
+ if (xemacs_stat ((char *) XSTRING_DATA (b->filename), &st) < 0)
{
/* If the file doesn't exist now and didn't exist before,
we say that it isn't modified, provided the error is a tame one. */
}
else
{
- Lisp_Object filename;
+ Lisp_Object filename = Qnil;
struct stat st;
Lisp_Object handler;
struct gcpro gcpro1, gcpro2, gcpro3;
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 ((char *) XSTRING_DATA (filename), &st) >= 0)
+ else if (xemacs_stat ((char *) XSTRING_DATA (filename), &st) >= 0)
current_buffer->modtime = st.st_mtime;
}
/* Get visited file's mode to become the auto save file's mode. */
if (STRINGP (fn) &&
- stat ((char *) XSTRING_DATA (fn), &st) >= 0)
+ xemacs_stat ((char *) XSTRING_DATA (fn), &st) >= 0)
/* But make sure we can overwrite it later! */
auto_save_mode_bits = st.st_mode | 0600;
else
/* Open the auto-save list file, if necessary.
We only do this now so that the file only exists
if we actually auto-saved any files. */
- if (!auto_saved && STRINGP (listfile) && listdesc < 0)
+ if (!auto_saved && !inhibit_auto_save_session
+ && !NILP (Vauto_save_list_file_prefix)
+ && STRINGP (listfile) && listdesc < 0)
{
listdesc = open ((char *) XSTRING_DATA (listfile),
O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY,
defsymbol (&Qformat_annotate_function, "format-annotate-function");
defsymbol (&Qcompute_buffer_file_truename, "compute-buffer-file-truename");
- deferror (&Qfile_error, "file-error", "File error", Qio_error);
- deferror (&Qfile_already_exists, "file-already-exists",
- "File already exists", Qfile_error);
+ DEFERROR_STANDARD (Qfile_error, Qio_error);
+ DEFERROR_STANDARD (Qfile_already_exists, Qfile_error);
DEFSUBR (Ffind_file_name_handler);
*/ );
Vauto_save_list_file_name = Qnil;
+ DEFVAR_LISP ("auto-save-list-file-prefix", &Vauto_save_list_file_prefix /*
+Prefix for generating auto-save-list-file-name.
+Emacs's pid and the system name will be appended to
+this prefix to create a unique file name.
+*/ );
+ Vauto_save_list_file_prefix = build_string ("~/.saves-");
+
+ DEFVAR_BOOL ("inhibit-auto-save-session", &inhibit_auto_save_session /*
+When non-nil, inhibit auto save list file creation.
+*/ );
+ inhibit_auto_save_session = 0;
+
DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks",
&disable_auto_save_when_buffer_shrinks /*
If non-nil, auto-saving is disabled when a buffer shrinks too much.