X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b016179b58efb59ba177cafdaea6bdee2d23e0e0..6c4aeab695a87a47ed87b3d9933a9a4634c8f39a:/src/fileio.c diff --git a/src/fileio.c b/src/fileio.c index 898dc0705d..8ce89ba23f 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1,6 +1,7 @@ /* File IO for GNU Emacs. - Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998, - 1999, 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, + 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, + 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -16,8 +17,8 @@ GNU General Public License for more details. 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, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ #include @@ -73,7 +74,7 @@ extern int errno; #include "lisp.h" #include "intervals.h" #include "buffer.h" -#include "charset.h" +#include "character.h" #include "coding.h" #include "window.h" @@ -224,6 +225,11 @@ int vms_stmlf_recfm; expanding file names. This can be bound to / or \. */ Lisp_Object Vdirectory_sep_char; +#ifdef HAVE_FSYNC +/* Nonzero means skip the call to fsync in Fwrite-region. */ +int write_region_inhibit_fsync; +#endif + extern Lisp_Object Vuser_login_name; #ifdef WINDOWSNT @@ -264,9 +270,12 @@ report_file_error (string, data) { Lisp_Object errstring; int errorno = errno; + char *str; synchronize_system_messages_locale (); - errstring = code_convert_string_norecord (build_string (strerror (errorno)), + str = strerror (errorno); + errstring = code_convert_string_norecord (make_unibyte_string (str, + strlen (str)), Vlocale_coding_system, 0); while (1) @@ -304,6 +313,7 @@ restore_point_unwind (location) Fset_marker (location, Qnil, Qnil); return Qnil; } + Lisp_Object Qexpand_file_name; Lisp_Object Qsubstitute_in_file_name; @@ -1055,6 +1065,7 @@ See also the function `substitute-in-file-name'. */) #endif /* DOS_NT */ int length; Lisp_Object handler, result; + int multibyte; CHECK_STRING (name); @@ -1132,6 +1143,7 @@ See also the function `substitute-in-file-name'. */) name = FILE_SYSTEM_CASE (name); nm = SDATA (name); + multibyte = STRING_MULTIBYTE (name); #ifdef DOS_NT /* We will force directory separators to be either all \ or /, so make @@ -1297,8 +1309,7 @@ See also the function `substitute-in-file-name'. */) if (index (nm, '/')) { nm = sys_translate_unix (nm); - return make_specified_string (nm, -1, strlen (nm), - STRING_MULTIBYTE (name)); + return make_specified_string (nm, -1, strlen (nm), multibyte); } #endif /* VMS */ #ifdef DOS_NT @@ -1310,8 +1321,7 @@ See also the function `substitute-in-file-name'. */) if (IS_DIRECTORY_SEP (nm[1])) { if (strcmp (nm, SDATA (name)) != 0) - name = make_specified_string (nm, -1, strlen (nm), - STRING_MULTIBYTE (name)); + name = make_specified_string (nm, -1, strlen (nm), multibyte); } else #endif @@ -1320,8 +1330,7 @@ See also the function `substitute-in-file-name'. */) { char temp[] = " :"; - name = make_specified_string (nm, -1, p - nm, - STRING_MULTIBYTE (name)); + name = make_specified_string (nm, -1, p - nm, multibyte); temp[0] = DRIVE_LETTER (drive); name = concat2 (build_string (temp), name); } @@ -1329,8 +1338,7 @@ See also the function `substitute-in-file-name'. */) #else /* not DOS_NT */ if (nm == SDATA (name)) return name; - return make_specified_string (nm, -1, strlen (nm), - STRING_MULTIBYTE (name)); + return make_specified_string (nm, -1, strlen (nm), multibyte); #endif /* not DOS_NT */ } } @@ -1442,6 +1450,7 @@ See also the function `substitute-in-file-name'. */) && !newdir) { newdir = SDATA (default_directory); + multibyte |= STRING_MULTIBYTE (default_directory); #ifdef DOS_NT /* Note if special escape prefix is present, but remove for now. */ if (newdir[0] == '/' && newdir[1] == ':') @@ -1639,8 +1648,7 @@ See also the function `substitute-in-file-name'. */) { *o++ = *p++; } - else if (IS_DIRECTORY_SEP (p[0]) - && p[1] == '.' + else if (p[1] == '.' && (IS_DIRECTORY_SEP (p[2]) || p[2] == 0)) { @@ -1650,7 +1658,7 @@ See also the function `substitute-in-file-name'. */) *o++ = *p; p += 2; } - else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.' + else if (p[1] == '.' && p[2] == '.' /* `/../' is the "superroot" on certain file systems. Turned off on DOS_NT systems because they have no "superroot" and because this causes us to produce @@ -1670,14 +1678,9 @@ See also the function `substitute-in-file-name'. */) ++o; p += 3; } - else if (p > target - && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])) - { - /* Collapse multiple `/' in a row. */ - *o++ = *p++; - while (IS_DIRECTORY_SEP (*p)) - ++p; - } + else if (p > target && IS_DIRECTORY_SEP (p[1])) + /* Collapse multiple `/' in a row. */ + p++; else { *o++ = *p++; @@ -1707,8 +1710,7 @@ See also the function `substitute-in-file-name'. */) CORRECT_DIR_SEPS (target); #endif /* DOS_NT */ - result = make_specified_string (target, -1, o - target, - STRING_MULTIBYTE (name)); + result = make_specified_string (target, -1, o - target, multibyte); /* Again look to see if the file name has special constructs in it and perhaps call the corresponding file handler. This is needed @@ -2287,7 +2289,8 @@ duplicates what `expand-file-name' does. */) convert what we substitute into multibyte. */ while (*o) { - int c = unibyte_char_to_multibyte (*o++); + int c = *o++; + c = unibyte_char_to_multibyte (c); x += CHAR_STRING (c, x); } } @@ -2406,32 +2409,31 @@ barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick) return; } -DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6, +DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 5, "fCopy file: \nGCopy %s to file: \np\nP", doc: /* Copy FILE to NEWNAME. Both args must be strings. If NEWNAME names a directory, copy FILE there. -Signals a `file-already-exists' error if file NEWNAME already exists, -unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil. -A number as third arg means request confirmation if NEWNAME already exists. -This is what happens in interactive use with M-x. -Always sets the file modes of the output file to match the input file. + +This function always sets the file modes of the output file to match +the input file. + +The optional third argument OK-IF-ALREADY-EXISTS specifies what to do +if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we +signal a `file-already-exists' error without overwriting. If +OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user +about overwriting; this is what happens in interactive use with M-x. +Any other value for OK-IF-ALREADY-EXISTS means to overwrite the +existing file. Fourth arg KEEP-TIME non-nil means give the output file the same last-modified time as the old one. (This works on only some systems.) A prefix arg makes KEEP-TIME non-nil. -The optional fifth arg MUSTBENEW, if non-nil, insists on a check -for an existing file with the same name. If MUSTBENEW is `excl', -that means to get an error if the file already exists; never overwrite. -If MUSTBENEW is neither nil nor `excl', that means ask for -confirmation before overwriting, but do go ahead and overwrite the file -if the user confirms. - If PRESERVE-UID-GID is non-nil, we try to transfer the uid and gid of FILE to NEWNAME. */) - (file, newname, ok_if_already_exists, keep_time, mustbenew, preserve_uid_gid) - Lisp_Object file, newname, ok_if_already_exists, keep_time, mustbenew; + (file, newname, ok_if_already_exists, keep_time, preserve_uid_gid) + Lisp_Object file, newname, ok_if_already_exists, keep_time; Lisp_Object preserve_uid_gid; { int ifd, ofd, n; @@ -2448,9 +2450,6 @@ uid and gid of FILE to NEWNAME. */) CHECK_STRING (file); CHECK_STRING (newname); - if (!NILP (mustbenew) && !EQ (mustbenew, Qexcl)) - barf_or_query_if_file_exists (newname, "overwrite", 1, 0, 1); - if (!NILP (Ffile_directory_p (newname))) newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname); else @@ -2553,12 +2552,12 @@ uid and gid of FILE to NEWNAME. */) /* System's default file type was set to binary by _fmode in emacs.c. */ ofd = emacs_open (SDATA (encoded_newname), O_WRONLY | O_TRUNC | O_CREAT - | (EQ (mustbenew, Qexcl) ? O_EXCL : 0), + | (NILP (ok_if_already_exists) ? O_EXCL : 0), S_IREAD | S_IWRITE); #else /* not MSDOS */ ofd = emacs_open (SDATA (encoded_newname), O_WRONLY | O_TRUNC | O_CREAT - | (EQ (mustbenew, Qexcl) ? O_EXCL : 0), + | (NILP (ok_if_already_exists) ? O_EXCL : 0), 0666); #endif /* not MSDOS */ #endif /* VMS */ @@ -2726,8 +2725,10 @@ int internal_delete_file (filename) Lisp_Object filename; { - return NILP (internal_condition_case_1 (Fdelete_file, filename, - Qt, internal_delete_file_1)); + Lisp_Object tem; + tem = internal_condition_case_1 (Fdelete_file, filename, + Qt, internal_delete_file_1); + return NILP (tem); } DEFUN ("rename-file", Frename_file, Srename_file, 2, 3, @@ -2801,7 +2802,7 @@ This is what happens in interactive use with M-x. */) /* 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, Qnil, Qt); + Qt, Qt); Fdelete_file (file); } @@ -3388,8 +3389,10 @@ searchable directory. */) } DEFUN ("file-regular-p", Ffile_regular_p, Sfile_regular_p, 1, 1, 0, - doc: /* Return t if file FILENAME is the name of a regular file. -This is the sort of file that holds an ordinary stream of data bytes. */) + doc: /* Return t if FILENAME names a regular file. +This is the sort of file that holds an ordinary stream of data bytes. +Symbolic links to regular files count as regular files. +See `file-symlink-p' to distinguish symlinks. */) (filename) Lisp_Object filename; { @@ -3759,7 +3762,7 @@ actually used. */) unsigned char buffer[1 << 14]; int replace_handled = 0; int set_coding_system = 0; - int coding_system_decided = 0; + Lisp_Object coding_system; int read_quit = 0; Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark; int we_locked_file = 0; @@ -3779,6 +3782,10 @@ actually used. */) CHECK_STRING (filename); filename = Fexpand_file_name (filename, Qnil); + /* The value Qnil means that the coding system is not yet + decided. */ + coding_system = Qnil; + /* If the file name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (filename, Qinsert_file_contents); @@ -3903,27 +3910,18 @@ actually used. */) if (EQ (Vcoding_system_for_read, Qauto_save_coding)) { - /* We use emacs-mule for auto saving... */ - setup_coding_system (Qemacs_mule, &coding); - /* ... but with the special flag to indicate to read in a - multibyte sequence for eight-bit-control char as is. */ - coding.flags = 1; - coding.src_multibyte = 0; - coding.dst_multibyte - = !NILP (current_buffer->enable_multibyte_characters); - coding.eol_type = CODING_EOL_LF; - coding_system_decided = 1; + coding_system = Qutf_8_emacs; + setup_coding_system (coding_system, &coding); + /* Ensure we set Vlast_coding_system_used. */ + set_coding_system = 1; } else if (BEG < Z) { /* Decide the coding system to use for reading the file now because we can't use an optimized method for handling `coding:' tag if the current buffer is not empty. */ - Lisp_Object val; - val = Qnil; - if (!NILP (Vcoding_system_for_read)) - val = Vcoding_system_for_read; + coding_system = Vcoding_system_for_read; else { /* Don't try looking inside a file for a coding system @@ -3979,8 +3977,8 @@ actually used. */) insert_1_both (read_buf, nread, nread, 0, 0, 0); TEMP_SET_PT_BOTH (BEG, BEG_BYTE); - val = call2 (Vset_auto_coding_function, - filename, make_number (nread)); + coding_system = call2 (Vset_auto_coding_function, + filename, make_number (nread)); set_buffer_internal (prev); /* Discard the unwind protect for recovering the @@ -3994,34 +3992,33 @@ actually used. */) } } - if (NILP (val)) + if (NILP (coding_system)) { /* If we have not yet decided a coding system, check file-coding-system-alist. */ - Lisp_Object args[6], coding_systems; + Lisp_Object args[6]; args[0] = Qinsert_file_contents, args[1] = orig_filename; args[2] = visit, args[3] = beg, args[4] = end, args[5] = replace; - coding_systems = Ffind_operation_coding_system (6, args); - if (CONSP (coding_systems)) - val = XCAR (coding_systems); + coding_system = Ffind_operation_coding_system (6, args); + if (CONSP (coding_system)) + coding_system = XCAR (coding_system); } } - setup_coding_system (Fcheck_coding_system (val), &coding); - /* Ensure we set Vlast_coding_system_used. */ - set_coding_system = 1; + if (NILP (coding_system)) + coding_system = Qundecided; + else + CHECK_CODING_SYSTEM (coding_system); - if (NILP (current_buffer->enable_multibyte_characters) - && ! NILP (val)) + if (NILP (current_buffer->enable_multibyte_characters)) /* We must suppress all character code conversion except for end-of-line conversion. */ - setup_raw_text_coding_system (&coding); + coding_system = raw_text_coding_system (coding_system); - coding.src_multibyte = 0; - coding.dst_multibyte - = !NILP (current_buffer->enable_multibyte_characters); - coding_system_decided = 1; + setup_coding_system (coding_system, &coding); + /* Ensure we set Vlast_coding_system_used. */ + set_coding_system = 1; } /* If requested, replace the accessible part of the buffer @@ -4040,7 +4037,8 @@ actually used. */) and let the following if-statement handle the replace job. */ if (!NILP (replace) && BEGV < ZV - && !(coding.common_flags & CODING_REQUIRE_DECODING_MASK)) + && (NILP (coding_system) + || ! CODING_REQUIRE_DECODING (&coding))) { /* same_at_start and same_at_end count bytes, because file access counts bytes @@ -4075,21 +4073,15 @@ actually used. */) else if (nread == 0) break; - if (coding.type == coding_type_undecided) - detect_coding (&coding, buffer, nread); - if (coding.common_flags & CODING_REQUIRE_DECODING_MASK) - /* We found that the file should be decoded somehow. - Let's give up here. */ + if (CODING_REQUIRE_DETECTION (&coding)) { - giveup_match_end = 1; - break; + coding_system = detect_coding_system (buffer, nread, nread, 1, 0, + coding_system); + setup_coding_system (coding_system, &coding); } - if (coding.eol_type == CODING_EOL_UNDECIDED) - detect_eol (&coding, buffer, nread); - if (coding.eol_type != CODING_EOL_UNDECIDED - && coding.eol_type != CODING_EOL_LF) - /* We found that the format of eol should be decoded. + if (CODING_REQUIRE_DECODING (&coding)) + /* We found that the file should be decoded somehow. Let's give up here. */ { giveup_match_end = 1; @@ -4234,127 +4226,108 @@ actually used. */) { int same_at_start = BEGV_BYTE; int same_at_end = ZV_BYTE; + int same_at_start_charpos; + int inserted_chars; int overlap; int bufpos; - /* Make sure that the gap is large enough. */ - int bufsize = 2 * st.st_size; - unsigned char *conversion_buffer = (unsigned char *) xmalloc (bufsize); + unsigned char *decoded; int temp; + int this_count = SPECPDL_INDEX (); + int multibyte = ! NILP (current_buffer->enable_multibyte_characters); + Lisp_Object conversion_buffer; + + conversion_buffer = code_conversion_save (1, multibyte); /* First read the whole file, performing code conversion into CONVERSION_BUFFER. */ if (lseek (fd, XINT (beg), 0) < 0) - { - xfree (conversion_buffer); - report_file_error ("Setting file position", - Fcons (orig_filename, Qnil)); - } + report_file_error ("Setting file position", + Fcons (orig_filename, Qnil)); total = st.st_size; /* Total bytes in the file. */ how_much = 0; /* Bytes read from file so far. */ inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */ unprocessed = 0; /* Bytes not processed in previous loop. */ + GCPRO1 (conversion_buffer); while (how_much < total) { + /* We read one bunch by one (READ_BUF_SIZE bytes) to allow + quitting while reading a huge while. */ /* try is reserved in some compilers (Microsoft C) */ int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed); - unsigned char *destination = read_buf + unprocessed; int this; /* Allow quitting out of the actual I/O. */ immediate_quit = 1; QUIT; - this = emacs_read (fd, destination, trytry); + this = emacs_read (fd, read_buf + unprocessed, trytry); immediate_quit = 0; - if (this < 0 || this + unprocessed == 0) + if (this <= 0) { - how_much = this; + if (this < 0) + how_much = this; break; } how_much += this; - if (CODING_MAY_REQUIRE_DECODING (&coding)) - { - int require, result; - - this += unprocessed; - - /* If we are using more space than estimated, - make CONVERSION_BUFFER bigger. */ - require = decoding_buffer_size (&coding, this); - if (inserted + require + 2 * (total - how_much) > bufsize) - { - bufsize = inserted + require + 2 * (total - how_much); - conversion_buffer = (unsigned char *) xrealloc (conversion_buffer, bufsize); - } - - /* Convert this batch with results in CONVERSION_BUFFER. */ - if (how_much >= total) /* This is the last block. */ - coding.mode |= CODING_MODE_LAST_BLOCK; - if (coding.composing != COMPOSITION_DISABLED) - coding_allocate_composition_data (&coding, BEGV); - result = decode_coding (&coding, read_buf, - conversion_buffer + inserted, - this, bufsize - inserted); - - /* Save for next iteration whatever we didn't convert. */ - unprocessed = this - coding.consumed; - bcopy (read_buf + coding.consumed, read_buf, unprocessed); - if (!NILP (current_buffer->enable_multibyte_characters)) - this = coding.produced; - else - this = str_as_unibyte (conversion_buffer + inserted, - coding.produced); - } - - inserted += this; + BUF_SET_PT (XBUFFER (conversion_buffer), + BUF_Z (XBUFFER (conversion_buffer))); + decode_coding_c_string (&coding, read_buf, unprocessed + this, + conversion_buffer); + unprocessed = coding.carryover_bytes; + if (coding.carryover_bytes > 0) + bcopy (coding.carryover, read_buf, unprocessed); } + UNGCPRO; + emacs_close (fd); - /* At this point, INSERTED is how many characters (i.e. bytes) - are present in CONVERSION_BUFFER. - HOW_MUCH should equal TOTAL, - or should be <= 0 if we couldn't read the file. */ + /* At this point, HOW_MUCH should equal TOTAL, or should be <= 0 + if we couldn't read the file. */ if (how_much < 0) + error ("IO error reading %s: %s", + SDATA (orig_filename), emacs_strerror (errno)); + + if (unprocessed > 0) { - xfree (conversion_buffer); - coding_free_composition_data (&coding); - if (how_much == -1) - error ("IO error reading %s: %s", - SDATA (orig_filename), emacs_strerror (errno)); - else if (how_much == -2) - error ("maximum buffer size exceeded"); + coding.mode |= CODING_MODE_LAST_BLOCK; + decode_coding_c_string (&coding, read_buf, unprocessed, + conversion_buffer); + coding.mode &= ~CODING_MODE_LAST_BLOCK; } - /* Compare the beginning of the converted file - with the buffer text. */ + decoded = BUF_BEG_ADDR (XBUFFER (conversion_buffer)); + inserted = (BUF_Z_BYTE (XBUFFER (conversion_buffer)) + - BUF_BEG_BYTE (XBUFFER (conversion_buffer))); + + /* Compare the beginning of the converted string with the buffer + text. */ bufpos = 0; while (bufpos < inserted && same_at_start < same_at_end - && FETCH_BYTE (same_at_start) == conversion_buffer[bufpos]) + && FETCH_BYTE (same_at_start) == decoded[bufpos]) same_at_start++, bufpos++; - /* If the file matches the buffer completely, + /* If the file matches the head of buffer completely, there's no need to replace anything. */ if (bufpos == inserted) { - xfree (conversion_buffer); - coding_free_composition_data (&coding); - emacs_close (fd); specpdl_ptr--; /* Truncate the buffer to the size of the file. */ del_range_byte (same_at_start, same_at_end, 0); inserted = 0; + + unbind_to (this_count, Qnil); goto handled; } - /* Extend the start of non-matching text area to multibyte - character boundary. */ + /* Extend the start of non-matching text area to the previous + multibyte character boundary. */ if (! NILP (current_buffer->enable_multibyte_characters)) while (same_at_start > BEGV_BYTE && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start))) @@ -4367,11 +4340,11 @@ actually used. */) /* Compare with same_at_start to avoid counting some buffer text as matching both at the file's beginning and at the end. */ while (bufpos > 0 && same_at_end > same_at_start - && FETCH_BYTE (same_at_end - 1) == conversion_buffer[bufpos - 1]) + && FETCH_BYTE (same_at_end - 1) == decoded[bufpos - 1]) same_at_end--, bufpos--; - /* Extend the end of non-matching text area to multibyte - character boundary. */ + /* Extend the end of non-matching text area to the next + multibyte character boundary. */ if (! NILP (current_buffer->enable_multibyte_characters)) while (same_at_end < ZV_BYTE && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end))) @@ -4389,7 +4362,7 @@ actually used. */) /* Replace the chars that we need to replace, and update INSERTED to equal the number of bytes - we are taking from the file. */ + we are taking from the decoded string. */ inserted -= (ZV_BYTE - same_at_end) + (same_at_start - BEGV_BYTE); if (same_at_end != same_at_start) @@ -4404,18 +4377,21 @@ actually used. */) } /* Insert from the file at the proper position. */ SET_PT_BOTH (temp, same_at_start); - insert_1 (conversion_buffer + same_at_start - BEGV_BYTE, inserted, - 0, 0, 0); - if (coding.cmp_data && coding.cmp_data->used) - coding_restore_composition (&coding, Fcurrent_buffer ()); - coding_free_composition_data (&coding); - + same_at_start_charpos + = buf_bytepos_to_charpos (XBUFFER (conversion_buffer), + same_at_start); + inserted_chars + = (buf_bytepos_to_charpos (XBUFFER (conversion_buffer), + same_at_start + inserted) + - same_at_start_charpos); + insert_from_buffer (XBUFFER (conversion_buffer), + same_at_start_charpos, inserted_chars, 0); /* Set `inserted' to the number of inserted characters. */ inserted = PT - temp; + /* Set point before the inserted characters. */ + SET_PT_BOTH (temp, same_at_start); - xfree (conversion_buffer); - emacs_close (fd); - specpdl_ptr--; + unbind_to (this_count, Qnil); goto handled; } @@ -4468,7 +4444,7 @@ actually used. */) inserted = 0; /* Here, we don't do code conversion in the loop. It is done by - code_convert_region after all data are read into the buffer. */ + decode_coding_gap after all data are read into the buffer. */ { int gap_size = GAP_SIZE; @@ -4546,6 +4522,8 @@ actually used. */) #endif Vdeactivate_mark = old_Vdeactivate_mark; } + else + Vdeactivate_mark = Qt; /* Make the text read part of the buffer. */ GAP_SIZE -= inserted; @@ -4571,104 +4549,98 @@ actually used. */) notfound: - if (! coding_system_decided) + if (NILP (coding_system)) { /* The coding system is not yet decided. Decide it by an optimized method for handling `coding:' tag. Note that we can get here only if the buffer was empty before the insertion. */ - Lisp_Object val; - val = Qnil; if (!NILP (Vcoding_system_for_read)) - val = Vcoding_system_for_read; + coding_system = Vcoding_system_for_read; else { /* Since we are sure that the current buffer was empty before the insertion, we can toggle enable-multibyte-characters directly here without taking - care of marker adjustment and byte combining problem. By - this way, we can run Lisp program safely before decoding - the inserted text. */ + care of marker adjustment. By this way, we can run Lisp + program safely before decoding the inserted text. */ Lisp_Object unwind_data; int count = SPECPDL_INDEX (); unwind_data = Fcons (current_buffer->enable_multibyte_characters, Fcons (current_buffer->undo_list, Fcurrent_buffer ())); - current_buffer->enable_multibyte_characters = Qnil; + current_buffer->enable_multibyte_characters = Qnil; current_buffer->undo_list = Qt; record_unwind_protect (decide_coding_unwind, unwind_data); if (inserted > 0 && ! NILP (Vset_auto_coding_function)) { - val = call2 (Vset_auto_coding_function, - filename, make_number (inserted)); + coding_system = call2 (Vset_auto_coding_function, + filename, make_number (inserted)); } - if (NILP (val)) + if (NILP (coding_system)) { /* If the coding system is not yet decided, check file-coding-system-alist. */ - Lisp_Object args[6], coding_systems; + Lisp_Object args[6]; args[0] = Qinsert_file_contents, args[1] = orig_filename; args[2] = visit, args[3] = beg, args[4] = end, args[5] = Qnil; - coding_systems = Ffind_operation_coding_system (6, args); - if (CONSP (coding_systems)) - val = XCAR (coding_systems); + coding_system = Ffind_operation_coding_system (6, args); + if (CONSP (coding_system)) + coding_system = XCAR (coding_system); } unbind_to (count, Qnil); inserted = Z_BYTE - BEG_BYTE; } - /* The following kludgy code is to avoid some compiler bug. - We can't simply do - setup_coding_system (val, &coding); - on some system. */ - { - struct coding_system temp_coding; - setup_coding_system (Fcheck_coding_system (val), &temp_coding); - bcopy (&temp_coding, &coding, sizeof coding); - } - /* Ensure we set Vlast_coding_system_used. */ - set_coding_system = 1; + if (NILP (coding_system)) + coding_system = Qundecided; + else + CHECK_CODING_SYSTEM (coding_system); - if (NILP (current_buffer->enable_multibyte_characters) - && ! NILP (val)) + if (NILP (current_buffer->enable_multibyte_characters)) /* We must suppress all character code conversion except for end-of-line conversion. */ - setup_raw_text_coding_system (&coding); - coding.src_multibyte = 0; - coding.dst_multibyte - = !NILP (current_buffer->enable_multibyte_characters); + coding_system = raw_text_coding_system (coding_system); + setup_coding_system (coding_system, &coding); + /* Ensure we set Vlast_coding_system_used. */ + set_coding_system = 1; } - if (!NILP (visit) - /* Can't do this if part of the buffer might be preserved. */ - && NILP (replace) - && (coding.type == coding_type_no_conversion - || coding.type == coding_type_raw_text)) + if (!NILP (visit)) { - /* Visiting a file with these coding system makes the buffer - unibyte. */ - current_buffer->enable_multibyte_characters = Qnil; - coding.dst_multibyte = 0; + /* When we visit a file by raw-text, we change the buffer to + unibyte. */ + if (CODING_FOR_UNIBYTE (&coding) + /* Can't do this if part of the buffer might be preserved. */ + && NILP (replace)) + /* Visiting a file with these coding system makes the buffer + unibyte. */ + current_buffer->enable_multibyte_characters = Qnil; } - if (inserted > 0 || coding.type == coding_type_ccl) + coding.dst_multibyte = ! NILP (current_buffer->enable_multibyte_characters); + if (CODING_MAY_REQUIRE_DECODING (&coding) + && (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding))) { - if (CODING_MAY_REQUIRE_DECODING (&coding)) - { - code_convert_region (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted, - &coding, 0, 0); - inserted = coding.produced_char; - } - else - adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted, - inserted); + move_gap_both (PT, PT_BYTE); + GAP_SIZE += inserted; + ZV_BYTE -= inserted; + Z_BYTE -= inserted; + ZV -= inserted; + Z -= inserted; + decode_coding_gap (&coding, inserted, inserted); + inserted = coding.produced_char; + coding_system = CODING_ID_NAME (coding.id); } + else if (inserted > 0) + adjust_after_insert (PT, PT_BYTE, PT + inserted, PT_BYTE + inserted, + inserted); /* Now INSERTED is measured in characters. */ @@ -4676,8 +4648,8 @@ actually used. */) /* Use the conversion type to determine buffer-file-type (find-buffer-file-type is now used to help determine the conversion). */ - if ((coding.eol_type == CODING_EOL_UNDECIDED - || coding.eol_type == CODING_EOL_LF) + if ((VECTORP (CODING_ID_EOL_TYPE (coding.id)) + || EQ (CODING_ID_EOL_TYPE (coding.id), Qunix)) && ! CODING_REQUIRE_DECODING (&coding)) current_buffer->buffer_file_type = Qt; else @@ -4718,7 +4690,7 @@ actually used. */) } if (set_coding_system) - Vlast_coding_system_used = coding.symbol; + Vlast_coding_system_used = coding_system; if (! NILP (Ffboundp (Qafter_insert_file_set_coding))) { @@ -4797,8 +4769,6 @@ actually used. */) } static Lisp_Object build_annotations P_ ((Lisp_Object, Lisp_Object)); -static Lisp_Object build_annotations_2 P_ ((Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object)); /* If build_annotations switched buffers, switch back to BUF. Kill the temporary buffer that was selected in the meantime. @@ -4823,7 +4793,7 @@ build_annotations_unwind (buf) /* Decide the coding-system to encode the data with. */ -void +static Lisp_Object choose_write_coding_system (start, end, filename, append, visit, lockname, coding) Lisp_Object start, end, filename, append, visit, lockname; @@ -4834,14 +4804,7 @@ choose_write_coding_system (start, end, filename, if (auto_saving && NILP (Fstring_equal (current_buffer->filename, current_buffer->auto_save_file_name))) - { - /* We use emacs-mule for auto saving... */ - setup_coding_system (Qemacs_mule, coding); - /* ... but with the special flag to indicate not to strip off - leading code of eight-bit-control chars. */ - coding->flags = 1; - goto done_setup_coding; - } + val = Qutf_8_emacs; else if (!NILP (Vcoding_system_for_write)) { val = Vcoding_system_for_write; @@ -4888,8 +4851,7 @@ choose_write_coding_system (start, end, filename, val = XCDR (coding_systems); } - if (NILP (val) - && !NILP (current_buffer->buffer_file_coding_system)) + if (NILP (val)) { /* If we still have not decided a coding system, use the default value of buffer-file-coding-system. */ @@ -4897,43 +4859,42 @@ choose_write_coding_system (start, end, filename, using_default_coding = 1; } + if (! NILP (val) && ! force_raw_text) + { + Lisp_Object spec, attrs; + + CHECK_CODING_SYSTEM_GET_SPEC (val, spec); + attrs = AREF (spec, 0); + if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text)) + force_raw_text = 1; + } + if (!force_raw_text && !NILP (Ffboundp (Vselect_safe_coding_system_function))) /* Confirm that VAL can surely encode the current region. */ val = call5 (Vselect_safe_coding_system_function, start, end, val, Qnil, filename); - setup_coding_system (Fcheck_coding_system (val), coding); - if (coding->eol_type == CODING_EOL_UNDECIDED - && !using_default_coding) - { - if (! EQ (default_buffer_file_coding.symbol, - buffer_defaults.buffer_file_coding_system)) - setup_coding_system (buffer_defaults.buffer_file_coding_system, - &default_buffer_file_coding); - if (default_buffer_file_coding.eol_type != CODING_EOL_UNDECIDED) - { - Lisp_Object subsidiaries; - - coding->eol_type = default_buffer_file_coding.eol_type; - subsidiaries = Fget (coding->symbol, Qeol_type); - if (VECTORP (subsidiaries) - && XVECTOR (subsidiaries)->size == 3) - coding->symbol - = XVECTOR (subsidiaries)->contents[coding->eol_type]; - } - } + /* If the decided coding-system doesn't specify end-of-line + format, we use that of + `default-buffer-file-coding-system'. */ + if (! using_default_coding + && ! NILP (buffer_defaults.buffer_file_coding_system)) + val = (coding_inherit_eol_type + (val, buffer_defaults.buffer_file_coding_system)); + /* If we decide not to encode text, use `raw-text' or one of its + subsidiaries. */ if (force_raw_text) - setup_raw_text_coding_system (coding); - goto done_setup_coding; + val = raw_text_coding_system (val); } - setup_coding_system (Fcheck_coding_system (val), coding); + val = coding_inherit_eol_type (val, Qnil); + setup_coding_system (val, coding); - done_setup_coding: if (!STRINGP (start) && !NILP (current_buffer->selective_display)) coding->mode |= CODING_MODE_SELECTIVE_DISPLAY; + return val; } DEFUN ("write-region", Fwrite_region, Swrite_region, 3, 7, @@ -4978,7 +4939,6 @@ This does code conversion according to the value of int save_errno = 0; const unsigned char *fn; struct stat st; - int tem; int count = SPECPDL_INDEX (); int count1; #ifdef VMS @@ -5003,6 +4963,7 @@ This does code conversion according to the value of if (!NILP (start) && !STRINGP (start)) validate_region (&start, &end); + visit_file = Qnil; GCPRO5 (start, filename, visit, visit_file, lockname); filename = Fexpand_file_name (filename, Qnil); @@ -5077,21 +5038,9 @@ This does code conversion according to the value of We used to make this choice before calling build_annotations, but that leads to problems when a write-annotate-function takes care of unsavable chars (as was the case with X-Symbol). */ - choose_write_coding_system (start, end, filename, - append, visit, lockname, &coding); - Vlast_coding_system_used = coding.symbol; - - given_buffer = current_buffer; - if (! STRINGP (start)) - { - annotations = build_annotations_2 (start, end, - coding.pre_write_conversion, annotations); - if (current_buffer != given_buffer) - { - XSETFASTINT (start, BEGV); - XSETFASTINT (end, ZV); - } - } + Vlast_coding_system_used + = choose_write_coding_system (start, end, filename, + append, visit, lockname, &coding); #ifdef CLASH_DETECTION if (!auto_saving) @@ -5229,6 +5178,9 @@ This does code conversion according to the value of if (GPT > BEG && GPT_ADDR[-1] != '\n') move_gap (find_next_newline (GPT, 1)); #else +#if 0 + /* The new encoding routine doesn't require the following. */ + /* Whether VMS or not, we must move the gap to the next of newline when we must put designation sequences at beginning of line. */ if (INTEGERP (start) @@ -5241,6 +5193,7 @@ This does code conversion according to the value of move_gap_both (PT, PT_BYTE); SET_PT_BOTH (opoint, opoint_byte); } +#endif #endif failure = 0; @@ -5254,23 +5207,10 @@ This does code conversion according to the value of } else if (XINT (start) != XINT (end)) { - tem = CHAR_TO_BYTE (XINT (start)); - - if (XINT (start) < GPT) - { - failure = 0 > a_write (desc, Qnil, XINT (start), - min (GPT, XINT (end)) - XINT (start), - &annotations, &coding); - save_errno = errno; - } - - if (XINT (end) > GPT && !failure) - { - tem = max (XINT (start), GPT); - failure = 0 > a_write (desc, Qnil, tem , XINT (end) - tem, - &annotations, &coding); - save_errno = errno; - } + failure = 0 > a_write (desc, Qnil, + XINT (start), XINT (end) - XINT (start), + &annotations, &coding); + save_errno = errno; } else { @@ -5286,7 +5226,7 @@ This does code conversion according to the value of { /* We have to flush out a data. */ coding.mode |= CODING_MODE_LAST_BLOCK; - failure = 0 > e_write (desc, Qnil, 0, 0, &coding); + failure = 0 > e_write (desc, Qnil, 1, 1, &coding); save_errno = errno; } @@ -5297,7 +5237,7 @@ This does code conversion according to the value of Disk full in NFS may be reported here. */ /* 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) + if (!auto_saving && !write_region_inhibit_fsync && fsync (desc) < 0) { /* If fsync fails with EINTR, don't treat that as serious. */ if (errno != EINTR) @@ -5483,30 +5423,6 @@ build_annotations (start, end) return annotations; } -static Lisp_Object -build_annotations_2 (start, end, pre_write_conversion, annotations) - Lisp_Object start, end, pre_write_conversion, annotations; -{ - struct gcpro gcpro1; - Lisp_Object res; - - GCPRO1 (annotations); - /* At last, do the same for the function PRE_WRITE_CONVERSION - implied by the current coding-system. */ - if (!NILP (pre_write_conversion)) - { - struct buffer *given_buffer = current_buffer; - Vwrite_region_annotations_so_far = annotations; - res = call2 (pre_write_conversion, start, end); - Flength (res); - annotations = (current_buffer != given_buffer - ? res - : merge (annotations, res, Qcar_less_than_car)); - } - - UNGCPRO; - return annotations; -} /* Write to descriptor DESC the NCHARS chars starting at POS of STRING. If STRING is nil, POS is the character position in the current buffer. @@ -5562,9 +5478,6 @@ a_write (desc, string, pos, nchars, annot, coding) return 0; } -#ifndef WRITE_BUF_SIZE -#define WRITE_BUF_SIZE (16 * 1024) -#endif /* Write text in the range START and END into descriptor DESC, encoding them with coding system CODING. If STRING is nil, START @@ -5578,78 +5491,77 @@ e_write (desc, string, start, end, coding) int start, end; struct coding_system *coding; { - register char *addr; - register int nbytes; - char buf[WRITE_BUF_SIZE]; - int return_val = 0; - - if (start >= end) - coding->composing = COMPOSITION_DISABLED; - if (coding->composing != COMPOSITION_DISABLED) - coding_save_composition (coding, start, end, string); - if (STRINGP (string)) { - addr = SDATA (string); - nbytes = SBYTES (string); - coding->src_multibyte = STRING_MULTIBYTE (string); - } - else if (start < end) - { - /* It is assured that the gap is not in the range START and END-1. */ - addr = CHAR_POS_ADDR (start); - nbytes = CHAR_TO_BYTE (end) - CHAR_TO_BYTE (start); - coding->src_multibyte - = !NILP (current_buffer->enable_multibyte_characters); - } - else - { - addr = ""; - nbytes = 0; - coding->src_multibyte = 1; + start = 0; + end = SCHARS (string); } /* We used to have a code for handling selective display here. But, now it is handled within encode_coding. */ - while (1) - { - int result; - result = encode_coding (coding, addr, buf, nbytes, WRITE_BUF_SIZE); - if (coding->produced > 0) + while (start < end) + { + if (STRINGP (string)) { - coding->produced -= emacs_write (desc, buf, coding->produced); - if (coding->produced) + coding->src_multibyte = SCHARS (string) < SBYTES (string); + if (CODING_REQUIRE_ENCODING (coding)) { - return_val = -1; - break; + encode_coding_object (coding, string, + start, string_char_to_byte (string, start), + end, string_char_to_byte (string, end), Qt); + } + else + { + coding->dst_object = string; + coding->consumed_char = SCHARS (string); + coding->produced = SBYTES (string); } } - nbytes -= coding->consumed; - addr += coding->consumed; - if (result == CODING_FINISH_INSUFFICIENT_SRC - && nbytes > 0) + else { - /* The source text ends by an incomplete multibyte form. - There's no way other than write it out as is. */ - nbytes -= emacs_write (desc, addr, nbytes); - if (nbytes) + int start_byte = CHAR_TO_BYTE (start); + int end_byte = CHAR_TO_BYTE (end); + + coding->src_multibyte = (end - start) < (end_byte - start_byte); + if (CODING_REQUIRE_ENCODING (coding)) { - return_val = -1; - break; + encode_coding_object (coding, Fcurrent_buffer (), + start, start_byte, end, end_byte, Qt); + } + else + { + coding->dst_object = Qnil; + coding->dst_pos_byte = start_byte; + if (start >= GPT || end <= GPT) + { + coding->consumed_char = end - start; + coding->produced = end_byte - start_byte; + } + else + { + coding->consumed_char = GPT - start; + coding->produced = GPT_BYTE - start_byte; + } } } - if (nbytes <= 0) - break; + + if (coding->produced > 0) + { + coding->produced -= + emacs_write (desc, + STRINGP (coding->dst_object) + ? SDATA (coding->dst_object) + : BYTE_POS_ADDR (coding->dst_pos_byte), + coding->produced); + + if (coding->produced) + return -1; + } start += coding->consumed_char; - if (coding->cmp_data) - coding_adjust_composition_offset (coding, start); } - if (coding->cmp_data) - coding_free_composition_data (coding); - - return return_val; + return 0; } DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, @@ -5768,6 +5680,8 @@ auto_save_error (error) Lisp_Object args[3], msg; int i, nbytes; struct gcpro gcpro1; + char *msgbuf; + USE_SAFE_ALLOCA; ring_bell (); @@ -5777,16 +5691,19 @@ auto_save_error (error) msg = Fformat (3, args); GCPRO1 (msg); nbytes = SBYTES (msg); + SAFE_ALLOCA (msgbuf, char *, nbytes); + bcopy (SDATA (msg), msgbuf, nbytes); for (i = 0; i < 3; ++i) { if (i == 0) - message2 (SDATA (msg), nbytes, STRING_MULTIBYTE (msg)); + message2 (msgbuf, nbytes, STRING_MULTIBYTE (msg)); else - message2_nolog (SDATA (msg), nbytes, STRING_MULTIBYTE (msg)); + message2_nolog (msgbuf, nbytes, STRING_MULTIBYTE (msg)); Fsleep_for (make_number (1), Qnil); } + SAFE_FREE (); UNGCPRO; return Qnil; } @@ -5818,13 +5735,13 @@ auto_save_1 () } static Lisp_Object -do_auto_save_unwind (stream) /* used as unwind-protect function */ - Lisp_Object stream; +do_auto_save_unwind (arg) /* used as unwind-protect function */ + Lisp_Object arg; { + FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer; auto_saving = 0; - if (!NILP (stream)) - fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16 - | XFASTINT (XCDR (stream)))); + if (stream != NULL) + fclose (stream); return Qnil; } @@ -5869,8 +5786,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) int auto_saved = 0; int do_handled_files; Lisp_Object oquit; - FILE *stream; - Lisp_Object lispstream; + FILE *stream = NULL; int count = SPECPDL_INDEX (); int orig_minibuffer_auto_raise = minibuffer_auto_raise; int old_message_p = 0; @@ -5922,24 +5838,10 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) } stream = fopen (SDATA (listfile), "w"); - if (stream != NULL) - { - /* Arrange to close that file whether or not we get an error. - Also reset auto_saving to 0. */ - lispstream = Fcons (Qnil, Qnil); - XSETCARFASTINT (lispstream, (EMACS_UINT)stream >> 16); - XSETCDRFASTINT (lispstream, (EMACS_UINT)stream & 0xffff); - } - else - lispstream = Qnil; - } - else - { - stream = NULL; - lispstream = Qnil; } - record_unwind_protect (do_auto_save_unwind, lispstream); + record_unwind_protect (do_auto_save_unwind, + make_save_value (stream, 0)); record_unwind_protect (do_auto_save_unwind_1, make_number (minibuffer_auto_raise)); minibuffer_auto_raise = 0; @@ -6238,13 +6140,17 @@ DEFUN ("read-file-name-internal", Fread_file_name_internal, Sread_file_name_inte #endif { /* Must do it the hard (and slow) way. */ + Lisp_Object tem; GCPRO3 (all, comp, specdir); count = SPECPDL_INDEX (); record_unwind_protect (read_file_name_cleanup, current_buffer->directory); current_buffer->directory = realdir; for (comp = Qnil; CONSP (all); all = XCDR (all)) - if (!NILP (call1 (Vread_file_name_predicate, XCAR (all)))) - comp = Fcons (XCAR (all), comp); + { + tem = call1 (Vread_file_name_predicate, XCAR (all)); + if (!NILP (tem)) + comp = Fcons (XCAR (all), comp); + } unbind_to (count, Qnil); UNGCPRO; } @@ -6754,6 +6660,14 @@ shortly after Emacs reads your `.emacs' file, if you have not yet given it a non-nil value. */); Vauto_save_list_file_name = Qnil; +#ifdef HAVE_FSYNC + DEFVAR_BOOL ("write-region-inhibit-fsync", &write_region_inhibit_fsync, + doc: /* *Non-nil means don't call fsync in `write-region'. +This variable affects calls to `write-region' as well as save commands. +A non-nil value may result in data loss! */); + write_region_inhibit_fsync = 0; +#endif + defsubr (&Sfind_file_name_handler); defsubr (&Sfile_name_directory); defsubr (&Sfile_name_nondirectory);