diff options
| author | Karl Heuer | 1997-02-22 19:31:32 +0000 |
|---|---|---|
| committer | Karl Heuer | 1997-02-22 19:31:32 +0000 |
| commit | 6fdaa9a05da1a0dbcb26d70a10d7e8c109347a8e (patch) | |
| tree | 5753ac49b77110ac0752720fd49241d7be246ddc /src | |
| parent | 969f51456a70e530c0874093f404675a6d5fc82b (diff) | |
| download | emacs-6fdaa9a05da1a0dbcb26d70a10d7e8c109347a8e.tar.gz emacs-6fdaa9a05da1a0dbcb26d70a10d7e8c109347a8e.zip | |
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'.
Diffstat (limited to 'src')
| -rw-r--r-- | src/fileio.c | 288 |
1 files changed, 234 insertions, 54 deletions
diff --git a/src/fileio.c b/src/fileio.c index 9d7fa4aadd4..c7c0111dbad 100644 --- a/src/fileio.c +++ b/src/fileio.c | |||
| @@ -92,6 +92,8 @@ extern char *strerror (); | |||
| 92 | #include "lisp.h" | 92 | #include "lisp.h" |
| 93 | #include "intervals.h" | 93 | #include "intervals.h" |
| 94 | #include "buffer.h" | 94 | #include "buffer.h" |
| 95 | #include "charset.h" | ||
| 96 | #include "coding.h" | ||
| 95 | #include "window.h" | 97 | #include "window.h" |
| 96 | 98 | ||
| 97 | #ifdef WINDOWSNT | 99 | #ifdef WINDOWSNT |
| @@ -2987,6 +2989,10 @@ otherwise, if FILE2 does not exist, the answer is t.") | |||
| 2987 | Lisp_Object Qfind_buffer_file_type; | 2989 | Lisp_Object Qfind_buffer_file_type; |
| 2988 | #endif /* DOS_NT */ | 2990 | #endif /* DOS_NT */ |
| 2989 | 2991 | ||
| 2992 | #ifndef READ_BUF_SIZE | ||
| 2993 | #define READ_BUF_SIZE (64 << 10) | ||
| 2994 | #endif | ||
| 2995 | |||
| 2990 | DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, | 2996 | DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, |
| 2991 | 1, 5, 0, | 2997 | 1, 5, 0, |
| 2992 | "Insert contents of file FILENAME after point.\n\ | 2998 | "Insert contents of file FILENAME after point.\n\ |
| @@ -2994,7 +3000,7 @@ Returns list of absolute file name and length of data inserted.\n\ | |||
| 2994 | If second argument VISIT is non-nil, the buffer's visited filename\n\ | 3000 | If second argument VISIT is non-nil, the buffer's visited filename\n\ |
| 2995 | and last save file modtime are set, and it is marked unmodified.\n\ | 3001 | and last save file modtime are set, and it is marked unmodified.\n\ |
| 2996 | If visiting and the file does not exist, visiting is completed\n\ | 3002 | If visiting and the file does not exist, visiting is completed\n\ |
| 2997 | before the error is signaled.\n\n\ | 3003 | before the error is signaled.\n\ |
| 2998 | The optional third and fourth arguments BEG and END\n\ | 3004 | The optional third and fourth arguments BEG and END\n\ |
| 2999 | specify what portion of the file to insert.\n\ | 3005 | specify what portion of the file to insert.\n\ |
| 3000 | If VISIT is non-nil, BEG and END must be nil.\n\ | 3006 | If VISIT is non-nil, BEG and END must be nil.\n\ |
| @@ -3005,7 +3011,10 @@ with the file contents. This is better than simply deleting and inserting\n\ | |||
| 3005 | the whole thing because (1) it preserves some marker positions\n\ | 3011 | the whole thing because (1) it preserves some marker positions\n\ |
| 3006 | and (2) it puts less data in the undo list.\n\ | 3012 | and (2) it puts less data in the undo list.\n\ |
| 3007 | When REPLACE is non-nil, the value is the number of characters actually read,\n\ | 3013 | When REPLACE is non-nil, the value is the number of characters actually read,\n\ |
| 3008 | which is often less than the number of characters to be read.") | 3014 | which is often less than the number of characters to be read.\n\ |
| 3015 | This does code conversion according to the value of\n\ | ||
| 3016 | `coding-system-for-read' or `coding-system-alist', and sets the variable\n\ | ||
| 3017 | `last-coding-system-used' to the coding system actually used.") | ||
| 3009 | (filename, visit, beg, end, replace) | 3018 | (filename, visit, beg, end, replace) |
| 3010 | Lisp_Object filename, visit, beg, end, replace; | 3019 | Lisp_Object filename, visit, beg, end, replace; |
| 3011 | { | 3020 | { |
| @@ -3013,12 +3022,15 @@ which is often less than the number of characters to be read.") | |||
| 3013 | register int fd; | 3022 | register int fd; |
| 3014 | register int inserted = 0; | 3023 | register int inserted = 0; |
| 3015 | register int how_much; | 3024 | register int how_much; |
| 3025 | register int unprocessed; | ||
| 3016 | int count = specpdl_ptr - specpdl; | 3026 | int count = specpdl_ptr - specpdl; |
| 3017 | struct gcpro gcpro1, gcpro2, gcpro3; | 3027 | struct gcpro gcpro1, gcpro2, gcpro3; |
| 3018 | Lisp_Object handler, val, insval; | 3028 | Lisp_Object handler, val, insval; |
| 3019 | Lisp_Object p; | 3029 | Lisp_Object p; |
| 3020 | int total; | 3030 | int total; |
| 3021 | int not_regular = 0; | 3031 | int not_regular = 0; |
| 3032 | char read_buf[READ_BUF_SIZE]; | ||
| 3033 | struct coding_system coding; | ||
| 3022 | 3034 | ||
| 3023 | if (current_buffer->base_buffer && ! NILP (visit)) | 3035 | if (current_buffer->base_buffer && ! NILP (visit)) |
| 3024 | error ("Cannot do file visiting in an indirect buffer"); | 3036 | error ("Cannot do file visiting in an indirect buffer"); |
| @@ -3044,6 +3056,21 @@ which is often less than the number of characters to be read.") | |||
| 3044 | goto handled; | 3056 | goto handled; |
| 3045 | } | 3057 | } |
| 3046 | 3058 | ||
| 3059 | /* Decide the coding-system of the file. */ | ||
| 3060 | { | ||
| 3061 | Lisp_Object val = Vcoding_system_for_read; | ||
| 3062 | if (NILP (val)) | ||
| 3063 | { | ||
| 3064 | Lisp_Object args[6], coding_systems; | ||
| 3065 | |||
| 3066 | args[0] = Qinsert_file_contents, args[1] = filename, args[2] = visit, | ||
| 3067 | args[3] = beg, args[4] = end, args[5] = replace; | ||
| 3068 | coding_systems = Ffind_coding_system (6, args); | ||
| 3069 | val = CONSP (coding_systems) ? XCONS (coding_systems)->car : Qnil; | ||
| 3070 | } | ||
| 3071 | setup_coding_system (Fcheck_coding_system (val), &coding); | ||
| 3072 | } | ||
| 3073 | |||
| 3047 | fd = -1; | 3074 | fd = -1; |
| 3048 | 3075 | ||
| 3049 | #ifndef APOLLO | 3076 | #ifndef APOLLO |
| @@ -3114,21 +3141,23 @@ which is often less than the number of characters to be read.") | |||
| 3114 | with the file contents. Avoid replacing text at the | 3141 | with the file contents. Avoid replacing text at the |
| 3115 | beginning or end of the buffer that matches the file contents; | 3142 | beginning or end of the buffer that matches the file contents; |
| 3116 | that preserves markers pointing to the unchanged parts. */ | 3143 | that preserves markers pointing to the unchanged parts. */ |
| 3117 | #ifdef DOS_NT | 3144 | if (!NILP (replace) && CODING_REQUIRE_CONVERSION (&coding)) |
| 3118 | /* On MSDOS, replace mode doesn't really work, except for binary files, | ||
| 3119 | and it's not worth supporting just for them. */ | ||
| 3120 | if (!NILP (replace)) | ||
| 3121 | { | 3145 | { |
| 3146 | /* We have to decode the input, which means replace mode is | ||
| 3147 | quite difficult. We give it up for the moment. */ | ||
| 3122 | replace = Qnil; | 3148 | replace = Qnil; |
| 3123 | del_range_1 (BEGV, ZV, 0); | 3149 | del_range_1 (BEGV, ZV, 0); |
| 3124 | } | 3150 | } |
| 3125 | #else /* not DOS_NT */ | ||
| 3126 | if (!NILP (replace)) | 3151 | if (!NILP (replace)) |
| 3127 | { | 3152 | { |
| 3128 | unsigned char buffer[1 << 14]; | 3153 | unsigned char buffer[1 << 14]; |
| 3129 | int same_at_start = BEGV; | 3154 | int same_at_start = BEGV; |
| 3130 | int same_at_end = ZV; | 3155 | int same_at_end = ZV; |
| 3131 | int overlap; | 3156 | int overlap; |
| 3157 | /* There is still a possibility we will find the need to do code | ||
| 3158 | conversion. If that happens, we set this variable to 1 to | ||
| 3159 | give up on the REPLACE feature. */ | ||
| 3160 | int giveup_match_end = 0; | ||
| 3132 | 3161 | ||
| 3133 | if (XINT (beg) != 0) | 3162 | if (XINT (beg) != 0) |
| 3134 | { | 3163 | { |
| @@ -3151,9 +3180,30 @@ which is often less than the number of characters to be read.") | |||
| 3151 | XSTRING (filename)->data, strerror (errno)); | 3180 | XSTRING (filename)->data, strerror (errno)); |
| 3152 | else if (nread == 0) | 3181 | else if (nread == 0) |
| 3153 | break; | 3182 | break; |
| 3183 | |||
| 3184 | if (coding.type == coding_type_automatic) | ||
| 3185 | detect_coding (&coding, buffer, nread); | ||
| 3186 | if (CODING_REQUIRE_TEXT_CONVERSION (&coding)) | ||
| 3187 | /* We found that the file should be decoded somehow. | ||
| 3188 | Let's give up here. */ | ||
| 3189 | { | ||
| 3190 | giveup_match_end = 1; | ||
| 3191 | break; | ||
| 3192 | } | ||
| 3193 | |||
| 3194 | if (coding.eol_type == CODING_EOL_AUTOMATIC) | ||
| 3195 | detect_eol (&coding, buffer, nread); | ||
| 3196 | if (CODING_REQUIRE_EOL_CONVERSION (&coding)) | ||
| 3197 | /* We found that the format of eol should be decoded. | ||
| 3198 | Let's give up here. */ | ||
| 3199 | { | ||
| 3200 | giveup_match_end = 1; | ||
| 3201 | break; | ||
| 3202 | } | ||
| 3203 | |||
| 3154 | bufpos = 0; | 3204 | bufpos = 0; |
| 3155 | while (bufpos < nread && same_at_start < ZV | 3205 | while (bufpos < nread && same_at_start < ZV |
| 3156 | && FETCH_CHAR (same_at_start) == buffer[bufpos]) | 3206 | && FETCH_BYTE (same_at_start) == buffer[bufpos]) |
| 3157 | same_at_start++, bufpos++; | 3207 | same_at_start++, bufpos++; |
| 3158 | /* If we found a discrepancy, stop the scan. | 3208 | /* If we found a discrepancy, stop the scan. |
| 3159 | Otherwise loop around and scan the next bufferful. */ | 3209 | Otherwise loop around and scan the next bufferful. */ |
| @@ -3174,8 +3224,9 @@ which is often less than the number of characters to be read.") | |||
| 3174 | immediate_quit = 1; | 3224 | immediate_quit = 1; |
| 3175 | QUIT; | 3225 | QUIT; |
| 3176 | /* Count how many chars at the end of the file | 3226 | /* Count how many chars at the end of the file |
| 3177 | match the text at the end of the buffer. */ | 3227 | match the text at the end of the buffer. But, if we have |
| 3178 | while (1) | 3228 | already found that decoding is necessary, don't waste time. */ |
| 3229 | while (!giveup_match_end) | ||
| 3179 | { | 3230 | { |
| 3180 | int total_read, nread, bufpos, curpos, trial; | 3231 | int total_read, nread, bufpos, curpos, trial; |
| 3181 | 3232 | ||
| @@ -3205,7 +3256,7 @@ which is often less than the number of characters to be read.") | |||
| 3205 | /* Compare with same_at_start to avoid counting some buffer text | 3256 | /* Compare with same_at_start to avoid counting some buffer text |
| 3206 | as matching both at the file's beginning and at the end. */ | 3257 | as matching both at the file's beginning and at the end. */ |
| 3207 | while (bufpos > 0 && same_at_end > same_at_start | 3258 | while (bufpos > 0 && same_at_end > same_at_start |
| 3208 | && FETCH_CHAR (same_at_end - 1) == buffer[bufpos - 1]) | 3259 | && FETCH_BYTE (same_at_end - 1) == buffer[bufpos - 1]) |
| 3209 | same_at_end--, bufpos--; | 3260 | same_at_end--, bufpos--; |
| 3210 | /* If we found a discrepancy, stop the scan. | 3261 | /* If we found a discrepancy, stop the scan. |
| 3211 | Otherwise loop around and scan the preceding bufferful. */ | 3262 | Otherwise loop around and scan the preceding bufferful. */ |
| @@ -3231,7 +3282,6 @@ which is often less than the number of characters to be read.") | |||
| 3231 | /* Insert from the file at the proper position. */ | 3282 | /* Insert from the file at the proper position. */ |
| 3232 | SET_PT (same_at_start); | 3283 | SET_PT (same_at_start); |
| 3233 | } | 3284 | } |
| 3234 | #endif /* not DOS_NT */ | ||
| 3235 | 3285 | ||
| 3236 | total = XINT (end) - XINT (beg); | 3286 | total = XINT (end) - XINT (beg); |
| 3237 | 3287 | ||
| @@ -3257,32 +3307,81 @@ which is often less than the number of characters to be read.") | |||
| 3257 | report_file_error ("Setting file position", Fcons (filename, Qnil)); | 3307 | report_file_error ("Setting file position", Fcons (filename, Qnil)); |
| 3258 | } | 3308 | } |
| 3259 | 3309 | ||
| 3310 | /* In the following loop, HOW_MUCH contains the total bytes read so | ||
| 3311 | far. Before exiting the loop, it is set to -1 if I/O error | ||
| 3312 | occurs, set to -2 if the maximum buffer size is exceeded. */ | ||
| 3260 | how_much = 0; | 3313 | how_much = 0; |
| 3261 | while (inserted < total) | 3314 | /* Total bytes inserted. */ |
| 3315 | inserted = 0; | ||
| 3316 | /* Bytes not processed in the previous loop because short gap size. */ | ||
| 3317 | unprocessed = 0; | ||
| 3318 | while (how_much < total) | ||
| 3262 | { | 3319 | { |
| 3263 | /* try is reserved in some compilers (Microsoft C) */ | 3320 | /* try is reserved in some compilers (Microsoft C) */ |
| 3264 | int trytry = min (total - inserted, 64 << 10); | 3321 | int trytry = min (total - how_much, READ_BUF_SIZE - unprocessed); |
| 3322 | char *destination = (CODING_REQUIRE_CONVERSION (&coding) | ||
| 3323 | ? read_buf + unprocessed | ||
| 3324 | : (char *) (POS_ADDR (PT + inserted - 1) + 1)); | ||
| 3265 | int this; | 3325 | int this; |
| 3266 | 3326 | ||
| 3267 | /* Allow quitting out of the actual I/O. */ | 3327 | /* Allow quitting out of the actual I/O. */ |
| 3268 | immediate_quit = 1; | 3328 | immediate_quit = 1; |
| 3269 | QUIT; | 3329 | QUIT; |
| 3270 | this = read (fd, &FETCH_CHAR (PT + inserted - 1) + 1, trytry); | 3330 | this = read (fd, destination, trytry); |
| 3271 | immediate_quit = 0; | 3331 | immediate_quit = 0; |
| 3272 | 3332 | ||
| 3273 | if (this <= 0) | 3333 | if (this < 0 || this + unprocessed == 0) |
| 3274 | { | 3334 | { |
| 3275 | how_much = this; | 3335 | how_much = this; |
| 3276 | break; | 3336 | break; |
| 3277 | } | 3337 | } |
| 3278 | 3338 | ||
| 3339 | how_much += this; | ||
| 3340 | |||
| 3341 | if (CODING_REQUIRE_CONVERSION (&coding)) | ||
| 3342 | { | ||
| 3343 | int require, produced, consumed; | ||
| 3344 | |||
| 3345 | this += unprocessed; | ||
| 3346 | /* Make sure that the gap is large enough. */ | ||
| 3347 | require = decoding_buffer_size (&coding, this); | ||
| 3348 | if (GAP_SIZE < require) | ||
| 3349 | make_gap (require - GAP_SIZE); | ||
| 3350 | if (how_much >= total) /* This is the last block. */ | ||
| 3351 | coding.last_block = 1; | ||
| 3352 | produced = decode_coding (&coding, read_buf, | ||
| 3353 | POS_ADDR (PT + inserted - 1) + 1, | ||
| 3354 | this, GAP_SIZE, &consumed); | ||
| 3355 | if (produced > 0) | ||
| 3356 | { | ||
| 3357 | Lisp_Object temp; | ||
| 3358 | |||
| 3359 | XSET (temp, Lisp_Int, Z + produced); | ||
| 3360 | if (Z + produced != XINT (temp)) | ||
| 3361 | { | ||
| 3362 | how_much = -2; | ||
| 3363 | break; | ||
| 3364 | } | ||
| 3365 | } | ||
| 3366 | unprocessed = this - consumed; | ||
| 3367 | bcopy (read_buf + consumed, read_buf, unprocessed); | ||
| 3368 | this = produced; | ||
| 3369 | } | ||
| 3370 | |||
| 3279 | GPT += this; | 3371 | GPT += this; |
| 3280 | GAP_SIZE -= this; | 3372 | GAP_SIZE -= this; |
| 3281 | ZV += this; | 3373 | ZV += this; |
| 3282 | Z += this; | 3374 | Z += this; |
| 3375 | if (GAP_SIZE > 0) | ||
| 3376 | /* Put an anchor to ensure multi-byte form ends at gap. */ | ||
| 3377 | *GPT_ADDR = 0; | ||
| 3283 | inserted += this; | 3378 | inserted += this; |
| 3284 | } | 3379 | } |
| 3285 | 3380 | ||
| 3381 | /* We don't have to consider file type of MSDOS because all files | ||
| 3382 | are read as binary and end-of-line format has already been | ||
| 3383 | decoded appropriately. */ | ||
| 3384 | #if 0 | ||
| 3286 | #ifdef DOS_NT | 3385 | #ifdef DOS_NT |
| 3287 | /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */ | 3386 | /* Demacs 1.1.1 91/10/16 HIRANO Satoshi, MW July 1993 */ |
| 3288 | /* Determine file type from name and remove LFs from CR-LFs if the file | 3387 | /* Determine file type from name and remove LFs from CR-LFs if the file |
| @@ -3293,7 +3392,7 @@ which is often less than the number of characters to be read.") | |||
| 3293 | if (NILP (current_buffer->buffer_file_type)) | 3392 | if (NILP (current_buffer->buffer_file_type)) |
| 3294 | { | 3393 | { |
| 3295 | int reduced_size | 3394 | int reduced_size |
| 3296 | = inserted - crlf_to_lf (inserted, &FETCH_CHAR (PT - 1) + 1); | 3395 | = inserted - crlf_to_lf (inserted, POS_ADDR (PT - 1) + 1); |
| 3297 | ZV -= reduced_size; | 3396 | ZV -= reduced_size; |
| 3298 | Z -= reduced_size; | 3397 | Z -= reduced_size; |
| 3299 | GPT -= reduced_size; | 3398 | GPT -= reduced_size; |
| @@ -3302,6 +3401,7 @@ which is often less than the number of characters to be read.") | |||
| 3302 | } | 3401 | } |
| 3303 | } | 3402 | } |
| 3304 | #endif /* DOS_NT */ | 3403 | #endif /* DOS_NT */ |
| 3404 | #endif /* 0 */ | ||
| 3305 | 3405 | ||
| 3306 | if (inserted > 0) | 3406 | if (inserted > 0) |
| 3307 | { | 3407 | { |
| @@ -3317,9 +3417,11 @@ which is often less than the number of characters to be read.") | |||
| 3317 | /* Discard the unwind protect for closing the file. */ | 3417 | /* Discard the unwind protect for closing the file. */ |
| 3318 | specpdl_ptr--; | 3418 | specpdl_ptr--; |
| 3319 | 3419 | ||
| 3320 | if (how_much < 0) | 3420 | if (how_much == -1) |
| 3321 | error ("IO error reading %s: %s", | 3421 | error ("IO error reading %s: %s", |
| 3322 | XSTRING (filename)->data, strerror (errno)); | 3422 | XSTRING (filename)->data, strerror (errno)); |
| 3423 | else if (how_much == -2) | ||
| 3424 | error ("maximum buffer size exceeded"); | ||
| 3323 | 3425 | ||
| 3324 | notfound: | 3426 | notfound: |
| 3325 | handled: | 3427 | handled: |
| @@ -3374,6 +3476,9 @@ which is often less than the number of characters to be read.") | |||
| 3374 | if (inserted > 0) | 3476 | if (inserted > 0) |
| 3375 | { | 3477 | { |
| 3376 | p = Vafter_insert_file_functions; | 3478 | p = Vafter_insert_file_functions; |
| 3479 | if (!NILP (coding.post_read_conversion)) | ||
| 3480 | p = Fcons (coding.post_read_conversion, p); | ||
| 3481 | |||
| 3377 | while (!NILP (p)) | 3482 | while (!NILP (p)) |
| 3378 | { | 3483 | { |
| 3379 | insval = call1 (Fcar (p), make_number (inserted)); | 3484 | insval = call1 (Fcar (p), make_number (inserted)); |
| @@ -3398,7 +3503,11 @@ which is often less than the number of characters to be read.") | |||
| 3398 | static Lisp_Object build_annotations (); | 3503 | static Lisp_Object build_annotations (); |
| 3399 | 3504 | ||
| 3400 | /* If build_annotations switched buffers, switch back to BUF. | 3505 | /* If build_annotations switched buffers, switch back to BUF. |
| 3401 | Kill the temporary buffer that was selected in the meantime. */ | 3506 | Kill the temporary buffer that was selected in the meantime. |
| 3507 | |||
| 3508 | Since this kill only the last temporary buffer, some buffers remain | ||
| 3509 | not killed if build_annotations switched buffers more than once. | ||
| 3510 | -- K.Handa */ | ||
| 3402 | 3511 | ||
| 3403 | static Lisp_Object | 3512 | static Lisp_Object |
| 3404 | build_annotations_unwind (buf) | 3513 | build_annotations_unwind (buf) |
| @@ -3432,7 +3541,10 @@ If VISIT is neither t nor nil nor a string,\n\ | |||
| 3432 | The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\ | 3541 | The optional sixth arg LOCKNAME, if non-nil, specifies the name to\n\ |
| 3433 | use for locking and unlocking, overriding FILENAME and VISIT.\n\ | 3542 | use for locking and unlocking, overriding FILENAME and VISIT.\n\ |
| 3434 | Kludgy feature: if START is a string, then that string is written\n\ | 3543 | Kludgy feature: if START is a string, then that string is written\n\ |
| 3435 | to the file, instead of any buffer contents, and END is ignored.") | 3544 | to the file, instead of any buffer contents, and END is ignored.\n\ |
| 3545 | This does code conversion according to the value of\n\ | ||
| 3546 | `coding-system-for-write' or `coding-system-alist', and sets the variable\n\ | ||
| 3547 | `last-coding-system-used' to the coding system actually used.") | ||
| 3436 | (start, end, filename, append, visit, lockname) | 3548 | (start, end, filename, append, visit, lockname) |
| 3437 | Lisp_Object start, end, filename, append, visit, lockname; | 3549 | Lisp_Object start, end, filename, append, visit, lockname; |
| 3438 | { | 3550 | { |
| @@ -3457,6 +3569,7 @@ to the file, instead of any buffer contents, and END is ignored.") | |||
| 3457 | int buffer_file_type | 3569 | int buffer_file_type |
| 3458 | = NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY; | 3570 | = NILP (current_buffer->buffer_file_type) ? O_TEXT : O_BINARY; |
| 3459 | #endif /* DOS_NT */ | 3571 | #endif /* DOS_NT */ |
| 3572 | struct coding_system coding; | ||
| 3460 | 3573 | ||
| 3461 | if (current_buffer->base_buffer && ! NILP (visit)) | 3574 | if (current_buffer->base_buffer && ! NILP (visit)) |
| 3462 | error ("Cannot do file visiting in an indirect buffer"); | 3575 | error ("Cannot do file visiting in an indirect buffer"); |
| @@ -3505,6 +3618,38 @@ to the file, instead of any buffer contents, and END is ignored.") | |||
| 3505 | return val; | 3618 | return val; |
| 3506 | } | 3619 | } |
| 3507 | 3620 | ||
| 3621 | /* Decide the coding-system to be encoded to. */ | ||
| 3622 | { | ||
| 3623 | Lisp_Object val; | ||
| 3624 | |||
| 3625 | if (auto_saving) | ||
| 3626 | val = Qnil; | ||
| 3627 | else if (!NILP (Vcoding_system_for_write)) | ||
| 3628 | val = Vcoding_system_for_write; | ||
| 3629 | else if (!NILP (Flocal_variable_if_set_p (Qbuffer_file_coding_system, | ||
| 3630 | Qnil))) | ||
| 3631 | val = Fsymbol_value (Qbuffer_file_coding_system); | ||
| 3632 | else | ||
| 3633 | { | ||
| 3634 | Lisp_Object args[7], coding_systems; | ||
| 3635 | |||
| 3636 | args[0] = Qwrite_region, args[1] = start, args[2] = end, | ||
| 3637 | args[3] = filename, args[4] = append, args[5] = visit, | ||
| 3638 | args[6] = lockname; | ||
| 3639 | coding_systems = Ffind_coding_system (7, args); | ||
| 3640 | val = (CONSP (coding_systems) | ||
| 3641 | ? XCONS (coding_systems)->cdr | ||
| 3642 | : Fsymbol_value (Qbuffer_file_coding_system)); | ||
| 3643 | } | ||
| 3644 | setup_coding_system (Fcheck_coding_system (val), &coding); | ||
| 3645 | if (!STRINGP (start) && !NILP (current_buffer->selective_display)) | ||
| 3646 | coding.selective = 1; | ||
| 3647 | #ifdef DOS_NT | ||
| 3648 | if (!NILP (current_buffer->buffer_file_type)) | ||
| 3649 | coding.eol_type = CODING_EOL_LF; | ||
| 3650 | #endif /* DOS_NT */ | ||
| 3651 | } | ||
| 3652 | |||
| 3508 | /* Special kludge to simplify auto-saving. */ | 3653 | /* Special kludge to simplify auto-saving. */ |
| 3509 | if (NILP (start)) | 3654 | if (NILP (start)) |
| 3510 | { | 3655 | { |
| @@ -3516,7 +3661,7 @@ to the file, instead of any buffer contents, and END is ignored.") | |||
| 3516 | count1 = specpdl_ptr - specpdl; | 3661 | count1 = specpdl_ptr - specpdl; |
| 3517 | 3662 | ||
| 3518 | given_buffer = current_buffer; | 3663 | given_buffer = current_buffer; |
| 3519 | annotations = build_annotations (start, end); | 3664 | annotations = build_annotations (start, end, coding.pre_write_conversion); |
| 3520 | if (current_buffer != given_buffer) | 3665 | if (current_buffer != given_buffer) |
| 3521 | { | 3666 | { |
| 3522 | start = BEGV; | 3667 | start = BEGV; |
| @@ -3649,7 +3794,7 @@ to the file, instead of any buffer contents, and END is ignored.") | |||
| 3649 | if (STRINGP (start)) | 3794 | if (STRINGP (start)) |
| 3650 | { | 3795 | { |
| 3651 | failure = 0 > a_write (desc, XSTRING (start)->data, | 3796 | failure = 0 > a_write (desc, XSTRING (start)->data, |
| 3652 | XSTRING (start)->size, 0, &annotations); | 3797 | XSTRING (start)->size, 0, &annotations, &coding); |
| 3653 | save_errno = errno; | 3798 | save_errno = errno; |
| 3654 | } | 3799 | } |
| 3655 | else if (XINT (start) != XINT (end)) | 3800 | else if (XINT (start) != XINT (end)) |
| @@ -3659,8 +3804,9 @@ to the file, instead of any buffer contents, and END is ignored.") | |||
| 3659 | { | 3804 | { |
| 3660 | register int end1 = XINT (end); | 3805 | register int end1 = XINT (end); |
| 3661 | tem = XINT (start); | 3806 | tem = XINT (start); |
| 3662 | failure = 0 > a_write (desc, &FETCH_CHAR (tem), | 3807 | failure = 0 > a_write (desc, POS_ADDR (tem), |
| 3663 | min (GPT, end1) - tem, tem, &annotations); | 3808 | min (GPT, end1) - tem, tem, &annotations, |
| 3809 | &coding); | ||
| 3664 | nwritten += min (GPT, end1) - tem; | 3810 | nwritten += min (GPT, end1) - tem; |
| 3665 | save_errno = errno; | 3811 | save_errno = errno; |
| 3666 | } | 3812 | } |
| @@ -3669,8 +3815,8 @@ to the file, instead of any buffer contents, and END is ignored.") | |||
| 3669 | { | 3815 | { |
| 3670 | tem = XINT (start); | 3816 | tem = XINT (start); |
| 3671 | tem = max (tem, GPT); | 3817 | tem = max (tem, GPT); |
| 3672 | failure = 0 > a_write (desc, &FETCH_CHAR (tem), XINT (end) - tem, | 3818 | failure = 0 > a_write (desc, POS_ADDR (tem), XINT (end) - tem, |
| 3673 | tem, &annotations); | 3819 | tem, &annotations, &coding); |
| 3674 | nwritten += XINT (end) - tem; | 3820 | nwritten += XINT (end) - tem; |
| 3675 | save_errno = errno; | 3821 | save_errno = errno; |
| 3676 | } | 3822 | } |
| @@ -3678,7 +3824,15 @@ to the file, instead of any buffer contents, and END is ignored.") | |||
| 3678 | else | 3824 | else |
| 3679 | { | 3825 | { |
| 3680 | /* If file was empty, still need to write the annotations */ | 3826 | /* If file was empty, still need to write the annotations */ |
| 3681 | failure = 0 > a_write (desc, "", 0, XINT (start), &annotations); | 3827 | failure = 0 > a_write (desc, "", 0, XINT (start), &annotations, &coding); |
| 3828 | save_errno = errno; | ||
| 3829 | } | ||
| 3830 | |||
| 3831 | if (coding.require_flushing) | ||
| 3832 | { | ||
| 3833 | /* We have to flush out a data. */ | ||
| 3834 | coding.last_block = 1; | ||
| 3835 | failure = 0 > e_write (desc, "", 0, &coding); | ||
| 3682 | save_errno = errno; | 3836 | save_errno = errno; |
| 3683 | } | 3837 | } |
| 3684 | 3838 | ||
| @@ -3787,8 +3941,8 @@ DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0, | |||
| 3787 | as save-excursion would do. */ | 3941 | as save-excursion would do. */ |
| 3788 | 3942 | ||
| 3789 | static Lisp_Object | 3943 | static Lisp_Object |
| 3790 | build_annotations (start, end) | 3944 | build_annotations (start, end, pre_write_conversion) |
| 3791 | Lisp_Object start, end; | 3945 | Lisp_Object start, end, pre_write_conversion; |
| 3792 | { | 3946 | { |
| 3793 | Lisp_Object annotations; | 3947 | Lisp_Object annotations; |
| 3794 | Lisp_Object p, res; | 3948 | Lisp_Object p, res; |
| @@ -3842,6 +3996,24 @@ build_annotations (start, end) | |||
| 3842 | annotations = merge (annotations, res, Qcar_less_than_car); | 3996 | annotations = merge (annotations, res, Qcar_less_than_car); |
| 3843 | p = Fcdr (p); | 3997 | p = Fcdr (p); |
| 3844 | } | 3998 | } |
| 3999 | |||
| 4000 | /* At last, do the same for the function PRE_WRITE_CONVERSION | ||
| 4001 | implied by the current coding-system. */ | ||
| 4002 | if (!NILP (pre_write_conversion)) | ||
| 4003 | { | ||
| 4004 | struct buffer *given_buffer = current_buffer; | ||
| 4005 | Vwrite_region_annotations_so_far = annotations; | ||
| 4006 | res = call2 (pre_write_conversion, start, end); | ||
| 4007 | if (current_buffer != given_buffer) | ||
| 4008 | { | ||
| 4009 | start = BEGV; | ||
| 4010 | end = ZV; | ||
| 4011 | annotations = Qnil; | ||
| 4012 | } | ||
| 4013 | Flength (res); | ||
| 4014 | annotations = merge (annotations, res, Qcar_less_than_car); | ||
| 4015 | } | ||
| 4016 | |||
| 3845 | UNGCPRO; | 4017 | UNGCPRO; |
| 3846 | return annotations; | 4018 | return annotations; |
| 3847 | } | 4019 | } |
| @@ -3856,12 +4028,13 @@ build_annotations (start, end) | |||
| 3856 | The return value is negative in case of system call failure. */ | 4028 | The return value is negative in case of system call failure. */ |
| 3857 | 4029 | ||
| 3858 | int | 4030 | int |
| 3859 | a_write (desc, addr, len, pos, annot) | 4031 | a_write (desc, addr, len, pos, annot, coding) |
| 3860 | int desc; | 4032 | int desc; |
| 3861 | register char *addr; | 4033 | register char *addr; |
| 3862 | register int len; | 4034 | register int len; |
| 3863 | int pos; | 4035 | int pos; |
| 3864 | Lisp_Object *annot; | 4036 | Lisp_Object *annot; |
| 4037 | struct coding_system *coding; | ||
| 3865 | { | 4038 | { |
| 3866 | Lisp_Object tem; | 4039 | Lisp_Object tem; |
| 3867 | int nextpos; | 4040 | int nextpos; |
| @@ -3873,10 +4046,10 @@ a_write (desc, addr, len, pos, annot) | |||
| 3873 | if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos) | 4046 | if (INTEGERP (tem) && XINT (tem) >= pos && XFASTINT (tem) <= lastpos) |
| 3874 | nextpos = XFASTINT (tem); | 4047 | nextpos = XFASTINT (tem); |
| 3875 | else | 4048 | else |
| 3876 | return e_write (desc, addr, lastpos - pos); | 4049 | return e_write (desc, addr, lastpos - pos, coding); |
| 3877 | if (nextpos > pos) | 4050 | if (nextpos > pos) |
| 3878 | { | 4051 | { |
| 3879 | if (0 > e_write (desc, addr, nextpos - pos)) | 4052 | if (0 > e_write (desc, addr, nextpos - pos, coding)) |
| 3880 | return -1; | 4053 | return -1; |
| 3881 | addr += nextpos - pos; | 4054 | addr += nextpos - pos; |
| 3882 | pos = nextpos; | 4055 | pos = nextpos; |
| @@ -3884,43 +4057,50 @@ a_write (desc, addr, len, pos, annot) | |||
| 3884 | tem = Fcdr (Fcar (*annot)); | 4057 | tem = Fcdr (Fcar (*annot)); |
| 3885 | if (STRINGP (tem)) | 4058 | if (STRINGP (tem)) |
| 3886 | { | 4059 | { |
| 3887 | if (0 > e_write (desc, XSTRING (tem)->data, XSTRING (tem)->size)) | 4060 | if (0 > e_write (desc, XSTRING (tem)->data, XSTRING (tem)->size, |
| 4061 | coding)) | ||
| 3888 | return -1; | 4062 | return -1; |
| 3889 | } | 4063 | } |
| 3890 | *annot = Fcdr (*annot); | 4064 | *annot = Fcdr (*annot); |
| 3891 | } | 4065 | } |
| 3892 | } | 4066 | } |
| 3893 | 4067 | ||
| 4068 | #ifndef WRITE_BUF_SIZE | ||
| 4069 | #define WRITE_BUF_SIZE (16 * 1024) | ||
| 4070 | #endif | ||
| 4071 | |||
| 3894 | int | 4072 | int |
| 3895 | e_write (desc, addr, len) | 4073 | e_write (desc, addr, len, coding) |
| 3896 | int desc; | 4074 | int desc; |
| 3897 | register char *addr; | 4075 | register char *addr; |
| 3898 | register int len; | 4076 | register int len; |
| 4077 | struct coding_system *coding; | ||
| 3899 | { | 4078 | { |
| 3900 | char buf[16 * 1024]; | 4079 | char buf[WRITE_BUF_SIZE]; |
| 3901 | register char *p, *end; | 4080 | int produced, consumed; |
| 3902 | 4081 | ||
| 3903 | if (!EQ (current_buffer->selective_display, Qt)) | 4082 | /* We used to have a code for handling selective display here. But, |
| 3904 | return write (desc, addr, len) - len; | 4083 | now it is handled within encode_coding. */ |
| 3905 | else | 4084 | while (1) |
| 3906 | { | 4085 | { |
| 3907 | p = buf; | 4086 | produced = encode_coding (coding, addr, buf, len, WRITE_BUF_SIZE, |
| 3908 | end = p + sizeof buf; | 4087 | &consumed); |
| 3909 | while (len--) | 4088 | len -= consumed, addr += consumed; |
| 4089 | if (produced == 0 && len > 0) | ||
| 3910 | { | 4090 | { |
| 3911 | if (p == end) | 4091 | /* There was a carry over because of invalid codes in the source. |
| 3912 | { | 4092 | We just write out them as is. */ |
| 3913 | if (write (desc, buf, sizeof buf) != sizeof buf) | 4093 | bcopy (addr, buf, len); |
| 3914 | return -1; | 4094 | produced = len; |
| 3915 | p = buf; | 4095 | len = 0; |
| 3916 | } | 4096 | } |
| 3917 | *p = *addr++; | 4097 | if (produced > 0) |
| 3918 | if (*p++ == '\015') | 4098 | { |
| 3919 | p[-1] = '\n'; | 4099 | produced -= write (desc, buf, produced); |
| 4100 | if (produced) return -1; | ||
| 3920 | } | 4101 | } |
| 3921 | if (p != buf) | 4102 | if (len <= 0) |
| 3922 | if (write (desc, buf, p - buf) != p - buf) | 4103 | break; |
| 3923 | return -1; | ||
| 3924 | } | 4104 | } |
| 3925 | return 0; | 4105 | return 0; |
| 3926 | } | 4106 | } |