X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/265a9e559da4ac72d154ecd638c51801b3e97847..42e3337cc7a782ab8705b1dea3841a7b0dcb6224:/src/fileio.c diff --git a/src/fileio.c b/src/fileio.c index d1bac1596a..5e6f048b9c 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1,11 +1,11 @@ /* File IO for GNU Emacs. - Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993 Free Software Foundation, Inc. This file is part of GNU Emacs. GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 1, or (at your option) +the Free Software Foundation; either version 2, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, @@ -17,12 +17,13 @@ You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ +#include "config.h" #include #include #ifdef VMS -#include "pwd.h" +#include "vms-pwd.h" #else #include #endif @@ -34,8 +35,6 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include #include #include -#else -#include #endif #include @@ -52,8 +51,16 @@ extern int sys_nerr; #include #endif -#include "config.h" +#ifndef USG +#ifndef VMS +#ifndef BSD4_1 +#define HAVE_FSYNC +#endif +#endif +#endif + #include "lisp.h" +#include "intervals.h" #include "buffer.h" #include "window.h" @@ -64,13 +71,7 @@ extern int sys_nerr; #include #endif -#ifdef NEED_TIME_H -#include -#else /* not NEED_TIME_H */ -#ifdef HAVE_TIMEVAL -#include -#endif /* HAVE_TIMEVAL */ -#endif /* not NEED_TIME_H */ +#include "systime.h" #ifdef HPUX #include @@ -93,6 +94,10 @@ int auto_saving; a new file with the same mode as the original */ int auto_save_mode_bits; +/* Alist of elements (REGEXP . HANDLER) for file names + whose I/O is done with a special handler. */ +Lisp_Object Vfile_name_handler_alist; + /* Nonzero means, when reading a filename in the minibuffer, start out by inserting the default directory into the minibuffer. */ int insert_default_directory; @@ -103,6 +108,8 @@ int vms_stmlf_recfm; Lisp_Object Qfile_error, Qfile_already_exists; +Lisp_Object Qfile_name_history; + report_file_error (string, data) char *string; Lisp_Object data; @@ -123,6 +130,69 @@ report_file_error (string, data) Fsignal (Qfile_error, Fcons (build_string (string), Fcons (errstring, data))); } + +close_file_unwind (fd) + Lisp_Object fd; +{ + close (XFASTINT (fd)); +} + +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; +Lisp_Object Qdelete_directory; +Lisp_Object Qdelete_file; +Lisp_Object Qrename_file; +Lisp_Object Qadd_name_to_file; +Lisp_Object Qmake_symbolic_link; +Lisp_Object Qfile_exists_p; +Lisp_Object Qfile_executable_p; +Lisp_Object Qfile_readable_p; +Lisp_Object Qfile_symlink_p; +Lisp_Object Qfile_writable_p; +Lisp_Object Qfile_directory_p; +Lisp_Object Qfile_accessible_directory_p; +Lisp_Object Qfile_modes; +Lisp_Object Qset_file_modes; +Lisp_Object Qfile_newer_than_file_p; +Lisp_Object Qinsert_file_contents; +Lisp_Object Qwrite_region; +Lisp_Object Qverify_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\ +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) + { + Lisp_Object elt; + elt = XCONS (chain)->car; + if (XTYPE (elt) == Lisp_Cons) + { + Lisp_Object string; + string = XCONS (elt)->car; + if (XTYPE (string) == Lisp_String + && fast_string_match (string, filename) >= 0) + return XCONS (elt)->cdr; + } + + QUIT; + } + return Qnil; +} DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, 1, 1, 0, @@ -136,9 +206,16 @@ on VMS, perhaps instead a string ending in `:', `]' or `>'.") { register unsigned char *beg; register unsigned char *p; + Lisp_Object handler; CHECK_STRING (file, 0); + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (file); + if (!NILP (handler)) + return call2 (handler, Qfile_name_directory, file); + beg = XSTRING (file)->data; p = beg + XSTRING (file)->size; @@ -163,9 +240,16 @@ or the entire name if it contains no slash.") Lisp_Object file; { register unsigned char *beg, *p, *end; + Lisp_Object handler; CHECK_STRING (file, 0); + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (file); + if (!NILP (handler)) + return call2 (handler, Qfile_name_nondirectory, file); + beg = XSTRING (file)->data; end = p = beg + XSTRING (file)->size; @@ -177,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) @@ -264,10 +371,18 @@ On VMS, converts \"[X]FOO.DIR\" to \"[X.FOO]\", etc.") Lisp_Object file; { char *buf; + Lisp_Object handler; CHECK_STRING (file, 0); if (NILP (file)) return Qnil; + + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (file); + if (!NILP (handler)) + return call2 (handler, Qfile_name_as_directory, file); + buf = (char *) alloca (XSTRING (file)->size + 10); return build_string (file_name_as_directory (buf, XSTRING (file)->data)); } @@ -390,9 +505,11 @@ directory_file_name (src, dst) && (ptr[rlen] == ']' || ptr[rlen] == '>') && ptr[rlen - 1] == '.') { - ptr[rlen - 1] = ']'; - ptr[rlen] = '\0'; - return directory_file_name (ptr, dst); + char * buf = (char *) alloca (strlen (ptr) + 1); + strcpy (buf, ptr); + buf[rlen - 1] = ']'; + buf[rlen] = '\0'; + return directory_file_name (buf, dst); } else dst[slen - 1] = ':'; @@ -411,7 +528,7 @@ directory_file_name (src, dst) /* Process as Unix format: just remove any final slash. But leave "/" unchanged; do not change it to "". */ strcpy (dst, src); - if (dst[slen - 1] == '/' && slen > 1) + if (slen > 1 && dst[slen - 1] == '/') dst[slen - 1] = 0; return 1; } @@ -429,11 +546,19 @@ it returns a file name such as \"[X]Y.DIR.1\".") Lisp_Object directory; { char *buf; + Lisp_Object handler; CHECK_STRING (directory, 0); if (NILP (directory)) return Qnil; + + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (directory); + if (!NILP (handler)) + return call2 (handler, Qdirectory_file_name, directory); + #ifdef VMS /* 20 extra chars is insufficient for VMS, since we might perform a logical name translation. an equivalence string can be up to 255 @@ -464,8 +589,12 @@ DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, Second arg DEFAULT is directory to start with if FILENAME is relative\n\ (does not start with slash); if DEFAULT is nil or missing,\n\ the current buffer's value of default-directory is used.\n\ -Filenames containing `.' or `..' as components are simplified;\n\ -initial `~/' expands to your home directory.\n\ +Path components that are `.' are removed, and \n\ +path components followed by `..' are removed, along with the `..' itself;\n\ +note that these simplifications are done without checking the resulting\n\ +paths in the file system.\n\ +An initial `~/' expands to your home directory.\n\ +An initial `~USER/' expands to USER's home directory.\n\ See also the function `substitute-in-file-name'.") (name, defalt) Lisp_Object name, defalt; @@ -476,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; @@ -485,9 +613,42 @@ See also the function `substitute-in-file-name'.") int lbrack = 0, rbrack = 0; int dots = 0; #endif /* VMS */ + Lisp_Object handler; CHECK_STRING (name, 0); + /* If the file name has special constructs in it, + call the corresponding file handler. */ + 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); @@ -504,10 +665,22 @@ 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 + element starts with a "/". */ + + /* "//" anywhere isn't necessarily hairy; we just start afresh + with the second slash. */ if (p[0] == '/' && p[1] == '/' #ifdef APOLLO /* // at start of filename is meaningful on Apollo system */ @@ -515,11 +688,18 @@ See also the function `substitute-in-file-name'.") #endif /* APOLLO */ ) nm = p + 1; + + /* "~" is hairy as the start of any path element. */ if (p[0] == '/' && p[1] == '~') nm = p + 1, lose = 1; - if (p[0] == '/' && p[1] == '.' - && (p[2] == '/' || p[2] == 0 - || (p[2] == '.' && (p[3] == '/' || p[3] == 0)))) + + /* "." and ".." are hairy. */ + if (p[0] == '/' + && p[1] == '.' + && (p[2] == '/' + || p[2] == 0 + || (p[2] == '.' && (p[3] == '/' + || p[3] == 0)))) lose = 1; #ifdef VMS if (p[0] == '\\') @@ -613,41 +793,46 @@ See also the function `substitute-in-file-name'.") newdir = 0; if (nm[0] == '~') /* prefix ~ */ - if (nm[1] == '/' + { + if (nm[1] == '/' #ifdef VMS - || nm[1] == ':' -#endif /* VMS */ - || nm[1] == 0)/* ~/filename */ - { - if (!(newdir = (unsigned char *) egetenv ("HOME"))) - newdir = (unsigned char *) ""; - nm++; + || nm[1] == ':' +#endif /* VMS */ + || nm[1] == 0) /* ~ by itself */ + { + if (!(newdir = (unsigned char *) egetenv ("HOME"))) + newdir = (unsigned char *) ""; + nm++; #ifdef VMS - nm++; /* Don't leave the slash in nm. */ -#endif /* VMS */ - } - else /* ~user/filename */ - { - for (p = nm; *p && (*p != '/' + nm++; /* Don't leave the slash in nm. */ +#endif /* VMS */ + } + else /* ~user/filename */ + { + for (p = nm; *p && (*p != '/' #ifdef VMS - && *p != ':' -#endif /* VMS */ - ); p++); - o = (unsigned char *) alloca (p - nm + 1); - bcopy ((char *) nm, o, p - nm); - o [p - nm] = 0; - - pw = (struct passwd *) getpwnam (o + 1); - if (!pw) - error ("\"%s\" isn't a registered user", o + 1); + && *p != ':' +#endif /* VMS */ + ); p++); + o = (unsigned char *) alloca (p - nm + 1); + bcopy ((char *) nm, o, p - nm); + o [p - nm] = 0; + pw = (struct passwd *) getpwnam (o + 1); + if (pw) + { + newdir = (unsigned char *) pw -> pw_dir; #ifdef VMS - nm = p + 1; /* skip the terminator */ + nm = p + 1; /* skip the terminator */ #else - nm = p; -#endif /* VMS */ - newdir = (unsigned char *) pw -> pw_dir; - } + nm = p; +#endif /* VMS */ + } + + /* If we don't find a user of that name, leave the name + unchanged; don't move nm forward to p. */ + } + } if (nm[0] != '/' #ifdef VMS @@ -655,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; } @@ -665,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); @@ -689,7 +874,7 @@ See also the function `substitute-in-file-name'.") strcpy (target, newdir); else #endif - file_name_as_directory (target, newdir); + file_name_as_directory (target, newdir); } strcat (target, nm); @@ -698,7 +883,7 @@ See also the function `substitute-in-file-name'.") strcpy (target, sys_translate_unix (target)); #endif /* VMS */ - /* Now canonicalize by removing /. and /foo/.. if they appear */ + /* Now canonicalize by removing /. and /foo/.. if they appear. */ p = target; o = target; @@ -761,9 +946,17 @@ See also the function `substitute-in-file-name'.") o = target; p++; } - else if (p[0] == '/' && p[1] == '.' && - (p[2] == '/' || p[2] == 0)) - p += 2; + else if (p[0] == '/' + && p[1] == '.' + && (p[2] == '/' + || p[2] == 0)) + { + /* If "/." is the entire filename, keep the "/". Otherwise, + just delete the whole "/.". */ + if (o == target && p[2] == '\0') + *o++ = *p; + p += 2; + } else if (!strncmp (p, "/..", 3) /* `/../' is the "superroot" on certain file systems. */ && o != target @@ -790,7 +983,8 @@ See also the function `substitute-in-file-name'.") return make_string (target, o - target); } #if 0 -DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, +/* Changed this DEFUN to a DEAFUN, so as not to confuse `make-docfile'. +DEAFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, "Convert FILENAME to absolute, and canonicalize it.\n\ Second arg DEFAULT is directory to start with if FILENAME is relative\n\ (does not start with slash); if DEFAULT is nil or missing,\n\ @@ -1306,6 +1500,13 @@ duplicates what `expand-file-name' does.") #endif /* not VMS */ } +/* A slightly faster and more convenient way to get + (directory-file-name (expand-file-name FOO)). The return value may + have had its last character zapped with a '\0' character, meaning + that it is acceptable to system calls, but not to other lisp + functions. Callers should make sure that the return value doesn't + escape. */ + Lisp_Object expand_and_dir_to_file (filename, defdir) Lisp_Object filename, defdir; @@ -1375,13 +1576,26 @@ A prefix arg makes KEEP-TIME non-nil.") int ifd, ofd, n; char buf[16 * 1024]; struct stat st; + Lisp_Object handler; struct gcpro gcpro1, gcpro2; + int count = specpdl_ptr - specpdl; GCPRO2 (filename, newname); CHECK_STRING (filename, 0); CHECK_STRING (newname, 1); filename = Fexpand_file_name (filename, Qnil); newname = Fexpand_file_name (newname, Qnil); + + /* If the input file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (filename); + if (!NILP (handler)) + return call3 (handler, Qcopy_file, filename, newname); + /* Likewise for output file name. */ + handler = Ffind_file_name_handler (newname); + if (!NILP (handler)) + return call3 (handler, Qcopy_file, filename, newname); + if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) barf_or_query_if_file_exists (newname, "copy to it", @@ -1391,6 +1605,8 @@ A prefix arg makes KEEP-TIME non-nil.") if (ifd < 0) report_file_error ("Opening input file", Fcons (filename, Qnil)); + record_unwind_protect (close_file_unwind, make_number (ifd)); + #ifdef VMS /* Create the copy file with the same record format as the input file */ ofd = sys_creat (XSTRING (newname)->data, 0666, ifd); @@ -1398,50 +1614,35 @@ A prefix arg makes KEEP-TIME non-nil.") ofd = creat (XSTRING (newname)->data, 0666); #endif /* VMS */ if (ofd < 0) - { - close (ifd); report_file_error ("Opening output file", Fcons (newname, Qnil)); - } + record_unwind_protect (close_file_unwind, make_number (ofd)); + + immediate_quit = 1; + QUIT; while ((n = read (ifd, buf, sizeof buf)) > 0) if (write (ofd, buf, n) != n) - { - close (ifd); - close (ofd); report_file_error ("I/O error", Fcons (newname, Qnil)); - } + immediate_quit = 0; if (fstat (ifd, &st) >= 0) { -#ifdef HAVE_TIMEVAL if (!NILP (keep_date)) { -#ifdef USE_UTIME -/* AIX has utimes() in compatibility package, but it dies. So use good old - utime interface instead. */ - struct { - time_t atime; - time_t mtime; - } tv; - tv.atime = st.st_atime; - tv.mtime = st.st_mtime; - utime (XSTRING (newname)->data, &tv); -#else /* not USE_UTIME */ - struct timeval timevals[2]; - timevals[0].tv_sec = st.st_atime; - timevals[1].tv_sec = st.st_mtime; - timevals[0].tv_usec = timevals[1].tv_usec = 0; - utimes (XSTRING (newname)->data, timevals); -#endif /* not USE_UTIME */ + 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); } -#endif /* HAVE_TIMEVALS */ - #ifdef APOLLO if (!egetenv ("USE_DOMAIN_ACLS")) #endif - chmod (XSTRING (newname)->data, st.st_mode & 07777); + chmod (XSTRING (newname)->data, st.st_mode & 07777); } + /* Discard the unwind protects. */ + specpdl_ptr = specpdl + count; + close (ifd); if (close (ofd) < 0) report_file_error ("I/O error", Fcons (newname, Qnil)); @@ -1450,34 +1651,46 @@ A prefix arg makes KEEP-TIME non-nil.") return Qnil; } -DEFUN ("make-directory", Fmake_directory, Smake_directory, 1, 1, "FMake directory: ", +DEFUN ("make-directory-internal", Fmake_directory_internal, + Smake_directory_internal, 1, 1, 0, "Create a directory. One argument, a file name string.") (dirname) Lisp_Object dirname; { unsigned char *dir; + Lisp_Object handler; CHECK_STRING (dirname, 0); dirname = Fexpand_file_name (dirname, Qnil); + + handler = Ffind_file_name_handler (dirname); + if (!NILP (handler)) + return call3 (handler, Qmake_directory, dirname, Qnil); + dir = XSTRING (dirname)->data; if (mkdir (dir, 0777) != 0) report_file_error ("Creating directory", Flist (1, &dirname)); - return Qnil; + return Qnil; } -DEFUN ("remove-directory", Fremove_directory, Sremove_directory, 1, 1, "FRemove directory: ", - "Remove a directory. One argument, a file name string.") +DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ", + "Delete a directory. One argument, a file name string.") (dirname) Lisp_Object dirname; { unsigned char *dir; + Lisp_Object handler; CHECK_STRING (dirname, 0); dirname = Fexpand_file_name (dirname, Qnil); dir = XSTRING (dirname)->data; + handler = Ffind_file_name_handler (dirname); + if (!NILP (handler)) + return call2 (handler, Qdelete_directory, dirname); + if (rmdir (dir) != 0) report_file_error ("Removing directory", Flist (1, &dirname)); @@ -1490,8 +1703,14 @@ If file has multiple names, it continues to exist with the other names.") (filename) Lisp_Object filename; { + Lisp_Object handler; CHECK_STRING (filename, 0); filename = Fexpand_file_name (filename, Qnil); + + handler = Ffind_file_name_handler (filename); + if (!NILP (handler)) + return call2 (handler, Qdelete_file, filename); + if (0 > unlink (XSTRING (filename)->data)) report_file_error ("Removing old name", Flist (1, &filename)); return Qnil; @@ -1511,6 +1730,7 @@ This is what happens in interactive use with M-x.") #ifdef NO_ARG_ARRAY Lisp_Object args[2]; #endif + Lisp_Object handler; struct gcpro gcpro1, gcpro2; GCPRO2 (filename, newname); @@ -1518,6 +1738,13 @@ This is what happens in interactive use with M-x.") CHECK_STRING (newname, 1); filename = Fexpand_file_name (filename, Qnil); newname = Fexpand_file_name (newname, Qnil); + + /* 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, Qrename_file, filename, newname); + if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) barf_or_query_if_file_exists (newname, "rename to it", @@ -1562,6 +1789,7 @@ This is what happens in interactive use with M-x.") #ifdef NO_ARG_ARRAY Lisp_Object args[2]; #endif + Lisp_Object handler; struct gcpro gcpro1, gcpro2; GCPRO2 (filename, newname); @@ -1569,6 +1797,13 @@ This is what happens in interactive use with M-x.") CHECK_STRING (newname, 1); filename = Fexpand_file_name (filename, Qnil); newname = Fexpand_file_name (newname, Qnil); + + /* 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, Qadd_name_to_file, filename, newname); + if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) barf_or_query_if_file_exists (newname, "make it a new name", @@ -1597,38 +1832,46 @@ Signals a `file-already-exists' error if a file NEWNAME 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\ This happens for interactive use with M-x.") - (filename, newname, ok_if_already_exists) - Lisp_Object filename, newname, ok_if_already_exists; + (filename, linkname, ok_if_already_exists) + Lisp_Object filename, linkname, ok_if_already_exists; { #ifdef NO_ARG_ARRAY Lisp_Object args[2]; #endif + Lisp_Object handler; struct gcpro gcpro1, gcpro2; - GCPRO2 (filename, newname); + GCPRO2 (filename, linkname); CHECK_STRING (filename, 0); - CHECK_STRING (newname, 1); + CHECK_STRING (linkname, 1); #if 0 /* This made it impossible to make a link to a relative name. */ filename = Fexpand_file_name (filename, Qnil); #endif - newname = Fexpand_file_name (newname, Qnil); + linkname = Fexpand_file_name (linkname, Qnil); + + /* 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, Qmake_symbolic_link, filename, linkname); + if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) - barf_or_query_if_file_exists (newname, "make it a link", + barf_or_query_if_file_exists (linkname, "make it a link", XTYPE (ok_if_already_exists) == Lisp_Int); - if (0 > symlink (XSTRING (filename)->data, XSTRING (newname)->data)) + if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data)) { /* If we didn't complain already, silently delete existing file. */ if (errno == EEXIST) { - unlink (XSTRING (filename)->data); - if (0 <= symlink (XSTRING (filename)->data, XSTRING (newname)->data)) + unlink (XSTRING (linkname)->data); + if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data)) return Qnil; } #ifdef NO_ARG_ARRAY args[0] = filename; - args[1] = newname; + args[1] = linkname; report_file_error ("Making symbolic link", Flist (2, args)); #else report_file_error ("Making symbolic link", Flist (2, &filename)); @@ -1718,23 +1961,39 @@ See also `file-readable-p' and `file-attributes'.") Lisp_Object filename; { Lisp_Object abspath; + Lisp_Object handler; 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); + if (!NILP (handler)) + return call2 (handler, Qfile_exists_p, abspath); + return (access (XSTRING (abspath)->data, 0) >= 0) ? Qt : 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; { Lisp_Object abspath; + Lisp_Object handler; 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); + if (!NILP (handler)) + return call2 (handler, Qfile_executable_p, abspath); + return (access (XSTRING (abspath)->data, 1) >= 0) ? Qt : Qnil; } @@ -1745,9 +2004,17 @@ See also `file-exists-p' and `file-attributes'.") Lisp_Object filename; { Lisp_Object abspath; + Lisp_Object handler; 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); + if (!NILP (handler)) + return call2 (handler, Qfile_readable_p, abspath); + return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil; } @@ -1763,10 +2030,17 @@ Otherwise returns NIL.") int bufsize; int valsize; Lisp_Object val; + Lisp_Object handler; CHECK_STRING (filename, 0); filename = Fexpand_file_name (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)) + return call2 (handler, Qfile_symlink_p, filename); + bufsize = 100; while (1) { @@ -1775,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, @@ -1799,17 +2097,28 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, Lisp_Object filename; { Lisp_Object abspath, dir; + Lisp_Object handler; 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); + 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); } @@ -1822,14 +2131,46 @@ if the directory so specified exists and really is a directory.") { register Lisp_Object abspath; struct stat st; + Lisp_Object handler; abspath = expand_and_dir_to_file (filename, current_buffer->directory); + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (abspath); + if (!NILP (handler)) + return call2 (handler, Qfile_directory_p, abspath); + if (stat (XSTRING (abspath)->data, &st) < 0) return Qnil; return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; } +DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, Sfile_accessible_directory_p, 1, 1, 0, + "Return t if file FILENAME is the name of a directory as a file,\n\ +and files in that directory can be opened by you. In order to use a\n\ +directory as a buffer's current directory, this predicate must return true.\n\ +A directory name spec may be given instead; then the value is t\n\ +if the directory so specified exists and really is a readable and\n\ +searchable directory.") + (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, Qfile_accessible_directory_p, filename); + + if (NILP (Ffile_directory_p (filename)) + || NILP (Ffile_executable_p (filename))) + return Qnil; + else + return Qt; +} + DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, "Return mode bits of FILE, as an integer.") (filename) @@ -1837,9 +2178,16 @@ DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, { Lisp_Object abspath; struct stat st; + Lisp_Object handler; abspath = expand_and_dir_to_file (filename, current_buffer->directory); + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (abspath); + if (!NILP (handler)) + return call2 (handler, Qfile_modes, abspath); + if (stat (XSTRING (abspath)->data, &st) < 0) return Qnil; return make_number (st.st_mode & 07777); @@ -1852,10 +2200,17 @@ Only the 12 low bits of MODE are used.") Lisp_Object filename, mode; { Lisp_Object abspath; + Lisp_Object handler; abspath = Fexpand_file_name (filename, current_buffer->directory); CHECK_NUMBER (mode, 1); + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (abspath); + if (!NILP (handler)) + return call3 (handler, Qset_file_modes, abspath, mode); + #ifndef APOLLO if (chmod (XSTRING (abspath)->data, XINT (mode)) < 0) report_file_error ("Doing chmod", Fcons (abspath, Qnil)); @@ -1890,6 +2245,47 @@ Only the 12 low bits of MODE are used.") return Qnil; } +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.") + (mode) + Lisp_Object mode; +{ + CHECK_NUMBER (mode, 0); + + umask ((~ XINT (mode)) & 0777); + + return Qnil; +} + +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.") + () +{ + int realmask; + Lisp_Object value; + + realmask = umask (0); + umask (realmask); + + XSET (value, Lisp_Int, (~ realmask) & 0777); + return value; +} + +#ifdef unix + +DEFUN ("unix-sync", Funix_sync, Sunix_sync, 0, 0, "", + "Tell Unix to finish all pending disk updates.") + () +{ + sync (); + return Qnil; +} + +#endif /* unix */ + DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, Sfile_newer_than_file_p, 2, 2, 0, "Return t if file FILE1 is newer than file FILE2.\n\ If FILE1 does not exist, the answer is nil;\n\ @@ -1897,34 +2293,38 @@ otherwise, if FILE2 does not exist, the answer is t.") (file1, file2) Lisp_Object file1, file2; { - Lisp_Object abspath; + Lisp_Object abspath1, abspath2; struct stat st; int mtime1; + Lisp_Object handler; + struct gcpro gcpro1, gcpro2; CHECK_STRING (file1, 0); CHECK_STRING (file2, 0); - abspath = expand_and_dir_to_file (file1, current_buffer->directory); + abspath1 = Qnil; + GCPRO2 (abspath1, file2); + abspath1 = expand_and_dir_to_file (file1, current_buffer->directory); + abspath2 = expand_and_dir_to_file (file2, current_buffer->directory); + UNGCPRO; - if (stat (XSTRING (abspath)->data, &st) < 0) + /* If the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (abspath1); + if (!NILP (handler)) + return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2); + + if (stat (XSTRING (abspath1)->data, &st) < 0) return Qnil; mtime1 = st.st_mtime; - abspath = expand_and_dir_to_file (file2, current_buffer->directory); - - if (stat (XSTRING (abspath)->data, &st) < 0) + if (stat (XSTRING (abspath2)->data, &st) < 0) return Qt; return (mtime1 > st.st_mtime) ? Qt : Qnil; } -close_file_unwind (fd) - Lisp_Object fd; -{ - close (XFASTINT (fd)); -} - DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, 1, 2, 0, "Insert contents of file FILENAME after point.\n\ @@ -1942,7 +2342,10 @@ before the error is signaled.") register int how_much; int count = specpdl_ptr - specpdl; struct gcpro gcpro1; - + Lisp_Object handler, val; + + val = Qnil; + GCPRO1 (filename); if (!NILP (current_buffer->read_only)) Fbarf_if_buffer_read_only(); @@ -1950,6 +2353,16 @@ before the error is signaled.") CHECK_STRING (filename, 0); filename = Fexpand_file_name (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)) + { + val = call3 (handler, Qinsert_file_contents, filename, visit); + st.st_mtime = 0; + goto handled; + } + fd = -1; #ifndef APOLLO @@ -1970,9 +2383,20 @@ before the error is signaled.") record_unwind_protect (close_file_unwind, make_number (fd)); +#ifdef S_IFSOCK + /* 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) + Fsignal (Qfile_error, + Fcons (build_string ("reading from named pipe"), + Fcons (filename, Qnil))); +#endif + /* Supposedly happens on VMS. */ if (st.st_size < 0) error ("File size is negative"); + { register Lisp_Object temp; @@ -1992,7 +2416,13 @@ before the error is signaled.") while (1) { int try = min (st.st_size - inserted, 64 << 10); - int this = read (fd, &FETCH_CHAR (point + inserted - 1) + 1, try); + int this; + + /* Allow quitting out of the actual I/O. */ + immediate_quit = 1; + QUIT; + this = read (fd, &FETCH_CHAR (point + inserted - 1) + 1, try); + immediate_quit = 0; if (this <= 0) { @@ -2008,8 +2438,13 @@ before the error is signaled.") } if (inserted > 0) - MODIFF++; - record_insert (point, inserted); + { + record_insert (point, inserted); + + /* Only defined if Emacs is compiled with USE_TEXT_PROPERTIES */ + offset_intervals (current_buffer, point, inserted); + MODIFF++; + } close (fd); @@ -2021,6 +2456,7 @@ before the error is signaled.") XSTRING (filename)->data, err_str (errno)); notfound: + handled: if (!NILP (visit)) { @@ -2033,18 +2469,23 @@ before the error is signaled.") current_buffer->auto_save_modified = MODIFF; XFASTINT (current_buffer->save_length) = Z - BEG; #ifdef CLASH_DETECTION - if (!NILP (current_buffer->filename)) - unlock_file (current_buffer->filename); - unlock_file (filename); + if (NILP (handler)) + { + if (!NILP (current_buffer->filename)) + unlock_file (current_buffer->filename); + unlock_file (filename); + } #endif /* CLASH_DETECTION */ current_buffer->filename = filename; /* If visiting nonexistent file, return nil. */ - if (st.st_mtime == -1) + if (current_buffer->modtime == -1) report_file_error ("Opening input file", Fcons (filename, Qnil)); } signal_after_change (point, 0, inserted); + if (!NILP (val)) + RETURN_UNGCPRO (val); RETURN_UNGCPRO (Fcons (filename, Fcons (make_number (inserted), Qnil))); @@ -2060,8 +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) @@ -2077,6 +2521,9 @@ to the file, instead of any buffer contents, and END is ignored.") #ifdef VMS unsigned char *fname = 0; /* If non-0, original filename (must rename) */ #endif /* VMS */ + Lisp_Object handler; + Lisp_Object visit_file; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; /* Special kludge to simplify auto-saving */ if (NILP (start)) @@ -2088,13 +2535,50 @@ to the file, instead of any buffer contents, and END is ignored.") validate_region (&start, &end); filename = Fexpand_file_name (filename, Qnil); - fn = XSTRING (filename)->data; + 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 = Ffind_file_name_handler (filename); + + if (!NILP (handler)) + { + Lisp_Object args[7]; + Lisp_Object val; + args[0] = handler; + args[1] = Qwrite_region; + args[2] = start; + args[3] = end; + args[4] = filename; + args[5] = append; + args[6] = visit; + val = Ffuncall (7, args); + + /* Do this before reporting IO error + to avoid a "file has changed on disk" warning on + next attempt to save. */ + if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String) + { + current_buffer->modtime = 0; + current_buffer->save_modified = MODIFF; + XFASTINT (current_buffer->save_length) = Z - BEG; + current_buffer->filename = visit_file; + } + UNGCPRO; + return val; + } #ifdef CLASH_DETECTION if (!auto_saving) - lock_file (filename); + lock_file (visit_file); #endif /* CLASH_DETECTION */ + fn = XSTRING (filename)->data; desc = -1; if (!NILP (append)) desc = open (fn, O_WRONLY); @@ -2107,8 +2591,8 @@ to the file, instead of any buffer contents, and END is ignored.") desc = open (fn, O_RDWR); if (desc < 0) desc = creat_copy_attrs (XTYPE (current_buffer->filename) == Lisp_String - ? XSTRING (current_buffer->filename)->data : 0, - fn); + ? XSTRING (current_buffer->filename)->data : 0, + fn); } else /* Write to temporary name and rename if no errors */ { @@ -2149,11 +2633,13 @@ to the file, instead of any buffer contents, and END is ignored.") desc = creat (fn, auto_saving ? auto_save_mode_bits : 0666); #endif /* not VMS */ + UNGCPRO; + if (desc < 0) { #ifdef CLASH_DETECTION save_errno = errno; - if (!auto_saving) unlock_file (filename); + if (!auto_saving) unlock_file (visit_file); errno = save_errno; #endif /* CLASH_DETECTION */ report_file_error ("Opening output file", Fcons (filename, Qnil)); @@ -2165,7 +2651,7 @@ to the file, instead of any buffer contents, and END is ignored.") if (lseek (desc, 0, 2) < 0) { #ifdef CLASH_DETECTION - if (!auto_saving) unlock_file (filename); + if (!auto_saving) unlock_file (visit_file); #endif /* CLASH_DETECTION */ report_file_error ("Lseek error", Fcons (filename, Qnil)); } @@ -2221,18 +2707,11 @@ to the file, instead of any buffer contents, and END is ignored.") immediate_quit = 0; -#ifndef USG -#ifndef VMS -#ifndef BSD4_1 -#ifndef alliant /* trinkle@cs.purdue.edu says fsync can return EBUSY - on alliant, for no visible reason. */ +#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 #endif /* Spurious "file has changed on disk" warnings have been @@ -2276,29 +2755,29 @@ to the file, instead of any buffer contents, and END is ignored.") #ifdef CLASH_DETECTION if (!auto_saving) - unlock_file (filename); + unlock_file (visit_file); #endif /* CLASH_DETECTION */ /* Do this before reporting IO error to avoid a "file has changed on disk" warning on next attempt to save. */ - if (EQ (visit, Qt)) + if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String) current_buffer->modtime = st.st_mtime; if (failure) error ("IO error writing %s: %s", fn, err_str (save_errno)); - if (EQ (visit, Qt)) + if (EQ (visit, Qt) || XTYPE (visit) == Lisp_String) { current_buffer->save_modified = MODIFF; XFASTINT (current_buffer->save_length) = Z - BEG; - current_buffer->filename = filename; + current_buffer->filename = visit_file; } else if (!NILP (visit)) return Qnil; if (!auto_saving) - message ("Wrote %s", fn); + message ("Wrote %s", XSTRING (visit_file)->data); return Qnil; } @@ -2346,6 +2825,7 @@ This means that the file has not been changed since it was visited or saved.") { struct buffer *b; struct stat st; + Lisp_Object handler; CHECK_BUFFER (buf, 0); b = XBUFFER (buf); @@ -2353,6 +2833,12 @@ This means that the file has not been changed since it was visited or saved.") if (XTYPE (b->filename) != Lisp_String) 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); + if (!NILP (handler)) + return call2 (handler, Qverify_visited_file_modtime, buf); + if (stat (XSTRING (b->filename)->data, &st) < 0) { /* If the file doesn't exist now and didn't exist before, @@ -2381,20 +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; + 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); - - if (stat (XSTRING (filename)->data, &st) >= 0) - current_buffer->modtime = st.st_mtime; + 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)) + return call3 (handler, Qfile_name_directory, filename, Qnil); + else if (stat (XSTRING (filename)->data, &st) >= 0) + current_buffer->modtime = st.st_mtime; + } return Qnil; } @@ -2406,11 +2917,11 @@ auto_save_error () ring_bell (); message ("Autosaving...error for %s", name); - Fsleep_for (make_number (1)); + Fsleep_for (make_number (1), Qnil); message ("Autosaving...error!for %s", name); - Fsleep_for (make_number (1)); + Fsleep_for (make_number (1), Qnil); message ("Autosaving...error for %s", name); - Fsleep_for (make_number (1)); + Fsleep_for (make_number (1), Qnil); return Qnil; } @@ -2441,73 +2952,88 @@ 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\ Non-nil first argument means do not print any message if successful.\n\ -Non-nil second argumet means save only current buffer.") - (nomsg) - Lisp_Object nomsg; +Non-nil second argument means save only current buffer.") + (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)); - 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); + } + } - if (auto_saved) - record_auto_save (); + /* 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; @@ -2545,36 +3071,46 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte lambda for verify final value */ { Lisp_Object name, specdir, realdir, val, orig_string; + int changed; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + + realdir = dir; + name = string; + orig_string = Qnil; + specdir = Qnil; + changed = 0; + /* No need to protect ACTION--we only compare it with t and nil. */ + GCPRO4 (string, realdir, name, specdir); if (XSTRING (string)->size == 0) { - orig_string = Qnil; - name = string; - realdir = dir; if (EQ (action, Qlambda)) - return Qnil; + { + UNGCPRO; + return Qnil; + } } else { orig_string = string; string = Fsubstitute_in_file_name (string); + changed = NILP (Fstring_equal (string, orig_string)); name = Ffile_name_nondirectory (string); - realdir = Ffile_name_directory (string); - if (NILP (realdir)) - realdir = dir; - else - realdir = Fexpand_file_name (realdir, dir); + val = Ffile_name_directory (string); + if (! NILP (val)) + realdir = Fexpand_file_name (val, realdir); } if (NILP (action)) { specdir = Ffile_name_directory (string); val = Ffile_name_completion (name, realdir); + UNGCPRO; if (XTYPE (val) != Lisp_String) { - if (NILP (Fstring_equal (string, orig_string))) + if (changed) return string; - return (val); + return val; } if (!NILP (specdir)) @@ -2606,8 +3142,9 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte } } #endif /* Not VMS */ - return (val); + return val; } + UNGCPRO; if (EQ (action, Qt)) return Ffile_name_all_completions (name, realdir); @@ -2633,7 +3170,7 @@ DIR defaults to current buffer's directory default.") (prompt, dir, defalt, mustmatch, initial) Lisp_Object prompt, dir, defalt, mustmatch, initial; { - Lisp_Object val, insdef, tem, backup_n; + Lisp_Object val, insdef, insdef1, tem; struct gcpro gcpro1, gcpro2; register char *homedir; int count; @@ -2658,23 +3195,20 @@ DIR defaults to current buffer's directory default.") if (insert_default_directory) { insdef = dir; + insdef1 = dir; if (!NILP (initial)) { - Lisp_Object args[2]; + Lisp_Object args[2], pos; args[0] = insdef; args[1] = initial; insdef = Fconcat (2, args); - backup_n = make_number (- (XSTRING (initial)->size)); + pos = make_number (XSTRING (dir)->size); + insdef1 = Fcons (insdef, pos); } - else - backup_n = Qnil; } else - { - insdef = build_string (""); - backup_n = Qnil; - } + insdef = Qnil, insdef1 = Qnil; #ifdef VMS count = specpdl_ptr - specpdl; @@ -2683,8 +3217,8 @@ DIR defaults to current buffer's directory default.") GCPRO2 (insdef, defalt); val = Fcompleting_read (prompt, intern ("read-file-name-internal"), - dir, mustmatch, - insert_default_directory ? insdef : Qnil, backup_n); + dir, mustmatch, insdef1, + Qfile_name_history); #ifdef VMS unbind_to (count, Qnil); @@ -2749,7 +3283,8 @@ DIR defaults to current buffer's directory default.") GCPRO2 (insdef, defalt); val = Fcompleting_read (prompt, intern ("read-file-name-internal"), dir, mustmatch, - insert_default_directory ? insdef : Qnil, Qnil); + insert_default_directory ? insdef : Qnil, + Qfile_name_history); #ifdef VMS unbind_to (count, Qnil); @@ -2767,6 +3302,64 @@ DIR defaults to current buffer's directory default.") syms_of_fileio () { + Qexpand_file_name = intern ("expand-file-name"); + 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"); + Qdelete_directory = intern ("delete-directory"); + Qdelete_file = intern ("delete-file"); + Qrename_file = intern ("rename-file"); + Qadd_name_to_file = intern ("add-name-to-file"); + Qmake_symbolic_link = intern ("make-symbolic-link"); + Qfile_exists_p = intern ("file-exists-p"); + Qfile_executable_p = intern ("file-executable-p"); + Qfile_readable_p = intern ("file-readable-p"); + Qfile_symlink_p = intern ("file-symlink-p"); + Qfile_writable_p = intern ("file-writable-p"); + Qfile_directory_p = intern ("file-directory-p"); + Qfile_accessible_directory_p = intern ("file-accessible-directory-p"); + Qfile_modes = intern ("file-modes"); + Qset_file_modes = intern ("set-file-modes"); + Qfile_newer_than_file_p = intern ("file-newer-than-file-p"); + Qinsert_file_contents = intern ("insert-file-contents"); + Qwrite_region = intern ("write-region"); + Qverify_visited_file_modtime = intern ("verify-visited-file-modtime"); + + 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); + staticpro (&Qdelete_file); + staticpro (&Qrename_file); + staticpro (&Qadd_name_to_file); + staticpro (&Qmake_symbolic_link); + staticpro (&Qfile_exists_p); + staticpro (&Qfile_executable_p); + staticpro (&Qfile_readable_p); + staticpro (&Qfile_symlink_p); + staticpro (&Qfile_writable_p); + staticpro (&Qfile_directory_p); + staticpro (&Qfile_accessible_directory_p); + staticpro (&Qfile_modes); + staticpro (&Qset_file_modes); + staticpro (&Qfile_newer_than_file_p); + 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"); staticpro (&Qfile_error); Qfile_already_exists = intern("file-already-exists"); @@ -2792,16 +3385,33 @@ syms_of_fileio () nil means use format `var'. This variable is meaningful only on VMS."); vms_stmlf_recfm = 0; + DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist, + "*Alist of elements (REGEXP . HANDLER) for file names handled specially.\n\ +If a file name matches REGEXP, then all I/O on that file is done by calling\n\ +HANDLER.\n\ +\n\ +The first argument given to HANDLER is the name of the I/O primitive\n\ +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)\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); defsubr (&Sexpand_file_name); defsubr (&Ssubstitute_in_file_name); defsubr (&Scopy_file); - defsubr (&Smake_directory); - defsubr (&Sremove_directory); + defsubr (&Smake_directory_internal); + defsubr (&Sdelete_directory); defsubr (&Sdelete_file); defsubr (&Srename_file); defsubr (&Sadd_name_to_file); @@ -2821,13 +3431,17 @@ nil means use format `var'. This variable is meaningful only on VMS."); defsubr (&Sfile_writable_p); defsubr (&Sfile_symlink_p); defsubr (&Sfile_directory_p); + defsubr (&Sfile_accessible_directory_p); defsubr (&Sfile_modes); defsubr (&Sset_file_modes); + 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); @@ -2835,4 +3449,8 @@ nil means use format `var'. This variable is meaningful only on VMS."); defsubr (&Sread_file_name_internal); defsubr (&Sread_file_name); + +#ifdef unix + defsubr (&Sunix_sync); +#endif }