/* File IO for GNU Emacs.
- Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993 Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <sys/time.h>
#endif
+#ifndef USG
+#ifndef VMS
+#ifndef BSD4_1
+#define HAVE_FSYNC
+#endif
+#endif
+#endif
+
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
int tlen;
unsigned char *target;
struct passwd *pw;
- int lose;
#ifdef VMS
unsigned char * colon = 0;
unsigned char * close = 0;
if (!NILP (handler))
return call3 (handler, Qexpand_file_name, name, defalt);
+ /* Use the buffer's default-directory if DEFALT is omitted. */
+ if (NILP (defalt))
+ defalt = current_buffer->directory;
+ CHECK_STRING (defalt, 1);
+
+ /* Make sure DEFALT is properly expanded.
+ It would be better to do this down below where we actually use
+ defalt. Unfortunately, calling Fexpand_file_name recursively
+ could invoke GC, and the strings might be relocated. This would
+ be annoying because we have pointers into strings lying around
+ that would need adjusting, and people would add new pointers to
+ the code and forget to adjust them, resulting in intermittent bugs.
+ Putting this call here avoids all that crud.
+
+ The EQ test avoids infinite recursion. */
+ if (! NILP (defalt) && !EQ (defalt, name)
+ /* This saves time in a common case. */
+ && XSTRING (defalt)->data[0] != '/')
+ {
+ struct gcpro gcpro1;
+
+ GCPRO1 (name);
+ defalt = Fexpand_file_name (defalt, Qnil);
+ UNGCPRO;
+ }
+
#ifdef VMS
/* Filenames on VMS are always upper case. */
name = Fupcase (name);
#endif /* VMS */
)
{
+ /* If it turns out that the filename we want to return is just a
+ suffix of FILENAME, we don't need to go through and edit
+ things; we just need to construct a new string using data
+ starting at the middle of FILENAME. If we set lose to a
+ non-zero value, that means we've discovered that we can't do
+ that cool trick. */
+ int lose = 0;
+
p = nm;
- lose = 0;
while (*p)
{
/* Since we know the path is absolute, we can assume that each
#endif /* not VMS */
&& !newdir)
{
- if (NILP (defalt))
- defalt = current_buffer->directory;
- CHECK_STRING (defalt, 1);
newdir = XSTRING (defalt)->data;
}
{
/* Get rid of any slash at the end of newdir. */
int length = strlen (newdir);
+ /* Adding `length > 1 &&' makes ~ expand into / when homedir
+ is the root dir. People disagree about whether that is right.
+ Anyway, we can't take the risk of this change now. */
if (newdir[length - 1] == '/')
{
unsigned char *temp = (unsigned char *) alloca (length);
/* If we didn't complain already, silently delete existing file. */
if (errno == EEXIST)
{
- unlink (XSTRING (filename)->data);
+ unlink (XSTRING (linkname)->data);
if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data))
return Qnil;
}
DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0,
"Return t if FILENAME can be executed by you.\n\
-For directories this means you can change to that directory.")
+For a directory, this means you can access files in that directory.")
(filename)
Lisp_Object filename;
valsize = readlink (XSTRING (filename)->data, buf, bufsize);
if (valsize < bufsize) break;
/* Buffer was not long enough */
- free (buf);
+ xfree (buf);
bufsize *= 2;
}
if (valsize == -1)
{
- free (buf);
+ xfree (buf);
return Qnil;
}
val = make_string (buf, valsize);
- free (buf);
+ xfree (buf);
return val;
#else /* not S_IFLNK */
return Qnil;
#endif /* not S_IFLNK */
}
+#ifdef SOLARIS_BROKEN_ACCESS
+/* In Solaris 2.1, the readonly-ness of the filesystem is not
+ considered by the access system call. This is Sun's bug, but we
+ still have to make Emacs work. */
+
+#include <sys/statvfs.h>
+
+static int
+ro_fsys (path)
+ char *path;
+{
+ struct statvfs statvfsb;
+
+ if (statvfs(path, &statvfsb))
+ return 1; /* error from statvfs, be conservative and say not wrtable */
+ else
+ /* Otherwise, fsys is ro if bit is set. */
+ return statvfsb.f_flag & ST_RDONLY;
+}
+#else
+/* But on every other os, access has already done the right thing. */
+#define ro_fsys(path) 0
+#endif
+
/* Having this before file-symlink-p mysteriously caused it to be forgotten
on the RT/PC. */
DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0,
return call2 (handler, Qfile_writable_p, abspath);
if (access (XSTRING (abspath)->data, 0) >= 0)
- return (access (XSTRING (abspath)->data, 2) >= 0) ? Qt : Qnil;
+ return ((access (XSTRING (abspath)->data, 2) >= 0
+ && ! ro_fsys (XSTRING (abspath)))
+ ? Qt : Qnil);
dir = Ffile_name_directory (abspath);
#ifdef VMS
if (!NILP (dir))
dir = Fdirectory_file_name (dir);
#endif /* VMS */
- return (access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0
+ return ((access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0
+ && ! ro_fsys ((char *) XSTRING (dir)))
? Qt : Qnil);
}
return Qnil;
}
-DEFUN ("set-default-file-mode", Fset_default_file_mode, Sset_default_file_mode, 1, 1, 0,
+DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
"Set the file permission bits for newly created files.\n\
The argument MODE should be an integer; only the low 9 bits are used.\n\
This setting is inherited by subprocesses.")
return Qnil;
}
-DEFUN ("default-file-mode", Fdefault_file_mode, Sdefault_file_mode, 0, 0, 0,
+DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0,
"Return the default file protection for created files.\n\
The value is an integer.")
()
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;
+ Lisp_Object visit_file;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
/* Special kludge to simplify auto-saving */
else if (XTYPE (start) != Lisp_String)
validate_region (&start, &end);
- GCPRO4 (start, filename, visit, visit_file);
filename = Fexpand_file_name (filename, Qnil);
+ if (XTYPE (visit) == Lisp_String)
+ visit_file = Fexpand_file_name (visit, Qnil);
+ else
+ visit_file = filename;
+
+ GCPRO4 (start, filename, visit, visit_file);
/* If the file name has special constructs in it,
call the corresponding file handler. */
immediate_quit = 0;
-#ifndef USG
-#ifndef VMS
-#ifndef BSD4_1
+#ifdef HAVE_FSYNC
/* Note fsync appears to change the modtime on BSD4.2 (both vax and sun).
Disk full in NFS may be reported here. */
if (fsync (desc) < 0)
failure = 1, save_errno = errno;
-#endif
-#endif
#endif
/* Spurious "file has changed on disk" warnings have been
return Qnil;
}
+DEFUN ("visited-file-modtime", Fvisited_file_modtime,
+ Svisited_file_modtime, 0, 0, 0,
+ "Return the current buffer's recorded visited file modification time.\n\
+The value is a list of the form (HIGH . LOW), like the time values\n\
+that `file-attributes' returns.")
+ ()
+{
+ return long_to_cons (current_buffer->modtime);
+}
+
DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime,
- Sset_visited_file_modtime, 0, 0, 0,
+ Sset_visited_file_modtime, 0, 1, 0,
"Update buffer's recorded modification time from the visited file's time.\n\
Useful if the buffer was not read from the file normally\n\
-or if the file itself has been changed for some known benign reason.")
- ()
+or if the file itself has been changed for some known benign reason.\n\
+An argument specifies the modification time value to use\n\
+\(instead of that of the visited file), in the form of a list\n\
+\(HIGH . LOW) or (HIGH LOW).")
+ (time_list)
+ Lisp_Object time_list;
{
- register Lisp_Object filename;
- struct stat st;
- Lisp_Object handler;
+ if (!NILP (time_list))
+ current_buffer->modtime = cons_to_long (time_list);
+ else
+ {
+ register Lisp_Object filename;
+ struct stat st;
+ Lisp_Object handler;
- filename = Fexpand_file_name (current_buffer->filename, Qnil);
+ 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;
-
- else if (stat (XSTRING (filename)->data, &st) >= 0)
- current_buffer->modtime = st.st_mtime;
+ /* 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, Qfile_name_directory, filename, Qnil);
+ else if (stat (XSTRING (filename)->data, &st) >= 0)
+ current_buffer->modtime = st.st_mtime;
+ }
return Qnil;
}
This file is not the file you visited; that changes only when you save.\n\n\
Non-nil first argument means do not print any message if successful.\n\
Non-nil second argument means save only current buffer.")
- (nomsg)
- Lisp_Object nomsg;
+ (no_message, current_only)
+ Lisp_Object no_message, current_only;
{
struct buffer *old = current_buffer, *b;
Lisp_Object tail, buf;
int auto_saved = 0;
char *omessage = echo_area_glyphs;
- extern minibuf_level;
+ extern int minibuf_level;
+ int do_handled_files;
/* No GCPRO needed, because (when it matters) all Lisp_Object variables
point to non-strings reached from Vbuffer_alist. */
auto_saving = 1;
if (minibuf_level)
- nomsg = Qt;
+ no_message = Qt;
/* Vrun_hooks is nil before emacs is dumped, and inc-vers.el will
eventually call do-auto-save, so don't err here in that case. */
if (!NILP (Vrun_hooks))
call1 (Vrun_hooks, intern ("auto-save-hook"));
- for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
- tail = XCONS (tail)->cdr)
- {
- buf = XCONS (XCONS (tail)->car)->cdr;
- b = XBUFFER (buf);
- /* Check for auto save enabled
- and file changed since last auto save
- and file changed since last real save. */
- if (XTYPE (b->auto_save_file_name) == Lisp_String
- && b->save_modified < BUF_MODIFF (b)
- && b->auto_save_modified < BUF_MODIFF (b))
- {
- if ((XFASTINT (b->save_length) * 10
- > (BUF_Z (b) - BUF_BEG (b)) * 13)
- /* A short file is likely to change a large fraction;
- spare the user annoying messages. */
- && XFASTINT (b->save_length) > 5000
- /* These messages are frequent and annoying for `*mail*'. */
- && !EQ (b->filename, Qnil))
- {
- /* It has shrunk too much; turn off auto-saving here. */
- message ("Buffer %s has shrunk a lot; auto save turned off there",
- XSTRING (b->name)->data);
- /* User can reenable saving with M-x auto-save. */
- b->auto_save_file_name = Qnil;
- /* Prevent warning from repeating if user does so. */
- XFASTINT (b->save_length) = 0;
- Fsleep_for (make_number (1), Qnil);
- continue;
- }
- set_buffer_internal (b);
- if (!auto_saved && NILP (nomsg))
- message1 ("Auto-saving...");
- internal_condition_case (auto_save_1, Qt, auto_save_error);
- auto_saved++;
- b->auto_save_modified = BUF_MODIFF (b);
- XFASTINT (current_buffer->save_length) = Z - BEG;
- set_buffer_internal (old);
- }
- }
+ /* First, save all files which don't have handlers. If Emacs is
+ crashing, the handlers may tweak what is causing Emacs to crash
+ in the first place, and it would be a shame if Emacs failed to
+ autosave perfectly ordinary files because it couldn't handle some
+ ange-ftp'd file. */
+ for (do_handled_files = 0; do_handled_files < 2; do_handled_files++)
+ for (tail = Vbuffer_alist; XGCTYPE (tail) == Lisp_Cons;
+ tail = XCONS (tail)->cdr)
+ {
+ buf = XCONS (XCONS (tail)->car)->cdr;
+ b = XBUFFER (buf);
+
+ if (!NILP (current_only)
+ && b != current_buffer)
+ continue;
+
+ /* Check for auto save enabled
+ and file changed since last auto save
+ and file changed since last real save. */
+ if (XTYPE (b->auto_save_file_name) == Lisp_String
+ && b->save_modified < BUF_MODIFF (b)
+ && b->auto_save_modified < BUF_MODIFF (b)
+ && (do_handled_files
+ || NILP (Ffind_file_name_handler (b->auto_save_file_name))))
+ {
+ if ((XFASTINT (b->save_length) * 10
+ > (BUF_Z (b) - BUF_BEG (b)) * 13)
+ /* A short file is likely to change a large fraction;
+ spare the user annoying messages. */
+ && XFASTINT (b->save_length) > 5000
+ /* These messages are frequent and annoying for `*mail*'. */
+ && !EQ (b->filename, Qnil)
+ && NILP (no_message))
+ {
+ /* It has shrunk too much; turn off auto-saving here. */
+ message ("Buffer %s has shrunk a lot; auto save turned off there",
+ XSTRING (b->name)->data);
+ /* User can reenable saving with M-x auto-save. */
+ b->auto_save_file_name = Qnil;
+ /* Prevent warning from repeating if user does so. */
+ XFASTINT (b->save_length) = 0;
+ Fsleep_for (make_number (1), Qnil);
+ continue;
+ }
+ set_buffer_internal (b);
+ if (!auto_saved && NILP (no_message))
+ message1 ("Auto-saving...");
+ internal_condition_case (auto_save_1, Qt, auto_save_error);
+ auto_saved++;
+ b->auto_save_modified = BUF_MODIFF (b);
+ XFASTINT (current_buffer->save_length) = Z - BEG;
+ set_buffer_internal (old);
+ }
+ }
/* Prevent another auto save till enough input events come in. */
record_auto_save ();
- if (auto_saved && NILP (nomsg))
+ if (auto_saved && NILP (no_message))
message1 (omessage ? omessage : "Auto-saving...done");
auto_saving = 0;
defsubr (&Sfile_accessible_directory_p);
defsubr (&Sfile_modes);
defsubr (&Sset_file_modes);
- defsubr (&Sset_default_file_mode);
- defsubr (&Sdefault_file_mode);
+ defsubr (&Sset_default_file_modes);
+ defsubr (&Sdefault_file_modes);
defsubr (&Sfile_newer_than_file_p);
defsubr (&Sinsert_file_contents);
defsubr (&Swrite_region);
defsubr (&Sverify_visited_file_modtime);
defsubr (&Sclear_visited_file_modtime);
+ defsubr (&Svisited_file_modtime);
defsubr (&Sset_visited_file_modtime);
defsubr (&Sdo_auto_save);
defsubr (&Sset_buffer_auto_saved);