X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/72b2181785d12fe97e4518bb62c4fe034c49915c..d093c3ac08ef48f862971dd9b1f35f72c6228976:/src/fileio.c diff --git a/src/fileio.c b/src/fileio.c index 94261b8218..fe4deb1fd3 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, 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" @@ -68,9 +76,11 @@ extern int sys_nerr; #ifdef HPUX #include #ifndef HPUX8 +#ifndef HPUX9 #include #endif #endif +#endif #ifndef O_WRONLY #define O_WRONLY 1 @@ -133,6 +143,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; @@ -154,15 +165,21 @@ Lisp_Object Qfile_newer_than_file_p; Lisp_Object Qinsert_file_contents; Lisp_Object Qwrite_region; Lisp_Object Qverify_visited_file_modtime; +Lisp_Object Qset_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; + + CHECK_STRING (filename, 0); + for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons; chain = XCONS (chain)->cdr) { @@ -176,6 +193,8 @@ find_file_handler (filename) && fast_string_match (string, filename) >= 0) return XCONS (elt)->cdr; } + + QUIT; } return Qnil; } @@ -198,7 +217,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 +251,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 +266,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 +384,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 +560,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 +610,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 +624,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,10 +670,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 */ @@ -614,11 +693,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] == '\\') @@ -712,44 +798,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)/* ~ by itself */ - { - 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; + && *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; + 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 */ - } + 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 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 @@ -757,9 +845,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; } @@ -767,6 +852,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); @@ -791,7 +879,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); @@ -800,7 +888,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; @@ -863,9 +951,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 @@ -1488,6 +1584,7 @@ A prefix arg makes KEEP-TIME non-nil.") Lisp_Object handler; struct gcpro gcpro1, gcpro2; int count = specpdl_ptr - specpdl; + Lisp_Object args[6]; GCPRO2 (filename, newname); CHECK_STRING (filename, 0); @@ -1497,13 +1594,13 @@ 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); - if (!NILP (handler)) - return call3 (handler, Qcopy_file, filename, newname); + handler = Ffind_file_name_handler (filename); /* Likewise for output file name. */ - handler = find_file_handler (newname); + if (NILP (handler)) + handler = Ffind_file_name_handler (newname); if (!NILP (handler)) - return call3 (handler, Qcopy_file, filename, newname); + return call5 (handler, Qcopy_file, filename, newname, + ok_if_already_exists, keep_date); if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) @@ -1560,7 +1657,8 @@ 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; @@ -1571,10 +1669,10 @@ DEFUN ("make-directory", Fmake_directory, Smake_directory, 1, 1, "FMake director 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 call2 (handler, Qmake_directory, dirname); - + return call3 (handler, Qmake_directory, dirname, Qnil); + dir = XSTRING (dirname)->data; if (mkdir (dir, 0777) != 0) @@ -1595,7 +1693,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); @@ -1615,7 +1713,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); @@ -1649,9 +1747,12 @@ 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)) + handler = Ffind_file_name_handler (newname); if (!NILP (handler)) - return call3 (handler, Qrename_file, filename, newname); + return call4 (handler, Qrename_file, + filename, newname, ok_if_already_exists); if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) @@ -1666,7 +1767,10 @@ This is what happens in interactive use with M-x.") { if (errno == EXDEV) { - Fcopy_file (filename, newname, ok_if_already_exists, Qt); + Fcopy_file (filename, newname, + /* We have already prompted if it was an integer, + so don't have copy-file prompt again. */ + NILP (ok_if_already_exists) ? Qnil : Qt, Qt); Fdelete_file (filename); } else @@ -1708,9 +1812,10 @@ 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); + return call4 (handler, Qadd_name_to_file, filename, newname, + ok_if_already_exists); if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) @@ -1759,9 +1864,10 @@ 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); + return call4 (handler, Qmake_symbolic_link, filename, linkname, + ok_if_already_exists); if (NILP (ok_if_already_exists) || XTYPE (ok_if_already_exists) == Lisp_Int) @@ -1772,7 +1878,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; } @@ -1876,7 +1982,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); @@ -1885,7 +1991,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; @@ -1898,7 +2004,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); @@ -1919,7 +2025,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); @@ -1945,7 +2051,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); @@ -1957,22 +2063,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, @@ -1988,18 +2118,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 ((char *) XSTRING (abspath)->data)) + ? 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)->data)) ? Qt : Qnil); } @@ -2018,7 +2151,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); @@ -2041,7 +2174,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); @@ -2065,7 +2198,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); @@ -2088,7 +2221,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); @@ -2126,35 +2259,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 @@ -2193,7 +2324,9 @@ 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)) + handler = Ffind_file_name_handler (abspath2); if (!NILP (handler)) return call3 (handler, Qfile_newer_than_file_p, abspath1, abspath2); @@ -2209,15 +2342,18 @@ otherwise, if FILE2 does not exist, the answer is t.") } DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, - 1, 2, 0, + 1, 4, 0, "Insert contents of file FILENAME after point.\n\ -Returns list of absolute pathname and length of data inserted.\n\ +Returns list of absolute file name and length of data inserted.\n\ If second argument VISIT is non-nil, the buffer's visited filename\n\ and last save file modtime are set, and it is marked unmodified.\n\ If visiting and the file does not exist, visiting is completed\n\ -before the error is signaled.") - (filename, visit) - Lisp_Object filename, visit; +before the error is signaled.\n\n\ +The optional third and fourth arguments BEG and END\n\ +specify what portion of the file to insert.\n\ +If VISIT is non-nil, BEG and END must be nil.") + (filename, visit, beg, end) + Lisp_Object filename, visit, beg, end; { struct stat st; register int fd; @@ -2226,6 +2362,7 @@ before the error is signaled.") int count = specpdl_ptr - specpdl; struct gcpro gcpro1; Lisp_Object handler, val; + int total; val = Qnil; @@ -2238,10 +2375,10 @@ 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); + val = call5 (handler, Qinsert_file_contents, filename, visit, beg, end); st.st_mtime = 0; goto handled; } @@ -2280,12 +2417,32 @@ before the error is signaled.") if (st.st_size < 0) error ("File size is negative"); + if (!NILP (beg) || !NILP (end)) + if (!NILP (visit)) + error ("Attempt to visit less than an entire file"); + + if (!NILP (beg)) + CHECK_NUMBER (beg, 0); + else + XFASTINT (beg) = 0; + + if (!NILP (end)) + CHECK_NUMBER (end, 0); + else + { + XSETINT (end, st.st_size); + if (XINT (end) != st.st_size) + error ("maximum buffer size exceeded"); + } + + total = XINT (end) - XINT (beg); + { register Lisp_Object temp; /* Make sure point-max won't overflow after this insertion. */ - XSET (temp, Lisp_Int, st.st_size + Z); - if (st.st_size + Z != XINT (temp)) + XSET (temp, Lisp_Int, total); + if (total != XINT (temp)) error ("maximum buffer size exceeded"); } @@ -2293,12 +2450,18 @@ before the error is signaled.") prepare_to_modify_buffer (point, point); move_gap (point); - if (GAP_SIZE < st.st_size) - make_gap (st.st_size - GAP_SIZE); - + if (GAP_SIZE < total) + make_gap (total - GAP_SIZE); + + if (XINT (beg) != 0) + { + if (lseek (fd, XINT (beg), 0) < 0) + report_file_error ("Setting file position", Fcons (filename, Qnil)); + } + while (1) { - int try = min (st.st_size - inserted, 64 << 10); + int try = min (total - inserted, 64 << 10); int this; /* Allow quitting out of the actual I/O. */ @@ -2373,7 +2536,7 @@ before the error is signaled.") Fcons (make_number (inserted), Qnil))); } - + DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 5, "r\nFWrite region to file: ", "Write current region into specified file.\n\ @@ -2384,8 +2547,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) @@ -2402,7 +2568,8 @@ 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; - struct gcpro gcpro1, gcpro2; + Lisp_Object visit_file; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; /* Special kludge to simplify auto-saving */ if (NILP (start)) @@ -2413,35 +2580,33 @@ to the file, instead of any buffer contents, and END is ignored.") else if (XTYPE (start) != Lisp_String) validate_region (&start, &end); - GCPRO2 (start, filename); 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)) { - 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); + val = call6 (handler, Qwrite_region, start, end, + filename, append, visit); /* 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 = 0; current_buffer->save_modified = MODIFF; XFASTINT (current_buffer->save_length) = Z - BEG; - current_buffer->filename = filename; + current_buffer->filename = visit_file; } UNGCPRO; return val; @@ -2449,7 +2614,7 @@ to the file, instead of any buffer contents, and END is ignored.") #ifdef CLASH_DETECTION if (!auto_saving) - lock_file (filename); + lock_file (visit_file); #endif /* CLASH_DETECTION */ fn = XSTRING (filename)->data; @@ -2513,7 +2678,7 @@ to the file, instead of any buffer contents, and END is ignored.") { #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)); @@ -2525,7 +2690,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)); } @@ -2581,15 +2746,13 @@ 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) + /* mib says that closing the file will try to write as fast as NFS can do + it, and that means the fsync here is not crucial for autosave files. */ + if (!auto_saving && fsync (desc) < 0) failure = 1, save_errno = errno; -#endif -#endif #endif /* Spurious "file has changed on disk" warnings have been @@ -2633,29 +2796,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; } @@ -2713,7 +2876,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); @@ -2745,27 +2908,46 @@ 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; - - 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 (!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 the file name has special constructs in it, + call the corresponding file handler. */ + handler = Ffind_file_name_handler (filename); + if (!NILP (handler)) + /* The handler can find the file name the same way we did. */ + return call2 (handler, Qset_visited_file_modtime, Qnil); + else if (stat (XSTRING (filename)->data, &st) >= 0) + current_buffer->modtime = st.st_mtime; + } return Qnil; } @@ -2813,72 +2995,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; @@ -3075,6 +3272,8 @@ DIR defaults to current buffer's directory default.") tem = Fstring_equal (val, insdef); if (!NILP (tem) && !NILP (defalt)) return defalt; + if (XSTRING (val)->size == 0 && NILP (insdef)) + return defalt; return Fsubstitute_in_file_name (val); } @@ -3151,6 +3350,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"); @@ -3172,10 +3372,14 @@ syms_of_fileio () Qinsert_file_contents = intern ("insert-file-contents"); 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); - + Qset_visited_file_modtime = intern ("set-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); @@ -3196,6 +3400,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"); @@ -3233,18 +3440,22 @@ 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); defsubr (&Sexpand_file_name); defsubr (&Ssubstitute_in_file_name); defsubr (&Scopy_file); - defsubr (&Smake_directory); + defsubr (&Smake_directory_internal); defsubr (&Sdelete_directory); defsubr (&Sdelete_file); defsubr (&Srename_file); @@ -3268,13 +3479,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);