# HG changeset patch # User Karl Heuer # Date 856639892 0 # Node ID a9f1f08212ec38625aed483a69abc2d8fccfee17 # Parent bc9a4db95edbdfdead48a747bcd794068a0997da Include charset.h and coding.h. (READ_BUF_SIZE): New macro. (Finsert_file_contents): Refer to a coding system in the docstring. Perform character code conversion of a text read in. (Fwrite_region): Refer to a coding system in the docstring. Setup a coding system for character code conversion. Pass a new arg `pre_write_conversion' (Lisp function) to build_annotations. Pass a new arg `coding' to a_write. (build_annotations): Handle the new arg. (a_write): Handle the new arg `coding' by passing it to e_write. (WRITE_BUF_SIZE): New macro. (e_write): Perform character code conversion of a text to write out according to the new arg `coding'. diff -r bc9a4db95edb -r a9f1f08212ec src/fileio.c --- a/src/fileio.c Sat Feb 22 19:31:13 1997 +0000 +++ b/src/fileio.c Sat Feb 22 19:31:32 1997 +0000 @@ -92,6 +92,8 @@ #include "lisp.h" #include "intervals.h" #include "buffer.h" +#include "charset.h" +#include "coding.h" #include "window.h" #ifdef WINDOWSNT @@ -2987,6 +2989,10 @@ Lisp_Object Qfind_buffer_file_type; #endif /* DOS_NT */ +#ifndef READ_BUF_SIZE +#define READ_BUF_SIZE (64 << 10) +#endif + DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, 1, 5, 0, "Insert contents of file FILENAME after point.\n\ @@ -2994,7 +3000,7 @@ 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.\n\n\ +before the error is signaled.\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.\n\ @@ -3005,7 +3011,10 @@ the whole thing because (1) it preserves some marker positions\n\ and (2) it puts less data in the undo list.\n\ When REPLACE is non-nil, the value is the number of characters actually read,\n\ -which is often less than the number of characters to be read.") +which is often less than the number of characters to be read.\n\ +This does code conversion according to the value of\n\ + `coding-system-for-read' or `coding-system-alist', and sets the variable\n\ + `last-coding-system-used' to the coding system actually used.") (filename, visit, beg, end, replace) Lisp_Object filename, visit, beg, end, replace; { @@ -3013,12 +3022,15 @@ register int fd; register int inserted = 0; register int how_much; + register int unprocessed; int count = specpdl_ptr - specpdl; struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object handler, val, insval; Lisp_Object p; int total; int not_regular = 0; + char read_buf[READ_BUF_SIZE]; + struct coding_system coding; if (current_buffer->base_buffer && ! NILP (visit)) error ("Cannot do file visiting in an indirect buffer"); @@ -3044,6 +3056,21 @@ goto handled; } + /* Decide the coding-system of the file. */ + { + Lisp_Object val = Vcoding_system_for_read; + if (NILP (val)) + { + Lisp_Object args[6], coding_systems; + + args[0] = Qinsert_file_contents, args[1] = filename, args[2] = visit, + args[3] = beg, args[4] = end, args[5] = replace; + coding_systems = Ffind_coding_system (6, args); + val = CONSP (coding_systems) ? XCONS (coding_systems)->car : Qnil; + } + setup_coding_system (Fcheck_coding_system (val), &coding); + } + fd = -1; #ifndef APOLLO @@ -3114,21 +3141,23 @@ with the file contents. Avoid replacing text at the beginning or end of the buffer that matches the file contents; that preserves markers pointing to the unchanged parts. */ -#ifdef DOS_NT - /* On MSDOS, replace mode doesn't really work, except for binary files, - and it's not worth supporting just for them. */ - if (!NILP (replace)) + if (!NILP (replace) && CODING_REQUIRE_CONVERSION (&coding)) { + /* We have to decode the input, which means replace mode is + quite difficult. We give it up for the moment. */ replace = Qnil; del_range_1 (BEGV, ZV, 0); } -#else /* not DOS_NT */ if (!NILP (replace)) { unsigned char buffer[1 << 14]; int same_at_start = BEGV; int same_at_end = ZV; int overlap; + /* There is still a possibility we will find the need to do code + conversion. If that happens, we set this variable to 1 to + give up on the REPLACE feature. */ + int giveup_match_end = 0; if (XINT (beg) != 0) { @@ -3151,9 +3180,30 @@ XSTRING (filename)->data, strerror (errno)); else if (nread == 0) break; + + if (coding.type == coding_type_automatic) + detect_coding (&coding, buffer, nread); + if (CODING_REQUIRE_TEXT_CONVERSION (&coding)) + /* We found that the file should be decoded somehow. + Let's give up here. */ + { + giveup_match_end = 1; + break; + } + + if (coding.eol_type == CODING_EOL_AUTOMATIC) + detect_eol (&coding, buffer, nread); + if (CODING_REQUIRE_EOL_CONVERSION (&coding)) + /* We found that the format of eol should be decoded. + Let's give up here. */ + { + giveup_match_end = 1; + break; + } + bufpos = 0; while (bufpos < nread && same_at_start < ZV - && FETCH_CHAR (same_at_start) == buffer[bufpos]) + && FETCH_BYTE (same_at_start) == buffer[bufpos]) same_at_start++, bufpos++; /* If we found a discrepancy, stop the scan. Otherwise loop around and scan the next bufferful. */ @@ -3174,8 +3224,9 @@ immediate_quit = 1; QUIT; /* Count how many chars at the end of the file - match the text at the end of the buffer. */ - while (1) + match the text at the end of the buffer. But, if we have + already found that decoding is necessary, don't waste time. */ + while (!giveup_match_end) { int total_read, nread, bufpos, curpos, trial; @@ -3205,7 +3256,7 @@ /* 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_CHAR (same_at_end - 1) == buffer[bufpos - 1]) + && FETCH_BYTE (same_at_end - 1) == buffer[bufpos - 1]) same_at_end--, bufpos--; /* If we found a discrepancy, stop the scan. Otherwise loop around and scan the preceding bufferful. */ @@ -3231,7 +3282,6 @@ /* Insert from the file at the proper position. */ SET_PT (same_at_start); } -#endif /* not DOS_NT */ total = XINT (end) - XINT (beg); @@ -3257,32 +3307,81 @@ report_file_error ("Setting file position", Fcons (filename, Qnil)); } + /* In the following loop, HOW_MUCH contains the total bytes read so + far. Before exiting the loop, it is set to -1 if I/O error + occurs, set to -2 if the maximum buffer size is exceeded. */ how_much = 0; - while (inserted < total) + /* Total bytes inserted. */ + inserted = 0; + /* Bytes not processed in the previous loop because short gap size. */ + unprocessed = 0; + while (how_much < total) { /* try is reserved in some compilers (Microsoft C) */ - int trytry = min (total - inserted, 64 << 10); + int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed); + char *destination = (CODING_REQUIRE_CONVERSION (&coding) + ? read_buf + unprocessed + : (char *) (POS_ADDR (PT + inserted - 1) + 1)); int this; /* Allow quitting out of the actual I/O. */ immediate_quit = 1; QUIT; - this = read (fd, &FETCH_CHAR (PT + inserted - 1) + 1, trytry); + this = read (fd, destination, trytry); immediate_quit = 0; - if (this <= 0) + if (this < 0 || this + unprocessed == 0) { how_much = this; break; } + how_much += this; + + if (CODING_REQUIRE_CONVERSION (&coding)) + { + int require, produced, consumed; + + this += unprocessed; + /* Make sure that the gap is large enough. */ + require = decoding_buffer_size (&coding, this); + if (GAP_SIZE < require) + make_gap (require - GAP_SIZE); + if (how_much >= total) /* This is the last block. */ + coding.last_block = 1; + produced = decode_coding (&coding, read_buf, + POS_ADDR (PT + inserted - 1) + 1, + this, GAP_SIZE, &consumed); + if (produced > 0) + { + Lisp_Object temp; + + XSET (temp, Lisp_Int, Z + produced); + if (Z + produced != XINT (temp)) + { + how_much = -2; + break; + } + } + unprocessed = this - consumed; + bcopy (read_buf + consumed, read_buf, unprocessed); + this = produced; + } + GPT += this; GAP_SIZE -= this; ZV += this; Z += this; + if (GAP_SIZE > 0) + /* Put an anchor to ensure multi-byte form ends at gap. */ + *GPT_ADDR = 0; inserted += this; } + /* We don't have to consider file type of MSDOS because all files + are read as binary and end-of-line format has already been + decoded appropriately. */ +#if 0 #ifdef DOS_NT /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */ /* Determine file type from name and remove LFs from CR-LFs if the file @@ -3293,7 +3392,7 @@ if (NILP (current_buffer->buffer_file_type)) { int reduced_size - = inserted - crlf_to_lf (inserted, &FETCH_CHAR (PT - 1) + 1); + = inserted - crlf_to_lf (inserted, POS_ADDR (PT - 1) + 1); ZV -= reduced_size; Z -= reduced_size; GPT -= reduced_size; @@ -3302,6 +3401,7 @@ } } #endif /* DOS_NT */ +#endif /* 0 */ if (inserted > 0) { @@ -3317,9 +3417,11 @@ /* Discard the unwind protect for closing the file. */ specpdl_ptr--; - if (how_much < 0) + if (how_much == -1) error ("IO error reading %s: %s", XSTRING (filename)->data, strerror (errno)); + else if (how_much == -2) + error ("maximum buffer size exceeded"); notfound: handled: @@ -3374,6 +3476,9 @@ if (inserted > 0) { p = Vafter_insert_file_functions; + if (!NILP (coding.post_read_conversion)) + p = Fcons (coding.post_read_conversion, p); + while (!NILP (p)) { insval = call1 (Fcar (p), make_number (inserted)); @@ -3398,7 +3503,11 @@ static Lisp_Object build_annotations (); /* If build_annotations switched buffers, switch back to BUF. - Kill the temporary buffer that was selected in the meantime. */ + Kill the temporary buffer that was selected in the meantime. + + Since this kill only the last temporary buffer, some buffers remain + not killed if build_annotations switched buffers more than once. + -- K.Handa */ static Lisp_Object build_annotations_unwind (buf) @@ -3432,7 +3541,10 @@ The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\ use for locking and unlocking, overriding FILENAME and VISIT.\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.") +to the file, instead of any buffer contents, and END is ignored.\n\ +This does code conversion according to the value of\n\ + `coding-system-for-write' or `coding-system-alist', and sets the variable\n\ + `last-coding-system-used' to the coding system actually used.") (start, end, filename, append, visit, lockname) Lisp_Object start, end, filename, append, visit, lockname; { @@ -3457,6 +3569,7 @@ int buffer_file_type = NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY; #endif /* DOS_NT */ + struct coding_system coding; if (current_buffer->base_buffer && ! NILP (visit)) error ("Cannot do file visiting in an indirect buffer"); @@ -3505,6 +3618,38 @@ return val; } + /* Decide the coding-system to be encoded to. */ + { + Lisp_Object val; + + if (auto_saving) + val = Qnil; + else if (!NILP (Vcoding_system_for_write)) + val = Vcoding_system_for_write; + else if (!NILP (Flocal_variable_if_set_p (Qbuffer_file_coding_system, + Qnil))) + val = Fsymbol_value (Qbuffer_file_coding_system); + else + { + Lisp_Object args[7], coding_systems; + + args[0] = Qwrite_region, args[1] = start, args[2] = end, + args[3] = filename, args[4] = append, args[5] = visit, + args[6] = lockname; + coding_systems = Ffind_coding_system (7, args); + val = (CONSP (coding_systems) + ? XCONS (coding_systems)->cdr + : Fsymbol_value (Qbuffer_file_coding_system)); + } + setup_coding_system (Fcheck_coding_system (val), &coding); + if (!STRINGP (start) && !NILP (current_buffer->selective_display)) + coding.selective = 1; +#ifdef DOS_NT + if (!NILP (current_buffer->buffer_file_type)) + coding.eol_type = CODING_EOL_LF; +#endif /* DOS_NT */ + } + /* Special kludge to simplify auto-saving. */ if (NILP (start)) { @@ -3516,7 +3661,7 @@ count1 = specpdl_ptr - specpdl; given_buffer = current_buffer; - annotations = build_annotations (start, end); + annotations = build_annotations (start, end, coding.pre_write_conversion); if (current_buffer != given_buffer) { start = BEGV; @@ -3649,7 +3794,7 @@ if (STRINGP (start)) { failure = 0 > a_write (desc, XSTRING (start)->data, - XSTRING (start)->size, 0, &annotations); + XSTRING (start)->size, 0, &annotations, &coding); save_errno = errno; } else if (XINT (start) != XINT (end)) @@ -3659,8 +3804,9 @@ { register int end1 = XINT (end); tem = XINT (start); - failure = 0 > a_write (desc, &FETCH_CHAR (tem), - min (GPT, end1) - tem, tem, &annotations); + failure = 0 > a_write (desc, POS_ADDR (tem), + min (GPT, end1) - tem, tem, &annotations, + &coding); nwritten += min (GPT, end1) - tem; save_errno = errno; } @@ -3669,8 +3815,8 @@ { tem = XINT (start); tem = max (tem, GPT); - failure = 0 > a_write (desc, &FETCH_CHAR (tem), XINT (end) - tem, - tem, &annotations); + failure = 0 > a_write (desc, POS_ADDR (tem), XINT (end) - tem, + tem, &annotations, &coding); nwritten += XINT (end) - tem; save_errno = errno; } @@ -3678,7 +3824,15 @@ else { /* If file was empty, still need to write the annotations */ - failure = 0 > a_write (desc, "", 0, XINT (start), &annotations); + failure = 0 > a_write (desc, "", 0, XINT (start), &annotations, &coding); + save_errno = errno; + } + + if (coding.require_flushing) + { + /* We have to flush out a data. */ + coding.last_block = 1; + failure = 0 > e_write (desc, "", 0, &coding); save_errno = errno; } @@ -3787,8 +3941,8 @@ as save-excursion would do. */ static Lisp_Object -build_annotations (start, end) - Lisp_Object start, end; +build_annotations (start, end, pre_write_conversion) + Lisp_Object start, end, pre_write_conversion; { Lisp_Object annotations; Lisp_Object p, res; @@ -3842,6 +3996,24 @@ annotations = merge (annotations, res, Qcar_less_than_car); p = Fcdr (p); } + + /* 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); + if (current_buffer != given_buffer) + { + start = BEGV; + end = ZV; + annotations = Qnil; + } + Flength (res); + annotations = merge (annotations, res, Qcar_less_than_car); + } + UNGCPRO; return annotations; } @@ -3856,12 +4028,13 @@ The return value is negative in case of system call failure. */ int -a_write (desc, addr, len, pos, annot) +a_write (desc, addr, len, pos, annot, coding) int desc; register char *addr; register int len; int pos; Lisp_Object *annot; + struct coding_system *coding; { Lisp_Object tem; int nextpos; @@ -3873,10 +4046,10 @@ if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos) nextpos = XFASTINT (tem); else - return e_write (desc, addr, lastpos - pos); + return e_write (desc, addr, lastpos - pos, coding); if (nextpos > pos) { - if (0 > e_write (desc, addr, nextpos - pos)) + if (0 > e_write (desc, addr, nextpos - pos, coding)) return -1; addr += nextpos - pos; pos = nextpos; @@ -3884,43 +4057,50 @@ tem = Fcdr (Fcar (*annot)); if (STRINGP (tem)) { - if (0 > e_write (desc, XSTRING (tem)->data, XSTRING (tem)->size)) + if (0 > e_write (desc, XSTRING (tem)->data, XSTRING (tem)->size, + coding)) return -1; } *annot = Fcdr (*annot); } } +#ifndef WRITE_BUF_SIZE +#define WRITE_BUF_SIZE (16 * 1024) +#endif + int -e_write (desc, addr, len) +e_write (desc, addr, len, coding) int desc; register char *addr; register int len; + struct coding_system *coding; { - char buf[16 * 1024]; - register char *p, *end; - - if (!EQ (current_buffer->selective_display, Qt)) - return write (desc, addr, len) - len; - else + char buf[WRITE_BUF_SIZE]; + int produced, consumed; + + /* We used to have a code for handling selective display here. But, + now it is handled within encode_coding. */ + while (1) { - p = buf; - end = p + sizeof buf; - while (len--) + produced = encode_coding (coding, addr, buf, len, WRITE_BUF_SIZE, + &consumed); + len -= consumed, addr += consumed; + if (produced == 0 && len > 0) { - if (p == end) - { - if (write (desc, buf, sizeof buf) != sizeof buf) - return -1; - p = buf; - } - *p = *addr++; - if (*p++ == '\015') - p[-1] = '\n'; + /* There was a carry over because of invalid codes in the source. + We just write out them as is. */ + bcopy (addr, buf, len); + produced = len; + len = 0; } - if (p != buf) - if (write (desc, buf, p - buf) != p - buf) - return -1; + if (produced > 0) + { + produced -= write (desc, buf, produced); + if (produced) return -1; + } + if (len <= 0) + break; } return 0; }