X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/5acac34e2a01eb811c6e532fa580d8208064a7d3..8a9b0da95ae651715f717ef85a98d55fbc3c4ae7:/src/fileio.c diff --git a/src/fileio.c b/src/fileio.c index 4f1ff5bf69..a06032a3ca 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -101,6 +101,10 @@ extern char *strerror (); #define O_WRONLY 1 #endif +#ifndef O_RDONLY +#define O_RDONLY 0 +#endif + #define min(a, b) ((a) < (b) ? (a) : (b)) #define max(a, b) ((a) > (b) ? (a) : (b)) @@ -121,6 +125,10 @@ Lisp_Object Vafter_insert_file_functions; /* Functions to be called to create text property annotations for file. */ Lisp_Object Vwrite_region_annotate_functions; +/* During build_annotations, each time an annotation function is called, + this holds the annotations made by the previous functions. */ +Lisp_Object Vwrite_region_annotations_so_far; + /* File name in which we write a list of all our auto save files. */ Lisp_Object Vauto_save_list_file_name; @@ -188,7 +196,7 @@ 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 Qmake_directory_internal; Lisp_Object Qdelete_directory; Lisp_Object Qdelete_file; Lisp_Object Qrename_file; @@ -231,17 +239,16 @@ use the standard functions without calling themselves recursively.") else inhibited_handlers = Qnil; - for (chain = Vfile_name_handler_alist; XTYPE (chain) == Lisp_Cons; + for (chain = Vfile_name_handler_alist; CONSP (chain); chain = XCONS (chain)->cdr) { Lisp_Object elt; elt = XCONS (chain)->car; - if (XTYPE (elt) == Lisp_Cons) + if (CONSP (elt)) { Lisp_Object string; string = XCONS (elt)->car; - if (XTYPE (string) == Lisp_String - && fast_string_match (string, filename) >= 0) + if (STRINGP (string) && fast_string_match (string, filename) >= 0) { Lisp_Object handler, tem; @@ -290,7 +297,7 @@ on VMS, perhaps instead a string ending in `:', `]' or `>'.") && p[-1] != ':' && p[-1] != ']' && p[-1] != '>' #endif /* VMS */ #ifdef MSDOS - && p[-1] != ':' + && p[-1] != ':' && p[-1] != '\\' #endif ) p--; @@ -345,7 +352,7 @@ or the entire name if it contains no slash.") && p[-1] != ':' && p[-1] != ']' && p[-1] != '>' #endif /* VMS */ #ifdef MSDOS - && p[-1] != ':' + && p[-1] != ':' && p[-1] != '\\' #endif ) p--; @@ -443,7 +450,7 @@ file_name_as_directory (out, in) #else /* not VMS */ /* For Unix syntax, Append a slash if necessary */ #ifdef MSDOS - if (out[size] != ':' && out[size] != '/') + if (out[size] != ':' && out[size] != '/' && out[size] != '\\') #else if (out[size] != '/') #endif @@ -623,9 +630,11 @@ directory_file_name (src, dst) But leave "/" unchanged; do not change it to "". */ strcpy (dst, src); if (slen > 1 - && dst[slen - 1] == '/' #ifdef MSDOS + && (dst[slen - 1] == '/' || dst[slen - 1] == '/') && dst[slen - 2] != ':' +#else + && dst[slen - 1] == '/' #endif ) dst[slen - 1] = 0; @@ -764,7 +773,10 @@ See also the function `substitute-in-file-name'.") nm = XSTRING (name)->data; #ifdef MSDOS - /* firstly, strip drive name. */ + /* First map all backslashes to slashes. */ + dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm)); + + /* Now strip drive name. */ { unsigned char *colon = rindex (nm, ':'); if (colon) @@ -1487,6 +1499,10 @@ duplicates what `expand-file-name' does.") CHECK_STRING (string, 0); nm = XSTRING (string)->data; +#ifdef MSDOS + dostounix_filename (nm = strcpy (alloca (strlen (nm) + 1), nm)); + substituted = !strcmp (nm, XSTRING (string)->data); +#endif endp = nm + XSTRING (string)->size; /* If /~ or // appears, discard everything through first slash. */ @@ -1687,15 +1703,19 @@ expand_and_dir_to_file (filename, defdir) return abspath; } +void barf_or_query_if_file_exists (absname, querystring, interactive) Lisp_Object absname; unsigned char *querystring; int interactive; { register Lisp_Object tem; + struct stat statbuf; struct gcpro gcpro1; - if (access (XSTRING (absname)->data, 4) >= 0) + /* stat is a good way to tell whether the file exists, + regardless of what access permissions it has. */ + if (stat (XSTRING (absname)->data, &statbuf) >= 0) { if (! interactive) Fsignal (Qfile_already_exists, @@ -1732,7 +1752,6 @@ A prefix arg makes KEEP-TIME non-nil.") Lisp_Object handler; struct gcpro gcpro1, gcpro2; int count = specpdl_ptr - specpdl; - Lisp_Object args[6]; int input_file_statable_p; GCPRO2 (filename, newname); @@ -1752,11 +1771,11 @@ A prefix arg makes KEEP-TIME non-nil.") ok_if_already_exists, keep_date)); if (NILP (ok_if_already_exists) - || XTYPE (ok_if_already_exists) == Lisp_Int) + || INTEGERP (ok_if_already_exists)) barf_or_query_if_file_exists (newname, "copy to it", - XTYPE (ok_if_already_exists) == Lisp_Int); + INTEGERP (ok_if_already_exists)); - ifd = open (XSTRING (filename)->data, 0); + ifd = open (XSTRING (filename)->data, O_RDONLY); if (ifd < 0) report_file_error ("Opening input file", Fcons (filename, Qnil)); @@ -1814,7 +1833,8 @@ A prefix arg makes KEEP-TIME non-nil.") 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); + if (set_file_times (XSTRING (newname)->data, atime, mtime)) + report_file_error ("I/O error", Fcons (newname, Qnil)); } #ifdef APOLLO if (!egetenv ("USE_DOMAIN_ACLS")) @@ -1843,9 +1863,9 @@ DEFUN ("make-directory-internal", Fmake_directory_internal, CHECK_STRING (dirname, 0); dirname = Fexpand_file_name (dirname, Qnil); - handler = Ffind_file_name_handler (dirname, Qmake_directory); + handler = Ffind_file_name_handler (dirname, Qmake_directory_internal); if (!NILP (handler)) - return call3 (handler, Qmake_directory, dirname, Qnil); + return call2 (handler, Qmake_directory_internal, dirname); dir = XSTRING (dirname)->data; @@ -1856,7 +1876,7 @@ DEFUN ("make-directory-internal", Fmake_directory_internal, } DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete directory: ", - "Delete a directory. One argument, a file name string.") + "Delete a directory. One argument, a file name or directory name string.") (dirname) Lisp_Object dirname; { @@ -1864,7 +1884,7 @@ DEFUN ("delete-directory", Fdelete_directory, Sdelete_directory, 1, 1, "FDelete Lisp_Object handler; CHECK_STRING (dirname, 0); - dirname = Fexpand_file_name (dirname, Qnil); + dirname = Fdirectory_file_name (Fexpand_file_name (dirname, Qnil)); dir = XSTRING (dirname)->data; handler = Ffind_file_name_handler (dirname, Qdelete_directory); @@ -1929,9 +1949,9 @@ This is what happens in interactive use with M-x.") filename, newname, ok_if_already_exists)); if (NILP (ok_if_already_exists) - || XTYPE (ok_if_already_exists) == Lisp_Int) + || INTEGERP (ok_if_already_exists)) barf_or_query_if_file_exists (newname, "rename to it", - XTYPE (ok_if_already_exists) == Lisp_Int); + INTEGERP (ok_if_already_exists)); #ifndef BSD4_1 if (0 > rename (XSTRING (filename)->data, XSTRING (newname)->data)) #else @@ -1992,9 +2012,9 @@ This is what happens in interactive use with M-x.") newname, ok_if_already_exists)); if (NILP (ok_if_already_exists) - || XTYPE (ok_if_already_exists) == Lisp_Int) + || INTEGERP (ok_if_already_exists)) barf_or_query_if_file_exists (newname, "make it a new name", - XTYPE (ok_if_already_exists) == Lisp_Int); + INTEGERP (ok_if_already_exists)); unlink (XSTRING (newname)->data); if (0 > link (XSTRING (filename)->data, XSTRING (newname)->data)) { @@ -2015,9 +2035,9 @@ This is what happens in interactive use with M-x.") DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3, "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", "Make a symbolic link to FILENAME, named LINKNAME. Both args strings.\n\ -Signals a `file-already-exists' error if a file NEWNAME already exists\n\ +Signals a `file-already-exists' error if a file LINKNAME 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\ +A number as third arg means request confirmation if LINKNAME already exists.\n\ This happens for interactive use with M-x.") (filename, linkname, ok_if_already_exists) Lisp_Object filename, linkname, ok_if_already_exists; @@ -2046,9 +2066,9 @@ This happens for interactive use with M-x.") linkname, ok_if_already_exists)); if (NILP (ok_if_already_exists) - || XTYPE (ok_if_already_exists) == Lisp_Int) + || INTEGERP (ok_if_already_exists)) barf_or_query_if_file_exists (linkname, "make it a link", - XTYPE (ok_if_already_exists) == Lisp_Int); + INTEGERP (ok_if_already_exists)); if (0 > symlink (XSTRING (filename)->data, XSTRING (linkname)->data)) { /* If we didn't complain already, silently delete existing file. */ @@ -2056,7 +2076,10 @@ This happens for interactive use with M-x.") { unlink (XSTRING (linkname)->data); if (0 <= symlink (XSTRING (filename)->data, XSTRING (linkname)->data)) - return Qnil; + { + UNGCPRO; + return Qnil; + } } #ifdef NO_ARG_ARRAY @@ -2139,13 +2162,71 @@ On Unix, this is a name starting with a `/' or a `~'.") && ptr[1] != '.') #endif /* VMS */ #ifdef MSDOS - || (*ptr != 0 && ptr[1] == ':' && ptr[2] == '/') + || (*ptr != 0 && ptr[1] == ':' && (ptr[2] == '/' || ptr[2] == '\\')) #endif ) return Qt; else return Qnil; } + +/* Return nonzero if file FILENAME exists and can be executed. */ + +static int +check_executable (filename) + char *filename; +{ +#ifdef __HURD__ + mach_port_t file; + int access_mode; + + file = path_lookup (filename, 0, 0); + if (file == MACH_PORT_NULL) + /* File can't be opened. */ + access_mode = 0; + else + { + file_access (file, &access_mode); + mach_port_deallocate (mach_task_self (), file); + } + return !!(access_mode & O_EXEC); +#else + /* Access isn't quite right because it uses the real uid + and we really want to test with the effective uid. + But Unix doesn't give us a right way to do it. */ + return (access (filename, 1) >= 0); +#endif +} + +/* Return nonzero if file FILENAME exists and can be written. */ + +static int +check_writable (filename) + char *filename; +{ +#ifdef __HURD__ + mach_port_t file; + int access_mode; + + file = path_lookup (filename, 0, 0); + if (file == MACH_PORT_NULL) + /* File can't be opened. */ + access_mode = 0; + else + { + file_access (file, &access_mode); + mach_port_deallocate (mach_task_self (), file); + } + return !!(access_mode & O_WRITE); +#else + /* Access isn't quite right because it uses the real uid + and we really want to test with the effective uid. + But Unix doesn't give us a right way to do it. + Opening with O_WRONLY could work for an ordinary file, + but would lose for directories. */ + return (access (filename, 2) >= 0); +#endif +} DEFUN ("file-exists-p", Ffile_exists_p, Sfile_exists_p, 1, 1, 0, "Return t if file FILENAME exists. (This does not mean you can read it.)\n\ @@ -2155,6 +2236,7 @@ See also `file-readable-p' and `file-attributes'.") { Lisp_Object abspath; Lisp_Object handler; + struct stat statbuf; CHECK_STRING (filename, 0); abspath = Fexpand_file_name (filename, Qnil); @@ -2165,7 +2247,7 @@ See also `file-readable-p' and `file-attributes'.") if (!NILP (handler)) return call2 (handler, Qfile_exists_p, abspath); - return (access (XSTRING (abspath)->data, 0) >= 0) ? Qt : Qnil; + return (stat (XSTRING (abspath)->data, &statbuf) >= 0) ? Qt : Qnil; } DEFUN ("file-executable-p", Ffile_executable_p, Sfile_executable_p, 1, 1, 0, @@ -2187,7 +2269,7 @@ For a directory, this means you can access files in that directory.") if (!NILP (handler)) return call2 (handler, Qfile_executable_p, abspath); - return (access (XSTRING (abspath)->data, 1) >= 0) ? Qt : Qnil; + return (check_executable (XSTRING (abspath)->data) ? Qt : Qnil); } DEFUN ("file-readable-p", Ffile_readable_p, Sfile_readable_p, 1, 1, 0, @@ -2198,6 +2280,7 @@ See also `file-exists-p' and `file-attributes'.") { Lisp_Object abspath; Lisp_Object handler; + int desc; CHECK_STRING (filename, 0); abspath = Fexpand_file_name (filename, Qnil); @@ -2208,7 +2291,11 @@ See also `file-exists-p' and `file-attributes'.") if (!NILP (handler)) return call2 (handler, Qfile_readable_p, abspath); - return (access (XSTRING (abspath)->data, 4) >= 0) ? Qt : Qnil; + desc = open (XSTRING (abspath)->data, O_RDONLY); + if (desc < 0) + return Qnil; + close (desc); + return Qt; } DEFUN ("file-symlink-p", Ffile_symlink_p, Sfile_symlink_p, 1, 1, 0, @@ -2258,30 +2345,6 @@ Otherwise returns nil.") #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, @@ -2291,6 +2354,7 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, { Lisp_Object abspath, dir; Lisp_Object handler; + struct stat statbuf; CHECK_STRING (filename, 0); abspath = Fexpand_file_name (filename, Qnil); @@ -2301,9 +2365,8 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, if (!NILP (handler)) return call2 (handler, Qfile_writable_p, abspath); - if (access (XSTRING (abspath)->data, 0) >= 0) - return ((access (XSTRING (abspath)->data, 2) >= 0 - && ! ro_fsys ((char *) XSTRING (abspath)->data)) + if (stat (XSTRING (abspath)->data, &statbuf) >= 0) + return (check_writable (XSTRING (abspath)->data) ? Qt : Qnil); dir = Ffile_name_directory (abspath); #ifdef VMS @@ -2314,8 +2377,7 @@ DEFUN ("file-writable-p", Ffile_writable_p, Sfile_writable_p, 1, 1, 0, if (!NILP (dir)) dir = Fdirectory_file_name (dir); #endif /* MSDOS */ - return ((access (!NILP (dir) ? (char *) XSTRING (dir)->data : "", 2) >= 0 - && ! ro_fsys ((char *) XSTRING (dir)->data)) + return (check_writable (!NILP (dir) ? (char *) XSTRING (dir)->data : "") ? Qt : Qnil); } @@ -2354,6 +2416,8 @@ searchable directory.") Lisp_Object filename; { Lisp_Object handler; + int tem; + struct gcpro gcpro1; /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2361,11 +2425,17 @@ searchable directory.") 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; + /* It's an unlikely combination, but yes we really do need to gcpro: + Suppose that file-accessible-directory-p has no handler, but + file-directory-p does have a handler; this handler causes a GC which + relocates the string in `filename'; and finally file-directory-p + returns non-nil. Then we would end up passing a garbaged string + to file-executable-p. */ + GCPRO1 (filename); + tem = (NILP (Ffile_directory_p (filename)) + || NILP (Ffile_executable_p (filename))); + UNGCPRO; + return tem ? Qnil : Qt; } DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, @@ -2565,7 +2635,7 @@ and (2) it puts less data in the undo list.") register int inserted = 0; register int how_much; int count = specpdl_ptr - specpdl; - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object handler, val, insval; Lisp_Object p; int total; @@ -2573,7 +2643,7 @@ and (2) it puts less data in the undo list.") val = Qnil; p = Qnil; - GCPRO2 (filename, p); + GCPRO3 (filename, val, p); if (!NILP (current_buffer->read_only)) Fbarf_if_buffer_read_only(); @@ -2593,14 +2663,14 @@ and (2) it puts less data in the undo list.") fd = -1; #ifndef APOLLO - if (stat (XSTRING (filename)->data, &st) < 0 - || (fd = open (XSTRING (filename)->data, 0)) < 0) + if (stat (XSTRING (filename)->data, &st) < 0) #else - if ((fd = open (XSTRING (filename)->data, 0)) < 0 + if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0 || fstat (fd, &st) < 0) #endif /* not APOLLO */ { if (fd >= 0) close (fd); + badopen: if (NILP (visit)) report_file_error ("Opening input file", Fcons (filename, Qnil)); st.st_mtime = -1; @@ -2608,22 +2678,26 @@ and (2) it puts less data in the undo list.") goto notfound; } - /* Replacement should preserve point as it preserves markers. */ - if (!NILP (replace)) - record_unwind_protect (restore_point_unwind, Fpoint_marker ()); - - record_unwind_protect (close_file_unwind, make_number (fd)); - -#ifdef S_IFSOCK +#ifdef S_IFREG /* 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) + if (!S_ISREG (st.st_mode)) Fsignal (Qfile_error, - Fcons (build_string ("reading from named pipe"), + Fcons (build_string ("not a regular file"), Fcons (filename, Qnil))); #endif + if (fd < 0) + if ((fd = open (XSTRING (filename)->data, O_RDONLY)) < 0) + goto badopen; + + /* Replacement should preserve point as it preserves markers. */ + if (!NILP (replace)) + record_unwind_protect (restore_point_unwind, Fpoint_marker ()); + + record_unwind_protect (close_file_unwind, make_number (fd)); + /* Supposedly happens on VMS. */ if (st.st_size < 0) error ("File size is negative"); @@ -2663,7 +2737,7 @@ and (2) it puts less data in the undo list.") #else /* MSDOS */ if (!NILP (replace)) { - char buffer[1 << 14]; + unsigned char buffer[1 << 14]; int same_at_start = BEGV; int same_at_end = ZV; int overlap; @@ -2694,10 +2768,12 @@ and (2) it puts less data in the undo list.") immediate_quit = 0; /* If the file matches the buffer completely, there's no need to replace anything. */ - if (same_at_start == st.st_size) + if (same_at_start - BEGV == st.st_size) { close (fd); specpdl_ptr--; + /* Truncate the buffer to the size of the file. */ + del_range_1 (same_at_start, same_at_end, 0); goto handled; } immediate_quit = 1; @@ -2710,6 +2786,9 @@ and (2) it puts less data in the undo list.") /* At what file position are we now scanning? */ curpos = st.st_size - (ZV - same_at_end); + /* If the entire file matches the buffer tail, stop the scan. */ + if (curpos == 0) + break; /* How much can we scan in the next step? */ trial = min (curpos, sizeof buffer); if (lseek (fd, curpos - trial, 0) < 0) @@ -2809,13 +2888,8 @@ and (2) it puts less data in the undo list.") /* Determine file type from name and remove LFs from CR-LFs if the file is deemed to be a text file. */ { - struct gcpro gcpro1; - Lisp_Object code; - code = Qnil; - GCPRO1 (filename); current_buffer->buffer_file_type = call1 (Qfind_buffer_file_type, filename); - UNGCPRO; if (NILP (current_buffer->buffer_file_type)) { int reduced_size @@ -2909,6 +2983,23 @@ and (2) it puts less data in the undo list.") static Lisp_Object build_annotations (); +/* If build_annotations switched buffers, switch back to BUF. + Kill the temporary buffer that was selected in the meantime. */ + +static Lisp_Object +build_annotations_unwind (buf) + Lisp_Object buf; +{ + Lisp_Object tembuf; + + if (XBUFFER (buf) == current_buffer) + return Qnil; + tembuf = Fcurrent_buffer (); + Fset_buffer (buf); + Fkill_buffer (tembuf); + return Qnil; +} + DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 5, "r\nFWrite region to file: ", "Write current region into specified file.\n\ @@ -2936,6 +3027,7 @@ to the file, instead of any buffer contents, and END is ignored.") struct stat st; int tem; int count = specpdl_ptr - specpdl; + int count1; #ifdef VMS unsigned char *fname = 0; /* If non-0, original filename (must rename) */ #endif /* VMS */ @@ -2944,6 +3036,7 @@ to the file, instead of any buffer contents, and END is ignored.") Lisp_Object annotations; int visiting, quietly; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + struct buffer *given_buffer; #ifdef MSDOS int buffer_file_type = NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY; @@ -2952,11 +3045,13 @@ to the file, instead of any buffer contents, and END is ignored.") if (!NILP (start) && !STRINGP (start)) validate_region (&start, &end); + GCPRO2 (filename, visit); filename = Fexpand_file_name (filename, Qnil); if (STRINGP (visit)) visit_file = Fexpand_file_name (visit, Qnil); else visit_file = filename; + UNGCPRO; visiting = (EQ (visit, Qt) || STRINGP (visit)); quietly = !NILP (visit); @@ -2969,7 +3064,7 @@ to the file, instead of any buffer contents, and END is ignored.") call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qwrite_region); /* If FILENAME has no handler, see if VISIT has one. */ - if (NILP (handler) && XTYPE (visit) == Lisp_String) + if (NILP (handler) && STRINGP (visit)) handler = Ffind_file_name_handler (visit, Qwrite_region); if (!NILP (handler)) @@ -2995,7 +3090,16 @@ to the file, instead of any buffer contents, and END is ignored.") XFASTINT (end) = Z; } + record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ()); + count1 = specpdl_ptr - specpdl; + + given_buffer = current_buffer; annotations = build_annotations (start, end); + if (current_buffer != given_buffer) + { + start = BEGV; + end = ZV; + } #ifdef CLASH_DETECTION if (!auto_saving) @@ -3197,8 +3301,10 @@ to the file, instead of any buffer contents, and END is ignored.") #ifndef FOO stat (fn, &st); #endif - /* Discard the unwind protect */ - specpdl_ptr = specpdl + count; + /* Discard the unwind protect for close_file_unwind. */ + specpdl_ptr = specpdl + count1; + /* Restore the original current buffer. */ + visit_file = unbind_to (count, visit_file); #ifdef CLASH_DETECTION if (!auto_saving) @@ -3219,6 +3325,7 @@ to the file, instead of any buffer contents, and END is ignored.") current_buffer->save_modified = MODIFF; XFASTINT (current_buffer->save_length) = Z - BEG; current_buffer->filename = visit_file; + update_mode_lines++; } else if (quietly) return Qnil; @@ -3241,7 +3348,11 @@ DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0, /* Build the complete list of annotations appropriate for writing out the text between START and END, by calling all the functions in - write-region-annotate-functions and merging the lists they return. */ + write-region-annotate-functions and merging the lists they return. + If one of these functions switches to a different buffer, we assume + that buffer contains altered text. Therefore, the caller must + make sure to restore the current buffer in all cases, + as save-excursion would do. */ static Lisp_Object build_annotations (start, end) @@ -3256,7 +3367,20 @@ build_annotations (start, end) GCPRO2 (annotations, p); while (!NILP (p)) { + struct buffer *given_buffer = current_buffer; + Vwrite_region_annotations_so_far = annotations; res = call2 (Fcar (p), start, end); + /* If the function makes a different buffer current, + assume that means this buffer contains altered text to be output. + Reset START and END from the buffer bounds + and discard all previous annotations because they should have + been dealt with by this function. */ + if (current_buffer != given_buffer) + { + start = BEGV; + end = ZV; + annotations = Qnil; + } Flength (res); /* Check basic validity of return value */ annotations = merge (annotations, res, Qcar_less_than_car); p = Fcdr (p); @@ -3286,7 +3410,7 @@ a_write (desc, addr, len, pos, annot) int nextpos; int lastpos = pos + len; - while (1) + while (NILP (*annot) || CONSP (*annot)) { tem = Fcar_safe (Fcar (*annot)); if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos) @@ -3358,7 +3482,7 @@ This means that the file has not been changed since it was visited or saved.") CHECK_BUFFER (buf, 0); b = XBUFFER (buf); - if (XTYPE (b->filename) != Lisp_String) return Qt; + if (!STRINGP (b->filename)) return Qt; if (b->modtime == 0) return Qt; /* If the file name has special constructs in it, @@ -3443,14 +3567,12 @@ An argument specifies the modification time value to use\n\ Lisp_Object auto_save_error () { - unsigned char *name = XSTRING (current_buffer->name)->data; - ring_bell (); - message ("Autosaving...error for %s", name); + message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data); Fsleep_for (make_number (1), Qnil); - message ("Autosaving...error!for %s", name); + message ("Autosaving...error!for %s", XSTRING (current_buffer->name)->data); Fsleep_for (make_number (1), Qnil); - message ("Autosaving...error for %s", name); + message ("Autosaving...error for %s", XSTRING (current_buffer->name)->data); Fsleep_for (make_number (1), Qnil); return Qnil; } @@ -3475,11 +3597,10 @@ auto_save_1 () } static Lisp_Object -do_auto_save_unwind (stream) /* used as unwind-protect function */ - Lisp_Object stream; +do_auto_save_unwind (desc) /* used as unwind-protect function */ + Lisp_Object desc; { - close (*(int *)XPNTR (stream)); - xfree (XPNTR (stream)); + close (XINT (desc)); return Qnil; } @@ -3505,7 +3626,6 @@ Non-nil second argument means save only current buffer.") int do_handled_files; Lisp_Object oquit; int listdesc; - Lisp_Object lispstream; int count = specpdl_ptr - specpdl; int *ptr; @@ -3536,15 +3656,10 @@ Non-nil second argument means save only current buffer.") } else listdesc = -1; - - /* We may not be able to store STREAM itself as a Lisp_Object pointer - since that is guaranteed to work only for data that has been malloc'd. - So malloc a full-size pointer, and record the address of that pointer. */ - ptr = (int *) xmalloc (sizeof (int)); - *ptr = listdesc; - XSET (lispstream, Lisp_Internal_Stream, (int) ptr); - record_unwind_protect (do_auto_save_unwind, lispstream); + /* Arrange to close that file whether or not we get an error. */ + if (listdesc >= 0) + record_unwind_protect (do_auto_save_unwind, make_number (listdesc)); /* First, save all files which don't have handlers. If Emacs is crashing, the handlers may tweak what is causing Emacs to crash @@ -3560,7 +3675,7 @@ Non-nil second argument means save only current buffer.") /* Record all the buffers that have auto save mode in the special file that lists them. */ - if (XTYPE (b->auto_save_file_name) == Lisp_String + if (STRINGP (b->auto_save_file_name) && listdesc >= 0 && do_handled_files == 0) { write (listdesc, XSTRING (b->auto_save_file_name)->data, @@ -3575,7 +3690,7 @@ Non-nil second argument means save only current buffer.") /* 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 + if (STRINGP (b->auto_save_file_name) && b->save_modified < BUF_MODIFF (b) && b->auto_save_modified < BUF_MODIFF (b) /* -1 means we've turned off autosaving for a while--see below. */ @@ -3755,10 +3870,10 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte specdir = Ffile_name_directory (string); val = Ffile_name_completion (name, realdir); UNGCPRO; - if (XTYPE (val) != Lisp_String) + if (!STRINGP (val)) { if (changed) - return string; + return double_dollars (string); return val; } @@ -3788,7 +3903,8 @@ DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0, "Read file name, prompting with PROMPT and completing in directory DIR.\n\ Value is not expanded---you must call `expand-file-name' yourself.\n\ Default name to DEFAULT if user enters a null string.\n\ - (If DEFAULT is omitted, the visited file name is used.)\n\ + (If DEFAULT is omitted, the visited file name is used,\n\ + except that if INITIAL is specified, that combined with DIR is used.)\n\ Fourth arg MUSTMATCH non-nil means require existing file's name.\n\ Non-nil and non-t means also require confirmation after completion.\n\ Fifth arg INITIAL specifies text to start with.\n\ @@ -3804,12 +3920,17 @@ DIR defaults to current buffer's directory default.") if (NILP (dir)) dir = current_buffer->directory; if (NILP (defalt)) - defalt = current_buffer->filename; + { + if (! NILP (initial)) + defalt = Fexpand_file_name (initial, dir); + else + defalt = current_buffer->filename; + } /* If dir starts with user's homedir, change that to ~. */ homedir = (char *) egetenv ("HOME"); if (homedir != 0 - && XTYPE (dir) == Lisp_String + && STRINGP (dir) && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir)) && XSTRING (dir)->data[strlen (homedir)] == '/') { @@ -3893,7 +4014,7 @@ DEFUN ("read-file-name", Fread_file_name, Sread_file_name, 1, 5, 0, /* If dir starts with user's homedir, change that to ~. */ homedir = (char *) egetenv ("HOME"); if (homedir != 0 - && XTYPE (dir) == Lisp_String + && STRINGP (dir) && !strncmp (homedir, XSTRING (dir)->data, strlen (homedir)) && XSTRING (dir)->data[strlen (homedir)] == '/') { @@ -3943,7 +4064,7 @@ syms_of_fileio () 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"); + Qmake_directory_internal = intern ("make-directory-internal"); Qdelete_directory = intern ("delete-directory"); Qdelete_file = intern ("delete-file"); Qrename_file = intern ("rename-file"); @@ -3971,7 +4092,7 @@ syms_of_fileio () staticpro (&Qunhandled_file_name_directory); staticpro (&Qfile_name_as_directory); staticpro (&Qcopy_file); - staticpro (&Qmake_directory); + staticpro (&Qmake_directory_internal); staticpro (&Qdelete_directory); staticpro (&Qdelete_file); staticpro (&Qrename_file); @@ -4061,8 +4182,15 @@ increasing order. If there are several functions in the list, the several\n\ lists are merged destructively."); Vwrite_region_annotate_functions = Qnil; + DEFVAR_LISP ("write-region-annotations-so-far", + &Vwrite_region_annotations_so_far, + "When an annotation function is called, this holds the previous annotations.\n\ +These are the annotations made by other annotation functions\n\ +that were already called. See also `write-region-annotate-functions'."); + Vwrite_region_annotations_so_far = Qnil; + DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers, - "A list of file names for which handlers should not be used.\n\ + "A list of file name handlers that temporarily should not be used.\n\ This applies only to the operation `inhibit-file-name-operation'."); Vinhibit_file_name_handlers = Qnil;