X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/1d386d28ffe4c5b7cde93242c046588f7783db0d..42e3337cc7a782ab8705b1dea3841a7b0dcb6224:/src/fileio.c diff --git a/src/fileio.c b/src/fileio.c index 0bc623a022..5e6f048b9c 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1,5 +1,5 @@ /* 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. @@ -51,6 +51,14 @@ extern int sys_nerr; #include #endif +#ifndef USG +#ifndef VMS +#ifndef BSD4_1 +#define HAVE_FSYNC +#endif +#endif +#endif + #include "lisp.h" #include "intervals.h" #include "buffer.h" @@ -597,7 +605,6 @@ See also the function `substitute-in-file-name'.") int tlen; unsigned char *target; struct passwd *pw; - int lose; #ifdef VMS unsigned char * colon = 0; unsigned char * close = 0; @@ -616,6 +623,32 @@ See also the function `substitute-in-file-name'.") if (!NILP (handler)) return call3 (handler, Qexpand_file_name, name, defalt); + /* Use the buffer's default-directory if DEFALT is omitted. */ + if (NILP (defalt)) + defalt = current_buffer->directory; + CHECK_STRING (defalt, 1); + + /* Make sure DEFALT is properly expanded. + It would be better to do this down below where we actually use + defalt. Unfortunately, calling Fexpand_file_name recursively + could invoke GC, and the strings might be relocated. This would + be annoying because we have pointers into strings lying around + that would need adjusting, and people would add new pointers to + the code and forget to adjust them, resulting in intermittent bugs. + Putting this call here avoids all that crud. + + The EQ test avoids infinite recursion. */ + if (! NILP (defalt) && !EQ (defalt, name) + /* This saves time in a common case. */ + && XSTRING (defalt)->data[0] != '/') + { + struct gcpro gcpro1; + + GCPRO1 (name); + defalt = Fexpand_file_name (defalt, Qnil); + UNGCPRO; + } + #ifdef VMS /* Filenames on VMS are always upper case. */ name = Fupcase (name); @@ -632,8 +665,15 @@ See also the function `substitute-in-file-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 @@ -800,9 +840,6 @@ See also the function `substitute-in-file-name'.") #endif /* not VMS */ && !newdir) { - if (NILP (defalt)) - defalt = current_buffer->directory; - CHECK_STRING (defalt, 1); newdir = XSTRING (defalt)->data; } @@ -810,6 +847,9 @@ See also the function `substitute-in-file-name'.") { /* 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); @@ -1824,7 +1864,7 @@ This happens for interactive use with M-x.") /* 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; } @@ -1937,7 +1977,7 @@ See also `file-readable-p' and `file-attributes'.") 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; @@ -2009,22 +2049,46 @@ Otherwise returns NIL.") 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 + +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, @@ -2045,13 +2109,16 @@ 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); } @@ -2178,35 +2245,33 @@ Only the 12 low bits of MODE are used.") return Qnil; } -DEFUN ("set-umask", Fset_umask, Sset_umask, 1, 1, 0, - "Select which permission bits to disable in newly created files.\n\ -MASK should be an integer; if a permission's bit in MASK is 1,\n\ -subsequently created files will not have that permission enabled.\n\ -Only the low 9 bits are used.\n\ +DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0, + "Set the file permission bits for newly created files.\n\ +The argument MODE should be an integer; only the low 9 bits are used.\n\ This setting is inherited by subprocesses.") - (mask) - Lisp_Object mask; + (mode) + Lisp_Object mode; { - CHECK_NUMBER (mask, 0); + CHECK_NUMBER (mode, 0); - umask (XINT (mask) & 0777); + umask ((~ XINT (mode)) & 0777); return Qnil; } -DEFUN ("umask", Fumask, Sumask, 0, 0, 0, - "Return the current umask value.\n\ -The umask value determines which permissions are enabled in newly\n\ -created files. If a permission's bit in the umask is 1, subsequently\n\ -created files will not have that permission enabled.") +DEFUN ("default-file-modes", Fdefault_file_modes, Sdefault_file_modes, 0, 0, 0, + "Return the default file protection for created files.\n\ +The value is an integer.") () { - Lisp_Object mask; + int realmask; + Lisp_Object value; - XSET (mask, Lisp_Int, umask (0)); - umask (XINT (mask)); + realmask = umask (0); + umask (realmask); - return mask; + XSET (value, Lisp_Int, (~ realmask) & 0777); + return value; } #ifdef unix @@ -2457,7 +2522,7 @@ to the file, instead of any buffer contents, and END is ignored.") 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 */ @@ -2469,8 +2534,13 @@ to the file, instead of any buffer contents, and END is ignored.") 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. */ @@ -2637,15 +2707,11 @@ to the file, instead of any buffer contents, and END is ignored.") 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 @@ -2801,27 +2867,45 @@ Next attempt to save will certainly not complain of a discrepancy.") 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; } @@ -2869,72 +2953,87 @@ so that your editing is not lost if the system crashes.\n\ This file is not the file you visited; that changes only when you save.\n\n\ Non-nil first argument means do not print any message if successful.\n\ Non-nil second 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; @@ -3335,13 +3434,14 @@ for its argument."); defsubr (&Sfile_accessible_directory_p); defsubr (&Sfile_modes); defsubr (&Sset_file_modes); - defsubr (&Sset_umask); - defsubr (&Sumask); + defsubr (&Sset_default_file_modes); + defsubr (&Sdefault_file_modes); defsubr (&Sfile_newer_than_file_p); defsubr (&Sinsert_file_contents); defsubr (&Swrite_region); defsubr (&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);