X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4ad827c5ef13e13c37f26bad608cb7f4971a9d70..d093c3ac08ef48f862971dd9b1f35f72c6228976:/src/fileio.c diff --git a/src/fileio.c b/src/fileio.c index 69ad679fbf..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. @@ -76,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 @@ -163,6 +165,7 @@ 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; 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\ @@ -173,8 +176,10 @@ A file name is handled if one of the regular expressions in\n\ 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) { @@ -847,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); @@ -1576,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); @@ -1586,12 +1595,12 @@ A prefix arg makes KEEP-TIME non-nil.") /* 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)) + 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) @@ -1739,8 +1748,11 @@ 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 = 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) @@ -1755,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 @@ -1799,7 +1814,8 @@ This is what happens in interactive use with M-x.") call the corresponding file handler. */ 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) @@ -1850,7 +1866,8 @@ This happens for interactive use with M-x.") call the corresponding file handler. */ 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) @@ -1861,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; } @@ -2046,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, @@ -2082,13 +2123,16 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, return call2 (handler, Qfile_writable_p, abspath); if (access (XSTRING (abspath)->data, 0) >= 0) - return (access (XSTRING (abspath)->data, 2) >= 0) ? Qt : Qnil; + return ((access (XSTRING (abspath)->data, 2) >= 0 + && ! ro_fsys ((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); } @@ -2281,6 +2325,8 @@ 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 = 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); @@ -2296,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; @@ -2313,6 +2362,7 @@ before the error is signaled.") int count = specpdl_ptr - specpdl; struct gcpro gcpro1; Lisp_Object handler, val; + int total; val = Qnil; @@ -2328,7 +2378,7 @@ before the error is signaled.") 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; } @@ -2367,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"); } @@ -2380,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. */ @@ -2460,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\ @@ -2506,7 +2582,7 @@ to the file, instead of any buffer contents, and END is ignored.") filename = Fexpand_file_name (filename, Qnil); if (XTYPE (visit) == Lisp_String) - visit = Fexpand_file_name (visit, Qnil); + visit_file = Fexpand_file_name (visit, Qnil); else visit_file = filename; @@ -2518,16 +2594,9 @@ to the file, instead of any buffer contents, and END is ignored.") 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 @@ -2680,7 +2749,9 @@ to the file, instead of any buffer contents, and END is ignored.") #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 @@ -2872,7 +2943,8 @@ An argument specifies the modification time value to use\n\ call the corresponding file handler. */ handler = Ffind_file_name_handler (filename); if (!NILP (handler)) - return call3 (handler, Qfile_name_directory, filename, Qnil); + /* 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; } @@ -3200,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); } @@ -3298,6 +3372,7 @@ syms_of_fileio () Qinsert_file_contents = intern ("insert-file-contents"); Qwrite_region = intern ("write-region"); Qverify_visited_file_modtime = intern ("verify-visited-file-modtime"); + Qset_visited_file_modtime = intern ("set-visited-file-modtime"); staticpro (&Qexpand_file_name); staticpro (&Qdirectory_file_name);