]> code.delx.au - gnu-emacs/blob - src/coding.c
Merge from emacs--devo--0
[gnu-emacs] / src / coding.c
1 /* Coding system handler (conversion, detection, etc).
2 Copyright (C) 2001, 2002, 2003, 2004, 2005,
3 2006, 2007 Free Software Foundation, Inc.
4 Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
5 2005, 2006, 2007
6 National Institute of Advanced Industrial Science and Technology (AIST)
7 Registration Number H14PRO021
8 Copyright (C) 2003
9 National Institute of Advanced Industrial Science and Technology (AIST)
10 Registration Number H13PRO009
11
12 This file is part of GNU Emacs.
13
14 GNU Emacs is free software; you can redistribute it and/or modify
15 it under the terms of the GNU General Public License as published by
16 the Free Software Foundation; either version 2, or (at your option)
17 any later version.
18
19 GNU Emacs is distributed in the hope that it will be useful,
20 but WITHOUT ANY WARRANTY; without even the implied warranty of
21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 GNU General Public License for more details.
23
24 You should have received a copy of the GNU General Public License
25 along with GNU Emacs; see the file COPYING. If not, write to
26 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27 Boston, MA 02110-1301, USA. */
28
29 /*** TABLE OF CONTENTS ***
30
31 0. General comments
32 1. Preamble
33 2. Emacs' internal format (emacs-utf-8) handlers
34 3. UTF-8 handlers
35 4. UTF-16 handlers
36 5. Charset-base coding systems handlers
37 6. emacs-mule (old Emacs' internal format) handlers
38 7. ISO2022 handlers
39 8. Shift-JIS and BIG5 handlers
40 9. CCL handlers
41 10. C library functions
42 11. Emacs Lisp library functions
43 12. Postamble
44
45 */
46
47 /*** 0. General comments ***
48
49
50 CODING SYSTEM
51
52 A coding system is an object for an encoding mechanism that contains
53 information about how to convert byte sequences to character
54 sequences and vice versa. When we say "decode", it means converting
55 a byte sequence of a specific coding system into a character
56 sequence that is represented by Emacs' internal coding system
57 `emacs-utf-8', and when we say "encode", it means converting a
58 character sequence of emacs-utf-8 to a byte sequence of a specific
59 coding system.
60
61 In Emacs Lisp, a coding system is represented by a Lisp symbol. In
62 C level, a coding system is represented by a vector of attributes
63 stored in the hash table Vcharset_hash_table. The conversion from
64 coding system symbol to attributes vector is done by looking up
65 Vcharset_hash_table by the symbol.
66
67 Coding systems are classified into the following types depending on
68 the encoding mechanism. Here's a brief description of the types.
69
70 o UTF-8
71
72 o UTF-16
73
74 o Charset-base coding system
75
76 A coding system defined by one or more (coded) character sets.
77 Decoding and encoding are done by a code converter defined for each
78 character set.
79
80 o Old Emacs internal format (emacs-mule)
81
82 The coding system adopted by old versions of Emacs (20 and 21).
83
84 o ISO2022-base coding system
85
86 The most famous coding system for multiple character sets. X's
87 Compound Text, various EUCs (Extended Unix Code), and coding systems
88 used in the Internet communication such as ISO-2022-JP are all
89 variants of ISO2022.
90
91 o SJIS (or Shift-JIS or MS-Kanji-Code)
92
93 A coding system to encode character sets: ASCII, JISX0201, and
94 JISX0208. Widely used for PC's in Japan. Details are described in
95 section 8.
96
97 o BIG5
98
99 A coding system to encode character sets: ASCII and Big5. Widely
100 used for Chinese (mainly in Taiwan and Hong Kong). Details are
101 described in section 8. In this file, when we write "big5" (all
102 lowercase), we mean the coding system, and when we write "Big5"
103 (capitalized), we mean the character set.
104
105 o CCL
106
107 If a user wants to decode/encode text encoded in a coding system
108 not listed above, he can supply a decoder and an encoder for it in
109 CCL (Code Conversion Language) programs. Emacs executes the CCL
110 program while decoding/encoding.
111
112 o Raw-text
113
114 A coding system for text containing raw eight-bit data. Emacs
115 treats each byte of source text as a character (except for
116 end-of-line conversion).
117
118 o No-conversion
119
120 Like raw text, but don't do end-of-line conversion.
121
122
123 END-OF-LINE FORMAT
124
125 How text end-of-line is encoded depends on operating system. For
126 instance, Unix's format is just one byte of LF (line-feed) code,
127 whereas DOS's format is two-byte sequence of `carriage-return' and
128 `line-feed' codes. MacOS's format is usually one byte of
129 `carriage-return'.
130
131 Since text character encoding and end-of-line encoding are
132 independent, any coding system described above can take any format
133 of end-of-line (except for no-conversion).
134
135 STRUCT CODING_SYSTEM
136
137 Before using a coding system for code conversion (i.e. decoding and
138 encoding), we setup a structure of type `struct coding_system'.
139 This structure keeps various information about a specific code
140 conversion (e.g. the location of source and destination data).
141
142 */
143
144 /* COMMON MACROS */
145
146
147 /*** GENERAL NOTES on `detect_coding_XXX ()' functions ***
148
149 These functions check if a byte sequence specified as a source in
150 CODING conforms to the format of XXX, and update the members of
151 DETECT_INFO.
152
153 Return 1 if the byte sequence conforms to XXX, otherwise return 0.
154
155 Below is the template of these functions. */
156
157 #if 0
158 static int
159 detect_coding_XXX (coding, detect_info)
160 struct coding_system *coding;
161 struct coding_detection_info *detect_info;
162 {
163 const unsigned char *src = coding->source;
164 const unsigned char *src_end = coding->source + coding->src_bytes;
165 int multibytep = coding->src_multibyte;
166 int consumed_chars = 0;
167 int found = 0;
168 ...;
169
170 while (1)
171 {
172 /* Get one byte from the source. If the souce is exausted, jump
173 to no_more_source:. */
174 ONE_MORE_BYTE (c);
175
176 if (! __C_conforms_to_XXX___ (c))
177 break;
178 if (! __C_strongly_suggests_XXX__ (c))
179 found = CATEGORY_MASK_XXX;
180 }
181 /* The byte sequence is invalid for XXX. */
182 detect_info->rejected |= CATEGORY_MASK_XXX;
183 return 0;
184
185 no_more_source:
186 /* The source exausted successfully. */
187 detect_info->found |= found;
188 return 1;
189 }
190 #endif
191
192 /*** GENERAL NOTES on `decode_coding_XXX ()' functions ***
193
194 These functions decode a byte sequence specified as a source by
195 CODING. The resulting multibyte text goes to a place pointed to by
196 CODING->charbuf, the length of which should not exceed
197 CODING->charbuf_size;
198
199 These functions set the information of original and decoded texts in
200 CODING->consumed, CODING->consumed_char, and CODING->charbuf_used.
201 They also set CODING->result to one of CODING_RESULT_XXX indicating
202 how the decoding is finished.
203
204 Below is the template of these functions. */
205
206 #if 0
207 static void
208 decode_coding_XXXX (coding)
209 struct coding_system *coding;
210 {
211 const unsigned char *src = coding->source + coding->consumed;
212 const unsigned char *src_end = coding->source + coding->src_bytes;
213 /* SRC_BASE remembers the start position in source in each loop.
214 The loop will be exited when there's not enough source code, or
215 when there's no room in CHARBUF for a decoded character. */
216 const unsigned char *src_base;
217 /* A buffer to produce decoded characters. */
218 int *charbuf = coding->charbuf + coding->charbuf_used;
219 int *charbuf_end = coding->charbuf + coding->charbuf_size;
220 int multibytep = coding->src_multibyte;
221
222 while (1)
223 {
224 src_base = src;
225 if (charbuf < charbuf_end)
226 /* No more room to produce a decoded character. */
227 break;
228 ONE_MORE_BYTE (c);
229 /* Decode it. */
230 }
231
232 no_more_source:
233 if (src_base < src_end
234 && coding->mode & CODING_MODE_LAST_BLOCK)
235 /* If the source ends by partial bytes to construct a character,
236 treat them as eight-bit raw data. */
237 while (src_base < src_end && charbuf < charbuf_end)
238 *charbuf++ = *src_base++;
239 /* Remember how many bytes and characters we consumed. If the
240 source is multibyte, the bytes and chars are not identical. */
241 coding->consumed = coding->consumed_char = src_base - coding->source;
242 /* Remember how many characters we produced. */
243 coding->charbuf_used = charbuf - coding->charbuf;
244 }
245 #endif
246
247 /*** GENERAL NOTES on `encode_coding_XXX ()' functions ***
248
249 These functions encode SRC_BYTES length text at SOURCE of Emacs'
250 internal multibyte format by CODING. The resulting byte sequence
251 goes to a place pointed to by DESTINATION, the length of which
252 should not exceed DST_BYTES.
253
254 These functions set the information of original and encoded texts in
255 the members produced, produced_char, consumed, and consumed_char of
256 the structure *CODING. They also set the member result to one of
257 CODING_RESULT_XXX indicating how the encoding finished.
258
259 DST_BYTES zero means that source area and destination area are
260 overlapped, which means that we can produce a encoded text until it
261 reaches at the head of not-yet-encoded source text.
262
263 Below is a template of these functions. */
264 #if 0
265 static void
266 encode_coding_XXX (coding)
267 struct coding_system *coding;
268 {
269 int multibytep = coding->dst_multibyte;
270 int *charbuf = coding->charbuf;
271 int *charbuf_end = charbuf->charbuf + coding->charbuf_used;
272 unsigned char *dst = coding->destination + coding->produced;
273 unsigned char *dst_end = coding->destination + coding->dst_bytes;
274 unsigned char *adjusted_dst_end = dst_end - _MAX_BYTES_PRODUCED_IN_LOOP_;
275 int produced_chars = 0;
276
277 for (; charbuf < charbuf_end && dst < adjusted_dst_end; charbuf++)
278 {
279 int c = *charbuf;
280 /* Encode C into DST, and increment DST. */
281 }
282 label_no_more_destination:
283 /* How many chars and bytes we produced. */
284 coding->produced_char += produced_chars;
285 coding->produced = dst - coding->destination;
286 }
287 #endif
288
289 \f
290 /*** 1. Preamble ***/
291
292 #include <config.h>
293 #include <stdio.h>
294
295 #include "lisp.h"
296 #include "buffer.h"
297 #include "character.h"
298 #include "charset.h"
299 #include "ccl.h"
300 #include "composite.h"
301 #include "coding.h"
302 #include "window.h"
303
304 Lisp_Object Vcoding_system_hash_table;
305
306 Lisp_Object Qcoding_system, Qcoding_aliases, Qeol_type;
307 Lisp_Object Qunix, Qdos;
308 extern Lisp_Object Qmac; /* frame.c */
309 Lisp_Object Qbuffer_file_coding_system;
310 Lisp_Object Qpost_read_conversion, Qpre_write_conversion;
311 Lisp_Object Qdefault_char;
312 Lisp_Object Qno_conversion, Qundecided;
313 Lisp_Object Qcharset, Qiso_2022, Qutf_8, Qutf_16, Qshift_jis, Qbig5;
314 Lisp_Object Qbig, Qlittle;
315 Lisp_Object Qcoding_system_history;
316 Lisp_Object Qvalid_codes;
317 Lisp_Object QCcategory, QCmnemonic, QCdefalut_char;
318 Lisp_Object QCdecode_translation_table, QCencode_translation_table;
319 Lisp_Object QCpost_read_conversion, QCpre_write_conversion;
320 Lisp_Object QCascii_compatible_p;
321
322 extern Lisp_Object Qinsert_file_contents, Qwrite_region;
323 Lisp_Object Qcall_process, Qcall_process_region;
324 Lisp_Object Qstart_process, Qopen_network_stream;
325 Lisp_Object Qtarget_idx;
326
327 Lisp_Object Qinsufficient_source, Qinconsistent_eol, Qinvalid_source;
328 Lisp_Object Qinterrupted, Qinsufficient_memory;
329
330 /* If a symbol has this property, evaluate the value to define the
331 symbol as a coding system. */
332 static Lisp_Object Qcoding_system_define_form;
333
334 int coding_system_require_warning;
335
336 Lisp_Object Vselect_safe_coding_system_function;
337
338 /* Mnemonic string for each format of end-of-line. */
339 Lisp_Object eol_mnemonic_unix, eol_mnemonic_dos, eol_mnemonic_mac;
340 /* Mnemonic string to indicate format of end-of-line is not yet
341 decided. */
342 Lisp_Object eol_mnemonic_undecided;
343
344 /* Format of end-of-line decided by system. This is Qunix on
345 Unix and Mac, Qdos on DOS/Windows.
346 This has an effect only for external encoding (i.e. for output to
347 file and process), not for in-buffer or Lisp string encoding. */
348 static Lisp_Object system_eol_type;
349
350 #ifdef emacs
351
352 Lisp_Object Vcoding_system_list, Vcoding_system_alist;
353
354 Lisp_Object Qcoding_system_p, Qcoding_system_error;
355
356 /* Coding system emacs-mule and raw-text are for converting only
357 end-of-line format. */
358 Lisp_Object Qemacs_mule, Qraw_text;
359 Lisp_Object Qutf_8_emacs;
360
361 /* Coding-systems are handed between Emacs Lisp programs and C internal
362 routines by the following three variables. */
363 /* Coding-system for reading files and receiving data from process. */
364 Lisp_Object Vcoding_system_for_read;
365 /* Coding-system for writing files and sending data to process. */
366 Lisp_Object Vcoding_system_for_write;
367 /* Coding-system actually used in the latest I/O. */
368 Lisp_Object Vlast_coding_system_used;
369 /* Set to non-nil when an error is detected while code conversion. */
370 Lisp_Object Vlast_code_conversion_error;
371 /* A vector of length 256 which contains information about special
372 Latin codes (especially for dealing with Microsoft codes). */
373 Lisp_Object Vlatin_extra_code_table;
374
375 /* Flag to inhibit code conversion of end-of-line format. */
376 int inhibit_eol_conversion;
377
378 /* Flag to inhibit ISO2022 escape sequence detection. */
379 int inhibit_iso_escape_detection;
380
381 /* Flag to make buffer-file-coding-system inherit from process-coding. */
382 int inherit_process_coding_system;
383
384 /* Coding system to be used to encode text for terminal display. */
385 struct coding_system terminal_coding;
386
387 /* Coding system to be used to encode text for terminal display when
388 terminal coding system is nil. */
389 struct coding_system safe_terminal_coding;
390
391 /* Coding system of what is sent from terminal keyboard. */
392 struct coding_system keyboard_coding;
393
394 Lisp_Object Vfile_coding_system_alist;
395 Lisp_Object Vprocess_coding_system_alist;
396 Lisp_Object Vnetwork_coding_system_alist;
397
398 Lisp_Object Vlocale_coding_system;
399
400 #endif /* emacs */
401
402 /* Flag to tell if we look up translation table on character code
403 conversion. */
404 Lisp_Object Venable_character_translation;
405 /* Standard translation table to look up on decoding (reading). */
406 Lisp_Object Vstandard_translation_table_for_decode;
407 /* Standard translation table to look up on encoding (writing). */
408 Lisp_Object Vstandard_translation_table_for_encode;
409
410 Lisp_Object Qtranslation_table;
411 Lisp_Object Qtranslation_table_id;
412 Lisp_Object Qtranslation_table_for_decode;
413 Lisp_Object Qtranslation_table_for_encode;
414
415 /* Alist of charsets vs revision number. */
416 static Lisp_Object Vcharset_revision_table;
417
418 /* Default coding systems used for process I/O. */
419 Lisp_Object Vdefault_process_coding_system;
420
421 /* Char table for translating Quail and self-inserting input. */
422 Lisp_Object Vtranslation_table_for_input;
423
424 /* Two special coding systems. */
425 Lisp_Object Vsjis_coding_system;
426 Lisp_Object Vbig5_coding_system;
427
428 /* ISO2022 section */
429
430 #define CODING_ISO_INITIAL(coding, reg) \
431 (XINT (AREF (AREF (CODING_ID_ATTRS ((coding)->id), \
432 coding_attr_iso_initial), \
433 reg)))
434
435
436 #define CODING_ISO_REQUEST(coding, charset_id) \
437 ((charset_id <= (coding)->max_charset_id \
438 ? (coding)->safe_charsets[charset_id] \
439 : -1))
440
441
442 #define CODING_ISO_FLAGS(coding) \
443 ((coding)->spec.iso_2022.flags)
444 #define CODING_ISO_DESIGNATION(coding, reg) \
445 ((coding)->spec.iso_2022.current_designation[reg])
446 #define CODING_ISO_INVOCATION(coding, plane) \
447 ((coding)->spec.iso_2022.current_invocation[plane])
448 #define CODING_ISO_SINGLE_SHIFTING(coding) \
449 ((coding)->spec.iso_2022.single_shifting)
450 #define CODING_ISO_BOL(coding) \
451 ((coding)->spec.iso_2022.bol)
452 #define CODING_ISO_INVOKED_CHARSET(coding, plane) \
453 CODING_ISO_DESIGNATION ((coding), CODING_ISO_INVOCATION ((coding), (plane)))
454
455 /* Control characters of ISO2022. */
456 /* code */ /* function */
457 #define ISO_CODE_LF 0x0A /* line-feed */
458 #define ISO_CODE_CR 0x0D /* carriage-return */
459 #define ISO_CODE_SO 0x0E /* shift-out */
460 #define ISO_CODE_SI 0x0F /* shift-in */
461 #define ISO_CODE_SS2_7 0x19 /* single-shift-2 for 7-bit code */
462 #define ISO_CODE_ESC 0x1B /* escape */
463 #define ISO_CODE_SS2 0x8E /* single-shift-2 */
464 #define ISO_CODE_SS3 0x8F /* single-shift-3 */
465 #define ISO_CODE_CSI 0x9B /* control-sequence-introducer */
466
467 /* All code (1-byte) of ISO2022 is classified into one of the
468 followings. */
469 enum iso_code_class_type
470 {
471 ISO_control_0, /* Control codes in the range
472 0x00..0x1F and 0x7F, except for the
473 following 5 codes. */
474 ISO_shift_out, /* ISO_CODE_SO (0x0E) */
475 ISO_shift_in, /* ISO_CODE_SI (0x0F) */
476 ISO_single_shift_2_7, /* ISO_CODE_SS2_7 (0x19) */
477 ISO_escape, /* ISO_CODE_SO (0x1B) */
478 ISO_control_1, /* Control codes in the range
479 0x80..0x9F, except for the
480 following 3 codes. */
481 ISO_single_shift_2, /* ISO_CODE_SS2 (0x8E) */
482 ISO_single_shift_3, /* ISO_CODE_SS3 (0x8F) */
483 ISO_control_sequence_introducer, /* ISO_CODE_CSI (0x9B) */
484 ISO_0x20_or_0x7F, /* Codes of the values 0x20 or 0x7F. */
485 ISO_graphic_plane_0, /* Graphic codes in the range 0x21..0x7E. */
486 ISO_0xA0_or_0xFF, /* Codes of the values 0xA0 or 0xFF. */
487 ISO_graphic_plane_1 /* Graphic codes in the range 0xA1..0xFE. */
488 };
489
490 /** The macros CODING_ISO_FLAG_XXX defines a flag bit of the
491 `iso-flags' attribute of an iso2022 coding system. */
492
493 /* If set, produce long-form designation sequence (e.g. ESC $ ( A)
494 instead of the correct short-form sequence (e.g. ESC $ A). */
495 #define CODING_ISO_FLAG_LONG_FORM 0x0001
496
497 /* If set, reset graphic planes and registers at end-of-line to the
498 initial state. */
499 #define CODING_ISO_FLAG_RESET_AT_EOL 0x0002
500
501 /* If set, reset graphic planes and registers before any control
502 characters to the initial state. */
503 #define CODING_ISO_FLAG_RESET_AT_CNTL 0x0004
504
505 /* If set, encode by 7-bit environment. */
506 #define CODING_ISO_FLAG_SEVEN_BITS 0x0008
507
508 /* If set, use locking-shift function. */
509 #define CODING_ISO_FLAG_LOCKING_SHIFT 0x0010
510
511 /* If set, use single-shift function. Overwrite
512 CODING_ISO_FLAG_LOCKING_SHIFT. */
513 #define CODING_ISO_FLAG_SINGLE_SHIFT 0x0020
514
515 /* If set, use designation escape sequence. */
516 #define CODING_ISO_FLAG_DESIGNATION 0x0040
517
518 /* If set, produce revision number sequence. */
519 #define CODING_ISO_FLAG_REVISION 0x0080
520
521 /* If set, produce ISO6429's direction specifying sequence. */
522 #define CODING_ISO_FLAG_DIRECTION 0x0100
523
524 /* If set, assume designation states are reset at beginning of line on
525 output. */
526 #define CODING_ISO_FLAG_INIT_AT_BOL 0x0200
527
528 /* If set, designation sequence should be placed at beginning of line
529 on output. */
530 #define CODING_ISO_FLAG_DESIGNATE_AT_BOL 0x0400
531
532 /* If set, do not encode unsafe charactes on output. */
533 #define CODING_ISO_FLAG_SAFE 0x0800
534
535 /* If set, extra latin codes (128..159) are accepted as a valid code
536 on input. */
537 #define CODING_ISO_FLAG_LATIN_EXTRA 0x1000
538
539 #define CODING_ISO_FLAG_COMPOSITION 0x2000
540
541 #define CODING_ISO_FLAG_EUC_TW_SHIFT 0x4000
542
543 #define CODING_ISO_FLAG_USE_ROMAN 0x8000
544
545 #define CODING_ISO_FLAG_USE_OLDJIS 0x10000
546
547 #define CODING_ISO_FLAG_FULL_SUPPORT 0x100000
548
549 /* A character to be produced on output if encoding of the original
550 character is prohibited by CODING_ISO_FLAG_SAFE. */
551 #define CODING_INHIBIT_CHARACTER_SUBSTITUTION '?'
552
553
554 /* UTF-16 section */
555 #define CODING_UTF_16_BOM(coding) \
556 ((coding)->spec.utf_16.bom)
557
558 #define CODING_UTF_16_ENDIAN(coding) \
559 ((coding)->spec.utf_16.endian)
560
561 #define CODING_UTF_16_SURROGATE(coding) \
562 ((coding)->spec.utf_16.surrogate)
563
564
565 /* CCL section */
566 #define CODING_CCL_DECODER(coding) \
567 AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_decoder)
568 #define CODING_CCL_ENCODER(coding) \
569 AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_encoder)
570 #define CODING_CCL_VALIDS(coding) \
571 (SDATA (AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_valids)))
572
573 /* Index for each coding category in `coding_categories' */
574
575 enum coding_category
576 {
577 coding_category_iso_7,
578 coding_category_iso_7_tight,
579 coding_category_iso_8_1,
580 coding_category_iso_8_2,
581 coding_category_iso_7_else,
582 coding_category_iso_8_else,
583 coding_category_utf_8,
584 coding_category_utf_16_auto,
585 coding_category_utf_16_be,
586 coding_category_utf_16_le,
587 coding_category_utf_16_be_nosig,
588 coding_category_utf_16_le_nosig,
589 coding_category_charset,
590 coding_category_sjis,
591 coding_category_big5,
592 coding_category_ccl,
593 coding_category_emacs_mule,
594 /* All above are targets of code detection. */
595 coding_category_raw_text,
596 coding_category_undecided,
597 coding_category_max
598 };
599
600 /* Definitions of flag bits used in detect_coding_XXXX. */
601 #define CATEGORY_MASK_ISO_7 (1 << coding_category_iso_7)
602 #define CATEGORY_MASK_ISO_7_TIGHT (1 << coding_category_iso_7_tight)
603 #define CATEGORY_MASK_ISO_8_1 (1 << coding_category_iso_8_1)
604 #define CATEGORY_MASK_ISO_8_2 (1 << coding_category_iso_8_2)
605 #define CATEGORY_MASK_ISO_7_ELSE (1 << coding_category_iso_7_else)
606 #define CATEGORY_MASK_ISO_8_ELSE (1 << coding_category_iso_8_else)
607 #define CATEGORY_MASK_UTF_8 (1 << coding_category_utf_8)
608 #define CATEGORY_MASK_UTF_16_AUTO (1 << coding_category_utf_16_auto)
609 #define CATEGORY_MASK_UTF_16_BE (1 << coding_category_utf_16_be)
610 #define CATEGORY_MASK_UTF_16_LE (1 << coding_category_utf_16_le)
611 #define CATEGORY_MASK_UTF_16_BE_NOSIG (1 << coding_category_utf_16_be_nosig)
612 #define CATEGORY_MASK_UTF_16_LE_NOSIG (1 << coding_category_utf_16_le_nosig)
613 #define CATEGORY_MASK_CHARSET (1 << coding_category_charset)
614 #define CATEGORY_MASK_SJIS (1 << coding_category_sjis)
615 #define CATEGORY_MASK_BIG5 (1 << coding_category_big5)
616 #define CATEGORY_MASK_CCL (1 << coding_category_ccl)
617 #define CATEGORY_MASK_EMACS_MULE (1 << coding_category_emacs_mule)
618 #define CATEGORY_MASK_RAW_TEXT (1 << coding_category_raw_text)
619
620 /* This value is returned if detect_coding_mask () find nothing other
621 than ASCII characters. */
622 #define CATEGORY_MASK_ANY \
623 (CATEGORY_MASK_ISO_7 \
624 | CATEGORY_MASK_ISO_7_TIGHT \
625 | CATEGORY_MASK_ISO_8_1 \
626 | CATEGORY_MASK_ISO_8_2 \
627 | CATEGORY_MASK_ISO_7_ELSE \
628 | CATEGORY_MASK_ISO_8_ELSE \
629 | CATEGORY_MASK_UTF_8 \
630 | CATEGORY_MASK_UTF_16_BE \
631 | CATEGORY_MASK_UTF_16_LE \
632 | CATEGORY_MASK_UTF_16_BE_NOSIG \
633 | CATEGORY_MASK_UTF_16_LE_NOSIG \
634 | CATEGORY_MASK_CHARSET \
635 | CATEGORY_MASK_SJIS \
636 | CATEGORY_MASK_BIG5 \
637 | CATEGORY_MASK_CCL \
638 | CATEGORY_MASK_EMACS_MULE)
639
640
641 #define CATEGORY_MASK_ISO_7BIT \
642 (CATEGORY_MASK_ISO_7 | CATEGORY_MASK_ISO_7_TIGHT)
643
644 #define CATEGORY_MASK_ISO_8BIT \
645 (CATEGORY_MASK_ISO_8_1 | CATEGORY_MASK_ISO_8_2)
646
647 #define CATEGORY_MASK_ISO_ELSE \
648 (CATEGORY_MASK_ISO_7_ELSE | CATEGORY_MASK_ISO_8_ELSE)
649
650 #define CATEGORY_MASK_ISO_ESCAPE \
651 (CATEGORY_MASK_ISO_7 \
652 | CATEGORY_MASK_ISO_7_TIGHT \
653 | CATEGORY_MASK_ISO_7_ELSE \
654 | CATEGORY_MASK_ISO_8_ELSE)
655
656 #define CATEGORY_MASK_ISO \
657 ( CATEGORY_MASK_ISO_7BIT \
658 | CATEGORY_MASK_ISO_8BIT \
659 | CATEGORY_MASK_ISO_ELSE)
660
661 #define CATEGORY_MASK_UTF_16 \
662 (CATEGORY_MASK_UTF_16_BE \
663 | CATEGORY_MASK_UTF_16_LE \
664 | CATEGORY_MASK_UTF_16_BE_NOSIG \
665 | CATEGORY_MASK_UTF_16_LE_NOSIG)
666
667
668 /* List of symbols `coding-category-xxx' ordered by priority. This
669 variable is exposed to Emacs Lisp. */
670 static Lisp_Object Vcoding_category_list;
671
672 /* Table of coding categories (Lisp symbols). This variable is for
673 internal use oly. */
674 static Lisp_Object Vcoding_category_table;
675
676 /* Table of coding-categories ordered by priority. */
677 static enum coding_category coding_priorities[coding_category_max];
678
679 /* Nth element is a coding context for the coding system bound to the
680 Nth coding category. */
681 static struct coding_system coding_categories[coding_category_max];
682
683 /*** Commonly used macros and functions ***/
684
685 #ifndef min
686 #define min(a, b) ((a) < (b) ? (a) : (b))
687 #endif
688 #ifndef max
689 #define max(a, b) ((a) > (b) ? (a) : (b))
690 #endif
691
692 #define CODING_GET_INFO(coding, attrs, charset_list) \
693 do { \
694 (attrs) = CODING_ID_ATTRS ((coding)->id); \
695 (charset_list) = CODING_ATTR_CHARSET_LIST (attrs); \
696 } while (0)
697
698
699 /* Safely get one byte from the source text pointed by SRC which ends
700 at SRC_END, and set C to that byte. If there are not enough bytes
701 in the source, it jumps to `no_more_source'. If multibytep is
702 nonzero, and a multibyte character is found at SRC, set C to the
703 negative value of the character code. The caller should declare
704 and set these variables appropriately in advance:
705 src, src_end, multibytep */
706
707 #define ONE_MORE_BYTE(c) \
708 do { \
709 if (src == src_end) \
710 { \
711 if (src_base < src) \
712 record_conversion_result \
713 (coding, CODING_RESULT_INSUFFICIENT_SRC); \
714 goto no_more_source; \
715 } \
716 c = *src++; \
717 if (multibytep && (c & 0x80)) \
718 { \
719 if ((c & 0xFE) == 0xC0) \
720 c = ((c & 1) << 6) | *src++; \
721 else \
722 { \
723 src--; \
724 c = - string_char (src, &src, NULL); \
725 record_conversion_result \
726 (coding, CODING_RESULT_INVALID_SRC); \
727 } \
728 } \
729 consumed_chars++; \
730 } while (0)
731
732
733 #define ONE_MORE_BYTE_NO_CHECK(c) \
734 do { \
735 c = *src++; \
736 if (multibytep && (c & 0x80)) \
737 { \
738 if ((c & 0xFE) == 0xC0) \
739 c = ((c & 1) << 6) | *src++; \
740 else \
741 { \
742 src--; \
743 c = - string_char (src, &src, NULL); \
744 record_conversion_result \
745 (coding, CODING_RESULT_INVALID_SRC); \
746 } \
747 } \
748 consumed_chars++; \
749 } while (0)
750
751
752 /* Store a byte C in the place pointed by DST and increment DST to the
753 next free point, and increment PRODUCED_CHARS. The caller should
754 assure that C is 0..127, and declare and set the variable `dst'
755 appropriately in advance.
756 */
757
758
759 #define EMIT_ONE_ASCII_BYTE(c) \
760 do { \
761 produced_chars++; \
762 *dst++ = (c); \
763 } while (0)
764
765
766 /* Like EMIT_ONE_ASCII_BYTE byt store two bytes; C1 and C2. */
767
768 #define EMIT_TWO_ASCII_BYTES(c1, c2) \
769 do { \
770 produced_chars += 2; \
771 *dst++ = (c1), *dst++ = (c2); \
772 } while (0)
773
774
775 /* Store a byte C in the place pointed by DST and increment DST to the
776 next free point, and increment PRODUCED_CHARS. If MULTIBYTEP is
777 nonzero, store in an appropriate multibyte from. The caller should
778 declare and set the variables `dst' and `multibytep' appropriately
779 in advance. */
780
781 #define EMIT_ONE_BYTE(c) \
782 do { \
783 produced_chars++; \
784 if (multibytep) \
785 { \
786 int ch = (c); \
787 if (ch >= 0x80) \
788 ch = BYTE8_TO_CHAR (ch); \
789 CHAR_STRING_ADVANCE (ch, dst); \
790 } \
791 else \
792 *dst++ = (c); \
793 } while (0)
794
795
796 /* Like EMIT_ONE_BYTE, but emit two bytes; C1 and C2. */
797
798 #define EMIT_TWO_BYTES(c1, c2) \
799 do { \
800 produced_chars += 2; \
801 if (multibytep) \
802 { \
803 int ch; \
804 \
805 ch = (c1); \
806 if (ch >= 0x80) \
807 ch = BYTE8_TO_CHAR (ch); \
808 CHAR_STRING_ADVANCE (ch, dst); \
809 ch = (c2); \
810 if (ch >= 0x80) \
811 ch = BYTE8_TO_CHAR (ch); \
812 CHAR_STRING_ADVANCE (ch, dst); \
813 } \
814 else \
815 { \
816 *dst++ = (c1); \
817 *dst++ = (c2); \
818 } \
819 } while (0)
820
821
822 #define EMIT_THREE_BYTES(c1, c2, c3) \
823 do { \
824 EMIT_ONE_BYTE (c1); \
825 EMIT_TWO_BYTES (c2, c3); \
826 } while (0)
827
828
829 #define EMIT_FOUR_BYTES(c1, c2, c3, c4) \
830 do { \
831 EMIT_TWO_BYTES (c1, c2); \
832 EMIT_TWO_BYTES (c3, c4); \
833 } while (0)
834
835
836 /* Prototypes for static functions. */
837 static void record_conversion_result P_ ((struct coding_system *coding,
838 enum coding_result_code result));
839 static int detect_coding_utf_8 P_ ((struct coding_system *,
840 struct coding_detection_info *info));
841 static void decode_coding_utf_8 P_ ((struct coding_system *));
842 static int encode_coding_utf_8 P_ ((struct coding_system *));
843
844 static int detect_coding_utf_16 P_ ((struct coding_system *,
845 struct coding_detection_info *info));
846 static void decode_coding_utf_16 P_ ((struct coding_system *));
847 static int encode_coding_utf_16 P_ ((struct coding_system *));
848
849 static int detect_coding_iso_2022 P_ ((struct coding_system *,
850 struct coding_detection_info *info));
851 static void decode_coding_iso_2022 P_ ((struct coding_system *));
852 static int encode_coding_iso_2022 P_ ((struct coding_system *));
853
854 static int detect_coding_emacs_mule P_ ((struct coding_system *,
855 struct coding_detection_info *info));
856 static void decode_coding_emacs_mule P_ ((struct coding_system *));
857 static int encode_coding_emacs_mule P_ ((struct coding_system *));
858
859 static int detect_coding_sjis P_ ((struct coding_system *,
860 struct coding_detection_info *info));
861 static void decode_coding_sjis P_ ((struct coding_system *));
862 static int encode_coding_sjis P_ ((struct coding_system *));
863
864 static int detect_coding_big5 P_ ((struct coding_system *,
865 struct coding_detection_info *info));
866 static void decode_coding_big5 P_ ((struct coding_system *));
867 static int encode_coding_big5 P_ ((struct coding_system *));
868
869 static int detect_coding_ccl P_ ((struct coding_system *,
870 struct coding_detection_info *info));
871 static void decode_coding_ccl P_ ((struct coding_system *));
872 static int encode_coding_ccl P_ ((struct coding_system *));
873
874 static void decode_coding_raw_text P_ ((struct coding_system *));
875 static int encode_coding_raw_text P_ ((struct coding_system *));
876
877 static void coding_set_source P_ ((struct coding_system *));
878 static void coding_set_destination P_ ((struct coding_system *));
879 static void coding_alloc_by_realloc P_ ((struct coding_system *, EMACS_INT));
880 static void coding_alloc_by_making_gap P_ ((struct coding_system *,
881 EMACS_INT));
882 static unsigned char *alloc_destination P_ ((struct coding_system *,
883 EMACS_INT, unsigned char *));
884 static void setup_iso_safe_charsets P_ ((Lisp_Object));
885 static unsigned char *encode_designation_at_bol P_ ((struct coding_system *,
886 int *, int *,
887 unsigned char *));
888 static int detect_eol P_ ((const unsigned char *,
889 EMACS_INT, enum coding_category));
890 static Lisp_Object adjust_coding_eol_type P_ ((struct coding_system *, int));
891 static void decode_eol P_ ((struct coding_system *));
892 static Lisp_Object get_translation_table P_ ((Lisp_Object, int, int *));
893 static Lisp_Object get_translation P_ ((Lisp_Object, int *, int *,
894 int, int *, int *));
895 static int produce_chars P_ ((struct coding_system *, Lisp_Object, int));
896 static INLINE void produce_composition P_ ((struct coding_system *, int *,
897 EMACS_INT));
898 static INLINE void produce_charset P_ ((struct coding_system *, int *,
899 EMACS_INT));
900 static void produce_annotation P_ ((struct coding_system *, EMACS_INT));
901 static int decode_coding P_ ((struct coding_system *));
902 static INLINE int *handle_composition_annotation P_ ((EMACS_INT, EMACS_INT,
903 struct coding_system *,
904 int *, EMACS_INT *));
905 static INLINE int *handle_charset_annotation P_ ((EMACS_INT, EMACS_INT,
906 struct coding_system *,
907 int *, EMACS_INT *));
908 static void consume_chars P_ ((struct coding_system *, Lisp_Object, int));
909 static int encode_coding P_ ((struct coding_system *));
910 static Lisp_Object make_conversion_work_buffer P_ ((int));
911 static Lisp_Object code_conversion_restore P_ ((Lisp_Object));
912 static INLINE int char_encodable_p P_ ((int, Lisp_Object));
913 static Lisp_Object make_subsidiaries P_ ((Lisp_Object));
914
915 static void
916 record_conversion_result (struct coding_system *coding,
917 enum coding_result_code result)
918 {
919 coding->result = result;
920 switch (result)
921 {
922 case CODING_RESULT_INSUFFICIENT_SRC:
923 Vlast_code_conversion_error = Qinsufficient_source;
924 break;
925 case CODING_RESULT_INCONSISTENT_EOL:
926 Vlast_code_conversion_error = Qinconsistent_eol;
927 break;
928 case CODING_RESULT_INVALID_SRC:
929 Vlast_code_conversion_error = Qinvalid_source;
930 break;
931 case CODING_RESULT_INTERRUPT:
932 Vlast_code_conversion_error = Qinterrupted;
933 break;
934 case CODING_RESULT_INSUFFICIENT_MEM:
935 Vlast_code_conversion_error = Qinsufficient_memory;
936 break;
937 default:
938 Vlast_code_conversion_error = intern ("Unknown error");
939 }
940 }
941
942 #define CODING_DECODE_CHAR(coding, src, src_base, src_end, charset, code, c) \
943 do { \
944 charset_map_loaded = 0; \
945 c = DECODE_CHAR (charset, code); \
946 if (charset_map_loaded) \
947 { \
948 const unsigned char *orig = coding->source; \
949 EMACS_INT offset; \
950 \
951 coding_set_source (coding); \
952 offset = coding->source - orig; \
953 src += offset; \
954 src_base += offset; \
955 src_end += offset; \
956 } \
957 } while (0)
958
959
960 #define ASSURE_DESTINATION(bytes) \
961 do { \
962 if (dst + (bytes) >= dst_end) \
963 { \
964 int more_bytes = charbuf_end - charbuf + (bytes); \
965 \
966 dst = alloc_destination (coding, more_bytes, dst); \
967 dst_end = coding->destination + coding->dst_bytes; \
968 } \
969 } while (0)
970
971
972
973 static void
974 coding_set_source (coding)
975 struct coding_system *coding;
976 {
977 if (BUFFERP (coding->src_object))
978 {
979 struct buffer *buf = XBUFFER (coding->src_object);
980
981 if (coding->src_pos < 0)
982 coding->source = BUF_GAP_END_ADDR (buf) + coding->src_pos_byte;
983 else
984 coding->source = BUF_BYTE_ADDRESS (buf, coding->src_pos_byte);
985 }
986 else if (STRINGP (coding->src_object))
987 {
988 coding->source = SDATA (coding->src_object) + coding->src_pos_byte;
989 }
990 else
991 /* Otherwise, the source is C string and is never relocated
992 automatically. Thus we don't have to update anything. */
993 ;
994 }
995
996 static void
997 coding_set_destination (coding)
998 struct coding_system *coding;
999 {
1000 if (BUFFERP (coding->dst_object))
1001 {
1002 if (coding->src_pos < 0)
1003 {
1004 coding->destination = BEG_ADDR + coding->dst_pos_byte - 1;
1005 coding->dst_bytes = (GAP_END_ADDR
1006 - (coding->src_bytes - coding->consumed)
1007 - coding->destination);
1008 }
1009 else
1010 {
1011 /* We are sure that coding->dst_pos_byte is before the gap
1012 of the buffer. */
1013 coding->destination = (BUF_BEG_ADDR (XBUFFER (coding->dst_object))
1014 + coding->dst_pos_byte - 1);
1015 coding->dst_bytes = (BUF_GAP_END_ADDR (XBUFFER (coding->dst_object))
1016 - coding->destination);
1017 }
1018 }
1019 else
1020 /* Otherwise, the destination is C string and is never relocated
1021 automatically. Thus we don't have to update anything. */
1022 ;
1023 }
1024
1025
1026 static void
1027 coding_alloc_by_realloc (coding, bytes)
1028 struct coding_system *coding;
1029 EMACS_INT bytes;
1030 {
1031 coding->destination = (unsigned char *) xrealloc (coding->destination,
1032 coding->dst_bytes + bytes);
1033 coding->dst_bytes += bytes;
1034 }
1035
1036 static void
1037 coding_alloc_by_making_gap (coding, bytes)
1038 struct coding_system *coding;
1039 EMACS_INT bytes;
1040 {
1041 if (BUFFERP (coding->dst_object)
1042 && EQ (coding->src_object, coding->dst_object))
1043 {
1044 EMACS_INT add = coding->src_bytes - coding->consumed;
1045
1046 GAP_SIZE -= add; ZV += add; Z += add; ZV_BYTE += add; Z_BYTE += add;
1047 make_gap (bytes);
1048 GAP_SIZE += add; ZV -= add; Z -= add; ZV_BYTE -= add; Z_BYTE -= add;
1049 }
1050 else
1051 {
1052 Lisp_Object this_buffer;
1053
1054 this_buffer = Fcurrent_buffer ();
1055 set_buffer_internal (XBUFFER (coding->dst_object));
1056 make_gap (bytes);
1057 set_buffer_internal (XBUFFER (this_buffer));
1058 }
1059 }
1060
1061
1062 static unsigned char *
1063 alloc_destination (coding, nbytes, dst)
1064 struct coding_system *coding;
1065 EMACS_INT nbytes;
1066 unsigned char *dst;
1067 {
1068 EMACS_INT offset = dst - coding->destination;
1069
1070 if (BUFFERP (coding->dst_object))
1071 coding_alloc_by_making_gap (coding, nbytes);
1072 else
1073 coding_alloc_by_realloc (coding, nbytes);
1074 record_conversion_result (coding, CODING_RESULT_SUCCESS);
1075 coding_set_destination (coding);
1076 dst = coding->destination + offset;
1077 return dst;
1078 }
1079
1080 /** Macros for annotations. */
1081
1082 /* Maximum length of annotation data (sum of annotations for
1083 composition and charset). */
1084 #define MAX_ANNOTATION_LENGTH (4 + (MAX_COMPOSITION_COMPONENTS * 2) - 1 + 4)
1085
1086 /* An annotation data is stored in the array coding->charbuf in this
1087 format:
1088 [ -LENGTH ANNOTATION_MASK NCHARS ... ]
1089 LENGTH is the number of elements in the annotation.
1090 ANNOTATION_MASK is one of CODING_ANNOTATE_XXX_MASK.
1091 NCHARS is the number of characters in the text annotated.
1092
1093 The format of the following elements depend on ANNOTATION_MASK.
1094
1095 In the case of CODING_ANNOTATE_COMPOSITION_MASK, these elements
1096 follows:
1097 ... METHOD [ COMPOSITION-COMPONENTS ... ]
1098 METHOD is one of enum composition_method.
1099 Optionnal COMPOSITION-COMPONENTS are characters and composition
1100 rules.
1101
1102 In the case of CODING_ANNOTATE_CHARSET_MASK, one element CHARSET-ID
1103 follows. */
1104
1105 #define ADD_ANNOTATION_DATA(buf, len, mask, nchars) \
1106 do { \
1107 *(buf)++ = -(len); \
1108 *(buf)++ = (mask); \
1109 *(buf)++ = (nchars); \
1110 coding->annotated = 1; \
1111 } while (0);
1112
1113 #define ADD_COMPOSITION_DATA(buf, nchars, method) \
1114 do { \
1115 ADD_ANNOTATION_DATA (buf, 4, CODING_ANNOTATE_COMPOSITION_MASK, nchars); \
1116 *buf++ = method; \
1117 } while (0)
1118
1119
1120 #define ADD_CHARSET_DATA(buf, nchars, id) \
1121 do { \
1122 ADD_ANNOTATION_DATA (buf, 4, CODING_ANNOTATE_CHARSET_MASK, nchars); \
1123 *buf++ = id; \
1124 } while (0)
1125
1126 \f
1127 /*** 2. Emacs' internal format (emacs-utf-8) ***/
1128
1129
1130
1131 \f
1132 /*** 3. UTF-8 ***/
1133
1134 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
1135 Check if a text is encoded in UTF-8. If it is, return 1, else
1136 return 0. */
1137
1138 #define UTF_8_1_OCTET_P(c) ((c) < 0x80)
1139 #define UTF_8_EXTRA_OCTET_P(c) (((c) & 0xC0) == 0x80)
1140 #define UTF_8_2_OCTET_LEADING_P(c) (((c) & 0xE0) == 0xC0)
1141 #define UTF_8_3_OCTET_LEADING_P(c) (((c) & 0xF0) == 0xE0)
1142 #define UTF_8_4_OCTET_LEADING_P(c) (((c) & 0xF8) == 0xF0)
1143 #define UTF_8_5_OCTET_LEADING_P(c) (((c) & 0xFC) == 0xF8)
1144
1145 static int
1146 detect_coding_utf_8 (coding, detect_info)
1147 struct coding_system *coding;
1148 struct coding_detection_info *detect_info;
1149 {
1150 const unsigned char *src = coding->source, *src_base;
1151 const unsigned char *src_end = coding->source + coding->src_bytes;
1152 int multibytep = coding->src_multibyte;
1153 int consumed_chars = 0;
1154 int found = 0;
1155
1156 detect_info->checked |= CATEGORY_MASK_UTF_8;
1157 /* A coding system of this category is always ASCII compatible. */
1158 src += coding->head_ascii;
1159
1160 while (1)
1161 {
1162 int c, c1, c2, c3, c4;
1163
1164 src_base = src;
1165 ONE_MORE_BYTE (c);
1166 if (c < 0 || UTF_8_1_OCTET_P (c))
1167 continue;
1168 ONE_MORE_BYTE (c1);
1169 if (c1 < 0 || ! UTF_8_EXTRA_OCTET_P (c1))
1170 break;
1171 if (UTF_8_2_OCTET_LEADING_P (c))
1172 {
1173 found = CATEGORY_MASK_UTF_8;
1174 continue;
1175 }
1176 ONE_MORE_BYTE (c2);
1177 if (c2 < 0 || ! UTF_8_EXTRA_OCTET_P (c2))
1178 break;
1179 if (UTF_8_3_OCTET_LEADING_P (c))
1180 {
1181 found = CATEGORY_MASK_UTF_8;
1182 continue;
1183 }
1184 ONE_MORE_BYTE (c3);
1185 if (c3 < 0 || ! UTF_8_EXTRA_OCTET_P (c3))
1186 break;
1187 if (UTF_8_4_OCTET_LEADING_P (c))
1188 {
1189 found = CATEGORY_MASK_UTF_8;
1190 continue;
1191 }
1192 ONE_MORE_BYTE (c4);
1193 if (c4 < 0 || ! UTF_8_EXTRA_OCTET_P (c4))
1194 break;
1195 if (UTF_8_5_OCTET_LEADING_P (c))
1196 {
1197 found = CATEGORY_MASK_UTF_8;
1198 continue;
1199 }
1200 break;
1201 }
1202 detect_info->rejected |= CATEGORY_MASK_UTF_8;
1203 return 0;
1204
1205 no_more_source:
1206 if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK)
1207 {
1208 detect_info->rejected |= CATEGORY_MASK_UTF_8;
1209 return 0;
1210 }
1211 detect_info->found |= found;
1212 return 1;
1213 }
1214
1215
1216 static void
1217 decode_coding_utf_8 (coding)
1218 struct coding_system *coding;
1219 {
1220 const unsigned char *src = coding->source + coding->consumed;
1221 const unsigned char *src_end = coding->source + coding->src_bytes;
1222 const unsigned char *src_base;
1223 int *charbuf = coding->charbuf + coding->charbuf_used;
1224 int *charbuf_end = coding->charbuf + coding->charbuf_size;
1225 int consumed_chars = 0, consumed_chars_base;
1226 int multibytep = coding->src_multibyte;
1227 Lisp_Object attr, charset_list;
1228
1229 CODING_GET_INFO (coding, attr, charset_list);
1230
1231 while (1)
1232 {
1233 int c, c1, c2, c3, c4, c5;
1234
1235 src_base = src;
1236 consumed_chars_base = consumed_chars;
1237
1238 if (charbuf >= charbuf_end)
1239 break;
1240
1241 ONE_MORE_BYTE (c1);
1242 if (c1 < 0)
1243 {
1244 c = - c1;
1245 }
1246 else if (UTF_8_1_OCTET_P(c1))
1247 {
1248 c = c1;
1249 }
1250 else
1251 {
1252 ONE_MORE_BYTE (c2);
1253 if (c2 < 0 || ! UTF_8_EXTRA_OCTET_P (c2))
1254 goto invalid_code;
1255 if (UTF_8_2_OCTET_LEADING_P (c1))
1256 {
1257 c = ((c1 & 0x1F) << 6) | (c2 & 0x3F);
1258 /* Reject overlong sequences here and below. Encoders
1259 producing them are incorrect, they can be misleading,
1260 and they mess up read/write invariance. */
1261 if (c < 128)
1262 goto invalid_code;
1263 }
1264 else
1265 {
1266 ONE_MORE_BYTE (c3);
1267 if (c3 < 0 || ! UTF_8_EXTRA_OCTET_P (c3))
1268 goto invalid_code;
1269 if (UTF_8_3_OCTET_LEADING_P (c1))
1270 {
1271 c = (((c1 & 0xF) << 12)
1272 | ((c2 & 0x3F) << 6) | (c3 & 0x3F));
1273 if (c < 0x800
1274 || (c >= 0xd800 && c < 0xe000)) /* surrogates (invalid) */
1275 goto invalid_code;
1276 }
1277 else
1278 {
1279 ONE_MORE_BYTE (c4);
1280 if (c4 < 0 || ! UTF_8_EXTRA_OCTET_P (c4))
1281 goto invalid_code;
1282 if (UTF_8_4_OCTET_LEADING_P (c1))
1283 {
1284 c = (((c1 & 0x7) << 18) | ((c2 & 0x3F) << 12)
1285 | ((c3 & 0x3F) << 6) | (c4 & 0x3F));
1286 if (c < 0x10000)
1287 goto invalid_code;
1288 }
1289 else
1290 {
1291 ONE_MORE_BYTE (c5);
1292 if (c5 < 0 || ! UTF_8_EXTRA_OCTET_P (c5))
1293 goto invalid_code;
1294 if (UTF_8_5_OCTET_LEADING_P (c1))
1295 {
1296 c = (((c1 & 0x3) << 24) | ((c2 & 0x3F) << 18)
1297 | ((c3 & 0x3F) << 12) | ((c4 & 0x3F) << 6)
1298 | (c5 & 0x3F));
1299 if ((c > MAX_CHAR) || (c < 0x200000))
1300 goto invalid_code;
1301 }
1302 else
1303 goto invalid_code;
1304 }
1305 }
1306 }
1307 }
1308
1309 *charbuf++ = c;
1310 continue;
1311
1312 invalid_code:
1313 src = src_base;
1314 consumed_chars = consumed_chars_base;
1315 ONE_MORE_BYTE (c);
1316 *charbuf++ = ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c);
1317 coding->errors++;
1318 }
1319
1320 no_more_source:
1321 coding->consumed_char += consumed_chars_base;
1322 coding->consumed = src_base - coding->source;
1323 coding->charbuf_used = charbuf - coding->charbuf;
1324 }
1325
1326
1327 static int
1328 encode_coding_utf_8 (coding)
1329 struct coding_system *coding;
1330 {
1331 int multibytep = coding->dst_multibyte;
1332 int *charbuf = coding->charbuf;
1333 int *charbuf_end = charbuf + coding->charbuf_used;
1334 unsigned char *dst = coding->destination + coding->produced;
1335 unsigned char *dst_end = coding->destination + coding->dst_bytes;
1336 int produced_chars = 0;
1337 int c;
1338
1339 if (multibytep)
1340 {
1341 int safe_room = MAX_MULTIBYTE_LENGTH * 2;
1342
1343 while (charbuf < charbuf_end)
1344 {
1345 unsigned char str[MAX_MULTIBYTE_LENGTH], *p, *pend = str;
1346
1347 ASSURE_DESTINATION (safe_room);
1348 c = *charbuf++;
1349 if (CHAR_BYTE8_P (c))
1350 {
1351 c = CHAR_TO_BYTE8 (c);
1352 EMIT_ONE_BYTE (c);
1353 }
1354 else
1355 {
1356 CHAR_STRING_ADVANCE (c, pend);
1357 for (p = str; p < pend; p++)
1358 EMIT_ONE_BYTE (*p);
1359 }
1360 }
1361 }
1362 else
1363 {
1364 int safe_room = MAX_MULTIBYTE_LENGTH;
1365
1366 while (charbuf < charbuf_end)
1367 {
1368 ASSURE_DESTINATION (safe_room);
1369 c = *charbuf++;
1370 if (CHAR_BYTE8_P (c))
1371 *dst++ = CHAR_TO_BYTE8 (c);
1372 else
1373 dst += CHAR_STRING (c, dst);
1374 produced_chars++;
1375 }
1376 }
1377 record_conversion_result (coding, CODING_RESULT_SUCCESS);
1378 coding->produced_char += produced_chars;
1379 coding->produced = dst - coding->destination;
1380 return 0;
1381 }
1382
1383
1384 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
1385 Check if a text is encoded in one of UTF-16 based coding systems.
1386 If it is, return 1, else return 0. */
1387
1388 #define UTF_16_HIGH_SURROGATE_P(val) \
1389 (((val) & 0xFC00) == 0xD800)
1390
1391 #define UTF_16_LOW_SURROGATE_P(val) \
1392 (((val) & 0xFC00) == 0xDC00)
1393
1394 #define UTF_16_INVALID_P(val) \
1395 (((val) == 0xFFFE) \
1396 || ((val) == 0xFFFF) \
1397 || UTF_16_LOW_SURROGATE_P (val))
1398
1399
1400 static int
1401 detect_coding_utf_16 (coding, detect_info)
1402 struct coding_system *coding;
1403 struct coding_detection_info *detect_info;
1404 {
1405 const unsigned char *src = coding->source, *src_base = src;
1406 const unsigned char *src_end = coding->source + coding->src_bytes;
1407 int multibytep = coding->src_multibyte;
1408 int consumed_chars = 0;
1409 int c1, c2;
1410
1411 detect_info->checked |= CATEGORY_MASK_UTF_16;
1412 if (coding->mode & CODING_MODE_LAST_BLOCK
1413 && (coding->src_chars & 1))
1414 {
1415 detect_info->rejected |= CATEGORY_MASK_UTF_16;
1416 return 0;
1417 }
1418
1419 ONE_MORE_BYTE (c1);
1420 ONE_MORE_BYTE (c2);
1421 if ((c1 == 0xFF) && (c2 == 0xFE))
1422 {
1423 detect_info->found |= (CATEGORY_MASK_UTF_16_LE
1424 | CATEGORY_MASK_UTF_16_AUTO);
1425 detect_info->rejected |= (CATEGORY_MASK_UTF_16_BE
1426 | CATEGORY_MASK_UTF_16_BE_NOSIG
1427 | CATEGORY_MASK_UTF_16_LE_NOSIG);
1428 }
1429 else if ((c1 == 0xFE) && (c2 == 0xFF))
1430 {
1431 detect_info->found |= (CATEGORY_MASK_UTF_16_BE
1432 | CATEGORY_MASK_UTF_16_AUTO);
1433 detect_info->rejected |= (CATEGORY_MASK_UTF_16_LE
1434 | CATEGORY_MASK_UTF_16_BE_NOSIG
1435 | CATEGORY_MASK_UTF_16_LE_NOSIG);
1436 }
1437 else if (c1 >= 0 && c2 >= 0)
1438 {
1439 detect_info->rejected
1440 |= (CATEGORY_MASK_UTF_16_BE | CATEGORY_MASK_UTF_16_LE);
1441 }
1442 no_more_source:
1443 return 1;
1444 }
1445
1446 static void
1447 decode_coding_utf_16 (coding)
1448 struct coding_system *coding;
1449 {
1450 const unsigned char *src = coding->source + coding->consumed;
1451 const unsigned char *src_end = coding->source + coding->src_bytes;
1452 const unsigned char *src_base;
1453 int *charbuf = coding->charbuf + coding->charbuf_used;
1454 int *charbuf_end = coding->charbuf + coding->charbuf_size;
1455 int consumed_chars = 0, consumed_chars_base;
1456 int multibytep = coding->src_multibyte;
1457 enum utf_16_bom_type bom = CODING_UTF_16_BOM (coding);
1458 enum utf_16_endian_type endian = CODING_UTF_16_ENDIAN (coding);
1459 int surrogate = CODING_UTF_16_SURROGATE (coding);
1460 Lisp_Object attr, charset_list;
1461
1462 CODING_GET_INFO (coding, attr, charset_list);
1463
1464 if (bom == utf_16_with_bom)
1465 {
1466 int c, c1, c2;
1467
1468 src_base = src;
1469 ONE_MORE_BYTE (c1);
1470 ONE_MORE_BYTE (c2);
1471 c = (c1 << 8) | c2;
1472
1473 if (endian == utf_16_big_endian
1474 ? c != 0xFEFF : c != 0xFFFE)
1475 {
1476 /* The first two bytes are not BOM. Treat them as bytes
1477 for a normal character. */
1478 src = src_base;
1479 coding->errors++;
1480 }
1481 CODING_UTF_16_BOM (coding) = utf_16_without_bom;
1482 }
1483 else if (bom == utf_16_detect_bom)
1484 {
1485 /* We have already tried to detect BOM and failed in
1486 detect_coding. */
1487 CODING_UTF_16_BOM (coding) = utf_16_without_bom;
1488 }
1489
1490 while (1)
1491 {
1492 int c, c1, c2;
1493
1494 src_base = src;
1495 consumed_chars_base = consumed_chars;
1496
1497 if (charbuf + 2 >= charbuf_end)
1498 break;
1499
1500 ONE_MORE_BYTE (c1);
1501 if (c1 < 0)
1502 {
1503 *charbuf++ = -c1;
1504 continue;
1505 }
1506 ONE_MORE_BYTE (c2);
1507 if (c2 < 0)
1508 {
1509 *charbuf++ = ASCII_BYTE_P (c1) ? c1 : BYTE8_TO_CHAR (c1);
1510 *charbuf++ = -c2;
1511 continue;
1512 }
1513 c = (endian == utf_16_big_endian
1514 ? ((c1 << 8) | c2) : ((c2 << 8) | c1));
1515 if (surrogate)
1516 {
1517 if (! UTF_16_LOW_SURROGATE_P (c))
1518 {
1519 if (endian == utf_16_big_endian)
1520 c1 = surrogate >> 8, c2 = surrogate & 0xFF;
1521 else
1522 c1 = surrogate & 0xFF, c2 = surrogate >> 8;
1523 *charbuf++ = c1;
1524 *charbuf++ = c2;
1525 coding->errors++;
1526 if (UTF_16_HIGH_SURROGATE_P (c))
1527 CODING_UTF_16_SURROGATE (coding) = surrogate = c;
1528 else
1529 *charbuf++ = c;
1530 }
1531 else
1532 {
1533 c = ((surrogate - 0xD800) << 10) | (c - 0xDC00);
1534 CODING_UTF_16_SURROGATE (coding) = surrogate = 0;
1535 *charbuf++ = 0x10000 + c;
1536 }
1537 }
1538 else
1539 {
1540 if (UTF_16_HIGH_SURROGATE_P (c))
1541 CODING_UTF_16_SURROGATE (coding) = surrogate = c;
1542 else
1543 *charbuf++ = c;
1544 }
1545 }
1546
1547 no_more_source:
1548 coding->consumed_char += consumed_chars_base;
1549 coding->consumed = src_base - coding->source;
1550 coding->charbuf_used = charbuf - coding->charbuf;
1551 }
1552
1553 static int
1554 encode_coding_utf_16 (coding)
1555 struct coding_system *coding;
1556 {
1557 int multibytep = coding->dst_multibyte;
1558 int *charbuf = coding->charbuf;
1559 int *charbuf_end = charbuf + coding->charbuf_used;
1560 unsigned char *dst = coding->destination + coding->produced;
1561 unsigned char *dst_end = coding->destination + coding->dst_bytes;
1562 int safe_room = 8;
1563 enum utf_16_bom_type bom = CODING_UTF_16_BOM (coding);
1564 int big_endian = CODING_UTF_16_ENDIAN (coding) == utf_16_big_endian;
1565 int produced_chars = 0;
1566 Lisp_Object attrs, charset_list;
1567 int c;
1568
1569 CODING_GET_INFO (coding, attrs, charset_list);
1570
1571 if (bom != utf_16_without_bom)
1572 {
1573 ASSURE_DESTINATION (safe_room);
1574 if (big_endian)
1575 EMIT_TWO_BYTES (0xFE, 0xFF);
1576 else
1577 EMIT_TWO_BYTES (0xFF, 0xFE);
1578 CODING_UTF_16_BOM (coding) = utf_16_without_bom;
1579 }
1580
1581 while (charbuf < charbuf_end)
1582 {
1583 ASSURE_DESTINATION (safe_room);
1584 c = *charbuf++;
1585 if (c >= MAX_UNICODE_CHAR)
1586 c = coding->default_char;
1587
1588 if (c < 0x10000)
1589 {
1590 if (big_endian)
1591 EMIT_TWO_BYTES (c >> 8, c & 0xFF);
1592 else
1593 EMIT_TWO_BYTES (c & 0xFF, c >> 8);
1594 }
1595 else
1596 {
1597 int c1, c2;
1598
1599 c -= 0x10000;
1600 c1 = (c >> 10) + 0xD800;
1601 c2 = (c & 0x3FF) + 0xDC00;
1602 if (big_endian)
1603 EMIT_FOUR_BYTES (c1 >> 8, c1 & 0xFF, c2 >> 8, c2 & 0xFF);
1604 else
1605 EMIT_FOUR_BYTES (c1 & 0xFF, c1 >> 8, c2 & 0xFF, c2 >> 8);
1606 }
1607 }
1608 record_conversion_result (coding, CODING_RESULT_SUCCESS);
1609 coding->produced = dst - coding->destination;
1610 coding->produced_char += produced_chars;
1611 return 0;
1612 }
1613
1614 \f
1615 /*** 6. Old Emacs' internal format (emacs-mule) ***/
1616
1617 /* Emacs' internal format for representation of multiple character
1618 sets is a kind of multi-byte encoding, i.e. characters are
1619 represented by variable-length sequences of one-byte codes.
1620
1621 ASCII characters and control characters (e.g. `tab', `newline') are
1622 represented by one-byte sequences which are their ASCII codes, in
1623 the range 0x00 through 0x7F.
1624
1625 8-bit characters of the range 0x80..0x9F are represented by
1626 two-byte sequences of LEADING_CODE_8_BIT_CONTROL and (their 8-bit
1627 code + 0x20).
1628
1629 8-bit characters of the range 0xA0..0xFF are represented by
1630 one-byte sequences which are their 8-bit code.
1631
1632 The other characters are represented by a sequence of `base
1633 leading-code', optional `extended leading-code', and one or two
1634 `position-code's. The length of the sequence is determined by the
1635 base leading-code. Leading-code takes the range 0x81 through 0x9D,
1636 whereas extended leading-code and position-code take the range 0xA0
1637 through 0xFF. See `charset.h' for more details about leading-code
1638 and position-code.
1639
1640 --- CODE RANGE of Emacs' internal format ---
1641 character set range
1642 ------------- -----
1643 ascii 0x00..0x7F
1644 eight-bit-control LEADING_CODE_8_BIT_CONTROL + 0xA0..0xBF
1645 eight-bit-graphic 0xA0..0xBF
1646 ELSE 0x81..0x9D + [0xA0..0xFF]+
1647 ---------------------------------------------
1648
1649 As this is the internal character representation, the format is
1650 usually not used externally (i.e. in a file or in a data sent to a
1651 process). But, it is possible to have a text externally in this
1652 format (i.e. by encoding by the coding system `emacs-mule').
1653
1654 In that case, a sequence of one-byte codes has a slightly different
1655 form.
1656
1657 At first, all characters in eight-bit-control are represented by
1658 one-byte sequences which are their 8-bit code.
1659
1660 Next, character composition data are represented by the byte
1661 sequence of the form: 0x80 METHOD BYTES CHARS COMPONENT ...,
1662 where,
1663 METHOD is 0xF0 plus one of composition method (enum
1664 composition_method),
1665
1666 BYTES is 0xA0 plus a byte length of this composition data,
1667
1668 CHARS is 0x20 plus a number of characters composed by this
1669 data,
1670
1671 COMPONENTs are characters of multibye form or composition
1672 rules encoded by two-byte of ASCII codes.
1673
1674 In addition, for backward compatibility, the following formats are
1675 also recognized as composition data on decoding.
1676
1677 0x80 MSEQ ...
1678 0x80 0xFF MSEQ RULE MSEQ RULE ... MSEQ
1679
1680 Here,
1681 MSEQ is a multibyte form but in these special format:
1682 ASCII: 0xA0 ASCII_CODE+0x80,
1683 other: LEADING_CODE+0x20 FOLLOWING-BYTE ...,
1684 RULE is a one byte code of the range 0xA0..0xF0 that
1685 represents a composition rule.
1686 */
1687
1688 char emacs_mule_bytes[256];
1689
1690 int
1691 emacs_mule_char (coding, src, nbytes, nchars, id)
1692 struct coding_system *coding;
1693 const unsigned char *src;
1694 int *nbytes, *nchars, *id;
1695 {
1696 const unsigned char *src_end = coding->source + coding->src_bytes;
1697 const unsigned char *src_base = src;
1698 int multibytep = coding->src_multibyte;
1699 struct charset *charset;
1700 unsigned code;
1701 int c;
1702 int consumed_chars = 0;
1703
1704 ONE_MORE_BYTE (c);
1705 if (c < 0)
1706 {
1707 c = -c;
1708 charset = emacs_mule_charset[0];
1709 }
1710 else
1711 {
1712 if (c >= 0xA0)
1713 {
1714 /* Old style component character of a compostion. */
1715 if (c == 0xA0)
1716 {
1717 ONE_MORE_BYTE (c);
1718 c -= 0x80;
1719 }
1720 else
1721 c -= 0x20;
1722 }
1723
1724 switch (emacs_mule_bytes[c])
1725 {
1726 case 2:
1727 if (! (charset = emacs_mule_charset[c]))
1728 goto invalid_code;
1729 ONE_MORE_BYTE (c);
1730 if (c < 0xA0)
1731 goto invalid_code;
1732 code = c & 0x7F;
1733 break;
1734
1735 case 3:
1736 if (c == EMACS_MULE_LEADING_CODE_PRIVATE_11
1737 || c == EMACS_MULE_LEADING_CODE_PRIVATE_12)
1738 {
1739 ONE_MORE_BYTE (c);
1740 if (c < 0xA0 || ! (charset = emacs_mule_charset[c]))
1741 goto invalid_code;
1742 ONE_MORE_BYTE (c);
1743 if (c < 0xA0)
1744 goto invalid_code;
1745 code = c & 0x7F;
1746 }
1747 else
1748 {
1749 if (! (charset = emacs_mule_charset[c]))
1750 goto invalid_code;
1751 ONE_MORE_BYTE (c);
1752 if (c < 0xA0)
1753 goto invalid_code;
1754 code = (c & 0x7F) << 8;
1755 ONE_MORE_BYTE (c);
1756 if (c < 0xA0)
1757 goto invalid_code;
1758 code |= c & 0x7F;
1759 }
1760 break;
1761
1762 case 4:
1763 ONE_MORE_BYTE (c);
1764 if (c < 0 || ! (charset = emacs_mule_charset[c]))
1765 goto invalid_code;
1766 ONE_MORE_BYTE (c);
1767 if (c < 0xA0)
1768 goto invalid_code;
1769 code = (c & 0x7F) << 8;
1770 ONE_MORE_BYTE (c);
1771 if (c < 0xA0)
1772 goto invalid_code;
1773 code |= c & 0x7F;
1774 break;
1775
1776 case 1:
1777 code = c;
1778 charset = CHARSET_FROM_ID (ASCII_BYTE_P (code)
1779 ? charset_ascii : charset_eight_bit);
1780 break;
1781
1782 default:
1783 abort ();
1784 }
1785 c = DECODE_CHAR (charset, code);
1786 if (c < 0)
1787 goto invalid_code;
1788 }
1789 *nbytes = src - src_base;
1790 *nchars = consumed_chars;
1791 if (id)
1792 *id = charset->id;
1793 return c;
1794
1795 no_more_source:
1796 return -2;
1797
1798 invalid_code:
1799 return -1;
1800 }
1801
1802
1803 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
1804 Check if a text is encoded in `emacs-mule'. If it is, return 1,
1805 else return 0. */
1806
1807 static int
1808 detect_coding_emacs_mule (coding, detect_info)
1809 struct coding_system *coding;
1810 struct coding_detection_info *detect_info;
1811 {
1812 const unsigned char *src = coding->source, *src_base;
1813 const unsigned char *src_end = coding->source + coding->src_bytes;
1814 int multibytep = coding->src_multibyte;
1815 int consumed_chars = 0;
1816 int c;
1817 int found = 0;
1818
1819 detect_info->checked |= CATEGORY_MASK_EMACS_MULE;
1820 /* A coding system of this category is always ASCII compatible. */
1821 src += coding->head_ascii;
1822
1823 while (1)
1824 {
1825 src_base = src;
1826 ONE_MORE_BYTE (c);
1827 if (c < 0)
1828 continue;
1829 if (c == 0x80)
1830 {
1831 /* Perhaps the start of composite character. We simple skip
1832 it because analyzing it is too heavy for detecting. But,
1833 at least, we check that the composite character
1834 constitues of more than 4 bytes. */
1835 const unsigned char *src_base;
1836
1837 repeat:
1838 src_base = src;
1839 do
1840 {
1841 ONE_MORE_BYTE (c);
1842 }
1843 while (c >= 0xA0);
1844
1845 if (src - src_base <= 4)
1846 break;
1847 found = CATEGORY_MASK_EMACS_MULE;
1848 if (c == 0x80)
1849 goto repeat;
1850 }
1851
1852 if (c < 0x80)
1853 {
1854 if (c < 0x20
1855 && (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO))
1856 break;
1857 }
1858 else
1859 {
1860 int more_bytes = emacs_mule_bytes[*src_base] - 1;
1861
1862 while (more_bytes > 0)
1863 {
1864 ONE_MORE_BYTE (c);
1865 if (c < 0xA0)
1866 {
1867 src--; /* Unread the last byte. */
1868 break;
1869 }
1870 more_bytes--;
1871 }
1872 if (more_bytes != 0)
1873 break;
1874 found = CATEGORY_MASK_EMACS_MULE;
1875 }
1876 }
1877 detect_info->rejected |= CATEGORY_MASK_EMACS_MULE;
1878 return 0;
1879
1880 no_more_source:
1881 if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK)
1882 {
1883 detect_info->rejected |= CATEGORY_MASK_EMACS_MULE;
1884 return 0;
1885 }
1886 detect_info->found |= found;
1887 return 1;
1888 }
1889
1890
1891 /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
1892
1893 /* Decode a character represented as a component of composition
1894 sequence of Emacs 20/21 style at SRC. Set C to that character and
1895 update SRC to the head of next character (or an encoded composition
1896 rule). If SRC doesn't points a composition component, set C to -1.
1897 If SRC points an invalid byte sequence, global exit by a return
1898 value 0. */
1899
1900 #define DECODE_EMACS_MULE_COMPOSITION_CHAR(buf) \
1901 if (1) \
1902 { \
1903 int c; \
1904 int nbytes, nchars; \
1905 \
1906 if (src == src_end) \
1907 break; \
1908 c = emacs_mule_char (coding, src, &nbytes, &nchars, NULL);\
1909 if (c < 0) \
1910 { \
1911 if (c == -2) \
1912 break; \
1913 goto invalid_code; \
1914 } \
1915 *buf++ = c; \
1916 src += nbytes; \
1917 consumed_chars += nchars; \
1918 } \
1919 else
1920
1921
1922 /* Decode a composition rule represented as a component of composition
1923 sequence of Emacs 20 style at SRC. Store the decoded rule in *BUF,
1924 and increment BUF. If SRC points an invalid byte sequence, set C
1925 to -1. */
1926
1927 #define DECODE_EMACS_MULE_COMPOSITION_RULE_20(buf) \
1928 do { \
1929 int c, gref, nref; \
1930 \
1931 if (src >= src_end) \
1932 goto invalid_code; \
1933 ONE_MORE_BYTE_NO_CHECK (c); \
1934 c -= 0xA0; \
1935 if (c < 0 || c >= 81) \
1936 goto invalid_code; \
1937 \
1938 gref = c / 9, nref = c % 9; \
1939 *buf++ = COMPOSITION_ENCODE_RULE (gref, nref); \
1940 } while (0)
1941
1942
1943 /* Decode a composition rule represented as a component of composition
1944 sequence of Emacs 21 style at SRC. Store the decoded rule in *BUF,
1945 and increment BUF. If SRC points an invalid byte sequence, set C
1946 to -1. */
1947
1948 #define DECODE_EMACS_MULE_COMPOSITION_RULE_21(buf) \
1949 do { \
1950 int gref, nref; \
1951 \
1952 if (src + 1>= src_end) \
1953 goto invalid_code; \
1954 ONE_MORE_BYTE_NO_CHECK (gref); \
1955 gref -= 0x20; \
1956 ONE_MORE_BYTE_NO_CHECK (nref); \
1957 nref -= 0x20; \
1958 if (gref < 0 || gref >= 81 \
1959 || nref < 0 || nref >= 81) \
1960 goto invalid_code; \
1961 *buf++ = COMPOSITION_ENCODE_RULE (gref, nref); \
1962 } while (0)
1963
1964
1965 #define DECODE_EMACS_MULE_21_COMPOSITION(c) \
1966 do { \
1967 /* Emacs 21 style format. The first three bytes at SRC are \
1968 (METHOD - 0xF2), (BYTES - 0xA0), (CHARS - 0xA0), where BYTES is \
1969 the byte length of this composition information, CHARS is the \
1970 number of characters composed by this composition. */ \
1971 enum composition_method method = c - 0xF2; \
1972 int *charbuf_base = charbuf; \
1973 int consumed_chars_limit; \
1974 int nbytes, nchars; \
1975 \
1976 ONE_MORE_BYTE (c); \
1977 if (c < 0) \
1978 goto invalid_code; \
1979 nbytes = c - 0xA0; \
1980 if (nbytes < 3) \
1981 goto invalid_code; \
1982 ONE_MORE_BYTE (c); \
1983 if (c < 0) \
1984 goto invalid_code; \
1985 nchars = c - 0xA0; \
1986 ADD_COMPOSITION_DATA (charbuf, nchars, method); \
1987 consumed_chars_limit = consumed_chars_base + nbytes; \
1988 if (method != COMPOSITION_RELATIVE) \
1989 { \
1990 int i = 0; \
1991 while (consumed_chars < consumed_chars_limit) \
1992 { \
1993 if (i % 2 && method != COMPOSITION_WITH_ALTCHARS) \
1994 DECODE_EMACS_MULE_COMPOSITION_RULE_21 (charbuf); \
1995 else \
1996 DECODE_EMACS_MULE_COMPOSITION_CHAR (charbuf); \
1997 i++; \
1998 } \
1999 if (consumed_chars < consumed_chars_limit) \
2000 goto invalid_code; \
2001 charbuf_base[0] -= i; \
2002 } \
2003 } while (0)
2004
2005
2006 #define DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION(c) \
2007 do { \
2008 /* Emacs 20 style format for relative composition. */ \
2009 /* Store multibyte form of characters to be composed. */ \
2010 enum composition_method method = COMPOSITION_RELATIVE; \
2011 int components[MAX_COMPOSITION_COMPONENTS * 2 - 1]; \
2012 int *buf = components; \
2013 int i, j; \
2014 \
2015 src = src_base; \
2016 ONE_MORE_BYTE (c); /* skip 0x80 */ \
2017 for (i = 0; *src >= 0xA0 && i < MAX_COMPOSITION_COMPONENTS; i++) \
2018 DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
2019 if (i < 2) \
2020 goto invalid_code; \
2021 ADD_COMPOSITION_DATA (charbuf, i, method); \
2022 for (j = 0; j < i; j++) \
2023 *charbuf++ = components[j]; \
2024 } while (0)
2025
2026
2027 #define DECODE_EMACS_MULE_20_RULEBASE_COMPOSITION(c) \
2028 do { \
2029 /* Emacs 20 style format for rule-base composition. */ \
2030 /* Store multibyte form of characters to be composed. */ \
2031 enum composition_method method = COMPOSITION_WITH_RULE; \
2032 int *charbuf_base = charbuf; \
2033 int components[MAX_COMPOSITION_COMPONENTS * 2 - 1]; \
2034 int *buf = components; \
2035 int i, j; \
2036 \
2037 DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
2038 for (i = 1; i < MAX_COMPOSITION_COMPONENTS; i++) \
2039 { \
2040 if (*src < 0xA0) \
2041 break; \
2042 DECODE_EMACS_MULE_COMPOSITION_RULE_20 (buf); \
2043 DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
2044 } \
2045 if (i <= 1 || (buf - components) % 2 == 0) \
2046 goto invalid_code; \
2047 if (charbuf + i + (i / 2) + 1 >= charbuf_end) \
2048 goto no_more_source; \
2049 ADD_COMPOSITION_DATA (charbuf, i, method); \
2050 i = i * 2 - 1; \
2051 for (j = 0; j < i; j++) \
2052 *charbuf++ = components[j]; \
2053 charbuf_base[0] -= i; \
2054 for (j = 0; j < i; j += 2) \
2055 *charbuf++ = components[j]; \
2056 } while (0)
2057
2058
2059 static void
2060 decode_coding_emacs_mule (coding)
2061 struct coding_system *coding;
2062 {
2063 const unsigned char *src = coding->source + coding->consumed;
2064 const unsigned char *src_end = coding->source + coding->src_bytes;
2065 const unsigned char *src_base;
2066 int *charbuf = coding->charbuf + coding->charbuf_used;
2067 int *charbuf_end
2068 = coding->charbuf + coding->charbuf_size - MAX_ANNOTATION_LENGTH;
2069 int consumed_chars = 0, consumed_chars_base;
2070 int multibytep = coding->src_multibyte;
2071 Lisp_Object attrs, charset_list;
2072 int char_offset = coding->produced_char;
2073 int last_offset = char_offset;
2074 int last_id = charset_ascii;
2075
2076 CODING_GET_INFO (coding, attrs, charset_list);
2077
2078 while (1)
2079 {
2080 int c;
2081
2082 src_base = src;
2083 consumed_chars_base = consumed_chars;
2084
2085 if (charbuf >= charbuf_end)
2086 break;
2087
2088 ONE_MORE_BYTE (c);
2089 if (c < 0)
2090 {
2091 *charbuf++ = -c;
2092 char_offset++;
2093 }
2094 else if (c < 0x80)
2095 {
2096 *charbuf++ = c;
2097 char_offset++;
2098 }
2099 else if (c == 0x80)
2100 {
2101 ONE_MORE_BYTE (c);
2102 if (c < 0)
2103 goto invalid_code;
2104 if (c - 0xF2 >= COMPOSITION_RELATIVE
2105 && c - 0xF2 <= COMPOSITION_WITH_RULE_ALTCHARS)
2106 DECODE_EMACS_MULE_21_COMPOSITION (c);
2107 else if (c < 0xC0)
2108 DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION (c);
2109 else if (c == 0xFF)
2110 DECODE_EMACS_MULE_20_RULEBASE_COMPOSITION (c);
2111 else
2112 goto invalid_code;
2113 }
2114 else if (c < 0xA0 && emacs_mule_bytes[c] > 1)
2115 {
2116 int nbytes, nchars;
2117 int id;
2118
2119 src = src_base;
2120 consumed_chars = consumed_chars_base;
2121 c = emacs_mule_char (coding, src, &nbytes, &nchars, &id);
2122 if (c < 0)
2123 {
2124 if (c == -2)
2125 break;
2126 goto invalid_code;
2127 }
2128 if (last_id != id)
2129 {
2130 if (last_id != charset_ascii)
2131 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
2132 last_id = id;
2133 last_offset = char_offset;
2134 }
2135 *charbuf++ = c;
2136 src += nbytes;
2137 consumed_chars += nchars;
2138 char_offset++;
2139 }
2140 else
2141 goto invalid_code;
2142 continue;
2143
2144 invalid_code:
2145 src = src_base;
2146 consumed_chars = consumed_chars_base;
2147 ONE_MORE_BYTE (c);
2148 *charbuf++ = ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c);
2149 char_offset++;
2150 coding->errors++;
2151 }
2152
2153 no_more_source:
2154 if (last_id != charset_ascii)
2155 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
2156 coding->consumed_char += consumed_chars_base;
2157 coding->consumed = src_base - coding->source;
2158 coding->charbuf_used = charbuf - coding->charbuf;
2159 }
2160
2161
2162 #define EMACS_MULE_LEADING_CODES(id, codes) \
2163 do { \
2164 if (id < 0xA0) \
2165 codes[0] = id, codes[1] = 0; \
2166 else if (id < 0xE0) \
2167 codes[0] = 0x9A, codes[1] = id; \
2168 else if (id < 0xF0) \
2169 codes[0] = 0x9B, codes[1] = id; \
2170 else if (id < 0xF5) \
2171 codes[0] = 0x9C, codes[1] = id; \
2172 else \
2173 codes[0] = 0x9D, codes[1] = id; \
2174 } while (0);
2175
2176
2177 static int
2178 encode_coding_emacs_mule (coding)
2179 struct coding_system *coding;
2180 {
2181 int multibytep = coding->dst_multibyte;
2182 int *charbuf = coding->charbuf;
2183 int *charbuf_end = charbuf + coding->charbuf_used;
2184 unsigned char *dst = coding->destination + coding->produced;
2185 unsigned char *dst_end = coding->destination + coding->dst_bytes;
2186 int safe_room = 8;
2187 int produced_chars = 0;
2188 Lisp_Object attrs, charset_list;
2189 int c;
2190 int preferred_charset_id = -1;
2191
2192 CODING_GET_INFO (coding, attrs, charset_list);
2193 if (! EQ (charset_list, Vemacs_mule_charset_list))
2194 {
2195 CODING_ATTR_CHARSET_LIST (attrs)
2196 = charset_list = Vemacs_mule_charset_list;
2197 }
2198
2199 while (charbuf < charbuf_end)
2200 {
2201 ASSURE_DESTINATION (safe_room);
2202 c = *charbuf++;
2203
2204 if (c < 0)
2205 {
2206 /* Handle an annotation. */
2207 switch (*charbuf)
2208 {
2209 case CODING_ANNOTATE_COMPOSITION_MASK:
2210 /* Not yet implemented. */
2211 break;
2212 case CODING_ANNOTATE_CHARSET_MASK:
2213 preferred_charset_id = charbuf[3];
2214 if (preferred_charset_id >= 0
2215 && NILP (Fmemq (make_number (preferred_charset_id),
2216 charset_list)))
2217 preferred_charset_id = -1;
2218 break;
2219 default:
2220 abort ();
2221 }
2222 charbuf += -c - 1;
2223 continue;
2224 }
2225
2226 if (ASCII_CHAR_P (c))
2227 EMIT_ONE_ASCII_BYTE (c);
2228 else if (CHAR_BYTE8_P (c))
2229 {
2230 c = CHAR_TO_BYTE8 (c);
2231 EMIT_ONE_BYTE (c);
2232 }
2233 else
2234 {
2235 struct charset *charset;
2236 unsigned code;
2237 int dimension;
2238 int emacs_mule_id;
2239 unsigned char leading_codes[2];
2240
2241 if (preferred_charset_id >= 0)
2242 {
2243 charset = CHARSET_FROM_ID (preferred_charset_id);
2244 if (! CHAR_CHARSET_P (c, charset))
2245 charset = char_charset (c, charset_list, NULL);
2246 }
2247 else
2248 charset = char_charset (c, charset_list, &code);
2249 if (! charset)
2250 {
2251 c = coding->default_char;
2252 if (ASCII_CHAR_P (c))
2253 {
2254 EMIT_ONE_ASCII_BYTE (c);
2255 continue;
2256 }
2257 charset = char_charset (c, charset_list, &code);
2258 }
2259 dimension = CHARSET_DIMENSION (charset);
2260 emacs_mule_id = CHARSET_EMACS_MULE_ID (charset);
2261 EMACS_MULE_LEADING_CODES (emacs_mule_id, leading_codes);
2262 EMIT_ONE_BYTE (leading_codes[0]);
2263 if (leading_codes[1])
2264 EMIT_ONE_BYTE (leading_codes[1]);
2265 if (dimension == 1)
2266 EMIT_ONE_BYTE (code | 0x80);
2267 else
2268 {
2269 code |= 0x8080;
2270 EMIT_ONE_BYTE (code >> 8);
2271 EMIT_ONE_BYTE (code & 0xFF);
2272 }
2273 }
2274 }
2275 record_conversion_result (coding, CODING_RESULT_SUCCESS);
2276 coding->produced_char += produced_chars;
2277 coding->produced = dst - coding->destination;
2278 return 0;
2279 }
2280
2281 \f
2282 /*** 7. ISO2022 handlers ***/
2283
2284 /* The following note describes the coding system ISO2022 briefly.
2285 Since the intention of this note is to help understand the
2286 functions in this file, some parts are NOT ACCURATE or are OVERLY
2287 SIMPLIFIED. For thorough understanding, please refer to the
2288 original document of ISO2022. This is equivalent to the standard
2289 ECMA-35, obtainable from <URL:http://www.ecma.ch/> (*).
2290
2291 ISO2022 provides many mechanisms to encode several character sets
2292 in 7-bit and 8-bit environments. For 7-bit environments, all text
2293 is encoded using bytes less than 128. This may make the encoded
2294 text a little bit longer, but the text passes more easily through
2295 several types of gateway, some of which strip off the MSB (Most
2296 Significant Bit).
2297
2298 There are two kinds of character sets: control character sets and
2299 graphic character sets. The former contain control characters such
2300 as `newline' and `escape' to provide control functions (control
2301 functions are also provided by escape sequences). The latter
2302 contain graphic characters such as 'A' and '-'. Emacs recognizes
2303 two control character sets and many graphic character sets.
2304
2305 Graphic character sets are classified into one of the following
2306 four classes, according to the number of bytes (DIMENSION) and
2307 number of characters in one dimension (CHARS) of the set:
2308 - DIMENSION1_CHARS94
2309 - DIMENSION1_CHARS96
2310 - DIMENSION2_CHARS94
2311 - DIMENSION2_CHARS96
2312
2313 In addition, each character set is assigned an identification tag,
2314 unique for each set, called the "final character" (denoted as <F>
2315 hereafter). The <F> of each character set is decided by ECMA(*)
2316 when it is registered in ISO. The code range of <F> is 0x30..0x7F
2317 (0x30..0x3F are for private use only).
2318
2319 Note (*): ECMA = European Computer Manufacturers Association
2320
2321 Here are examples of graphic character sets [NAME(<F>)]:
2322 o DIMENSION1_CHARS94 -- ASCII('B'), right-half-of-JISX0201('I'), ...
2323 o DIMENSION1_CHARS96 -- right-half-of-ISO8859-1('A'), ...
2324 o DIMENSION2_CHARS94 -- GB2312('A'), JISX0208('B'), ...
2325 o DIMENSION2_CHARS96 -- none for the moment
2326
2327 A code area (1 byte=8 bits) is divided into 4 areas, C0, GL, C1, and GR.
2328 C0 [0x00..0x1F] -- control character plane 0
2329 GL [0x20..0x7F] -- graphic character plane 0
2330 C1 [0x80..0x9F] -- control character plane 1
2331 GR [0xA0..0xFF] -- graphic character plane 1
2332
2333 A control character set is directly designated and invoked to C0 or
2334 C1 by an escape sequence. The most common case is that:
2335 - ISO646's control character set is designated/invoked to C0, and
2336 - ISO6429's control character set is designated/invoked to C1,
2337 and usually these designations/invocations are omitted in encoded
2338 text. In a 7-bit environment, only C0 can be used, and a control
2339 character for C1 is encoded by an appropriate escape sequence to
2340 fit into the environment. All control characters for C1 are
2341 defined to have corresponding escape sequences.
2342
2343 A graphic character set is at first designated to one of four
2344 graphic registers (G0 through G3), then these graphic registers are
2345 invoked to GL or GR. These designations and invocations can be
2346 done independently. The most common case is that G0 is invoked to
2347 GL, G1 is invoked to GR, and ASCII is designated to G0. Usually
2348 these invocations and designations are omitted in encoded text.
2349 In a 7-bit environment, only GL can be used.
2350
2351 When a graphic character set of CHARS94 is invoked to GL, codes
2352 0x20 and 0x7F of the GL area work as control characters SPACE and
2353 DEL respectively, and codes 0xA0 and 0xFF of the GR area should not
2354 be used.
2355
2356 There are two ways of invocation: locking-shift and single-shift.
2357 With locking-shift, the invocation lasts until the next different
2358 invocation, whereas with single-shift, the invocation affects the
2359 following character only and doesn't affect the locking-shift
2360 state. Invocations are done by the following control characters or
2361 escape sequences:
2362
2363 ----------------------------------------------------------------------
2364 abbrev function cntrl escape seq description
2365 ----------------------------------------------------------------------
2366 SI/LS0 (shift-in) 0x0F none invoke G0 into GL
2367 SO/LS1 (shift-out) 0x0E none invoke G1 into GL
2368 LS2 (locking-shift-2) none ESC 'n' invoke G2 into GL
2369 LS3 (locking-shift-3) none ESC 'o' invoke G3 into GL
2370 LS1R (locking-shift-1 right) none ESC '~' invoke G1 into GR (*)
2371 LS2R (locking-shift-2 right) none ESC '}' invoke G2 into GR (*)
2372 LS3R (locking-shift 3 right) none ESC '|' invoke G3 into GR (*)
2373 SS2 (single-shift-2) 0x8E ESC 'N' invoke G2 for one char
2374 SS3 (single-shift-3) 0x8F ESC 'O' invoke G3 for one char
2375 ----------------------------------------------------------------------
2376 (*) These are not used by any known coding system.
2377
2378 Control characters for these functions are defined by macros
2379 ISO_CODE_XXX in `coding.h'.
2380
2381 Designations are done by the following escape sequences:
2382 ----------------------------------------------------------------------
2383 escape sequence description
2384 ----------------------------------------------------------------------
2385 ESC '(' <F> designate DIMENSION1_CHARS94<F> to G0
2386 ESC ')' <F> designate DIMENSION1_CHARS94<F> to G1
2387 ESC '*' <F> designate DIMENSION1_CHARS94<F> to G2
2388 ESC '+' <F> designate DIMENSION1_CHARS94<F> to G3
2389 ESC ',' <F> designate DIMENSION1_CHARS96<F> to G0 (*)
2390 ESC '-' <F> designate DIMENSION1_CHARS96<F> to G1
2391 ESC '.' <F> designate DIMENSION1_CHARS96<F> to G2
2392 ESC '/' <F> designate DIMENSION1_CHARS96<F> to G3
2393 ESC '$' '(' <F> designate DIMENSION2_CHARS94<F> to G0 (**)
2394 ESC '$' ')' <F> designate DIMENSION2_CHARS94<F> to G1
2395 ESC '$' '*' <F> designate DIMENSION2_CHARS94<F> to G2
2396 ESC '$' '+' <F> designate DIMENSION2_CHARS94<F> to G3
2397 ESC '$' ',' <F> designate DIMENSION2_CHARS96<F> to G0 (*)
2398 ESC '$' '-' <F> designate DIMENSION2_CHARS96<F> to G1
2399 ESC '$' '.' <F> designate DIMENSION2_CHARS96<F> to G2
2400 ESC '$' '/' <F> designate DIMENSION2_CHARS96<F> to G3
2401 ----------------------------------------------------------------------
2402
2403 In this list, "DIMENSION1_CHARS94<F>" means a graphic character set
2404 of dimension 1, chars 94, and final character <F>, etc...
2405
2406 Note (*): Although these designations are not allowed in ISO2022,
2407 Emacs accepts them on decoding, and produces them on encoding
2408 CHARS96 character sets in a coding system which is characterized as
2409 7-bit environment, non-locking-shift, and non-single-shift.
2410
2411 Note (**): If <F> is '@', 'A', or 'B', the intermediate character
2412 '(' must be omitted. We refer to this as "short-form" hereafter.
2413
2414 Now you may notice that there are a lot of ways of encoding the
2415 same multilingual text in ISO2022. Actually, there exist many
2416 coding systems such as Compound Text (used in X11's inter client
2417 communication, ISO-2022-JP (used in Japanese Internet), ISO-2022-KR
2418 (used in Korean Internet), EUC (Extended UNIX Code, used in Asian
2419 localized platforms), and all of these are variants of ISO2022.
2420
2421 In addition to the above, Emacs handles two more kinds of escape
2422 sequences: ISO6429's direction specification and Emacs' private
2423 sequence for specifying character composition.
2424
2425 ISO6429's direction specification takes the following form:
2426 o CSI ']' -- end of the current direction
2427 o CSI '0' ']' -- end of the current direction
2428 o CSI '1' ']' -- start of left-to-right text
2429 o CSI '2' ']' -- start of right-to-left text
2430 The control character CSI (0x9B: control sequence introducer) is
2431 abbreviated to the escape sequence ESC '[' in a 7-bit environment.
2432
2433 Character composition specification takes the following form:
2434 o ESC '0' -- start relative composition
2435 o ESC '1' -- end composition
2436 o ESC '2' -- start rule-base composition (*)
2437 o ESC '3' -- start relative composition with alternate chars (**)
2438 o ESC '4' -- start rule-base composition with alternate chars (**)
2439 Since these are not standard escape sequences of any ISO standard,
2440 the use of them with these meanings is restricted to Emacs only.
2441
2442 (*) This form is used only in Emacs 20.7 and older versions,
2443 but newer versions can safely decode it.
2444 (**) This form is used only in Emacs 21.1 and newer versions,
2445 and older versions can't decode it.
2446
2447 Here's a list of example usages of these composition escape
2448 sequences (categorized by `enum composition_method').
2449
2450 COMPOSITION_RELATIVE:
2451 ESC 0 CHAR [ CHAR ] ESC 1
2452 COMPOSITION_WITH_RULE:
2453 ESC 2 CHAR [ RULE CHAR ] ESC 1
2454 COMPOSITION_WITH_ALTCHARS:
2455 ESC 3 ALTCHAR [ ALTCHAR ] ESC 0 CHAR [ CHAR ] ESC 1
2456 COMPOSITION_WITH_RULE_ALTCHARS:
2457 ESC 4 ALTCHAR [ RULE ALTCHAR ] ESC 0 CHAR [ CHAR ] ESC 1 */
2458
2459 enum iso_code_class_type iso_code_class[256];
2460
2461 #define SAFE_CHARSET_P(coding, id) \
2462 ((id) <= (coding)->max_charset_id \
2463 && (coding)->safe_charsets[id] >= 0)
2464
2465
2466 #define SHIFT_OUT_OK(category) \
2467 (CODING_ISO_INITIAL (&coding_categories[category], 1) >= 0)
2468
2469 static void
2470 setup_iso_safe_charsets (attrs)
2471 Lisp_Object attrs;
2472 {
2473 Lisp_Object charset_list, safe_charsets;
2474 Lisp_Object request;
2475 Lisp_Object reg_usage;
2476 Lisp_Object tail;
2477 int reg94, reg96;
2478 int flags = XINT (AREF (attrs, coding_attr_iso_flags));
2479 int max_charset_id;
2480
2481 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
2482 if ((flags & CODING_ISO_FLAG_FULL_SUPPORT)
2483 && ! EQ (charset_list, Viso_2022_charset_list))
2484 {
2485 CODING_ATTR_CHARSET_LIST (attrs)
2486 = charset_list = Viso_2022_charset_list;
2487 ASET (attrs, coding_attr_safe_charsets, Qnil);
2488 }
2489
2490 if (STRINGP (AREF (attrs, coding_attr_safe_charsets)))
2491 return;
2492
2493 max_charset_id = 0;
2494 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
2495 {
2496 int id = XINT (XCAR (tail));
2497 if (max_charset_id < id)
2498 max_charset_id = id;
2499 }
2500
2501 safe_charsets = Fmake_string (make_number (max_charset_id + 1),
2502 make_number (255));
2503 request = AREF (attrs, coding_attr_iso_request);
2504 reg_usage = AREF (attrs, coding_attr_iso_usage);
2505 reg94 = XINT (XCAR (reg_usage));
2506 reg96 = XINT (XCDR (reg_usage));
2507
2508 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
2509 {
2510 Lisp_Object id;
2511 Lisp_Object reg;
2512 struct charset *charset;
2513
2514 id = XCAR (tail);
2515 charset = CHARSET_FROM_ID (XINT (id));
2516 reg = Fcdr (Fassq (id, request));
2517 if (! NILP (reg))
2518 SSET (safe_charsets, XINT (id), XINT (reg));
2519 else if (charset->iso_chars_96)
2520 {
2521 if (reg96 < 4)
2522 SSET (safe_charsets, XINT (id), reg96);
2523 }
2524 else
2525 {
2526 if (reg94 < 4)
2527 SSET (safe_charsets, XINT (id), reg94);
2528 }
2529 }
2530 ASET (attrs, coding_attr_safe_charsets, safe_charsets);
2531 }
2532
2533
2534 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
2535 Check if a text is encoded in one of ISO-2022 based codig systems.
2536 If it is, return 1, else return 0. */
2537
2538 static int
2539 detect_coding_iso_2022 (coding, detect_info)
2540 struct coding_system *coding;
2541 struct coding_detection_info *detect_info;
2542 {
2543 const unsigned char *src = coding->source, *src_base = src;
2544 const unsigned char *src_end = coding->source + coding->src_bytes;
2545 int multibytep = coding->src_multibyte;
2546 int single_shifting = 0;
2547 int id;
2548 int c, c1;
2549 int consumed_chars = 0;
2550 int i;
2551 int rejected = 0;
2552 int found = 0;
2553
2554 detect_info->checked |= CATEGORY_MASK_ISO;
2555
2556 for (i = coding_category_iso_7; i <= coding_category_iso_8_else; i++)
2557 {
2558 struct coding_system *this = &(coding_categories[i]);
2559 Lisp_Object attrs, val;
2560
2561 attrs = CODING_ID_ATTRS (this->id);
2562 if (CODING_ISO_FLAGS (this) & CODING_ISO_FLAG_FULL_SUPPORT
2563 && ! EQ (CODING_ATTR_SAFE_CHARSETS (attrs), Viso_2022_charset_list))
2564 setup_iso_safe_charsets (attrs);
2565 val = CODING_ATTR_SAFE_CHARSETS (attrs);
2566 this->max_charset_id = SCHARS (val) - 1;
2567 this->safe_charsets = (char *) SDATA (val);
2568 }
2569
2570 /* A coding system of this category is always ASCII compatible. */
2571 src += coding->head_ascii;
2572
2573 while (rejected != CATEGORY_MASK_ISO)
2574 {
2575 src_base = src;
2576 ONE_MORE_BYTE (c);
2577 switch (c)
2578 {
2579 case ISO_CODE_ESC:
2580 if (inhibit_iso_escape_detection)
2581 break;
2582 single_shifting = 0;
2583 ONE_MORE_BYTE (c);
2584 if (c >= '(' && c <= '/')
2585 {
2586 /* Designation sequence for a charset of dimension 1. */
2587 ONE_MORE_BYTE (c1);
2588 if (c1 < ' ' || c1 >= 0x80
2589 || (id = iso_charset_table[0][c >= ','][c1]) < 0)
2590 /* Invalid designation sequence. Just ignore. */
2591 break;
2592 }
2593 else if (c == '$')
2594 {
2595 /* Designation sequence for a charset of dimension 2. */
2596 ONE_MORE_BYTE (c);
2597 if (c >= '@' && c <= 'B')
2598 /* Designation for JISX0208.1978, GB2312, or JISX0208. */
2599 id = iso_charset_table[1][0][c];
2600 else if (c >= '(' && c <= '/')
2601 {
2602 ONE_MORE_BYTE (c1);
2603 if (c1 < ' ' || c1 >= 0x80
2604 || (id = iso_charset_table[1][c >= ','][c1]) < 0)
2605 /* Invalid designation sequence. Just ignore. */
2606 break;
2607 }
2608 else
2609 /* Invalid designation sequence. Just ignore it. */
2610 break;
2611 }
2612 else if (c == 'N' || c == 'O')
2613 {
2614 /* ESC <Fe> for SS2 or SS3. */
2615 single_shifting = 1;
2616 rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_8BIT;
2617 break;
2618 }
2619 else if (c >= '0' && c <= '4')
2620 {
2621 /* ESC <Fp> for start/end composition. */
2622 found |= CATEGORY_MASK_ISO;
2623 break;
2624 }
2625 else
2626 {
2627 /* Invalid escape sequence. Just ignore it. */
2628 break;
2629 }
2630
2631 /* We found a valid designation sequence for CHARSET. */
2632 rejected |= CATEGORY_MASK_ISO_8BIT;
2633 if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_7],
2634 id))
2635 found |= CATEGORY_MASK_ISO_7;
2636 else
2637 rejected |= CATEGORY_MASK_ISO_7;
2638 if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_7_tight],
2639 id))
2640 found |= CATEGORY_MASK_ISO_7_TIGHT;
2641 else
2642 rejected |= CATEGORY_MASK_ISO_7_TIGHT;
2643 if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_7_else],
2644 id))
2645 found |= CATEGORY_MASK_ISO_7_ELSE;
2646 else
2647 rejected |= CATEGORY_MASK_ISO_7_ELSE;
2648 if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_8_else],
2649 id))
2650 found |= CATEGORY_MASK_ISO_8_ELSE;
2651 else
2652 rejected |= CATEGORY_MASK_ISO_8_ELSE;
2653 break;
2654
2655 case ISO_CODE_SO:
2656 case ISO_CODE_SI:
2657 /* Locking shift out/in. */
2658 if (inhibit_iso_escape_detection)
2659 break;
2660 single_shifting = 0;
2661 rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_8BIT;
2662 found |= CATEGORY_MASK_ISO_ELSE;
2663 break;
2664
2665 case ISO_CODE_CSI:
2666 /* Control sequence introducer. */
2667 single_shifting = 0;
2668 rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_7_ELSE;
2669 found |= CATEGORY_MASK_ISO_8_ELSE;
2670 goto check_extra_latin;
2671
2672 case ISO_CODE_SS2:
2673 case ISO_CODE_SS3:
2674 /* Single shift. */
2675 if (inhibit_iso_escape_detection)
2676 break;
2677 single_shifting = 0;
2678 rejected |= CATEGORY_MASK_ISO_7BIT;
2679 if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_1])
2680 & CODING_ISO_FLAG_SINGLE_SHIFT)
2681 found |= CATEGORY_MASK_ISO_8_1, single_shifting = 1;
2682 if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_2])
2683 & CODING_ISO_FLAG_SINGLE_SHIFT)
2684 found |= CATEGORY_MASK_ISO_8_2, single_shifting = 1;
2685 if (single_shifting)
2686 break;
2687 goto check_extra_latin;
2688
2689 default:
2690 if (c < 0)
2691 continue;
2692 if (c < 0x80)
2693 {
2694 single_shifting = 0;
2695 break;
2696 }
2697 if (c >= 0xA0)
2698 {
2699 rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_7_ELSE;
2700 found |= CATEGORY_MASK_ISO_8_1;
2701 /* Check the length of succeeding codes of the range
2702 0xA0..0FF. If the byte length is even, we include
2703 CATEGORY_MASK_ISO_8_2 in `found'. We can check this
2704 only when we are not single shifting. */
2705 if (! single_shifting
2706 && ! (rejected & CATEGORY_MASK_ISO_8_2))
2707 {
2708 int i = 1;
2709 while (src < src_end)
2710 {
2711 ONE_MORE_BYTE (c);
2712 if (c < 0xA0)
2713 break;
2714 i++;
2715 }
2716
2717 if (i & 1 && src < src_end)
2718 rejected |= CATEGORY_MASK_ISO_8_2;
2719 else
2720 found |= CATEGORY_MASK_ISO_8_2;
2721 }
2722 break;
2723 }
2724 check_extra_latin:
2725 single_shifting = 0;
2726 if (! VECTORP (Vlatin_extra_code_table)
2727 || NILP (XVECTOR (Vlatin_extra_code_table)->contents[c]))
2728 {
2729 rejected = CATEGORY_MASK_ISO;
2730 break;
2731 }
2732 if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_1])
2733 & CODING_ISO_FLAG_LATIN_EXTRA)
2734 found |= CATEGORY_MASK_ISO_8_1;
2735 else
2736 rejected |= CATEGORY_MASK_ISO_8_1;
2737 rejected |= CATEGORY_MASK_ISO_8_2;
2738 }
2739 }
2740 detect_info->rejected |= CATEGORY_MASK_ISO;
2741 return 0;
2742
2743 no_more_source:
2744 detect_info->rejected |= rejected;
2745 detect_info->found |= (found & ~rejected);
2746 return 1;
2747 }
2748
2749
2750 /* Set designation state into CODING. Set CHARS_96 to -1 if the
2751 escape sequence should be kept. */
2752 #define DECODE_DESIGNATION(reg, dim, chars_96, final) \
2753 do { \
2754 int id, prev; \
2755 \
2756 if (final < '0' || final >= 128 \
2757 || ((id = ISO_CHARSET_TABLE (dim, chars_96, final)) < 0) \
2758 || !SAFE_CHARSET_P (coding, id)) \
2759 { \
2760 CODING_ISO_DESIGNATION (coding, reg) = -2; \
2761 chars_96 = -1; \
2762 break; \
2763 } \
2764 prev = CODING_ISO_DESIGNATION (coding, reg); \
2765 if (id == charset_jisx0201_roman) \
2766 { \
2767 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_ROMAN) \
2768 id = charset_ascii; \
2769 } \
2770 else if (id == charset_jisx0208_1978) \
2771 { \
2772 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_OLDJIS) \
2773 id = charset_jisx0208; \
2774 } \
2775 CODING_ISO_DESIGNATION (coding, reg) = id; \
2776 /* If there was an invalid designation to REG previously, and this \
2777 designation is ASCII to REG, we should keep this designation \
2778 sequence. */ \
2779 if (prev == -2 && id == charset_ascii) \
2780 chars_96 = -1; \
2781 } while (0)
2782
2783
2784 #define MAYBE_FINISH_COMPOSITION() \
2785 do { \
2786 int i; \
2787 if (composition_state == COMPOSING_NO) \
2788 break; \
2789 /* It is assured that we have enough room for producing \
2790 characters stored in the table `components'. */ \
2791 if (charbuf + component_idx > charbuf_end) \
2792 goto no_more_source; \
2793 composition_state = COMPOSING_NO; \
2794 if (method == COMPOSITION_RELATIVE \
2795 || method == COMPOSITION_WITH_ALTCHARS) \
2796 { \
2797 for (i = 0; i < component_idx; i++) \
2798 *charbuf++ = components[i]; \
2799 char_offset += component_idx; \
2800 } \
2801 else \
2802 { \
2803 for (i = 0; i < component_idx; i += 2) \
2804 *charbuf++ = components[i]; \
2805 char_offset += (component_idx / 2) + 1; \
2806 } \
2807 } while (0)
2808
2809
2810 /* Handle composition start sequence ESC 0, ESC 2, ESC 3, or ESC 4.
2811 ESC 0 : relative composition : ESC 0 CHAR ... ESC 1
2812 ESC 2 : rulebase composition : ESC 2 CHAR RULE CHAR RULE ... CHAR ESC 1
2813 ESC 3 : altchar composition : ESC 3 CHAR ... ESC 0 CHAR ... ESC 1
2814 ESC 4 : alt&rule composition : ESC 4 CHAR RULE ... CHAR ESC 0 CHAR ... ESC 1
2815 */
2816
2817 #define DECODE_COMPOSITION_START(c1) \
2818 do { \
2819 if (c1 == '0' \
2820 && composition_state == COMPOSING_COMPONENT_RULE) \
2821 { \
2822 component_len = component_idx; \
2823 composition_state = COMPOSING_CHAR; \
2824 } \
2825 else \
2826 { \
2827 const unsigned char *p; \
2828 \
2829 MAYBE_FINISH_COMPOSITION (); \
2830 if (charbuf + MAX_COMPOSITION_COMPONENTS > charbuf_end) \
2831 goto no_more_source; \
2832 for (p = src; p < src_end - 1; p++) \
2833 if (*p == ISO_CODE_ESC && p[1] == '1') \
2834 break; \
2835 if (p == src_end - 1) \
2836 { \
2837 /* The current composition doesn't end in the current \
2838 source. */ \
2839 record_conversion_result \
2840 (coding, CODING_RESULT_INSUFFICIENT_SRC); \
2841 goto no_more_source; \
2842 } \
2843 \
2844 /* This is surely the start of a composition. */ \
2845 method = (c1 == '0' ? COMPOSITION_RELATIVE \
2846 : c1 == '2' ? COMPOSITION_WITH_RULE \
2847 : c1 == '3' ? COMPOSITION_WITH_ALTCHARS \
2848 : COMPOSITION_WITH_RULE_ALTCHARS); \
2849 composition_state = (c1 <= '2' ? COMPOSING_CHAR \
2850 : COMPOSING_COMPONENT_CHAR); \
2851 component_idx = component_len = 0; \
2852 } \
2853 } while (0)
2854
2855
2856 /* Handle compositoin end sequence ESC 1. */
2857
2858 #define DECODE_COMPOSITION_END() \
2859 do { \
2860 int nchars = (component_len > 0 ? component_idx - component_len \
2861 : method == COMPOSITION_RELATIVE ? component_idx \
2862 : (component_idx + 1) / 2); \
2863 int i; \
2864 int *saved_charbuf = charbuf; \
2865 \
2866 ADD_COMPOSITION_DATA (charbuf, nchars, method); \
2867 if (method != COMPOSITION_RELATIVE) \
2868 { \
2869 if (component_len == 0) \
2870 for (i = 0; i < component_idx; i++) \
2871 *charbuf++ = components[i]; \
2872 else \
2873 for (i = 0; i < component_len; i++) \
2874 *charbuf++ = components[i]; \
2875 *saved_charbuf = saved_charbuf - charbuf; \
2876 } \
2877 if (method == COMPOSITION_WITH_RULE) \
2878 for (i = 0; i < component_idx; i += 2, char_offset++) \
2879 *charbuf++ = components[i]; \
2880 else \
2881 for (i = component_len; i < component_idx; i++, char_offset++) \
2882 *charbuf++ = components[i]; \
2883 coding->annotated = 1; \
2884 composition_state = COMPOSING_NO; \
2885 } while (0)
2886
2887
2888 /* Decode a composition rule from the byte C1 (and maybe one more byte
2889 from SRC) and store one encoded composition rule in
2890 coding->cmp_data. */
2891
2892 #define DECODE_COMPOSITION_RULE(c1) \
2893 do { \
2894 (c1) -= 32; \
2895 if (c1 < 81) /* old format (before ver.21) */ \
2896 { \
2897 int gref = (c1) / 9; \
2898 int nref = (c1) % 9; \
2899 if (gref == 4) gref = 10; \
2900 if (nref == 4) nref = 10; \
2901 c1 = COMPOSITION_ENCODE_RULE (gref, nref); \
2902 } \
2903 else if (c1 < 93) /* new format (after ver.21) */ \
2904 { \
2905 ONE_MORE_BYTE (c2); \
2906 c1 = COMPOSITION_ENCODE_RULE (c1 - 81, c2 - 32); \
2907 } \
2908 else \
2909 c1 = 0; \
2910 } while (0)
2911
2912
2913 /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
2914
2915 static void
2916 decode_coding_iso_2022 (coding)
2917 struct coding_system *coding;
2918 {
2919 const unsigned char *src = coding->source + coding->consumed;
2920 const unsigned char *src_end = coding->source + coding->src_bytes;
2921 const unsigned char *src_base;
2922 int *charbuf = coding->charbuf + coding->charbuf_used;
2923 int *charbuf_end
2924 = coding->charbuf + coding->charbuf_size - 4 - MAX_ANNOTATION_LENGTH;
2925 int consumed_chars = 0, consumed_chars_base;
2926 int multibytep = coding->src_multibyte;
2927 /* Charsets invoked to graphic plane 0 and 1 respectively. */
2928 int charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
2929 int charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1);
2930 int charset_id_2, charset_id_3;
2931 struct charset *charset;
2932 int c;
2933 /* For handling composition sequence. */
2934 #define COMPOSING_NO 0
2935 #define COMPOSING_CHAR 1
2936 #define COMPOSING_RULE 2
2937 #define COMPOSING_COMPONENT_CHAR 3
2938 #define COMPOSING_COMPONENT_RULE 4
2939
2940 int composition_state = COMPOSING_NO;
2941 enum composition_method method;
2942 int components[MAX_COMPOSITION_COMPONENTS * 2 + 1];
2943 int component_idx;
2944 int component_len;
2945 Lisp_Object attrs, charset_list;
2946 int char_offset = coding->produced_char;
2947 int last_offset = char_offset;
2948 int last_id = charset_ascii;
2949
2950 CODING_GET_INFO (coding, attrs, charset_list);
2951 setup_iso_safe_charsets (attrs);
2952
2953 while (1)
2954 {
2955 int c1, c2;
2956
2957 src_base = src;
2958 consumed_chars_base = consumed_chars;
2959
2960 if (charbuf >= charbuf_end)
2961 break;
2962
2963 ONE_MORE_BYTE (c1);
2964 if (c1 < 0)
2965 goto invalid_code;
2966
2967 /* We produce at most one character. */
2968 switch (iso_code_class [c1])
2969 {
2970 case ISO_0x20_or_0x7F:
2971 if (composition_state != COMPOSING_NO)
2972 {
2973 if (composition_state == COMPOSING_RULE
2974 || composition_state == COMPOSING_COMPONENT_RULE)
2975 {
2976 DECODE_COMPOSITION_RULE (c1);
2977 components[component_idx++] = c1;
2978 composition_state--;
2979 continue;
2980 }
2981 }
2982 if (charset_id_0 < 0
2983 || ! CHARSET_ISO_CHARS_96 (CHARSET_FROM_ID (charset_id_0)))
2984 /* This is SPACE or DEL. */
2985 charset = CHARSET_FROM_ID (charset_ascii);
2986 else
2987 charset = CHARSET_FROM_ID (charset_id_0);
2988 break;
2989
2990 case ISO_graphic_plane_0:
2991 if (composition_state != COMPOSING_NO)
2992 {
2993 if (composition_state == COMPOSING_RULE
2994 || composition_state == COMPOSING_COMPONENT_RULE)
2995 {
2996 DECODE_COMPOSITION_RULE (c1);
2997 components[component_idx++] = c1;
2998 composition_state--;
2999 continue;
3000 }
3001 }
3002 if (charset_id_0 < 0)
3003 charset = CHARSET_FROM_ID (charset_ascii);
3004 else
3005 charset = CHARSET_FROM_ID (charset_id_0);
3006 break;
3007
3008 case ISO_0xA0_or_0xFF:
3009 if (charset_id_1 < 0
3010 || ! CHARSET_ISO_CHARS_96 (CHARSET_FROM_ID (charset_id_1))
3011 || CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS)
3012 goto invalid_code;
3013 /* This is a graphic character, we fall down ... */
3014
3015 case ISO_graphic_plane_1:
3016 if (charset_id_1 < 0)
3017 goto invalid_code;
3018 charset = CHARSET_FROM_ID (charset_id_1);
3019 break;
3020
3021 case ISO_control_0:
3022 MAYBE_FINISH_COMPOSITION ();
3023 charset = CHARSET_FROM_ID (charset_ascii);
3024 break;
3025
3026 case ISO_control_1:
3027 MAYBE_FINISH_COMPOSITION ();
3028 goto invalid_code;
3029
3030 case ISO_shift_out:
3031 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT)
3032 || CODING_ISO_DESIGNATION (coding, 1) < 0)
3033 goto invalid_code;
3034 CODING_ISO_INVOCATION (coding, 0) = 1;
3035 charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
3036 continue;
3037
3038 case ISO_shift_in:
3039 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT))
3040 goto invalid_code;
3041 CODING_ISO_INVOCATION (coding, 0) = 0;
3042 charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
3043 continue;
3044
3045 case ISO_single_shift_2_7:
3046 case ISO_single_shift_2:
3047 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT))
3048 goto invalid_code;
3049 /* SS2 is handled as an escape sequence of ESC 'N' */
3050 c1 = 'N';
3051 goto label_escape_sequence;
3052
3053 case ISO_single_shift_3:
3054 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT))
3055 goto invalid_code;
3056 /* SS2 is handled as an escape sequence of ESC 'O' */
3057 c1 = 'O';
3058 goto label_escape_sequence;
3059
3060 case ISO_control_sequence_introducer:
3061 /* CSI is handled as an escape sequence of ESC '[' ... */
3062 c1 = '[';
3063 goto label_escape_sequence;
3064
3065 case ISO_escape:
3066 ONE_MORE_BYTE (c1);
3067 label_escape_sequence:
3068 /* Escape sequences handled here are invocation,
3069 designation, direction specification, and character
3070 composition specification. */
3071 switch (c1)
3072 {
3073 case '&': /* revision of following character set */
3074 ONE_MORE_BYTE (c1);
3075 if (!(c1 >= '@' && c1 <= '~'))
3076 goto invalid_code;
3077 ONE_MORE_BYTE (c1);
3078 if (c1 != ISO_CODE_ESC)
3079 goto invalid_code;
3080 ONE_MORE_BYTE (c1);
3081 goto label_escape_sequence;
3082
3083 case '$': /* designation of 2-byte character set */
3084 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATION))
3085 goto invalid_code;
3086 {
3087 int reg, chars96;
3088
3089 ONE_MORE_BYTE (c1);
3090 if (c1 >= '@' && c1 <= 'B')
3091 { /* designation of JISX0208.1978, GB2312.1980,
3092 or JISX0208.1980 */
3093 reg = 0, chars96 = 0;
3094 }
3095 else if (c1 >= 0x28 && c1 <= 0x2B)
3096 { /* designation of DIMENSION2_CHARS94 character set */
3097 reg = c1 - 0x28, chars96 = 0;
3098 ONE_MORE_BYTE (c1);
3099 }
3100 else if (c1 >= 0x2C && c1 <= 0x2F)
3101 { /* designation of DIMENSION2_CHARS96 character set */
3102 reg = c1 - 0x2C, chars96 = 1;
3103 ONE_MORE_BYTE (c1);
3104 }
3105 else
3106 goto invalid_code;
3107 DECODE_DESIGNATION (reg, 2, chars96, c1);
3108 /* We must update these variables now. */
3109 if (reg == 0)
3110 charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
3111 else if (reg == 1)
3112 charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1);
3113 if (chars96 < 0)
3114 goto invalid_code;
3115 }
3116 continue;
3117
3118 case 'n': /* invocation of locking-shift-2 */
3119 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT)
3120 || CODING_ISO_DESIGNATION (coding, 2) < 0)
3121 goto invalid_code;
3122 CODING_ISO_INVOCATION (coding, 0) = 2;
3123 charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
3124 continue;
3125
3126 case 'o': /* invocation of locking-shift-3 */
3127 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT)
3128 || CODING_ISO_DESIGNATION (coding, 3) < 0)
3129 goto invalid_code;
3130 CODING_ISO_INVOCATION (coding, 0) = 3;
3131 charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
3132 continue;
3133
3134 case 'N': /* invocation of single-shift-2 */
3135 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT)
3136 || CODING_ISO_DESIGNATION (coding, 2) < 0)
3137 goto invalid_code;
3138 charset_id_2 = CODING_ISO_DESIGNATION (coding, 2);
3139 if (charset_id_2 < 0)
3140 charset = CHARSET_FROM_ID (charset_ascii);
3141 else
3142 charset = CHARSET_FROM_ID (charset_id_2);
3143 ONE_MORE_BYTE (c1);
3144 if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0))
3145 goto invalid_code;
3146 break;
3147
3148 case 'O': /* invocation of single-shift-3 */
3149 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT)
3150 || CODING_ISO_DESIGNATION (coding, 3) < 0)
3151 goto invalid_code;
3152 charset_id_3 = CODING_ISO_DESIGNATION (coding, 3);
3153 if (charset_id_3 < 0)
3154 charset = CHARSET_FROM_ID (charset_ascii);
3155 else
3156 charset = CHARSET_FROM_ID (charset_id_3);
3157 ONE_MORE_BYTE (c1);
3158 if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0))
3159 goto invalid_code;
3160 break;
3161
3162 case '0': case '2': case '3': case '4': /* start composition */
3163 if (! (coding->common_flags & CODING_ANNOTATE_COMPOSITION_MASK))
3164 goto invalid_code;
3165 DECODE_COMPOSITION_START (c1);
3166 continue;
3167
3168 case '1': /* end composition */
3169 if (composition_state == COMPOSING_NO)
3170 goto invalid_code;
3171 DECODE_COMPOSITION_END ();
3172 continue;
3173
3174 case '[': /* specification of direction */
3175 if (! CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DIRECTION)
3176 goto invalid_code;
3177 /* For the moment, nested direction is not supported.
3178 So, `coding->mode & CODING_MODE_DIRECTION' zero means
3179 left-to-right, and nozero means right-to-left. */
3180 ONE_MORE_BYTE (c1);
3181 switch (c1)
3182 {
3183 case ']': /* end of the current direction */
3184 coding->mode &= ~CODING_MODE_DIRECTION;
3185
3186 case '0': /* end of the current direction */
3187 case '1': /* start of left-to-right direction */
3188 ONE_MORE_BYTE (c1);
3189 if (c1 == ']')
3190 coding->mode &= ~CODING_MODE_DIRECTION;
3191 else
3192 goto invalid_code;
3193 break;
3194
3195 case '2': /* start of right-to-left direction */
3196 ONE_MORE_BYTE (c1);
3197 if (c1 == ']')
3198 coding->mode |= CODING_MODE_DIRECTION;
3199 else
3200 goto invalid_code;
3201 break;
3202
3203 default:
3204 goto invalid_code;
3205 }
3206 continue;
3207
3208 case '%':
3209 ONE_MORE_BYTE (c1);
3210 if (c1 == '/')
3211 {
3212 /* CTEXT extended segment:
3213 ESC % / [0-4] M L --ENCODING-NAME-- \002 --BYTES--
3214 We keep these bytes as is for the moment.
3215 They may be decoded by post-read-conversion. */
3216 int dim, M, L;
3217 int size;
3218
3219 ONE_MORE_BYTE (dim);
3220 ONE_MORE_BYTE (M);
3221 ONE_MORE_BYTE (L);
3222 size = ((M - 128) * 128) + (L - 128);
3223 if (charbuf + 8 + size > charbuf_end)
3224 goto break_loop;
3225 *charbuf++ = ISO_CODE_ESC;
3226 *charbuf++ = '%';
3227 *charbuf++ = '/';
3228 *charbuf++ = dim;
3229 *charbuf++ = BYTE8_TO_CHAR (M);
3230 *charbuf++ = BYTE8_TO_CHAR (L);
3231 while (size-- > 0)
3232 {
3233 ONE_MORE_BYTE (c1);
3234 *charbuf++ = ASCII_BYTE_P (c1) ? c1 : BYTE8_TO_CHAR (c1);
3235 }
3236 }
3237 else if (c1 == 'G')
3238 {
3239 /* XFree86 extension for embedding UTF-8 in CTEXT:
3240 ESC % G --UTF-8-BYTES-- ESC % @
3241 We keep these bytes as is for the moment.
3242 They may be decoded by post-read-conversion. */
3243 int *p = charbuf;
3244
3245 if (p + 6 > charbuf_end)
3246 goto break_loop;
3247 *p++ = ISO_CODE_ESC;
3248 *p++ = '%';
3249 *p++ = 'G';
3250 while (p < charbuf_end)
3251 {
3252 ONE_MORE_BYTE (c1);
3253 if (c1 == ISO_CODE_ESC
3254 && src + 1 < src_end
3255 && src[0] == '%'
3256 && src[1] == '@')
3257 {
3258 src += 2;
3259 break;
3260 }
3261 *p++ = ASCII_BYTE_P (c1) ? c1 : BYTE8_TO_CHAR (c1);
3262 }
3263 if (p + 3 > charbuf_end)
3264 goto break_loop;
3265 *p++ = ISO_CODE_ESC;
3266 *p++ = '%';
3267 *p++ = '@';
3268 charbuf = p;
3269 }
3270 else
3271 goto invalid_code;
3272 continue;
3273 break;
3274
3275 default:
3276 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATION))
3277 goto invalid_code;
3278 {
3279 int reg, chars96;
3280
3281 if (c1 >= 0x28 && c1 <= 0x2B)
3282 { /* designation of DIMENSION1_CHARS94 character set */
3283 reg = c1 - 0x28, chars96 = 0;
3284 ONE_MORE_BYTE (c1);
3285 }
3286 else if (c1 >= 0x2C && c1 <= 0x2F)
3287 { /* designation of DIMENSION1_CHARS96 character set */
3288 reg = c1 - 0x2C, chars96 = 1;
3289 ONE_MORE_BYTE (c1);
3290 }
3291 else
3292 goto invalid_code;
3293 DECODE_DESIGNATION (reg, 1, chars96, c1);
3294 /* We must update these variables now. */
3295 if (reg == 0)
3296 charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
3297 else if (reg == 1)
3298 charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1);
3299 if (chars96 < 0)
3300 goto invalid_code;
3301 }
3302 continue;
3303 }
3304 }
3305
3306 if (charset->id != charset_ascii
3307 && last_id != charset->id)
3308 {
3309 if (last_id != charset_ascii)
3310 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
3311 last_id = charset->id;
3312 last_offset = char_offset;
3313 }
3314
3315 /* Now we know CHARSET and 1st position code C1 of a character.
3316 Produce a decoded character while getting 2nd position code
3317 C2 if necessary. */
3318 c1 &= 0x7F;
3319 if (CHARSET_DIMENSION (charset) > 1)
3320 {
3321 ONE_MORE_BYTE (c2);
3322 if (c2 < 0x20 || (c2 >= 0x80 && c2 < 0xA0))
3323 /* C2 is not in a valid range. */
3324 goto invalid_code;
3325 c1 = (c1 << 8) | (c2 & 0x7F);
3326 if (CHARSET_DIMENSION (charset) > 2)
3327 {
3328 ONE_MORE_BYTE (c2);
3329 if (c2 < 0x20 || (c2 >= 0x80 && c2 < 0xA0))
3330 /* C2 is not in a valid range. */
3331 goto invalid_code;
3332 c1 = (c1 << 8) | (c2 & 0x7F);
3333 }
3334 }
3335
3336 CODING_DECODE_CHAR (coding, src, src_base, src_end, charset, c1, c);
3337 if (c < 0)
3338 {
3339 MAYBE_FINISH_COMPOSITION ();
3340 for (; src_base < src; src_base++, char_offset++)
3341 {
3342 if (ASCII_BYTE_P (*src_base))
3343 *charbuf++ = *src_base;
3344 else
3345 *charbuf++ = BYTE8_TO_CHAR (*src_base);
3346 }
3347 }
3348 else if (composition_state == COMPOSING_NO)
3349 {
3350 *charbuf++ = c;
3351 char_offset++;
3352 }
3353 else
3354 {
3355 components[component_idx++] = c;
3356 if (method == COMPOSITION_WITH_RULE
3357 || (method == COMPOSITION_WITH_RULE_ALTCHARS
3358 && composition_state == COMPOSING_COMPONENT_CHAR))
3359 composition_state++;
3360 }
3361 continue;
3362
3363 invalid_code:
3364 MAYBE_FINISH_COMPOSITION ();
3365 src = src_base;
3366 consumed_chars = consumed_chars_base;
3367 ONE_MORE_BYTE (c);
3368 *charbuf++ = c < 0 ? -c : ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c);
3369 char_offset++;
3370 coding->errors++;
3371 continue;
3372
3373 break_loop:
3374 break;
3375 }
3376
3377 no_more_source:
3378 if (last_id != charset_ascii)
3379 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
3380 coding->consumed_char += consumed_chars_base;
3381 coding->consumed = src_base - coding->source;
3382 coding->charbuf_used = charbuf - coding->charbuf;
3383 }
3384
3385
3386 /* ISO2022 encoding stuff. */
3387
3388 /*
3389 It is not enough to say just "ISO2022" on encoding, we have to
3390 specify more details. In Emacs, each coding system of ISO2022
3391 variant has the following specifications:
3392 1. Initial designation to G0 thru G3.
3393 2. Allows short-form designation?
3394 3. ASCII should be designated to G0 before control characters?
3395 4. ASCII should be designated to G0 at end of line?
3396 5. 7-bit environment or 8-bit environment?
3397 6. Use locking-shift?
3398 7. Use Single-shift?
3399 And the following two are only for Japanese:
3400 8. Use ASCII in place of JIS0201-1976-Roman?
3401 9. Use JISX0208-1983 in place of JISX0208-1978?
3402 These specifications are encoded in CODING_ISO_FLAGS (coding) as flag bits
3403 defined by macros CODING_ISO_FLAG_XXX. See `coding.h' for more
3404 details.
3405 */
3406
3407 /* Produce codes (escape sequence) for designating CHARSET to graphic
3408 register REG at DST, and increment DST. If <final-char> of CHARSET is
3409 '@', 'A', or 'B' and the coding system CODING allows, produce
3410 designation sequence of short-form. */
3411
3412 #define ENCODE_DESIGNATION(charset, reg, coding) \
3413 do { \
3414 unsigned char final_char = CHARSET_ISO_FINAL (charset); \
3415 char *intermediate_char_94 = "()*+"; \
3416 char *intermediate_char_96 = ",-./"; \
3417 int revision = -1; \
3418 int c; \
3419 \
3420 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_REVISION) \
3421 revision = CHARSET_ISO_REVISION (charset); \
3422 \
3423 if (revision >= 0) \
3424 { \
3425 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, '&'); \
3426 EMIT_ONE_BYTE ('@' + revision); \
3427 } \
3428 EMIT_ONE_ASCII_BYTE (ISO_CODE_ESC); \
3429 if (CHARSET_DIMENSION (charset) == 1) \
3430 { \
3431 if (! CHARSET_ISO_CHARS_96 (charset)) \
3432 c = intermediate_char_94[reg]; \
3433 else \
3434 c = intermediate_char_96[reg]; \
3435 EMIT_ONE_ASCII_BYTE (c); \
3436 } \
3437 else \
3438 { \
3439 EMIT_ONE_ASCII_BYTE ('$'); \
3440 if (! CHARSET_ISO_CHARS_96 (charset)) \
3441 { \
3442 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LONG_FORM \
3443 || reg != 0 \
3444 || final_char < '@' || final_char > 'B') \
3445 EMIT_ONE_ASCII_BYTE (intermediate_char_94[reg]); \
3446 } \
3447 else \
3448 EMIT_ONE_ASCII_BYTE (intermediate_char_96[reg]); \
3449 } \
3450 EMIT_ONE_ASCII_BYTE (final_char); \
3451 \
3452 CODING_ISO_DESIGNATION (coding, reg) = CHARSET_ID (charset); \
3453 } while (0)
3454
3455
3456 /* The following two macros produce codes (control character or escape
3457 sequence) for ISO2022 single-shift functions (single-shift-2 and
3458 single-shift-3). */
3459
3460 #define ENCODE_SINGLE_SHIFT_2 \
3461 do { \
3462 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
3463 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'N'); \
3464 else \
3465 EMIT_ONE_BYTE (ISO_CODE_SS2); \
3466 CODING_ISO_SINGLE_SHIFTING (coding) = 1; \
3467 } while (0)
3468
3469
3470 #define ENCODE_SINGLE_SHIFT_3 \
3471 do { \
3472 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
3473 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'O'); \
3474 else \
3475 EMIT_ONE_BYTE (ISO_CODE_SS3); \
3476 CODING_ISO_SINGLE_SHIFTING (coding) = 1; \
3477 } while (0)
3478
3479
3480 /* The following four macros produce codes (control character or
3481 escape sequence) for ISO2022 locking-shift functions (shift-in,
3482 shift-out, locking-shift-2, and locking-shift-3). */
3483
3484 #define ENCODE_SHIFT_IN \
3485 do { \
3486 EMIT_ONE_ASCII_BYTE (ISO_CODE_SI); \
3487 CODING_ISO_INVOCATION (coding, 0) = 0; \
3488 } while (0)
3489
3490
3491 #define ENCODE_SHIFT_OUT \
3492 do { \
3493 EMIT_ONE_ASCII_BYTE (ISO_CODE_SO); \
3494 CODING_ISO_INVOCATION (coding, 0) = 1; \
3495 } while (0)
3496
3497
3498 #define ENCODE_LOCKING_SHIFT_2 \
3499 do { \
3500 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'n'); \
3501 CODING_ISO_INVOCATION (coding, 0) = 2; \
3502 } while (0)
3503
3504
3505 #define ENCODE_LOCKING_SHIFT_3 \
3506 do { \
3507 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'n'); \
3508 CODING_ISO_INVOCATION (coding, 0) = 3; \
3509 } while (0)
3510
3511
3512 /* Produce codes for a DIMENSION1 character whose character set is
3513 CHARSET and whose position-code is C1. Designation and invocation
3514 sequences are also produced in advance if necessary. */
3515
3516 #define ENCODE_ISO_CHARACTER_DIMENSION1(charset, c1) \
3517 do { \
3518 int id = CHARSET_ID (charset); \
3519 \
3520 if ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_ROMAN) \
3521 && id == charset_ascii) \
3522 { \
3523 id = charset_jisx0201_roman; \
3524 charset = CHARSET_FROM_ID (id); \
3525 } \
3526 \
3527 if (CODING_ISO_SINGLE_SHIFTING (coding)) \
3528 { \
3529 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
3530 EMIT_ONE_ASCII_BYTE (c1 & 0x7F); \
3531 else \
3532 EMIT_ONE_BYTE (c1 | 0x80); \
3533 CODING_ISO_SINGLE_SHIFTING (coding) = 0; \
3534 break; \
3535 } \
3536 else if (id == CODING_ISO_INVOKED_CHARSET (coding, 0)) \
3537 { \
3538 EMIT_ONE_ASCII_BYTE (c1 & 0x7F); \
3539 break; \
3540 } \
3541 else if (id == CODING_ISO_INVOKED_CHARSET (coding, 1)) \
3542 { \
3543 EMIT_ONE_BYTE (c1 | 0x80); \
3544 break; \
3545 } \
3546 else \
3547 /* Since CHARSET is not yet invoked to any graphic planes, we \
3548 must invoke it, or, at first, designate it to some graphic \
3549 register. Then repeat the loop to actually produce the \
3550 character. */ \
3551 dst = encode_invocation_designation (charset, coding, dst, \
3552 &produced_chars); \
3553 } while (1)
3554
3555
3556 /* Produce codes for a DIMENSION2 character whose character set is
3557 CHARSET and whose position-codes are C1 and C2. Designation and
3558 invocation codes are also produced in advance if necessary. */
3559
3560 #define ENCODE_ISO_CHARACTER_DIMENSION2(charset, c1, c2) \
3561 do { \
3562 int id = CHARSET_ID (charset); \
3563 \
3564 if ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_OLDJIS) \
3565 && id == charset_jisx0208) \
3566 { \
3567 id = charset_jisx0208_1978; \
3568 charset = CHARSET_FROM_ID (id); \
3569 } \
3570 \
3571 if (CODING_ISO_SINGLE_SHIFTING (coding)) \
3572 { \
3573 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
3574 EMIT_TWO_ASCII_BYTES ((c1) & 0x7F, (c2) & 0x7F); \
3575 else \
3576 EMIT_TWO_BYTES ((c1) | 0x80, (c2) | 0x80); \
3577 CODING_ISO_SINGLE_SHIFTING (coding) = 0; \
3578 break; \
3579 } \
3580 else if (id == CODING_ISO_INVOKED_CHARSET (coding, 0)) \
3581 { \
3582 EMIT_TWO_ASCII_BYTES ((c1) & 0x7F, (c2) & 0x7F); \
3583 break; \
3584 } \
3585 else if (id == CODING_ISO_INVOKED_CHARSET (coding, 1)) \
3586 { \
3587 EMIT_TWO_BYTES ((c1) | 0x80, (c2) | 0x80); \
3588 break; \
3589 } \
3590 else \
3591 /* Since CHARSET is not yet invoked to any graphic planes, we \
3592 must invoke it, or, at first, designate it to some graphic \
3593 register. Then repeat the loop to actually produce the \
3594 character. */ \
3595 dst = encode_invocation_designation (charset, coding, dst, \
3596 &produced_chars); \
3597 } while (1)
3598
3599
3600 #define ENCODE_ISO_CHARACTER(charset, c) \
3601 do { \
3602 int code = ENCODE_CHAR ((charset),(c)); \
3603 \
3604 if (CHARSET_DIMENSION (charset) == 1) \
3605 ENCODE_ISO_CHARACTER_DIMENSION1 ((charset), code); \
3606 else \
3607 ENCODE_ISO_CHARACTER_DIMENSION2 ((charset), code >> 8, code & 0xFF); \
3608 } while (0)
3609
3610
3611 /* Produce designation and invocation codes at a place pointed by DST
3612 to use CHARSET. The element `spec.iso_2022' of *CODING is updated.
3613 Return new DST. */
3614
3615 unsigned char *
3616 encode_invocation_designation (charset, coding, dst, p_nchars)
3617 struct charset *charset;
3618 struct coding_system *coding;
3619 unsigned char *dst;
3620 int *p_nchars;
3621 {
3622 int multibytep = coding->dst_multibyte;
3623 int produced_chars = *p_nchars;
3624 int reg; /* graphic register number */
3625 int id = CHARSET_ID (charset);
3626
3627 /* At first, check designations. */
3628 for (reg = 0; reg < 4; reg++)
3629 if (id == CODING_ISO_DESIGNATION (coding, reg))
3630 break;
3631
3632 if (reg >= 4)
3633 {
3634 /* CHARSET is not yet designated to any graphic registers. */
3635 /* At first check the requested designation. */
3636 reg = CODING_ISO_REQUEST (coding, id);
3637 if (reg < 0)
3638 /* Since CHARSET requests no special designation, designate it
3639 to graphic register 0. */
3640 reg = 0;
3641
3642 ENCODE_DESIGNATION (charset, reg, coding);
3643 }
3644
3645 if (CODING_ISO_INVOCATION (coding, 0) != reg
3646 && CODING_ISO_INVOCATION (coding, 1) != reg)
3647 {
3648 /* Since the graphic register REG is not invoked to any graphic
3649 planes, invoke it to graphic plane 0. */
3650 switch (reg)
3651 {
3652 case 0: /* graphic register 0 */
3653 ENCODE_SHIFT_IN;
3654 break;
3655
3656 case 1: /* graphic register 1 */
3657 ENCODE_SHIFT_OUT;
3658 break;
3659
3660 case 2: /* graphic register 2 */
3661 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT)
3662 ENCODE_SINGLE_SHIFT_2;
3663 else
3664 ENCODE_LOCKING_SHIFT_2;
3665 break;
3666
3667 case 3: /* graphic register 3 */
3668 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT)
3669 ENCODE_SINGLE_SHIFT_3;
3670 else
3671 ENCODE_LOCKING_SHIFT_3;
3672 break;
3673 }
3674 }
3675
3676 *p_nchars = produced_chars;
3677 return dst;
3678 }
3679
3680 /* The following three macros produce codes for indicating direction
3681 of text. */
3682 #define ENCODE_CONTROL_SEQUENCE_INTRODUCER \
3683 do { \
3684 if (CODING_ISO_FLAGS (coding) == CODING_ISO_FLAG_SEVEN_BITS) \
3685 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, '['); \
3686 else \
3687 EMIT_ONE_BYTE (ISO_CODE_CSI); \
3688 } while (0)
3689
3690
3691 #define ENCODE_DIRECTION_R2L() \
3692 do { \
3693 ENCODE_CONTROL_SEQUENCE_INTRODUCER (dst); \
3694 EMIT_TWO_ASCII_BYTES ('2', ']'); \
3695 } while (0)
3696
3697
3698 #define ENCODE_DIRECTION_L2R() \
3699 do { \
3700 ENCODE_CONTROL_SEQUENCE_INTRODUCER (dst); \
3701 EMIT_TWO_ASCII_BYTES ('0', ']'); \
3702 } while (0)
3703
3704
3705 /* Produce codes for designation and invocation to reset the graphic
3706 planes and registers to initial state. */
3707 #define ENCODE_RESET_PLANE_AND_REGISTER() \
3708 do { \
3709 int reg; \
3710 struct charset *charset; \
3711 \
3712 if (CODING_ISO_INVOCATION (coding, 0) != 0) \
3713 ENCODE_SHIFT_IN; \
3714 for (reg = 0; reg < 4; reg++) \
3715 if (CODING_ISO_INITIAL (coding, reg) >= 0 \
3716 && (CODING_ISO_DESIGNATION (coding, reg) \
3717 != CODING_ISO_INITIAL (coding, reg))) \
3718 { \
3719 charset = CHARSET_FROM_ID (CODING_ISO_INITIAL (coding, reg)); \
3720 ENCODE_DESIGNATION (charset, reg, coding); \
3721 } \
3722 } while (0)
3723
3724
3725 /* Produce designation sequences of charsets in the line started from
3726 SRC to a place pointed by DST, and return updated DST.
3727
3728 If the current block ends before any end-of-line, we may fail to
3729 find all the necessary designations. */
3730
3731 static unsigned char *
3732 encode_designation_at_bol (coding, charbuf, charbuf_end, dst)
3733 struct coding_system *coding;
3734 int *charbuf, *charbuf_end;
3735 unsigned char *dst;
3736 {
3737 struct charset *charset;
3738 /* Table of charsets to be designated to each graphic register. */
3739 int r[4];
3740 int c, found = 0, reg;
3741 int produced_chars = 0;
3742 int multibytep = coding->dst_multibyte;
3743 Lisp_Object attrs;
3744 Lisp_Object charset_list;
3745
3746 attrs = CODING_ID_ATTRS (coding->id);
3747 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
3748 if (EQ (charset_list, Qiso_2022))
3749 charset_list = Viso_2022_charset_list;
3750
3751 for (reg = 0; reg < 4; reg++)
3752 r[reg] = -1;
3753
3754 while (found < 4)
3755 {
3756 int id;
3757
3758 c = *charbuf++;
3759 if (c == '\n')
3760 break;
3761 charset = char_charset (c, charset_list, NULL);
3762 id = CHARSET_ID (charset);
3763 reg = CODING_ISO_REQUEST (coding, id);
3764 if (reg >= 0 && r[reg] < 0)
3765 {
3766 found++;
3767 r[reg] = id;
3768 }
3769 }
3770
3771 if (found)
3772 {
3773 for (reg = 0; reg < 4; reg++)
3774 if (r[reg] >= 0
3775 && CODING_ISO_DESIGNATION (coding, reg) != r[reg])
3776 ENCODE_DESIGNATION (CHARSET_FROM_ID (r[reg]), reg, coding);
3777 }
3778
3779 return dst;
3780 }
3781
3782 /* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions". */
3783
3784 static int
3785 encode_coding_iso_2022 (coding)
3786 struct coding_system *coding;
3787 {
3788 int multibytep = coding->dst_multibyte;
3789 int *charbuf = coding->charbuf;
3790 int *charbuf_end = charbuf + coding->charbuf_used;
3791 unsigned char *dst = coding->destination + coding->produced;
3792 unsigned char *dst_end = coding->destination + coding->dst_bytes;
3793 int safe_room = 16;
3794 int bol_designation
3795 = (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATE_AT_BOL
3796 && CODING_ISO_BOL (coding));
3797 int produced_chars = 0;
3798 Lisp_Object attrs, eol_type, charset_list;
3799 int ascii_compatible;
3800 int c;
3801 int preferred_charset_id = -1;
3802
3803 CODING_GET_INFO (coding, attrs, charset_list);
3804 eol_type = CODING_ID_EOL_TYPE (coding->id);
3805 if (VECTORP (eol_type))
3806 eol_type = Qunix;
3807
3808 setup_iso_safe_charsets (attrs);
3809 /* Charset list may have been changed. */
3810 charset_list = CODING_ATTR_CHARSET_LIST (attrs); \
3811 coding->safe_charsets = (char *) SDATA (CODING_ATTR_SAFE_CHARSETS(attrs));
3812
3813 ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
3814
3815 while (charbuf < charbuf_end)
3816 {
3817 ASSURE_DESTINATION (safe_room);
3818
3819 if (bol_designation)
3820 {
3821 unsigned char *dst_prev = dst;
3822
3823 /* We have to produce designation sequences if any now. */
3824 dst = encode_designation_at_bol (coding, charbuf, charbuf_end, dst);
3825 bol_designation = 0;
3826 /* We are sure that designation sequences are all ASCII bytes. */
3827 produced_chars += dst - dst_prev;
3828 }
3829
3830 c = *charbuf++;
3831
3832 if (c < 0)
3833 {
3834 /* Handle an annotation. */
3835 switch (*charbuf)
3836 {
3837 case CODING_ANNOTATE_COMPOSITION_MASK:
3838 /* Not yet implemented. */
3839 break;
3840 case CODING_ANNOTATE_CHARSET_MASK:
3841 preferred_charset_id = charbuf[2];
3842 if (preferred_charset_id >= 0
3843 && NILP (Fmemq (make_number (preferred_charset_id),
3844 charset_list)))
3845 preferred_charset_id = -1;
3846 break;
3847 default:
3848 abort ();
3849 }
3850 charbuf += -c - 1;
3851 continue;
3852 }
3853
3854 /* Now encode the character C. */
3855 if (c < 0x20 || c == 0x7F)
3856 {
3857 if (c == '\n'
3858 || (c == '\r' && EQ (eol_type, Qmac)))
3859 {
3860 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_RESET_AT_EOL)
3861 ENCODE_RESET_PLANE_AND_REGISTER ();
3862 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_INIT_AT_BOL)
3863 {
3864 int i;
3865
3866 for (i = 0; i < 4; i++)
3867 CODING_ISO_DESIGNATION (coding, i)
3868 = CODING_ISO_INITIAL (coding, i);
3869 }
3870 bol_designation
3871 = CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATE_AT_BOL;
3872 }
3873 else if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_RESET_AT_CNTL)
3874 ENCODE_RESET_PLANE_AND_REGISTER ();
3875 EMIT_ONE_ASCII_BYTE (c);
3876 }
3877 else if (ASCII_CHAR_P (c))
3878 {
3879 if (ascii_compatible)
3880 EMIT_ONE_ASCII_BYTE (c);
3881 else
3882 {
3883 struct charset *charset = CHARSET_FROM_ID (charset_ascii);
3884 ENCODE_ISO_CHARACTER (charset, c);
3885 }
3886 }
3887 else if (CHAR_BYTE8_P (c))
3888 {
3889 c = CHAR_TO_BYTE8 (c);
3890 EMIT_ONE_BYTE (c);
3891 }
3892 else
3893 {
3894 struct charset *charset;
3895
3896 if (preferred_charset_id >= 0)
3897 {
3898 charset = CHARSET_FROM_ID (preferred_charset_id);
3899 if (! CHAR_CHARSET_P (c, charset))
3900 charset = char_charset (c, charset_list, NULL);
3901 }
3902 else
3903 charset = char_charset (c, charset_list, NULL);
3904 if (!charset)
3905 {
3906 if (coding->mode & CODING_MODE_SAFE_ENCODING)
3907 {
3908 c = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
3909 charset = CHARSET_FROM_ID (charset_ascii);
3910 }
3911 else
3912 {
3913 c = coding->default_char;
3914 charset = char_charset (c, charset_list, NULL);
3915 }
3916 }
3917 ENCODE_ISO_CHARACTER (charset, c);
3918 }
3919 }
3920
3921 if (coding->mode & CODING_MODE_LAST_BLOCK
3922 && CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_RESET_AT_EOL)
3923 {
3924 ASSURE_DESTINATION (safe_room);
3925 ENCODE_RESET_PLANE_AND_REGISTER ();
3926 }
3927 record_conversion_result (coding, CODING_RESULT_SUCCESS);
3928 CODING_ISO_BOL (coding) = bol_designation;
3929 coding->produced_char += produced_chars;
3930 coding->produced = dst - coding->destination;
3931 return 0;
3932 }
3933
3934 \f
3935 /*** 8,9. SJIS and BIG5 handlers ***/
3936
3937 /* Although SJIS and BIG5 are not ISO's coding system, they are used
3938 quite widely. So, for the moment, Emacs supports them in the bare
3939 C code. But, in the future, they may be supported only by CCL. */
3940
3941 /* SJIS is a coding system encoding three character sets: ASCII, right
3942 half of JISX0201-Kana, and JISX0208. An ASCII character is encoded
3943 as is. A character of charset katakana-jisx0201 is encoded by
3944 "position-code + 0x80". A character of charset japanese-jisx0208
3945 is encoded in 2-byte but two position-codes are divided and shifted
3946 so that it fit in the range below.
3947
3948 --- CODE RANGE of SJIS ---
3949 (character set) (range)
3950 ASCII 0x00 .. 0x7F
3951 KATAKANA-JISX0201 0xA0 .. 0xDF
3952 JISX0208 (1st byte) 0x81 .. 0x9F and 0xE0 .. 0xEF
3953 (2nd byte) 0x40 .. 0x7E and 0x80 .. 0xFC
3954 -------------------------------
3955
3956 */
3957
3958 /* BIG5 is a coding system encoding two character sets: ASCII and
3959 Big5. An ASCII character is encoded as is. Big5 is a two-byte
3960 character set and is encoded in two-byte.
3961
3962 --- CODE RANGE of BIG5 ---
3963 (character set) (range)
3964 ASCII 0x00 .. 0x7F
3965 Big5 (1st byte) 0xA1 .. 0xFE
3966 (2nd byte) 0x40 .. 0x7E and 0xA1 .. 0xFE
3967 --------------------------
3968
3969 */
3970
3971 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
3972 Check if a text is encoded in SJIS. If it is, return
3973 CATEGORY_MASK_SJIS, else return 0. */
3974
3975 static int
3976 detect_coding_sjis (coding, detect_info)
3977 struct coding_system *coding;
3978 struct coding_detection_info *detect_info;
3979 {
3980 const unsigned char *src = coding->source, *src_base;
3981 const unsigned char *src_end = coding->source + coding->src_bytes;
3982 int multibytep = coding->src_multibyte;
3983 int consumed_chars = 0;
3984 int found = 0;
3985 int c;
3986
3987 detect_info->checked |= CATEGORY_MASK_SJIS;
3988 /* A coding system of this category is always ASCII compatible. */
3989 src += coding->head_ascii;
3990
3991 while (1)
3992 {
3993 src_base = src;
3994 ONE_MORE_BYTE (c);
3995 if (c < 0x80)
3996 continue;
3997 if ((c >= 0x81 && c <= 0x9F) || (c >= 0xE0 && c <= 0xEF))
3998 {
3999 ONE_MORE_BYTE (c);
4000 if (c < 0x40 || c == 0x7F || c > 0xFC)
4001 break;
4002 found = CATEGORY_MASK_SJIS;
4003 }
4004 else if (c >= 0xA0 && c < 0xE0)
4005 found = CATEGORY_MASK_SJIS;
4006 else
4007 break;
4008 }
4009 detect_info->rejected |= CATEGORY_MASK_SJIS;
4010 return 0;
4011
4012 no_more_source:
4013 if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK)
4014 {
4015 detect_info->rejected |= CATEGORY_MASK_SJIS;
4016 return 0;
4017 }
4018 detect_info->found |= found;
4019 return 1;
4020 }
4021
4022 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
4023 Check if a text is encoded in BIG5. If it is, return
4024 CATEGORY_MASK_BIG5, else return 0. */
4025
4026 static int
4027 detect_coding_big5 (coding, detect_info)
4028 struct coding_system *coding;
4029 struct coding_detection_info *detect_info;
4030 {
4031 const unsigned char *src = coding->source, *src_base;
4032 const unsigned char *src_end = coding->source + coding->src_bytes;
4033 int multibytep = coding->src_multibyte;
4034 int consumed_chars = 0;
4035 int found = 0;
4036 int c;
4037
4038 detect_info->checked |= CATEGORY_MASK_BIG5;
4039 /* A coding system of this category is always ASCII compatible. */
4040 src += coding->head_ascii;
4041
4042 while (1)
4043 {
4044 src_base = src;
4045 ONE_MORE_BYTE (c);
4046 if (c < 0x80)
4047 continue;
4048 if (c >= 0xA1)
4049 {
4050 ONE_MORE_BYTE (c);
4051 if (c < 0x40 || (c >= 0x7F && c <= 0xA0))
4052 return 0;
4053 found = CATEGORY_MASK_BIG5;
4054 }
4055 else
4056 break;
4057 }
4058 detect_info->rejected |= CATEGORY_MASK_BIG5;
4059 return 0;
4060
4061 no_more_source:
4062 if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK)
4063 {
4064 detect_info->rejected |= CATEGORY_MASK_BIG5;
4065 return 0;
4066 }
4067 detect_info->found |= found;
4068 return 1;
4069 }
4070
4071 /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions".
4072 If SJIS_P is 1, decode SJIS text, else decode BIG5 test. */
4073
4074 static void
4075 decode_coding_sjis (coding)
4076 struct coding_system *coding;
4077 {
4078 const unsigned char *src = coding->source + coding->consumed;
4079 const unsigned char *src_end = coding->source + coding->src_bytes;
4080 const unsigned char *src_base;
4081 int *charbuf = coding->charbuf + coding->charbuf_used;
4082 int *charbuf_end
4083 = coding->charbuf + coding->charbuf_size - MAX_ANNOTATION_LENGTH;
4084 int consumed_chars = 0, consumed_chars_base;
4085 int multibytep = coding->src_multibyte;
4086 struct charset *charset_roman, *charset_kanji, *charset_kana;
4087 struct charset *charset_kanji2;
4088 Lisp_Object attrs, charset_list, val;
4089 int char_offset = coding->produced_char;
4090 int last_offset = char_offset;
4091 int last_id = charset_ascii;
4092
4093 CODING_GET_INFO (coding, attrs, charset_list);
4094
4095 val = charset_list;
4096 charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
4097 charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
4098 charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
4099 charset_kanji2 = NILP (val) ? NULL : CHARSET_FROM_ID (XINT (XCAR (val)));
4100
4101 while (1)
4102 {
4103 int c, c1;
4104 struct charset *charset;
4105
4106 src_base = src;
4107 consumed_chars_base = consumed_chars;
4108
4109 if (charbuf >= charbuf_end)
4110 break;
4111
4112 ONE_MORE_BYTE (c);
4113 if (c < 0)
4114 goto invalid_code;
4115 if (c < 0x80)
4116 charset = charset_roman;
4117 else if (c == 0x80 || c == 0xA0)
4118 goto invalid_code;
4119 else if (c >= 0xA1 && c <= 0xDF)
4120 {
4121 /* SJIS -> JISX0201-Kana */
4122 c &= 0x7F;
4123 charset = charset_kana;
4124 }
4125 else if (c <= 0xEF)
4126 {
4127 /* SJIS -> JISX0208 */
4128 ONE_MORE_BYTE (c1);
4129 if (c1 < 0x40 || c1 == 0x7F || c1 > 0xFC)
4130 goto invalid_code;
4131 c = (c << 8) | c1;
4132 SJIS_TO_JIS (c);
4133 charset = charset_kanji;
4134 }
4135 else if (c <= 0xFC && charset_kanji2)
4136 {
4137 /* SJIS -> JISX0213-2 */
4138 ONE_MORE_BYTE (c1);
4139 if (c1 < 0x40 || c1 == 0x7F || c1 > 0xFC)
4140 goto invalid_code;
4141 c = (c << 8) | c1;
4142 SJIS_TO_JIS2 (c);
4143 charset = charset_kanji2;
4144 }
4145 else
4146 goto invalid_code;
4147 if (charset->id != charset_ascii
4148 && last_id != charset->id)
4149 {
4150 if (last_id != charset_ascii)
4151 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
4152 last_id = charset->id;
4153 last_offset = char_offset;
4154 }
4155 CODING_DECODE_CHAR (coding, src, src_base, src_end, charset, c, c);
4156 *charbuf++ = c;
4157 char_offset++;
4158 continue;
4159
4160 invalid_code:
4161 src = src_base;
4162 consumed_chars = consumed_chars_base;
4163 ONE_MORE_BYTE (c);
4164 *charbuf++ = c < 0 ? -c : BYTE8_TO_CHAR (c);
4165 char_offset++;
4166 coding->errors++;
4167 }
4168
4169 no_more_source:
4170 if (last_id != charset_ascii)
4171 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
4172 coding->consumed_char += consumed_chars_base;
4173 coding->consumed = src_base - coding->source;
4174 coding->charbuf_used = charbuf - coding->charbuf;
4175 }
4176
4177 static void
4178 decode_coding_big5 (coding)
4179 struct coding_system *coding;
4180 {
4181 const unsigned char *src = coding->source + coding->consumed;
4182 const unsigned char *src_end = coding->source + coding->src_bytes;
4183 const unsigned char *src_base;
4184 int *charbuf = coding->charbuf + coding->charbuf_used;
4185 int *charbuf_end
4186 = coding->charbuf + coding->charbuf_size - MAX_ANNOTATION_LENGTH;
4187 int consumed_chars = 0, consumed_chars_base;
4188 int multibytep = coding->src_multibyte;
4189 struct charset *charset_roman, *charset_big5;
4190 Lisp_Object attrs, charset_list, val;
4191 int char_offset = coding->produced_char;
4192 int last_offset = char_offset;
4193 int last_id = charset_ascii;
4194
4195 CODING_GET_INFO (coding, attrs, charset_list);
4196 val = charset_list;
4197 charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
4198 charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val)));
4199
4200 while (1)
4201 {
4202 int c, c1;
4203 struct charset *charset;
4204
4205 src_base = src;
4206 consumed_chars_base = consumed_chars;
4207
4208 if (charbuf >= charbuf_end)
4209 break;
4210
4211 ONE_MORE_BYTE (c);
4212
4213 if (c < 0)
4214 goto invalid_code;
4215 if (c < 0x80)
4216 charset = charset_roman;
4217 else
4218 {
4219 /* BIG5 -> Big5 */
4220 if (c < 0xA1 || c > 0xFE)
4221 goto invalid_code;
4222 ONE_MORE_BYTE (c1);
4223 if (c1 < 0x40 || (c1 > 0x7E && c1 < 0xA1) || c1 > 0xFE)
4224 goto invalid_code;
4225 c = c << 8 | c1;
4226 charset = charset_big5;
4227 }
4228 if (charset->id != charset_ascii
4229 && last_id != charset->id)
4230 {
4231 if (last_id != charset_ascii)
4232 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
4233 last_id = charset->id;
4234 last_offset = char_offset;
4235 }
4236 CODING_DECODE_CHAR (coding, src, src_base, src_end, charset, c, c);
4237 *charbuf++ = c;
4238 char_offset++;
4239 continue;
4240
4241 invalid_code:
4242 src = src_base;
4243 consumed_chars = consumed_chars_base;
4244 ONE_MORE_BYTE (c);
4245 *charbuf++ = c < 0 ? -c : BYTE8_TO_CHAR (c);
4246 char_offset++;
4247 coding->errors++;
4248 }
4249
4250 no_more_source:
4251 if (last_id != charset_ascii)
4252 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
4253 coding->consumed_char += consumed_chars_base;
4254 coding->consumed = src_base - coding->source;
4255 coding->charbuf_used = charbuf - coding->charbuf;
4256 }
4257
4258 /* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions".
4259 This function can encode charsets `ascii', `katakana-jisx0201',
4260 `japanese-jisx0208', `chinese-big5-1', and `chinese-big5-2'. We
4261 are sure that all these charsets are registered as official charset
4262 (i.e. do not have extended leading-codes). Characters of other
4263 charsets are produced without any encoding. If SJIS_P is 1, encode
4264 SJIS text, else encode BIG5 text. */
4265
4266 static int
4267 encode_coding_sjis (coding)
4268 struct coding_system *coding;
4269 {
4270 int multibytep = coding->dst_multibyte;
4271 int *charbuf = coding->charbuf;
4272 int *charbuf_end = charbuf + coding->charbuf_used;
4273 unsigned char *dst = coding->destination + coding->produced;
4274 unsigned char *dst_end = coding->destination + coding->dst_bytes;
4275 int safe_room = 4;
4276 int produced_chars = 0;
4277 Lisp_Object attrs, charset_list, val;
4278 int ascii_compatible;
4279 struct charset *charset_roman, *charset_kanji, *charset_kana;
4280 struct charset *charset_kanji2;
4281 int c;
4282
4283 CODING_GET_INFO (coding, attrs, charset_list);
4284 val = charset_list;
4285 charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
4286 charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
4287 charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
4288 charset_kanji2 = NILP (val) ? NULL : CHARSET_FROM_ID (XINT (XCAR (val)));
4289
4290 ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
4291
4292 while (charbuf < charbuf_end)
4293 {
4294 ASSURE_DESTINATION (safe_room);
4295 c = *charbuf++;
4296 /* Now encode the character C. */
4297 if (ASCII_CHAR_P (c) && ascii_compatible)
4298 EMIT_ONE_ASCII_BYTE (c);
4299 else if (CHAR_BYTE8_P (c))
4300 {
4301 c = CHAR_TO_BYTE8 (c);
4302 EMIT_ONE_BYTE (c);
4303 }
4304 else
4305 {
4306 unsigned code;
4307 struct charset *charset = char_charset (c, charset_list, &code);
4308
4309 if (!charset)
4310 {
4311 if (coding->mode & CODING_MODE_SAFE_ENCODING)
4312 {
4313 code = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
4314 charset = CHARSET_FROM_ID (charset_ascii);
4315 }
4316 else
4317 {
4318 c = coding->default_char;
4319 charset = char_charset (c, charset_list, &code);
4320 }
4321 }
4322 if (code == CHARSET_INVALID_CODE (charset))
4323 abort ();
4324 if (charset == charset_kanji)
4325 {
4326 int c1, c2;
4327 JIS_TO_SJIS (code);
4328 c1 = code >> 8, c2 = code & 0xFF;
4329 EMIT_TWO_BYTES (c1, c2);
4330 }
4331 else if (charset == charset_kana)
4332 EMIT_ONE_BYTE (code | 0x80);
4333 else if (charset_kanji2 && charset == charset_kanji2)
4334 {
4335 int c1, c2;
4336
4337 c1 = code >> 8;
4338 if (c1 == 0x21 || (c1 >= 0x23 && c1 < 0x25)
4339 || (c1 >= 0x2C && c1 <= 0x2F) || c1 >= 0x6E)
4340 {
4341 JIS_TO_SJIS2 (code);
4342 c1 = code >> 8, c2 = code & 0xFF;
4343 EMIT_TWO_BYTES (c1, c2);
4344 }
4345 else
4346 EMIT_ONE_ASCII_BYTE (code & 0x7F);
4347 }
4348 else
4349 EMIT_ONE_ASCII_BYTE (code & 0x7F);
4350 }
4351 }
4352 record_conversion_result (coding, CODING_RESULT_SUCCESS);
4353 coding->produced_char += produced_chars;
4354 coding->produced = dst - coding->destination;
4355 return 0;
4356 }
4357
4358 static int
4359 encode_coding_big5 (coding)
4360 struct coding_system *coding;
4361 {
4362 int multibytep = coding->dst_multibyte;
4363 int *charbuf = coding->charbuf;
4364 int *charbuf_end = charbuf + coding->charbuf_used;
4365 unsigned char *dst = coding->destination + coding->produced;
4366 unsigned char *dst_end = coding->destination + coding->dst_bytes;
4367 int safe_room = 4;
4368 int produced_chars = 0;
4369 Lisp_Object attrs, charset_list, val;
4370 int ascii_compatible;
4371 struct charset *charset_roman, *charset_big5;
4372 int c;
4373
4374 CODING_GET_INFO (coding, attrs, charset_list);
4375 val = charset_list;
4376 charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
4377 charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val)));
4378 ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
4379
4380 while (charbuf < charbuf_end)
4381 {
4382 ASSURE_DESTINATION (safe_room);
4383 c = *charbuf++;
4384 /* Now encode the character C. */
4385 if (ASCII_CHAR_P (c) && ascii_compatible)
4386 EMIT_ONE_ASCII_BYTE (c);
4387 else if (CHAR_BYTE8_P (c))
4388 {
4389 c = CHAR_TO_BYTE8 (c);
4390 EMIT_ONE_BYTE (c);
4391 }
4392 else
4393 {
4394 unsigned code;
4395 struct charset *charset = char_charset (c, charset_list, &code);
4396
4397 if (! charset)
4398 {
4399 if (coding->mode & CODING_MODE_SAFE_ENCODING)
4400 {
4401 code = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
4402 charset = CHARSET_FROM_ID (charset_ascii);
4403 }
4404 else
4405 {
4406 c = coding->default_char;
4407 charset = char_charset (c, charset_list, &code);
4408 }
4409 }
4410 if (code == CHARSET_INVALID_CODE (charset))
4411 abort ();
4412 if (charset == charset_big5)
4413 {
4414 int c1, c2;
4415
4416 c1 = code >> 8, c2 = code & 0xFF;
4417 EMIT_TWO_BYTES (c1, c2);
4418 }
4419 else
4420 EMIT_ONE_ASCII_BYTE (code & 0x7F);
4421 }
4422 }
4423 record_conversion_result (coding, CODING_RESULT_SUCCESS);
4424 coding->produced_char += produced_chars;
4425 coding->produced = dst - coding->destination;
4426 return 0;
4427 }
4428
4429 \f
4430 /*** 10. CCL handlers ***/
4431
4432 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
4433 Check if a text is encoded in a coding system of which
4434 encoder/decoder are written in CCL program. If it is, return
4435 CATEGORY_MASK_CCL, else return 0. */
4436
4437 static int
4438 detect_coding_ccl (coding, detect_info)
4439 struct coding_system *coding;
4440 struct coding_detection_info *detect_info;
4441 {
4442 const unsigned char *src = coding->source, *src_base;
4443 const unsigned char *src_end = coding->source + coding->src_bytes;
4444 int multibytep = coding->src_multibyte;
4445 int consumed_chars = 0;
4446 int found = 0;
4447 unsigned char *valids;
4448 int head_ascii = coding->head_ascii;
4449 Lisp_Object attrs;
4450
4451 detect_info->checked |= CATEGORY_MASK_CCL;
4452
4453 coding = &coding_categories[coding_category_ccl];
4454 valids = CODING_CCL_VALIDS (coding);
4455 attrs = CODING_ID_ATTRS (coding->id);
4456 if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
4457 src += head_ascii;
4458
4459 while (1)
4460 {
4461 int c;
4462
4463 src_base = src;
4464 ONE_MORE_BYTE (c);
4465 if (c < 0 || ! valids[c])
4466 break;
4467 if ((valids[c] > 1))
4468 found = CATEGORY_MASK_CCL;
4469 }
4470 detect_info->rejected |= CATEGORY_MASK_CCL;
4471 return 0;
4472
4473 no_more_source:
4474 detect_info->found |= found;
4475 return 1;
4476 }
4477
4478 static void
4479 decode_coding_ccl (coding)
4480 struct coding_system *coding;
4481 {
4482 const unsigned char *src = coding->source + coding->consumed;
4483 const unsigned char *src_end = coding->source + coding->src_bytes;
4484 int *charbuf = coding->charbuf + coding->charbuf_used;
4485 int *charbuf_end = coding->charbuf + coding->charbuf_size;
4486 int consumed_chars = 0;
4487 int multibytep = coding->src_multibyte;
4488 struct ccl_program ccl;
4489 int source_charbuf[1024];
4490 int source_byteidx[1024];
4491 Lisp_Object attrs, charset_list;
4492
4493 CODING_GET_INFO (coding, attrs, charset_list);
4494 setup_ccl_program (&ccl, CODING_CCL_DECODER (coding));
4495
4496 while (src < src_end)
4497 {
4498 const unsigned char *p = src;
4499 int *source, *source_end;
4500 int i = 0;
4501
4502 if (multibytep)
4503 while (i < 1024 && p < src_end)
4504 {
4505 source_byteidx[i] = p - src;
4506 source_charbuf[i++] = STRING_CHAR_ADVANCE (p);
4507 }
4508 else
4509 while (i < 1024 && p < src_end)
4510 source_charbuf[i++] = *p++;
4511
4512 if (p == src_end && coding->mode & CODING_MODE_LAST_BLOCK)
4513 ccl.last_block = 1;
4514
4515 source = source_charbuf;
4516 source_end = source + i;
4517 while (source < source_end)
4518 {
4519 ccl_driver (&ccl, source, charbuf,
4520 source_end - source, charbuf_end - charbuf,
4521 charset_list);
4522 source += ccl.consumed;
4523 charbuf += ccl.produced;
4524 if (ccl.status != CCL_STAT_SUSPEND_BY_DST)
4525 break;
4526 }
4527 if (source < source_end)
4528 src += source_byteidx[source - source_charbuf];
4529 else
4530 src = p;
4531 consumed_chars += source - source_charbuf;
4532
4533 if (ccl.status != CCL_STAT_SUSPEND_BY_SRC
4534 && ccl.status != CODING_RESULT_INSUFFICIENT_SRC)
4535 break;
4536 }
4537
4538 switch (ccl.status)
4539 {
4540 case CCL_STAT_SUSPEND_BY_SRC:
4541 record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_SRC);
4542 break;
4543 case CCL_STAT_SUSPEND_BY_DST:
4544 break;
4545 case CCL_STAT_QUIT:
4546 case CCL_STAT_INVALID_CMD:
4547 record_conversion_result (coding, CODING_RESULT_INTERRUPT);
4548 break;
4549 default:
4550 record_conversion_result (coding, CODING_RESULT_SUCCESS);
4551 break;
4552 }
4553 coding->consumed_char += consumed_chars;
4554 coding->consumed = src - coding->source;
4555 coding->charbuf_used = charbuf - coding->charbuf;
4556 }
4557
4558 static int
4559 encode_coding_ccl (coding)
4560 struct coding_system *coding;
4561 {
4562 struct ccl_program ccl;
4563 int multibytep = coding->dst_multibyte;
4564 int *charbuf = coding->charbuf;
4565 int *charbuf_end = charbuf + coding->charbuf_used;
4566 unsigned char *dst = coding->destination + coding->produced;
4567 unsigned char *dst_end = coding->destination + coding->dst_bytes;
4568 int destination_charbuf[1024];
4569 int i, produced_chars = 0;
4570 Lisp_Object attrs, charset_list;
4571
4572 CODING_GET_INFO (coding, attrs, charset_list);
4573 setup_ccl_program (&ccl, CODING_CCL_ENCODER (coding));
4574
4575 ccl.last_block = coding->mode & CODING_MODE_LAST_BLOCK;
4576 ccl.dst_multibyte = coding->dst_multibyte;
4577
4578 while (charbuf < charbuf_end)
4579 {
4580 ccl_driver (&ccl, charbuf, destination_charbuf,
4581 charbuf_end - charbuf, 1024, charset_list);
4582 if (multibytep)
4583 {
4584 ASSURE_DESTINATION (ccl.produced * 2);
4585 for (i = 0; i < ccl.produced; i++)
4586 EMIT_ONE_BYTE (destination_charbuf[i] & 0xFF);
4587 }
4588 else
4589 {
4590 ASSURE_DESTINATION (ccl.produced);
4591 for (i = 0; i < ccl.produced; i++)
4592 *dst++ = destination_charbuf[i] & 0xFF;
4593 produced_chars += ccl.produced;
4594 }
4595 charbuf += ccl.consumed;
4596 if (ccl.status == CCL_STAT_QUIT
4597 || ccl.status == CCL_STAT_INVALID_CMD)
4598 break;
4599 }
4600
4601 switch (ccl.status)
4602 {
4603 case CCL_STAT_SUSPEND_BY_SRC:
4604 record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_SRC);
4605 break;
4606 case CCL_STAT_SUSPEND_BY_DST:
4607 record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_DST);
4608 break;
4609 case CCL_STAT_QUIT:
4610 case CCL_STAT_INVALID_CMD:
4611 record_conversion_result (coding, CODING_RESULT_INTERRUPT);
4612 break;
4613 default:
4614 record_conversion_result (coding, CODING_RESULT_SUCCESS);
4615 break;
4616 }
4617
4618 coding->produced_char += produced_chars;
4619 coding->produced = dst - coding->destination;
4620 return 0;
4621 }
4622
4623
4624 \f
4625 /*** 10, 11. no-conversion handlers ***/
4626
4627 /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
4628
4629 static void
4630 decode_coding_raw_text (coding)
4631 struct coding_system *coding;
4632 {
4633 coding->chars_at_source = 1;
4634 coding->consumed_char = 0;
4635 coding->consumed = 0;
4636 record_conversion_result (coding, CODING_RESULT_SUCCESS);
4637 }
4638
4639 static int
4640 encode_coding_raw_text (coding)
4641 struct coding_system *coding;
4642 {
4643 int multibytep = coding->dst_multibyte;
4644 int *charbuf = coding->charbuf;
4645 int *charbuf_end = coding->charbuf + coding->charbuf_used;
4646 unsigned char *dst = coding->destination + coding->produced;
4647 unsigned char *dst_end = coding->destination + coding->dst_bytes;
4648 int produced_chars = 0;
4649 int c;
4650
4651 if (multibytep)
4652 {
4653 int safe_room = MAX_MULTIBYTE_LENGTH * 2;
4654
4655 if (coding->src_multibyte)
4656 while (charbuf < charbuf_end)
4657 {
4658 ASSURE_DESTINATION (safe_room);
4659 c = *charbuf++;
4660 if (ASCII_CHAR_P (c))
4661 EMIT_ONE_ASCII_BYTE (c);
4662 else if (CHAR_BYTE8_P (c))
4663 {
4664 c = CHAR_TO_BYTE8 (c);
4665 EMIT_ONE_BYTE (c);
4666 }
4667 else
4668 {
4669 unsigned char str[MAX_MULTIBYTE_LENGTH], *p0 = str, *p1 = str;
4670
4671 CHAR_STRING_ADVANCE (c, p1);
4672 while (p0 < p1)
4673 {
4674 EMIT_ONE_BYTE (*p0);
4675 p0++;
4676 }
4677 }
4678 }
4679 else
4680 while (charbuf < charbuf_end)
4681 {
4682 ASSURE_DESTINATION (safe_room);
4683 c = *charbuf++;
4684 EMIT_ONE_BYTE (c);
4685 }
4686 }
4687 else
4688 {
4689 if (coding->src_multibyte)
4690 {
4691 int safe_room = MAX_MULTIBYTE_LENGTH;
4692
4693 while (charbuf < charbuf_end)
4694 {
4695 ASSURE_DESTINATION (safe_room);
4696 c = *charbuf++;
4697 if (ASCII_CHAR_P (c))
4698 *dst++ = c;
4699 else if (CHAR_BYTE8_P (c))
4700 *dst++ = CHAR_TO_BYTE8 (c);
4701 else
4702 CHAR_STRING_ADVANCE (c, dst);
4703 produced_chars++;
4704 }
4705 }
4706 else
4707 {
4708 ASSURE_DESTINATION (charbuf_end - charbuf);
4709 while (charbuf < charbuf_end && dst < dst_end)
4710 *dst++ = *charbuf++;
4711 produced_chars = dst - (coding->destination + coding->dst_bytes);
4712 }
4713 }
4714 record_conversion_result (coding, CODING_RESULT_SUCCESS);
4715 coding->produced_char += produced_chars;
4716 coding->produced = dst - coding->destination;
4717 return 0;
4718 }
4719
4720 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
4721 Check if a text is encoded in a charset-based coding system. If it
4722 is, return 1, else return 0. */
4723
4724 static int
4725 detect_coding_charset (coding, detect_info)
4726 struct coding_system *coding;
4727 struct coding_detection_info *detect_info;
4728 {
4729 const unsigned char *src = coding->source, *src_base;
4730 const unsigned char *src_end = coding->source + coding->src_bytes;
4731 int multibytep = coding->src_multibyte;
4732 int consumed_chars = 0;
4733 Lisp_Object attrs, valids;
4734 int found = 0;
4735 int head_ascii = coding->head_ascii;
4736
4737 detect_info->checked |= CATEGORY_MASK_CHARSET;
4738
4739 coding = &coding_categories[coding_category_charset];
4740 attrs = CODING_ID_ATTRS (coding->id);
4741 valids = AREF (attrs, coding_attr_charset_valids);
4742
4743 if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
4744 src += head_ascii;
4745
4746 while (1)
4747 {
4748 int c;
4749 Lisp_Object val;
4750 struct charset *charset;
4751 int dim, idx;
4752
4753 src_base = src;
4754 ONE_MORE_BYTE (c);
4755 if (c < 0)
4756 continue;
4757 val = AREF (valids, c);
4758 if (NILP (val))
4759 break;
4760 if (c >= 0x80)
4761 found = CATEGORY_MASK_CHARSET;
4762 if (INTEGERP (val))
4763 {
4764 charset = CHARSET_FROM_ID (XFASTINT (val));
4765 dim = CHARSET_DIMENSION (charset);
4766 for (idx = 1; idx < dim; idx++)
4767 {
4768 if (src == src_end)
4769 goto too_short;
4770 ONE_MORE_BYTE (c);
4771 if (c < charset->code_space[(dim - 1 - idx) * 2]
4772 || c > charset->code_space[(dim - 1 - idx) * 2 + 1])
4773 break;
4774 }
4775 if (idx < dim)
4776 break;
4777 }
4778 else
4779 {
4780 idx = 1;
4781 for (; CONSP (val); val = XCDR (val))
4782 {
4783 charset = CHARSET_FROM_ID (XFASTINT (XCAR (val)));
4784 dim = CHARSET_DIMENSION (charset);
4785 while (idx < dim)
4786 {
4787 if (src == src_end)
4788 goto too_short;
4789 ONE_MORE_BYTE (c);
4790 if (c < charset->code_space[(dim - 1 - idx) * 4]
4791 || c > charset->code_space[(dim - 1 - idx) * 4 + 1])
4792 break;
4793 idx++;
4794 }
4795 if (idx == dim)
4796 {
4797 val = Qnil;
4798 break;
4799 }
4800 }
4801 if (CONSP (val))
4802 break;
4803 }
4804 }
4805 too_short:
4806 detect_info->rejected |= CATEGORY_MASK_CHARSET;
4807 return 0;
4808
4809 no_more_source:
4810 detect_info->found |= found;
4811 return 1;
4812 }
4813
4814 static void
4815 decode_coding_charset (coding)
4816 struct coding_system *coding;
4817 {
4818 const unsigned char *src = coding->source + coding->consumed;
4819 const unsigned char *src_end = coding->source + coding->src_bytes;
4820 const unsigned char *src_base;
4821 int *charbuf = coding->charbuf + coding->charbuf_used;
4822 int *charbuf_end
4823 = coding->charbuf + coding->charbuf_size - MAX_ANNOTATION_LENGTH;
4824 int consumed_chars = 0, consumed_chars_base;
4825 int multibytep = coding->src_multibyte;
4826 Lisp_Object attrs, charset_list, valids;
4827 int char_offset = coding->produced_char;
4828 int last_offset = char_offset;
4829 int last_id = charset_ascii;
4830
4831 CODING_GET_INFO (coding, attrs, charset_list);
4832 valids = AREF (attrs, coding_attr_charset_valids);
4833
4834 while (1)
4835 {
4836 int c;
4837 Lisp_Object val;
4838 struct charset *charset;
4839 int dim;
4840 int len = 1;
4841 unsigned code;
4842
4843 src_base = src;
4844 consumed_chars_base = consumed_chars;
4845
4846 if (charbuf >= charbuf_end)
4847 break;
4848
4849 ONE_MORE_BYTE (c);
4850 if (c < 0)
4851 goto invalid_code;
4852 code = c;
4853
4854 val = AREF (valids, c);
4855 if (NILP (val))
4856 goto invalid_code;
4857 if (INTEGERP (val))
4858 {
4859 charset = CHARSET_FROM_ID (XFASTINT (val));
4860 dim = CHARSET_DIMENSION (charset);
4861 while (len < dim)
4862 {
4863 ONE_MORE_BYTE (c);
4864 code = (code << 8) | c;
4865 len++;
4866 }
4867 CODING_DECODE_CHAR (coding, src, src_base, src_end,
4868 charset, code, c);
4869 }
4870 else
4871 {
4872 /* VAL is a list of charset IDs. It is assured that the
4873 list is sorted by charset dimensions (smaller one
4874 comes first). */
4875 while (CONSP (val))
4876 {
4877 charset = CHARSET_FROM_ID (XFASTINT (XCAR (val)));
4878 dim = CHARSET_DIMENSION (charset);
4879 while (len < dim)
4880 {
4881 ONE_MORE_BYTE (c);
4882 code = (code << 8) | c;
4883 len++;
4884 }
4885 CODING_DECODE_CHAR (coding, src, src_base,
4886 src_end, charset, code, c);
4887 if (c >= 0)
4888 break;
4889 val = XCDR (val);
4890 }
4891 }
4892 if (c < 0)
4893 goto invalid_code;
4894 if (charset->id != charset_ascii
4895 && last_id != charset->id)
4896 {
4897 if (last_id != charset_ascii)
4898 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
4899 last_id = charset->id;
4900 last_offset = char_offset;
4901 }
4902
4903 *charbuf++ = c;
4904 char_offset++;
4905 continue;
4906
4907 invalid_code:
4908 src = src_base;
4909 consumed_chars = consumed_chars_base;
4910 ONE_MORE_BYTE (c);
4911 *charbuf++ = c < 0 ? -c : ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c);
4912 char_offset++;
4913 coding->errors++;
4914 }
4915
4916 no_more_source:
4917 if (last_id != charset_ascii)
4918 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
4919 coding->consumed_char += consumed_chars_base;
4920 coding->consumed = src_base - coding->source;
4921 coding->charbuf_used = charbuf - coding->charbuf;
4922 }
4923
4924 static int
4925 encode_coding_charset (coding)
4926 struct coding_system *coding;
4927 {
4928 int multibytep = coding->dst_multibyte;
4929 int *charbuf = coding->charbuf;
4930 int *charbuf_end = charbuf + coding->charbuf_used;
4931 unsigned char *dst = coding->destination + coding->produced;
4932 unsigned char *dst_end = coding->destination + coding->dst_bytes;
4933 int safe_room = MAX_MULTIBYTE_LENGTH;
4934 int produced_chars = 0;
4935 Lisp_Object attrs, charset_list;
4936 int ascii_compatible;
4937 int c;
4938
4939 CODING_GET_INFO (coding, attrs, charset_list);
4940 ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
4941
4942 while (charbuf < charbuf_end)
4943 {
4944 struct charset *charset;
4945 unsigned code;
4946
4947 ASSURE_DESTINATION (safe_room);
4948 c = *charbuf++;
4949 if (ascii_compatible && ASCII_CHAR_P (c))
4950 EMIT_ONE_ASCII_BYTE (c);
4951 else if (CHAR_BYTE8_P (c))
4952 {
4953 c = CHAR_TO_BYTE8 (c);
4954 EMIT_ONE_BYTE (c);
4955 }
4956 else
4957 {
4958 charset = char_charset (c, charset_list, &code);
4959 if (charset)
4960 {
4961 if (CHARSET_DIMENSION (charset) == 1)
4962 EMIT_ONE_BYTE (code);
4963 else if (CHARSET_DIMENSION (charset) == 2)
4964 EMIT_TWO_BYTES (code >> 8, code & 0xFF);
4965 else if (CHARSET_DIMENSION (charset) == 3)
4966 EMIT_THREE_BYTES (code >> 16, (code >> 8) & 0xFF, code & 0xFF);
4967 else
4968 EMIT_FOUR_BYTES (code >> 24, (code >> 16) & 0xFF,
4969 (code >> 8) & 0xFF, code & 0xFF);
4970 }
4971 else
4972 {
4973 if (coding->mode & CODING_MODE_SAFE_ENCODING)
4974 c = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
4975 else
4976 c = coding->default_char;
4977 EMIT_ONE_BYTE (c);
4978 }
4979 }
4980 }
4981
4982 record_conversion_result (coding, CODING_RESULT_SUCCESS);
4983 coding->produced_char += produced_chars;
4984 coding->produced = dst - coding->destination;
4985 return 0;
4986 }
4987
4988 \f
4989 /*** 7. C library functions ***/
4990
4991 /* Setup coding context CODING from information about CODING_SYSTEM.
4992 If CODING_SYSTEM is nil, `no-conversion' is assumed. If
4993 CODING_SYSTEM is invalid, signal an error. */
4994
4995 void
4996 setup_coding_system (coding_system, coding)
4997 Lisp_Object coding_system;
4998 struct coding_system *coding;
4999 {
5000 Lisp_Object attrs;
5001 Lisp_Object eol_type;
5002 Lisp_Object coding_type;
5003 Lisp_Object val;
5004
5005 if (NILP (coding_system))
5006 coding_system = Qundecided;
5007
5008 CHECK_CODING_SYSTEM_GET_ID (coding_system, coding->id);
5009
5010 attrs = CODING_ID_ATTRS (coding->id);
5011 eol_type = CODING_ID_EOL_TYPE (coding->id);
5012
5013 coding->mode = 0;
5014 coding->head_ascii = -1;
5015 if (VECTORP (eol_type))
5016 coding->common_flags = (CODING_REQUIRE_DECODING_MASK
5017 | CODING_REQUIRE_DETECTION_MASK);
5018 else if (! EQ (eol_type, Qunix))
5019 coding->common_flags = (CODING_REQUIRE_DECODING_MASK
5020 | CODING_REQUIRE_ENCODING_MASK);
5021 else
5022 coding->common_flags = 0;
5023 if (! NILP (CODING_ATTR_POST_READ (attrs)))
5024 coding->common_flags |= CODING_REQUIRE_DECODING_MASK;
5025 if (! NILP (CODING_ATTR_PRE_WRITE (attrs)))
5026 coding->common_flags |= CODING_REQUIRE_ENCODING_MASK;
5027 if (! NILP (CODING_ATTR_FOR_UNIBYTE (attrs)))
5028 coding->common_flags |= CODING_FOR_UNIBYTE_MASK;
5029
5030 val = CODING_ATTR_SAFE_CHARSETS (attrs);
5031 coding->max_charset_id = SCHARS (val) - 1;
5032 coding->safe_charsets = (char *) SDATA (val);
5033 coding->default_char = XINT (CODING_ATTR_DEFAULT_CHAR (attrs));
5034
5035 coding_type = CODING_ATTR_TYPE (attrs);
5036 if (EQ (coding_type, Qundecided))
5037 {
5038 coding->detector = NULL;
5039 coding->decoder = decode_coding_raw_text;
5040 coding->encoder = encode_coding_raw_text;
5041 coding->common_flags |= CODING_REQUIRE_DETECTION_MASK;
5042 }
5043 else if (EQ (coding_type, Qiso_2022))
5044 {
5045 int i;
5046 int flags = XINT (AREF (attrs, coding_attr_iso_flags));
5047
5048 /* Invoke graphic register 0 to plane 0. */
5049 CODING_ISO_INVOCATION (coding, 0) = 0;
5050 /* Invoke graphic register 1 to plane 1 if we can use 8-bit. */
5051 CODING_ISO_INVOCATION (coding, 1)
5052 = (flags & CODING_ISO_FLAG_SEVEN_BITS ? -1 : 1);
5053 /* Setup the initial status of designation. */
5054 for (i = 0; i < 4; i++)
5055 CODING_ISO_DESIGNATION (coding, i) = CODING_ISO_INITIAL (coding, i);
5056 /* Not single shifting initially. */
5057 CODING_ISO_SINGLE_SHIFTING (coding) = 0;
5058 /* Beginning of buffer should also be regarded as bol. */
5059 CODING_ISO_BOL (coding) = 1;
5060 coding->detector = detect_coding_iso_2022;
5061 coding->decoder = decode_coding_iso_2022;
5062 coding->encoder = encode_coding_iso_2022;
5063 if (flags & CODING_ISO_FLAG_SAFE)
5064 coding->mode |= CODING_MODE_SAFE_ENCODING;
5065 coding->common_flags
5066 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK
5067 | CODING_REQUIRE_FLUSHING_MASK);
5068 if (flags & CODING_ISO_FLAG_COMPOSITION)
5069 coding->common_flags |= CODING_ANNOTATE_COMPOSITION_MASK;
5070 if (flags & CODING_ISO_FLAG_DESIGNATION)
5071 coding->common_flags |= CODING_ANNOTATE_CHARSET_MASK;
5072 if (flags & CODING_ISO_FLAG_FULL_SUPPORT)
5073 {
5074 setup_iso_safe_charsets (attrs);
5075 val = CODING_ATTR_SAFE_CHARSETS (attrs);
5076 coding->max_charset_id = SCHARS (val) - 1;
5077 coding->safe_charsets = (char *) SDATA (val);
5078 }
5079 CODING_ISO_FLAGS (coding) = flags;
5080 }
5081 else if (EQ (coding_type, Qcharset))
5082 {
5083 coding->detector = detect_coding_charset;
5084 coding->decoder = decode_coding_charset;
5085 coding->encoder = encode_coding_charset;
5086 coding->common_flags
5087 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
5088 }
5089 else if (EQ (coding_type, Qutf_8))
5090 {
5091 coding->detector = detect_coding_utf_8;
5092 coding->decoder = decode_coding_utf_8;
5093 coding->encoder = encode_coding_utf_8;
5094 coding->common_flags
5095 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
5096 }
5097 else if (EQ (coding_type, Qutf_16))
5098 {
5099 val = AREF (attrs, coding_attr_utf_16_bom);
5100 CODING_UTF_16_BOM (coding) = (CONSP (val) ? utf_16_detect_bom
5101 : EQ (val, Qt) ? utf_16_with_bom
5102 : utf_16_without_bom);
5103 val = AREF (attrs, coding_attr_utf_16_endian);
5104 CODING_UTF_16_ENDIAN (coding) = (EQ (val, Qbig) ? utf_16_big_endian
5105 : utf_16_little_endian);
5106 CODING_UTF_16_SURROGATE (coding) = 0;
5107 coding->detector = detect_coding_utf_16;
5108 coding->decoder = decode_coding_utf_16;
5109 coding->encoder = encode_coding_utf_16;
5110 coding->common_flags
5111 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
5112 if (CODING_UTF_16_BOM (coding) == utf_16_detect_bom)
5113 coding->common_flags |= CODING_REQUIRE_DETECTION_MASK;
5114 }
5115 else if (EQ (coding_type, Qccl))
5116 {
5117 coding->detector = detect_coding_ccl;
5118 coding->decoder = decode_coding_ccl;
5119 coding->encoder = encode_coding_ccl;
5120 coding->common_flags
5121 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK
5122 | CODING_REQUIRE_FLUSHING_MASK);
5123 }
5124 else if (EQ (coding_type, Qemacs_mule))
5125 {
5126 coding->detector = detect_coding_emacs_mule;
5127 coding->decoder = decode_coding_emacs_mule;
5128 coding->encoder = encode_coding_emacs_mule;
5129 coding->common_flags
5130 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
5131 if (! NILP (AREF (attrs, coding_attr_emacs_mule_full))
5132 && ! EQ (CODING_ATTR_CHARSET_LIST (attrs), Vemacs_mule_charset_list))
5133 {
5134 Lisp_Object tail, safe_charsets;
5135 int max_charset_id = 0;
5136
5137 for (tail = Vemacs_mule_charset_list; CONSP (tail);
5138 tail = XCDR (tail))
5139 if (max_charset_id < XFASTINT (XCAR (tail)))
5140 max_charset_id = XFASTINT (XCAR (tail));
5141 safe_charsets = Fmake_string (make_number (max_charset_id + 1),
5142 make_number (255));
5143 for (tail = Vemacs_mule_charset_list; CONSP (tail);
5144 tail = XCDR (tail))
5145 SSET (safe_charsets, XFASTINT (XCAR (tail)), 0);
5146 coding->max_charset_id = max_charset_id;
5147 coding->safe_charsets = (char *) SDATA (safe_charsets);
5148 }
5149 }
5150 else if (EQ (coding_type, Qshift_jis))
5151 {
5152 coding->detector = detect_coding_sjis;
5153 coding->decoder = decode_coding_sjis;
5154 coding->encoder = encode_coding_sjis;
5155 coding->common_flags
5156 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
5157 }
5158 else if (EQ (coding_type, Qbig5))
5159 {
5160 coding->detector = detect_coding_big5;
5161 coding->decoder = decode_coding_big5;
5162 coding->encoder = encode_coding_big5;
5163 coding->common_flags
5164 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
5165 }
5166 else /* EQ (coding_type, Qraw_text) */
5167 {
5168 coding->detector = NULL;
5169 coding->decoder = decode_coding_raw_text;
5170 coding->encoder = encode_coding_raw_text;
5171 if (! EQ (eol_type, Qunix))
5172 {
5173 coding->common_flags |= CODING_REQUIRE_DECODING_MASK;
5174 if (! VECTORP (eol_type))
5175 coding->common_flags |= CODING_REQUIRE_ENCODING_MASK;
5176 }
5177
5178 }
5179
5180 return;
5181 }
5182
5183 /* Return a list of charsets supported by CODING. */
5184
5185 Lisp_Object
5186 coding_charset_list (coding)
5187 struct coding_system *coding;
5188 {
5189 Lisp_Object attrs, charset_list;
5190
5191 CODING_GET_INFO (coding, attrs, charset_list);
5192 if (EQ (CODING_ATTR_TYPE (attrs), Qiso_2022))
5193 {
5194 int flags = XINT (AREF (attrs, coding_attr_iso_flags));
5195
5196 if (flags & CODING_ISO_FLAG_FULL_SUPPORT)
5197 charset_list = Viso_2022_charset_list;
5198 }
5199 else if (EQ (CODING_ATTR_TYPE (attrs), Qemacs_mule))
5200 {
5201 charset_list = Vemacs_mule_charset_list;
5202 }
5203 return charset_list;
5204 }
5205
5206
5207 /* Return raw-text or one of its subsidiaries that has the same
5208 eol_type as CODING-SYSTEM. */
5209
5210 Lisp_Object
5211 raw_text_coding_system (coding_system)
5212 Lisp_Object coding_system;
5213 {
5214 Lisp_Object spec, attrs;
5215 Lisp_Object eol_type, raw_text_eol_type;
5216
5217 if (NILP (coding_system))
5218 return Qraw_text;
5219 spec = CODING_SYSTEM_SPEC (coding_system);
5220 attrs = AREF (spec, 0);
5221
5222 if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
5223 return coding_system;
5224
5225 eol_type = AREF (spec, 2);
5226 if (VECTORP (eol_type))
5227 return Qraw_text;
5228 spec = CODING_SYSTEM_SPEC (Qraw_text);
5229 raw_text_eol_type = AREF (spec, 2);
5230 return (EQ (eol_type, Qunix) ? AREF (raw_text_eol_type, 0)
5231 : EQ (eol_type, Qdos) ? AREF (raw_text_eol_type, 1)
5232 : AREF (raw_text_eol_type, 2));
5233 }
5234
5235
5236 /* If CODING_SYSTEM doesn't specify end-of-line format but PARENT
5237 does, return one of the subsidiary that has the same eol-spec as
5238 PARENT. Otherwise, return CODING_SYSTEM. If PARENT is nil,
5239 inherit end-of-line format from the system's setting
5240 (system_eol_type). */
5241
5242 Lisp_Object
5243 coding_inherit_eol_type (coding_system, parent)
5244 Lisp_Object coding_system, parent;
5245 {
5246 Lisp_Object spec, eol_type;
5247
5248 if (NILP (coding_system))
5249 coding_system = Qraw_text;
5250 spec = CODING_SYSTEM_SPEC (coding_system);
5251 eol_type = AREF (spec, 2);
5252 if (VECTORP (eol_type))
5253 {
5254 Lisp_Object parent_eol_type;
5255
5256 if (! NILP (parent))
5257 {
5258 Lisp_Object parent_spec;
5259
5260 parent_spec = CODING_SYSTEM_SPEC (parent);
5261 parent_eol_type = AREF (parent_spec, 2);
5262 }
5263 else
5264 parent_eol_type = system_eol_type;
5265 if (EQ (parent_eol_type, Qunix))
5266 coding_system = AREF (eol_type, 0);
5267 else if (EQ (parent_eol_type, Qdos))
5268 coding_system = AREF (eol_type, 1);
5269 else if (EQ (parent_eol_type, Qmac))
5270 coding_system = AREF (eol_type, 2);
5271 }
5272 return coding_system;
5273 }
5274
5275 /* Emacs has a mechanism to automatically detect a coding system if it
5276 is one of Emacs' internal format, ISO2022, SJIS, and BIG5. But,
5277 it's impossible to distinguish some coding systems accurately
5278 because they use the same range of codes. So, at first, coding
5279 systems are categorized into 7, those are:
5280
5281 o coding-category-emacs-mule
5282
5283 The category for a coding system which has the same code range
5284 as Emacs' internal format. Assigned the coding-system (Lisp
5285 symbol) `emacs-mule' by default.
5286
5287 o coding-category-sjis
5288
5289 The category for a coding system which has the same code range
5290 as SJIS. Assigned the coding-system (Lisp
5291 symbol) `japanese-shift-jis' by default.
5292
5293 o coding-category-iso-7
5294
5295 The category for a coding system which has the same code range
5296 as ISO2022 of 7-bit environment. This doesn't use any locking
5297 shift and single shift functions. This can encode/decode all
5298 charsets. Assigned the coding-system (Lisp symbol)
5299 `iso-2022-7bit' by default.
5300
5301 o coding-category-iso-7-tight
5302
5303 Same as coding-category-iso-7 except that this can
5304 encode/decode only the specified charsets.
5305
5306 o coding-category-iso-8-1
5307
5308 The category for a coding system which has the same code range
5309 as ISO2022 of 8-bit environment and graphic plane 1 used only
5310 for DIMENSION1 charset. This doesn't use any locking shift
5311 and single shift functions. Assigned the coding-system (Lisp
5312 symbol) `iso-latin-1' by default.
5313
5314 o coding-category-iso-8-2
5315
5316 The category for a coding system which has the same code range
5317 as ISO2022 of 8-bit environment and graphic plane 1 used only
5318 for DIMENSION2 charset. This doesn't use any locking shift
5319 and single shift functions. Assigned the coding-system (Lisp
5320 symbol) `japanese-iso-8bit' by default.
5321
5322 o coding-category-iso-7-else
5323
5324 The category for a coding system which has the same code range
5325 as ISO2022 of 7-bit environemnt but uses locking shift or
5326 single shift functions. Assigned the coding-system (Lisp
5327 symbol) `iso-2022-7bit-lock' by default.
5328
5329 o coding-category-iso-8-else
5330
5331 The category for a coding system which has the same code range
5332 as ISO2022 of 8-bit environemnt but uses locking shift or
5333 single shift functions. Assigned the coding-system (Lisp
5334 symbol) `iso-2022-8bit-ss2' by default.
5335
5336 o coding-category-big5
5337
5338 The category for a coding system which has the same code range
5339 as BIG5. Assigned the coding-system (Lisp symbol)
5340 `cn-big5' by default.
5341
5342 o coding-category-utf-8
5343
5344 The category for a coding system which has the same code range
5345 as UTF-8 (cf. RFC3629). Assigned the coding-system (Lisp
5346 symbol) `utf-8' by default.
5347
5348 o coding-category-utf-16-be
5349
5350 The category for a coding system in which a text has an
5351 Unicode signature (cf. Unicode Standard) in the order of BIG
5352 endian at the head. Assigned the coding-system (Lisp symbol)
5353 `utf-16-be' by default.
5354
5355 o coding-category-utf-16-le
5356
5357 The category for a coding system in which a text has an
5358 Unicode signature (cf. Unicode Standard) in the order of
5359 LITTLE endian at the head. Assigned the coding-system (Lisp
5360 symbol) `utf-16-le' by default.
5361
5362 o coding-category-ccl
5363
5364 The category for a coding system of which encoder/decoder is
5365 written in CCL programs. The default value is nil, i.e., no
5366 coding system is assigned.
5367
5368 o coding-category-binary
5369
5370 The category for a coding system not categorized in any of the
5371 above. Assigned the coding-system (Lisp symbol)
5372 `no-conversion' by default.
5373
5374 Each of them is a Lisp symbol and the value is an actual
5375 `coding-system's (this is also a Lisp symbol) assigned by a user.
5376 What Emacs does actually is to detect a category of coding system.
5377 Then, it uses a `coding-system' assigned to it. If Emacs can't
5378 decide only one possible category, it selects a category of the
5379 highest priority. Priorities of categories are also specified by a
5380 user in a Lisp variable `coding-category-list'.
5381
5382 */
5383
5384 #define EOL_SEEN_NONE 0
5385 #define EOL_SEEN_LF 1
5386 #define EOL_SEEN_CR 2
5387 #define EOL_SEEN_CRLF 4
5388
5389 /* Detect how end-of-line of a text of length SRC_BYTES pointed by
5390 SOURCE is encoded. If CATEGORY is one of
5391 coding_category_utf_16_XXXX, assume that CR and LF are encoded by
5392 two-byte, else they are encoded by one-byte.
5393
5394 Return one of EOL_SEEN_XXX. */
5395
5396 #define MAX_EOL_CHECK_COUNT 3
5397
5398 static int
5399 detect_eol (source, src_bytes, category)
5400 const unsigned char *source;
5401 EMACS_INT src_bytes;
5402 enum coding_category category;
5403 {
5404 const unsigned char *src = source, *src_end = src + src_bytes;
5405 unsigned char c;
5406 int total = 0;
5407 int eol_seen = EOL_SEEN_NONE;
5408
5409 if ((1 << category) & CATEGORY_MASK_UTF_16)
5410 {
5411 int msb, lsb;
5412
5413 msb = category == (coding_category_utf_16_le
5414 | coding_category_utf_16_le_nosig);
5415 lsb = 1 - msb;
5416
5417 while (src + 1 < src_end)
5418 {
5419 c = src[lsb];
5420 if (src[msb] == 0 && (c == '\n' || c == '\r'))
5421 {
5422 int this_eol;
5423
5424 if (c == '\n')
5425 this_eol = EOL_SEEN_LF;
5426 else if (src + 3 >= src_end
5427 || src[msb + 2] != 0
5428 || src[lsb + 2] != '\n')
5429 this_eol = EOL_SEEN_CR;
5430 else
5431 this_eol = EOL_SEEN_CRLF;
5432
5433 if (eol_seen == EOL_SEEN_NONE)
5434 /* This is the first end-of-line. */
5435 eol_seen = this_eol;
5436 else if (eol_seen != this_eol)
5437 {
5438 /* The found type is different from what found before. */
5439 eol_seen = EOL_SEEN_LF;
5440 break;
5441 }
5442 if (++total == MAX_EOL_CHECK_COUNT)
5443 break;
5444 }
5445 src += 2;
5446 }
5447 }
5448 else
5449 {
5450 while (src < src_end)
5451 {
5452 c = *src++;
5453 if (c == '\n' || c == '\r')
5454 {
5455 int this_eol;
5456
5457 if (c == '\n')
5458 this_eol = EOL_SEEN_LF;
5459 else if (src >= src_end || *src != '\n')
5460 this_eol = EOL_SEEN_CR;
5461 else
5462 this_eol = EOL_SEEN_CRLF, src++;
5463
5464 if (eol_seen == EOL_SEEN_NONE)
5465 /* This is the first end-of-line. */
5466 eol_seen = this_eol;
5467 else if (eol_seen != this_eol)
5468 {
5469 /* The found type is different from what found before. */
5470 eol_seen = EOL_SEEN_LF;
5471 break;
5472 }
5473 if (++total == MAX_EOL_CHECK_COUNT)
5474 break;
5475 }
5476 }
5477 }
5478 return eol_seen;
5479 }
5480
5481
5482 static Lisp_Object
5483 adjust_coding_eol_type (coding, eol_seen)
5484 struct coding_system *coding;
5485 int eol_seen;
5486 {
5487 Lisp_Object eol_type;
5488
5489 eol_type = CODING_ID_EOL_TYPE (coding->id);
5490 if (eol_seen & EOL_SEEN_LF)
5491 {
5492 coding->id = CODING_SYSTEM_ID (AREF (eol_type, 0));
5493 eol_type = Qunix;
5494 }
5495 else if (eol_seen & EOL_SEEN_CRLF)
5496 {
5497 coding->id = CODING_SYSTEM_ID (AREF (eol_type, 1));
5498 eol_type = Qdos;
5499 }
5500 else if (eol_seen & EOL_SEEN_CR)
5501 {
5502 coding->id = CODING_SYSTEM_ID (AREF (eol_type, 2));
5503 eol_type = Qmac;
5504 }
5505 return eol_type;
5506 }
5507
5508 /* Detect how a text specified in CODING is encoded. If a coding
5509 system is detected, update fields of CODING by the detected coding
5510 system. */
5511
5512 void
5513 detect_coding (coding)
5514 struct coding_system *coding;
5515 {
5516 const unsigned char *src, *src_end;
5517
5518 coding->consumed = coding->consumed_char = 0;
5519 coding->produced = coding->produced_char = 0;
5520 coding_set_source (coding);
5521
5522 src_end = coding->source + coding->src_bytes;
5523
5524 /* If we have not yet decided the text encoding type, detect it
5525 now. */
5526 if (EQ (CODING_ATTR_TYPE (CODING_ID_ATTRS (coding->id)), Qundecided))
5527 {
5528 int c, i;
5529 struct coding_detection_info detect_info;
5530
5531 detect_info.checked = detect_info.found = detect_info.rejected = 0;
5532 for (i = 0, src = coding->source; src < src_end; i++, src++)
5533 {
5534 c = *src;
5535 if (c & 0x80)
5536 break;
5537 if (c < 0x20
5538 && (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
5539 && ! inhibit_iso_escape_detection
5540 && ! detect_info.checked)
5541 {
5542 coding->head_ascii = src - (coding->source + coding->consumed);
5543 if (detect_coding_iso_2022 (coding, &detect_info))
5544 {
5545 /* We have scanned the whole data. */
5546 if (! (detect_info.rejected & CATEGORY_MASK_ISO_7_ELSE))
5547 /* We didn't find an 8-bit code. */
5548 src = src_end;
5549 break;
5550 }
5551 }
5552 }
5553 coding->head_ascii = src - (coding->source + coding->consumed);
5554
5555 if (coding->head_ascii < coding->src_bytes
5556 || detect_info.found)
5557 {
5558 enum coding_category category;
5559 struct coding_system *this;
5560
5561 if (coding->head_ascii == coding->src_bytes)
5562 /* As all bytes are 7-bit, we can ignore non-ISO-2022 codings. */
5563 for (i = 0; i < coding_category_raw_text; i++)
5564 {
5565 category = coding_priorities[i];
5566 this = coding_categories + category;
5567 if (detect_info.found & (1 << category))
5568 break;
5569 }
5570 else
5571 for (i = 0; i < coding_category_raw_text; i++)
5572 {
5573 category = coding_priorities[i];
5574 this = coding_categories + category;
5575 if (this->id < 0)
5576 {
5577 /* No coding system of this category is defined. */
5578 detect_info.rejected |= (1 << category);
5579 }
5580 else if (category >= coding_category_raw_text)
5581 continue;
5582 else if (detect_info.checked & (1 << category))
5583 {
5584 if (detect_info.found & (1 << category))
5585 break;
5586 }
5587 else if ((*(this->detector)) (coding, &detect_info)
5588 && detect_info.found & (1 << category))
5589 {
5590 if (category == coding_category_utf_16_auto)
5591 {
5592 if (detect_info.found & CATEGORY_MASK_UTF_16_LE)
5593 category = coding_category_utf_16_le;
5594 else
5595 category = coding_category_utf_16_be;
5596 }
5597 break;
5598 }
5599 }
5600
5601 if (i < coding_category_raw_text)
5602 setup_coding_system (CODING_ID_NAME (this->id), coding);
5603 else if (detect_info.rejected == CATEGORY_MASK_ANY)
5604 setup_coding_system (Qraw_text, coding);
5605 else if (detect_info.rejected)
5606 for (i = 0; i < coding_category_raw_text; i++)
5607 if (! (detect_info.rejected & (1 << coding_priorities[i])))
5608 {
5609 this = coding_categories + coding_priorities[i];
5610 setup_coding_system (CODING_ID_NAME (this->id), coding);
5611 break;
5612 }
5613 }
5614 }
5615 else if (XINT (CODING_ATTR_CATEGORY (CODING_ID_ATTRS (coding->id)))
5616 == coding_category_utf_16_auto)
5617 {
5618 Lisp_Object coding_systems;
5619 struct coding_detection_info detect_info;
5620
5621 coding_systems
5622 = AREF (CODING_ID_ATTRS (coding->id), coding_attr_utf_16_bom);
5623 detect_info.found = detect_info.rejected = 0;
5624 if (CONSP (coding_systems)
5625 && detect_coding_utf_16 (coding, &detect_info))
5626 {
5627 if (detect_info.found & CATEGORY_MASK_UTF_16_LE)
5628 setup_coding_system (XCAR (coding_systems), coding);
5629 else if (detect_info.found & CATEGORY_MASK_UTF_16_BE)
5630 setup_coding_system (XCDR (coding_systems), coding);
5631 }
5632 }
5633 }
5634
5635
5636 static void
5637 decode_eol (coding)
5638 struct coding_system *coding;
5639 {
5640 Lisp_Object eol_type;
5641 unsigned char *p, *pbeg, *pend;
5642
5643 eol_type = CODING_ID_EOL_TYPE (coding->id);
5644 if (EQ (eol_type, Qunix))
5645 return;
5646
5647 if (NILP (coding->dst_object))
5648 pbeg = coding->destination;
5649 else
5650 pbeg = BYTE_POS_ADDR (coding->dst_pos_byte);
5651 pend = pbeg + coding->produced;
5652
5653 if (VECTORP (eol_type))
5654 {
5655 int eol_seen = EOL_SEEN_NONE;
5656
5657 for (p = pbeg; p < pend; p++)
5658 {
5659 if (*p == '\n')
5660 eol_seen |= EOL_SEEN_LF;
5661 else if (*p == '\r')
5662 {
5663 if (p + 1 < pend && *(p + 1) == '\n')
5664 {
5665 eol_seen |= EOL_SEEN_CRLF;
5666 p++;
5667 }
5668 else
5669 eol_seen |= EOL_SEEN_CR;
5670 }
5671 }
5672 if (eol_seen != EOL_SEEN_NONE
5673 && eol_seen != EOL_SEEN_LF
5674 && eol_seen != EOL_SEEN_CRLF
5675 && eol_seen != EOL_SEEN_CR)
5676 eol_seen = EOL_SEEN_LF;
5677 if (eol_seen != EOL_SEEN_NONE)
5678 eol_type = adjust_coding_eol_type (coding, eol_seen);
5679 }
5680
5681 if (EQ (eol_type, Qmac))
5682 {
5683 for (p = pbeg; p < pend; p++)
5684 if (*p == '\r')
5685 *p = '\n';
5686 }
5687 else if (EQ (eol_type, Qdos))
5688 {
5689 int n = 0;
5690
5691 if (NILP (coding->dst_object))
5692 {
5693 /* Start deleting '\r' from the tail to minimize the memory
5694 movement. */
5695 for (p = pend - 2; p >= pbeg; p--)
5696 if (*p == '\r')
5697 {
5698 safe_bcopy ((char *) (p + 1), (char *) p, pend-- - p - 1);
5699 n++;
5700 }
5701 }
5702 else
5703 {
5704 int pos_byte = coding->dst_pos_byte;
5705 int pos = coding->dst_pos;
5706 int pos_end = pos + coding->produced_char - 1;
5707
5708 while (pos < pos_end)
5709 {
5710 p = BYTE_POS_ADDR (pos_byte);
5711 if (*p == '\r' && p[1] == '\n')
5712 {
5713 del_range_2 (pos, pos_byte, pos + 1, pos_byte + 1, 0);
5714 n++;
5715 pos_end--;
5716 }
5717 pos++;
5718 pos_byte += BYTES_BY_CHAR_HEAD (*p);
5719 }
5720 }
5721 coding->produced -= n;
5722 coding->produced_char -= n;
5723 }
5724 }
5725
5726
5727 /* Return a translation table (or list of them) from coding system
5728 attribute vector ATTRS for encoding (ENCODEP is nonzero) or
5729 decoding (ENCODEP is zero). */
5730
5731 static Lisp_Object
5732 get_translation_table (attrs, encodep, max_lookup)
5733 Lisp_Object attrs;
5734 int encodep, *max_lookup;
5735 {
5736 Lisp_Object standard, translation_table;
5737 Lisp_Object val;
5738
5739 if (encodep)
5740 translation_table = CODING_ATTR_ENCODE_TBL (attrs),
5741 standard = Vstandard_translation_table_for_encode;
5742 else
5743 translation_table = CODING_ATTR_DECODE_TBL (attrs),
5744 standard = Vstandard_translation_table_for_decode;
5745 if (NILP (translation_table))
5746 translation_table = standard;
5747 else
5748 {
5749 if (SYMBOLP (translation_table))
5750 translation_table = Fget (translation_table, Qtranslation_table);
5751 else if (CONSP (translation_table))
5752 {
5753 translation_table = Fcopy_sequence (translation_table);
5754 for (val = translation_table; CONSP (val); val = XCDR (val))
5755 if (SYMBOLP (XCAR (val)))
5756 XSETCAR (val, Fget (XCAR (val), Qtranslation_table));
5757 }
5758 if (CHAR_TABLE_P (standard))
5759 {
5760 if (CONSP (translation_table))
5761 translation_table = nconc2 (translation_table,
5762 Fcons (standard, Qnil));
5763 else
5764 translation_table = Fcons (translation_table,
5765 Fcons (standard, Qnil));
5766 }
5767 }
5768
5769 if (max_lookup)
5770 {
5771 *max_lookup = 1;
5772 if (CHAR_TABLE_P (translation_table)
5773 && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (translation_table)) > 1)
5774 {
5775 val = XCHAR_TABLE (translation_table)->extras[1];
5776 if (NATNUMP (val) && *max_lookup < XFASTINT (val))
5777 *max_lookup = XFASTINT (val);
5778 }
5779 else if (CONSP (translation_table))
5780 {
5781 Lisp_Object tail, val;
5782
5783 for (tail = translation_table; CONSP (tail); tail = XCDR (tail))
5784 if (CHAR_TABLE_P (XCAR (tail))
5785 && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (XCAR (tail))) > 1)
5786 {
5787 val = XCHAR_TABLE (XCAR (tail))->extras[1];
5788 if (NATNUMP (val) && *max_lookup < XFASTINT (val))
5789 *max_lookup = XFASTINT (val);
5790 }
5791 }
5792 }
5793 return translation_table;
5794 }
5795
5796 #define LOOKUP_TRANSLATION_TABLE(table, c, trans) \
5797 do { \
5798 trans = Qnil; \
5799 if (CHAR_TABLE_P (table)) \
5800 { \
5801 trans = CHAR_TABLE_REF (table, c); \
5802 if (CHARACTERP (trans)) \
5803 c = XFASTINT (trans), trans = Qnil; \
5804 } \
5805 else if (CONSP (table)) \
5806 { \
5807 Lisp_Object tail; \
5808 \
5809 for (tail = table; CONSP (tail); tail = XCDR (tail)) \
5810 if (CHAR_TABLE_P (XCAR (tail))) \
5811 { \
5812 trans = CHAR_TABLE_REF (XCAR (tail), c); \
5813 if (CHARACTERP (trans)) \
5814 c = XFASTINT (trans), trans = Qnil; \
5815 else if (! NILP (trans)) \
5816 break; \
5817 } \
5818 } \
5819 } while (0)
5820
5821
5822 static Lisp_Object
5823 get_translation (val, buf, buf_end, last_block, from_nchars, to_nchars)
5824 Lisp_Object val;
5825 int *buf, *buf_end;
5826 int last_block;
5827 int *from_nchars, *to_nchars;
5828 {
5829 /* VAL is TO or (([FROM-CHAR ...] . TO) ...) where TO is TO-CHAR or
5830 [TO-CHAR ...]. */
5831 if (CONSP (val))
5832 {
5833 Lisp_Object from, tail;
5834 int i, len;
5835
5836 for (tail = val; CONSP (tail); tail = XCDR (tail))
5837 {
5838 val = XCAR (tail);
5839 from = XCAR (val);
5840 len = ASIZE (from);
5841 for (i = 0; i < len; i++)
5842 {
5843 if (buf + i == buf_end)
5844 {
5845 if (! last_block)
5846 return Qt;
5847 break;
5848 }
5849 if (XINT (AREF (from, i)) != buf[i])
5850 break;
5851 }
5852 if (i == len)
5853 {
5854 val = XCDR (val);
5855 *from_nchars = len;
5856 break;
5857 }
5858 }
5859 if (! CONSP (tail))
5860 return Qnil;
5861 }
5862 if (VECTORP (val))
5863 *buf = XINT (AREF (val, 0)), *to_nchars = ASIZE (val);
5864 else
5865 *buf = XINT (val);
5866 return val;
5867 }
5868
5869
5870 static int
5871 produce_chars (coding, translation_table, last_block)
5872 struct coding_system *coding;
5873 Lisp_Object translation_table;
5874 int last_block;
5875 {
5876 unsigned char *dst = coding->destination + coding->produced;
5877 unsigned char *dst_end = coding->destination + coding->dst_bytes;
5878 int produced;
5879 int produced_chars = 0;
5880 int carryover = 0;
5881
5882 if (! coding->chars_at_source)
5883 {
5884 /* Characters are in coding->charbuf. */
5885 int *buf = coding->charbuf;
5886 int *buf_end = buf + coding->charbuf_used;
5887
5888 if (BUFFERP (coding->src_object)
5889 && EQ (coding->src_object, coding->dst_object))
5890 dst_end = ((unsigned char *) coding->source) + coding->consumed;
5891
5892 while (buf < buf_end)
5893 {
5894 int c = *buf, i;
5895
5896 if (c >= 0)
5897 {
5898 int from_nchars = 1, to_nchars = 1;
5899 Lisp_Object trans = Qnil;
5900
5901 LOOKUP_TRANSLATION_TABLE (translation_table, c, trans);
5902 if (! NILP (trans))
5903 {
5904 trans = get_translation (trans, buf, buf_end, last_block,
5905 &from_nchars, &to_nchars);
5906 if (EQ (trans, Qt))
5907 break;
5908 c = *buf;
5909 }
5910
5911 if (dst + MAX_MULTIBYTE_LENGTH * to_nchars > dst_end)
5912 {
5913 dst = alloc_destination (coding,
5914 buf_end - buf
5915 + MAX_MULTIBYTE_LENGTH * to_nchars,
5916 dst);
5917 dst_end = coding->destination + coding->dst_bytes;
5918 }
5919
5920 for (i = 0; i < to_nchars; i++)
5921 {
5922 if (i > 0)
5923 c = XINT (AREF (trans, i));
5924 if (coding->dst_multibyte
5925 || ! CHAR_BYTE8_P (c))
5926 CHAR_STRING_ADVANCE (c, dst);
5927 else
5928 *dst++ = CHAR_TO_BYTE8 (c);
5929 }
5930 produced_chars += to_nchars;
5931 *buf++ = to_nchars;
5932 while (--from_nchars > 0)
5933 *buf++ = 0;
5934 }
5935 else
5936 /* This is an annotation datum. (-C) is the length. */
5937 buf += -c;
5938 }
5939 carryover = buf_end - buf;
5940 }
5941 else
5942 {
5943 const unsigned char *src = coding->source;
5944 const unsigned char *src_end = src + coding->src_bytes;
5945 Lisp_Object eol_type;
5946
5947 eol_type = CODING_ID_EOL_TYPE (coding->id);
5948
5949 if (coding->src_multibyte != coding->dst_multibyte)
5950 {
5951 if (coding->src_multibyte)
5952 {
5953 int multibytep = 1;
5954 int consumed_chars;
5955
5956 while (1)
5957 {
5958 const unsigned char *src_base = src;
5959 int c;
5960
5961 ONE_MORE_BYTE (c);
5962 if (c == '\r')
5963 {
5964 if (EQ (eol_type, Qdos))
5965 {
5966 if (src == src_end)
5967 {
5968 record_conversion_result
5969 (coding, CODING_RESULT_INSUFFICIENT_SRC);
5970 goto no_more_source;
5971 }
5972 if (*src == '\n')
5973 c = *src++;
5974 }
5975 else if (EQ (eol_type, Qmac))
5976 c = '\n';
5977 }
5978 if (dst == dst_end)
5979 {
5980 coding->consumed = src - coding->source;
5981
5982 if (EQ (coding->src_object, coding->dst_object))
5983 dst_end = (unsigned char *) src;
5984 if (dst == dst_end)
5985 {
5986 dst = alloc_destination (coding, src_end - src + 1,
5987 dst);
5988 dst_end = coding->destination + coding->dst_bytes;
5989 coding_set_source (coding);
5990 src = coding->source + coding->consumed;
5991 src_end = coding->source + coding->src_bytes;
5992 }
5993 }
5994 *dst++ = c;
5995 produced_chars++;
5996 }
5997 no_more_source:
5998 ;
5999 }
6000 else
6001 while (src < src_end)
6002 {
6003 int multibytep = 1;
6004 int c = *src++;
6005
6006 if (c == '\r')
6007 {
6008 if (EQ (eol_type, Qdos))
6009 {
6010 if (src < src_end
6011 && *src == '\n')
6012 c = *src++;
6013 }
6014 else if (EQ (eol_type, Qmac))
6015 c = '\n';
6016 }
6017 if (dst >= dst_end - 1)
6018 {
6019 coding->consumed = src - coding->source;
6020
6021 if (EQ (coding->src_object, coding->dst_object))
6022 dst_end = (unsigned char *) src;
6023 if (dst >= dst_end - 1)
6024 {
6025 dst = alloc_destination (coding, src_end - src + 2,
6026 dst);
6027 dst_end = coding->destination + coding->dst_bytes;
6028 coding_set_source (coding);
6029 src = coding->source + coding->consumed;
6030 src_end = coding->source + coding->src_bytes;
6031 }
6032 }
6033 EMIT_ONE_BYTE (c);
6034 }
6035 }
6036 else
6037 {
6038 if (!EQ (coding->src_object, coding->dst_object))
6039 {
6040 int require = coding->src_bytes - coding->dst_bytes;
6041
6042 if (require > 0)
6043 {
6044 EMACS_INT offset = src - coding->source;
6045
6046 dst = alloc_destination (coding, require, dst);
6047 coding_set_source (coding);
6048 src = coding->source + offset;
6049 src_end = coding->source + coding->src_bytes;
6050 }
6051 }
6052 produced_chars = coding->src_chars;
6053 while (src < src_end)
6054 {
6055 int c = *src++;
6056
6057 if (c == '\r')
6058 {
6059 if (EQ (eol_type, Qdos))
6060 {
6061 if (src < src_end
6062 && *src == '\n')
6063 c = *src++;
6064 produced_chars--;
6065 }
6066 else if (EQ (eol_type, Qmac))
6067 c = '\n';
6068 }
6069 *dst++ = c;
6070 }
6071 }
6072 coding->consumed = coding->src_bytes;
6073 coding->consumed_char = coding->src_chars;
6074 }
6075
6076 produced = dst - (coding->destination + coding->produced);
6077 if (BUFFERP (coding->dst_object))
6078 insert_from_gap (produced_chars, produced);
6079 coding->produced += produced;
6080 coding->produced_char += produced_chars;
6081 return carryover;
6082 }
6083
6084 /* Compose text in CODING->object according to the annotation data at
6085 CHARBUF. CHARBUF is an array:
6086 [ -LENGTH ANNOTATION_MASK FROM TO METHOD COMP_LEN [ COMPONENTS... ] ]
6087 */
6088
6089 static INLINE void
6090 produce_composition (coding, charbuf, pos)
6091 struct coding_system *coding;
6092 int *charbuf;
6093 EMACS_INT pos;
6094 {
6095 int len;
6096 EMACS_INT to;
6097 enum composition_method method;
6098 Lisp_Object components;
6099
6100 len = -charbuf[0];
6101 to = pos + charbuf[2];
6102 if (to <= pos)
6103 return;
6104 method = (enum composition_method) (charbuf[3]);
6105
6106 if (method == COMPOSITION_RELATIVE)
6107 components = Qnil;
6108 else if (method >= COMPOSITION_WITH_RULE
6109 && method <= COMPOSITION_WITH_RULE_ALTCHARS)
6110 {
6111 Lisp_Object args[MAX_COMPOSITION_COMPONENTS * 2 - 1];
6112 int i;
6113
6114 len -= 4;
6115 charbuf += 4;
6116 for (i = 0; i < len; i++)
6117 {
6118 args[i] = make_number (charbuf[i]);
6119 if (charbuf[i] < 0)
6120 return;
6121 }
6122 components = (method == COMPOSITION_WITH_ALTCHARS
6123 ? Fstring (len, args) : Fvector (len, args));
6124 }
6125 else
6126 return;
6127 compose_text (pos, to, components, Qnil, coding->dst_object);
6128 }
6129
6130
6131 /* Put `charset' property on text in CODING->object according to
6132 the annotation data at CHARBUF. CHARBUF is an array:
6133 [ -LENGTH ANNOTATION_MASK NCHARS CHARSET-ID ]
6134 */
6135
6136 static INLINE void
6137 produce_charset (coding, charbuf, pos)
6138 struct coding_system *coding;
6139 int *charbuf;
6140 EMACS_INT pos;
6141 {
6142 EMACS_INT from = pos - charbuf[2];
6143 struct charset *charset = CHARSET_FROM_ID (charbuf[3]);
6144
6145 Fput_text_property (make_number (from), make_number (pos),
6146 Qcharset, CHARSET_NAME (charset),
6147 coding->dst_object);
6148 }
6149
6150
6151 #define CHARBUF_SIZE 0x4000
6152
6153 #define ALLOC_CONVERSION_WORK_AREA(coding) \
6154 do { \
6155 int size = CHARBUF_SIZE;; \
6156 \
6157 coding->charbuf = NULL; \
6158 while (size > 1024) \
6159 { \
6160 coding->charbuf = (int *) alloca (sizeof (int) * size); \
6161 if (coding->charbuf) \
6162 break; \
6163 size >>= 1; \
6164 } \
6165 if (! coding->charbuf) \
6166 { \
6167 record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_MEM); \
6168 return coding->result; \
6169 } \
6170 coding->charbuf_size = size; \
6171 } while (0)
6172
6173
6174 static void
6175 produce_annotation (coding, pos)
6176 struct coding_system *coding;
6177 EMACS_INT pos;
6178 {
6179 int *charbuf = coding->charbuf;
6180 int *charbuf_end = charbuf + coding->charbuf_used;
6181
6182 if (NILP (coding->dst_object))
6183 return;
6184
6185 while (charbuf < charbuf_end)
6186 {
6187 if (*charbuf >= 0)
6188 pos += *charbuf++;
6189 else
6190 {
6191 int len = -*charbuf;
6192 switch (charbuf[1])
6193 {
6194 case CODING_ANNOTATE_COMPOSITION_MASK:
6195 produce_composition (coding, charbuf, pos);
6196 break;
6197 case CODING_ANNOTATE_CHARSET_MASK:
6198 produce_charset (coding, charbuf, pos);
6199 break;
6200 default:
6201 abort ();
6202 }
6203 charbuf += len;
6204 }
6205 }
6206 }
6207
6208 /* Decode the data at CODING->src_object into CODING->dst_object.
6209 CODING->src_object is a buffer, a string, or nil.
6210 CODING->dst_object is a buffer.
6211
6212 If CODING->src_object is a buffer, it must be the current buffer.
6213 In this case, if CODING->src_pos is positive, it is a position of
6214 the source text in the buffer, otherwise, the source text is in the
6215 gap area of the buffer, and CODING->src_pos specifies the offset of
6216 the text from GPT (which must be the same as PT). If this is the
6217 same buffer as CODING->dst_object, CODING->src_pos must be
6218 negative.
6219
6220 If CODING->src_object is a string, CODING->src_pos is an index to
6221 that string.
6222
6223 If CODING->src_object is nil, CODING->source must already point to
6224 the non-relocatable memory area. In this case, CODING->src_pos is
6225 an offset from CODING->source.
6226
6227 The decoded data is inserted at the current point of the buffer
6228 CODING->dst_object.
6229 */
6230
6231 static int
6232 decode_coding (coding)
6233 struct coding_system *coding;
6234 {
6235 Lisp_Object attrs;
6236 Lisp_Object undo_list;
6237 Lisp_Object translation_table;
6238 int carryover;
6239 int i;
6240
6241 if (BUFFERP (coding->src_object)
6242 && coding->src_pos > 0
6243 && coding->src_pos < GPT
6244 && coding->src_pos + coding->src_chars > GPT)
6245 move_gap_both (coding->src_pos, coding->src_pos_byte);
6246
6247 undo_list = Qt;
6248 if (BUFFERP (coding->dst_object))
6249 {
6250 if (current_buffer != XBUFFER (coding->dst_object))
6251 set_buffer_internal (XBUFFER (coding->dst_object));
6252 if (GPT != PT)
6253 move_gap_both (PT, PT_BYTE);
6254 undo_list = current_buffer->undo_list;
6255 current_buffer->undo_list = Qt;
6256 }
6257
6258 coding->consumed = coding->consumed_char = 0;
6259 coding->produced = coding->produced_char = 0;
6260 coding->chars_at_source = 0;
6261 record_conversion_result (coding, CODING_RESULT_SUCCESS);
6262 coding->errors = 0;
6263
6264 ALLOC_CONVERSION_WORK_AREA (coding);
6265
6266 attrs = CODING_ID_ATTRS (coding->id);
6267 translation_table = get_translation_table (attrs, 0, NULL);
6268
6269 carryover = 0;
6270 do
6271 {
6272 EMACS_INT pos = coding->dst_pos + coding->produced_char;
6273
6274 coding_set_source (coding);
6275 coding->annotated = 0;
6276 coding->charbuf_used = carryover;
6277 (*(coding->decoder)) (coding);
6278 coding_set_destination (coding);
6279 carryover = produce_chars (coding, translation_table, 0);
6280 if (coding->annotated)
6281 produce_annotation (coding, pos);
6282 for (i = 0; i < carryover; i++)
6283 coding->charbuf[i]
6284 = coding->charbuf[coding->charbuf_used - carryover + i];
6285 }
6286 while (coding->consumed < coding->src_bytes
6287 && (coding->result == CODING_RESULT_SUCCESS
6288 || coding->result == CODING_RESULT_INVALID_SRC));
6289
6290 if (carryover > 0)
6291 {
6292 coding_set_destination (coding);
6293 coding->charbuf_used = carryover;
6294 produce_chars (coding, translation_table, 1);
6295 }
6296
6297 coding->carryover_bytes = 0;
6298 if (coding->consumed < coding->src_bytes)
6299 {
6300 int nbytes = coding->src_bytes - coding->consumed;
6301 const unsigned char *src;
6302
6303 coding_set_source (coding);
6304 coding_set_destination (coding);
6305 src = coding->source + coding->consumed;
6306
6307 if (coding->mode & CODING_MODE_LAST_BLOCK)
6308 {
6309 /* Flush out unprocessed data as binary chars. We are sure
6310 that the number of data is less than the size of
6311 coding->charbuf. */
6312 coding->charbuf_used = 0;
6313 while (nbytes-- > 0)
6314 {
6315 int c = *src++;
6316
6317 if (c & 0x80)
6318 c = BYTE8_TO_CHAR (c);
6319 coding->charbuf[coding->charbuf_used++] = c;
6320 }
6321 produce_chars (coding, Qnil, 1);
6322 }
6323 else
6324 {
6325 /* Record unprocessed bytes in coding->carryover. We are
6326 sure that the number of data is less than the size of
6327 coding->carryover. */
6328 unsigned char *p = coding->carryover;
6329
6330 coding->carryover_bytes = nbytes;
6331 while (nbytes-- > 0)
6332 *p++ = *src++;
6333 }
6334 coding->consumed = coding->src_bytes;
6335 }
6336
6337 if (! EQ (CODING_ID_EOL_TYPE (coding->id), Qunix))
6338 decode_eol (coding);
6339 if (BUFFERP (coding->dst_object))
6340 {
6341 current_buffer->undo_list = undo_list;
6342 record_insert (coding->dst_pos, coding->produced_char);
6343 }
6344 return coding->result;
6345 }
6346
6347
6348 /* Extract an annotation datum from a composition starting at POS and
6349 ending before LIMIT of CODING->src_object (buffer or string), store
6350 the data in BUF, set *STOP to a starting position of the next
6351 composition (if any) or to LIMIT, and return the address of the
6352 next element of BUF.
6353
6354 If such an annotation is not found, set *STOP to a starting
6355 position of a composition after POS (if any) or to LIMIT, and
6356 return BUF. */
6357
6358 static INLINE int *
6359 handle_composition_annotation (pos, limit, coding, buf, stop)
6360 EMACS_INT pos, limit;
6361 struct coding_system *coding;
6362 int *buf;
6363 EMACS_INT *stop;
6364 {
6365 EMACS_INT start, end;
6366 Lisp_Object prop;
6367
6368 if (! find_composition (pos, limit, &start, &end, &prop, coding->src_object)
6369 || end > limit)
6370 *stop = limit;
6371 else if (start > pos)
6372 *stop = start;
6373 else
6374 {
6375 if (start == pos)
6376 {
6377 /* We found a composition. Store the corresponding
6378 annotation data in BUF. */
6379 int *head = buf;
6380 enum composition_method method = COMPOSITION_METHOD (prop);
6381 int nchars = COMPOSITION_LENGTH (prop);
6382
6383 ADD_COMPOSITION_DATA (buf, nchars, method);
6384 if (method != COMPOSITION_RELATIVE)
6385 {
6386 Lisp_Object components;
6387 int len, i, i_byte;
6388
6389 components = COMPOSITION_COMPONENTS (prop);
6390 if (VECTORP (components))
6391 {
6392 len = XVECTOR (components)->size;
6393 for (i = 0; i < len; i++)
6394 *buf++ = XINT (AREF (components, i));
6395 }
6396 else if (STRINGP (components))
6397 {
6398 len = SCHARS (components);
6399 i = i_byte = 0;
6400 while (i < len)
6401 {
6402 FETCH_STRING_CHAR_ADVANCE (*buf, components, i, i_byte);
6403 buf++;
6404 }
6405 }
6406 else if (INTEGERP (components))
6407 {
6408 len = 1;
6409 *buf++ = XINT (components);
6410 }
6411 else if (CONSP (components))
6412 {
6413 for (len = 0; CONSP (components);
6414 len++, components = XCDR (components))
6415 *buf++ = XINT (XCAR (components));
6416 }
6417 else
6418 abort ();
6419 *head -= len;
6420 }
6421 }
6422
6423 if (find_composition (end, limit, &start, &end, &prop,
6424 coding->src_object)
6425 && end <= limit)
6426 *stop = start;
6427 else
6428 *stop = limit;
6429 }
6430 return buf;
6431 }
6432
6433
6434 /* Extract an annotation datum from a text property `charset' at POS of
6435 CODING->src_object (buffer of string), store the data in BUF, set
6436 *STOP to the position where the value of `charset' property changes
6437 (limiting by LIMIT), and return the address of the next element of
6438 BUF.
6439
6440 If the property value is nil, set *STOP to the position where the
6441 property value is non-nil (limiting by LIMIT), and return BUF. */
6442
6443 static INLINE int *
6444 handle_charset_annotation (pos, limit, coding, buf, stop)
6445 EMACS_INT pos, limit;
6446 struct coding_system *coding;
6447 int *buf;
6448 EMACS_INT *stop;
6449 {
6450 Lisp_Object val, next;
6451 int id;
6452
6453 val = Fget_text_property (make_number (pos), Qcharset, coding->src_object);
6454 if (! NILP (val) && CHARSETP (val))
6455 id = XINT (CHARSET_SYMBOL_ID (val));
6456 else
6457 id = -1;
6458 ADD_CHARSET_DATA (buf, 0, id);
6459 next = Fnext_single_property_change (make_number (pos), Qcharset,
6460 coding->src_object,
6461 make_number (limit));
6462 *stop = XINT (next);
6463 return buf;
6464 }
6465
6466
6467 static void
6468 consume_chars (coding, translation_table, max_lookup)
6469 struct coding_system *coding;
6470 Lisp_Object translation_table;
6471 int max_lookup;
6472 {
6473 int *buf = coding->charbuf;
6474 int *buf_end = coding->charbuf + coding->charbuf_size;
6475 const unsigned char *src = coding->source + coding->consumed;
6476 const unsigned char *src_end = coding->source + coding->src_bytes;
6477 EMACS_INT pos = coding->src_pos + coding->consumed_char;
6478 EMACS_INT end_pos = coding->src_pos + coding->src_chars;
6479 int multibytep = coding->src_multibyte;
6480 Lisp_Object eol_type;
6481 int c;
6482 EMACS_INT stop, stop_composition, stop_charset;
6483 int *lookup_buf = NULL;
6484
6485 if (! NILP (translation_table))
6486 lookup_buf = alloca (sizeof (int) * max_lookup);
6487
6488 eol_type = CODING_ID_EOL_TYPE (coding->id);
6489 if (VECTORP (eol_type))
6490 eol_type = Qunix;
6491
6492 /* Note: composition handling is not yet implemented. */
6493 coding->common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
6494
6495 if (NILP (coding->src_object))
6496 stop = stop_composition = stop_charset = end_pos;
6497 else
6498 {
6499 if (coding->common_flags & CODING_ANNOTATE_COMPOSITION_MASK)
6500 stop = stop_composition = pos;
6501 else
6502 stop = stop_composition = end_pos;
6503 if (coding->common_flags & CODING_ANNOTATE_CHARSET_MASK)
6504 stop = stop_charset = pos;
6505 else
6506 stop_charset = end_pos;
6507 }
6508
6509 /* Compensate for CRLF and conversion. */
6510 buf_end -= 1 + MAX_ANNOTATION_LENGTH;
6511 while (buf < buf_end)
6512 {
6513 Lisp_Object trans;
6514
6515 if (pos == stop)
6516 {
6517 if (pos == end_pos)
6518 break;
6519 if (pos == stop_composition)
6520 buf = handle_composition_annotation (pos, end_pos, coding,
6521 buf, &stop_composition);
6522 if (pos == stop_charset)
6523 buf = handle_charset_annotation (pos, end_pos, coding,
6524 buf, &stop_charset);
6525 stop = (stop_composition < stop_charset
6526 ? stop_composition : stop_charset);
6527 }
6528
6529 if (! multibytep)
6530 {
6531 EMACS_INT bytes;
6532
6533 if (coding->encoder == encode_coding_raw_text)
6534 c = *src++, pos++;
6535 else if ((bytes = MULTIBYTE_LENGTH (src, src_end)) > 0)
6536 c = STRING_CHAR_ADVANCE (src), pos += bytes;
6537 else
6538 c = BYTE8_TO_CHAR (*src), src++, pos++;
6539 }
6540 else
6541 c = STRING_CHAR_ADVANCE (src), pos++;
6542 if ((c == '\r') && (coding->mode & CODING_MODE_SELECTIVE_DISPLAY))
6543 c = '\n';
6544 if (! EQ (eol_type, Qunix))
6545 {
6546 if (c == '\n')
6547 {
6548 if (EQ (eol_type, Qdos))
6549 *buf++ = '\r';
6550 else
6551 c = '\r';
6552 }
6553 }
6554
6555 trans = Qnil;
6556 LOOKUP_TRANSLATION_TABLE (translation_table, c, trans);
6557 if (NILP (trans))
6558 *buf++ = c;
6559 else
6560 {
6561 int from_nchars = 1, to_nchars = 1;
6562 int *lookup_buf_end;
6563 const unsigned char *p = src;
6564 int i;
6565
6566 lookup_buf[0] = c;
6567 for (i = 1; i < max_lookup && p < src_end; i++)
6568 lookup_buf[i] = STRING_CHAR_ADVANCE (p);
6569 lookup_buf_end = lookup_buf + i;
6570 trans = get_translation (trans, lookup_buf, lookup_buf_end, 1,
6571 &from_nchars, &to_nchars);
6572 if (EQ (trans, Qt)
6573 || buf + to_nchars > buf_end)
6574 break;
6575 *buf++ = *lookup_buf;
6576 for (i = 1; i < to_nchars; i++)
6577 *buf++ = XINT (AREF (trans, i));
6578 for (i = 1; i < from_nchars; i++, pos++)
6579 src += MULTIBYTE_LENGTH_NO_CHECK (src);
6580 }
6581 }
6582
6583 coding->consumed = src - coding->source;
6584 coding->consumed_char = pos - coding->src_pos;
6585 coding->charbuf_used = buf - coding->charbuf;
6586 coding->chars_at_source = 0;
6587 }
6588
6589
6590 /* Encode the text at CODING->src_object into CODING->dst_object.
6591 CODING->src_object is a buffer or a string.
6592 CODING->dst_object is a buffer or nil.
6593
6594 If CODING->src_object is a buffer, it must be the current buffer.
6595 In this case, if CODING->src_pos is positive, it is a position of
6596 the source text in the buffer, otherwise. the source text is in the
6597 gap area of the buffer, and coding->src_pos specifies the offset of
6598 the text from GPT (which must be the same as PT). If this is the
6599 same buffer as CODING->dst_object, CODING->src_pos must be
6600 negative and CODING should not have `pre-write-conversion'.
6601
6602 If CODING->src_object is a string, CODING should not have
6603 `pre-write-conversion'.
6604
6605 If CODING->dst_object is a buffer, the encoded data is inserted at
6606 the current point of that buffer.
6607
6608 If CODING->dst_object is nil, the encoded data is placed at the
6609 memory area specified by CODING->destination. */
6610
6611 static int
6612 encode_coding (coding)
6613 struct coding_system *coding;
6614 {
6615 Lisp_Object attrs;
6616 Lisp_Object translation_table;
6617 int max_lookup;
6618
6619 attrs = CODING_ID_ATTRS (coding->id);
6620 if (coding->encoder == encode_coding_raw_text)
6621 translation_table = Qnil, max_lookup = 0;
6622 else
6623 translation_table = get_translation_table (attrs, 1, &max_lookup);
6624
6625 if (BUFFERP (coding->dst_object))
6626 {
6627 set_buffer_internal (XBUFFER (coding->dst_object));
6628 coding->dst_multibyte
6629 = ! NILP (current_buffer->enable_multibyte_characters);
6630 }
6631
6632 coding->consumed = coding->consumed_char = 0;
6633 coding->produced = coding->produced_char = 0;
6634 record_conversion_result (coding, CODING_RESULT_SUCCESS);
6635 coding->errors = 0;
6636
6637 ALLOC_CONVERSION_WORK_AREA (coding);
6638
6639 do {
6640 coding_set_source (coding);
6641 consume_chars (coding, translation_table, max_lookup);
6642 coding_set_destination (coding);
6643 (*(coding->encoder)) (coding);
6644 } while (coding->consumed_char < coding->src_chars);
6645
6646 if (BUFFERP (coding->dst_object))
6647 insert_from_gap (coding->produced_char, coding->produced);
6648
6649 return (coding->result);
6650 }
6651
6652
6653 /* Name (or base name) of work buffer for code conversion. */
6654 static Lisp_Object Vcode_conversion_workbuf_name;
6655
6656 /* A working buffer used by the top level conversion. Once it is
6657 created, it is never destroyed. It has the name
6658 Vcode_conversion_workbuf_name. The other working buffers are
6659 destroyed after the use is finished, and their names are modified
6660 versions of Vcode_conversion_workbuf_name. */
6661 static Lisp_Object Vcode_conversion_reused_workbuf;
6662
6663 /* 1 iff Vcode_conversion_reused_workbuf is already in use. */
6664 static int reused_workbuf_in_use;
6665
6666
6667 /* Return a working buffer of code convesion. MULTIBYTE specifies the
6668 multibyteness of returning buffer. */
6669
6670 static Lisp_Object
6671 make_conversion_work_buffer (multibyte)
6672 int multibyte;
6673 {
6674 Lisp_Object name, workbuf;
6675 struct buffer *current;
6676
6677 if (reused_workbuf_in_use++)
6678 {
6679 name = Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name, Qnil);
6680 workbuf = Fget_buffer_create (name);
6681 }
6682 else
6683 {
6684 name = Vcode_conversion_workbuf_name;
6685 workbuf = Fget_buffer_create (name);
6686 if (NILP (Vcode_conversion_reused_workbuf))
6687 Vcode_conversion_reused_workbuf = workbuf;
6688 }
6689 current = current_buffer;
6690 set_buffer_internal (XBUFFER (workbuf));
6691 Ferase_buffer ();
6692 current_buffer->undo_list = Qt;
6693 current_buffer->enable_multibyte_characters = multibyte ? Qt : Qnil;
6694 set_buffer_internal (current);
6695 return workbuf;
6696 }
6697
6698
6699 static Lisp_Object
6700 code_conversion_restore (arg)
6701 Lisp_Object arg;
6702 {
6703 Lisp_Object current, workbuf;
6704 struct gcpro gcpro1;
6705
6706 GCPRO1 (arg);
6707 current = XCAR (arg);
6708 workbuf = XCDR (arg);
6709 if (! NILP (workbuf))
6710 {
6711 if (EQ (workbuf, Vcode_conversion_reused_workbuf))
6712 reused_workbuf_in_use = 0;
6713 else if (! NILP (Fbuffer_live_p (workbuf)))
6714 Fkill_buffer (workbuf);
6715 }
6716 set_buffer_internal (XBUFFER (current));
6717 UNGCPRO;
6718 return Qnil;
6719 }
6720
6721 Lisp_Object
6722 code_conversion_save (with_work_buf, multibyte)
6723 int with_work_buf, multibyte;
6724 {
6725 Lisp_Object workbuf = Qnil;
6726
6727 if (with_work_buf)
6728 workbuf = make_conversion_work_buffer (multibyte);
6729 record_unwind_protect (code_conversion_restore,
6730 Fcons (Fcurrent_buffer (), workbuf));
6731 return workbuf;
6732 }
6733
6734 int
6735 decode_coding_gap (coding, chars, bytes)
6736 struct coding_system *coding;
6737 EMACS_INT chars, bytes;
6738 {
6739 int count = specpdl_ptr - specpdl;
6740 Lisp_Object attrs;
6741
6742 code_conversion_save (0, 0);
6743
6744 coding->src_object = Fcurrent_buffer ();
6745 coding->src_chars = chars;
6746 coding->src_bytes = bytes;
6747 coding->src_pos = -chars;
6748 coding->src_pos_byte = -bytes;
6749 coding->src_multibyte = chars < bytes;
6750 coding->dst_object = coding->src_object;
6751 coding->dst_pos = PT;
6752 coding->dst_pos_byte = PT_BYTE;
6753 coding->dst_multibyte = ! NILP (current_buffer->enable_multibyte_characters);
6754
6755 if (CODING_REQUIRE_DETECTION (coding))
6756 detect_coding (coding);
6757
6758 coding->mode |= CODING_MODE_LAST_BLOCK;
6759 decode_coding (coding);
6760
6761 attrs = CODING_ID_ATTRS (coding->id);
6762 if (! NILP (CODING_ATTR_POST_READ (attrs)))
6763 {
6764 EMACS_INT prev_Z = Z, prev_Z_BYTE = Z_BYTE;
6765 Lisp_Object val;
6766
6767 TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
6768 val = call1 (CODING_ATTR_POST_READ (attrs),
6769 make_number (coding->produced_char));
6770 CHECK_NATNUM (val);
6771 coding->produced_char += Z - prev_Z;
6772 coding->produced += Z_BYTE - prev_Z_BYTE;
6773 }
6774
6775 unbind_to (count, Qnil);
6776 return coding->result;
6777 }
6778
6779 int
6780 encode_coding_gap (coding, chars, bytes)
6781 struct coding_system *coding;
6782 EMACS_INT chars, bytes;
6783 {
6784 int count = specpdl_ptr - specpdl;
6785
6786 code_conversion_save (0, 0);
6787
6788 coding->src_object = Fcurrent_buffer ();
6789 coding->src_chars = chars;
6790 coding->src_bytes = bytes;
6791 coding->src_pos = -chars;
6792 coding->src_pos_byte = -bytes;
6793 coding->src_multibyte = chars < bytes;
6794 coding->dst_object = coding->src_object;
6795 coding->dst_pos = PT;
6796 coding->dst_pos_byte = PT_BYTE;
6797
6798 encode_coding (coding);
6799
6800 unbind_to (count, Qnil);
6801 return coding->result;
6802 }
6803
6804
6805 /* Decode the text in the range FROM/FROM_BYTE and TO/TO_BYTE in
6806 SRC_OBJECT into DST_OBJECT by coding context CODING.
6807
6808 SRC_OBJECT is a buffer, a string, or Qnil.
6809
6810 If it is a buffer, the text is at point of the buffer. FROM and TO
6811 are positions in the buffer.
6812
6813 If it is a string, the text is at the beginning of the string.
6814 FROM and TO are indices to the string.
6815
6816 If it is nil, the text is at coding->source. FROM and TO are
6817 indices to coding->source.
6818
6819 DST_OBJECT is a buffer, Qt, or Qnil.
6820
6821 If it is a buffer, the decoded text is inserted at point of the
6822 buffer. If the buffer is the same as SRC_OBJECT, the source text
6823 is deleted.
6824
6825 If it is Qt, a string is made from the decoded text, and
6826 set in CODING->dst_object.
6827
6828 If it is Qnil, the decoded text is stored at CODING->destination.
6829 The caller must allocate CODING->dst_bytes bytes at
6830 CODING->destination by xmalloc. If the decoded text is longer than
6831 CODING->dst_bytes, CODING->destination is relocated by xrealloc.
6832 */
6833
6834 void
6835 decode_coding_object (coding, src_object, from, from_byte, to, to_byte,
6836 dst_object)
6837 struct coding_system *coding;
6838 Lisp_Object src_object;
6839 EMACS_INT from, from_byte, to, to_byte;
6840 Lisp_Object dst_object;
6841 {
6842 int count = specpdl_ptr - specpdl;
6843 unsigned char *destination;
6844 EMACS_INT dst_bytes;
6845 EMACS_INT chars = to - from;
6846 EMACS_INT bytes = to_byte - from_byte;
6847 Lisp_Object attrs;
6848 Lisp_Object buffer;
6849 int saved_pt = -1, saved_pt_byte;
6850
6851 buffer = Fcurrent_buffer ();
6852
6853 if (NILP (dst_object))
6854 {
6855 destination = coding->destination;
6856 dst_bytes = coding->dst_bytes;
6857 }
6858
6859 coding->src_object = src_object;
6860 coding->src_chars = chars;
6861 coding->src_bytes = bytes;
6862 coding->src_multibyte = chars < bytes;
6863
6864 if (STRINGP (src_object))
6865 {
6866 coding->src_pos = from;
6867 coding->src_pos_byte = from_byte;
6868 }
6869 else if (BUFFERP (src_object))
6870 {
6871 set_buffer_internal (XBUFFER (src_object));
6872 if (from != GPT)
6873 move_gap_both (from, from_byte);
6874 if (EQ (src_object, dst_object))
6875 {
6876 saved_pt = PT, saved_pt_byte = PT_BYTE;
6877 TEMP_SET_PT_BOTH (from, from_byte);
6878 del_range_both (from, from_byte, to, to_byte, 1);
6879 coding->src_pos = -chars;
6880 coding->src_pos_byte = -bytes;
6881 }
6882 else
6883 {
6884 coding->src_pos = from;
6885 coding->src_pos_byte = from_byte;
6886 }
6887 }
6888
6889 if (CODING_REQUIRE_DETECTION (coding))
6890 detect_coding (coding);
6891 attrs = CODING_ID_ATTRS (coding->id);
6892
6893 if (EQ (dst_object, Qt)
6894 || (! NILP (CODING_ATTR_POST_READ (attrs))
6895 && NILP (dst_object)))
6896 {
6897 coding->dst_object = code_conversion_save (1, 1);
6898 coding->dst_pos = BEG;
6899 coding->dst_pos_byte = BEG_BYTE;
6900 coding->dst_multibyte = 1;
6901 }
6902 else if (BUFFERP (dst_object))
6903 {
6904 code_conversion_save (0, 0);
6905 coding->dst_object = dst_object;
6906 coding->dst_pos = BUF_PT (XBUFFER (dst_object));
6907 coding->dst_pos_byte = BUF_PT_BYTE (XBUFFER (dst_object));
6908 coding->dst_multibyte
6909 = ! NILP (XBUFFER (dst_object)->enable_multibyte_characters);
6910 }
6911 else
6912 {
6913 code_conversion_save (0, 0);
6914 coding->dst_object = Qnil;
6915 coding->dst_multibyte = 1;
6916 }
6917
6918 decode_coding (coding);
6919
6920 if (BUFFERP (coding->dst_object))
6921 set_buffer_internal (XBUFFER (coding->dst_object));
6922
6923 if (! NILP (CODING_ATTR_POST_READ (attrs)))
6924 {
6925 struct gcpro gcpro1, gcpro2;
6926 EMACS_INT prev_Z = Z, prev_Z_BYTE = Z_BYTE;
6927 Lisp_Object val;
6928
6929 TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
6930 GCPRO2 (coding->src_object, coding->dst_object);
6931 val = safe_call1 (CODING_ATTR_POST_READ (attrs),
6932 make_number (coding->produced_char));
6933 UNGCPRO;
6934 CHECK_NATNUM (val);
6935 coding->produced_char += Z - prev_Z;
6936 coding->produced += Z_BYTE - prev_Z_BYTE;
6937 }
6938
6939 if (EQ (dst_object, Qt))
6940 {
6941 coding->dst_object = Fbuffer_string ();
6942 }
6943 else if (NILP (dst_object) && BUFFERP (coding->dst_object))
6944 {
6945 set_buffer_internal (XBUFFER (coding->dst_object));
6946 if (dst_bytes < coding->produced)
6947 {
6948 destination
6949 = (unsigned char *) xrealloc (destination, coding->produced);
6950 if (! destination)
6951 {
6952 record_conversion_result (coding,
6953 CODING_RESULT_INSUFFICIENT_DST);
6954 unbind_to (count, Qnil);
6955 return;
6956 }
6957 if (BEGV < GPT && GPT < BEGV + coding->produced_char)
6958 move_gap_both (BEGV, BEGV_BYTE);
6959 bcopy (BEGV_ADDR, destination, coding->produced);
6960 coding->destination = destination;
6961 }
6962 }
6963
6964 if (saved_pt >= 0)
6965 {
6966 /* This is the case of:
6967 (BUFFERP (src_object) && EQ (src_object, dst_object))
6968 As we have moved PT while replacing the original buffer
6969 contents, we must recover it now. */
6970 set_buffer_internal (XBUFFER (src_object));
6971 if (saved_pt < from)
6972 TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte);
6973 else if (saved_pt < from + chars)
6974 TEMP_SET_PT_BOTH (from, from_byte);
6975 else if (! NILP (current_buffer->enable_multibyte_characters))
6976 TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars),
6977 saved_pt_byte + (coding->produced - bytes));
6978 else
6979 TEMP_SET_PT_BOTH (saved_pt + (coding->produced - bytes),
6980 saved_pt_byte + (coding->produced - bytes));
6981 }
6982
6983 unbind_to (count, coding->dst_object);
6984 }
6985
6986
6987 void
6988 encode_coding_object (coding, src_object, from, from_byte, to, to_byte,
6989 dst_object)
6990 struct coding_system *coding;
6991 Lisp_Object src_object;
6992 EMACS_INT from, from_byte, to, to_byte;
6993 Lisp_Object dst_object;
6994 {
6995 int count = specpdl_ptr - specpdl;
6996 EMACS_INT chars = to - from;
6997 EMACS_INT bytes = to_byte - from_byte;
6998 Lisp_Object attrs;
6999 Lisp_Object buffer;
7000 int saved_pt = -1, saved_pt_byte;
7001 int kill_src_buffer = 0;
7002
7003 buffer = Fcurrent_buffer ();
7004
7005 coding->src_object = src_object;
7006 coding->src_chars = chars;
7007 coding->src_bytes = bytes;
7008 coding->src_multibyte = chars < bytes;
7009
7010 attrs = CODING_ID_ATTRS (coding->id);
7011
7012 if (! NILP (CODING_ATTR_PRE_WRITE (attrs)))
7013 {
7014 coding->src_object = code_conversion_save (1, coding->src_multibyte);
7015 set_buffer_internal (XBUFFER (coding->src_object));
7016 if (STRINGP (src_object))
7017 insert_from_string (src_object, from, from_byte, chars, bytes, 0);
7018 else if (BUFFERP (src_object))
7019 insert_from_buffer (XBUFFER (src_object), from, chars, 0);
7020 else
7021 insert_1_both (coding->source + from, chars, bytes, 0, 0, 0);
7022
7023 if (EQ (src_object, dst_object))
7024 {
7025 set_buffer_internal (XBUFFER (src_object));
7026 saved_pt = PT, saved_pt_byte = PT_BYTE;
7027 del_range_both (from, from_byte, to, to_byte, 1);
7028 set_buffer_internal (XBUFFER (coding->src_object));
7029 }
7030
7031 {
7032 Lisp_Object args[3];
7033
7034 args[0] = CODING_ATTR_PRE_WRITE (attrs);
7035 args[1] = make_number (BEG);
7036 args[2] = make_number (Z);
7037 safe_call (3, args);
7038 }
7039 if (XBUFFER (coding->src_object) != current_buffer)
7040 kill_src_buffer = 1;
7041 coding->src_object = Fcurrent_buffer ();
7042 if (BEG != GPT)
7043 move_gap_both (BEG, BEG_BYTE);
7044 coding->src_chars = Z - BEG;
7045 coding->src_bytes = Z_BYTE - BEG_BYTE;
7046 coding->src_pos = BEG;
7047 coding->src_pos_byte = BEG_BYTE;
7048 coding->src_multibyte = Z < Z_BYTE;
7049 }
7050 else if (STRINGP (src_object))
7051 {
7052 code_conversion_save (0, 0);
7053 coding->src_pos = from;
7054 coding->src_pos_byte = from_byte;
7055 }
7056 else if (BUFFERP (src_object))
7057 {
7058 code_conversion_save (0, 0);
7059 set_buffer_internal (XBUFFER (src_object));
7060 if (EQ (src_object, dst_object))
7061 {
7062 saved_pt = PT, saved_pt_byte = PT_BYTE;
7063 coding->src_object = del_range_1 (from, to, 1, 1);
7064 coding->src_pos = 0;
7065 coding->src_pos_byte = 0;
7066 }
7067 else
7068 {
7069 if (from < GPT && to >= GPT)
7070 move_gap_both (from, from_byte);
7071 coding->src_pos = from;
7072 coding->src_pos_byte = from_byte;
7073 }
7074 }
7075 else
7076 code_conversion_save (0, 0);
7077
7078 if (BUFFERP (dst_object))
7079 {
7080 coding->dst_object = dst_object;
7081 if (EQ (src_object, dst_object))
7082 {
7083 coding->dst_pos = from;
7084 coding->dst_pos_byte = from_byte;
7085 }
7086 else
7087 {
7088 coding->dst_pos = BUF_PT (XBUFFER (dst_object));
7089 coding->dst_pos_byte = BUF_PT_BYTE (XBUFFER (dst_object));
7090 }
7091 coding->dst_multibyte
7092 = ! NILP (XBUFFER (dst_object)->enable_multibyte_characters);
7093 }
7094 else if (EQ (dst_object, Qt))
7095 {
7096 coding->dst_object = Qnil;
7097 coding->dst_bytes = coding->src_chars;
7098 if (coding->dst_bytes == 0)
7099 coding->dst_bytes = 1;
7100 coding->destination = (unsigned char *) xmalloc (coding->dst_bytes);
7101 coding->dst_multibyte = 0;
7102 }
7103 else
7104 {
7105 coding->dst_object = Qnil;
7106 coding->dst_multibyte = 0;
7107 }
7108
7109 encode_coding (coding);
7110
7111 if (EQ (dst_object, Qt))
7112 {
7113 if (BUFFERP (coding->dst_object))
7114 coding->dst_object = Fbuffer_string ();
7115 else
7116 {
7117 coding->dst_object
7118 = make_unibyte_string ((char *) coding->destination,
7119 coding->produced);
7120 xfree (coding->destination);
7121 }
7122 }
7123
7124 if (saved_pt >= 0)
7125 {
7126 /* This is the case of:
7127 (BUFFERP (src_object) && EQ (src_object, dst_object))
7128 As we have moved PT while replacing the original buffer
7129 contents, we must recover it now. */
7130 set_buffer_internal (XBUFFER (src_object));
7131 if (saved_pt < from)
7132 TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte);
7133 else if (saved_pt < from + chars)
7134 TEMP_SET_PT_BOTH (from, from_byte);
7135 else if (! NILP (current_buffer->enable_multibyte_characters))
7136 TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars),
7137 saved_pt_byte + (coding->produced - bytes));
7138 else
7139 TEMP_SET_PT_BOTH (saved_pt + (coding->produced - bytes),
7140 saved_pt_byte + (coding->produced - bytes));
7141 }
7142
7143 if (kill_src_buffer)
7144 Fkill_buffer (coding->src_object);
7145 unbind_to (count, Qnil);
7146 }
7147
7148
7149 Lisp_Object
7150 preferred_coding_system ()
7151 {
7152 int id = coding_categories[coding_priorities[0]].id;
7153
7154 return CODING_ID_NAME (id);
7155 }
7156
7157 \f
7158 #ifdef emacs
7159 /*** 8. Emacs Lisp library functions ***/
7160
7161 DEFUN ("coding-system-p", Fcoding_system_p, Scoding_system_p, 1, 1, 0,
7162 doc: /* Return t if OBJECT is nil or a coding-system.
7163 See the documentation of `define-coding-system' for information
7164 about coding-system objects. */)
7165 (obj)
7166 Lisp_Object obj;
7167 {
7168 if (NILP (obj)
7169 || CODING_SYSTEM_ID (obj) >= 0)
7170 return Qt;
7171 if (! SYMBOLP (obj)
7172 || NILP (Fget (obj, Qcoding_system_define_form)))
7173 return Qnil;
7174 return Qt;
7175 }
7176
7177 DEFUN ("read-non-nil-coding-system", Fread_non_nil_coding_system,
7178 Sread_non_nil_coding_system, 1, 1, 0,
7179 doc: /* Read a coding system from the minibuffer, prompting with string PROMPT. */)
7180 (prompt)
7181 Lisp_Object prompt;
7182 {
7183 Lisp_Object val;
7184 do
7185 {
7186 val = Fcompleting_read (prompt, Vcoding_system_alist, Qnil,
7187 Qt, Qnil, Qcoding_system_history, Qnil, Qnil);
7188 }
7189 while (SCHARS (val) == 0);
7190 return (Fintern (val, Qnil));
7191 }
7192
7193 DEFUN ("read-coding-system", Fread_coding_system, Sread_coding_system, 1, 2, 0,
7194 doc: /* Read a coding system from the minibuffer, prompting with string PROMPT.
7195 If the user enters null input, return second argument DEFAULT-CODING-SYSTEM. */)
7196 (prompt, default_coding_system)
7197 Lisp_Object prompt, default_coding_system;
7198 {
7199 Lisp_Object val;
7200 if (SYMBOLP (default_coding_system))
7201 XSETSTRING (default_coding_system, XPNTR (SYMBOL_NAME (default_coding_system)));
7202 val = Fcompleting_read (prompt, Vcoding_system_alist, Qnil,
7203 Qt, Qnil, Qcoding_system_history,
7204 default_coding_system, Qnil);
7205 return (SCHARS (val) == 0 ? Qnil : Fintern (val, Qnil));
7206 }
7207
7208 DEFUN ("check-coding-system", Fcheck_coding_system, Scheck_coding_system,
7209 1, 1, 0,
7210 doc: /* Check validity of CODING-SYSTEM.
7211 If valid, return CODING-SYSTEM, else signal a `coding-system-error' error.
7212 It is valid if it is nil or a symbol defined as a coding system by the
7213 function `define-coding-system'. */)
7214 (coding_system)
7215 Lisp_Object coding_system;
7216 {
7217 Lisp_Object define_form;
7218
7219 define_form = Fget (coding_system, Qcoding_system_define_form);
7220 if (! NILP (define_form))
7221 {
7222 Fput (coding_system, Qcoding_system_define_form, Qnil);
7223 safe_eval (define_form);
7224 }
7225 if (!NILP (Fcoding_system_p (coding_system)))
7226 return coding_system;
7227 xsignal1 (Qcoding_system_error, coding_system);
7228 }
7229
7230 \f
7231 /* Detect how the bytes at SRC of length SRC_BYTES are encoded. If
7232 HIGHEST is nonzero, return the coding system of the highest
7233 priority among the detected coding systems. Otherwize return a
7234 list of detected coding systems sorted by their priorities. If
7235 MULTIBYTEP is nonzero, it is assumed that the bytes are in correct
7236 multibyte form but contains only ASCII and eight-bit chars.
7237 Otherwise, the bytes are raw bytes.
7238
7239 CODING-SYSTEM controls the detection as below:
7240
7241 If it is nil, detect both text-format and eol-format. If the
7242 text-format part of CODING-SYSTEM is already specified
7243 (e.g. `iso-latin-1'), detect only eol-format. If the eol-format
7244 part of CODING-SYSTEM is already specified (e.g. `undecided-unix'),
7245 detect only text-format. */
7246
7247 Lisp_Object
7248 detect_coding_system (src, src_chars, src_bytes, highest, multibytep,
7249 coding_system)
7250 const unsigned char *src;
7251 int src_chars, src_bytes, highest;
7252 int multibytep;
7253 Lisp_Object coding_system;
7254 {
7255 const unsigned char *src_end = src + src_bytes;
7256 Lisp_Object attrs, eol_type;
7257 Lisp_Object val;
7258 struct coding_system coding;
7259 int id;
7260 struct coding_detection_info detect_info;
7261 enum coding_category base_category;
7262
7263 if (NILP (coding_system))
7264 coding_system = Qundecided;
7265 setup_coding_system (coding_system, &coding);
7266 attrs = CODING_ID_ATTRS (coding.id);
7267 eol_type = CODING_ID_EOL_TYPE (coding.id);
7268 coding_system = CODING_ATTR_BASE_NAME (attrs);
7269
7270 coding.source = src;
7271 coding.src_chars = src_chars;
7272 coding.src_bytes = src_bytes;
7273 coding.src_multibyte = multibytep;
7274 coding.consumed = 0;
7275 coding.mode |= CODING_MODE_LAST_BLOCK;
7276
7277 detect_info.checked = detect_info.found = detect_info.rejected = 0;
7278
7279 /* At first, detect text-format if necessary. */
7280 base_category = XINT (CODING_ATTR_CATEGORY (attrs));
7281 if (base_category == coding_category_undecided)
7282 {
7283 enum coding_category category;
7284 struct coding_system *this;
7285 int c, i;
7286
7287 /* Skip all ASCII bytes except for a few ISO2022 controls. */
7288 for (i = 0; src < src_end; i++, src++)
7289 {
7290 c = *src;
7291 if (c & 0x80)
7292 break;
7293 if (c < 0x20
7294 && (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
7295 && ! inhibit_iso_escape_detection)
7296 {
7297 coding.head_ascii = src - coding.source;
7298 if (detect_coding_iso_2022 (&coding, &detect_info))
7299 {
7300 /* We have scanned the whole data. */
7301 if (! (detect_info.rejected & CATEGORY_MASK_ISO_7_ELSE))
7302 /* We didn't find an 8-bit code. */
7303 src = src_end;
7304 break;
7305 }
7306 }
7307 }
7308 coding.head_ascii = src - coding.source;
7309
7310 if (src < src_end
7311 || detect_info.found)
7312 {
7313 if (src == src_end)
7314 /* As all bytes are 7-bit, we can ignore non-ISO-2022 codings. */
7315 for (i = 0; i < coding_category_raw_text; i++)
7316 {
7317 category = coding_priorities[i];
7318 this = coding_categories + category;
7319 if (detect_info.found & (1 << category))
7320 break;
7321 }
7322 else
7323 for (i = 0; i < coding_category_raw_text; i++)
7324 {
7325 category = coding_priorities[i];
7326 this = coding_categories + category;
7327
7328 if (this->id < 0)
7329 {
7330 /* No coding system of this category is defined. */
7331 detect_info.rejected |= (1 << category);
7332 }
7333 else if (category >= coding_category_raw_text)
7334 continue;
7335 else if (detect_info.checked & (1 << category))
7336 {
7337 if (highest
7338 && (detect_info.found & (1 << category)))
7339 break;
7340 }
7341 else
7342 {
7343 if ((*(this->detector)) (&coding, &detect_info)
7344 && highest
7345 && (detect_info.found & (1 << category)))
7346 {
7347 if (category == coding_category_utf_16_auto)
7348 {
7349 if (detect_info.found & CATEGORY_MASK_UTF_16_LE)
7350 category = coding_category_utf_16_le;
7351 else
7352 category = coding_category_utf_16_be;
7353 }
7354 break;
7355 }
7356 }
7357 }
7358 }
7359
7360 if (detect_info.rejected == CATEGORY_MASK_ANY)
7361 {
7362 detect_info.found = CATEGORY_MASK_RAW_TEXT;
7363 id = coding_categories[coding_category_raw_text].id;
7364 val = Fcons (make_number (id), Qnil);
7365 }
7366 else if (! detect_info.rejected && ! detect_info.found)
7367 {
7368 detect_info.found = CATEGORY_MASK_ANY;
7369 id = coding_categories[coding_category_undecided].id;
7370 val = Fcons (make_number (id), Qnil);
7371 }
7372 else if (highest)
7373 {
7374 if (detect_info.found)
7375 {
7376 detect_info.found = 1 << category;
7377 val = Fcons (make_number (this->id), Qnil);
7378 }
7379 else
7380 for (i = 0; i < coding_category_raw_text; i++)
7381 if (! (detect_info.rejected & (1 << coding_priorities[i])))
7382 {
7383 detect_info.found = 1 << coding_priorities[i];
7384 id = coding_categories[coding_priorities[i]].id;
7385 val = Fcons (make_number (id), Qnil);
7386 break;
7387 }
7388 }
7389 else
7390 {
7391 int mask = detect_info.rejected | detect_info.found;
7392 int found = 0;
7393 val = Qnil;
7394
7395 for (i = coding_category_raw_text - 1; i >= 0; i--)
7396 {
7397 category = coding_priorities[i];
7398 if (! (mask & (1 << category)))
7399 {
7400 found |= 1 << category;
7401 id = coding_categories[category].id;
7402 if (id >= 0)
7403 val = Fcons (make_number (id), val);
7404 }
7405 }
7406 for (i = coding_category_raw_text - 1; i >= 0; i--)
7407 {
7408 category = coding_priorities[i];
7409 if (detect_info.found & (1 << category))
7410 {
7411 id = coding_categories[category].id;
7412 val = Fcons (make_number (id), val);
7413 }
7414 }
7415 detect_info.found |= found;
7416 }
7417 }
7418 else if (base_category == coding_category_utf_16_auto)
7419 {
7420 if (detect_coding_utf_16 (&coding, &detect_info))
7421 {
7422 struct coding_system *this;
7423
7424 if (detect_info.found & CATEGORY_MASK_UTF_16_LE)
7425 this = coding_categories + coding_category_utf_16_le;
7426 else if (detect_info.found & CATEGORY_MASK_UTF_16_BE)
7427 this = coding_categories + coding_category_utf_16_be;
7428 else if (detect_info.rejected & CATEGORY_MASK_UTF_16_LE_NOSIG)
7429 this = coding_categories + coding_category_utf_16_be_nosig;
7430 else
7431 this = coding_categories + coding_category_utf_16_le_nosig;
7432 val = Fcons (make_number (this->id), Qnil);
7433 }
7434 }
7435 else
7436 {
7437 detect_info.found = 1 << XINT (CODING_ATTR_CATEGORY (attrs));
7438 val = Fcons (make_number (coding.id), Qnil);
7439 }
7440
7441 /* Then, detect eol-format if necessary. */
7442 {
7443 int normal_eol = -1, utf_16_be_eol = -1, utf_16_le_eol;
7444 Lisp_Object tail;
7445
7446 if (VECTORP (eol_type))
7447 {
7448 if (detect_info.found & ~CATEGORY_MASK_UTF_16)
7449 normal_eol = detect_eol (coding.source, src_bytes,
7450 coding_category_raw_text);
7451 if (detect_info.found & (CATEGORY_MASK_UTF_16_BE
7452 | CATEGORY_MASK_UTF_16_BE_NOSIG))
7453 utf_16_be_eol = detect_eol (coding.source, src_bytes,
7454 coding_category_utf_16_be);
7455 if (detect_info.found & (CATEGORY_MASK_UTF_16_LE
7456 | CATEGORY_MASK_UTF_16_LE_NOSIG))
7457 utf_16_le_eol = detect_eol (coding.source, src_bytes,
7458 coding_category_utf_16_le);
7459 }
7460 else
7461 {
7462 if (EQ (eol_type, Qunix))
7463 normal_eol = utf_16_be_eol = utf_16_le_eol = EOL_SEEN_LF;
7464 else if (EQ (eol_type, Qdos))
7465 normal_eol = utf_16_be_eol = utf_16_le_eol = EOL_SEEN_CRLF;
7466 else
7467 normal_eol = utf_16_be_eol = utf_16_le_eol = EOL_SEEN_CR;
7468 }
7469
7470 for (tail = val; CONSP (tail); tail = XCDR (tail))
7471 {
7472 enum coding_category category;
7473 int this_eol;
7474
7475 id = XINT (XCAR (tail));
7476 attrs = CODING_ID_ATTRS (id);
7477 category = XINT (CODING_ATTR_CATEGORY (attrs));
7478 eol_type = CODING_ID_EOL_TYPE (id);
7479 if (VECTORP (eol_type))
7480 {
7481 if (category == coding_category_utf_16_be
7482 || category == coding_category_utf_16_be_nosig)
7483 this_eol = utf_16_be_eol;
7484 else if (category == coding_category_utf_16_le
7485 || category == coding_category_utf_16_le_nosig)
7486 this_eol = utf_16_le_eol;
7487 else
7488 this_eol = normal_eol;
7489
7490 if (this_eol == EOL_SEEN_LF)
7491 XSETCAR (tail, AREF (eol_type, 0));
7492 else if (this_eol == EOL_SEEN_CRLF)
7493 XSETCAR (tail, AREF (eol_type, 1));
7494 else if (this_eol == EOL_SEEN_CR)
7495 XSETCAR (tail, AREF (eol_type, 2));
7496 else
7497 XSETCAR (tail, CODING_ID_NAME (id));
7498 }
7499 else
7500 XSETCAR (tail, CODING_ID_NAME (id));
7501 }
7502 }
7503
7504 return (highest ? XCAR (val) : val);
7505 }
7506
7507
7508 DEFUN ("detect-coding-region", Fdetect_coding_region, Sdetect_coding_region,
7509 2, 3, 0,
7510 doc: /* Detect coding system of the text in the region between START and END.
7511 Return a list of possible coding systems ordered by priority.
7512
7513 If only ASCII characters are found (except for such ISO-2022 control
7514 characters ISO-2022 as ESC), it returns a list of single element
7515 `undecided' or its subsidiary coding system according to a detected
7516 end-of-line format.
7517
7518 If optional argument HIGHEST is non-nil, return the coding system of
7519 highest priority. */)
7520 (start, end, highest)
7521 Lisp_Object start, end, highest;
7522 {
7523 int from, to;
7524 int from_byte, to_byte;
7525
7526 CHECK_NUMBER_COERCE_MARKER (start);
7527 CHECK_NUMBER_COERCE_MARKER (end);
7528
7529 validate_region (&start, &end);
7530 from = XINT (start), to = XINT (end);
7531 from_byte = CHAR_TO_BYTE (from);
7532 to_byte = CHAR_TO_BYTE (to);
7533
7534 if (from < GPT && to >= GPT)
7535 move_gap_both (to, to_byte);
7536
7537 return detect_coding_system (BYTE_POS_ADDR (from_byte),
7538 to - from, to_byte - from_byte,
7539 !NILP (highest),
7540 !NILP (current_buffer
7541 ->enable_multibyte_characters),
7542 Qnil);
7543 }
7544
7545 DEFUN ("detect-coding-string", Fdetect_coding_string, Sdetect_coding_string,
7546 1, 2, 0,
7547 doc: /* Detect coding system of the text in STRING.
7548 Return a list of possible coding systems ordered by priority.
7549
7550 If only ASCII characters are found (except for such ISO-2022 control
7551 characters ISO-2022 as ESC), it returns a list of single element
7552 `undecided' or its subsidiary coding system according to a detected
7553 end-of-line format.
7554
7555 If optional argument HIGHEST is non-nil, return the coding system of
7556 highest priority. */)
7557 (string, highest)
7558 Lisp_Object string, highest;
7559 {
7560 CHECK_STRING (string);
7561
7562 return detect_coding_system (SDATA (string),
7563 SCHARS (string), SBYTES (string),
7564 !NILP (highest), STRING_MULTIBYTE (string),
7565 Qnil);
7566 }
7567
7568
7569 static INLINE int
7570 char_encodable_p (c, attrs)
7571 int c;
7572 Lisp_Object attrs;
7573 {
7574 Lisp_Object tail;
7575 struct charset *charset;
7576 Lisp_Object translation_table;
7577
7578 translation_table = CODING_ATTR_TRANS_TBL (attrs);
7579 if (! NILP (translation_table))
7580 c = translate_char (translation_table, c);
7581 for (tail = CODING_ATTR_CHARSET_LIST (attrs);
7582 CONSP (tail); tail = XCDR (tail))
7583 {
7584 charset = CHARSET_FROM_ID (XINT (XCAR (tail)));
7585 if (CHAR_CHARSET_P (c, charset))
7586 break;
7587 }
7588 return (! NILP (tail));
7589 }
7590
7591
7592 /* Return a list of coding systems that safely encode the text between
7593 START and END. If EXCLUDE is non-nil, it is a list of coding
7594 systems not to check. The returned list doesn't contain any such
7595 coding systems. In any case, if the text contains only ASCII or is
7596 unibyte, return t. */
7597
7598 DEFUN ("find-coding-systems-region-internal",
7599 Ffind_coding_systems_region_internal,
7600 Sfind_coding_systems_region_internal, 2, 3, 0,
7601 doc: /* Internal use only. */)
7602 (start, end, exclude)
7603 Lisp_Object start, end, exclude;
7604 {
7605 Lisp_Object coding_attrs_list, safe_codings;
7606 EMACS_INT start_byte, end_byte;
7607 const unsigned char *p, *pbeg, *pend;
7608 int c;
7609 Lisp_Object tail, elt;
7610
7611 if (STRINGP (start))
7612 {
7613 if (!STRING_MULTIBYTE (start)
7614 || SCHARS (start) == SBYTES (start))
7615 return Qt;
7616 start_byte = 0;
7617 end_byte = SBYTES (start);
7618 }
7619 else
7620 {
7621 CHECK_NUMBER_COERCE_MARKER (start);
7622 CHECK_NUMBER_COERCE_MARKER (end);
7623 if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end))
7624 args_out_of_range (start, end);
7625 if (NILP (current_buffer->enable_multibyte_characters))
7626 return Qt;
7627 start_byte = CHAR_TO_BYTE (XINT (start));
7628 end_byte = CHAR_TO_BYTE (XINT (end));
7629 if (XINT (end) - XINT (start) == end_byte - start_byte)
7630 return Qt;
7631
7632 if (XINT (start) < GPT && XINT (end) > GPT)
7633 {
7634 if ((GPT - XINT (start)) < (XINT (end) - GPT))
7635 move_gap_both (XINT (start), start_byte);
7636 else
7637 move_gap_both (XINT (end), end_byte);
7638 }
7639 }
7640
7641 coding_attrs_list = Qnil;
7642 for (tail = Vcoding_system_list; CONSP (tail); tail = XCDR (tail))
7643 if (NILP (exclude)
7644 || NILP (Fmemq (XCAR (tail), exclude)))
7645 {
7646 Lisp_Object attrs;
7647
7648 attrs = AREF (CODING_SYSTEM_SPEC (XCAR (tail)), 0);
7649 if (EQ (XCAR (tail), CODING_ATTR_BASE_NAME (attrs))
7650 && ! EQ (CODING_ATTR_TYPE (attrs), Qundecided))
7651 {
7652 ASET (attrs, coding_attr_trans_tbl,
7653 get_translation_table (attrs, 1, NULL));
7654 coding_attrs_list = Fcons (attrs, coding_attrs_list);
7655 }
7656 }
7657
7658 if (STRINGP (start))
7659 p = pbeg = SDATA (start);
7660 else
7661 p = pbeg = BYTE_POS_ADDR (start_byte);
7662 pend = p + (end_byte - start_byte);
7663
7664 while (p < pend && ASCII_BYTE_P (*p)) p++;
7665 while (p < pend && ASCII_BYTE_P (*(pend - 1))) pend--;
7666
7667 while (p < pend)
7668 {
7669 if (ASCII_BYTE_P (*p))
7670 p++;
7671 else
7672 {
7673 c = STRING_CHAR_ADVANCE (p);
7674
7675 charset_map_loaded = 0;
7676 for (tail = coding_attrs_list; CONSP (tail);)
7677 {
7678 elt = XCAR (tail);
7679 if (NILP (elt))
7680 tail = XCDR (tail);
7681 else if (char_encodable_p (c, elt))
7682 tail = XCDR (tail);
7683 else if (CONSP (XCDR (tail)))
7684 {
7685 XSETCAR (tail, XCAR (XCDR (tail)));
7686 XSETCDR (tail, XCDR (XCDR (tail)));
7687 }
7688 else
7689 {
7690 XSETCAR (tail, Qnil);
7691 tail = XCDR (tail);
7692 }
7693 }
7694 if (charset_map_loaded)
7695 {
7696 EMACS_INT p_offset = p - pbeg, pend_offset = pend - pbeg;
7697
7698 if (STRINGP (start))
7699 pbeg = SDATA (start);
7700 else
7701 pbeg = BYTE_POS_ADDR (start_byte);
7702 p = pbeg + p_offset;
7703 pend = pbeg + pend_offset;
7704 }
7705 }
7706 }
7707
7708 safe_codings = list2 (Qraw_text, Qno_conversion);
7709 for (tail = coding_attrs_list; CONSP (tail); tail = XCDR (tail))
7710 if (! NILP (XCAR (tail)))
7711 safe_codings = Fcons (CODING_ATTR_BASE_NAME (XCAR (tail)), safe_codings);
7712
7713 return safe_codings;
7714 }
7715
7716
7717 DEFUN ("unencodable-char-position", Funencodable_char_position,
7718 Sunencodable_char_position, 3, 5, 0,
7719 doc: /*
7720 Return position of first un-encodable character in a region.
7721 START and END specfiy the region and CODING-SYSTEM specifies the
7722 encoding to check. Return nil if CODING-SYSTEM does encode the region.
7723
7724 If optional 4th argument COUNT is non-nil, it specifies at most how
7725 many un-encodable characters to search. In this case, the value is a
7726 list of positions.
7727
7728 If optional 5th argument STRING is non-nil, it is a string to search
7729 for un-encodable characters. In that case, START and END are indexes
7730 to the string. */)
7731 (start, end, coding_system, count, string)
7732 Lisp_Object start, end, coding_system, count, string;
7733 {
7734 int n;
7735 struct coding_system coding;
7736 Lisp_Object attrs, charset_list, translation_table;
7737 Lisp_Object positions;
7738 int from, to;
7739 const unsigned char *p, *stop, *pend;
7740 int ascii_compatible;
7741
7742 setup_coding_system (Fcheck_coding_system (coding_system), &coding);
7743 attrs = CODING_ID_ATTRS (coding.id);
7744 if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
7745 return Qnil;
7746 ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
7747 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
7748 translation_table = get_translation_table (attrs, 1, NULL);
7749
7750 if (NILP (string))
7751 {
7752 validate_region (&start, &end);
7753 from = XINT (start);
7754 to = XINT (end);
7755 if (NILP (current_buffer->enable_multibyte_characters)
7756 || (ascii_compatible
7757 && (to - from) == (CHAR_TO_BYTE (to) - (CHAR_TO_BYTE (from)))))
7758 return Qnil;
7759 p = CHAR_POS_ADDR (from);
7760 pend = CHAR_POS_ADDR (to);
7761 if (from < GPT && to >= GPT)
7762 stop = GPT_ADDR;
7763 else
7764 stop = pend;
7765 }
7766 else
7767 {
7768 CHECK_STRING (string);
7769 CHECK_NATNUM (start);
7770 CHECK_NATNUM (end);
7771 from = XINT (start);
7772 to = XINT (end);
7773 if (from > to
7774 || to > SCHARS (string))
7775 args_out_of_range_3 (string, start, end);
7776 if (! STRING_MULTIBYTE (string))
7777 return Qnil;
7778 p = SDATA (string) + string_char_to_byte (string, from);
7779 stop = pend = SDATA (string) + string_char_to_byte (string, to);
7780 if (ascii_compatible && (to - from) == (pend - p))
7781 return Qnil;
7782 }
7783
7784 if (NILP (count))
7785 n = 1;
7786 else
7787 {
7788 CHECK_NATNUM (count);
7789 n = XINT (count);
7790 }
7791
7792 positions = Qnil;
7793 while (1)
7794 {
7795 int c;
7796
7797 if (ascii_compatible)
7798 while (p < stop && ASCII_BYTE_P (*p))
7799 p++, from++;
7800 if (p >= stop)
7801 {
7802 if (p >= pend)
7803 break;
7804 stop = pend;
7805 p = GAP_END_ADDR;
7806 }
7807
7808 c = STRING_CHAR_ADVANCE (p);
7809 if (! (ASCII_CHAR_P (c) && ascii_compatible)
7810 && ! char_charset (translate_char (translation_table, c),
7811 charset_list, NULL))
7812 {
7813 positions = Fcons (make_number (from), positions);
7814 n--;
7815 if (n == 0)
7816 break;
7817 }
7818
7819 from++;
7820 }
7821
7822 return (NILP (count) ? Fcar (positions) : Fnreverse (positions));
7823 }
7824
7825
7826 DEFUN ("check-coding-systems-region", Fcheck_coding_systems_region,
7827 Scheck_coding_systems_region, 3, 3, 0,
7828 doc: /* Check if the region is encodable by coding systems.
7829
7830 START and END are buffer positions specifying the region.
7831 CODING-SYSTEM-LIST is a list of coding systems to check.
7832
7833 The value is an alist ((CODING-SYSTEM POS0 POS1 ...) ...), where
7834 CODING-SYSTEM is a member of CODING-SYSTEM-LIst and can't encode the
7835 whole region, POS0, POS1, ... are buffer positions where non-encodable
7836 characters are found.
7837
7838 If all coding systems in CODING-SYSTEM-LIST can encode the region, the
7839 value is nil.
7840
7841 START may be a string. In that case, check if the string is
7842 encodable, and the value contains indices to the string instead of
7843 buffer positions. END is ignored. */)
7844 (start, end, coding_system_list)
7845 Lisp_Object start, end, coding_system_list;
7846 {
7847 Lisp_Object list;
7848 EMACS_INT start_byte, end_byte;
7849 int pos;
7850 const unsigned char *p, *pbeg, *pend;
7851 int c;
7852 Lisp_Object tail, elt, attrs;
7853
7854 if (STRINGP (start))
7855 {
7856 if (!STRING_MULTIBYTE (start)
7857 && SCHARS (start) != SBYTES (start))
7858 return Qnil;
7859 start_byte = 0;
7860 end_byte = SBYTES (start);
7861 pos = 0;
7862 }
7863 else
7864 {
7865 CHECK_NUMBER_COERCE_MARKER (start);
7866 CHECK_NUMBER_COERCE_MARKER (end);
7867 if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end))
7868 args_out_of_range (start, end);
7869 if (NILP (current_buffer->enable_multibyte_characters))
7870 return Qnil;
7871 start_byte = CHAR_TO_BYTE (XINT (start));
7872 end_byte = CHAR_TO_BYTE (XINT (end));
7873 if (XINT (end) - XINT (start) == end_byte - start_byte)
7874 return Qt;
7875
7876 if (XINT (start) < GPT && XINT (end) > GPT)
7877 {
7878 if ((GPT - XINT (start)) < (XINT (end) - GPT))
7879 move_gap_both (XINT (start), start_byte);
7880 else
7881 move_gap_both (XINT (end), end_byte);
7882 }
7883 pos = XINT (start);
7884 }
7885
7886 list = Qnil;
7887 for (tail = coding_system_list; CONSP (tail); tail = XCDR (tail))
7888 {
7889 elt = XCAR (tail);
7890 attrs = AREF (CODING_SYSTEM_SPEC (elt), 0);
7891 ASET (attrs, coding_attr_trans_tbl,
7892 get_translation_table (attrs, 1, NULL));
7893 list = Fcons (Fcons (elt, Fcons (attrs, Qnil)), list);
7894 }
7895
7896 if (STRINGP (start))
7897 p = pbeg = SDATA (start);
7898 else
7899 p = pbeg = BYTE_POS_ADDR (start_byte);
7900 pend = p + (end_byte - start_byte);
7901
7902 while (p < pend && ASCII_BYTE_P (*p)) p++, pos++;
7903 while (p < pend && ASCII_BYTE_P (*(pend - 1))) pend--;
7904
7905 while (p < pend)
7906 {
7907 if (ASCII_BYTE_P (*p))
7908 p++;
7909 else
7910 {
7911 c = STRING_CHAR_ADVANCE (p);
7912
7913 charset_map_loaded = 0;
7914 for (tail = list; CONSP (tail); tail = XCDR (tail))
7915 {
7916 elt = XCDR (XCAR (tail));
7917 if (! char_encodable_p (c, XCAR (elt)))
7918 XSETCDR (elt, Fcons (make_number (pos), XCDR (elt)));
7919 }
7920 if (charset_map_loaded)
7921 {
7922 EMACS_INT p_offset = p - pbeg, pend_offset = pend - pbeg;
7923
7924 if (STRINGP (start))
7925 pbeg = SDATA (start);
7926 else
7927 pbeg = BYTE_POS_ADDR (start_byte);
7928 p = pbeg + p_offset;
7929 pend = pbeg + pend_offset;
7930 }
7931 }
7932 pos++;
7933 }
7934
7935 tail = list;
7936 list = Qnil;
7937 for (; CONSP (tail); tail = XCDR (tail))
7938 {
7939 elt = XCAR (tail);
7940 if (CONSP (XCDR (XCDR (elt))))
7941 list = Fcons (Fcons (XCAR (elt), Fnreverse (XCDR (XCDR (elt)))),
7942 list);
7943 }
7944
7945 return list;
7946 }
7947
7948
7949 Lisp_Object
7950 code_convert_region (start, end, coding_system, dst_object, encodep, norecord)
7951 Lisp_Object start, end, coding_system, dst_object;
7952 int encodep, norecord;
7953 {
7954 struct coding_system coding;
7955 EMACS_INT from, from_byte, to, to_byte;
7956 Lisp_Object src_object;
7957
7958 CHECK_NUMBER_COERCE_MARKER (start);
7959 CHECK_NUMBER_COERCE_MARKER (end);
7960 if (NILP (coding_system))
7961 coding_system = Qno_conversion;
7962 else
7963 CHECK_CODING_SYSTEM (coding_system);
7964 src_object = Fcurrent_buffer ();
7965 if (NILP (dst_object))
7966 dst_object = src_object;
7967 else if (! EQ (dst_object, Qt))
7968 CHECK_BUFFER (dst_object);
7969
7970 validate_region (&start, &end);
7971 from = XFASTINT (start);
7972 from_byte = CHAR_TO_BYTE (from);
7973 to = XFASTINT (end);
7974 to_byte = CHAR_TO_BYTE (to);
7975
7976 setup_coding_system (coding_system, &coding);
7977 coding.mode |= CODING_MODE_LAST_BLOCK;
7978
7979 if (encodep)
7980 encode_coding_object (&coding, src_object, from, from_byte, to, to_byte,
7981 dst_object);
7982 else
7983 decode_coding_object (&coding, src_object, from, from_byte, to, to_byte,
7984 dst_object);
7985 if (! norecord)
7986 Vlast_coding_system_used = CODING_ID_NAME (coding.id);
7987
7988 return (BUFFERP (dst_object)
7989 ? make_number (coding.produced_char)
7990 : coding.dst_object);
7991 }
7992
7993
7994 DEFUN ("decode-coding-region", Fdecode_coding_region, Sdecode_coding_region,
7995 3, 4, "r\nzCoding system: ",
7996 doc: /* Decode the current region from the specified coding system.
7997 When called from a program, takes four arguments:
7998 START, END, CODING-SYSTEM, and DESTINATION.
7999 START and END are buffer positions.
8000
8001 Optional 4th arguments DESTINATION specifies where the decoded text goes.
8002 If nil, the region between START and END is replace by the decoded text.
8003 If buffer, the decoded text is inserted in the buffer.
8004 If t, the decoded text is returned.
8005
8006 This function sets `last-coding-system-used' to the precise coding system
8007 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
8008 not fully specified.)
8009 It returns the length of the decoded text. */)
8010 (start, end, coding_system, destination)
8011 Lisp_Object start, end, coding_system, destination;
8012 {
8013 return code_convert_region (start, end, coding_system, destination, 0, 0);
8014 }
8015
8016 DEFUN ("encode-coding-region", Fencode_coding_region, Sencode_coding_region,
8017 3, 4, "r\nzCoding system: ",
8018 doc: /* Encode the current region by specified coding system.
8019 When called from a program, takes three arguments:
8020 START, END, and CODING-SYSTEM. START and END are buffer positions.
8021
8022 Optional 4th arguments DESTINATION specifies where the encoded text goes.
8023 If nil, the region between START and END is replace by the encoded text.
8024 If buffer, the encoded text is inserted in the buffer.
8025 If t, the encoded text is returned.
8026
8027 This function sets `last-coding-system-used' to the precise coding system
8028 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
8029 not fully specified.)
8030 It returns the length of the encoded text. */)
8031 (start, end, coding_system, destination)
8032 Lisp_Object start, end, coding_system, destination;
8033 {
8034 return code_convert_region (start, end, coding_system, destination, 1, 0);
8035 }
8036
8037 Lisp_Object
8038 code_convert_string (string, coding_system, dst_object,
8039 encodep, nocopy, norecord)
8040 Lisp_Object string, coding_system, dst_object;
8041 int encodep, nocopy, norecord;
8042 {
8043 struct coding_system coding;
8044 EMACS_INT chars, bytes;
8045
8046 CHECK_STRING (string);
8047 if (NILP (coding_system))
8048 {
8049 if (! norecord)
8050 Vlast_coding_system_used = Qno_conversion;
8051 if (NILP (dst_object))
8052 return (nocopy ? Fcopy_sequence (string) : string);
8053 }
8054
8055 if (NILP (coding_system))
8056 coding_system = Qno_conversion;
8057 else
8058 CHECK_CODING_SYSTEM (coding_system);
8059 if (NILP (dst_object))
8060 dst_object = Qt;
8061 else if (! EQ (dst_object, Qt))
8062 CHECK_BUFFER (dst_object);
8063
8064 setup_coding_system (coding_system, &coding);
8065 coding.mode |= CODING_MODE_LAST_BLOCK;
8066 chars = SCHARS (string);
8067 bytes = SBYTES (string);
8068 if (encodep)
8069 encode_coding_object (&coding, string, 0, 0, chars, bytes, dst_object);
8070 else
8071 decode_coding_object (&coding, string, 0, 0, chars, bytes, dst_object);
8072 if (! norecord)
8073 Vlast_coding_system_used = CODING_ID_NAME (coding.id);
8074
8075 return (BUFFERP (dst_object)
8076 ? make_number (coding.produced_char)
8077 : coding.dst_object);
8078 }
8079
8080
8081 /* Encode or decode STRING according to CODING_SYSTEM.
8082 Do not set Vlast_coding_system_used.
8083
8084 This function is called only from macros DECODE_FILE and
8085 ENCODE_FILE, thus we ignore character composition. */
8086
8087 Lisp_Object
8088 code_convert_string_norecord (string, coding_system, encodep)
8089 Lisp_Object string, coding_system;
8090 int encodep;
8091 {
8092 return code_convert_string (string, coding_system, Qt, encodep, 0, 1);
8093 }
8094
8095
8096 DEFUN ("decode-coding-string", Fdecode_coding_string, Sdecode_coding_string,
8097 2, 4, 0,
8098 doc: /* Decode STRING which is encoded in CODING-SYSTEM, and return the result.
8099
8100 Optional third arg NOCOPY non-nil means it is OK to return STRING itself
8101 if the decoding operation is trivial.
8102
8103 Optional fourth arg BUFFER non-nil meant that the decoded text is
8104 inserted in BUFFER instead of returned as a string. In this case,
8105 the return value is BUFFER.
8106
8107 This function sets `last-coding-system-used' to the precise coding system
8108 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
8109 not fully specified. */)
8110 (string, coding_system, nocopy, buffer)
8111 Lisp_Object string, coding_system, nocopy, buffer;
8112 {
8113 return code_convert_string (string, coding_system, buffer,
8114 0, ! NILP (nocopy), 0);
8115 }
8116
8117 DEFUN ("encode-coding-string", Fencode_coding_string, Sencode_coding_string,
8118 2, 4, 0,
8119 doc: /* Encode STRING to CODING-SYSTEM, and return the result.
8120
8121 Optional third arg NOCOPY non-nil means it is OK to return STRING
8122 itself if the encoding operation is trivial.
8123
8124 Optional fourth arg BUFFER non-nil meant that the encoded text is
8125 inserted in BUFFER instead of returned as a string. In this case,
8126 the return value is BUFFER.
8127
8128 This function sets `last-coding-system-used' to the precise coding system
8129 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
8130 not fully specified.) */)
8131 (string, coding_system, nocopy, buffer)
8132 Lisp_Object string, coding_system, nocopy, buffer;
8133 {
8134 return code_convert_string (string, coding_system, buffer,
8135 1, ! NILP (nocopy), 1);
8136 }
8137
8138 \f
8139 DEFUN ("decode-sjis-char", Fdecode_sjis_char, Sdecode_sjis_char, 1, 1, 0,
8140 doc: /* Decode a Japanese character which has CODE in shift_jis encoding.
8141 Return the corresponding character. */)
8142 (code)
8143 Lisp_Object code;
8144 {
8145 Lisp_Object spec, attrs, val;
8146 struct charset *charset_roman, *charset_kanji, *charset_kana, *charset;
8147 int c;
8148
8149 CHECK_NATNUM (code);
8150 c = XFASTINT (code);
8151 CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system, spec);
8152 attrs = AREF (spec, 0);
8153
8154 if (ASCII_BYTE_P (c)
8155 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
8156 return code;
8157
8158 val = CODING_ATTR_CHARSET_LIST (attrs);
8159 charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
8160 charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
8161 charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val)));
8162
8163 if (c <= 0x7F)
8164 charset = charset_roman;
8165 else if (c >= 0xA0 && c < 0xDF)
8166 {
8167 charset = charset_kana;
8168 c -= 0x80;
8169 }
8170 else
8171 {
8172 int s1 = c >> 8, s2 = c & 0xFF;
8173
8174 if (s1 < 0x81 || (s1 > 0x9F && s1 < 0xE0) || s1 > 0xEF
8175 || s2 < 0x40 || s2 == 0x7F || s2 > 0xFC)
8176 error ("Invalid code: %d", code);
8177 SJIS_TO_JIS (c);
8178 charset = charset_kanji;
8179 }
8180 c = DECODE_CHAR (charset, c);
8181 if (c < 0)
8182 error ("Invalid code: %d", code);
8183 return make_number (c);
8184 }
8185
8186
8187 DEFUN ("encode-sjis-char", Fencode_sjis_char, Sencode_sjis_char, 1, 1, 0,
8188 doc: /* Encode a Japanese character CH to shift_jis encoding.
8189 Return the corresponding code in SJIS. */)
8190 (ch)
8191 Lisp_Object ch;
8192 {
8193 Lisp_Object spec, attrs, charset_list;
8194 int c;
8195 struct charset *charset;
8196 unsigned code;
8197
8198 CHECK_CHARACTER (ch);
8199 c = XFASTINT (ch);
8200 CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system, spec);
8201 attrs = AREF (spec, 0);
8202
8203 if (ASCII_CHAR_P (c)
8204 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
8205 return ch;
8206
8207 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
8208 charset = char_charset (c, charset_list, &code);
8209 if (code == CHARSET_INVALID_CODE (charset))
8210 error ("Can't encode by shift_jis encoding: %d", c);
8211 JIS_TO_SJIS (code);
8212
8213 return make_number (code);
8214 }
8215
8216 DEFUN ("decode-big5-char", Fdecode_big5_char, Sdecode_big5_char, 1, 1, 0,
8217 doc: /* Decode a Big5 character which has CODE in BIG5 coding system.
8218 Return the corresponding character. */)
8219 (code)
8220 Lisp_Object code;
8221 {
8222 Lisp_Object spec, attrs, val;
8223 struct charset *charset_roman, *charset_big5, *charset;
8224 int c;
8225
8226 CHECK_NATNUM (code);
8227 c = XFASTINT (code);
8228 CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system, spec);
8229 attrs = AREF (spec, 0);
8230
8231 if (ASCII_BYTE_P (c)
8232 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
8233 return code;
8234
8235 val = CODING_ATTR_CHARSET_LIST (attrs);
8236 charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
8237 charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val)));
8238
8239 if (c <= 0x7F)
8240 charset = charset_roman;
8241 else
8242 {
8243 int b1 = c >> 8, b2 = c & 0x7F;
8244 if (b1 < 0xA1 || b1 > 0xFE
8245 || b2 < 0x40 || (b2 > 0x7E && b2 < 0xA1) || b2 > 0xFE)
8246 error ("Invalid code: %d", code);
8247 charset = charset_big5;
8248 }
8249 c = DECODE_CHAR (charset, (unsigned )c);
8250 if (c < 0)
8251 error ("Invalid code: %d", code);
8252 return make_number (c);
8253 }
8254
8255 DEFUN ("encode-big5-char", Fencode_big5_char, Sencode_big5_char, 1, 1, 0,
8256 doc: /* Encode the Big5 character CH to BIG5 coding system.
8257 Return the corresponding character code in Big5. */)
8258 (ch)
8259 Lisp_Object ch;
8260 {
8261 Lisp_Object spec, attrs, charset_list;
8262 struct charset *charset;
8263 int c;
8264 unsigned code;
8265
8266 CHECK_CHARACTER (ch);
8267 c = XFASTINT (ch);
8268 CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system, spec);
8269 attrs = AREF (spec, 0);
8270 if (ASCII_CHAR_P (c)
8271 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
8272 return ch;
8273
8274 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
8275 charset = char_charset (c, charset_list, &code);
8276 if (code == CHARSET_INVALID_CODE (charset))
8277 error ("Can't encode by Big5 encoding: %d", c);
8278
8279 return make_number (code);
8280 }
8281
8282 \f
8283 DEFUN ("set-terminal-coding-system-internal",
8284 Fset_terminal_coding_system_internal,
8285 Sset_terminal_coding_system_internal, 1, 1, 0,
8286 doc: /* Internal use only. */)
8287 (coding_system)
8288 Lisp_Object coding_system;
8289 {
8290 CHECK_SYMBOL (coding_system);
8291 setup_coding_system (Fcheck_coding_system (coding_system),
8292 &terminal_coding);
8293
8294 /* We had better not send unsafe characters to terminal. */
8295 terminal_coding.mode |= CODING_MODE_SAFE_ENCODING;
8296 /* Characer composition should be disabled. */
8297 terminal_coding.common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
8298 terminal_coding.src_multibyte = 1;
8299 terminal_coding.dst_multibyte = 0;
8300 return Qnil;
8301 }
8302
8303 DEFUN ("set-safe-terminal-coding-system-internal",
8304 Fset_safe_terminal_coding_system_internal,
8305 Sset_safe_terminal_coding_system_internal, 1, 1, 0,
8306 doc: /* Internal use only. */)
8307 (coding_system)
8308 Lisp_Object coding_system;
8309 {
8310 CHECK_SYMBOL (coding_system);
8311 setup_coding_system (Fcheck_coding_system (coding_system),
8312 &safe_terminal_coding);
8313 /* Characer composition should be disabled. */
8314 safe_terminal_coding.common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
8315 safe_terminal_coding.src_multibyte = 1;
8316 safe_terminal_coding.dst_multibyte = 0;
8317 return Qnil;
8318 }
8319
8320 DEFUN ("terminal-coding-system",
8321 Fterminal_coding_system, Sterminal_coding_system, 0, 0, 0,
8322 doc: /* Return coding system specified for terminal output. */)
8323 ()
8324 {
8325 Lisp_Object coding_system;
8326
8327 coding_system = CODING_ID_NAME (terminal_coding.id);
8328 /* For backward compatibility, return nil if it is `undecided'. */
8329 return (! EQ (coding_system, Qundecided) ? coding_system : Qnil);
8330 }
8331
8332 DEFUN ("set-keyboard-coding-system-internal",
8333 Fset_keyboard_coding_system_internal,
8334 Sset_keyboard_coding_system_internal, 1, 1, 0,
8335 doc: /* Internal use only. */)
8336 (coding_system)
8337 Lisp_Object coding_system;
8338 {
8339 CHECK_SYMBOL (coding_system);
8340 setup_coding_system (Fcheck_coding_system (coding_system),
8341 &keyboard_coding);
8342 /* Characer composition should be disabled. */
8343 keyboard_coding.common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
8344 return Qnil;
8345 }
8346
8347 DEFUN ("keyboard-coding-system",
8348 Fkeyboard_coding_system, Skeyboard_coding_system, 0, 0, 0,
8349 doc: /* Return coding system specified for decoding keyboard input. */)
8350 ()
8351 {
8352 return CODING_ID_NAME (keyboard_coding.id);
8353 }
8354
8355 \f
8356 DEFUN ("find-operation-coding-system", Ffind_operation_coding_system,
8357 Sfind_operation_coding_system, 1, MANY, 0,
8358 doc: /* Choose a coding system for an operation based on the target name.
8359 The value names a pair of coding systems: (DECODING-SYSTEM . ENCODING-SYSTEM).
8360 DECODING-SYSTEM is the coding system to use for decoding
8361 \(in case OPERATION does decoding), and ENCODING-SYSTEM is the coding system
8362 for encoding (in case OPERATION does encoding).
8363
8364 The first argument OPERATION specifies an I/O primitive:
8365 For file I/O, `insert-file-contents' or `write-region'.
8366 For process I/O, `call-process', `call-process-region', or `start-process'.
8367 For network I/O, `open-network-stream'.
8368
8369 The remaining arguments should be the same arguments that were passed
8370 to the primitive. Depending on which primitive, one of those arguments
8371 is selected as the TARGET. For example, if OPERATION does file I/O,
8372 whichever argument specifies the file name is TARGET.
8373
8374 TARGET has a meaning which depends on OPERATION:
8375 For file I/O, TARGET is a file name (except for the special case below).
8376 For process I/O, TARGET is a process name.
8377 For network I/O, TARGET is a service name or a port number
8378
8379 This function looks up what specified for TARGET in,
8380 `file-coding-system-alist', `process-coding-system-alist',
8381 or `network-coding-system-alist' depending on OPERATION.
8382 They may specify a coding system, a cons of coding systems,
8383 or a function symbol to call.
8384 In the last case, we call the function with one argument,
8385 which is a list of all the arguments given to this function.
8386
8387 If OPERATION is `insert-file-contents', the argument corresponding to
8388 TARGET may be a cons (FILENAME . BUFFER). In that case, FILENAME is a
8389 file name to look up, and BUFFER is a buffer that contains the file's
8390 contents (not yet decoded). If `file-coding-system-alist' specifies a
8391 function to call for FILENAME, that function should examine the
8392 contents of BUFFER instead of reading the file.
8393
8394 usage: (find-operation-coding-system OPERATION ARGUMENTS ...) */)
8395 (nargs, args)
8396 int nargs;
8397 Lisp_Object *args;
8398 {
8399 Lisp_Object operation, target_idx, target, val;
8400 register Lisp_Object chain;
8401
8402 if (nargs < 2)
8403 error ("Too few arguments");
8404 operation = args[0];
8405 if (!SYMBOLP (operation)
8406 || !INTEGERP (target_idx = Fget (operation, Qtarget_idx)))
8407 error ("Invalid first arguement");
8408 if (nargs < 1 + XINT (target_idx))
8409 error ("Too few arguments for operation: %s",
8410 SDATA (SYMBOL_NAME (operation)));
8411 target = args[XINT (target_idx) + 1];
8412 if (!(STRINGP (target)
8413 || (EQ (operation, Qinsert_file_contents) && CONSP (target)
8414 && STRINGP (XCAR (target)) && BUFFERP (XCDR (target)))
8415 || (EQ (operation, Qopen_network_stream) && INTEGERP (target))))
8416 error ("Invalid %dth argument", XINT (target_idx) + 1);
8417 if (CONSP (target))
8418 target = XCAR (target);
8419
8420 chain = ((EQ (operation, Qinsert_file_contents)
8421 || EQ (operation, Qwrite_region))
8422 ? Vfile_coding_system_alist
8423 : (EQ (operation, Qopen_network_stream)
8424 ? Vnetwork_coding_system_alist
8425 : Vprocess_coding_system_alist));
8426 if (NILP (chain))
8427 return Qnil;
8428
8429 for (; CONSP (chain); chain = XCDR (chain))
8430 {
8431 Lisp_Object elt;
8432
8433 elt = XCAR (chain);
8434 if (CONSP (elt)
8435 && ((STRINGP (target)
8436 && STRINGP (XCAR (elt))
8437 && fast_string_match (XCAR (elt), target) >= 0)
8438 || (INTEGERP (target) && EQ (target, XCAR (elt)))))
8439 {
8440 val = XCDR (elt);
8441 /* Here, if VAL is both a valid coding system and a valid
8442 function symbol, we return VAL as a coding system. */
8443 if (CONSP (val))
8444 return val;
8445 if (! SYMBOLP (val))
8446 return Qnil;
8447 if (! NILP (Fcoding_system_p (val)))
8448 return Fcons (val, val);
8449 if (! NILP (Ffboundp (val)))
8450 {
8451 /* We use call1 rather than safe_call1
8452 so as to get bug reports about functions called here
8453 which don't handle the current interface. */
8454 val = call1 (val, Flist (nargs, args));
8455 if (CONSP (val))
8456 return val;
8457 if (SYMBOLP (val) && ! NILP (Fcoding_system_p (val)))
8458 return Fcons (val, val);
8459 }
8460 return Qnil;
8461 }
8462 }
8463 return Qnil;
8464 }
8465
8466 DEFUN ("set-coding-system-priority", Fset_coding_system_priority,
8467 Sset_coding_system_priority, 0, MANY, 0,
8468 doc: /* Assign higher priority to the coding systems given as arguments.
8469 If multiple coding systems belongs to the same category,
8470 all but the first one are ignored.
8471
8472 usage: (set-coding-system-priority ...) */)
8473 (nargs, args)
8474 int nargs;
8475 Lisp_Object *args;
8476 {
8477 int i, j;
8478 int changed[coding_category_max];
8479 enum coding_category priorities[coding_category_max];
8480
8481 bzero (changed, sizeof changed);
8482
8483 for (i = j = 0; i < nargs; i++)
8484 {
8485 enum coding_category category;
8486 Lisp_Object spec, attrs;
8487
8488 CHECK_CODING_SYSTEM_GET_SPEC (args[i], spec);
8489 attrs = AREF (spec, 0);
8490 category = XINT (CODING_ATTR_CATEGORY (attrs));
8491 if (changed[category])
8492 /* Ignore this coding system because a coding system of the
8493 same category already had a higher priority. */
8494 continue;
8495 changed[category] = 1;
8496 priorities[j++] = category;
8497 if (coding_categories[category].id >= 0
8498 && ! EQ (args[i], CODING_ID_NAME (coding_categories[category].id)))
8499 setup_coding_system (args[i], &coding_categories[category]);
8500 Fset (AREF (Vcoding_category_table, category), args[i]);
8501 }
8502
8503 /* Now we have decided top J priorities. Reflect the order of the
8504 original priorities to the remaining priorities. */
8505
8506 for (i = j, j = 0; i < coding_category_max; i++, j++)
8507 {
8508 while (j < coding_category_max
8509 && changed[coding_priorities[j]])
8510 j++;
8511 if (j == coding_category_max)
8512 abort ();
8513 priorities[i] = coding_priorities[j];
8514 }
8515
8516 bcopy (priorities, coding_priorities, sizeof priorities);
8517
8518 /* Update `coding-category-list'. */
8519 Vcoding_category_list = Qnil;
8520 for (i = coding_category_max - 1; i >= 0; i--)
8521 Vcoding_category_list
8522 = Fcons (AREF (Vcoding_category_table, priorities[i]),
8523 Vcoding_category_list);
8524
8525 return Qnil;
8526 }
8527
8528 DEFUN ("coding-system-priority-list", Fcoding_system_priority_list,
8529 Scoding_system_priority_list, 0, 1, 0,
8530 doc: /* Return a list of coding systems ordered by their priorities.
8531 HIGHESTP non-nil means just return the highest priority one. */)
8532 (highestp)
8533 Lisp_Object highestp;
8534 {
8535 int i;
8536 Lisp_Object val;
8537
8538 for (i = 0, val = Qnil; i < coding_category_max; i++)
8539 {
8540 enum coding_category category = coding_priorities[i];
8541 int id = coding_categories[category].id;
8542 Lisp_Object attrs;
8543
8544 if (id < 0)
8545 continue;
8546 attrs = CODING_ID_ATTRS (id);
8547 if (! NILP (highestp))
8548 return CODING_ATTR_BASE_NAME (attrs);
8549 val = Fcons (CODING_ATTR_BASE_NAME (attrs), val);
8550 }
8551 return Fnreverse (val);
8552 }
8553
8554 static char *suffixes[] = { "-unix", "-dos", "-mac" };
8555
8556 static Lisp_Object
8557 make_subsidiaries (base)
8558 Lisp_Object base;
8559 {
8560 Lisp_Object subsidiaries;
8561 int base_name_len = SBYTES (SYMBOL_NAME (base));
8562 char *buf = (char *) alloca (base_name_len + 6);
8563 int i;
8564
8565 bcopy (SDATA (SYMBOL_NAME (base)), buf, base_name_len);
8566 subsidiaries = Fmake_vector (make_number (3), Qnil);
8567 for (i = 0; i < 3; i++)
8568 {
8569 bcopy (suffixes[i], buf + base_name_len, strlen (suffixes[i]) + 1);
8570 ASET (subsidiaries, i, intern (buf));
8571 }
8572 return subsidiaries;
8573 }
8574
8575
8576 DEFUN ("define-coding-system-internal", Fdefine_coding_system_internal,
8577 Sdefine_coding_system_internal, coding_arg_max, MANY, 0,
8578 doc: /* For internal use only.
8579 usage: (define-coding-system-internal ...) */)
8580 (nargs, args)
8581 int nargs;
8582 Lisp_Object *args;
8583 {
8584 Lisp_Object name;
8585 Lisp_Object spec_vec; /* [ ATTRS ALIASE EOL_TYPE ] */
8586 Lisp_Object attrs; /* Vector of attributes. */
8587 Lisp_Object eol_type;
8588 Lisp_Object aliases;
8589 Lisp_Object coding_type, charset_list, safe_charsets;
8590 enum coding_category category;
8591 Lisp_Object tail, val;
8592 int max_charset_id = 0;
8593 int i;
8594
8595 if (nargs < coding_arg_max)
8596 goto short_args;
8597
8598 attrs = Fmake_vector (make_number (coding_attr_last_index), Qnil);
8599
8600 name = args[coding_arg_name];
8601 CHECK_SYMBOL (name);
8602 CODING_ATTR_BASE_NAME (attrs) = name;
8603
8604 val = args[coding_arg_mnemonic];
8605 if (! STRINGP (val))
8606 CHECK_CHARACTER (val);
8607 CODING_ATTR_MNEMONIC (attrs) = val;
8608
8609 coding_type = args[coding_arg_coding_type];
8610 CHECK_SYMBOL (coding_type);
8611 CODING_ATTR_TYPE (attrs) = coding_type;
8612
8613 charset_list = args[coding_arg_charset_list];
8614 if (SYMBOLP (charset_list))
8615 {
8616 if (EQ (charset_list, Qiso_2022))
8617 {
8618 if (! EQ (coding_type, Qiso_2022))
8619 error ("Invalid charset-list");
8620 charset_list = Viso_2022_charset_list;
8621 }
8622 else if (EQ (charset_list, Qemacs_mule))
8623 {
8624 if (! EQ (coding_type, Qemacs_mule))
8625 error ("Invalid charset-list");
8626 charset_list = Vemacs_mule_charset_list;
8627 }
8628 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
8629 if (max_charset_id < XFASTINT (XCAR (tail)))
8630 max_charset_id = XFASTINT (XCAR (tail));
8631 }
8632 else
8633 {
8634 charset_list = Fcopy_sequence (charset_list);
8635 for (tail = charset_list; !NILP (tail); tail = Fcdr (tail))
8636 {
8637 struct charset *charset;
8638
8639 val = Fcar (tail);
8640 CHECK_CHARSET_GET_CHARSET (val, charset);
8641 if (EQ (coding_type, Qiso_2022)
8642 ? CHARSET_ISO_FINAL (charset) < 0
8643 : EQ (coding_type, Qemacs_mule)
8644 ? CHARSET_EMACS_MULE_ID (charset) < 0
8645 : 0)
8646 error ("Can't handle charset `%s'",
8647 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
8648
8649 XSETCAR (tail, make_number (charset->id));
8650 if (max_charset_id < charset->id)
8651 max_charset_id = charset->id;
8652 }
8653 }
8654 CODING_ATTR_CHARSET_LIST (attrs) = charset_list;
8655
8656 safe_charsets = Fmake_string (make_number (max_charset_id + 1),
8657 make_number (255));
8658 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
8659 SSET (safe_charsets, XFASTINT (XCAR (tail)), 0);
8660 CODING_ATTR_SAFE_CHARSETS (attrs) = safe_charsets;
8661
8662 CODING_ATTR_ASCII_COMPAT (attrs) = args[coding_arg_ascii_compatible_p];
8663
8664 val = args[coding_arg_decode_translation_table];
8665 if (! CHAR_TABLE_P (val) && ! CONSP (val))
8666 CHECK_SYMBOL (val);
8667 CODING_ATTR_DECODE_TBL (attrs) = val;
8668
8669 val = args[coding_arg_encode_translation_table];
8670 if (! CHAR_TABLE_P (val) && ! CONSP (val))
8671 CHECK_SYMBOL (val);
8672 CODING_ATTR_ENCODE_TBL (attrs) = val;
8673
8674 val = args[coding_arg_post_read_conversion];
8675 CHECK_SYMBOL (val);
8676 CODING_ATTR_POST_READ (attrs) = val;
8677
8678 val = args[coding_arg_pre_write_conversion];
8679 CHECK_SYMBOL (val);
8680 CODING_ATTR_PRE_WRITE (attrs) = val;
8681
8682 val = args[coding_arg_default_char];
8683 if (NILP (val))
8684 CODING_ATTR_DEFAULT_CHAR (attrs) = make_number (' ');
8685 else
8686 {
8687 CHECK_CHARACTER (val);
8688 CODING_ATTR_DEFAULT_CHAR (attrs) = val;
8689 }
8690
8691 val = args[coding_arg_for_unibyte];
8692 CODING_ATTR_FOR_UNIBYTE (attrs) = NILP (val) ? Qnil : Qt;
8693
8694 val = args[coding_arg_plist];
8695 CHECK_LIST (val);
8696 CODING_ATTR_PLIST (attrs) = val;
8697
8698 if (EQ (coding_type, Qcharset))
8699 {
8700 /* Generate a lisp vector of 256 elements. Each element is nil,
8701 integer, or a list of charset IDs.
8702
8703 If Nth element is nil, the byte code N is invalid in this
8704 coding system.
8705
8706 If Nth element is a number NUM, N is the first byte of a
8707 charset whose ID is NUM.
8708
8709 If Nth element is a list of charset IDs, N is the first byte
8710 of one of them. The list is sorted by dimensions of the
8711 charsets. A charset of smaller dimension comes firtst. */
8712 val = Fmake_vector (make_number (256), Qnil);
8713
8714 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
8715 {
8716 struct charset *charset = CHARSET_FROM_ID (XFASTINT (XCAR (tail)));
8717 int dim = CHARSET_DIMENSION (charset);
8718 int idx = (dim - 1) * 4;
8719
8720 if (CHARSET_ASCII_COMPATIBLE_P (charset))
8721 CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
8722
8723 for (i = charset->code_space[idx];
8724 i <= charset->code_space[idx + 1]; i++)
8725 {
8726 Lisp_Object tmp, tmp2;
8727 int dim2;
8728
8729 tmp = AREF (val, i);
8730 if (NILP (tmp))
8731 tmp = XCAR (tail);
8732 else if (NUMBERP (tmp))
8733 {
8734 dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (tmp)));
8735 if (dim < dim2)
8736 tmp = Fcons (XCAR (tail), Fcons (tmp, Qnil));
8737 else
8738 tmp = Fcons (tmp, Fcons (XCAR (tail), Qnil));
8739 }
8740 else
8741 {
8742 for (tmp2 = tmp; CONSP (tmp2); tmp2 = XCDR (tmp2))
8743 {
8744 dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (XCAR (tmp2))));
8745 if (dim < dim2)
8746 break;
8747 }
8748 if (NILP (tmp2))
8749 tmp = nconc2 (tmp, Fcons (XCAR (tail), Qnil));
8750 else
8751 {
8752 XSETCDR (tmp2, Fcons (XCAR (tmp2), XCDR (tmp2)));
8753 XSETCAR (tmp2, XCAR (tail));
8754 }
8755 }
8756 ASET (val, i, tmp);
8757 }
8758 }
8759 ASET (attrs, coding_attr_charset_valids, val);
8760 category = coding_category_charset;
8761 }
8762 else if (EQ (coding_type, Qccl))
8763 {
8764 Lisp_Object valids;
8765
8766 if (nargs < coding_arg_ccl_max)
8767 goto short_args;
8768
8769 val = args[coding_arg_ccl_decoder];
8770 CHECK_CCL_PROGRAM (val);
8771 if (VECTORP (val))
8772 val = Fcopy_sequence (val);
8773 ASET (attrs, coding_attr_ccl_decoder, val);
8774
8775 val = args[coding_arg_ccl_encoder];
8776 CHECK_CCL_PROGRAM (val);
8777 if (VECTORP (val))
8778 val = Fcopy_sequence (val);
8779 ASET (attrs, coding_attr_ccl_encoder, val);
8780
8781 val = args[coding_arg_ccl_valids];
8782 valids = Fmake_string (make_number (256), make_number (0));
8783 for (tail = val; !NILP (tail); tail = Fcdr (tail))
8784 {
8785 int from, to;
8786
8787 val = Fcar (tail);
8788 if (INTEGERP (val))
8789 {
8790 from = to = XINT (val);
8791 if (from < 0 || from > 255)
8792 args_out_of_range_3 (val, make_number (0), make_number (255));
8793 }
8794 else
8795 {
8796 CHECK_CONS (val);
8797 CHECK_NATNUM_CAR (val);
8798 CHECK_NATNUM_CDR (val);
8799 from = XINT (XCAR (val));
8800 if (from > 255)
8801 args_out_of_range_3 (XCAR (val),
8802 make_number (0), make_number (255));
8803 to = XINT (XCDR (val));
8804 if (to < from || to > 255)
8805 args_out_of_range_3 (XCDR (val),
8806 XCAR (val), make_number (255));
8807 }
8808 for (i = from; i <= to; i++)
8809 SSET (valids, i, 1);
8810 }
8811 ASET (attrs, coding_attr_ccl_valids, valids);
8812
8813 category = coding_category_ccl;
8814 }
8815 else if (EQ (coding_type, Qutf_16))
8816 {
8817 Lisp_Object bom, endian;
8818
8819 CODING_ATTR_ASCII_COMPAT (attrs) = Qnil;
8820
8821 if (nargs < coding_arg_utf16_max)
8822 goto short_args;
8823
8824 bom = args[coding_arg_utf16_bom];
8825 if (! NILP (bom) && ! EQ (bom, Qt))
8826 {
8827 CHECK_CONS (bom);
8828 val = XCAR (bom);
8829 CHECK_CODING_SYSTEM (val);
8830 val = XCDR (bom);
8831 CHECK_CODING_SYSTEM (val);
8832 }
8833 ASET (attrs, coding_attr_utf_16_bom, bom);
8834
8835 endian = args[coding_arg_utf16_endian];
8836 CHECK_SYMBOL (endian);
8837 if (NILP (endian))
8838 endian = Qbig;
8839 else if (! EQ (endian, Qbig) && ! EQ (endian, Qlittle))
8840 error ("Invalid endian: %s", SDATA (SYMBOL_NAME (endian)));
8841 ASET (attrs, coding_attr_utf_16_endian, endian);
8842
8843 category = (CONSP (bom)
8844 ? coding_category_utf_16_auto
8845 : NILP (bom)
8846 ? (EQ (endian, Qbig)
8847 ? coding_category_utf_16_be_nosig
8848 : coding_category_utf_16_le_nosig)
8849 : (EQ (endian, Qbig)
8850 ? coding_category_utf_16_be
8851 : coding_category_utf_16_le));
8852 }
8853 else if (EQ (coding_type, Qiso_2022))
8854 {
8855 Lisp_Object initial, reg_usage, request, flags;
8856 int i;
8857
8858 if (nargs < coding_arg_iso2022_max)
8859 goto short_args;
8860
8861 initial = Fcopy_sequence (args[coding_arg_iso2022_initial]);
8862 CHECK_VECTOR (initial);
8863 for (i = 0; i < 4; i++)
8864 {
8865 val = Faref (initial, make_number (i));
8866 if (! NILP (val))
8867 {
8868 struct charset *charset;
8869
8870 CHECK_CHARSET_GET_CHARSET (val, charset);
8871 ASET (initial, i, make_number (CHARSET_ID (charset)));
8872 if (i == 0 && CHARSET_ASCII_COMPATIBLE_P (charset))
8873 CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
8874 }
8875 else
8876 ASET (initial, i, make_number (-1));
8877 }
8878
8879 reg_usage = args[coding_arg_iso2022_reg_usage];
8880 CHECK_CONS (reg_usage);
8881 CHECK_NUMBER_CAR (reg_usage);
8882 CHECK_NUMBER_CDR (reg_usage);
8883
8884 request = Fcopy_sequence (args[coding_arg_iso2022_request]);
8885 for (tail = request; ! NILP (tail); tail = Fcdr (tail))
8886 {
8887 int id;
8888 Lisp_Object tmp;
8889
8890 val = Fcar (tail);
8891 CHECK_CONS (val);
8892 tmp = XCAR (val);
8893 CHECK_CHARSET_GET_ID (tmp, id);
8894 CHECK_NATNUM_CDR (val);
8895 if (XINT (XCDR (val)) >= 4)
8896 error ("Invalid graphic register number: %d", XINT (XCDR (val)));
8897 XSETCAR (val, make_number (id));
8898 }
8899
8900 flags = args[coding_arg_iso2022_flags];
8901 CHECK_NATNUM (flags);
8902 i = XINT (flags);
8903 if (EQ (args[coding_arg_charset_list], Qiso_2022))
8904 flags = make_number (i | CODING_ISO_FLAG_FULL_SUPPORT);
8905
8906 ASET (attrs, coding_attr_iso_initial, initial);
8907 ASET (attrs, coding_attr_iso_usage, reg_usage);
8908 ASET (attrs, coding_attr_iso_request, request);
8909 ASET (attrs, coding_attr_iso_flags, flags);
8910 setup_iso_safe_charsets (attrs);
8911
8912 if (i & CODING_ISO_FLAG_SEVEN_BITS)
8913 category = ((i & (CODING_ISO_FLAG_LOCKING_SHIFT
8914 | CODING_ISO_FLAG_SINGLE_SHIFT))
8915 ? coding_category_iso_7_else
8916 : EQ (args[coding_arg_charset_list], Qiso_2022)
8917 ? coding_category_iso_7
8918 : coding_category_iso_7_tight);
8919 else
8920 {
8921 int id = XINT (AREF (initial, 1));
8922
8923 category = (((i & CODING_ISO_FLAG_LOCKING_SHIFT)
8924 || EQ (args[coding_arg_charset_list], Qiso_2022)
8925 || id < 0)
8926 ? coding_category_iso_8_else
8927 : (CHARSET_DIMENSION (CHARSET_FROM_ID (id)) == 1)
8928 ? coding_category_iso_8_1
8929 : coding_category_iso_8_2);
8930 }
8931 if (category != coding_category_iso_8_1
8932 && category != coding_category_iso_8_2)
8933 CODING_ATTR_ASCII_COMPAT (attrs) = Qnil;
8934 }
8935 else if (EQ (coding_type, Qemacs_mule))
8936 {
8937 if (EQ (args[coding_arg_charset_list], Qemacs_mule))
8938 ASET (attrs, coding_attr_emacs_mule_full, Qt);
8939 CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
8940 category = coding_category_emacs_mule;
8941 }
8942 else if (EQ (coding_type, Qshift_jis))
8943 {
8944
8945 struct charset *charset;
8946
8947 if (XINT (Flength (charset_list)) != 3
8948 && XINT (Flength (charset_list)) != 4)
8949 error ("There should be three or four charsets");
8950
8951 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
8952 if (CHARSET_DIMENSION (charset) != 1)
8953 error ("Dimension of charset %s is not one",
8954 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
8955 if (CHARSET_ASCII_COMPATIBLE_P (charset))
8956 CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
8957
8958 charset_list = XCDR (charset_list);
8959 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
8960 if (CHARSET_DIMENSION (charset) != 1)
8961 error ("Dimension of charset %s is not one",
8962 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
8963
8964 charset_list = XCDR (charset_list);
8965 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
8966 if (CHARSET_DIMENSION (charset) != 2)
8967 error ("Dimension of charset %s is not two",
8968 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
8969
8970 charset_list = XCDR (charset_list);
8971 if (! NILP (charset_list))
8972 {
8973 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
8974 if (CHARSET_DIMENSION (charset) != 2)
8975 error ("Dimension of charset %s is not two",
8976 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
8977 }
8978
8979 category = coding_category_sjis;
8980 Vsjis_coding_system = name;
8981 }
8982 else if (EQ (coding_type, Qbig5))
8983 {
8984 struct charset *charset;
8985
8986 if (XINT (Flength (charset_list)) != 2)
8987 error ("There should be just two charsets");
8988
8989 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
8990 if (CHARSET_DIMENSION (charset) != 1)
8991 error ("Dimension of charset %s is not one",
8992 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
8993 if (CHARSET_ASCII_COMPATIBLE_P (charset))
8994 CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
8995
8996 charset_list = XCDR (charset_list);
8997 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
8998 if (CHARSET_DIMENSION (charset) != 2)
8999 error ("Dimension of charset %s is not two",
9000 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
9001
9002 category = coding_category_big5;
9003 Vbig5_coding_system = name;
9004 }
9005 else if (EQ (coding_type, Qraw_text))
9006 {
9007 category = coding_category_raw_text;
9008 CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
9009 }
9010 else if (EQ (coding_type, Qutf_8))
9011 {
9012 category = coding_category_utf_8;
9013 CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
9014 }
9015 else if (EQ (coding_type, Qundecided))
9016 category = coding_category_undecided;
9017 else
9018 error ("Invalid coding system type: %s",
9019 SDATA (SYMBOL_NAME (coding_type)));
9020
9021 CODING_ATTR_CATEGORY (attrs) = make_number (category);
9022 CODING_ATTR_PLIST (attrs)
9023 = Fcons (QCcategory, Fcons (AREF (Vcoding_category_table, category),
9024 CODING_ATTR_PLIST (attrs)));
9025 CODING_ATTR_PLIST (attrs)
9026 = Fcons (QCascii_compatible_p,
9027 Fcons (CODING_ATTR_ASCII_COMPAT (attrs),
9028 CODING_ATTR_PLIST (attrs)));
9029
9030 eol_type = args[coding_arg_eol_type];
9031 if (! NILP (eol_type)
9032 && ! EQ (eol_type, Qunix)
9033 && ! EQ (eol_type, Qdos)
9034 && ! EQ (eol_type, Qmac))
9035 error ("Invalid eol-type");
9036
9037 aliases = Fcons (name, Qnil);
9038
9039 if (NILP (eol_type))
9040 {
9041 eol_type = make_subsidiaries (name);
9042 for (i = 0; i < 3; i++)
9043 {
9044 Lisp_Object this_spec, this_name, this_aliases, this_eol_type;
9045
9046 this_name = AREF (eol_type, i);
9047 this_aliases = Fcons (this_name, Qnil);
9048 this_eol_type = (i == 0 ? Qunix : i == 1 ? Qdos : Qmac);
9049 this_spec = Fmake_vector (make_number (3), attrs);
9050 ASET (this_spec, 1, this_aliases);
9051 ASET (this_spec, 2, this_eol_type);
9052 Fputhash (this_name, this_spec, Vcoding_system_hash_table);
9053 Vcoding_system_list = Fcons (this_name, Vcoding_system_list);
9054 val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist);
9055 if (NILP (val))
9056 Vcoding_system_alist
9057 = Fcons (Fcons (Fsymbol_name (this_name), Qnil),
9058 Vcoding_system_alist);
9059 }
9060 }
9061
9062 spec_vec = Fmake_vector (make_number (3), attrs);
9063 ASET (spec_vec, 1, aliases);
9064 ASET (spec_vec, 2, eol_type);
9065
9066 Fputhash (name, spec_vec, Vcoding_system_hash_table);
9067 Vcoding_system_list = Fcons (name, Vcoding_system_list);
9068 val = Fassoc (Fsymbol_name (name), Vcoding_system_alist);
9069 if (NILP (val))
9070 Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (name), Qnil),
9071 Vcoding_system_alist);
9072
9073 {
9074 int id = coding_categories[category].id;
9075
9076 if (id < 0 || EQ (name, CODING_ID_NAME (id)))
9077 setup_coding_system (name, &coding_categories[category]);
9078 }
9079
9080 return Qnil;
9081
9082 short_args:
9083 return Fsignal (Qwrong_number_of_arguments,
9084 Fcons (intern ("define-coding-system-internal"),
9085 make_number (nargs)));
9086 }
9087
9088
9089 DEFUN ("coding-system-put", Fcoding_system_put, Scoding_system_put,
9090 3, 3, 0,
9091 doc: /* Change value in CODING-SYSTEM's property list PROP to VAL. */)
9092 (coding_system, prop, val)
9093 Lisp_Object coding_system, prop, val;
9094 {
9095 Lisp_Object spec, attrs;
9096
9097 CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
9098 attrs = AREF (spec, 0);
9099 if (EQ (prop, QCmnemonic))
9100 {
9101 if (! STRINGP (val))
9102 CHECK_CHARACTER (val);
9103 CODING_ATTR_MNEMONIC (attrs) = val;
9104 }
9105 else if (EQ (prop, QCdefalut_char))
9106 {
9107 if (NILP (val))
9108 val = make_number (' ');
9109 else
9110 CHECK_CHARACTER (val);
9111 CODING_ATTR_DEFAULT_CHAR (attrs) = val;
9112 }
9113 else if (EQ (prop, QCdecode_translation_table))
9114 {
9115 if (! CHAR_TABLE_P (val) && ! CONSP (val))
9116 CHECK_SYMBOL (val);
9117 CODING_ATTR_DECODE_TBL (attrs) = val;
9118 }
9119 else if (EQ (prop, QCencode_translation_table))
9120 {
9121 if (! CHAR_TABLE_P (val) && ! CONSP (val))
9122 CHECK_SYMBOL (val);
9123 CODING_ATTR_ENCODE_TBL (attrs) = val;
9124 }
9125 else if (EQ (prop, QCpost_read_conversion))
9126 {
9127 CHECK_SYMBOL (val);
9128 CODING_ATTR_POST_READ (attrs) = val;
9129 }
9130 else if (EQ (prop, QCpre_write_conversion))
9131 {
9132 CHECK_SYMBOL (val);
9133 CODING_ATTR_PRE_WRITE (attrs) = val;
9134 }
9135 else if (EQ (prop, QCascii_compatible_p))
9136 {
9137 CODING_ATTR_ASCII_COMPAT (attrs) = val;
9138 }
9139
9140 CODING_ATTR_PLIST (attrs)
9141 = Fplist_put (CODING_ATTR_PLIST (attrs), prop, val);
9142 return val;
9143 }
9144
9145
9146 DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias,
9147 Sdefine_coding_system_alias, 2, 2, 0,
9148 doc: /* Define ALIAS as an alias for CODING-SYSTEM. */)
9149 (alias, coding_system)
9150 Lisp_Object alias, coding_system;
9151 {
9152 Lisp_Object spec, aliases, eol_type, val;
9153
9154 CHECK_SYMBOL (alias);
9155 CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
9156 aliases = AREF (spec, 1);
9157 /* ALISES should be a list of length more than zero, and the first
9158 element is a base coding system. Append ALIAS at the tail of the
9159 list. */
9160 while (!NILP (XCDR (aliases)))
9161 aliases = XCDR (aliases);
9162 XSETCDR (aliases, Fcons (alias, Qnil));
9163
9164 eol_type = AREF (spec, 2);
9165 if (VECTORP (eol_type))
9166 {
9167 Lisp_Object subsidiaries;
9168 int i;
9169
9170 subsidiaries = make_subsidiaries (alias);
9171 for (i = 0; i < 3; i++)
9172 Fdefine_coding_system_alias (AREF (subsidiaries, i),
9173 AREF (eol_type, i));
9174 }
9175
9176 Fputhash (alias, spec, Vcoding_system_hash_table);
9177 Vcoding_system_list = Fcons (alias, Vcoding_system_list);
9178 val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist);
9179 if (NILP (val))
9180 Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (alias), Qnil),
9181 Vcoding_system_alist);
9182
9183 return Qnil;
9184 }
9185
9186 DEFUN ("coding-system-base", Fcoding_system_base, Scoding_system_base,
9187 1, 1, 0,
9188 doc: /* Return the base of CODING-SYSTEM.
9189 Any alias or subsidiary coding system is not a base coding system. */)
9190 (coding_system)
9191 Lisp_Object coding_system;
9192 {
9193 Lisp_Object spec, attrs;
9194
9195 if (NILP (coding_system))
9196 return (Qno_conversion);
9197 CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
9198 attrs = AREF (spec, 0);
9199 return CODING_ATTR_BASE_NAME (attrs);
9200 }
9201
9202 DEFUN ("coding-system-plist", Fcoding_system_plist, Scoding_system_plist,
9203 1, 1, 0,
9204 doc: "Return the property list of CODING-SYSTEM.")
9205 (coding_system)
9206 Lisp_Object coding_system;
9207 {
9208 Lisp_Object spec, attrs;
9209
9210 if (NILP (coding_system))
9211 coding_system = Qno_conversion;
9212 CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
9213 attrs = AREF (spec, 0);
9214 return CODING_ATTR_PLIST (attrs);
9215 }
9216
9217
9218 DEFUN ("coding-system-aliases", Fcoding_system_aliases, Scoding_system_aliases,
9219 1, 1, 0,
9220 doc: /* Return the list of aliases of CODING-SYSTEM. */)
9221 (coding_system)
9222 Lisp_Object coding_system;
9223 {
9224 Lisp_Object spec;
9225
9226 if (NILP (coding_system))
9227 coding_system = Qno_conversion;
9228 CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
9229 return AREF (spec, 1);
9230 }
9231
9232 DEFUN ("coding-system-eol-type", Fcoding_system_eol_type,
9233 Scoding_system_eol_type, 1, 1, 0,
9234 doc: /* Return eol-type of CODING-SYSTEM.
9235 An eol-type is integer 0, 1, 2, or a vector of coding systems.
9236
9237 Integer values 0, 1, and 2 indicate a format of end-of-line; LF, CRLF,
9238 and CR respectively.
9239
9240 A vector value indicates that a format of end-of-line should be
9241 detected automatically. Nth element of the vector is the subsidiary
9242 coding system whose eol-type is N. */)
9243 (coding_system)
9244 Lisp_Object coding_system;
9245 {
9246 Lisp_Object spec, eol_type;
9247 int n;
9248
9249 if (NILP (coding_system))
9250 coding_system = Qno_conversion;
9251 if (! CODING_SYSTEM_P (coding_system))
9252 return Qnil;
9253 spec = CODING_SYSTEM_SPEC (coding_system);
9254 eol_type = AREF (spec, 2);
9255 if (VECTORP (eol_type))
9256 return Fcopy_sequence (eol_type);
9257 n = EQ (eol_type, Qunix) ? 0 : EQ (eol_type, Qdos) ? 1 : 2;
9258 return make_number (n);
9259 }
9260
9261 #endif /* emacs */
9262
9263 \f
9264 /*** 9. Post-amble ***/
9265
9266 void
9267 init_coding_once ()
9268 {
9269 int i;
9270
9271 for (i = 0; i < coding_category_max; i++)
9272 {
9273 coding_categories[i].id = -1;
9274 coding_priorities[i] = i;
9275 }
9276
9277 /* ISO2022 specific initialize routine. */
9278 for (i = 0; i < 0x20; i++)
9279 iso_code_class[i] = ISO_control_0;
9280 for (i = 0x21; i < 0x7F; i++)
9281 iso_code_class[i] = ISO_graphic_plane_0;
9282 for (i = 0x80; i < 0xA0; i++)
9283 iso_code_class[i] = ISO_control_1;
9284 for (i = 0xA1; i < 0xFF; i++)
9285 iso_code_class[i] = ISO_graphic_plane_1;
9286 iso_code_class[0x20] = iso_code_class[0x7F] = ISO_0x20_or_0x7F;
9287 iso_code_class[0xA0] = iso_code_class[0xFF] = ISO_0xA0_or_0xFF;
9288 iso_code_class[ISO_CODE_SO] = ISO_shift_out;
9289 iso_code_class[ISO_CODE_SI] = ISO_shift_in;
9290 iso_code_class[ISO_CODE_SS2_7] = ISO_single_shift_2_7;
9291 iso_code_class[ISO_CODE_ESC] = ISO_escape;
9292 iso_code_class[ISO_CODE_SS2] = ISO_single_shift_2;
9293 iso_code_class[ISO_CODE_SS3] = ISO_single_shift_3;
9294 iso_code_class[ISO_CODE_CSI] = ISO_control_sequence_introducer;
9295
9296 for (i = 0; i < 256; i++)
9297 {
9298 emacs_mule_bytes[i] = 1;
9299 }
9300 emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_11] = 3;
9301 emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_12] = 3;
9302 emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_21] = 4;
9303 emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_22] = 4;
9304 }
9305
9306 #ifdef emacs
9307
9308 void
9309 syms_of_coding ()
9310 {
9311 staticpro (&Vcoding_system_hash_table);
9312 {
9313 Lisp_Object args[2];
9314 args[0] = QCtest;
9315 args[1] = Qeq;
9316 Vcoding_system_hash_table = Fmake_hash_table (2, args);
9317 }
9318
9319 staticpro (&Vsjis_coding_system);
9320 Vsjis_coding_system = Qnil;
9321
9322 staticpro (&Vbig5_coding_system);
9323 Vbig5_coding_system = Qnil;
9324
9325 staticpro (&Vcode_conversion_reused_workbuf);
9326 Vcode_conversion_reused_workbuf = Qnil;
9327
9328 staticpro (&Vcode_conversion_workbuf_name);
9329 Vcode_conversion_workbuf_name = build_string (" *code-conversion-work*");
9330
9331 reused_workbuf_in_use = 0;
9332
9333 DEFSYM (Qcharset, "charset");
9334 DEFSYM (Qtarget_idx, "target-idx");
9335 DEFSYM (Qcoding_system_history, "coding-system-history");
9336 Fset (Qcoding_system_history, Qnil);
9337
9338 /* Target FILENAME is the first argument. */
9339 Fput (Qinsert_file_contents, Qtarget_idx, make_number (0));
9340 /* Target FILENAME is the third argument. */
9341 Fput (Qwrite_region, Qtarget_idx, make_number (2));
9342
9343 DEFSYM (Qcall_process, "call-process");
9344 /* Target PROGRAM is the first argument. */
9345 Fput (Qcall_process, Qtarget_idx, make_number (0));
9346
9347 DEFSYM (Qcall_process_region, "call-process-region");
9348 /* Target PROGRAM is the third argument. */
9349 Fput (Qcall_process_region, Qtarget_idx, make_number (2));
9350
9351 DEFSYM (Qstart_process, "start-process");
9352 /* Target PROGRAM is the third argument. */
9353 Fput (Qstart_process, Qtarget_idx, make_number (2));
9354
9355 DEFSYM (Qopen_network_stream, "open-network-stream");
9356 /* Target SERVICE is the fourth argument. */
9357 Fput (Qopen_network_stream, Qtarget_idx, make_number (3));
9358
9359 DEFSYM (Qcoding_system, "coding-system");
9360 DEFSYM (Qcoding_aliases, "coding-aliases");
9361
9362 DEFSYM (Qeol_type, "eol-type");
9363 DEFSYM (Qunix, "unix");
9364 DEFSYM (Qdos, "dos");
9365
9366 DEFSYM (Qbuffer_file_coding_system, "buffer-file-coding-system");
9367 DEFSYM (Qpost_read_conversion, "post-read-conversion");
9368 DEFSYM (Qpre_write_conversion, "pre-write-conversion");
9369 DEFSYM (Qdefault_char, "default-char");
9370 DEFSYM (Qundecided, "undecided");
9371 DEFSYM (Qno_conversion, "no-conversion");
9372 DEFSYM (Qraw_text, "raw-text");
9373
9374 DEFSYM (Qiso_2022, "iso-2022");
9375
9376 DEFSYM (Qutf_8, "utf-8");
9377 DEFSYM (Qutf_8_emacs, "utf-8-emacs");
9378
9379 DEFSYM (Qutf_16, "utf-16");
9380 DEFSYM (Qbig, "big");
9381 DEFSYM (Qlittle, "little");
9382
9383 DEFSYM (Qshift_jis, "shift-jis");
9384 DEFSYM (Qbig5, "big5");
9385
9386 DEFSYM (Qcoding_system_p, "coding-system-p");
9387
9388 DEFSYM (Qcoding_system_error, "coding-system-error");
9389 Fput (Qcoding_system_error, Qerror_conditions,
9390 Fcons (Qcoding_system_error, Fcons (Qerror, Qnil)));
9391 Fput (Qcoding_system_error, Qerror_message,
9392 build_string ("Invalid coding system"));
9393
9394 /* Intern this now in case it isn't already done.
9395 Setting this variable twice is harmless.
9396 But don't staticpro it here--that is done in alloc.c. */
9397 Qchar_table_extra_slots = intern ("char-table-extra-slots");
9398
9399 DEFSYM (Qtranslation_table, "translation-table");
9400 Fput (Qtranslation_table, Qchar_table_extra_slots, make_number (2));
9401 DEFSYM (Qtranslation_table_id, "translation-table-id");
9402 DEFSYM (Qtranslation_table_for_decode, "translation-table-for-decode");
9403 DEFSYM (Qtranslation_table_for_encode, "translation-table-for-encode");
9404
9405 DEFSYM (Qvalid_codes, "valid-codes");
9406
9407 DEFSYM (Qemacs_mule, "emacs-mule");
9408
9409 DEFSYM (QCcategory, ":category");
9410 DEFSYM (QCmnemonic, ":mnemonic");
9411 DEFSYM (QCdefalut_char, ":default-char");
9412 DEFSYM (QCdecode_translation_table, ":decode-translation-table");
9413 DEFSYM (QCencode_translation_table, ":encode-translation-table");
9414 DEFSYM (QCpost_read_conversion, ":post-read-conversion");
9415 DEFSYM (QCpre_write_conversion, ":pre-write-conversion");
9416 DEFSYM (QCascii_compatible_p, ":ascii-compatible-p");
9417
9418 Vcoding_category_table
9419 = Fmake_vector (make_number (coding_category_max), Qnil);
9420 staticpro (&Vcoding_category_table);
9421 /* Followings are target of code detection. */
9422 ASET (Vcoding_category_table, coding_category_iso_7,
9423 intern ("coding-category-iso-7"));
9424 ASET (Vcoding_category_table, coding_category_iso_7_tight,
9425 intern ("coding-category-iso-7-tight"));
9426 ASET (Vcoding_category_table, coding_category_iso_8_1,
9427 intern ("coding-category-iso-8-1"));
9428 ASET (Vcoding_category_table, coding_category_iso_8_2,
9429 intern ("coding-category-iso-8-2"));
9430 ASET (Vcoding_category_table, coding_category_iso_7_else,
9431 intern ("coding-category-iso-7-else"));
9432 ASET (Vcoding_category_table, coding_category_iso_8_else,
9433 intern ("coding-category-iso-8-else"));
9434 ASET (Vcoding_category_table, coding_category_utf_8,
9435 intern ("coding-category-utf-8"));
9436 ASET (Vcoding_category_table, coding_category_utf_16_be,
9437 intern ("coding-category-utf-16-be"));
9438 ASET (Vcoding_category_table, coding_category_utf_16_auto,
9439 intern ("coding-category-utf-16-auto"));
9440 ASET (Vcoding_category_table, coding_category_utf_16_le,
9441 intern ("coding-category-utf-16-le"));
9442 ASET (Vcoding_category_table, coding_category_utf_16_be_nosig,
9443 intern ("coding-category-utf-16-be-nosig"));
9444 ASET (Vcoding_category_table, coding_category_utf_16_le_nosig,
9445 intern ("coding-category-utf-16-le-nosig"));
9446 ASET (Vcoding_category_table, coding_category_charset,
9447 intern ("coding-category-charset"));
9448 ASET (Vcoding_category_table, coding_category_sjis,
9449 intern ("coding-category-sjis"));
9450 ASET (Vcoding_category_table, coding_category_big5,
9451 intern ("coding-category-big5"));
9452 ASET (Vcoding_category_table, coding_category_ccl,
9453 intern ("coding-category-ccl"));
9454 ASET (Vcoding_category_table, coding_category_emacs_mule,
9455 intern ("coding-category-emacs-mule"));
9456 /* Followings are NOT target of code detection. */
9457 ASET (Vcoding_category_table, coding_category_raw_text,
9458 intern ("coding-category-raw-text"));
9459 ASET (Vcoding_category_table, coding_category_undecided,
9460 intern ("coding-category-undecided"));
9461
9462 DEFSYM (Qinsufficient_source, "insufficient-source");
9463 DEFSYM (Qinconsistent_eol, "inconsistent-eol");
9464 DEFSYM (Qinvalid_source, "invalid-source");
9465 DEFSYM (Qinterrupted, "interrupted");
9466 DEFSYM (Qinsufficient_memory, "insufficient-memory");
9467 DEFSYM (Qcoding_system_define_form, "coding-system-define-form");
9468
9469 defsubr (&Scoding_system_p);
9470 defsubr (&Sread_coding_system);
9471 defsubr (&Sread_non_nil_coding_system);
9472 defsubr (&Scheck_coding_system);
9473 defsubr (&Sdetect_coding_region);
9474 defsubr (&Sdetect_coding_string);
9475 defsubr (&Sfind_coding_systems_region_internal);
9476 defsubr (&Sunencodable_char_position);
9477 defsubr (&Scheck_coding_systems_region);
9478 defsubr (&Sdecode_coding_region);
9479 defsubr (&Sencode_coding_region);
9480 defsubr (&Sdecode_coding_string);
9481 defsubr (&Sencode_coding_string);
9482 defsubr (&Sdecode_sjis_char);
9483 defsubr (&Sencode_sjis_char);
9484 defsubr (&Sdecode_big5_char);
9485 defsubr (&Sencode_big5_char);
9486 defsubr (&Sset_terminal_coding_system_internal);
9487 defsubr (&Sset_safe_terminal_coding_system_internal);
9488 defsubr (&Sterminal_coding_system);
9489 defsubr (&Sset_keyboard_coding_system_internal);
9490 defsubr (&Skeyboard_coding_system);
9491 defsubr (&Sfind_operation_coding_system);
9492 defsubr (&Sset_coding_system_priority);
9493 defsubr (&Sdefine_coding_system_internal);
9494 defsubr (&Sdefine_coding_system_alias);
9495 defsubr (&Scoding_system_put);
9496 defsubr (&Scoding_system_base);
9497 defsubr (&Scoding_system_plist);
9498 defsubr (&Scoding_system_aliases);
9499 defsubr (&Scoding_system_eol_type);
9500 defsubr (&Scoding_system_priority_list);
9501
9502 DEFVAR_LISP ("coding-system-list", &Vcoding_system_list,
9503 doc: /* List of coding systems.
9504
9505 Do not alter the value of this variable manually. This variable should be
9506 updated by the functions `define-coding-system' and
9507 `define-coding-system-alias'. */);
9508 Vcoding_system_list = Qnil;
9509
9510 DEFVAR_LISP ("coding-system-alist", &Vcoding_system_alist,
9511 doc: /* Alist of coding system names.
9512 Each element is one element list of coding system name.
9513 This variable is given to `completing-read' as TABLE argument.
9514
9515 Do not alter the value of this variable manually. This variable should be
9516 updated by the functions `make-coding-system' and
9517 `define-coding-system-alias'. */);
9518 Vcoding_system_alist = Qnil;
9519
9520 DEFVAR_LISP ("coding-category-list", &Vcoding_category_list,
9521 doc: /* List of coding-categories (symbols) ordered by priority.
9522
9523 On detecting a coding system, Emacs tries code detection algorithms
9524 associated with each coding-category one by one in this order. When
9525 one algorithm agrees with a byte sequence of source text, the coding
9526 system bound to the corresponding coding-category is selected.
9527
9528 Don't modify this variable directly, but use `set-coding-priority'. */);
9529 {
9530 int i;
9531
9532 Vcoding_category_list = Qnil;
9533 for (i = coding_category_max - 1; i >= 0; i--)
9534 Vcoding_category_list
9535 = Fcons (XVECTOR (Vcoding_category_table)->contents[i],
9536 Vcoding_category_list);
9537 }
9538
9539 DEFVAR_LISP ("coding-system-for-read", &Vcoding_system_for_read,
9540 doc: /* Specify the coding system for read operations.
9541 It is useful to bind this variable with `let', but do not set it globally.
9542 If the value is a coding system, it is used for decoding on read operation.
9543 If not, an appropriate element is used from one of the coding system alists:
9544 There are three such tables, `file-coding-system-alist',
9545 `process-coding-system-alist', and `network-coding-system-alist'. */);
9546 Vcoding_system_for_read = Qnil;
9547
9548 DEFVAR_LISP ("coding-system-for-write", &Vcoding_system_for_write,
9549 doc: /* Specify the coding system for write operations.
9550 Programs bind this variable with `let', but you should not set it globally.
9551 If the value is a coding system, it is used for encoding of output,
9552 when writing it to a file and when sending it to a file or subprocess.
9553
9554 If this does not specify a coding system, an appropriate element
9555 is used from one of the coding system alists:
9556 There are three such tables, `file-coding-system-alist',
9557 `process-coding-system-alist', and `network-coding-system-alist'.
9558 For output to files, if the above procedure does not specify a coding system,
9559 the value of `buffer-file-coding-system' is used. */);
9560 Vcoding_system_for_write = Qnil;
9561
9562 DEFVAR_LISP ("last-coding-system-used", &Vlast_coding_system_used,
9563 doc: /*
9564 Coding system used in the latest file or process I/O. */);
9565 Vlast_coding_system_used = Qnil;
9566
9567 DEFVAR_LISP ("last-code-conversion-error", &Vlast_code_conversion_error,
9568 doc: /*
9569 Error status of the last code conversion.
9570
9571 When an error was detected in the last code conversion, this variable
9572 is set to one of the following symbols.
9573 `insufficient-source'
9574 `inconsistent-eol'
9575 `invalid-source'
9576 `interrupted'
9577 `insufficient-memory'
9578 When no error was detected, the value doesn't change. So, to check
9579 the error status of a code conversion by this variable, you must
9580 explicitly set this variable to nil before performing code
9581 conversion. */);
9582 Vlast_code_conversion_error = Qnil;
9583
9584 DEFVAR_BOOL ("inhibit-eol-conversion", &inhibit_eol_conversion,
9585 doc: /*
9586 *Non-nil means always inhibit code conversion of end-of-line format.
9587 See info node `Coding Systems' and info node `Text and Binary' concerning
9588 such conversion. */);
9589 inhibit_eol_conversion = 0;
9590
9591 DEFVAR_BOOL ("inherit-process-coding-system", &inherit_process_coding_system,
9592 doc: /*
9593 Non-nil means process buffer inherits coding system of process output.
9594 Bind it to t if the process output is to be treated as if it were a file
9595 read from some filesystem. */);
9596 inherit_process_coding_system = 0;
9597
9598 DEFVAR_LISP ("file-coding-system-alist", &Vfile_coding_system_alist,
9599 doc: /*
9600 Alist to decide a coding system to use for a file I/O operation.
9601 The format is ((PATTERN . VAL) ...),
9602 where PATTERN is a regular expression matching a file name,
9603 VAL is a coding system, a cons of coding systems, or a function symbol.
9604 If VAL is a coding system, it is used for both decoding and encoding
9605 the file contents.
9606 If VAL is a cons of coding systems, the car part is used for decoding,
9607 and the cdr part is used for encoding.
9608 If VAL is a function symbol, the function must return a coding system
9609 or a cons of coding systems which are used as above. The function gets
9610 the arguments with which `find-operation-coding-systems' was called.
9611
9612 See also the function `find-operation-coding-system'
9613 and the variable `auto-coding-alist'. */);
9614 Vfile_coding_system_alist = Qnil;
9615
9616 DEFVAR_LISP ("process-coding-system-alist", &Vprocess_coding_system_alist,
9617 doc: /*
9618 Alist to decide a coding system to use for a process I/O operation.
9619 The format is ((PATTERN . VAL) ...),
9620 where PATTERN is a regular expression matching a program name,
9621 VAL is a coding system, a cons of coding systems, or a function symbol.
9622 If VAL is a coding system, it is used for both decoding what received
9623 from the program and encoding what sent to the program.
9624 If VAL is a cons of coding systems, the car part is used for decoding,
9625 and the cdr part is used for encoding.
9626 If VAL is a function symbol, the function must return a coding system
9627 or a cons of coding systems which are used as above.
9628
9629 See also the function `find-operation-coding-system'. */);
9630 Vprocess_coding_system_alist = Qnil;
9631
9632 DEFVAR_LISP ("network-coding-system-alist", &Vnetwork_coding_system_alist,
9633 doc: /*
9634 Alist to decide a coding system to use for a network I/O operation.
9635 The format is ((PATTERN . VAL) ...),
9636 where PATTERN is a regular expression matching a network service name
9637 or is a port number to connect to,
9638 VAL is a coding system, a cons of coding systems, or a function symbol.
9639 If VAL is a coding system, it is used for both decoding what received
9640 from the network stream and encoding what sent to the network stream.
9641 If VAL is a cons of coding systems, the car part is used for decoding,
9642 and the cdr part is used for encoding.
9643 If VAL is a function symbol, the function must return a coding system
9644 or a cons of coding systems which are used as above.
9645
9646 See also the function `find-operation-coding-system'. */);
9647 Vnetwork_coding_system_alist = Qnil;
9648
9649 DEFVAR_LISP ("locale-coding-system", &Vlocale_coding_system,
9650 doc: /* Coding system to use with system messages.
9651 Also used for decoding keyboard input on X Window system. */);
9652 Vlocale_coding_system = Qnil;
9653
9654 /* The eol mnemonics are reset in startup.el system-dependently. */
9655 DEFVAR_LISP ("eol-mnemonic-unix", &eol_mnemonic_unix,
9656 doc: /*
9657 *String displayed in mode line for UNIX-like (LF) end-of-line format. */);
9658 eol_mnemonic_unix = build_string (":");
9659
9660 DEFVAR_LISP ("eol-mnemonic-dos", &eol_mnemonic_dos,
9661 doc: /*
9662 *String displayed in mode line for DOS-like (CRLF) end-of-line format. */);
9663 eol_mnemonic_dos = build_string ("\\");
9664
9665 DEFVAR_LISP ("eol-mnemonic-mac", &eol_mnemonic_mac,
9666 doc: /*
9667 *String displayed in mode line for MAC-like (CR) end-of-line format. */);
9668 eol_mnemonic_mac = build_string ("/");
9669
9670 DEFVAR_LISP ("eol-mnemonic-undecided", &eol_mnemonic_undecided,
9671 doc: /*
9672 *String displayed in mode line when end-of-line format is not yet determined. */);
9673 eol_mnemonic_undecided = build_string (":");
9674
9675 DEFVAR_LISP ("enable-character-translation", &Venable_character_translation,
9676 doc: /*
9677 *Non-nil enables character translation while encoding and decoding. */);
9678 Venable_character_translation = Qt;
9679
9680 DEFVAR_LISP ("standard-translation-table-for-decode",
9681 &Vstandard_translation_table_for_decode,
9682 doc: /* Table for translating characters while decoding. */);
9683 Vstandard_translation_table_for_decode = Qnil;
9684
9685 DEFVAR_LISP ("standard-translation-table-for-encode",
9686 &Vstandard_translation_table_for_encode,
9687 doc: /* Table for translating characters while encoding. */);
9688 Vstandard_translation_table_for_encode = Qnil;
9689
9690 DEFVAR_LISP ("charset-revision-table", &Vcharset_revision_table,
9691 doc: /* Alist of charsets vs revision numbers.
9692 While encoding, if a charset (car part of an element) is found,
9693 designate it with the escape sequence identifying revision (cdr part
9694 of the element). */);
9695 Vcharset_revision_table = Qnil;
9696
9697 DEFVAR_LISP ("default-process-coding-system",
9698 &Vdefault_process_coding_system,
9699 doc: /* Cons of coding systems used for process I/O by default.
9700 The car part is used for decoding a process output,
9701 the cdr part is used for encoding a text to be sent to a process. */);
9702 Vdefault_process_coding_system = Qnil;
9703
9704 DEFVAR_LISP ("latin-extra-code-table", &Vlatin_extra_code_table,
9705 doc: /*
9706 Table of extra Latin codes in the range 128..159 (inclusive).
9707 This is a vector of length 256.
9708 If Nth element is non-nil, the existence of code N in a file
9709 \(or output of subprocess) doesn't prevent it to be detected as
9710 a coding system of ISO 2022 variant which has a flag
9711 `accept-latin-extra-code' t (e.g. iso-latin-1) on reading a file
9712 or reading output of a subprocess.
9713 Only 128th through 159th elements has a meaning. */);
9714 Vlatin_extra_code_table = Fmake_vector (make_number (256), Qnil);
9715
9716 DEFVAR_LISP ("select-safe-coding-system-function",
9717 &Vselect_safe_coding_system_function,
9718 doc: /*
9719 Function to call to select safe coding system for encoding a text.
9720
9721 If set, this function is called to force a user to select a proper
9722 coding system which can encode the text in the case that a default
9723 coding system used in each operation can't encode the text.
9724
9725 The default value is `select-safe-coding-system' (which see). */);
9726 Vselect_safe_coding_system_function = Qnil;
9727
9728 DEFVAR_BOOL ("coding-system-require-warning",
9729 &coding_system_require_warning,
9730 doc: /* Internal use only.
9731 If non-nil, on writing a file, `select-safe-coding-system-function' is
9732 called even if `coding-system-for-write' is non-nil. The command
9733 `universal-coding-system-argument' binds this variable to t temporarily. */);
9734 coding_system_require_warning = 0;
9735
9736
9737 DEFVAR_BOOL ("inhibit-iso-escape-detection",
9738 &inhibit_iso_escape_detection,
9739 doc: /*
9740 If non-nil, Emacs ignores ISO2022's escape sequence on code detection.
9741
9742 By default, on reading a file, Emacs tries to detect how the text is
9743 encoded. This code detection is sensitive to escape sequences. If
9744 the sequence is valid as ISO2022, the code is determined as one of
9745 the ISO2022 encodings, and the file is decoded by the corresponding
9746 coding system (e.g. `iso-2022-7bit').
9747
9748 However, there may be a case that you want to read escape sequences in
9749 a file as is. In such a case, you can set this variable to non-nil.
9750 Then, as the code detection ignores any escape sequences, no file is
9751 detected as encoded in some ISO2022 encoding. The result is that all
9752 escape sequences become visible in a buffer.
9753
9754 The default value is nil, and it is strongly recommended not to change
9755 it. That is because many Emacs Lisp source files that contain
9756 non-ASCII characters are encoded by the coding system `iso-2022-7bit'
9757 in Emacs's distribution, and they won't be decoded correctly on
9758 reading if you suppress escape sequence detection.
9759
9760 The other way to read escape sequences in a file without decoding is
9761 to explicitly specify some coding system that doesn't use ISO2022's
9762 escape sequence (e.g `latin-1') on reading by \\[universal-coding-system-argument]. */);
9763 inhibit_iso_escape_detection = 0;
9764
9765 DEFVAR_LISP ("translation-table-for-input", &Vtranslation_table_for_input,
9766 doc: /* Char table for translating self-inserting characters.
9767 This is applied to the result of input methods, not their input. See also
9768 `keyboard-translate-table'. */);
9769 Vtranslation_table_for_input = Qnil;
9770
9771 {
9772 Lisp_Object args[coding_arg_max];
9773 Lisp_Object plist[16];
9774 int i;
9775
9776 for (i = 0; i < coding_arg_max; i++)
9777 args[i] = Qnil;
9778
9779 plist[0] = intern (":name");
9780 plist[1] = args[coding_arg_name] = Qno_conversion;
9781 plist[2] = intern (":mnemonic");
9782 plist[3] = args[coding_arg_mnemonic] = make_number ('=');
9783 plist[4] = intern (":coding-type");
9784 plist[5] = args[coding_arg_coding_type] = Qraw_text;
9785 plist[6] = intern (":ascii-compatible-p");
9786 plist[7] = args[coding_arg_ascii_compatible_p] = Qt;
9787 plist[8] = intern (":default-char");
9788 plist[9] = args[coding_arg_default_char] = make_number (0);
9789 plist[10] = intern (":for-unibyte");
9790 plist[11] = args[coding_arg_for_unibyte] = Qt;
9791 plist[12] = intern (":docstring");
9792 plist[13] = build_string ("Do no conversion.\n\
9793 \n\
9794 When you visit a file with this coding, the file is read into a\n\
9795 unibyte buffer as is, thus each byte of a file is treated as a\n\
9796 character.");
9797 plist[14] = intern (":eol-type");
9798 plist[15] = args[coding_arg_eol_type] = Qunix;
9799 args[coding_arg_plist] = Flist (16, plist);
9800 Fdefine_coding_system_internal (coding_arg_max, args);
9801
9802 plist[1] = args[coding_arg_name] = Qundecided;
9803 plist[3] = args[coding_arg_mnemonic] = make_number ('-');
9804 plist[5] = args[coding_arg_coding_type] = Qundecided;
9805 /* This is already set.
9806 plist[7] = args[coding_arg_ascii_compatible_p] = Qt; */
9807 plist[8] = intern (":charset-list");
9808 plist[9] = args[coding_arg_charset_list] = Fcons (Qascii, Qnil);
9809 plist[11] = args[coding_arg_for_unibyte] = Qnil;
9810 plist[13] = build_string ("No conversion on encoding, automatic conversion on decoding.");
9811 plist[15] = args[coding_arg_eol_type] = Qnil;
9812 args[coding_arg_plist] = Flist (16, plist);
9813 Fdefine_coding_system_internal (coding_arg_max, args);
9814 }
9815
9816 setup_coding_system (Qno_conversion, &keyboard_coding);
9817 setup_coding_system (Qundecided, &terminal_coding);
9818 setup_coding_system (Qno_conversion, &safe_terminal_coding);
9819
9820 {
9821 int i;
9822
9823 for (i = 0; i < coding_category_max; i++)
9824 Fset (AREF (Vcoding_category_table, i), Qno_conversion);
9825 }
9826 #if defined (MSDOS) || defined (WINDOWSNT)
9827 system_eol_type = Qdos;
9828 #else
9829 system_eol_type = Qunix;
9830 #endif
9831 staticpro (&system_eol_type);
9832 }
9833
9834 char *
9835 emacs_strerror (error_number)
9836 int error_number;
9837 {
9838 char *str;
9839
9840 synchronize_system_messages_locale ();
9841 str = strerror (error_number);
9842
9843 if (! NILP (Vlocale_coding_system))
9844 {
9845 Lisp_Object dec = code_convert_string_norecord (build_string (str),
9846 Vlocale_coding_system,
9847 0);
9848 str = (char *) SDATA (dec);
9849 }
9850
9851 return str;
9852 }
9853
9854 #endif /* emacs */
9855
9856 /* arch-tag: 3a3a2b01-5ff6-4071-9afe-f5b808d9229d
9857 (do not change this comment) */