X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c77d647ec8d6231214e952aeb216190e0cd42266..42e3337cc7a782ab8705b1dea3841a7b0dcb6224:/src/fileio.c diff --git a/src/fileio.c b/src/fileio.c index 58b7972a75..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" @@ -133,6 +141,7 @@ Lisp_Object Qexpand_file_name; Lisp_Object Qdirectory_file_name; Lisp_Object Qfile_name_directory; Lisp_Object Qfile_name_nondirectory; +Lisp_Object Qunhandled_file_name_directory; Lisp_Object Qfile_name_as_directory; Lisp_Object Qcopy_file; Lisp_Object Qmake_directory; @@ -155,13 +164,16 @@ Lisp_Object Qinsert_file_contents; Lisp_Object Qwrite_region; Lisp_Object Qverify_visited_file_modtime; -/* If FILENAME is handled specially on account of its syntax, - return its handler function. Otherwise, return nil. */ - -Lisp_Object -find_file_handler (filename) - Lisp_Object filename; +DEFUN ("find-file-name-handler", Ffind_file_name_handler, Sfind_file_name_handler, 1, 1, 0, + "Return FILENAME's handler function, if its syntax is handled specially.\n\ +Otherwise, return nil.\n\ +A file name is handled if one of the regular expressions in\n\ +`file-name-handler-alist' matches it.") + (filename) + Lisp_Object filename; { + /* This function must not munge the match data. */ + Lisp_Object chain; for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons; chain = XCONS (chain)->cdr) @@ -176,6 +188,8 @@ find_file_handler (filename) && fast_string_match (string, filename) >= 0) return XCONS (elt)->cdr; } + + QUIT; } return Qnil; } @@ -198,7 +212,7 @@ on VMS, perhaps instead a string ending in `:', `]' or `>'.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (file); + handler = Ffind_file_name_handler (file); if (!NILP (handler)) return call2 (handler, Qfile_name_directory, file); @@ -232,7 +246,7 @@ or the entire name if it contains no slash.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (file); + handler = Ffind_file_name_handler (file); if (!NILP (handler)) return call2 (handler, Qfile_name_nondirectory, file); @@ -247,6 +261,29 @@ or the entire name if it contains no slash.") return make_string (p, end - p); } + +DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, Sunhandled_file_name_directory, 1, 1, 0, + "Return a directly usable directory name somehow associated with FILENAME.\n\ +A `directly usable' directory name is one that may be used without the\n\ +intervention of any file handler.\n\ +If FILENAME is a directly usable file itself, return\n\ +(file-name-directory FILENAME).\n\ +The `call-process' and `start-process' functions use this function to\n\ +get a current directory to run processes in.") + (filename) + Lisp_Object filename; +{ + Lisp_Object handler; + + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (filename); + if (!NILP (handler)) + return call2 (handler, Qunhandled_file_name_directory, filename); + + return Ffile_name_directory (filename); +} + char * file_name_as_directory (out, in) @@ -342,7 +379,7 @@ On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (file); + handler = Ffind_file_name_handler (file); if (!NILP (handler)) return call2 (handler, Qfile_name_as_directory, file); @@ -518,7 +555,7 @@ it returns a file name such as \"[X]Y.DIR.1\".") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (directory); + handler = Ffind_file_name_handler (directory); if (!NILP (handler)) return call2 (handler, Qdirectory_file_name, directory); @@ -568,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; @@ -583,10 +619,36 @@ See also the function `substitute-in-file-name'.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (name); + handler = Ffind_file_name_handler (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); @@ -603,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 @@ -771,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; } @@ -781,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); @@ -1519,11 +1588,11 @@ A prefix arg makes KEEP-TIME non-nil.") /* If the input file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (filename); + handler = Ffind_file_name_handler (filename); if (!NILP (handler)) return call3 (handler, Qcopy_file, filename, newname); /* Likewise for output file name. */ - handler = find_file_handler (newname); + handler = Ffind_file_name_handler (newname); if (!NILP (handler)) return call3 (handler, Qcopy_file, filename, newname); @@ -1594,7 +1663,7 @@ DEFUN ("make-directory-internal", Fmake_directory_internal, CHECK_STRING (dirname, 0); dirname = Fexpand_file_name (dirname, Qnil); - handler = find_file_handler (dirname); + handler = Ffind_file_name_handler (dirname); if (!NILP (handler)) return call3 (handler, Qmake_directory, dirname, Qnil); @@ -1618,7 +1687,7 @@ DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete dirname = Fexpand_file_name (dirname, Qnil); dir = XSTRING (dirname)->data; - handler = find_file_handler (dirname); + handler = Ffind_file_name_handler (dirname); if (!NILP (handler)) return call2 (handler, Qdelete_directory, dirname); @@ -1638,7 +1707,7 @@ If file has multiple names, it continues to exist with the other names.") CHECK_STRING (filename, 0); filename = Fexpand_file_name (filename, Qnil); - handler = find_file_handler (filename); + handler = Ffind_file_name_handler (filename); if (!NILP (handler)) return call2 (handler, Qdelete_file, filename); @@ -1672,7 +1741,7 @@ This is what happens in interactive use with M-x.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (filename); + handler = Ffind_file_name_handler (filename); if (!NILP (handler)) return call3 (handler, Qrename_file, filename, newname); @@ -1731,7 +1800,7 @@ This is what happens in interactive use with M-x.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (filename); + handler = Ffind_file_name_handler (filename); if (!NILP (handler)) return call3 (handler, Qadd_name_to_file, filename, newname); @@ -1782,7 +1851,7 @@ This happens for interactive use with M-x.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (filename); + handler = Ffind_file_name_handler (filename); if (!NILP (handler)) return call3 (handler, Qmake_symbolic_link, filename, linkname); @@ -1795,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; } @@ -1899,7 +1968,7 @@ See also `file-readable-p' and `file-attributes'.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (abspath); + handler = Ffind_file_name_handler (abspath); if (!NILP (handler)) return call2 (handler, Qfile_exists_p, abspath); @@ -1908,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; @@ -1921,7 +1990,7 @@ For directories this means you can change to that directory.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (abspath); + handler = Ffind_file_name_handler (abspath); if (!NILP (handler)) return call2 (handler, Qfile_executable_p, abspath); @@ -1942,7 +2011,7 @@ See also `file-exists-p' and `file-attributes'.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (abspath); + handler = Ffind_file_name_handler (abspath); if (!NILP (handler)) return call2 (handler, Qfile_readable_p, abspath); @@ -1968,7 +2037,7 @@ Otherwise returns NIL.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (filename); + handler = Ffind_file_name_handler (filename); if (!NILP (handler)) return call2 (handler, Qfile_symlink_p, filename); @@ -1980,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, @@ -2011,18 +2104,21 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (abspath); + handler = Ffind_file_name_handler (abspath); if (!NILP (handler)) return call2 (handler, Qfile_writable_p, abspath); if (access (XSTRING (abspath)->data, 0) >= 0) - return (access (XSTRING (abspath)->data, 2) >= 0) ? Qt : Qnil; + 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); } @@ -2041,7 +2137,7 @@ if the directory so specified exists and really is a directory.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (abspath); + handler = Ffind_file_name_handler (abspath); if (!NILP (handler)) return call2 (handler, Qfile_directory_p, abspath); @@ -2064,7 +2160,7 @@ searchable directory.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (filename); + handler = Ffind_file_name_handler (filename); if (!NILP (handler)) return call2 (handler, Qfile_accessible_directory_p, filename); @@ -2088,7 +2184,7 @@ 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 = find_file_handler (abspath); + handler = Ffind_file_name_handler (abspath); if (!NILP (handler)) return call2 (handler, Qfile_modes, abspath); @@ -2111,7 +2207,7 @@ Only the 12 low bits of MODE are used.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (abspath); + handler = Ffind_file_name_handler (abspath); if (!NILP (handler)) return call3 (handler, Qset_file_modes, abspath, mode); @@ -2149,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 @@ -2216,7 +2310,7 @@ otherwise, if FILE2 does not exist, the answer is t.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (abspath1); + handler = Ffind_file_name_handler (abspath1); if (!NILP (handler)) return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2); @@ -2261,7 +2355,7 @@ before the error is signaled.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (filename); + handler = Ffind_file_name_handler (filename); if (!NILP (handler)) { val = call3 (handler, Qinsert_file_contents, filename, visit); @@ -2407,11 +2501,11 @@ Optional fourth argument APPEND if non-nil means\n\ Optional fifth argument VISIT if t means\n\ set the last-save-file-modtime of buffer to this file's modtime\n\ and mark buffer not modified.\n\ -If VISIT is neither t nor nil, it means do not print\n\ - the \"Wrote file\" message.\n\ If VISIT is a string, it is a second file name;\n\ the output goes to FILENAME, but the buffer is marked as visiting VISIT.\n\ VISIT is also the file name to lock and unlock for clash detection.\n\ +If VISIT is neither t nor nil nor a string,\n\ + that means do not print the \"Wrote file\" message.\n\ Kludgy feature: if START is a string, then that string is written\n\ to the file, instead of any buffer contents, and END is ignored.") (start, end, filename, append, visit) @@ -2428,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 */ @@ -2440,12 +2534,17 @@ 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. */ - handler = find_file_handler (filename); + handler = Ffind_file_name_handler (filename); if (!NILP (handler)) { @@ -2608,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 @@ -2740,7 +2835,7 @@ This means that the file has not been changed since it was visited or saved.") /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = find_file_handler (b->filename); + handler = Ffind_file_name_handler (b->filename); if (!NILP (handler)) return call2 (handler, Qverify_visited_file_modtime, buf); @@ -2772,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 = find_file_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; } @@ -2840,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; @@ -3178,6 +3306,7 @@ syms_of_fileio () Qdirectory_file_name = intern ("directory-file-name"); Qfile_name_directory = intern ("file-name-directory"); Qfile_name_nondirectory = intern ("file-name-nondirectory"); + Qunhandled_file_name_directory = intern ("unhandled-file-name-directory"); Qfile_name_as_directory = intern ("file-name-as-directory"); Qcopy_file = intern ("copy-file"); Qmake_directory = intern ("make-directory"); @@ -3200,9 +3329,12 @@ syms_of_fileio () Qwrite_region = intern ("write-region"); Qverify_visited_file_modtime = intern ("verify-visited-file-modtime"); - Qfile_name_history = intern ("file-name-history"); - Fset (Qfile_name_history, Qnil); - + staticpro (&Qexpand_file_name); + staticpro (&Qdirectory_file_name); + staticpro (&Qfile_name_directory); + staticpro (&Qfile_name_nondirectory); + staticpro (&Qunhandled_file_name_directory); + staticpro (&Qfile_name_as_directory); staticpro (&Qcopy_file); staticpro (&Qmake_directory); staticpro (&Qdelete_directory); @@ -3223,6 +3355,9 @@ syms_of_fileio () staticpro (&Qinsert_file_contents); staticpro (&Qwrite_region); staticpro (&Qverify_visited_file_modtime); + + Qfile_name_history = intern ("file-name-history"); + Fset (Qfile_name_history, Qnil); staticpro (&Qfile_name_history); Qfile_error = intern ("file-error"); @@ -3260,11 +3395,15 @@ to be handled; the remaining arguments are the arguments that were\n\ passed to that primitive. For example, if you do\n\ (file-exists-p FILENAME)\n\ and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\ - (funcall HANDLER 'file-exists-p FILENAME)"); + (funcall HANDLER 'file-exists-p FILENAME)\n\ +The function `find-file-name-handler' checks this list for a handler\n\ +for its argument."); Vfile_name_handler_alist = Qnil; + defsubr (&Sfind_file_name_handler); defsubr (&Sfile_name_directory); defsubr (&Sfile_name_nondirectory); + defsubr (&Sunhandled_file_name_directory); defsubr (&Sfile_name_as_directory); defsubr (&Sdirectory_file_name); defsubr (&Smake_temp_name); @@ -3295,13 +3434,14 @@ and FILENAME is handled by HANDLER, then HANDLER is called like this:\n\ 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);