Merge from emacs--devo--0
[bpt/emacs.git] / 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 3, 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 #include "frame.h"
304 #include "termhooks.h"
305
306 Lisp_Object Vcoding_system_hash_table;
307
308 Lisp_Object Qcoding_system, Qcoding_aliases, Qeol_type;
309 Lisp_Object Qunix, Qdos;
310 extern Lisp_Object Qmac; /* frame.c */
311 Lisp_Object Qbuffer_file_coding_system;
312 Lisp_Object Qpost_read_conversion, Qpre_write_conversion;
313 Lisp_Object Qdefault_char;
314 Lisp_Object Qno_conversion, Qundecided;
315 Lisp_Object Qcharset, Qiso_2022, Qutf_8, Qutf_16, Qshift_jis, Qbig5;
316 Lisp_Object Qbig, Qlittle;
317 Lisp_Object Qcoding_system_history;
318 Lisp_Object Qvalid_codes;
319 Lisp_Object QCcategory, QCmnemonic, QCdefalut_char;
320 Lisp_Object QCdecode_translation_table, QCencode_translation_table;
321 Lisp_Object QCpost_read_conversion, QCpre_write_conversion;
322 Lisp_Object QCascii_compatible_p;
323
324 extern Lisp_Object Qinsert_file_contents, Qwrite_region;
325 Lisp_Object Qcall_process, Qcall_process_region;
326 Lisp_Object Qstart_process, Qopen_network_stream;
327 Lisp_Object Qtarget_idx;
328
329 Lisp_Object Qinsufficient_source, Qinconsistent_eol, Qinvalid_source;
330 Lisp_Object Qinterrupted, Qinsufficient_memory;
331
332 /* If a symbol has this property, evaluate the value to define the
333 symbol as a coding system. */
334 static Lisp_Object Qcoding_system_define_form;
335
336 int coding_system_require_warning;
337
338 Lisp_Object Vselect_safe_coding_system_function;
339
340 /* Mnemonic string for each format of end-of-line. */
341 Lisp_Object eol_mnemonic_unix, eol_mnemonic_dos, eol_mnemonic_mac;
342 /* Mnemonic string to indicate format of end-of-line is not yet
343 decided. */
344 Lisp_Object eol_mnemonic_undecided;
345
346 /* Format of end-of-line decided by system. This is Qunix on
347 Unix and Mac, Qdos on DOS/Windows.
348 This has an effect only for external encoding (i.e. for output to
349 file and process), not for in-buffer or Lisp string encoding. */
350 static Lisp_Object system_eol_type;
351
352 #ifdef emacs
353
354 Lisp_Object Vcoding_system_list, Vcoding_system_alist;
355
356 Lisp_Object Qcoding_system_p, Qcoding_system_error;
357
358 /* Coding system emacs-mule and raw-text are for converting only
359 end-of-line format. */
360 Lisp_Object Qemacs_mule, Qraw_text;
361 Lisp_Object Qutf_8_emacs;
362
363 /* Coding-systems are handed between Emacs Lisp programs and C internal
364 routines by the following three variables. */
365 /* Coding-system for reading files and receiving data from process. */
366 Lisp_Object Vcoding_system_for_read;
367 /* Coding-system for writing files and sending data to process. */
368 Lisp_Object Vcoding_system_for_write;
369 /* Coding-system actually used in the latest I/O. */
370 Lisp_Object Vlast_coding_system_used;
371 /* Set to non-nil when an error is detected while code conversion. */
372 Lisp_Object Vlast_code_conversion_error;
373 /* A vector of length 256 which contains information about special
374 Latin codes (especially for dealing with Microsoft codes). */
375 Lisp_Object Vlatin_extra_code_table;
376
377 /* Flag to inhibit code conversion of end-of-line format. */
378 int inhibit_eol_conversion;
379
380 /* Flag to inhibit ISO2022 escape sequence detection. */
381 int inhibit_iso_escape_detection;
382
383 /* Flag to make buffer-file-coding-system inherit from process-coding. */
384 int inherit_process_coding_system;
385
386 /* Coding system to be used to encode text for terminal display when
387 terminal coding system is nil. */
388 struct coding_system safe_terminal_coding;
389
390 Lisp_Object Vfile_coding_system_alist;
391 Lisp_Object Vprocess_coding_system_alist;
392 Lisp_Object Vnetwork_coding_system_alist;
393
394 Lisp_Object Vlocale_coding_system;
395
396 #endif /* emacs */
397
398 /* Flag to tell if we look up translation table on character code
399 conversion. */
400 Lisp_Object Venable_character_translation;
401 /* Standard translation table to look up on decoding (reading). */
402 Lisp_Object Vstandard_translation_table_for_decode;
403 /* Standard translation table to look up on encoding (writing). */
404 Lisp_Object Vstandard_translation_table_for_encode;
405
406 Lisp_Object Qtranslation_table;
407 Lisp_Object Qtranslation_table_id;
408 Lisp_Object Qtranslation_table_for_decode;
409 Lisp_Object Qtranslation_table_for_encode;
410
411 /* Alist of charsets vs revision number. */
412 static Lisp_Object Vcharset_revision_table;
413
414 /* Default coding systems used for process I/O. */
415 Lisp_Object Vdefault_process_coding_system;
416
417 /* Char table for translating Quail and self-inserting input. */
418 Lisp_Object Vtranslation_table_for_input;
419
420 /* Two special coding systems. */
421 Lisp_Object Vsjis_coding_system;
422 Lisp_Object Vbig5_coding_system;
423
424 /* ISO2022 section */
425
426 #define CODING_ISO_INITIAL(coding, reg) \
427 (XINT (AREF (AREF (CODING_ID_ATTRS ((coding)->id), \
428 coding_attr_iso_initial), \
429 reg)))
430
431
432 #define CODING_ISO_REQUEST(coding, charset_id) \
433 ((charset_id <= (coding)->max_charset_id \
434 ? (coding)->safe_charsets[charset_id] \
435 : -1))
436
437
438 #define CODING_ISO_FLAGS(coding) \
439 ((coding)->spec.iso_2022.flags)
440 #define CODING_ISO_DESIGNATION(coding, reg) \
441 ((coding)->spec.iso_2022.current_designation[reg])
442 #define CODING_ISO_INVOCATION(coding, plane) \
443 ((coding)->spec.iso_2022.current_invocation[plane])
444 #define CODING_ISO_SINGLE_SHIFTING(coding) \
445 ((coding)->spec.iso_2022.single_shifting)
446 #define CODING_ISO_BOL(coding) \
447 ((coding)->spec.iso_2022.bol)
448 #define CODING_ISO_INVOKED_CHARSET(coding, plane) \
449 CODING_ISO_DESIGNATION ((coding), CODING_ISO_INVOCATION ((coding), (plane)))
450
451 /* Control characters of ISO2022. */
452 /* code */ /* function */
453 #define ISO_CODE_LF 0x0A /* line-feed */
454 #define ISO_CODE_CR 0x0D /* carriage-return */
455 #define ISO_CODE_SO 0x0E /* shift-out */
456 #define ISO_CODE_SI 0x0F /* shift-in */
457 #define ISO_CODE_SS2_7 0x19 /* single-shift-2 for 7-bit code */
458 #define ISO_CODE_ESC 0x1B /* escape */
459 #define ISO_CODE_SS2 0x8E /* single-shift-2 */
460 #define ISO_CODE_SS3 0x8F /* single-shift-3 */
461 #define ISO_CODE_CSI 0x9B /* control-sequence-introducer */
462
463 /* All code (1-byte) of ISO2022 is classified into one of the
464 followings. */
465 enum iso_code_class_type
466 {
467 ISO_control_0, /* Control codes in the range
468 0x00..0x1F and 0x7F, except for the
469 following 5 codes. */
470 ISO_shift_out, /* ISO_CODE_SO (0x0E) */
471 ISO_shift_in, /* ISO_CODE_SI (0x0F) */
472 ISO_single_shift_2_7, /* ISO_CODE_SS2_7 (0x19) */
473 ISO_escape, /* ISO_CODE_SO (0x1B) */
474 ISO_control_1, /* Control codes in the range
475 0x80..0x9F, except for the
476 following 3 codes. */
477 ISO_single_shift_2, /* ISO_CODE_SS2 (0x8E) */
478 ISO_single_shift_3, /* ISO_CODE_SS3 (0x8F) */
479 ISO_control_sequence_introducer, /* ISO_CODE_CSI (0x9B) */
480 ISO_0x20_or_0x7F, /* Codes of the values 0x20 or 0x7F. */
481 ISO_graphic_plane_0, /* Graphic codes in the range 0x21..0x7E. */
482 ISO_0xA0_or_0xFF, /* Codes of the values 0xA0 or 0xFF. */
483 ISO_graphic_plane_1 /* Graphic codes in the range 0xA1..0xFE. */
484 };
485
486 /** The macros CODING_ISO_FLAG_XXX defines a flag bit of the
487 `iso-flags' attribute of an iso2022 coding system. */
488
489 /* If set, produce long-form designation sequence (e.g. ESC $ ( A)
490 instead of the correct short-form sequence (e.g. ESC $ A). */
491 #define CODING_ISO_FLAG_LONG_FORM 0x0001
492
493 /* If set, reset graphic planes and registers at end-of-line to the
494 initial state. */
495 #define CODING_ISO_FLAG_RESET_AT_EOL 0x0002
496
497 /* If set, reset graphic planes and registers before any control
498 characters to the initial state. */
499 #define CODING_ISO_FLAG_RESET_AT_CNTL 0x0004
500
501 /* If set, encode by 7-bit environment. */
502 #define CODING_ISO_FLAG_SEVEN_BITS 0x0008
503
504 /* If set, use locking-shift function. */
505 #define CODING_ISO_FLAG_LOCKING_SHIFT 0x0010
506
507 /* If set, use single-shift function. Overwrite
508 CODING_ISO_FLAG_LOCKING_SHIFT. */
509 #define CODING_ISO_FLAG_SINGLE_SHIFT 0x0020
510
511 /* If set, use designation escape sequence. */
512 #define CODING_ISO_FLAG_DESIGNATION 0x0040
513
514 /* If set, produce revision number sequence. */
515 #define CODING_ISO_FLAG_REVISION 0x0080
516
517 /* If set, produce ISO6429's direction specifying sequence. */
518 #define CODING_ISO_FLAG_DIRECTION 0x0100
519
520 /* If set, assume designation states are reset at beginning of line on
521 output. */
522 #define CODING_ISO_FLAG_INIT_AT_BOL 0x0200
523
524 /* If set, designation sequence should be placed at beginning of line
525 on output. */
526 #define CODING_ISO_FLAG_DESIGNATE_AT_BOL 0x0400
527
528 /* If set, do not encode unsafe charactes on output. */
529 #define CODING_ISO_FLAG_SAFE 0x0800
530
531 /* If set, extra latin codes (128..159) are accepted as a valid code
532 on input. */
533 #define CODING_ISO_FLAG_LATIN_EXTRA 0x1000
534
535 #define CODING_ISO_FLAG_COMPOSITION 0x2000
536
537 #define CODING_ISO_FLAG_EUC_TW_SHIFT 0x4000
538
539 #define CODING_ISO_FLAG_USE_ROMAN 0x8000
540
541 #define CODING_ISO_FLAG_USE_OLDJIS 0x10000
542
543 #define CODING_ISO_FLAG_FULL_SUPPORT 0x100000
544
545 /* A character to be produced on output if encoding of the original
546 character is prohibited by CODING_ISO_FLAG_SAFE. */
547 #define CODING_INHIBIT_CHARACTER_SUBSTITUTION '?'
548
549
550 /* UTF-16 section */
551 #define CODING_UTF_16_BOM(coding) \
552 ((coding)->spec.utf_16.bom)
553
554 #define CODING_UTF_16_ENDIAN(coding) \
555 ((coding)->spec.utf_16.endian)
556
557 #define CODING_UTF_16_SURROGATE(coding) \
558 ((coding)->spec.utf_16.surrogate)
559
560
561 /* CCL section */
562 #define CODING_CCL_DECODER(coding) \
563 AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_decoder)
564 #define CODING_CCL_ENCODER(coding) \
565 AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_encoder)
566 #define CODING_CCL_VALIDS(coding) \
567 (SDATA (AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_valids)))
568
569 /* Index for each coding category in `coding_categories' */
570
571 enum coding_category
572 {
573 coding_category_iso_7,
574 coding_category_iso_7_tight,
575 coding_category_iso_8_1,
576 coding_category_iso_8_2,
577 coding_category_iso_7_else,
578 coding_category_iso_8_else,
579 coding_category_utf_8,
580 coding_category_utf_16_auto,
581 coding_category_utf_16_be,
582 coding_category_utf_16_le,
583 coding_category_utf_16_be_nosig,
584 coding_category_utf_16_le_nosig,
585 coding_category_charset,
586 coding_category_sjis,
587 coding_category_big5,
588 coding_category_ccl,
589 coding_category_emacs_mule,
590 /* All above are targets of code detection. */
591 coding_category_raw_text,
592 coding_category_undecided,
593 coding_category_max
594 };
595
596 /* Definitions of flag bits used in detect_coding_XXXX. */
597 #define CATEGORY_MASK_ISO_7 (1 << coding_category_iso_7)
598 #define CATEGORY_MASK_ISO_7_TIGHT (1 << coding_category_iso_7_tight)
599 #define CATEGORY_MASK_ISO_8_1 (1 << coding_category_iso_8_1)
600 #define CATEGORY_MASK_ISO_8_2 (1 << coding_category_iso_8_2)
601 #define CATEGORY_MASK_ISO_7_ELSE (1 << coding_category_iso_7_else)
602 #define CATEGORY_MASK_ISO_8_ELSE (1 << coding_category_iso_8_else)
603 #define CATEGORY_MASK_UTF_8 (1 << coding_category_utf_8)
604 #define CATEGORY_MASK_UTF_16_AUTO (1 << coding_category_utf_16_auto)
605 #define CATEGORY_MASK_UTF_16_BE (1 << coding_category_utf_16_be)
606 #define CATEGORY_MASK_UTF_16_LE (1 << coding_category_utf_16_le)
607 #define CATEGORY_MASK_UTF_16_BE_NOSIG (1 << coding_category_utf_16_be_nosig)
608 #define CATEGORY_MASK_UTF_16_LE_NOSIG (1 << coding_category_utf_16_le_nosig)
609 #define CATEGORY_MASK_CHARSET (1 << coding_category_charset)
610 #define CATEGORY_MASK_SJIS (1 << coding_category_sjis)
611 #define CATEGORY_MASK_BIG5 (1 << coding_category_big5)
612 #define CATEGORY_MASK_CCL (1 << coding_category_ccl)
613 #define CATEGORY_MASK_EMACS_MULE (1 << coding_category_emacs_mule)
614 #define CATEGORY_MASK_RAW_TEXT (1 << coding_category_raw_text)
615
616 /* This value is returned if detect_coding_mask () find nothing other
617 than ASCII characters. */
618 #define CATEGORY_MASK_ANY \
619 (CATEGORY_MASK_ISO_7 \
620 | CATEGORY_MASK_ISO_7_TIGHT \
621 | CATEGORY_MASK_ISO_8_1 \
622 | CATEGORY_MASK_ISO_8_2 \
623 | CATEGORY_MASK_ISO_7_ELSE \
624 | CATEGORY_MASK_ISO_8_ELSE \
625 | CATEGORY_MASK_UTF_8 \
626 | CATEGORY_MASK_UTF_16_BE \
627 | CATEGORY_MASK_UTF_16_LE \
628 | CATEGORY_MASK_UTF_16_BE_NOSIG \
629 | CATEGORY_MASK_UTF_16_LE_NOSIG \
630 | CATEGORY_MASK_CHARSET \
631 | CATEGORY_MASK_SJIS \
632 | CATEGORY_MASK_BIG5 \
633 | CATEGORY_MASK_CCL \
634 | CATEGORY_MASK_EMACS_MULE)
635
636
637 #define CATEGORY_MASK_ISO_7BIT \
638 (CATEGORY_MASK_ISO_7 | CATEGORY_MASK_ISO_7_TIGHT)
639
640 #define CATEGORY_MASK_ISO_8BIT \
641 (CATEGORY_MASK_ISO_8_1 | CATEGORY_MASK_ISO_8_2)
642
643 #define CATEGORY_MASK_ISO_ELSE \
644 (CATEGORY_MASK_ISO_7_ELSE | CATEGORY_MASK_ISO_8_ELSE)
645
646 #define CATEGORY_MASK_ISO_ESCAPE \
647 (CATEGORY_MASK_ISO_7 \
648 | CATEGORY_MASK_ISO_7_TIGHT \
649 | CATEGORY_MASK_ISO_7_ELSE \
650 | CATEGORY_MASK_ISO_8_ELSE)
651
652 #define CATEGORY_MASK_ISO \
653 ( CATEGORY_MASK_ISO_7BIT \
654 | CATEGORY_MASK_ISO_8BIT \
655 | CATEGORY_MASK_ISO_ELSE)
656
657 #define CATEGORY_MASK_UTF_16 \
658 (CATEGORY_MASK_UTF_16_BE \
659 | CATEGORY_MASK_UTF_16_LE \
660 | CATEGORY_MASK_UTF_16_BE_NOSIG \
661 | CATEGORY_MASK_UTF_16_LE_NOSIG)
662
663
664 /* List of symbols `coding-category-xxx' ordered by priority. This
665 variable is exposed to Emacs Lisp. */
666 static Lisp_Object Vcoding_category_list;
667
668 /* Table of coding categories (Lisp symbols). This variable is for
669 internal use oly. */
670 static Lisp_Object Vcoding_category_table;
671
672 /* Table of coding-categories ordered by priority. */
673 static enum coding_category coding_priorities[coding_category_max];
674
675 /* Nth element is a coding context for the coding system bound to the
676 Nth coding category. */
677 static struct coding_system coding_categories[coding_category_max];
678
679 /*** Commonly used macros and functions ***/
680
681 #ifndef min
682 #define min(a, b) ((a) < (b) ? (a) : (b))
683 #endif
684 #ifndef max
685 #define max(a, b) ((a) > (b) ? (a) : (b))
686 #endif
687
688 #define CODING_GET_INFO(coding, attrs, charset_list) \
689 do { \
690 (attrs) = CODING_ID_ATTRS ((coding)->id); \
691 (charset_list) = CODING_ATTR_CHARSET_LIST (attrs); \
692 } while (0)
693
694
695 /* Safely get one byte from the source text pointed by SRC which ends
696 at SRC_END, and set C to that byte. If there are not enough bytes
697 in the source, it jumps to `no_more_source'. If multibytep is
698 nonzero, and a multibyte character is found at SRC, set C to the
699 negative value of the character code. The caller should declare
700 and set these variables appropriately in advance:
701 src, src_end, multibytep */
702
703 #define ONE_MORE_BYTE(c) \
704 do { \
705 if (src == src_end) \
706 { \
707 if (src_base < src) \
708 record_conversion_result \
709 (coding, CODING_RESULT_INSUFFICIENT_SRC); \
710 goto no_more_source; \
711 } \
712 c = *src++; \
713 if (multibytep && (c & 0x80)) \
714 { \
715 if ((c & 0xFE) == 0xC0) \
716 c = ((c & 1) << 6) | *src++; \
717 else \
718 { \
719 src--; \
720 c = - string_char (src, &src, NULL); \
721 record_conversion_result \
722 (coding, CODING_RESULT_INVALID_SRC); \
723 } \
724 } \
725 consumed_chars++; \
726 } while (0)
727
728
729 #define ONE_MORE_BYTE_NO_CHECK(c) \
730 do { \
731 c = *src++; \
732 if (multibytep && (c & 0x80)) \
733 { \
734 if ((c & 0xFE) == 0xC0) \
735 c = ((c & 1) << 6) | *src++; \
736 else \
737 { \
738 src--; \
739 c = - string_char (src, &src, NULL); \
740 record_conversion_result \
741 (coding, CODING_RESULT_INVALID_SRC); \
742 } \
743 } \
744 consumed_chars++; \
745 } while (0)
746
747
748 /* Store a byte C in the place pointed by DST and increment DST to the
749 next free point, and increment PRODUCED_CHARS. The caller should
750 assure that C is 0..127, and declare and set the variable `dst'
751 appropriately in advance.
752 */
753
754
755 #define EMIT_ONE_ASCII_BYTE(c) \
756 do { \
757 produced_chars++; \
758 *dst++ = (c); \
759 } while (0)
760
761
762 /* Like EMIT_ONE_ASCII_BYTE byt store two bytes; C1 and C2. */
763
764 #define EMIT_TWO_ASCII_BYTES(c1, c2) \
765 do { \
766 produced_chars += 2; \
767 *dst++ = (c1), *dst++ = (c2); \
768 } while (0)
769
770
771 /* Store a byte C in the place pointed by DST and increment DST to the
772 next free point, and increment PRODUCED_CHARS. If MULTIBYTEP is
773 nonzero, store in an appropriate multibyte from. The caller should
774 declare and set the variables `dst' and `multibytep' appropriately
775 in advance. */
776
777 #define EMIT_ONE_BYTE(c) \
778 do { \
779 produced_chars++; \
780 if (multibytep) \
781 { \
782 int ch = (c); \
783 if (ch >= 0x80) \
784 ch = BYTE8_TO_CHAR (ch); \
785 CHAR_STRING_ADVANCE (ch, dst); \
786 } \
787 else \
788 *dst++ = (c); \
789 } while (0)
790
791
792 /* Like EMIT_ONE_BYTE, but emit two bytes; C1 and C2. */
793
794 #define EMIT_TWO_BYTES(c1, c2) \
795 do { \
796 produced_chars += 2; \
797 if (multibytep) \
798 { \
799 int ch; \
800 \
801 ch = (c1); \
802 if (ch >= 0x80) \
803 ch = BYTE8_TO_CHAR (ch); \
804 CHAR_STRING_ADVANCE (ch, dst); \
805 ch = (c2); \
806 if (ch >= 0x80) \
807 ch = BYTE8_TO_CHAR (ch); \
808 CHAR_STRING_ADVANCE (ch, dst); \
809 } \
810 else \
811 { \
812 *dst++ = (c1); \
813 *dst++ = (c2); \
814 } \
815 } while (0)
816
817
818 #define EMIT_THREE_BYTES(c1, c2, c3) \
819 do { \
820 EMIT_ONE_BYTE (c1); \
821 EMIT_TWO_BYTES (c2, c3); \
822 } while (0)
823
824
825 #define EMIT_FOUR_BYTES(c1, c2, c3, c4) \
826 do { \
827 EMIT_TWO_BYTES (c1, c2); \
828 EMIT_TWO_BYTES (c3, c4); \
829 } while (0)
830
831
832 /* Prototypes for static functions. */
833 static void record_conversion_result P_ ((struct coding_system *coding,
834 enum coding_result_code result));
835 static int detect_coding_utf_8 P_ ((struct coding_system *,
836 struct coding_detection_info *info));
837 static void decode_coding_utf_8 P_ ((struct coding_system *));
838 static int encode_coding_utf_8 P_ ((struct coding_system *));
839
840 static int detect_coding_utf_16 P_ ((struct coding_system *,
841 struct coding_detection_info *info));
842 static void decode_coding_utf_16 P_ ((struct coding_system *));
843 static int encode_coding_utf_16 P_ ((struct coding_system *));
844
845 static int detect_coding_iso_2022 P_ ((struct coding_system *,
846 struct coding_detection_info *info));
847 static void decode_coding_iso_2022 P_ ((struct coding_system *));
848 static int encode_coding_iso_2022 P_ ((struct coding_system *));
849
850 static int detect_coding_emacs_mule P_ ((struct coding_system *,
851 struct coding_detection_info *info));
852 static void decode_coding_emacs_mule P_ ((struct coding_system *));
853 static int encode_coding_emacs_mule P_ ((struct coding_system *));
854
855 static int detect_coding_sjis P_ ((struct coding_system *,
856 struct coding_detection_info *info));
857 static void decode_coding_sjis P_ ((struct coding_system *));
858 static int encode_coding_sjis P_ ((struct coding_system *));
859
860 static int detect_coding_big5 P_ ((struct coding_system *,
861 struct coding_detection_info *info));
862 static void decode_coding_big5 P_ ((struct coding_system *));
863 static int encode_coding_big5 P_ ((struct coding_system *));
864
865 static int detect_coding_ccl P_ ((struct coding_system *,
866 struct coding_detection_info *info));
867 static void decode_coding_ccl P_ ((struct coding_system *));
868 static int encode_coding_ccl P_ ((struct coding_system *));
869
870 static void decode_coding_raw_text P_ ((struct coding_system *));
871 static int encode_coding_raw_text P_ ((struct coding_system *));
872
873 static void coding_set_source P_ ((struct coding_system *));
874 static void coding_set_destination P_ ((struct coding_system *));
875 static void coding_alloc_by_realloc P_ ((struct coding_system *, EMACS_INT));
876 static void coding_alloc_by_making_gap P_ ((struct coding_system *,
877 EMACS_INT, EMACS_INT));
878 static unsigned char *alloc_destination P_ ((struct coding_system *,
879 EMACS_INT, unsigned char *));
880 static void setup_iso_safe_charsets P_ ((Lisp_Object));
881 static unsigned char *encode_designation_at_bol P_ ((struct coding_system *,
882 int *, int *,
883 unsigned char *));
884 static int detect_eol P_ ((const unsigned char *,
885 EMACS_INT, enum coding_category));
886 static Lisp_Object adjust_coding_eol_type P_ ((struct coding_system *, int));
887 static void decode_eol P_ ((struct coding_system *));
888 static Lisp_Object get_translation_table P_ ((Lisp_Object, int, int *));
889 static Lisp_Object get_translation P_ ((Lisp_Object, int *, int *,
890 int, int *, int *));
891 static int produce_chars P_ ((struct coding_system *, Lisp_Object, int));
892 static INLINE void produce_composition P_ ((struct coding_system *, int *,
893 EMACS_INT));
894 static INLINE void produce_charset P_ ((struct coding_system *, int *,
895 EMACS_INT));
896 static void produce_annotation P_ ((struct coding_system *, EMACS_INT));
897 static int decode_coding P_ ((struct coding_system *));
898 static INLINE int *handle_composition_annotation P_ ((EMACS_INT, EMACS_INT,
899 struct coding_system *,
900 int *, EMACS_INT *));
901 static INLINE int *handle_charset_annotation P_ ((EMACS_INT, EMACS_INT,
902 struct coding_system *,
903 int *, EMACS_INT *));
904 static void consume_chars P_ ((struct coding_system *, Lisp_Object, int));
905 static int encode_coding P_ ((struct coding_system *));
906 static Lisp_Object make_conversion_work_buffer P_ ((int));
907 static Lisp_Object code_conversion_restore P_ ((Lisp_Object));
908 static INLINE int char_encodable_p P_ ((int, Lisp_Object));
909 static Lisp_Object make_subsidiaries P_ ((Lisp_Object));
910
911 static void
912 record_conversion_result (struct coding_system *coding,
913 enum coding_result_code result)
914 {
915 coding->result = result;
916 switch (result)
917 {
918 case CODING_RESULT_INSUFFICIENT_SRC:
919 Vlast_code_conversion_error = Qinsufficient_source;
920 break;
921 case CODING_RESULT_INCONSISTENT_EOL:
922 Vlast_code_conversion_error = Qinconsistent_eol;
923 break;
924 case CODING_RESULT_INVALID_SRC:
925 Vlast_code_conversion_error = Qinvalid_source;
926 break;
927 case CODING_RESULT_INTERRUPT:
928 Vlast_code_conversion_error = Qinterrupted;
929 break;
930 case CODING_RESULT_INSUFFICIENT_MEM:
931 Vlast_code_conversion_error = Qinsufficient_memory;
932 break;
933 default:
934 Vlast_code_conversion_error = intern ("Unknown error");
935 }
936 }
937
938 #define CODING_DECODE_CHAR(coding, src, src_base, src_end, charset, code, c) \
939 do { \
940 charset_map_loaded = 0; \
941 c = DECODE_CHAR (charset, code); \
942 if (charset_map_loaded) \
943 { \
944 const unsigned char *orig = coding->source; \
945 EMACS_INT offset; \
946 \
947 coding_set_source (coding); \
948 offset = coding->source - orig; \
949 src += offset; \
950 src_base += offset; \
951 src_end += offset; \
952 } \
953 } while (0)
954
955
956 #define ASSURE_DESTINATION(bytes) \
957 do { \
958 if (dst + (bytes) >= dst_end) \
959 { \
960 int more_bytes = charbuf_end - charbuf + (bytes); \
961 \
962 dst = alloc_destination (coding, more_bytes, dst); \
963 dst_end = coding->destination + coding->dst_bytes; \
964 } \
965 } while (0)
966
967
968
969 static void
970 coding_set_source (coding)
971 struct coding_system *coding;
972 {
973 if (BUFFERP (coding->src_object))
974 {
975 struct buffer *buf = XBUFFER (coding->src_object);
976
977 if (coding->src_pos < 0)
978 coding->source = BUF_GAP_END_ADDR (buf) + coding->src_pos_byte;
979 else
980 coding->source = BUF_BYTE_ADDRESS (buf, coding->src_pos_byte);
981 }
982 else if (STRINGP (coding->src_object))
983 {
984 coding->source = SDATA (coding->src_object) + coding->src_pos_byte;
985 }
986 else
987 /* Otherwise, the source is C string and is never relocated
988 automatically. Thus we don't have to update anything. */
989 ;
990 }
991
992 static void
993 coding_set_destination (coding)
994 struct coding_system *coding;
995 {
996 if (BUFFERP (coding->dst_object))
997 {
998 if (coding->src_pos < 0)
999 {
1000 coding->destination = BEG_ADDR + coding->dst_pos_byte - 1;
1001 coding->dst_bytes = (GAP_END_ADDR
1002 - (coding->src_bytes - coding->consumed)
1003 - coding->destination);
1004 }
1005 else
1006 {
1007 /* We are sure that coding->dst_pos_byte is before the gap
1008 of the buffer. */
1009 coding->destination = (BUF_BEG_ADDR (XBUFFER (coding->dst_object))
1010 + coding->dst_pos_byte - 1);
1011 coding->dst_bytes = (BUF_GAP_END_ADDR (XBUFFER (coding->dst_object))
1012 - coding->destination);
1013 }
1014 }
1015 else
1016 /* Otherwise, the destination is C string and is never relocated
1017 automatically. Thus we don't have to update anything. */
1018 ;
1019 }
1020
1021
1022 static void
1023 coding_alloc_by_realloc (coding, bytes)
1024 struct coding_system *coding;
1025 EMACS_INT bytes;
1026 {
1027 coding->destination = (unsigned char *) xrealloc (coding->destination,
1028 coding->dst_bytes + bytes);
1029 coding->dst_bytes += bytes;
1030 }
1031
1032 static void
1033 coding_alloc_by_making_gap (coding, offset, bytes)
1034 struct coding_system *coding;
1035 EMACS_INT offset, bytes;
1036 {
1037 if (BUFFERP (coding->dst_object)
1038 && EQ (coding->src_object, coding->dst_object))
1039 {
1040 EMACS_INT add = offset + (coding->src_bytes - coding->consumed);
1041
1042 GPT += offset, GPT_BYTE += offset;
1043 GAP_SIZE -= add; ZV += add; Z += add; ZV_BYTE += add; Z_BYTE += add;
1044 make_gap (bytes);
1045 GAP_SIZE += add; ZV -= add; Z -= add; ZV_BYTE -= add; Z_BYTE -= add;
1046 GPT -= offset, GPT_BYTE -= offset;
1047 }
1048 else
1049 {
1050 Lisp_Object this_buffer;
1051
1052 this_buffer = Fcurrent_buffer ();
1053 set_buffer_internal (XBUFFER (coding->dst_object));
1054 make_gap (bytes);
1055 set_buffer_internal (XBUFFER (this_buffer));
1056 }
1057 }
1058
1059
1060 static unsigned char *
1061 alloc_destination (coding, nbytes, dst)
1062 struct coding_system *coding;
1063 EMACS_INT nbytes;
1064 unsigned char *dst;
1065 {
1066 EMACS_INT offset = dst - coding->destination;
1067
1068 if (BUFFERP (coding->dst_object))
1069 coding_alloc_by_making_gap (coding, offset, nbytes);
1070 else
1071 coding_alloc_by_realloc (coding, nbytes);
1072 record_conversion_result (coding, CODING_RESULT_SUCCESS);
1073 coding_set_destination (coding);
1074 dst = coding->destination + offset;
1075 return dst;
1076 }
1077
1078 /** Macros for annotations. */
1079
1080 /* Maximum length of annotation data (sum of annotations for
1081 composition and charset). */
1082 #define MAX_ANNOTATION_LENGTH (4 + (MAX_COMPOSITION_COMPONENTS * 2) - 1 + 4)
1083
1084 /* An annotation data is stored in the array coding->charbuf in this
1085 format:
1086 [ -LENGTH ANNOTATION_MASK NCHARS ... ]
1087 LENGTH is the number of elements in the annotation.
1088 ANNOTATION_MASK is one of CODING_ANNOTATE_XXX_MASK.
1089 NCHARS is the number of characters in the text annotated.
1090
1091 The format of the following elements depend on ANNOTATION_MASK.
1092
1093 In the case of CODING_ANNOTATE_COMPOSITION_MASK, these elements
1094 follows:
1095 ... METHOD [ COMPOSITION-COMPONENTS ... ]
1096 METHOD is one of enum composition_method.
1097 Optionnal COMPOSITION-COMPONENTS are characters and composition
1098 rules.
1099
1100 In the case of CODING_ANNOTATE_CHARSET_MASK, one element CHARSET-ID
1101 follows. */
1102
1103 #define ADD_ANNOTATION_DATA(buf, len, mask, nchars) \
1104 do { \
1105 *(buf)++ = -(len); \
1106 *(buf)++ = (mask); \
1107 *(buf)++ = (nchars); \
1108 coding->annotated = 1; \
1109 } while (0);
1110
1111 #define ADD_COMPOSITION_DATA(buf, nchars, method) \
1112 do { \
1113 ADD_ANNOTATION_DATA (buf, 4, CODING_ANNOTATE_COMPOSITION_MASK, nchars); \
1114 *buf++ = method; \
1115 } while (0)
1116
1117
1118 #define ADD_CHARSET_DATA(buf, nchars, id) \
1119 do { \
1120 ADD_ANNOTATION_DATA (buf, 4, CODING_ANNOTATE_CHARSET_MASK, nchars); \
1121 *buf++ = id; \
1122 } while (0)
1123
1124 \f
1125 /*** 2. Emacs' internal format (emacs-utf-8) ***/
1126
1127
1128
1129 \f
1130 /*** 3. UTF-8 ***/
1131
1132 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
1133 Check if a text is encoded in UTF-8. If it is, return 1, else
1134 return 0. */
1135
1136 #define UTF_8_1_OCTET_P(c) ((c) < 0x80)
1137 #define UTF_8_EXTRA_OCTET_P(c) (((c) & 0xC0) == 0x80)
1138 #define UTF_8_2_OCTET_LEADING_P(c) (((c) & 0xE0) == 0xC0)
1139 #define UTF_8_3_OCTET_LEADING_P(c) (((c) & 0xF0) == 0xE0)
1140 #define UTF_8_4_OCTET_LEADING_P(c) (((c) & 0xF8) == 0xF0)
1141 #define UTF_8_5_OCTET_LEADING_P(c) (((c) & 0xFC) == 0xF8)
1142
1143 static int
1144 detect_coding_utf_8 (coding, detect_info)
1145 struct coding_system *coding;
1146 struct coding_detection_info *detect_info;
1147 {
1148 const unsigned char *src = coding->source, *src_base;
1149 const unsigned char *src_end = coding->source + coding->src_bytes;
1150 int multibytep = coding->src_multibyte;
1151 int consumed_chars = 0;
1152 int found = 0;
1153
1154 detect_info->checked |= CATEGORY_MASK_UTF_8;
1155 /* A coding system of this category is always ASCII compatible. */
1156 src += coding->head_ascii;
1157
1158 while (1)
1159 {
1160 int c, c1, c2, c3, c4;
1161
1162 src_base = src;
1163 ONE_MORE_BYTE (c);
1164 if (c < 0 || UTF_8_1_OCTET_P (c))
1165 continue;
1166 ONE_MORE_BYTE (c1);
1167 if (c1 < 0 || ! UTF_8_EXTRA_OCTET_P (c1))
1168 break;
1169 if (UTF_8_2_OCTET_LEADING_P (c))
1170 {
1171 found = CATEGORY_MASK_UTF_8;
1172 continue;
1173 }
1174 ONE_MORE_BYTE (c2);
1175 if (c2 < 0 || ! UTF_8_EXTRA_OCTET_P (c2))
1176 break;
1177 if (UTF_8_3_OCTET_LEADING_P (c))
1178 {
1179 found = CATEGORY_MASK_UTF_8;
1180 continue;
1181 }
1182 ONE_MORE_BYTE (c3);
1183 if (c3 < 0 || ! UTF_8_EXTRA_OCTET_P (c3))
1184 break;
1185 if (UTF_8_4_OCTET_LEADING_P (c))
1186 {
1187 found = CATEGORY_MASK_UTF_8;
1188 continue;
1189 }
1190 ONE_MORE_BYTE (c4);
1191 if (c4 < 0 || ! UTF_8_EXTRA_OCTET_P (c4))
1192 break;
1193 if (UTF_8_5_OCTET_LEADING_P (c))
1194 {
1195 found = CATEGORY_MASK_UTF_8;
1196 continue;
1197 }
1198 break;
1199 }
1200 detect_info->rejected |= CATEGORY_MASK_UTF_8;
1201 return 0;
1202
1203 no_more_source:
1204 if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK)
1205 {
1206 detect_info->rejected |= CATEGORY_MASK_UTF_8;
1207 return 0;
1208 }
1209 detect_info->found |= found;
1210 return 1;
1211 }
1212
1213
1214 static void
1215 decode_coding_utf_8 (coding)
1216 struct coding_system *coding;
1217 {
1218 const unsigned char *src = coding->source + coding->consumed;
1219 const unsigned char *src_end = coding->source + coding->src_bytes;
1220 const unsigned char *src_base;
1221 int *charbuf = coding->charbuf + coding->charbuf_used;
1222 int *charbuf_end = coding->charbuf + coding->charbuf_size;
1223 int consumed_chars = 0, consumed_chars_base;
1224 int multibytep = coding->src_multibyte;
1225 Lisp_Object attr, charset_list;
1226
1227 CODING_GET_INFO (coding, attr, charset_list);
1228
1229 while (1)
1230 {
1231 int c, c1, c2, c3, c4, c5;
1232
1233 src_base = src;
1234 consumed_chars_base = consumed_chars;
1235
1236 if (charbuf >= charbuf_end)
1237 break;
1238
1239 ONE_MORE_BYTE (c1);
1240 if (c1 < 0)
1241 {
1242 c = - c1;
1243 }
1244 else if (UTF_8_1_OCTET_P(c1))
1245 {
1246 c = c1;
1247 }
1248 else
1249 {
1250 ONE_MORE_BYTE (c2);
1251 if (c2 < 0 || ! UTF_8_EXTRA_OCTET_P (c2))
1252 goto invalid_code;
1253 if (UTF_8_2_OCTET_LEADING_P (c1))
1254 {
1255 c = ((c1 & 0x1F) << 6) | (c2 & 0x3F);
1256 /* Reject overlong sequences here and below. Encoders
1257 producing them are incorrect, they can be misleading,
1258 and they mess up read/write invariance. */
1259 if (c < 128)
1260 goto invalid_code;
1261 }
1262 else
1263 {
1264 ONE_MORE_BYTE (c3);
1265 if (c3 < 0 || ! UTF_8_EXTRA_OCTET_P (c3))
1266 goto invalid_code;
1267 if (UTF_8_3_OCTET_LEADING_P (c1))
1268 {
1269 c = (((c1 & 0xF) << 12)
1270 | ((c2 & 0x3F) << 6) | (c3 & 0x3F));
1271 if (c < 0x800
1272 || (c >= 0xd800 && c < 0xe000)) /* surrogates (invalid) */
1273 goto invalid_code;
1274 }
1275 else
1276 {
1277 ONE_MORE_BYTE (c4);
1278 if (c4 < 0 || ! UTF_8_EXTRA_OCTET_P (c4))
1279 goto invalid_code;
1280 if (UTF_8_4_OCTET_LEADING_P (c1))
1281 {
1282 c = (((c1 & 0x7) << 18) | ((c2 & 0x3F) << 12)
1283 | ((c3 & 0x3F) << 6) | (c4 & 0x3F));
1284 if (c < 0x10000)
1285 goto invalid_code;
1286 }
1287 else
1288 {
1289 ONE_MORE_BYTE (c5);
1290 if (c5 < 0 || ! UTF_8_EXTRA_OCTET_P (c5))
1291 goto invalid_code;
1292 if (UTF_8_5_OCTET_LEADING_P (c1))
1293 {
1294 c = (((c1 & 0x3) << 24) | ((c2 & 0x3F) << 18)
1295 | ((c3 & 0x3F) << 12) | ((c4 & 0x3F) << 6)
1296 | (c5 & 0x3F));
1297 if ((c > MAX_CHAR) || (c < 0x200000))
1298 goto invalid_code;
1299 }
1300 else
1301 goto invalid_code;
1302 }
1303 }
1304 }
1305 }
1306
1307 *charbuf++ = c;
1308 continue;
1309
1310 invalid_code:
1311 src = src_base;
1312 consumed_chars = consumed_chars_base;
1313 ONE_MORE_BYTE (c);
1314 *charbuf++ = ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c);
1315 coding->errors++;
1316 }
1317
1318 no_more_source:
1319 coding->consumed_char += consumed_chars_base;
1320 coding->consumed = src_base - coding->source;
1321 coding->charbuf_used = charbuf - coding->charbuf;
1322 }
1323
1324
1325 static int
1326 encode_coding_utf_8 (coding)
1327 struct coding_system *coding;
1328 {
1329 int multibytep = coding->dst_multibyte;
1330 int *charbuf = coding->charbuf;
1331 int *charbuf_end = charbuf + coding->charbuf_used;
1332 unsigned char *dst = coding->destination + coding->produced;
1333 unsigned char *dst_end = coding->destination + coding->dst_bytes;
1334 int produced_chars = 0;
1335 int c;
1336
1337 if (multibytep)
1338 {
1339 int safe_room = MAX_MULTIBYTE_LENGTH * 2;
1340
1341 while (charbuf < charbuf_end)
1342 {
1343 unsigned char str[MAX_MULTIBYTE_LENGTH], *p, *pend = str;
1344
1345 ASSURE_DESTINATION (safe_room);
1346 c = *charbuf++;
1347 if (CHAR_BYTE8_P (c))
1348 {
1349 c = CHAR_TO_BYTE8 (c);
1350 EMIT_ONE_BYTE (c);
1351 }
1352 else
1353 {
1354 CHAR_STRING_ADVANCE (c, pend);
1355 for (p = str; p < pend; p++)
1356 EMIT_ONE_BYTE (*p);
1357 }
1358 }
1359 }
1360 else
1361 {
1362 int safe_room = MAX_MULTIBYTE_LENGTH;
1363
1364 while (charbuf < charbuf_end)
1365 {
1366 ASSURE_DESTINATION (safe_room);
1367 c = *charbuf++;
1368 if (CHAR_BYTE8_P (c))
1369 *dst++ = CHAR_TO_BYTE8 (c);
1370 else
1371 dst += CHAR_STRING (c, dst);
1372 produced_chars++;
1373 }
1374 }
1375 record_conversion_result (coding, CODING_RESULT_SUCCESS);
1376 coding->produced_char += produced_chars;
1377 coding->produced = dst - coding->destination;
1378 return 0;
1379 }
1380
1381
1382 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
1383 Check if a text is encoded in one of UTF-16 based coding systems.
1384 If it is, return 1, else return 0. */
1385
1386 #define UTF_16_HIGH_SURROGATE_P(val) \
1387 (((val) & 0xFC00) == 0xD800)
1388
1389 #define UTF_16_LOW_SURROGATE_P(val) \
1390 (((val) & 0xFC00) == 0xDC00)
1391
1392 #define UTF_16_INVALID_P(val) \
1393 (((val) == 0xFFFE) \
1394 || ((val) == 0xFFFF) \
1395 || UTF_16_LOW_SURROGATE_P (val))
1396
1397
1398 static int
1399 detect_coding_utf_16 (coding, detect_info)
1400 struct coding_system *coding;
1401 struct coding_detection_info *detect_info;
1402 {
1403 const unsigned char *src = coding->source, *src_base = src;
1404 const unsigned char *src_end = coding->source + coding->src_bytes;
1405 int multibytep = coding->src_multibyte;
1406 int consumed_chars = 0;
1407 int c1, c2;
1408
1409 detect_info->checked |= CATEGORY_MASK_UTF_16;
1410 if (coding->mode & CODING_MODE_LAST_BLOCK
1411 && (coding->src_chars & 1))
1412 {
1413 detect_info->rejected |= CATEGORY_MASK_UTF_16;
1414 return 0;
1415 }
1416
1417 ONE_MORE_BYTE (c1);
1418 ONE_MORE_BYTE (c2);
1419 if ((c1 == 0xFF) && (c2 == 0xFE))
1420 {
1421 detect_info->found |= (CATEGORY_MASK_UTF_16_LE
1422 | CATEGORY_MASK_UTF_16_AUTO);
1423 detect_info->rejected |= (CATEGORY_MASK_UTF_16_BE
1424 | CATEGORY_MASK_UTF_16_BE_NOSIG
1425 | CATEGORY_MASK_UTF_16_LE_NOSIG);
1426 }
1427 else if ((c1 == 0xFE) && (c2 == 0xFF))
1428 {
1429 detect_info->found |= (CATEGORY_MASK_UTF_16_BE
1430 | CATEGORY_MASK_UTF_16_AUTO);
1431 detect_info->rejected |= (CATEGORY_MASK_UTF_16_LE
1432 | CATEGORY_MASK_UTF_16_BE_NOSIG
1433 | CATEGORY_MASK_UTF_16_LE_NOSIG);
1434 }
1435 else if (c1 >= 0 && c2 >= 0)
1436 {
1437 detect_info->rejected
1438 |= (CATEGORY_MASK_UTF_16_BE | CATEGORY_MASK_UTF_16_LE);
1439 }
1440 no_more_source:
1441 return 1;
1442 }
1443
1444 static void
1445 decode_coding_utf_16 (coding)
1446 struct coding_system *coding;
1447 {
1448 const unsigned char *src = coding->source + coding->consumed;
1449 const unsigned char *src_end = coding->source + coding->src_bytes;
1450 const unsigned char *src_base;
1451 int *charbuf = coding->charbuf + coding->charbuf_used;
1452 int *charbuf_end = coding->charbuf + coding->charbuf_size;
1453 int consumed_chars = 0, consumed_chars_base;
1454 int multibytep = coding->src_multibyte;
1455 enum utf_16_bom_type bom = CODING_UTF_16_BOM (coding);
1456 enum utf_16_endian_type endian = CODING_UTF_16_ENDIAN (coding);
1457 int surrogate = CODING_UTF_16_SURROGATE (coding);
1458 Lisp_Object attr, charset_list;
1459
1460 CODING_GET_INFO (coding, attr, charset_list);
1461
1462 if (bom == utf_16_with_bom)
1463 {
1464 int c, c1, c2;
1465
1466 src_base = src;
1467 ONE_MORE_BYTE (c1);
1468 ONE_MORE_BYTE (c2);
1469 c = (c1 << 8) | c2;
1470
1471 if (endian == utf_16_big_endian
1472 ? c != 0xFEFF : c != 0xFFFE)
1473 {
1474 /* The first two bytes are not BOM. Treat them as bytes
1475 for a normal character. */
1476 src = src_base;
1477 coding->errors++;
1478 }
1479 CODING_UTF_16_BOM (coding) = utf_16_without_bom;
1480 }
1481 else if (bom == utf_16_detect_bom)
1482 {
1483 /* We have already tried to detect BOM and failed in
1484 detect_coding. */
1485 CODING_UTF_16_BOM (coding) = utf_16_without_bom;
1486 }
1487
1488 while (1)
1489 {
1490 int c, c1, c2;
1491
1492 src_base = src;
1493 consumed_chars_base = consumed_chars;
1494
1495 if (charbuf + 2 >= charbuf_end)
1496 break;
1497
1498 ONE_MORE_BYTE (c1);
1499 if (c1 < 0)
1500 {
1501 *charbuf++ = -c1;
1502 continue;
1503 }
1504 ONE_MORE_BYTE (c2);
1505 if (c2 < 0)
1506 {
1507 *charbuf++ = ASCII_BYTE_P (c1) ? c1 : BYTE8_TO_CHAR (c1);
1508 *charbuf++ = -c2;
1509 continue;
1510 }
1511 c = (endian == utf_16_big_endian
1512 ? ((c1 << 8) | c2) : ((c2 << 8) | c1));
1513 if (surrogate)
1514 {
1515 if (! UTF_16_LOW_SURROGATE_P (c))
1516 {
1517 if (endian == utf_16_big_endian)
1518 c1 = surrogate >> 8, c2 = surrogate & 0xFF;
1519 else
1520 c1 = surrogate & 0xFF, c2 = surrogate >> 8;
1521 *charbuf++ = c1;
1522 *charbuf++ = c2;
1523 coding->errors++;
1524 if (UTF_16_HIGH_SURROGATE_P (c))
1525 CODING_UTF_16_SURROGATE (coding) = surrogate = c;
1526 else
1527 *charbuf++ = c;
1528 }
1529 else
1530 {
1531 c = ((surrogate - 0xD800) << 10) | (c - 0xDC00);
1532 CODING_UTF_16_SURROGATE (coding) = surrogate = 0;
1533 *charbuf++ = 0x10000 + c;
1534 }
1535 }
1536 else
1537 {
1538 if (UTF_16_HIGH_SURROGATE_P (c))
1539 CODING_UTF_16_SURROGATE (coding) = surrogate = c;
1540 else
1541 *charbuf++ = c;
1542 }
1543 }
1544
1545 no_more_source:
1546 coding->consumed_char += consumed_chars_base;
1547 coding->consumed = src_base - coding->source;
1548 coding->charbuf_used = charbuf - coding->charbuf;
1549 }
1550
1551 static int
1552 encode_coding_utf_16 (coding)
1553 struct coding_system *coding;
1554 {
1555 int multibytep = coding->dst_multibyte;
1556 int *charbuf = coding->charbuf;
1557 int *charbuf_end = charbuf + coding->charbuf_used;
1558 unsigned char *dst = coding->destination + coding->produced;
1559 unsigned char *dst_end = coding->destination + coding->dst_bytes;
1560 int safe_room = 8;
1561 enum utf_16_bom_type bom = CODING_UTF_16_BOM (coding);
1562 int big_endian = CODING_UTF_16_ENDIAN (coding) == utf_16_big_endian;
1563 int produced_chars = 0;
1564 Lisp_Object attrs, charset_list;
1565 int c;
1566
1567 CODING_GET_INFO (coding, attrs, charset_list);
1568
1569 if (bom != utf_16_without_bom)
1570 {
1571 ASSURE_DESTINATION (safe_room);
1572 if (big_endian)
1573 EMIT_TWO_BYTES (0xFE, 0xFF);
1574 else
1575 EMIT_TWO_BYTES (0xFF, 0xFE);
1576 CODING_UTF_16_BOM (coding) = utf_16_without_bom;
1577 }
1578
1579 while (charbuf < charbuf_end)
1580 {
1581 ASSURE_DESTINATION (safe_room);
1582 c = *charbuf++;
1583 if (c >= MAX_UNICODE_CHAR)
1584 c = coding->default_char;
1585
1586 if (c < 0x10000)
1587 {
1588 if (big_endian)
1589 EMIT_TWO_BYTES (c >> 8, c & 0xFF);
1590 else
1591 EMIT_TWO_BYTES (c & 0xFF, c >> 8);
1592 }
1593 else
1594 {
1595 int c1, c2;
1596
1597 c -= 0x10000;
1598 c1 = (c >> 10) + 0xD800;
1599 c2 = (c & 0x3FF) + 0xDC00;
1600 if (big_endian)
1601 EMIT_FOUR_BYTES (c1 >> 8, c1 & 0xFF, c2 >> 8, c2 & 0xFF);
1602 else
1603 EMIT_FOUR_BYTES (c1 & 0xFF, c1 >> 8, c2 & 0xFF, c2 >> 8);
1604 }
1605 }
1606 record_conversion_result (coding, CODING_RESULT_SUCCESS);
1607 coding->produced = dst - coding->destination;
1608 coding->produced_char += produced_chars;
1609 return 0;
1610 }
1611
1612 \f
1613 /*** 6. Old Emacs' internal format (emacs-mule) ***/
1614
1615 /* Emacs' internal format for representation of multiple character
1616 sets is a kind of multi-byte encoding, i.e. characters are
1617 represented by variable-length sequences of one-byte codes.
1618
1619 ASCII characters and control characters (e.g. `tab', `newline') are
1620 represented by one-byte sequences which are their ASCII codes, in
1621 the range 0x00 through 0x7F.
1622
1623 8-bit characters of the range 0x80..0x9F are represented by
1624 two-byte sequences of LEADING_CODE_8_BIT_CONTROL and (their 8-bit
1625 code + 0x20).
1626
1627 8-bit characters of the range 0xA0..0xFF are represented by
1628 one-byte sequences which are their 8-bit code.
1629
1630 The other characters are represented by a sequence of `base
1631 leading-code', optional `extended leading-code', and one or two
1632 `position-code's. The length of the sequence is determined by the
1633 base leading-code. Leading-code takes the range 0x81 through 0x9D,
1634 whereas extended leading-code and position-code take the range 0xA0
1635 through 0xFF. See `charset.h' for more details about leading-code
1636 and position-code.
1637
1638 --- CODE RANGE of Emacs' internal format ---
1639 character set range
1640 ------------- -----
1641 ascii 0x00..0x7F
1642 eight-bit-control LEADING_CODE_8_BIT_CONTROL + 0xA0..0xBF
1643 eight-bit-graphic 0xA0..0xBF
1644 ELSE 0x81..0x9D + [0xA0..0xFF]+
1645 ---------------------------------------------
1646
1647 As this is the internal character representation, the format is
1648 usually not used externally (i.e. in a file or in a data sent to a
1649 process). But, it is possible to have a text externally in this
1650 format (i.e. by encoding by the coding system `emacs-mule').
1651
1652 In that case, a sequence of one-byte codes has a slightly different
1653 form.
1654
1655 At first, all characters in eight-bit-control are represented by
1656 one-byte sequences which are their 8-bit code.
1657
1658 Next, character composition data are represented by the byte
1659 sequence of the form: 0x80 METHOD BYTES CHARS COMPONENT ...,
1660 where,
1661 METHOD is 0xF0 plus one of composition method (enum
1662 composition_method),
1663
1664 BYTES is 0xA0 plus a byte length of this composition data,
1665
1666 CHARS is 0x20 plus a number of characters composed by this
1667 data,
1668
1669 COMPONENTs are characters of multibye form or composition
1670 rules encoded by two-byte of ASCII codes.
1671
1672 In addition, for backward compatibility, the following formats are
1673 also recognized as composition data on decoding.
1674
1675 0x80 MSEQ ...
1676 0x80 0xFF MSEQ RULE MSEQ RULE ... MSEQ
1677
1678 Here,
1679 MSEQ is a multibyte form but in these special format:
1680 ASCII: 0xA0 ASCII_CODE+0x80,
1681 other: LEADING_CODE+0x20 FOLLOWING-BYTE ...,
1682 RULE is a one byte code of the range 0xA0..0xF0 that
1683 represents a composition rule.
1684 */
1685
1686 char emacs_mule_bytes[256];
1687
1688 int
1689 emacs_mule_char (coding, src, nbytes, nchars, id)
1690 struct coding_system *coding;
1691 const unsigned char *src;
1692 int *nbytes, *nchars, *id;
1693 {
1694 const unsigned char *src_end = coding->source + coding->src_bytes;
1695 const unsigned char *src_base = src;
1696 int multibytep = coding->src_multibyte;
1697 struct charset *charset;
1698 unsigned code;
1699 int c;
1700 int consumed_chars = 0;
1701
1702 ONE_MORE_BYTE (c);
1703 if (c < 0)
1704 {
1705 c = -c;
1706 charset = emacs_mule_charset[0];
1707 }
1708 else
1709 {
1710 if (c >= 0xA0)
1711 {
1712 /* Old style component character of a compostion. */
1713 if (c == 0xA0)
1714 {
1715 ONE_MORE_BYTE (c);
1716 c -= 0x80;
1717 }
1718 else
1719 c -= 0x20;
1720 }
1721
1722 switch (emacs_mule_bytes[c])
1723 {
1724 case 2:
1725 if (! (charset = emacs_mule_charset[c]))
1726 goto invalid_code;
1727 ONE_MORE_BYTE (c);
1728 if (c < 0xA0)
1729 goto invalid_code;
1730 code = c & 0x7F;
1731 break;
1732
1733 case 3:
1734 if (c == EMACS_MULE_LEADING_CODE_PRIVATE_11
1735 || c == EMACS_MULE_LEADING_CODE_PRIVATE_12)
1736 {
1737 ONE_MORE_BYTE (c);
1738 if (c < 0xA0 || ! (charset = emacs_mule_charset[c]))
1739 goto invalid_code;
1740 ONE_MORE_BYTE (c);
1741 if (c < 0xA0)
1742 goto invalid_code;
1743 code = c & 0x7F;
1744 }
1745 else
1746 {
1747 if (! (charset = emacs_mule_charset[c]))
1748 goto invalid_code;
1749 ONE_MORE_BYTE (c);
1750 if (c < 0xA0)
1751 goto invalid_code;
1752 code = (c & 0x7F) << 8;
1753 ONE_MORE_BYTE (c);
1754 if (c < 0xA0)
1755 goto invalid_code;
1756 code |= c & 0x7F;
1757 }
1758 break;
1759
1760 case 4:
1761 ONE_MORE_BYTE (c);
1762 if (c < 0 || ! (charset = emacs_mule_charset[c]))
1763 goto invalid_code;
1764 ONE_MORE_BYTE (c);
1765 if (c < 0xA0)
1766 goto invalid_code;
1767 code = (c & 0x7F) << 8;
1768 ONE_MORE_BYTE (c);
1769 if (c < 0xA0)
1770 goto invalid_code;
1771 code |= c & 0x7F;
1772 break;
1773
1774 case 1:
1775 code = c;
1776 charset = CHARSET_FROM_ID (ASCII_BYTE_P (code)
1777 ? charset_ascii : charset_eight_bit);
1778 break;
1779
1780 default:
1781 abort ();
1782 }
1783 c = DECODE_CHAR (charset, code);
1784 if (c < 0)
1785 goto invalid_code;
1786 }
1787 *nbytes = src - src_base;
1788 *nchars = consumed_chars;
1789 if (id)
1790 *id = charset->id;
1791 return c;
1792
1793 no_more_source:
1794 return -2;
1795
1796 invalid_code:
1797 return -1;
1798 }
1799
1800
1801 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
1802 Check if a text is encoded in `emacs-mule'. If it is, return 1,
1803 else return 0. */
1804
1805 static int
1806 detect_coding_emacs_mule (coding, detect_info)
1807 struct coding_system *coding;
1808 struct coding_detection_info *detect_info;
1809 {
1810 const unsigned char *src = coding->source, *src_base;
1811 const unsigned char *src_end = coding->source + coding->src_bytes;
1812 int multibytep = coding->src_multibyte;
1813 int consumed_chars = 0;
1814 int c;
1815 int found = 0;
1816
1817 detect_info->checked |= CATEGORY_MASK_EMACS_MULE;
1818 /* A coding system of this category is always ASCII compatible. */
1819 src += coding->head_ascii;
1820
1821 while (1)
1822 {
1823 src_base = src;
1824 ONE_MORE_BYTE (c);
1825 if (c < 0)
1826 continue;
1827 if (c == 0x80)
1828 {
1829 /* Perhaps the start of composite character. We simple skip
1830 it because analyzing it is too heavy for detecting. But,
1831 at least, we check that the composite character
1832 constitues of more than 4 bytes. */
1833 const unsigned char *src_base;
1834
1835 repeat:
1836 src_base = src;
1837 do
1838 {
1839 ONE_MORE_BYTE (c);
1840 }
1841 while (c >= 0xA0);
1842
1843 if (src - src_base <= 4)
1844 break;
1845 found = CATEGORY_MASK_EMACS_MULE;
1846 if (c == 0x80)
1847 goto repeat;
1848 }
1849
1850 if (c < 0x80)
1851 {
1852 if (c < 0x20
1853 && (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO))
1854 break;
1855 }
1856 else
1857 {
1858 int more_bytes = emacs_mule_bytes[*src_base] - 1;
1859
1860 while (more_bytes > 0)
1861 {
1862 ONE_MORE_BYTE (c);
1863 if (c < 0xA0)
1864 {
1865 src--; /* Unread the last byte. */
1866 break;
1867 }
1868 more_bytes--;
1869 }
1870 if (more_bytes != 0)
1871 break;
1872 found = CATEGORY_MASK_EMACS_MULE;
1873 }
1874 }
1875 detect_info->rejected |= CATEGORY_MASK_EMACS_MULE;
1876 return 0;
1877
1878 no_more_source:
1879 if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK)
1880 {
1881 detect_info->rejected |= CATEGORY_MASK_EMACS_MULE;
1882 return 0;
1883 }
1884 detect_info->found |= found;
1885 return 1;
1886 }
1887
1888
1889 /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
1890
1891 /* Decode a character represented as a component of composition
1892 sequence of Emacs 20/21 style at SRC. Set C to that character and
1893 update SRC to the head of next character (or an encoded composition
1894 rule). If SRC doesn't points a composition component, set C to -1.
1895 If SRC points an invalid byte sequence, global exit by a return
1896 value 0. */
1897
1898 #define DECODE_EMACS_MULE_COMPOSITION_CHAR(buf) \
1899 if (1) \
1900 { \
1901 int c; \
1902 int nbytes, nchars; \
1903 \
1904 if (src == src_end) \
1905 break; \
1906 c = emacs_mule_char (coding, src, &nbytes, &nchars, NULL);\
1907 if (c < 0) \
1908 { \
1909 if (c == -2) \
1910 break; \
1911 goto invalid_code; \
1912 } \
1913 *buf++ = c; \
1914 src += nbytes; \
1915 consumed_chars += nchars; \
1916 } \
1917 else
1918
1919
1920 /* Decode a composition rule represented as a component of composition
1921 sequence of Emacs 20 style at SRC. Store the decoded rule in *BUF,
1922 and increment BUF. If SRC points an invalid byte sequence, set C
1923 to -1. */
1924
1925 #define DECODE_EMACS_MULE_COMPOSITION_RULE_20(buf) \
1926 do { \
1927 int c, gref, nref; \
1928 \
1929 if (src >= src_end) \
1930 goto invalid_code; \
1931 ONE_MORE_BYTE_NO_CHECK (c); \
1932 c -= 0xA0; \
1933 if (c < 0 || c >= 81) \
1934 goto invalid_code; \
1935 \
1936 gref = c / 9, nref = c % 9; \
1937 *buf++ = COMPOSITION_ENCODE_RULE (gref, nref); \
1938 } while (0)
1939
1940
1941 /* Decode a composition rule represented as a component of composition
1942 sequence of Emacs 21 style at SRC. Store the decoded rule in *BUF,
1943 and increment BUF. If SRC points an invalid byte sequence, set C
1944 to -1. */
1945
1946 #define DECODE_EMACS_MULE_COMPOSITION_RULE_21(buf) \
1947 do { \
1948 int gref, nref; \
1949 \
1950 if (src + 1>= src_end) \
1951 goto invalid_code; \
1952 ONE_MORE_BYTE_NO_CHECK (gref); \
1953 gref -= 0x20; \
1954 ONE_MORE_BYTE_NO_CHECK (nref); \
1955 nref -= 0x20; \
1956 if (gref < 0 || gref >= 81 \
1957 || nref < 0 || nref >= 81) \
1958 goto invalid_code; \
1959 *buf++ = COMPOSITION_ENCODE_RULE (gref, nref); \
1960 } while (0)
1961
1962
1963 #define DECODE_EMACS_MULE_21_COMPOSITION(c) \
1964 do { \
1965 /* Emacs 21 style format. The first three bytes at SRC are \
1966 (METHOD - 0xF2), (BYTES - 0xA0), (CHARS - 0xA0), where BYTES is \
1967 the byte length of this composition information, CHARS is the \
1968 number of characters composed by this composition. */ \
1969 enum composition_method method = c - 0xF2; \
1970 int *charbuf_base = charbuf; \
1971 int consumed_chars_limit; \
1972 int nbytes, nchars; \
1973 \
1974 ONE_MORE_BYTE (c); \
1975 if (c < 0) \
1976 goto invalid_code; \
1977 nbytes = c - 0xA0; \
1978 if (nbytes < 3) \
1979 goto invalid_code; \
1980 ONE_MORE_BYTE (c); \
1981 if (c < 0) \
1982 goto invalid_code; \
1983 nchars = c - 0xA0; \
1984 ADD_COMPOSITION_DATA (charbuf, nchars, method); \
1985 consumed_chars_limit = consumed_chars_base + nbytes; \
1986 if (method != COMPOSITION_RELATIVE) \
1987 { \
1988 int i = 0; \
1989 while (consumed_chars < consumed_chars_limit) \
1990 { \
1991 if (i % 2 && method != COMPOSITION_WITH_ALTCHARS) \
1992 DECODE_EMACS_MULE_COMPOSITION_RULE_21 (charbuf); \
1993 else \
1994 DECODE_EMACS_MULE_COMPOSITION_CHAR (charbuf); \
1995 i++; \
1996 } \
1997 if (consumed_chars < consumed_chars_limit) \
1998 goto invalid_code; \
1999 charbuf_base[0] -= i; \
2000 } \
2001 } while (0)
2002
2003
2004 #define DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION(c) \
2005 do { \
2006 /* Emacs 20 style format for relative composition. */ \
2007 /* Store multibyte form of characters to be composed. */ \
2008 enum composition_method method = COMPOSITION_RELATIVE; \
2009 int components[MAX_COMPOSITION_COMPONENTS * 2 - 1]; \
2010 int *buf = components; \
2011 int i, j; \
2012 \
2013 src = src_base; \
2014 ONE_MORE_BYTE (c); /* skip 0x80 */ \
2015 for (i = 0; *src >= 0xA0 && i < MAX_COMPOSITION_COMPONENTS; i++) \
2016 DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
2017 if (i < 2) \
2018 goto invalid_code; \
2019 ADD_COMPOSITION_DATA (charbuf, i, method); \
2020 for (j = 0; j < i; j++) \
2021 *charbuf++ = components[j]; \
2022 } while (0)
2023
2024
2025 #define DECODE_EMACS_MULE_20_RULEBASE_COMPOSITION(c) \
2026 do { \
2027 /* Emacs 20 style format for rule-base composition. */ \
2028 /* Store multibyte form of characters to be composed. */ \
2029 enum composition_method method = COMPOSITION_WITH_RULE; \
2030 int *charbuf_base = charbuf; \
2031 int components[MAX_COMPOSITION_COMPONENTS * 2 - 1]; \
2032 int *buf = components; \
2033 int i, j; \
2034 \
2035 DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
2036 for (i = 1; i < MAX_COMPOSITION_COMPONENTS; i++) \
2037 { \
2038 if (*src < 0xA0) \
2039 break; \
2040 DECODE_EMACS_MULE_COMPOSITION_RULE_20 (buf); \
2041 DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
2042 } \
2043 if (i <= 1 || (buf - components) % 2 == 0) \
2044 goto invalid_code; \
2045 if (charbuf + i + (i / 2) + 1 >= charbuf_end) \
2046 goto no_more_source; \
2047 ADD_COMPOSITION_DATA (charbuf, i, method); \
2048 i = i * 2 - 1; \
2049 for (j = 0; j < i; j++) \
2050 *charbuf++ = components[j]; \
2051 charbuf_base[0] -= i; \
2052 for (j = 0; j < i; j += 2) \
2053 *charbuf++ = components[j]; \
2054 } while (0)
2055
2056
2057 static void
2058 decode_coding_emacs_mule (coding)
2059 struct coding_system *coding;
2060 {
2061 const unsigned char *src = coding->source + coding->consumed;
2062 const unsigned char *src_end = coding->source + coding->src_bytes;
2063 const unsigned char *src_base;
2064 int *charbuf = coding->charbuf + coding->charbuf_used;
2065 int *charbuf_end
2066 = coding->charbuf + coding->charbuf_size - MAX_ANNOTATION_LENGTH;
2067 int consumed_chars = 0, consumed_chars_base;
2068 int multibytep = coding->src_multibyte;
2069 Lisp_Object attrs, charset_list;
2070 int char_offset = coding->produced_char;
2071 int last_offset = char_offset;
2072 int last_id = charset_ascii;
2073
2074 CODING_GET_INFO (coding, attrs, charset_list);
2075
2076 while (1)
2077 {
2078 int c;
2079
2080 src_base = src;
2081 consumed_chars_base = consumed_chars;
2082
2083 if (charbuf >= charbuf_end)
2084 break;
2085
2086 ONE_MORE_BYTE (c);
2087 if (c < 0)
2088 {
2089 *charbuf++ = -c;
2090 char_offset++;
2091 }
2092 else if (c < 0x80)
2093 {
2094 *charbuf++ = c;
2095 char_offset++;
2096 }
2097 else if (c == 0x80)
2098 {
2099 ONE_MORE_BYTE (c);
2100 if (c < 0)
2101 goto invalid_code;
2102 if (c - 0xF2 >= COMPOSITION_RELATIVE
2103 && c - 0xF2 <= COMPOSITION_WITH_RULE_ALTCHARS)
2104 DECODE_EMACS_MULE_21_COMPOSITION (c);
2105 else if (c < 0xC0)
2106 DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION (c);
2107 else if (c == 0xFF)
2108 DECODE_EMACS_MULE_20_RULEBASE_COMPOSITION (c);
2109 else
2110 goto invalid_code;
2111 }
2112 else if (c < 0xA0 && emacs_mule_bytes[c] > 1)
2113 {
2114 int nbytes, nchars;
2115 int id;
2116
2117 src = src_base;
2118 consumed_chars = consumed_chars_base;
2119 c = emacs_mule_char (coding, src, &nbytes, &nchars, &id);
2120 if (c < 0)
2121 {
2122 if (c == -2)
2123 break;
2124 goto invalid_code;
2125 }
2126 if (last_id != id)
2127 {
2128 if (last_id != charset_ascii)
2129 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
2130 last_id = id;
2131 last_offset = char_offset;
2132 }
2133 *charbuf++ = c;
2134 src += nbytes;
2135 consumed_chars += nchars;
2136 char_offset++;
2137 }
2138 else
2139 goto invalid_code;
2140 continue;
2141
2142 invalid_code:
2143 src = src_base;
2144 consumed_chars = consumed_chars_base;
2145 ONE_MORE_BYTE (c);
2146 *charbuf++ = ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c);
2147 char_offset++;
2148 coding->errors++;
2149 }
2150
2151 no_more_source:
2152 if (last_id != charset_ascii)
2153 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
2154 coding->consumed_char += consumed_chars_base;
2155 coding->consumed = src_base - coding->source;
2156 coding->charbuf_used = charbuf - coding->charbuf;
2157 }
2158
2159
2160 #define EMACS_MULE_LEADING_CODES(id, codes) \
2161 do { \
2162 if (id < 0xA0) \
2163 codes[0] = id, codes[1] = 0; \
2164 else if (id < 0xE0) \
2165 codes[0] = 0x9A, codes[1] = id; \
2166 else if (id < 0xF0) \
2167 codes[0] = 0x9B, codes[1] = id; \
2168 else if (id < 0xF5) \
2169 codes[0] = 0x9C, codes[1] = id; \
2170 else \
2171 codes[0] = 0x9D, codes[1] = id; \
2172 } while (0);
2173
2174
2175 static int
2176 encode_coding_emacs_mule (coding)
2177 struct coding_system *coding;
2178 {
2179 int multibytep = coding->dst_multibyte;
2180 int *charbuf = coding->charbuf;
2181 int *charbuf_end = charbuf + coding->charbuf_used;
2182 unsigned char *dst = coding->destination + coding->produced;
2183 unsigned char *dst_end = coding->destination + coding->dst_bytes;
2184 int safe_room = 8;
2185 int produced_chars = 0;
2186 Lisp_Object attrs, charset_list;
2187 int c;
2188 int preferred_charset_id = -1;
2189
2190 CODING_GET_INFO (coding, attrs, charset_list);
2191 if (! EQ (charset_list, Vemacs_mule_charset_list))
2192 {
2193 CODING_ATTR_CHARSET_LIST (attrs)
2194 = charset_list = Vemacs_mule_charset_list;
2195 }
2196
2197 while (charbuf < charbuf_end)
2198 {
2199 ASSURE_DESTINATION (safe_room);
2200 c = *charbuf++;
2201
2202 if (c < 0)
2203 {
2204 /* Handle an annotation. */
2205 switch (*charbuf)
2206 {
2207 case CODING_ANNOTATE_COMPOSITION_MASK:
2208 /* Not yet implemented. */
2209 break;
2210 case CODING_ANNOTATE_CHARSET_MASK:
2211 preferred_charset_id = charbuf[3];
2212 if (preferred_charset_id >= 0
2213 && NILP (Fmemq (make_number (preferred_charset_id),
2214 charset_list)))
2215 preferred_charset_id = -1;
2216 break;
2217 default:
2218 abort ();
2219 }
2220 charbuf += -c - 1;
2221 continue;
2222 }
2223
2224 if (ASCII_CHAR_P (c))
2225 EMIT_ONE_ASCII_BYTE (c);
2226 else if (CHAR_BYTE8_P (c))
2227 {
2228 c = CHAR_TO_BYTE8 (c);
2229 EMIT_ONE_BYTE (c);
2230 }
2231 else
2232 {
2233 struct charset *charset;
2234 unsigned code;
2235 int dimension;
2236 int emacs_mule_id;
2237 unsigned char leading_codes[2];
2238
2239 if (preferred_charset_id >= 0)
2240 {
2241 charset = CHARSET_FROM_ID (preferred_charset_id);
2242 if (! CHAR_CHARSET_P (c, charset))
2243 charset = char_charset (c, charset_list, NULL);
2244 }
2245 else
2246 charset = char_charset (c, charset_list, &code);
2247 if (! charset)
2248 {
2249 c = coding->default_char;
2250 if (ASCII_CHAR_P (c))
2251 {
2252 EMIT_ONE_ASCII_BYTE (c);
2253 continue;
2254 }
2255 charset = char_charset (c, charset_list, &code);
2256 }
2257 dimension = CHARSET_DIMENSION (charset);
2258 emacs_mule_id = CHARSET_EMACS_MULE_ID (charset);
2259 EMACS_MULE_LEADING_CODES (emacs_mule_id, leading_codes);
2260 EMIT_ONE_BYTE (leading_codes[0]);
2261 if (leading_codes[1])
2262 EMIT_ONE_BYTE (leading_codes[1]);
2263 if (dimension == 1)
2264 EMIT_ONE_BYTE (code | 0x80);
2265 else
2266 {
2267 code |= 0x8080;
2268 EMIT_ONE_BYTE (code >> 8);
2269 EMIT_ONE_BYTE (code & 0xFF);
2270 }
2271 }
2272 }
2273 record_conversion_result (coding, CODING_RESULT_SUCCESS);
2274 coding->produced_char += produced_chars;
2275 coding->produced = dst - coding->destination;
2276 return 0;
2277 }
2278
2279 \f
2280 /*** 7. ISO2022 handlers ***/
2281
2282 /* The following note describes the coding system ISO2022 briefly.
2283 Since the intention of this note is to help understand the
2284 functions in this file, some parts are NOT ACCURATE or are OVERLY
2285 SIMPLIFIED. For thorough understanding, please refer to the
2286 original document of ISO2022. This is equivalent to the standard
2287 ECMA-35, obtainable from <URL:http://www.ecma.ch/> (*).
2288
2289 ISO2022 provides many mechanisms to encode several character sets
2290 in 7-bit and 8-bit environments. For 7-bit environments, all text
2291 is encoded using bytes less than 128. This may make the encoded
2292 text a little bit longer, but the text passes more easily through
2293 several types of gateway, some of which strip off the MSB (Most
2294 Significant Bit).
2295
2296 There are two kinds of character sets: control character sets and
2297 graphic character sets. The former contain control characters such
2298 as `newline' and `escape' to provide control functions (control
2299 functions are also provided by escape sequences). The latter
2300 contain graphic characters such as 'A' and '-'. Emacs recognizes
2301 two control character sets and many graphic character sets.
2302
2303 Graphic character sets are classified into one of the following
2304 four classes, according to the number of bytes (DIMENSION) and
2305 number of characters in one dimension (CHARS) of the set:
2306 - DIMENSION1_CHARS94
2307 - DIMENSION1_CHARS96
2308 - DIMENSION2_CHARS94
2309 - DIMENSION2_CHARS96
2310
2311 In addition, each character set is assigned an identification tag,
2312 unique for each set, called the "final character" (denoted as <F>
2313 hereafter). The <F> of each character set is decided by ECMA(*)
2314 when it is registered in ISO. The code range of <F> is 0x30..0x7F
2315 (0x30..0x3F are for private use only).
2316
2317 Note (*): ECMA = European Computer Manufacturers Association
2318
2319 Here are examples of graphic character sets [NAME(<F>)]:
2320 o DIMENSION1_CHARS94 -- ASCII('B'), right-half-of-JISX0201('I'), ...
2321 o DIMENSION1_CHARS96 -- right-half-of-ISO8859-1('A'), ...
2322 o DIMENSION2_CHARS94 -- GB2312('A'), JISX0208('B'), ...
2323 o DIMENSION2_CHARS96 -- none for the moment
2324
2325 A code area (1 byte=8 bits) is divided into 4 areas, C0, GL, C1, and GR.
2326 C0 [0x00..0x1F] -- control character plane 0
2327 GL [0x20..0x7F] -- graphic character plane 0
2328 C1 [0x80..0x9F] -- control character plane 1
2329 GR [0xA0..0xFF] -- graphic character plane 1
2330
2331 A control character set is directly designated and invoked to C0 or
2332 C1 by an escape sequence. The most common case is that:
2333 - ISO646's control character set is designated/invoked to C0, and
2334 - ISO6429's control character set is designated/invoked to C1,
2335 and usually these designations/invocations are omitted in encoded
2336 text. In a 7-bit environment, only C0 can be used, and a control
2337 character for C1 is encoded by an appropriate escape sequence to
2338 fit into the environment. All control characters for C1 are
2339 defined to have corresponding escape sequences.
2340
2341 A graphic character set is at first designated to one of four
2342 graphic registers (G0 through G3), then these graphic registers are
2343 invoked to GL or GR. These designations and invocations can be
2344 done independently. The most common case is that G0 is invoked to
2345 GL, G1 is invoked to GR, and ASCII is designated to G0. Usually
2346 these invocations and designations are omitted in encoded text.
2347 In a 7-bit environment, only GL can be used.
2348
2349 When a graphic character set of CHARS94 is invoked to GL, codes
2350 0x20 and 0x7F of the GL area work as control characters SPACE and
2351 DEL respectively, and codes 0xA0 and 0xFF of the GR area should not
2352 be used.
2353
2354 There are two ways of invocation: locking-shift and single-shift.
2355 With locking-shift, the invocation lasts until the next different
2356 invocation, whereas with single-shift, the invocation affects the
2357 following character only and doesn't affect the locking-shift
2358 state. Invocations are done by the following control characters or
2359 escape sequences:
2360
2361 ----------------------------------------------------------------------
2362 abbrev function cntrl escape seq description
2363 ----------------------------------------------------------------------
2364 SI/LS0 (shift-in) 0x0F none invoke G0 into GL
2365 SO/LS1 (shift-out) 0x0E none invoke G1 into GL
2366 LS2 (locking-shift-2) none ESC 'n' invoke G2 into GL
2367 LS3 (locking-shift-3) none ESC 'o' invoke G3 into GL
2368 LS1R (locking-shift-1 right) none ESC '~' invoke G1 into GR (*)
2369 LS2R (locking-shift-2 right) none ESC '}' invoke G2 into GR (*)
2370 LS3R (locking-shift 3 right) none ESC '|' invoke G3 into GR (*)
2371 SS2 (single-shift-2) 0x8E ESC 'N' invoke G2 for one char
2372 SS3 (single-shift-3) 0x8F ESC 'O' invoke G3 for one char
2373 ----------------------------------------------------------------------
2374 (*) These are not used by any known coding system.
2375
2376 Control characters for these functions are defined by macros
2377 ISO_CODE_XXX in `coding.h'.
2378
2379 Designations are done by the following escape sequences:
2380 ----------------------------------------------------------------------
2381 escape sequence description
2382 ----------------------------------------------------------------------
2383 ESC '(' <F> designate DIMENSION1_CHARS94<F> to G0
2384 ESC ')' <F> designate DIMENSION1_CHARS94<F> to G1
2385 ESC '*' <F> designate DIMENSION1_CHARS94<F> to G2
2386 ESC '+' <F> designate DIMENSION1_CHARS94<F> to G3
2387 ESC ',' <F> designate DIMENSION1_CHARS96<F> to G0 (*)
2388 ESC '-' <F> designate DIMENSION1_CHARS96<F> to G1
2389 ESC '.' <F> designate DIMENSION1_CHARS96<F> to G2
2390 ESC '/' <F> designate DIMENSION1_CHARS96<F> to G3
2391 ESC '$' '(' <F> designate DIMENSION2_CHARS94<F> to G0 (**)
2392 ESC '$' ')' <F> designate DIMENSION2_CHARS94<F> to G1
2393 ESC '$' '*' <F> designate DIMENSION2_CHARS94<F> to G2
2394 ESC '$' '+' <F> designate DIMENSION2_CHARS94<F> to G3
2395 ESC '$' ',' <F> designate DIMENSION2_CHARS96<F> to G0 (*)
2396 ESC '$' '-' <F> designate DIMENSION2_CHARS96<F> to G1
2397 ESC '$' '.' <F> designate DIMENSION2_CHARS96<F> to G2
2398 ESC '$' '/' <F> designate DIMENSION2_CHARS96<F> to G3
2399 ----------------------------------------------------------------------
2400
2401 In this list, "DIMENSION1_CHARS94<F>" means a graphic character set
2402 of dimension 1, chars 94, and final character <F>, etc...
2403
2404 Note (*): Although these designations are not allowed in ISO2022,
2405 Emacs accepts them on decoding, and produces them on encoding
2406 CHARS96 character sets in a coding system which is characterized as
2407 7-bit environment, non-locking-shift, and non-single-shift.
2408
2409 Note (**): If <F> is '@', 'A', or 'B', the intermediate character
2410 '(' must be omitted. We refer to this as "short-form" hereafter.
2411
2412 Now you may notice that there are a lot of ways of encoding the
2413 same multilingual text in ISO2022. Actually, there exist many
2414 coding systems such as Compound Text (used in X11's inter client
2415 communication, ISO-2022-JP (used in Japanese Internet), ISO-2022-KR
2416 (used in Korean Internet), EUC (Extended UNIX Code, used in Asian
2417 localized platforms), and all of these are variants of ISO2022.
2418
2419 In addition to the above, Emacs handles two more kinds of escape
2420 sequences: ISO6429's direction specification and Emacs' private
2421 sequence for specifying character composition.
2422
2423 ISO6429's direction specification takes the following form:
2424 o CSI ']' -- end of the current direction
2425 o CSI '0' ']' -- end of the current direction
2426 o CSI '1' ']' -- start of left-to-right text
2427 o CSI '2' ']' -- start of right-to-left text
2428 The control character CSI (0x9B: control sequence introducer) is
2429 abbreviated to the escape sequence ESC '[' in a 7-bit environment.
2430
2431 Character composition specification takes the following form:
2432 o ESC '0' -- start relative composition
2433 o ESC '1' -- end composition
2434 o ESC '2' -- start rule-base composition (*)
2435 o ESC '3' -- start relative composition with alternate chars (**)
2436 o ESC '4' -- start rule-base composition with alternate chars (**)
2437 Since these are not standard escape sequences of any ISO standard,
2438 the use of them with these meanings is restricted to Emacs only.
2439
2440 (*) This form is used only in Emacs 20.7 and older versions,
2441 but newer versions can safely decode it.
2442 (**) This form is used only in Emacs 21.1 and newer versions,
2443 and older versions can't decode it.
2444
2445 Here's a list of example usages of these composition escape
2446 sequences (categorized by `enum composition_method').
2447
2448 COMPOSITION_RELATIVE:
2449 ESC 0 CHAR [ CHAR ] ESC 1
2450 COMPOSITION_WITH_RULE:
2451 ESC 2 CHAR [ RULE CHAR ] ESC 1
2452 COMPOSITION_WITH_ALTCHARS:
2453 ESC 3 ALTCHAR [ ALTCHAR ] ESC 0 CHAR [ CHAR ] ESC 1
2454 COMPOSITION_WITH_RULE_ALTCHARS:
2455 ESC 4 ALTCHAR [ RULE ALTCHAR ] ESC 0 CHAR [ CHAR ] ESC 1 */
2456
2457 enum iso_code_class_type iso_code_class[256];
2458
2459 #define SAFE_CHARSET_P(coding, id) \
2460 ((id) <= (coding)->max_charset_id \
2461 && (coding)->safe_charsets[id] >= 0)
2462
2463
2464 #define SHIFT_OUT_OK(category) \
2465 (CODING_ISO_INITIAL (&coding_categories[category], 1) >= 0)
2466
2467 static void
2468 setup_iso_safe_charsets (attrs)
2469 Lisp_Object attrs;
2470 {
2471 Lisp_Object charset_list, safe_charsets;
2472 Lisp_Object request;
2473 Lisp_Object reg_usage;
2474 Lisp_Object tail;
2475 int reg94, reg96;
2476 int flags = XINT (AREF (attrs, coding_attr_iso_flags));
2477 int max_charset_id;
2478
2479 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
2480 if ((flags & CODING_ISO_FLAG_FULL_SUPPORT)
2481 && ! EQ (charset_list, Viso_2022_charset_list))
2482 {
2483 CODING_ATTR_CHARSET_LIST (attrs)
2484 = charset_list = Viso_2022_charset_list;
2485 ASET (attrs, coding_attr_safe_charsets, Qnil);
2486 }
2487
2488 if (STRINGP (AREF (attrs, coding_attr_safe_charsets)))
2489 return;
2490
2491 max_charset_id = 0;
2492 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
2493 {
2494 int id = XINT (XCAR (tail));
2495 if (max_charset_id < id)
2496 max_charset_id = id;
2497 }
2498
2499 safe_charsets = Fmake_string (make_number (max_charset_id + 1),
2500 make_number (255));
2501 request = AREF (attrs, coding_attr_iso_request);
2502 reg_usage = AREF (attrs, coding_attr_iso_usage);
2503 reg94 = XINT (XCAR (reg_usage));
2504 reg96 = XINT (XCDR (reg_usage));
2505
2506 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
2507 {
2508 Lisp_Object id;
2509 Lisp_Object reg;
2510 struct charset *charset;
2511
2512 id = XCAR (tail);
2513 charset = CHARSET_FROM_ID (XINT (id));
2514 reg = Fcdr (Fassq (id, request));
2515 if (! NILP (reg))
2516 SSET (safe_charsets, XINT (id), XINT (reg));
2517 else if (charset->iso_chars_96)
2518 {
2519 if (reg96 < 4)
2520 SSET (safe_charsets, XINT (id), reg96);
2521 }
2522 else
2523 {
2524 if (reg94 < 4)
2525 SSET (safe_charsets, XINT (id), reg94);
2526 }
2527 }
2528 ASET (attrs, coding_attr_safe_charsets, safe_charsets);
2529 }
2530
2531
2532 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
2533 Check if a text is encoded in one of ISO-2022 based codig systems.
2534 If it is, return 1, else return 0. */
2535
2536 static int
2537 detect_coding_iso_2022 (coding, detect_info)
2538 struct coding_system *coding;
2539 struct coding_detection_info *detect_info;
2540 {
2541 const unsigned char *src = coding->source, *src_base = src;
2542 const unsigned char *src_end = coding->source + coding->src_bytes;
2543 int multibytep = coding->src_multibyte;
2544 int single_shifting = 0;
2545 int id;
2546 int c, c1;
2547 int consumed_chars = 0;
2548 int i;
2549 int rejected = 0;
2550 int found = 0;
2551
2552 detect_info->checked |= CATEGORY_MASK_ISO;
2553
2554 for (i = coding_category_iso_7; i <= coding_category_iso_8_else; i++)
2555 {
2556 struct coding_system *this = &(coding_categories[i]);
2557 Lisp_Object attrs, val;
2558
2559 attrs = CODING_ID_ATTRS (this->id);
2560 if (CODING_ISO_FLAGS (this) & CODING_ISO_FLAG_FULL_SUPPORT
2561 && ! EQ (CODING_ATTR_SAFE_CHARSETS (attrs), Viso_2022_charset_list))
2562 setup_iso_safe_charsets (attrs);
2563 val = CODING_ATTR_SAFE_CHARSETS (attrs);
2564 this->max_charset_id = SCHARS (val) - 1;
2565 this->safe_charsets = (char *) SDATA (val);
2566 }
2567
2568 /* A coding system of this category is always ASCII compatible. */
2569 src += coding->head_ascii;
2570
2571 while (rejected != CATEGORY_MASK_ISO)
2572 {
2573 src_base = src;
2574 ONE_MORE_BYTE (c);
2575 switch (c)
2576 {
2577 case ISO_CODE_ESC:
2578 if (inhibit_iso_escape_detection)
2579 break;
2580 single_shifting = 0;
2581 ONE_MORE_BYTE (c);
2582 if (c >= '(' && c <= '/')
2583 {
2584 /* Designation sequence for a charset of dimension 1. */
2585 ONE_MORE_BYTE (c1);
2586 if (c1 < ' ' || c1 >= 0x80
2587 || (id = iso_charset_table[0][c >= ','][c1]) < 0)
2588 /* Invalid designation sequence. Just ignore. */
2589 break;
2590 }
2591 else if (c == '$')
2592 {
2593 /* Designation sequence for a charset of dimension 2. */
2594 ONE_MORE_BYTE (c);
2595 if (c >= '@' && c <= 'B')
2596 /* Designation for JISX0208.1978, GB2312, or JISX0208. */
2597 id = iso_charset_table[1][0][c];
2598 else if (c >= '(' && c <= '/')
2599 {
2600 ONE_MORE_BYTE (c1);
2601 if (c1 < ' ' || c1 >= 0x80
2602 || (id = iso_charset_table[1][c >= ','][c1]) < 0)
2603 /* Invalid designation sequence. Just ignore. */
2604 break;
2605 }
2606 else
2607 /* Invalid designation sequence. Just ignore it. */
2608 break;
2609 }
2610 else if (c == 'N' || c == 'O')
2611 {
2612 /* ESC <Fe> for SS2 or SS3. */
2613 single_shifting = 1;
2614 rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_8BIT;
2615 break;
2616 }
2617 else if (c >= '0' && c <= '4')
2618 {
2619 /* ESC <Fp> for start/end composition. */
2620 found |= CATEGORY_MASK_ISO;
2621 break;
2622 }
2623 else
2624 {
2625 /* Invalid escape sequence. Just ignore it. */
2626 break;
2627 }
2628
2629 /* We found a valid designation sequence for CHARSET. */
2630 rejected |= CATEGORY_MASK_ISO_8BIT;
2631 if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_7],
2632 id))
2633 found |= CATEGORY_MASK_ISO_7;
2634 else
2635 rejected |= CATEGORY_MASK_ISO_7;
2636 if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_7_tight],
2637 id))
2638 found |= CATEGORY_MASK_ISO_7_TIGHT;
2639 else
2640 rejected |= CATEGORY_MASK_ISO_7_TIGHT;
2641 if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_7_else],
2642 id))
2643 found |= CATEGORY_MASK_ISO_7_ELSE;
2644 else
2645 rejected |= CATEGORY_MASK_ISO_7_ELSE;
2646 if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_8_else],
2647 id))
2648 found |= CATEGORY_MASK_ISO_8_ELSE;
2649 else
2650 rejected |= CATEGORY_MASK_ISO_8_ELSE;
2651 break;
2652
2653 case ISO_CODE_SO:
2654 case ISO_CODE_SI:
2655 /* Locking shift out/in. */
2656 if (inhibit_iso_escape_detection)
2657 break;
2658 single_shifting = 0;
2659 rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_8BIT;
2660 break;
2661
2662 case ISO_CODE_CSI:
2663 /* Control sequence introducer. */
2664 single_shifting = 0;
2665 rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_7_ELSE;
2666 found |= CATEGORY_MASK_ISO_8_ELSE;
2667 goto check_extra_latin;
2668
2669 case ISO_CODE_SS2:
2670 case ISO_CODE_SS3:
2671 /* Single shift. */
2672 if (inhibit_iso_escape_detection)
2673 break;
2674 single_shifting = 0;
2675 rejected |= CATEGORY_MASK_ISO_7BIT;
2676 if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_1])
2677 & CODING_ISO_FLAG_SINGLE_SHIFT)
2678 found |= CATEGORY_MASK_ISO_8_1, single_shifting = 1;
2679 if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_2])
2680 & CODING_ISO_FLAG_SINGLE_SHIFT)
2681 found |= CATEGORY_MASK_ISO_8_2, single_shifting = 1;
2682 if (single_shifting)
2683 break;
2684 goto check_extra_latin;
2685
2686 default:
2687 if (c < 0)
2688 continue;
2689 if (c < 0x80)
2690 {
2691 single_shifting = 0;
2692 break;
2693 }
2694 if (c >= 0xA0)
2695 {
2696 rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_7_ELSE;
2697 found |= CATEGORY_MASK_ISO_8_1;
2698 /* Check the length of succeeding codes of the range
2699 0xA0..0FF. If the byte length is even, we include
2700 CATEGORY_MASK_ISO_8_2 in `found'. We can check this
2701 only when we are not single shifting. */
2702 if (! single_shifting
2703 && ! (rejected & CATEGORY_MASK_ISO_8_2))
2704 {
2705 int i = 1;
2706 while (src < src_end)
2707 {
2708 ONE_MORE_BYTE (c);
2709 if (c < 0xA0)
2710 break;
2711 i++;
2712 }
2713
2714 if (i & 1 && src < src_end)
2715 rejected |= CATEGORY_MASK_ISO_8_2;
2716 else
2717 found |= CATEGORY_MASK_ISO_8_2;
2718 }
2719 break;
2720 }
2721 check_extra_latin:
2722 single_shifting = 0;
2723 if (! VECTORP (Vlatin_extra_code_table)
2724 || NILP (XVECTOR (Vlatin_extra_code_table)->contents[c]))
2725 {
2726 rejected = CATEGORY_MASK_ISO;
2727 break;
2728 }
2729 if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_1])
2730 & CODING_ISO_FLAG_LATIN_EXTRA)
2731 found |= CATEGORY_MASK_ISO_8_1;
2732 else
2733 rejected |= CATEGORY_MASK_ISO_8_1;
2734 rejected |= CATEGORY_MASK_ISO_8_2;
2735 }
2736 }
2737 detect_info->rejected |= CATEGORY_MASK_ISO;
2738 return 0;
2739
2740 no_more_source:
2741 detect_info->rejected |= rejected;
2742 detect_info->found |= (found & ~rejected);
2743 return 1;
2744 }
2745
2746
2747 /* Set designation state into CODING. Set CHARS_96 to -1 if the
2748 escape sequence should be kept. */
2749 #define DECODE_DESIGNATION(reg, dim, chars_96, final) \
2750 do { \
2751 int id, prev; \
2752 \
2753 if (final < '0' || final >= 128 \
2754 || ((id = ISO_CHARSET_TABLE (dim, chars_96, final)) < 0) \
2755 || !SAFE_CHARSET_P (coding, id)) \
2756 { \
2757 CODING_ISO_DESIGNATION (coding, reg) = -2; \
2758 chars_96 = -1; \
2759 break; \
2760 } \
2761 prev = CODING_ISO_DESIGNATION (coding, reg); \
2762 if (id == charset_jisx0201_roman) \
2763 { \
2764 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_ROMAN) \
2765 id = charset_ascii; \
2766 } \
2767 else if (id == charset_jisx0208_1978) \
2768 { \
2769 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_OLDJIS) \
2770 id = charset_jisx0208; \
2771 } \
2772 CODING_ISO_DESIGNATION (coding, reg) = id; \
2773 /* If there was an invalid designation to REG previously, and this \
2774 designation is ASCII to REG, we should keep this designation \
2775 sequence. */ \
2776 if (prev == -2 && id == charset_ascii) \
2777 chars_96 = -1; \
2778 } while (0)
2779
2780
2781 #define MAYBE_FINISH_COMPOSITION() \
2782 do { \
2783 int i; \
2784 if (composition_state == COMPOSING_NO) \
2785 break; \
2786 /* It is assured that we have enough room for producing \
2787 characters stored in the table `components'. */ \
2788 if (charbuf + component_idx > charbuf_end) \
2789 goto no_more_source; \
2790 composition_state = COMPOSING_NO; \
2791 if (method == COMPOSITION_RELATIVE \
2792 || method == COMPOSITION_WITH_ALTCHARS) \
2793 { \
2794 for (i = 0; i < component_idx; i++) \
2795 *charbuf++ = components[i]; \
2796 char_offset += component_idx; \
2797 } \
2798 else \
2799 { \
2800 for (i = 0; i < component_idx; i += 2) \
2801 *charbuf++ = components[i]; \
2802 char_offset += (component_idx / 2) + 1; \
2803 } \
2804 } while (0)
2805
2806
2807 /* Handle composition start sequence ESC 0, ESC 2, ESC 3, or ESC 4.
2808 ESC 0 : relative composition : ESC 0 CHAR ... ESC 1
2809 ESC 2 : rulebase composition : ESC 2 CHAR RULE CHAR RULE ... CHAR ESC 1
2810 ESC 3 : altchar composition : ESC 3 CHAR ... ESC 0 CHAR ... ESC 1
2811 ESC 4 : alt&rule composition : ESC 4 CHAR RULE ... CHAR ESC 0 CHAR ... ESC 1
2812 */
2813
2814 #define DECODE_COMPOSITION_START(c1) \
2815 do { \
2816 if (c1 == '0' \
2817 && composition_state == COMPOSING_COMPONENT_RULE) \
2818 { \
2819 component_len = component_idx; \
2820 composition_state = COMPOSING_CHAR; \
2821 } \
2822 else \
2823 { \
2824 const unsigned char *p; \
2825 \
2826 MAYBE_FINISH_COMPOSITION (); \
2827 if (charbuf + MAX_COMPOSITION_COMPONENTS > charbuf_end) \
2828 goto no_more_source; \
2829 for (p = src; p < src_end - 1; p++) \
2830 if (*p == ISO_CODE_ESC && p[1] == '1') \
2831 break; \
2832 if (p == src_end - 1) \
2833 { \
2834 /* The current composition doesn't end in the current \
2835 source. */ \
2836 record_conversion_result \
2837 (coding, CODING_RESULT_INSUFFICIENT_SRC); \
2838 goto no_more_source; \
2839 } \
2840 \
2841 /* This is surely the start of a composition. */ \
2842 method = (c1 == '0' ? COMPOSITION_RELATIVE \
2843 : c1 == '2' ? COMPOSITION_WITH_RULE \
2844 : c1 == '3' ? COMPOSITION_WITH_ALTCHARS \
2845 : COMPOSITION_WITH_RULE_ALTCHARS); \
2846 composition_state = (c1 <= '2' ? COMPOSING_CHAR \
2847 : COMPOSING_COMPONENT_CHAR); \
2848 component_idx = component_len = 0; \
2849 } \
2850 } while (0)
2851
2852
2853 /* Handle compositoin end sequence ESC 1. */
2854
2855 #define DECODE_COMPOSITION_END() \
2856 do { \
2857 int nchars = (component_len > 0 ? component_idx - component_len \
2858 : method == COMPOSITION_RELATIVE ? component_idx \
2859 : (component_idx + 1) / 2); \
2860 int i; \
2861 int *saved_charbuf = charbuf; \
2862 \
2863 ADD_COMPOSITION_DATA (charbuf, nchars, method); \
2864 if (method != COMPOSITION_RELATIVE) \
2865 { \
2866 if (component_len == 0) \
2867 for (i = 0; i < component_idx; i++) \
2868 *charbuf++ = components[i]; \
2869 else \
2870 for (i = 0; i < component_len; i++) \
2871 *charbuf++ = components[i]; \
2872 *saved_charbuf = saved_charbuf - charbuf; \
2873 } \
2874 if (method == COMPOSITION_WITH_RULE) \
2875 for (i = 0; i < component_idx; i += 2, char_offset++) \
2876 *charbuf++ = components[i]; \
2877 else \
2878 for (i = component_len; i < component_idx; i++, char_offset++) \
2879 *charbuf++ = components[i]; \
2880 coding->annotated = 1; \
2881 composition_state = COMPOSING_NO; \
2882 } while (0)
2883
2884
2885 /* Decode a composition rule from the byte C1 (and maybe one more byte
2886 from SRC) and store one encoded composition rule in
2887 coding->cmp_data. */
2888
2889 #define DECODE_COMPOSITION_RULE(c1) \
2890 do { \
2891 (c1) -= 32; \
2892 if (c1 < 81) /* old format (before ver.21) */ \
2893 { \
2894 int gref = (c1) / 9; \
2895 int nref = (c1) % 9; \
2896 if (gref == 4) gref = 10; \
2897 if (nref == 4) nref = 10; \
2898 c1 = COMPOSITION_ENCODE_RULE (gref, nref); \
2899 } \
2900 else if (c1 < 93) /* new format (after ver.21) */ \
2901 { \
2902 ONE_MORE_BYTE (c2); \
2903 c1 = COMPOSITION_ENCODE_RULE (c1 - 81, c2 - 32); \
2904 } \
2905 else \
2906 c1 = 0; \
2907 } while (0)
2908
2909
2910 /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
2911
2912 static void
2913 decode_coding_iso_2022 (coding)
2914 struct coding_system *coding;
2915 {
2916 const unsigned char *src = coding->source + coding->consumed;
2917 const unsigned char *src_end = coding->source + coding->src_bytes;
2918 const unsigned char *src_base;
2919 int *charbuf = coding->charbuf + coding->charbuf_used;
2920 int *charbuf_end
2921 = coding->charbuf + coding->charbuf_size - 4 - MAX_ANNOTATION_LENGTH;
2922 int consumed_chars = 0, consumed_chars_base;
2923 int multibytep = coding->src_multibyte;
2924 /* Charsets invoked to graphic plane 0 and 1 respectively. */
2925 int charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
2926 int charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1);
2927 int charset_id_2, charset_id_3;
2928 struct charset *charset;
2929 int c;
2930 /* For handling composition sequence. */
2931 #define COMPOSING_NO 0
2932 #define COMPOSING_CHAR 1
2933 #define COMPOSING_RULE 2
2934 #define COMPOSING_COMPONENT_CHAR 3
2935 #define COMPOSING_COMPONENT_RULE 4
2936
2937 int composition_state = COMPOSING_NO;
2938 enum composition_method method;
2939 int components[MAX_COMPOSITION_COMPONENTS * 2 + 1];
2940 int component_idx;
2941 int component_len;
2942 Lisp_Object attrs, charset_list;
2943 int char_offset = coding->produced_char;
2944 int last_offset = char_offset;
2945 int last_id = charset_ascii;
2946
2947 CODING_GET_INFO (coding, attrs, charset_list);
2948 setup_iso_safe_charsets (attrs);
2949 /* Charset list may have been changed. */
2950 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
2951 coding->safe_charsets = (char *) SDATA (CODING_ATTR_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) && produced_chars > 0)
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) && coding->produced_char > 0)
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 current_buffer->text->inhibit_shrinking = 1;
6760 decode_coding (coding);
6761 current_buffer->text->inhibit_shrinking = 0;
6762
6763 attrs = CODING_ID_ATTRS (coding->id);
6764 if (! NILP (CODING_ATTR_POST_READ (attrs)))
6765 {
6766 EMACS_INT prev_Z = Z, prev_Z_BYTE = Z_BYTE;
6767 Lisp_Object val;
6768
6769 TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
6770 val = call1 (CODING_ATTR_POST_READ (attrs),
6771 make_number (coding->produced_char));
6772 CHECK_NATNUM (val);
6773 coding->produced_char += Z - prev_Z;
6774 coding->produced += Z_BYTE - prev_Z_BYTE;
6775 }
6776
6777 unbind_to (count, Qnil);
6778 return coding->result;
6779 }
6780
6781 int
6782 encode_coding_gap (coding, chars, bytes)
6783 struct coding_system *coding;
6784 EMACS_INT chars, bytes;
6785 {
6786 int count = specpdl_ptr - specpdl;
6787
6788 code_conversion_save (0, 0);
6789
6790 coding->src_object = Fcurrent_buffer ();
6791 coding->src_chars = chars;
6792 coding->src_bytes = bytes;
6793 coding->src_pos = -chars;
6794 coding->src_pos_byte = -bytes;
6795 coding->src_multibyte = chars < bytes;
6796 coding->dst_object = coding->src_object;
6797 coding->dst_pos = PT;
6798 coding->dst_pos_byte = PT_BYTE;
6799
6800 encode_coding (coding);
6801
6802 unbind_to (count, Qnil);
6803 return coding->result;
6804 }
6805
6806
6807 /* Decode the text in the range FROM/FROM_BYTE and TO/TO_BYTE in
6808 SRC_OBJECT into DST_OBJECT by coding context CODING.
6809
6810 SRC_OBJECT is a buffer, a string, or Qnil.
6811
6812 If it is a buffer, the text is at point of the buffer. FROM and TO
6813 are positions in the buffer.
6814
6815 If it is a string, the text is at the beginning of the string.
6816 FROM and TO are indices to the string.
6817
6818 If it is nil, the text is at coding->source. FROM and TO are
6819 indices to coding->source.
6820
6821 DST_OBJECT is a buffer, Qt, or Qnil.
6822
6823 If it is a buffer, the decoded text is inserted at point of the
6824 buffer. If the buffer is the same as SRC_OBJECT, the source text
6825 is deleted.
6826
6827 If it is Qt, a string is made from the decoded text, and
6828 set in CODING->dst_object.
6829
6830 If it is Qnil, the decoded text is stored at CODING->destination.
6831 The caller must allocate CODING->dst_bytes bytes at
6832 CODING->destination by xmalloc. If the decoded text is longer than
6833 CODING->dst_bytes, CODING->destination is relocated by xrealloc.
6834 */
6835
6836 void
6837 decode_coding_object (coding, src_object, from, from_byte, to, to_byte,
6838 dst_object)
6839 struct coding_system *coding;
6840 Lisp_Object src_object;
6841 EMACS_INT from, from_byte, to, to_byte;
6842 Lisp_Object dst_object;
6843 {
6844 int count = specpdl_ptr - specpdl;
6845 unsigned char *destination;
6846 EMACS_INT dst_bytes;
6847 EMACS_INT chars = to - from;
6848 EMACS_INT bytes = to_byte - from_byte;
6849 Lisp_Object attrs;
6850 Lisp_Object buffer;
6851 int saved_pt = -1, saved_pt_byte;
6852
6853 buffer = Fcurrent_buffer ();
6854
6855 if (NILP (dst_object))
6856 {
6857 destination = coding->destination;
6858 dst_bytes = coding->dst_bytes;
6859 }
6860
6861 coding->src_object = src_object;
6862 coding->src_chars = chars;
6863 coding->src_bytes = bytes;
6864 coding->src_multibyte = chars < bytes;
6865
6866 if (STRINGP (src_object))
6867 {
6868 coding->src_pos = from;
6869 coding->src_pos_byte = from_byte;
6870 }
6871 else if (BUFFERP (src_object))
6872 {
6873 set_buffer_internal (XBUFFER (src_object));
6874 if (from != GPT)
6875 move_gap_both (from, from_byte);
6876 if (EQ (src_object, dst_object))
6877 {
6878 saved_pt = PT, saved_pt_byte = PT_BYTE;
6879 TEMP_SET_PT_BOTH (from, from_byte);
6880 del_range_both (from, from_byte, to, to_byte, 1);
6881 coding->src_pos = -chars;
6882 coding->src_pos_byte = -bytes;
6883 }
6884 else
6885 {
6886 coding->src_pos = from;
6887 coding->src_pos_byte = from_byte;
6888 }
6889 }
6890
6891 if (CODING_REQUIRE_DETECTION (coding))
6892 detect_coding (coding);
6893 attrs = CODING_ID_ATTRS (coding->id);
6894
6895 if (EQ (dst_object, Qt)
6896 || (! NILP (CODING_ATTR_POST_READ (attrs))
6897 && NILP (dst_object)))
6898 {
6899 coding->dst_object = code_conversion_save (1, 1);
6900 coding->dst_pos = BEG;
6901 coding->dst_pos_byte = BEG_BYTE;
6902 coding->dst_multibyte = 1;
6903 }
6904 else if (BUFFERP (dst_object))
6905 {
6906 code_conversion_save (0, 0);
6907 coding->dst_object = dst_object;
6908 coding->dst_pos = BUF_PT (XBUFFER (dst_object));
6909 coding->dst_pos_byte = BUF_PT_BYTE (XBUFFER (dst_object));
6910 coding->dst_multibyte
6911 = ! NILP (XBUFFER (dst_object)->enable_multibyte_characters);
6912 }
6913 else
6914 {
6915 code_conversion_save (0, 0);
6916 coding->dst_object = Qnil;
6917 coding->dst_multibyte = 1;
6918 }
6919
6920 decode_coding (coding);
6921
6922 if (BUFFERP (coding->dst_object))
6923 set_buffer_internal (XBUFFER (coding->dst_object));
6924
6925 if (! NILP (CODING_ATTR_POST_READ (attrs)))
6926 {
6927 struct gcpro gcpro1, gcpro2;
6928 EMACS_INT prev_Z = Z, prev_Z_BYTE = Z_BYTE;
6929 Lisp_Object val;
6930
6931 TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
6932 GCPRO2 (coding->src_object, coding->dst_object);
6933 val = safe_call1 (CODING_ATTR_POST_READ (attrs),
6934 make_number (coding->produced_char));
6935 UNGCPRO;
6936 CHECK_NATNUM (val);
6937 coding->produced_char += Z - prev_Z;
6938 coding->produced += Z_BYTE - prev_Z_BYTE;
6939 }
6940
6941 if (EQ (dst_object, Qt))
6942 {
6943 coding->dst_object = Fbuffer_string ();
6944 }
6945 else if (NILP (dst_object) && BUFFERP (coding->dst_object))
6946 {
6947 set_buffer_internal (XBUFFER (coding->dst_object));
6948 if (dst_bytes < coding->produced)
6949 {
6950 destination
6951 = (unsigned char *) xrealloc (destination, coding->produced);
6952 if (! destination)
6953 {
6954 record_conversion_result (coding,
6955 CODING_RESULT_INSUFFICIENT_DST);
6956 unbind_to (count, Qnil);
6957 return;
6958 }
6959 if (BEGV < GPT && GPT < BEGV + coding->produced_char)
6960 move_gap_both (BEGV, BEGV_BYTE);
6961 bcopy (BEGV_ADDR, destination, coding->produced);
6962 coding->destination = destination;
6963 }
6964 }
6965
6966 if (saved_pt >= 0)
6967 {
6968 /* This is the case of:
6969 (BUFFERP (src_object) && EQ (src_object, dst_object))
6970 As we have moved PT while replacing the original buffer
6971 contents, we must recover it now. */
6972 set_buffer_internal (XBUFFER (src_object));
6973 if (saved_pt < from)
6974 TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte);
6975 else if (saved_pt < from + chars)
6976 TEMP_SET_PT_BOTH (from, from_byte);
6977 else if (! NILP (current_buffer->enable_multibyte_characters))
6978 TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars),
6979 saved_pt_byte + (coding->produced - bytes));
6980 else
6981 TEMP_SET_PT_BOTH (saved_pt + (coding->produced - bytes),
6982 saved_pt_byte + (coding->produced - bytes));
6983 }
6984
6985 unbind_to (count, coding->dst_object);
6986 }
6987
6988
6989 void
6990 encode_coding_object (coding, src_object, from, from_byte, to, to_byte,
6991 dst_object)
6992 struct coding_system *coding;
6993 Lisp_Object src_object;
6994 EMACS_INT from, from_byte, to, to_byte;
6995 Lisp_Object dst_object;
6996 {
6997 int count = specpdl_ptr - specpdl;
6998 EMACS_INT chars = to - from;
6999 EMACS_INT bytes = to_byte - from_byte;
7000 Lisp_Object attrs;
7001 Lisp_Object buffer;
7002 int saved_pt = -1, saved_pt_byte;
7003 int kill_src_buffer = 0;
7004
7005 buffer = Fcurrent_buffer ();
7006
7007 coding->src_object = src_object;
7008 coding->src_chars = chars;
7009 coding->src_bytes = bytes;
7010 coding->src_multibyte = chars < bytes;
7011
7012 attrs = CODING_ID_ATTRS (coding->id);
7013
7014 if (! NILP (CODING_ATTR_PRE_WRITE (attrs)))
7015 {
7016 coding->src_object = code_conversion_save (1, coding->src_multibyte);
7017 set_buffer_internal (XBUFFER (coding->src_object));
7018 if (STRINGP (src_object))
7019 insert_from_string (src_object, from, from_byte, chars, bytes, 0);
7020 else if (BUFFERP (src_object))
7021 insert_from_buffer (XBUFFER (src_object), from, chars, 0);
7022 else
7023 insert_1_both (coding->source + from, chars, bytes, 0, 0, 0);
7024
7025 if (EQ (src_object, dst_object))
7026 {
7027 set_buffer_internal (XBUFFER (src_object));
7028 saved_pt = PT, saved_pt_byte = PT_BYTE;
7029 del_range_both (from, from_byte, to, to_byte, 1);
7030 set_buffer_internal (XBUFFER (coding->src_object));
7031 }
7032
7033 {
7034 Lisp_Object args[3];
7035
7036 args[0] = CODING_ATTR_PRE_WRITE (attrs);
7037 args[1] = make_number (BEG);
7038 args[2] = make_number (Z);
7039 safe_call (3, args);
7040 }
7041 if (XBUFFER (coding->src_object) != current_buffer)
7042 kill_src_buffer = 1;
7043 coding->src_object = Fcurrent_buffer ();
7044 if (BEG != GPT)
7045 move_gap_both (BEG, BEG_BYTE);
7046 coding->src_chars = Z - BEG;
7047 coding->src_bytes = Z_BYTE - BEG_BYTE;
7048 coding->src_pos = BEG;
7049 coding->src_pos_byte = BEG_BYTE;
7050 coding->src_multibyte = Z < Z_BYTE;
7051 }
7052 else if (STRINGP (src_object))
7053 {
7054 code_conversion_save (0, 0);
7055 coding->src_pos = from;
7056 coding->src_pos_byte = from_byte;
7057 }
7058 else if (BUFFERP (src_object))
7059 {
7060 code_conversion_save (0, 0);
7061 set_buffer_internal (XBUFFER (src_object));
7062 if (EQ (src_object, dst_object))
7063 {
7064 saved_pt = PT, saved_pt_byte = PT_BYTE;
7065 coding->src_object = del_range_1 (from, to, 1, 1);
7066 coding->src_pos = 0;
7067 coding->src_pos_byte = 0;
7068 }
7069 else
7070 {
7071 if (from < GPT && to >= GPT)
7072 move_gap_both (from, from_byte);
7073 coding->src_pos = from;
7074 coding->src_pos_byte = from_byte;
7075 }
7076 }
7077 else
7078 code_conversion_save (0, 0);
7079
7080 if (BUFFERP (dst_object))
7081 {
7082 coding->dst_object = dst_object;
7083 if (EQ (src_object, dst_object))
7084 {
7085 coding->dst_pos = from;
7086 coding->dst_pos_byte = from_byte;
7087 }
7088 else
7089 {
7090 coding->dst_pos = BUF_PT (XBUFFER (dst_object));
7091 coding->dst_pos_byte = BUF_PT_BYTE (XBUFFER (dst_object));
7092 }
7093 coding->dst_multibyte
7094 = ! NILP (XBUFFER (dst_object)->enable_multibyte_characters);
7095 }
7096 else if (EQ (dst_object, Qt))
7097 {
7098 coding->dst_object = Qnil;
7099 coding->dst_bytes = coding->src_chars;
7100 if (coding->dst_bytes == 0)
7101 coding->dst_bytes = 1;
7102 coding->destination = (unsigned char *) xmalloc (coding->dst_bytes);
7103 coding->dst_multibyte = 0;
7104 }
7105 else
7106 {
7107 coding->dst_object = Qnil;
7108 coding->dst_multibyte = 0;
7109 }
7110
7111 encode_coding (coding);
7112
7113 if (EQ (dst_object, Qt))
7114 {
7115 if (BUFFERP (coding->dst_object))
7116 coding->dst_object = Fbuffer_string ();
7117 else
7118 {
7119 coding->dst_object
7120 = make_unibyte_string ((char *) coding->destination,
7121 coding->produced);
7122 xfree (coding->destination);
7123 }
7124 }
7125
7126 if (saved_pt >= 0)
7127 {
7128 /* This is the case of:
7129 (BUFFERP (src_object) && EQ (src_object, dst_object))
7130 As we have moved PT while replacing the original buffer
7131 contents, we must recover it now. */
7132 set_buffer_internal (XBUFFER (src_object));
7133 if (saved_pt < from)
7134 TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte);
7135 else if (saved_pt < from + chars)
7136 TEMP_SET_PT_BOTH (from, from_byte);
7137 else if (! NILP (current_buffer->enable_multibyte_characters))
7138 TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars),
7139 saved_pt_byte + (coding->produced - bytes));
7140 else
7141 TEMP_SET_PT_BOTH (saved_pt + (coding->produced - bytes),
7142 saved_pt_byte + (coding->produced - bytes));
7143 }
7144
7145 if (kill_src_buffer)
7146 Fkill_buffer (coding->src_object);
7147 unbind_to (count, Qnil);
7148 }
7149
7150
7151 Lisp_Object
7152 preferred_coding_system ()
7153 {
7154 int id = coding_categories[coding_priorities[0]].id;
7155
7156 return CODING_ID_NAME (id);
7157 }
7158
7159 \f
7160 #ifdef emacs
7161 /*** 8. Emacs Lisp library functions ***/
7162
7163 DEFUN ("coding-system-p", Fcoding_system_p, Scoding_system_p, 1, 1, 0,
7164 doc: /* Return t if OBJECT is nil or a coding-system.
7165 See the documentation of `define-coding-system' for information
7166 about coding-system objects. */)
7167 (obj)
7168 Lisp_Object obj;
7169 {
7170 if (NILP (obj)
7171 || CODING_SYSTEM_ID (obj) >= 0)
7172 return Qt;
7173 if (! SYMBOLP (obj)
7174 || NILP (Fget (obj, Qcoding_system_define_form)))
7175 return Qnil;
7176 return Qt;
7177 }
7178
7179 DEFUN ("read-non-nil-coding-system", Fread_non_nil_coding_system,
7180 Sread_non_nil_coding_system, 1, 1, 0,
7181 doc: /* Read a coding system from the minibuffer, prompting with string PROMPT. */)
7182 (prompt)
7183 Lisp_Object prompt;
7184 {
7185 Lisp_Object val;
7186 do
7187 {
7188 val = Fcompleting_read (prompt, Vcoding_system_alist, Qnil,
7189 Qt, Qnil, Qcoding_system_history, Qnil, Qnil);
7190 }
7191 while (SCHARS (val) == 0);
7192 return (Fintern (val, Qnil));
7193 }
7194
7195 DEFUN ("read-coding-system", Fread_coding_system, Sread_coding_system, 1, 2, 0,
7196 doc: /* Read a coding system from the minibuffer, prompting with string PROMPT.
7197 If the user enters null input, return second argument DEFAULT-CODING-SYSTEM. */)
7198 (prompt, default_coding_system)
7199 Lisp_Object prompt, default_coding_system;
7200 {
7201 Lisp_Object val;
7202 if (SYMBOLP (default_coding_system))
7203 XSETSTRING (default_coding_system, XPNTR (SYMBOL_NAME (default_coding_system)));
7204 val = Fcompleting_read (prompt, Vcoding_system_alist, Qnil,
7205 Qt, Qnil, Qcoding_system_history,
7206 default_coding_system, Qnil);
7207 return (SCHARS (val) == 0 ? Qnil : Fintern (val, Qnil));
7208 }
7209
7210 DEFUN ("check-coding-system", Fcheck_coding_system, Scheck_coding_system,
7211 1, 1, 0,
7212 doc: /* Check validity of CODING-SYSTEM.
7213 If valid, return CODING-SYSTEM, else signal a `coding-system-error' error.
7214 It is valid if it is nil or a symbol defined as a coding system by the
7215 function `define-coding-system'. */)
7216 (coding_system)
7217 Lisp_Object coding_system;
7218 {
7219 Lisp_Object define_form;
7220
7221 define_form = Fget (coding_system, Qcoding_system_define_form);
7222 if (! NILP (define_form))
7223 {
7224 Fput (coding_system, Qcoding_system_define_form, Qnil);
7225 safe_eval (define_form);
7226 }
7227 if (!NILP (Fcoding_system_p (coding_system)))
7228 return coding_system;
7229 xsignal1 (Qcoding_system_error, coding_system);
7230 }
7231
7232 \f
7233 /* Detect how the bytes at SRC of length SRC_BYTES are encoded. If
7234 HIGHEST is nonzero, return the coding system of the highest
7235 priority among the detected coding systems. Otherwize return a
7236 list of detected coding systems sorted by their priorities. If
7237 MULTIBYTEP is nonzero, it is assumed that the bytes are in correct
7238 multibyte form but contains only ASCII and eight-bit chars.
7239 Otherwise, the bytes are raw bytes.
7240
7241 CODING-SYSTEM controls the detection as below:
7242
7243 If it is nil, detect both text-format and eol-format. If the
7244 text-format part of CODING-SYSTEM is already specified
7245 (e.g. `iso-latin-1'), detect only eol-format. If the eol-format
7246 part of CODING-SYSTEM is already specified (e.g. `undecided-unix'),
7247 detect only text-format. */
7248
7249 Lisp_Object
7250 detect_coding_system (src, src_chars, src_bytes, highest, multibytep,
7251 coding_system)
7252 const unsigned char *src;
7253 int src_chars, src_bytes, highest;
7254 int multibytep;
7255 Lisp_Object coding_system;
7256 {
7257 const unsigned char *src_end = src + src_bytes;
7258 Lisp_Object attrs, eol_type;
7259 Lisp_Object val;
7260 struct coding_system coding;
7261 int id;
7262 struct coding_detection_info detect_info;
7263 enum coding_category base_category;
7264
7265 if (NILP (coding_system))
7266 coding_system = Qundecided;
7267 setup_coding_system (coding_system, &coding);
7268 attrs = CODING_ID_ATTRS (coding.id);
7269 eol_type = CODING_ID_EOL_TYPE (coding.id);
7270 coding_system = CODING_ATTR_BASE_NAME (attrs);
7271
7272 coding.source = src;
7273 coding.src_chars = src_chars;
7274 coding.src_bytes = src_bytes;
7275 coding.src_multibyte = multibytep;
7276 coding.consumed = 0;
7277 coding.mode |= CODING_MODE_LAST_BLOCK;
7278
7279 detect_info.checked = detect_info.found = detect_info.rejected = 0;
7280
7281 /* At first, detect text-format if necessary. */
7282 base_category = XINT (CODING_ATTR_CATEGORY (attrs));
7283 if (base_category == coding_category_undecided)
7284 {
7285 enum coding_category category;
7286 struct coding_system *this;
7287 int c, i;
7288
7289 /* Skip all ASCII bytes except for a few ISO2022 controls. */
7290 for (i = 0; src < src_end; i++, src++)
7291 {
7292 c = *src;
7293 if (c & 0x80)
7294 break;
7295 if (c < 0x20
7296 && (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
7297 && ! inhibit_iso_escape_detection)
7298 {
7299 coding.head_ascii = src - coding.source;
7300 if (detect_coding_iso_2022 (&coding, &detect_info))
7301 {
7302 /* We have scanned the whole data. */
7303 if (! (detect_info.rejected & CATEGORY_MASK_ISO_7_ELSE))
7304 /* We didn't find an 8-bit code. */
7305 src = src_end;
7306 break;
7307 }
7308 }
7309 }
7310 coding.head_ascii = src - coding.source;
7311
7312 if (src < src_end
7313 || detect_info.found)
7314 {
7315 if (src == src_end)
7316 /* As all bytes are 7-bit, we can ignore non-ISO-2022 codings. */
7317 for (i = 0; i < coding_category_raw_text; i++)
7318 {
7319 category = coding_priorities[i];
7320 this = coding_categories + category;
7321 if (detect_info.found & (1 << category))
7322 break;
7323 }
7324 else
7325 for (i = 0; i < coding_category_raw_text; i++)
7326 {
7327 category = coding_priorities[i];
7328 this = coding_categories + category;
7329
7330 if (this->id < 0)
7331 {
7332 /* No coding system of this category is defined. */
7333 detect_info.rejected |= (1 << category);
7334 }
7335 else if (category >= coding_category_raw_text)
7336 continue;
7337 else if (detect_info.checked & (1 << category))
7338 {
7339 if (highest
7340 && (detect_info.found & (1 << category)))
7341 break;
7342 }
7343 else
7344 {
7345 if ((*(this->detector)) (&coding, &detect_info)
7346 && highest
7347 && (detect_info.found & (1 << category)))
7348 {
7349 if (category == coding_category_utf_16_auto)
7350 {
7351 if (detect_info.found & CATEGORY_MASK_UTF_16_LE)
7352 category = coding_category_utf_16_le;
7353 else
7354 category = coding_category_utf_16_be;
7355 }
7356 break;
7357 }
7358 }
7359 }
7360 }
7361
7362 if (detect_info.rejected == CATEGORY_MASK_ANY)
7363 {
7364 detect_info.found = CATEGORY_MASK_RAW_TEXT;
7365 id = coding_categories[coding_category_raw_text].id;
7366 val = Fcons (make_number (id), Qnil);
7367 }
7368 else if (! detect_info.rejected && ! detect_info.found)
7369 {
7370 detect_info.found = CATEGORY_MASK_ANY;
7371 id = coding_categories[coding_category_undecided].id;
7372 val = Fcons (make_number (id), Qnil);
7373 }
7374 else if (highest)
7375 {
7376 if (detect_info.found)
7377 {
7378 detect_info.found = 1 << category;
7379 val = Fcons (make_number (this->id), Qnil);
7380 }
7381 else
7382 for (i = 0; i < coding_category_raw_text; i++)
7383 if (! (detect_info.rejected & (1 << coding_priorities[i])))
7384 {
7385 detect_info.found = 1 << coding_priorities[i];
7386 id = coding_categories[coding_priorities[i]].id;
7387 val = Fcons (make_number (id), Qnil);
7388 break;
7389 }
7390 }
7391 else
7392 {
7393 int mask = detect_info.rejected | detect_info.found;
7394 int found = 0;
7395 val = Qnil;
7396
7397 for (i = coding_category_raw_text - 1; i >= 0; i--)
7398 {
7399 category = coding_priorities[i];
7400 if (! (mask & (1 << category)))
7401 {
7402 found |= 1 << category;
7403 id = coding_categories[category].id;
7404 if (id >= 0)
7405 val = Fcons (make_number (id), val);
7406 }
7407 }
7408 for (i = coding_category_raw_text - 1; i >= 0; i--)
7409 {
7410 category = coding_priorities[i];
7411 if (detect_info.found & (1 << category))
7412 {
7413 id = coding_categories[category].id;
7414 val = Fcons (make_number (id), val);
7415 }
7416 }
7417 detect_info.found |= found;
7418 }
7419 }
7420 else if (base_category == coding_category_utf_16_auto)
7421 {
7422 if (detect_coding_utf_16 (&coding, &detect_info))
7423 {
7424 struct coding_system *this;
7425
7426 if (detect_info.found & CATEGORY_MASK_UTF_16_LE)
7427 this = coding_categories + coding_category_utf_16_le;
7428 else if (detect_info.found & CATEGORY_MASK_UTF_16_BE)
7429 this = coding_categories + coding_category_utf_16_be;
7430 else if (detect_info.rejected & CATEGORY_MASK_UTF_16_LE_NOSIG)
7431 this = coding_categories + coding_category_utf_16_be_nosig;
7432 else
7433 this = coding_categories + coding_category_utf_16_le_nosig;
7434 val = Fcons (make_number (this->id), Qnil);
7435 }
7436 }
7437 else
7438 {
7439 detect_info.found = 1 << XINT (CODING_ATTR_CATEGORY (attrs));
7440 val = Fcons (make_number (coding.id), Qnil);
7441 }
7442
7443 /* Then, detect eol-format if necessary. */
7444 {
7445 int normal_eol = -1, utf_16_be_eol = -1, utf_16_le_eol;
7446 Lisp_Object tail;
7447
7448 if (VECTORP (eol_type))
7449 {
7450 if (detect_info.found & ~CATEGORY_MASK_UTF_16)
7451 normal_eol = detect_eol (coding.source, src_bytes,
7452 coding_category_raw_text);
7453 if (detect_info.found & (CATEGORY_MASK_UTF_16_BE
7454 | CATEGORY_MASK_UTF_16_BE_NOSIG))
7455 utf_16_be_eol = detect_eol (coding.source, src_bytes,
7456 coding_category_utf_16_be);
7457 if (detect_info.found & (CATEGORY_MASK_UTF_16_LE
7458 | CATEGORY_MASK_UTF_16_LE_NOSIG))
7459 utf_16_le_eol = detect_eol (coding.source, src_bytes,
7460 coding_category_utf_16_le);
7461 }
7462 else
7463 {
7464 if (EQ (eol_type, Qunix))
7465 normal_eol = utf_16_be_eol = utf_16_le_eol = EOL_SEEN_LF;
7466 else if (EQ (eol_type, Qdos))
7467 normal_eol = utf_16_be_eol = utf_16_le_eol = EOL_SEEN_CRLF;
7468 else
7469 normal_eol = utf_16_be_eol = utf_16_le_eol = EOL_SEEN_CR;
7470 }
7471
7472 for (tail = val; CONSP (tail); tail = XCDR (tail))
7473 {
7474 enum coding_category category;
7475 int this_eol;
7476
7477 id = XINT (XCAR (tail));
7478 attrs = CODING_ID_ATTRS (id);
7479 category = XINT (CODING_ATTR_CATEGORY (attrs));
7480 eol_type = CODING_ID_EOL_TYPE (id);
7481 if (VECTORP (eol_type))
7482 {
7483 if (category == coding_category_utf_16_be
7484 || category == coding_category_utf_16_be_nosig)
7485 this_eol = utf_16_be_eol;
7486 else if (category == coding_category_utf_16_le
7487 || category == coding_category_utf_16_le_nosig)
7488 this_eol = utf_16_le_eol;
7489 else
7490 this_eol = normal_eol;
7491
7492 if (this_eol == EOL_SEEN_LF)
7493 XSETCAR (tail, AREF (eol_type, 0));
7494 else if (this_eol == EOL_SEEN_CRLF)
7495 XSETCAR (tail, AREF (eol_type, 1));
7496 else if (this_eol == EOL_SEEN_CR)
7497 XSETCAR (tail, AREF (eol_type, 2));
7498 else
7499 XSETCAR (tail, CODING_ID_NAME (id));
7500 }
7501 else
7502 XSETCAR (tail, CODING_ID_NAME (id));
7503 }
7504 }
7505
7506 return (highest ? XCAR (val) : val);
7507 }
7508
7509
7510 DEFUN ("detect-coding-region", Fdetect_coding_region, Sdetect_coding_region,
7511 2, 3, 0,
7512 doc: /* Detect coding system of the text in the region between START and END.
7513 Return a list of possible coding systems ordered by priority.
7514
7515 If only ASCII characters are found (except for such ISO-2022 control
7516 characters ISO-2022 as ESC), it returns a list of single element
7517 `undecided' or its subsidiary coding system according to a detected
7518 end-of-line format.
7519
7520 If optional argument HIGHEST is non-nil, return the coding system of
7521 highest priority. */)
7522 (start, end, highest)
7523 Lisp_Object start, end, highest;
7524 {
7525 int from, to;
7526 int from_byte, to_byte;
7527
7528 CHECK_NUMBER_COERCE_MARKER (start);
7529 CHECK_NUMBER_COERCE_MARKER (end);
7530
7531 validate_region (&start, &end);
7532 from = XINT (start), to = XINT (end);
7533 from_byte = CHAR_TO_BYTE (from);
7534 to_byte = CHAR_TO_BYTE (to);
7535
7536 if (from < GPT && to >= GPT)
7537 move_gap_both (to, to_byte);
7538
7539 return detect_coding_system (BYTE_POS_ADDR (from_byte),
7540 to - from, to_byte - from_byte,
7541 !NILP (highest),
7542 !NILP (current_buffer
7543 ->enable_multibyte_characters),
7544 Qnil);
7545 }
7546
7547 DEFUN ("detect-coding-string", Fdetect_coding_string, Sdetect_coding_string,
7548 1, 2, 0,
7549 doc: /* Detect coding system of the text in STRING.
7550 Return a list of possible coding systems ordered by priority.
7551
7552 If only ASCII characters are found (except for such ISO-2022 control
7553 characters ISO-2022 as ESC), it returns a list of single element
7554 `undecided' or its subsidiary coding system according to a detected
7555 end-of-line format.
7556
7557 If optional argument HIGHEST is non-nil, return the coding system of
7558 highest priority. */)
7559 (string, highest)
7560 Lisp_Object string, highest;
7561 {
7562 CHECK_STRING (string);
7563
7564 return detect_coding_system (SDATA (string),
7565 SCHARS (string), SBYTES (string),
7566 !NILP (highest), STRING_MULTIBYTE (string),
7567 Qnil);
7568 }
7569
7570
7571 static INLINE int
7572 char_encodable_p (c, attrs)
7573 int c;
7574 Lisp_Object attrs;
7575 {
7576 Lisp_Object tail;
7577 struct charset *charset;
7578 Lisp_Object translation_table;
7579
7580 translation_table = CODING_ATTR_TRANS_TBL (attrs);
7581 if (! NILP (translation_table))
7582 c = translate_char (translation_table, c);
7583 for (tail = CODING_ATTR_CHARSET_LIST (attrs);
7584 CONSP (tail); tail = XCDR (tail))
7585 {
7586 charset = CHARSET_FROM_ID (XINT (XCAR (tail)));
7587 if (CHAR_CHARSET_P (c, charset))
7588 break;
7589 }
7590 return (! NILP (tail));
7591 }
7592
7593
7594 /* Return a list of coding systems that safely encode the text between
7595 START and END. If EXCLUDE is non-nil, it is a list of coding
7596 systems not to check. The returned list doesn't contain any such
7597 coding systems. In any case, if the text contains only ASCII or is
7598 unibyte, return t. */
7599
7600 DEFUN ("find-coding-systems-region-internal",
7601 Ffind_coding_systems_region_internal,
7602 Sfind_coding_systems_region_internal, 2, 3, 0,
7603 doc: /* Internal use only. */)
7604 (start, end, exclude)
7605 Lisp_Object start, end, exclude;
7606 {
7607 Lisp_Object coding_attrs_list, safe_codings;
7608 EMACS_INT start_byte, end_byte;
7609 const unsigned char *p, *pbeg, *pend;
7610 int c;
7611 Lisp_Object tail, elt;
7612
7613 if (STRINGP (start))
7614 {
7615 if (!STRING_MULTIBYTE (start)
7616 || SCHARS (start) == SBYTES (start))
7617 return Qt;
7618 start_byte = 0;
7619 end_byte = SBYTES (start);
7620 }
7621 else
7622 {
7623 CHECK_NUMBER_COERCE_MARKER (start);
7624 CHECK_NUMBER_COERCE_MARKER (end);
7625 if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end))
7626 args_out_of_range (start, end);
7627 if (NILP (current_buffer->enable_multibyte_characters))
7628 return Qt;
7629 start_byte = CHAR_TO_BYTE (XINT (start));
7630 end_byte = CHAR_TO_BYTE (XINT (end));
7631 if (XINT (end) - XINT (start) == end_byte - start_byte)
7632 return Qt;
7633
7634 if (XINT (start) < GPT && XINT (end) > GPT)
7635 {
7636 if ((GPT - XINT (start)) < (XINT (end) - GPT))
7637 move_gap_both (XINT (start), start_byte);
7638 else
7639 move_gap_both (XINT (end), end_byte);
7640 }
7641 }
7642
7643 coding_attrs_list = Qnil;
7644 for (tail = Vcoding_system_list; CONSP (tail); tail = XCDR (tail))
7645 if (NILP (exclude)
7646 || NILP (Fmemq (XCAR (tail), exclude)))
7647 {
7648 Lisp_Object attrs;
7649
7650 attrs = AREF (CODING_SYSTEM_SPEC (XCAR (tail)), 0);
7651 if (EQ (XCAR (tail), CODING_ATTR_BASE_NAME (attrs))
7652 && ! EQ (CODING_ATTR_TYPE (attrs), Qundecided))
7653 {
7654 ASET (attrs, coding_attr_trans_tbl,
7655 get_translation_table (attrs, 1, NULL));
7656 coding_attrs_list = Fcons (attrs, coding_attrs_list);
7657 }
7658 }
7659
7660 if (STRINGP (start))
7661 p = pbeg = SDATA (start);
7662 else
7663 p = pbeg = BYTE_POS_ADDR (start_byte);
7664 pend = p + (end_byte - start_byte);
7665
7666 while (p < pend && ASCII_BYTE_P (*p)) p++;
7667 while (p < pend && ASCII_BYTE_P (*(pend - 1))) pend--;
7668
7669 while (p < pend)
7670 {
7671 if (ASCII_BYTE_P (*p))
7672 p++;
7673 else
7674 {
7675 c = STRING_CHAR_ADVANCE (p);
7676
7677 charset_map_loaded = 0;
7678 for (tail = coding_attrs_list; CONSP (tail);)
7679 {
7680 elt = XCAR (tail);
7681 if (NILP (elt))
7682 tail = XCDR (tail);
7683 else if (char_encodable_p (c, elt))
7684 tail = XCDR (tail);
7685 else if (CONSP (XCDR (tail)))
7686 {
7687 XSETCAR (tail, XCAR (XCDR (tail)));
7688 XSETCDR (tail, XCDR (XCDR (tail)));
7689 }
7690 else
7691 {
7692 XSETCAR (tail, Qnil);
7693 tail = XCDR (tail);
7694 }
7695 }
7696 if (charset_map_loaded)
7697 {
7698 EMACS_INT p_offset = p - pbeg, pend_offset = pend - pbeg;
7699
7700 if (STRINGP (start))
7701 pbeg = SDATA (start);
7702 else
7703 pbeg = BYTE_POS_ADDR (start_byte);
7704 p = pbeg + p_offset;
7705 pend = pbeg + pend_offset;
7706 }
7707 }
7708 }
7709
7710 safe_codings = list2 (Qraw_text, Qno_conversion);
7711 for (tail = coding_attrs_list; CONSP (tail); tail = XCDR (tail))
7712 if (! NILP (XCAR (tail)))
7713 safe_codings = Fcons (CODING_ATTR_BASE_NAME (XCAR (tail)), safe_codings);
7714
7715 return safe_codings;
7716 }
7717
7718
7719 DEFUN ("unencodable-char-position", Funencodable_char_position,
7720 Sunencodable_char_position, 3, 5, 0,
7721 doc: /*
7722 Return position of first un-encodable character in a region.
7723 START and END specfiy the region and CODING-SYSTEM specifies the
7724 encoding to check. Return nil if CODING-SYSTEM does encode the region.
7725
7726 If optional 4th argument COUNT is non-nil, it specifies at most how
7727 many un-encodable characters to search. In this case, the value is a
7728 list of positions.
7729
7730 If optional 5th argument STRING is non-nil, it is a string to search
7731 for un-encodable characters. In that case, START and END are indexes
7732 to the string. */)
7733 (start, end, coding_system, count, string)
7734 Lisp_Object start, end, coding_system, count, string;
7735 {
7736 int n;
7737 struct coding_system coding;
7738 Lisp_Object attrs, charset_list, translation_table;
7739 Lisp_Object positions;
7740 int from, to;
7741 const unsigned char *p, *stop, *pend;
7742 int ascii_compatible;
7743
7744 setup_coding_system (Fcheck_coding_system (coding_system), &coding);
7745 attrs = CODING_ID_ATTRS (coding.id);
7746 if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
7747 return Qnil;
7748 ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
7749 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
7750 translation_table = get_translation_table (attrs, 1, NULL);
7751
7752 if (NILP (string))
7753 {
7754 validate_region (&start, &end);
7755 from = XINT (start);
7756 to = XINT (end);
7757 if (NILP (current_buffer->enable_multibyte_characters)
7758 || (ascii_compatible
7759 && (to - from) == (CHAR_TO_BYTE (to) - (CHAR_TO_BYTE (from)))))
7760 return Qnil;
7761 p = CHAR_POS_ADDR (from);
7762 pend = CHAR_POS_ADDR (to);
7763 if (from < GPT && to >= GPT)
7764 stop = GPT_ADDR;
7765 else
7766 stop = pend;
7767 }
7768 else
7769 {
7770 CHECK_STRING (string);
7771 CHECK_NATNUM (start);
7772 CHECK_NATNUM (end);
7773 from = XINT (start);
7774 to = XINT (end);
7775 if (from > to
7776 || to > SCHARS (string))
7777 args_out_of_range_3 (string, start, end);
7778 if (! STRING_MULTIBYTE (string))
7779 return Qnil;
7780 p = SDATA (string) + string_char_to_byte (string, from);
7781 stop = pend = SDATA (string) + string_char_to_byte (string, to);
7782 if (ascii_compatible && (to - from) == (pend - p))
7783 return Qnil;
7784 }
7785
7786 if (NILP (count))
7787 n = 1;
7788 else
7789 {
7790 CHECK_NATNUM (count);
7791 n = XINT (count);
7792 }
7793
7794 positions = Qnil;
7795 while (1)
7796 {
7797 int c;
7798
7799 if (ascii_compatible)
7800 while (p < stop && ASCII_BYTE_P (*p))
7801 p++, from++;
7802 if (p >= stop)
7803 {
7804 if (p >= pend)
7805 break;
7806 stop = pend;
7807 p = GAP_END_ADDR;
7808 }
7809
7810 c = STRING_CHAR_ADVANCE (p);
7811 if (! (ASCII_CHAR_P (c) && ascii_compatible)
7812 && ! char_charset (translate_char (translation_table, c),
7813 charset_list, NULL))
7814 {
7815 positions = Fcons (make_number (from), positions);
7816 n--;
7817 if (n == 0)
7818 break;
7819 }
7820
7821 from++;
7822 }
7823
7824 return (NILP (count) ? Fcar (positions) : Fnreverse (positions));
7825 }
7826
7827
7828 DEFUN ("check-coding-systems-region", Fcheck_coding_systems_region,
7829 Scheck_coding_systems_region, 3, 3, 0,
7830 doc: /* Check if the region is encodable by coding systems.
7831
7832 START and END are buffer positions specifying the region.
7833 CODING-SYSTEM-LIST is a list of coding systems to check.
7834
7835 The value is an alist ((CODING-SYSTEM POS0 POS1 ...) ...), where
7836 CODING-SYSTEM is a member of CODING-SYSTEM-LIst and can't encode the
7837 whole region, POS0, POS1, ... are buffer positions where non-encodable
7838 characters are found.
7839
7840 If all coding systems in CODING-SYSTEM-LIST can encode the region, the
7841 value is nil.
7842
7843 START may be a string. In that case, check if the string is
7844 encodable, and the value contains indices to the string instead of
7845 buffer positions. END is ignored. */)
7846 (start, end, coding_system_list)
7847 Lisp_Object start, end, coding_system_list;
7848 {
7849 Lisp_Object list;
7850 EMACS_INT start_byte, end_byte;
7851 int pos;
7852 const unsigned char *p, *pbeg, *pend;
7853 int c;
7854 Lisp_Object tail, elt, attrs;
7855
7856 if (STRINGP (start))
7857 {
7858 if (!STRING_MULTIBYTE (start)
7859 && SCHARS (start) != SBYTES (start))
7860 return Qnil;
7861 start_byte = 0;
7862 end_byte = SBYTES (start);
7863 pos = 0;
7864 }
7865 else
7866 {
7867 CHECK_NUMBER_COERCE_MARKER (start);
7868 CHECK_NUMBER_COERCE_MARKER (end);
7869 if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end))
7870 args_out_of_range (start, end);
7871 if (NILP (current_buffer->enable_multibyte_characters))
7872 return Qnil;
7873 start_byte = CHAR_TO_BYTE (XINT (start));
7874 end_byte = CHAR_TO_BYTE (XINT (end));
7875 if (XINT (end) - XINT (start) == end_byte - start_byte)
7876 return Qt;
7877
7878 if (XINT (start) < GPT && XINT (end) > GPT)
7879 {
7880 if ((GPT - XINT (start)) < (XINT (end) - GPT))
7881 move_gap_both (XINT (start), start_byte);
7882 else
7883 move_gap_both (XINT (end), end_byte);
7884 }
7885 pos = XINT (start);
7886 }
7887
7888 list = Qnil;
7889 for (tail = coding_system_list; CONSP (tail); tail = XCDR (tail))
7890 {
7891 elt = XCAR (tail);
7892 attrs = AREF (CODING_SYSTEM_SPEC (elt), 0);
7893 ASET (attrs, coding_attr_trans_tbl,
7894 get_translation_table (attrs, 1, NULL));
7895 list = Fcons (Fcons (elt, Fcons (attrs, Qnil)), list);
7896 }
7897
7898 if (STRINGP (start))
7899 p = pbeg = SDATA (start);
7900 else
7901 p = pbeg = BYTE_POS_ADDR (start_byte);
7902 pend = p + (end_byte - start_byte);
7903
7904 while (p < pend && ASCII_BYTE_P (*p)) p++, pos++;
7905 while (p < pend && ASCII_BYTE_P (*(pend - 1))) pend--;
7906
7907 while (p < pend)
7908 {
7909 if (ASCII_BYTE_P (*p))
7910 p++;
7911 else
7912 {
7913 c = STRING_CHAR_ADVANCE (p);
7914
7915 charset_map_loaded = 0;
7916 for (tail = list; CONSP (tail); tail = XCDR (tail))
7917 {
7918 elt = XCDR (XCAR (tail));
7919 if (! char_encodable_p (c, XCAR (elt)))
7920 XSETCDR (elt, Fcons (make_number (pos), XCDR (elt)));
7921 }
7922 if (charset_map_loaded)
7923 {
7924 EMACS_INT p_offset = p - pbeg, pend_offset = pend - pbeg;
7925
7926 if (STRINGP (start))
7927 pbeg = SDATA (start);
7928 else
7929 pbeg = BYTE_POS_ADDR (start_byte);
7930 p = pbeg + p_offset;
7931 pend = pbeg + pend_offset;
7932 }
7933 }
7934 pos++;
7935 }
7936
7937 tail = list;
7938 list = Qnil;
7939 for (; CONSP (tail); tail = XCDR (tail))
7940 {
7941 elt = XCAR (tail);
7942 if (CONSP (XCDR (XCDR (elt))))
7943 list = Fcons (Fcons (XCAR (elt), Fnreverse (XCDR (XCDR (elt)))),
7944 list);
7945 }
7946
7947 return list;
7948 }
7949
7950
7951 Lisp_Object
7952 code_convert_region (start, end, coding_system, dst_object, encodep, norecord)
7953 Lisp_Object start, end, coding_system, dst_object;
7954 int encodep, norecord;
7955 {
7956 struct coding_system coding;
7957 EMACS_INT from, from_byte, to, to_byte;
7958 Lisp_Object src_object;
7959
7960 CHECK_NUMBER_COERCE_MARKER (start);
7961 CHECK_NUMBER_COERCE_MARKER (end);
7962 if (NILP (coding_system))
7963 coding_system = Qno_conversion;
7964 else
7965 CHECK_CODING_SYSTEM (coding_system);
7966 src_object = Fcurrent_buffer ();
7967 if (NILP (dst_object))
7968 dst_object = src_object;
7969 else if (! EQ (dst_object, Qt))
7970 CHECK_BUFFER (dst_object);
7971
7972 validate_region (&start, &end);
7973 from = XFASTINT (start);
7974 from_byte = CHAR_TO_BYTE (from);
7975 to = XFASTINT (end);
7976 to_byte = CHAR_TO_BYTE (to);
7977
7978 setup_coding_system (coding_system, &coding);
7979 coding.mode |= CODING_MODE_LAST_BLOCK;
7980
7981 if (encodep)
7982 encode_coding_object (&coding, src_object, from, from_byte, to, to_byte,
7983 dst_object);
7984 else
7985 decode_coding_object (&coding, src_object, from, from_byte, to, to_byte,
7986 dst_object);
7987 if (! norecord)
7988 Vlast_coding_system_used = CODING_ID_NAME (coding.id);
7989
7990 return (BUFFERP (dst_object)
7991 ? make_number (coding.produced_char)
7992 : coding.dst_object);
7993 }
7994
7995
7996 DEFUN ("decode-coding-region", Fdecode_coding_region, Sdecode_coding_region,
7997 3, 4, "r\nzCoding system: ",
7998 doc: /* Decode the current region from the specified coding system.
7999 When called from a program, takes four arguments:
8000 START, END, CODING-SYSTEM, and DESTINATION.
8001 START and END are buffer positions.
8002
8003 Optional 4th arguments DESTINATION specifies where the decoded text goes.
8004 If nil, the region between START and END is replace by the decoded text.
8005 If buffer, the decoded text is inserted in the buffer.
8006 If t, the decoded text is returned.
8007
8008 This function sets `last-coding-system-used' to the precise coding system
8009 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
8010 not fully specified.)
8011 It returns the length of the decoded text. */)
8012 (start, end, coding_system, destination)
8013 Lisp_Object start, end, coding_system, destination;
8014 {
8015 return code_convert_region (start, end, coding_system, destination, 0, 0);
8016 }
8017
8018 DEFUN ("encode-coding-region", Fencode_coding_region, Sencode_coding_region,
8019 3, 4, "r\nzCoding system: ",
8020 doc: /* Encode the current region by specified coding system.
8021 When called from a program, takes three arguments:
8022 START, END, and CODING-SYSTEM. START and END are buffer positions.
8023
8024 Optional 4th arguments DESTINATION specifies where the encoded text goes.
8025 If nil, the region between START and END is replace by the encoded text.
8026 If buffer, the encoded text is inserted in the buffer.
8027 If t, the encoded text is returned.
8028
8029 This function sets `last-coding-system-used' to the precise coding system
8030 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
8031 not fully specified.)
8032 It returns the length of the encoded text. */)
8033 (start, end, coding_system, destination)
8034 Lisp_Object start, end, coding_system, destination;
8035 {
8036 return code_convert_region (start, end, coding_system, destination, 1, 0);
8037 }
8038
8039 Lisp_Object
8040 code_convert_string (string, coding_system, dst_object,
8041 encodep, nocopy, norecord)
8042 Lisp_Object string, coding_system, dst_object;
8043 int encodep, nocopy, norecord;
8044 {
8045 struct coding_system coding;
8046 EMACS_INT chars, bytes;
8047
8048 CHECK_STRING (string);
8049 if (NILP (coding_system))
8050 {
8051 if (! norecord)
8052 Vlast_coding_system_used = Qno_conversion;
8053 if (NILP (dst_object))
8054 return (nocopy ? Fcopy_sequence (string) : string);
8055 }
8056
8057 if (NILP (coding_system))
8058 coding_system = Qno_conversion;
8059 else
8060 CHECK_CODING_SYSTEM (coding_system);
8061 if (NILP (dst_object))
8062 dst_object = Qt;
8063 else if (! EQ (dst_object, Qt))
8064 CHECK_BUFFER (dst_object);
8065
8066 setup_coding_system (coding_system, &coding);
8067 coding.mode |= CODING_MODE_LAST_BLOCK;
8068 chars = SCHARS (string);
8069 bytes = SBYTES (string);
8070 if (encodep)
8071 encode_coding_object (&coding, string, 0, 0, chars, bytes, dst_object);
8072 else
8073 decode_coding_object (&coding, string, 0, 0, chars, bytes, dst_object);
8074 if (! norecord)
8075 Vlast_coding_system_used = CODING_ID_NAME (coding.id);
8076
8077 return (BUFFERP (dst_object)
8078 ? make_number (coding.produced_char)
8079 : coding.dst_object);
8080 }
8081
8082
8083 /* Encode or decode STRING according to CODING_SYSTEM.
8084 Do not set Vlast_coding_system_used.
8085
8086 This function is called only from macros DECODE_FILE and
8087 ENCODE_FILE, thus we ignore character composition. */
8088
8089 Lisp_Object
8090 code_convert_string_norecord (string, coding_system, encodep)
8091 Lisp_Object string, coding_system;
8092 int encodep;
8093 {
8094 return code_convert_string (string, coding_system, Qt, encodep, 0, 1);
8095 }
8096
8097
8098 DEFUN ("decode-coding-string", Fdecode_coding_string, Sdecode_coding_string,
8099 2, 4, 0,
8100 doc: /* Decode STRING which is encoded in CODING-SYSTEM, and return the result.
8101
8102 Optional third arg NOCOPY non-nil means it is OK to return STRING itself
8103 if the decoding operation is trivial.
8104
8105 Optional fourth arg BUFFER non-nil meant that the decoded text is
8106 inserted in BUFFER instead of returned as a string. In this case,
8107 the return value is BUFFER.
8108
8109 This function sets `last-coding-system-used' to the precise coding system
8110 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
8111 not fully specified. */)
8112 (string, coding_system, nocopy, buffer)
8113 Lisp_Object string, coding_system, nocopy, buffer;
8114 {
8115 return code_convert_string (string, coding_system, buffer,
8116 0, ! NILP (nocopy), 0);
8117 }
8118
8119 DEFUN ("encode-coding-string", Fencode_coding_string, Sencode_coding_string,
8120 2, 4, 0,
8121 doc: /* Encode STRING to CODING-SYSTEM, and return the result.
8122
8123 Optional third arg NOCOPY non-nil means it is OK to return STRING
8124 itself if the encoding operation is trivial.
8125
8126 Optional fourth arg BUFFER non-nil meant that the encoded text is
8127 inserted in BUFFER instead of returned as a string. In this case,
8128 the return value is BUFFER.
8129
8130 This function sets `last-coding-system-used' to the precise coding system
8131 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
8132 not fully specified.) */)
8133 (string, coding_system, nocopy, buffer)
8134 Lisp_Object string, coding_system, nocopy, buffer;
8135 {
8136 return code_convert_string (string, coding_system, buffer,
8137 1, ! NILP (nocopy), 1);
8138 }
8139
8140 \f
8141 DEFUN ("decode-sjis-char", Fdecode_sjis_char, Sdecode_sjis_char, 1, 1, 0,
8142 doc: /* Decode a Japanese character which has CODE in shift_jis encoding.
8143 Return the corresponding character. */)
8144 (code)
8145 Lisp_Object code;
8146 {
8147 Lisp_Object spec, attrs, val;
8148 struct charset *charset_roman, *charset_kanji, *charset_kana, *charset;
8149 int c;
8150
8151 CHECK_NATNUM (code);
8152 c = XFASTINT (code);
8153 CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system, spec);
8154 attrs = AREF (spec, 0);
8155
8156 if (ASCII_BYTE_P (c)
8157 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
8158 return code;
8159
8160 val = CODING_ATTR_CHARSET_LIST (attrs);
8161 charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
8162 charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
8163 charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val)));
8164
8165 if (c <= 0x7F)
8166 charset = charset_roman;
8167 else if (c >= 0xA0 && c < 0xDF)
8168 {
8169 charset = charset_kana;
8170 c -= 0x80;
8171 }
8172 else
8173 {
8174 int s1 = c >> 8, s2 = c & 0xFF;
8175
8176 if (s1 < 0x81 || (s1 > 0x9F && s1 < 0xE0) || s1 > 0xEF
8177 || s2 < 0x40 || s2 == 0x7F || s2 > 0xFC)
8178 error ("Invalid code: %d", code);
8179 SJIS_TO_JIS (c);
8180 charset = charset_kanji;
8181 }
8182 c = DECODE_CHAR (charset, c);
8183 if (c < 0)
8184 error ("Invalid code: %d", code);
8185 return make_number (c);
8186 }
8187
8188
8189 DEFUN ("encode-sjis-char", Fencode_sjis_char, Sencode_sjis_char, 1, 1, 0,
8190 doc: /* Encode a Japanese character CH to shift_jis encoding.
8191 Return the corresponding code in SJIS. */)
8192 (ch)
8193 Lisp_Object ch;
8194 {
8195 Lisp_Object spec, attrs, charset_list;
8196 int c;
8197 struct charset *charset;
8198 unsigned code;
8199
8200 CHECK_CHARACTER (ch);
8201 c = XFASTINT (ch);
8202 CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system, spec);
8203 attrs = AREF (spec, 0);
8204
8205 if (ASCII_CHAR_P (c)
8206 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
8207 return ch;
8208
8209 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
8210 charset = char_charset (c, charset_list, &code);
8211 if (code == CHARSET_INVALID_CODE (charset))
8212 error ("Can't encode by shift_jis encoding: %d", c);
8213 JIS_TO_SJIS (code);
8214
8215 return make_number (code);
8216 }
8217
8218 DEFUN ("decode-big5-char", Fdecode_big5_char, Sdecode_big5_char, 1, 1, 0,
8219 doc: /* Decode a Big5 character which has CODE in BIG5 coding system.
8220 Return the corresponding character. */)
8221 (code)
8222 Lisp_Object code;
8223 {
8224 Lisp_Object spec, attrs, val;
8225 struct charset *charset_roman, *charset_big5, *charset;
8226 int c;
8227
8228 CHECK_NATNUM (code);
8229 c = XFASTINT (code);
8230 CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system, spec);
8231 attrs = AREF (spec, 0);
8232
8233 if (ASCII_BYTE_P (c)
8234 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
8235 return code;
8236
8237 val = CODING_ATTR_CHARSET_LIST (attrs);
8238 charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
8239 charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val)));
8240
8241 if (c <= 0x7F)
8242 charset = charset_roman;
8243 else
8244 {
8245 int b1 = c >> 8, b2 = c & 0x7F;
8246 if (b1 < 0xA1 || b1 > 0xFE
8247 || b2 < 0x40 || (b2 > 0x7E && b2 < 0xA1) || b2 > 0xFE)
8248 error ("Invalid code: %d", code);
8249 charset = charset_big5;
8250 }
8251 c = DECODE_CHAR (charset, (unsigned )c);
8252 if (c < 0)
8253 error ("Invalid code: %d", code);
8254 return make_number (c);
8255 }
8256
8257 DEFUN ("encode-big5-char", Fencode_big5_char, Sencode_big5_char, 1, 1, 0,
8258 doc: /* Encode the Big5 character CH to BIG5 coding system.
8259 Return the corresponding character code in Big5. */)
8260 (ch)
8261 Lisp_Object ch;
8262 {
8263 Lisp_Object spec, attrs, charset_list;
8264 struct charset *charset;
8265 int c;
8266 unsigned code;
8267
8268 CHECK_CHARACTER (ch);
8269 c = XFASTINT (ch);
8270 CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system, spec);
8271 attrs = AREF (spec, 0);
8272 if (ASCII_CHAR_P (c)
8273 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
8274 return ch;
8275
8276 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
8277 charset = char_charset (c, charset_list, &code);
8278 if (code == CHARSET_INVALID_CODE (charset))
8279 error ("Can't encode by Big5 encoding: %d", c);
8280
8281 return make_number (code);
8282 }
8283
8284 \f
8285 DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_internal,
8286 Sset_terminal_coding_system_internal, 1, 2, 0,
8287 doc: /* Internal use only. */)
8288 (coding_system, terminal)
8289 Lisp_Object coding_system;
8290 Lisp_Object terminal;
8291 {
8292 struct coding_system *terminal_coding = TERMINAL_TERMINAL_CODING (get_terminal (terminal, 1));
8293 CHECK_SYMBOL (coding_system);
8294 setup_coding_system (Fcheck_coding_system (coding_system), terminal_coding);
8295 /* We had better not send unsafe characters to terminal. */
8296 terminal_coding->mode |= CODING_MODE_SAFE_ENCODING;
8297 /* Characer composition should be disabled. */
8298 terminal_coding->common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
8299 terminal_coding->src_multibyte = 1;
8300 terminal_coding->dst_multibyte = 0;
8301 return Qnil;
8302 }
8303
8304 DEFUN ("set-safe-terminal-coding-system-internal",
8305 Fset_safe_terminal_coding_system_internal,
8306 Sset_safe_terminal_coding_system_internal, 1, 1, 0,
8307 doc: /* Internal use only. */)
8308 (coding_system)
8309 Lisp_Object coding_system;
8310 {
8311 CHECK_SYMBOL (coding_system);
8312 setup_coding_system (Fcheck_coding_system (coding_system),
8313 &safe_terminal_coding);
8314 /* Characer composition should be disabled. */
8315 safe_terminal_coding.common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
8316 safe_terminal_coding.src_multibyte = 1;
8317 safe_terminal_coding.dst_multibyte = 0;
8318 return Qnil;
8319 }
8320
8321 DEFUN ("terminal-coding-system", Fterminal_coding_system,
8322 Sterminal_coding_system, 0, 1, 0,
8323 doc: /* Return coding system specified for terminal output on the given terminal.
8324 TERMINAL may be a terminal id, a frame, or nil for the selected
8325 frame's terminal device. */)
8326 (terminal)
8327 Lisp_Object terminal;
8328 {
8329 struct coding_system *terminal_coding
8330 = TERMINAL_TERMINAL_CODING (get_terminal (terminal, 1));
8331 Lisp_Object coding_system = CODING_ID_NAME (terminal_coding->id);
8332
8333 /* For backward compatibility, return nil if it is `undecided'. */
8334 return (! EQ (coding_system, Qundecided) ? coding_system : Qnil);
8335 }
8336
8337 DEFUN ("set-keyboard-coding-system-internal", Fset_keyboard_coding_system_internal,
8338 Sset_keyboard_coding_system_internal, 1, 2, 0,
8339 doc: /* Internal use only. */)
8340 (coding_system, terminal)
8341 Lisp_Object coding_system;
8342 Lisp_Object terminal;
8343 {
8344 struct terminal *t = get_terminal (terminal, 1);
8345 CHECK_SYMBOL (coding_system);
8346 setup_coding_system (Fcheck_coding_system (coding_system),
8347 TERMINAL_KEYBOARD_CODING (t));
8348 /* Characer composition should be disabled. */
8349 TERMINAL_KEYBOARD_CODING (t)->common_flags
8350 &= ~CODING_ANNOTATE_COMPOSITION_MASK;
8351 return Qnil;
8352 }
8353
8354 DEFUN ("keyboard-coding-system",
8355 Fkeyboard_coding_system, Skeyboard_coding_system, 0, 1, 0,
8356 doc: /* Return coding system specified for decoding keyboard input. */)
8357 (terminal)
8358 Lisp_Object terminal;
8359 {
8360 return CODING_ID_NAME (TERMINAL_KEYBOARD_CODING
8361 (get_terminal (terminal, 1))->id);
8362 }
8363
8364 \f
8365 DEFUN ("find-operation-coding-system", Ffind_operation_coding_system,
8366 Sfind_operation_coding_system, 1, MANY, 0,
8367 doc: /* Choose a coding system for an operation based on the target name.
8368 The value names a pair of coding systems: (DECODING-SYSTEM . ENCODING-SYSTEM).
8369 DECODING-SYSTEM is the coding system to use for decoding
8370 \(in case OPERATION does decoding), and ENCODING-SYSTEM is the coding system
8371 for encoding (in case OPERATION does encoding).
8372
8373 The first argument OPERATION specifies an I/O primitive:
8374 For file I/O, `insert-file-contents' or `write-region'.
8375 For process I/O, `call-process', `call-process-region', or `start-process'.
8376 For network I/O, `open-network-stream'.
8377
8378 The remaining arguments should be the same arguments that were passed
8379 to the primitive. Depending on which primitive, one of those arguments
8380 is selected as the TARGET. For example, if OPERATION does file I/O,
8381 whichever argument specifies the file name is TARGET.
8382
8383 TARGET has a meaning which depends on OPERATION:
8384 For file I/O, TARGET is a file name (except for the special case below).
8385 For process I/O, TARGET is a process name.
8386 For network I/O, TARGET is a service name or a port number
8387
8388 This function looks up what specified for TARGET in,
8389 `file-coding-system-alist', `process-coding-system-alist',
8390 or `network-coding-system-alist' depending on OPERATION.
8391 They may specify a coding system, a cons of coding systems,
8392 or a function symbol to call.
8393 In the last case, we call the function with one argument,
8394 which is a list of all the arguments given to this function.
8395 If the function can't decide a coding system, it can return
8396 `undecided' so that the normal code-detection is performed.
8397
8398 If OPERATION is `insert-file-contents', the argument corresponding to
8399 TARGET may be a cons (FILENAME . BUFFER). In that case, FILENAME is a
8400 file name to look up, and BUFFER is a buffer that contains the file's
8401 contents (not yet decoded). If `file-coding-system-alist' specifies a
8402 function to call for FILENAME, that function should examine the
8403 contents of BUFFER instead of reading the file.
8404
8405 usage: (find-operation-coding-system OPERATION ARGUMENTS...) */)
8406 (nargs, args)
8407 int nargs;
8408 Lisp_Object *args;
8409 {
8410 Lisp_Object operation, target_idx, target, val;
8411 register Lisp_Object chain;
8412
8413 if (nargs < 2)
8414 error ("Too few arguments");
8415 operation = args[0];
8416 if (!SYMBOLP (operation)
8417 || !INTEGERP (target_idx = Fget (operation, Qtarget_idx)))
8418 error ("Invalid first arguement");
8419 if (nargs < 1 + XINT (target_idx))
8420 error ("Too few arguments for operation: %s",
8421 SDATA (SYMBOL_NAME (operation)));
8422 target = args[XINT (target_idx) + 1];
8423 if (!(STRINGP (target)
8424 || (EQ (operation, Qinsert_file_contents) && CONSP (target)
8425 && STRINGP (XCAR (target)) && BUFFERP (XCDR (target)))
8426 || (EQ (operation, Qopen_network_stream) && INTEGERP (target))))
8427 error ("Invalid %dth argument", XINT (target_idx) + 1);
8428 if (CONSP (target))
8429 target = XCAR (target);
8430
8431 chain = ((EQ (operation, Qinsert_file_contents)
8432 || EQ (operation, Qwrite_region))
8433 ? Vfile_coding_system_alist
8434 : (EQ (operation, Qopen_network_stream)
8435 ? Vnetwork_coding_system_alist
8436 : Vprocess_coding_system_alist));
8437 if (NILP (chain))
8438 return Qnil;
8439
8440 for (; CONSP (chain); chain = XCDR (chain))
8441 {
8442 Lisp_Object elt;
8443
8444 elt = XCAR (chain);
8445 if (CONSP (elt)
8446 && ((STRINGP (target)
8447 && STRINGP (XCAR (elt))
8448 && fast_string_match (XCAR (elt), target) >= 0)
8449 || (INTEGERP (target) && EQ (target, XCAR (elt)))))
8450 {
8451 val = XCDR (elt);
8452 /* Here, if VAL is both a valid coding system and a valid
8453 function symbol, we return VAL as a coding system. */
8454 if (CONSP (val))
8455 return val;
8456 if (! SYMBOLP (val))
8457 return Qnil;
8458 if (! NILP (Fcoding_system_p (val)))
8459 return Fcons (val, val);
8460 if (! NILP (Ffboundp (val)))
8461 {
8462 /* We use call1 rather than safe_call1
8463 so as to get bug reports about functions called here
8464 which don't handle the current interface. */
8465 val = call1 (val, Flist (nargs, args));
8466 if (CONSP (val))
8467 return val;
8468 if (SYMBOLP (val) && ! NILP (Fcoding_system_p (val)))
8469 return Fcons (val, val);
8470 }
8471 return Qnil;
8472 }
8473 }
8474 return Qnil;
8475 }
8476
8477 DEFUN ("set-coding-system-priority", Fset_coding_system_priority,
8478 Sset_coding_system_priority, 0, MANY, 0,
8479 doc: /* Assign higher priority to the coding systems given as arguments.
8480 If multiple coding systems belongs to the same category,
8481 all but the first one are ignored.
8482
8483 usage: (set-coding-system-priority ...) */)
8484 (nargs, args)
8485 int nargs;
8486 Lisp_Object *args;
8487 {
8488 int i, j;
8489 int changed[coding_category_max];
8490 enum coding_category priorities[coding_category_max];
8491
8492 bzero (changed, sizeof changed);
8493
8494 for (i = j = 0; i < nargs; i++)
8495 {
8496 enum coding_category category;
8497 Lisp_Object spec, attrs;
8498
8499 CHECK_CODING_SYSTEM_GET_SPEC (args[i], spec);
8500 attrs = AREF (spec, 0);
8501 category = XINT (CODING_ATTR_CATEGORY (attrs));
8502 if (changed[category])
8503 /* Ignore this coding system because a coding system of the
8504 same category already had a higher priority. */
8505 continue;
8506 changed[category] = 1;
8507 priorities[j++] = category;
8508 if (coding_categories[category].id >= 0
8509 && ! EQ (args[i], CODING_ID_NAME (coding_categories[category].id)))
8510 setup_coding_system (args[i], &coding_categories[category]);
8511 Fset (AREF (Vcoding_category_table, category), args[i]);
8512 }
8513
8514 /* Now we have decided top J priorities. Reflect the order of the
8515 original priorities to the remaining priorities. */
8516
8517 for (i = j, j = 0; i < coding_category_max; i++, j++)
8518 {
8519 while (j < coding_category_max
8520 && changed[coding_priorities[j]])
8521 j++;
8522 if (j == coding_category_max)
8523 abort ();
8524 priorities[i] = coding_priorities[j];
8525 }
8526
8527 bcopy (priorities, coding_priorities, sizeof priorities);
8528
8529 /* Update `coding-category-list'. */
8530 Vcoding_category_list = Qnil;
8531 for (i = coding_category_max - 1; i >= 0; i--)
8532 Vcoding_category_list
8533 = Fcons (AREF (Vcoding_category_table, priorities[i]),
8534 Vcoding_category_list);
8535
8536 return Qnil;
8537 }
8538
8539 DEFUN ("coding-system-priority-list", Fcoding_system_priority_list,
8540 Scoding_system_priority_list, 0, 1, 0,
8541 doc: /* Return a list of coding systems ordered by their priorities.
8542 HIGHESTP non-nil means just return the highest priority one. */)
8543 (highestp)
8544 Lisp_Object highestp;
8545 {
8546 int i;
8547 Lisp_Object val;
8548
8549 for (i = 0, val = Qnil; i < coding_category_max; i++)
8550 {
8551 enum coding_category category = coding_priorities[i];
8552 int id = coding_categories[category].id;
8553 Lisp_Object attrs;
8554
8555 if (id < 0)
8556 continue;
8557 attrs = CODING_ID_ATTRS (id);
8558 if (! NILP (highestp))
8559 return CODING_ATTR_BASE_NAME (attrs);
8560 val = Fcons (CODING_ATTR_BASE_NAME (attrs), val);
8561 }
8562 return Fnreverse (val);
8563 }
8564
8565 static char *suffixes[] = { "-unix", "-dos", "-mac" };
8566
8567 static Lisp_Object
8568 make_subsidiaries (base)
8569 Lisp_Object base;
8570 {
8571 Lisp_Object subsidiaries;
8572 int base_name_len = SBYTES (SYMBOL_NAME (base));
8573 char *buf = (char *) alloca (base_name_len + 6);
8574 int i;
8575
8576 bcopy (SDATA (SYMBOL_NAME (base)), buf, base_name_len);
8577 subsidiaries = Fmake_vector (make_number (3), Qnil);
8578 for (i = 0; i < 3; i++)
8579 {
8580 bcopy (suffixes[i], buf + base_name_len, strlen (suffixes[i]) + 1);
8581 ASET (subsidiaries, i, intern (buf));
8582 }
8583 return subsidiaries;
8584 }
8585
8586
8587 DEFUN ("define-coding-system-internal", Fdefine_coding_system_internal,
8588 Sdefine_coding_system_internal, coding_arg_max, MANY, 0,
8589 doc: /* For internal use only.
8590 usage: (define-coding-system-internal ...) */)
8591 (nargs, args)
8592 int nargs;
8593 Lisp_Object *args;
8594 {
8595 Lisp_Object name;
8596 Lisp_Object spec_vec; /* [ ATTRS ALIASE EOL_TYPE ] */
8597 Lisp_Object attrs; /* Vector of attributes. */
8598 Lisp_Object eol_type;
8599 Lisp_Object aliases;
8600 Lisp_Object coding_type, charset_list, safe_charsets;
8601 enum coding_category category;
8602 Lisp_Object tail, val;
8603 int max_charset_id = 0;
8604 int i;
8605
8606 if (nargs < coding_arg_max)
8607 goto short_args;
8608
8609 attrs = Fmake_vector (make_number (coding_attr_last_index), Qnil);
8610
8611 name = args[coding_arg_name];
8612 CHECK_SYMBOL (name);
8613 CODING_ATTR_BASE_NAME (attrs) = name;
8614
8615 val = args[coding_arg_mnemonic];
8616 if (! STRINGP (val))
8617 CHECK_CHARACTER (val);
8618 CODING_ATTR_MNEMONIC (attrs) = val;
8619
8620 coding_type = args[coding_arg_coding_type];
8621 CHECK_SYMBOL (coding_type);
8622 CODING_ATTR_TYPE (attrs) = coding_type;
8623
8624 charset_list = args[coding_arg_charset_list];
8625 if (SYMBOLP (charset_list))
8626 {
8627 if (EQ (charset_list, Qiso_2022))
8628 {
8629 if (! EQ (coding_type, Qiso_2022))
8630 error ("Invalid charset-list");
8631 charset_list = Viso_2022_charset_list;
8632 }
8633 else if (EQ (charset_list, Qemacs_mule))
8634 {
8635 if (! EQ (coding_type, Qemacs_mule))
8636 error ("Invalid charset-list");
8637 charset_list = Vemacs_mule_charset_list;
8638 }
8639 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
8640 if (max_charset_id < XFASTINT (XCAR (tail)))
8641 max_charset_id = XFASTINT (XCAR (tail));
8642 }
8643 else
8644 {
8645 charset_list = Fcopy_sequence (charset_list);
8646 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
8647 {
8648 struct charset *charset;
8649
8650 val = XCAR (tail);
8651 CHECK_CHARSET_GET_CHARSET (val, charset);
8652 if (EQ (coding_type, Qiso_2022)
8653 ? CHARSET_ISO_FINAL (charset) < 0
8654 : EQ (coding_type, Qemacs_mule)
8655 ? CHARSET_EMACS_MULE_ID (charset) < 0
8656 : 0)
8657 error ("Can't handle charset `%s'",
8658 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
8659
8660 XSETCAR (tail, make_number (charset->id));
8661 if (max_charset_id < charset->id)
8662 max_charset_id = charset->id;
8663 }
8664 }
8665 CODING_ATTR_CHARSET_LIST (attrs) = charset_list;
8666
8667 safe_charsets = Fmake_string (make_number (max_charset_id + 1),
8668 make_number (255));
8669 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
8670 SSET (safe_charsets, XFASTINT (XCAR (tail)), 0);
8671 CODING_ATTR_SAFE_CHARSETS (attrs) = safe_charsets;
8672
8673 CODING_ATTR_ASCII_COMPAT (attrs) = args[coding_arg_ascii_compatible_p];
8674
8675 val = args[coding_arg_decode_translation_table];
8676 if (! CHAR_TABLE_P (val) && ! CONSP (val))
8677 CHECK_SYMBOL (val);
8678 CODING_ATTR_DECODE_TBL (attrs) = val;
8679
8680 val = args[coding_arg_encode_translation_table];
8681 if (! CHAR_TABLE_P (val) && ! CONSP (val))
8682 CHECK_SYMBOL (val);
8683 CODING_ATTR_ENCODE_TBL (attrs) = val;
8684
8685 val = args[coding_arg_post_read_conversion];
8686 CHECK_SYMBOL (val);
8687 CODING_ATTR_POST_READ (attrs) = val;
8688
8689 val = args[coding_arg_pre_write_conversion];
8690 CHECK_SYMBOL (val);
8691 CODING_ATTR_PRE_WRITE (attrs) = val;
8692
8693 val = args[coding_arg_default_char];
8694 if (NILP (val))
8695 CODING_ATTR_DEFAULT_CHAR (attrs) = make_number (' ');
8696 else
8697 {
8698 CHECK_CHARACTER (val);
8699 CODING_ATTR_DEFAULT_CHAR (attrs) = val;
8700 }
8701
8702 val = args[coding_arg_for_unibyte];
8703 CODING_ATTR_FOR_UNIBYTE (attrs) = NILP (val) ? Qnil : Qt;
8704
8705 val = args[coding_arg_plist];
8706 CHECK_LIST (val);
8707 CODING_ATTR_PLIST (attrs) = val;
8708
8709 if (EQ (coding_type, Qcharset))
8710 {
8711 /* Generate a lisp vector of 256 elements. Each element is nil,
8712 integer, or a list of charset IDs.
8713
8714 If Nth element is nil, the byte code N is invalid in this
8715 coding system.
8716
8717 If Nth element is a number NUM, N is the first byte of a
8718 charset whose ID is NUM.
8719
8720 If Nth element is a list of charset IDs, N is the first byte
8721 of one of them. The list is sorted by dimensions of the
8722 charsets. A charset of smaller dimension comes firtst. */
8723 val = Fmake_vector (make_number (256), Qnil);
8724
8725 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
8726 {
8727 struct charset *charset = CHARSET_FROM_ID (XFASTINT (XCAR (tail)));
8728 int dim = CHARSET_DIMENSION (charset);
8729 int idx = (dim - 1) * 4;
8730
8731 if (CHARSET_ASCII_COMPATIBLE_P (charset))
8732 CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
8733
8734 for (i = charset->code_space[idx];
8735 i <= charset->code_space[idx + 1]; i++)
8736 {
8737 Lisp_Object tmp, tmp2;
8738 int dim2;
8739
8740 tmp = AREF (val, i);
8741 if (NILP (tmp))
8742 tmp = XCAR (tail);
8743 else if (NUMBERP (tmp))
8744 {
8745 dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (tmp)));
8746 if (dim < dim2)
8747 tmp = Fcons (XCAR (tail), Fcons (tmp, Qnil));
8748 else
8749 tmp = Fcons (tmp, Fcons (XCAR (tail), Qnil));
8750 }
8751 else
8752 {
8753 for (tmp2 = tmp; CONSP (tmp2); tmp2 = XCDR (tmp2))
8754 {
8755 dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (XCAR (tmp2))));
8756 if (dim < dim2)
8757 break;
8758 }
8759 if (NILP (tmp2))
8760 tmp = nconc2 (tmp, Fcons (XCAR (tail), Qnil));
8761 else
8762 {
8763 XSETCDR (tmp2, Fcons (XCAR (tmp2), XCDR (tmp2)));
8764 XSETCAR (tmp2, XCAR (tail));
8765 }
8766 }
8767 ASET (val, i, tmp);
8768 }
8769 }
8770 ASET (attrs, coding_attr_charset_valids, val);
8771 category = coding_category_charset;
8772 }
8773 else if (EQ (coding_type, Qccl))
8774 {
8775 Lisp_Object valids;
8776
8777 if (nargs < coding_arg_ccl_max)
8778 goto short_args;
8779
8780 val = args[coding_arg_ccl_decoder];
8781 CHECK_CCL_PROGRAM (val);
8782 if (VECTORP (val))
8783 val = Fcopy_sequence (val);
8784 ASET (attrs, coding_attr_ccl_decoder, val);
8785
8786 val = args[coding_arg_ccl_encoder];
8787 CHECK_CCL_PROGRAM (val);
8788 if (VECTORP (val))
8789 val = Fcopy_sequence (val);
8790 ASET (attrs, coding_attr_ccl_encoder, val);
8791
8792 val = args[coding_arg_ccl_valids];
8793 valids = Fmake_string (make_number (256), make_number (0));
8794 for (tail = val; !NILP (tail); tail = Fcdr (tail))
8795 {
8796 int from, to;
8797
8798 val = Fcar (tail);
8799 if (INTEGERP (val))
8800 {
8801 from = to = XINT (val);
8802 if (from < 0 || from > 255)
8803 args_out_of_range_3 (val, make_number (0), make_number (255));
8804 }
8805 else
8806 {
8807 CHECK_CONS (val);
8808 CHECK_NATNUM_CAR (val);
8809 CHECK_NATNUM_CDR (val);
8810 from = XINT (XCAR (val));
8811 if (from > 255)
8812 args_out_of_range_3 (XCAR (val),
8813 make_number (0), make_number (255));
8814 to = XINT (XCDR (val));
8815 if (to < from || to > 255)
8816 args_out_of_range_3 (XCDR (val),
8817 XCAR (val), make_number (255));
8818 }
8819 for (i = from; i <= to; i++)
8820 SSET (valids, i, 1);
8821 }
8822 ASET (attrs, coding_attr_ccl_valids, valids);
8823
8824 category = coding_category_ccl;
8825 }
8826 else if (EQ (coding_type, Qutf_16))
8827 {
8828 Lisp_Object bom, endian;
8829
8830 CODING_ATTR_ASCII_COMPAT (attrs) = Qnil;
8831
8832 if (nargs < coding_arg_utf16_max)
8833 goto short_args;
8834
8835 bom = args[coding_arg_utf16_bom];
8836 if (! NILP (bom) && ! EQ (bom, Qt))
8837 {
8838 CHECK_CONS (bom);
8839 val = XCAR (bom);
8840 CHECK_CODING_SYSTEM (val);
8841 val = XCDR (bom);
8842 CHECK_CODING_SYSTEM (val);
8843 }
8844 ASET (attrs, coding_attr_utf_16_bom, bom);
8845
8846 endian = args[coding_arg_utf16_endian];
8847 CHECK_SYMBOL (endian);
8848 if (NILP (endian))
8849 endian = Qbig;
8850 else if (! EQ (endian, Qbig) && ! EQ (endian, Qlittle))
8851 error ("Invalid endian: %s", SDATA (SYMBOL_NAME (endian)));
8852 ASET (attrs, coding_attr_utf_16_endian, endian);
8853
8854 category = (CONSP (bom)
8855 ? coding_category_utf_16_auto
8856 : NILP (bom)
8857 ? (EQ (endian, Qbig)
8858 ? coding_category_utf_16_be_nosig
8859 : coding_category_utf_16_le_nosig)
8860 : (EQ (endian, Qbig)
8861 ? coding_category_utf_16_be
8862 : coding_category_utf_16_le));
8863 }
8864 else if (EQ (coding_type, Qiso_2022))
8865 {
8866 Lisp_Object initial, reg_usage, request, flags;
8867 int i;
8868
8869 if (nargs < coding_arg_iso2022_max)
8870 goto short_args;
8871
8872 initial = Fcopy_sequence (args[coding_arg_iso2022_initial]);
8873 CHECK_VECTOR (initial);
8874 for (i = 0; i < 4; i++)
8875 {
8876 val = Faref (initial, make_number (i));
8877 if (! NILP (val))
8878 {
8879 struct charset *charset;
8880
8881 CHECK_CHARSET_GET_CHARSET (val, charset);
8882 ASET (initial, i, make_number (CHARSET_ID (charset)));
8883 if (i == 0 && CHARSET_ASCII_COMPATIBLE_P (charset))
8884 CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
8885 }
8886 else
8887 ASET (initial, i, make_number (-1));
8888 }
8889
8890 reg_usage = args[coding_arg_iso2022_reg_usage];
8891 CHECK_CONS (reg_usage);
8892 CHECK_NUMBER_CAR (reg_usage);
8893 CHECK_NUMBER_CDR (reg_usage);
8894
8895 request = Fcopy_sequence (args[coding_arg_iso2022_request]);
8896 for (tail = request; ! NILP (tail); tail = Fcdr (tail))
8897 {
8898 int id;
8899 Lisp_Object tmp;
8900
8901 val = Fcar (tail);
8902 CHECK_CONS (val);
8903 tmp = XCAR (val);
8904 CHECK_CHARSET_GET_ID (tmp, id);
8905 CHECK_NATNUM_CDR (val);
8906 if (XINT (XCDR (val)) >= 4)
8907 error ("Invalid graphic register number: %d", XINT (XCDR (val)));
8908 XSETCAR (val, make_number (id));
8909 }
8910
8911 flags = args[coding_arg_iso2022_flags];
8912 CHECK_NATNUM (flags);
8913 i = XINT (flags);
8914 if (EQ (args[coding_arg_charset_list], Qiso_2022))
8915 flags = make_number (i | CODING_ISO_FLAG_FULL_SUPPORT);
8916
8917 ASET (attrs, coding_attr_iso_initial, initial);
8918 ASET (attrs, coding_attr_iso_usage, reg_usage);
8919 ASET (attrs, coding_attr_iso_request, request);
8920 ASET (attrs, coding_attr_iso_flags, flags);
8921 setup_iso_safe_charsets (attrs);
8922
8923 if (i & CODING_ISO_FLAG_SEVEN_BITS)
8924 category = ((i & (CODING_ISO_FLAG_LOCKING_SHIFT
8925 | CODING_ISO_FLAG_SINGLE_SHIFT))
8926 ? coding_category_iso_7_else
8927 : EQ (args[coding_arg_charset_list], Qiso_2022)
8928 ? coding_category_iso_7
8929 : coding_category_iso_7_tight);
8930 else
8931 {
8932 int id = XINT (AREF (initial, 1));
8933
8934 category = (((i & CODING_ISO_FLAG_LOCKING_SHIFT)
8935 || EQ (args[coding_arg_charset_list], Qiso_2022)
8936 || id < 0)
8937 ? coding_category_iso_8_else
8938 : (CHARSET_DIMENSION (CHARSET_FROM_ID (id)) == 1)
8939 ? coding_category_iso_8_1
8940 : coding_category_iso_8_2);
8941 }
8942 if (category != coding_category_iso_8_1
8943 && category != coding_category_iso_8_2)
8944 CODING_ATTR_ASCII_COMPAT (attrs) = Qnil;
8945 }
8946 else if (EQ (coding_type, Qemacs_mule))
8947 {
8948 if (EQ (args[coding_arg_charset_list], Qemacs_mule))
8949 ASET (attrs, coding_attr_emacs_mule_full, Qt);
8950 CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
8951 category = coding_category_emacs_mule;
8952 }
8953 else if (EQ (coding_type, Qshift_jis))
8954 {
8955
8956 struct charset *charset;
8957
8958 if (XINT (Flength (charset_list)) != 3
8959 && XINT (Flength (charset_list)) != 4)
8960 error ("There should be three or four charsets");
8961
8962 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
8963 if (CHARSET_DIMENSION (charset) != 1)
8964 error ("Dimension of charset %s is not one",
8965 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
8966 if (CHARSET_ASCII_COMPATIBLE_P (charset))
8967 CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
8968
8969 charset_list = XCDR (charset_list);
8970 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
8971 if (CHARSET_DIMENSION (charset) != 1)
8972 error ("Dimension of charset %s is not one",
8973 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
8974
8975 charset_list = XCDR (charset_list);
8976 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
8977 if (CHARSET_DIMENSION (charset) != 2)
8978 error ("Dimension of charset %s is not two",
8979 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
8980
8981 charset_list = XCDR (charset_list);
8982 if (! NILP (charset_list))
8983 {
8984 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
8985 if (CHARSET_DIMENSION (charset) != 2)
8986 error ("Dimension of charset %s is not two",
8987 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
8988 }
8989
8990 category = coding_category_sjis;
8991 Vsjis_coding_system = name;
8992 }
8993 else if (EQ (coding_type, Qbig5))
8994 {
8995 struct charset *charset;
8996
8997 if (XINT (Flength (charset_list)) != 2)
8998 error ("There should be just two charsets");
8999
9000 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
9001 if (CHARSET_DIMENSION (charset) != 1)
9002 error ("Dimension of charset %s is not one",
9003 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
9004 if (CHARSET_ASCII_COMPATIBLE_P (charset))
9005 CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
9006
9007 charset_list = XCDR (charset_list);
9008 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
9009 if (CHARSET_DIMENSION (charset) != 2)
9010 error ("Dimension of charset %s is not two",
9011 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
9012
9013 category = coding_category_big5;
9014 Vbig5_coding_system = name;
9015 }
9016 else if (EQ (coding_type, Qraw_text))
9017 {
9018 category = coding_category_raw_text;
9019 CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
9020 }
9021 else if (EQ (coding_type, Qutf_8))
9022 {
9023 category = coding_category_utf_8;
9024 CODING_ATTR_ASCII_COMPAT (attrs) = Qt;
9025 }
9026 else if (EQ (coding_type, Qundecided))
9027 category = coding_category_undecided;
9028 else
9029 error ("Invalid coding system type: %s",
9030 SDATA (SYMBOL_NAME (coding_type)));
9031
9032 CODING_ATTR_CATEGORY (attrs) = make_number (category);
9033 CODING_ATTR_PLIST (attrs)
9034 = Fcons (QCcategory, Fcons (AREF (Vcoding_category_table, category),
9035 CODING_ATTR_PLIST (attrs)));
9036 CODING_ATTR_PLIST (attrs)
9037 = Fcons (QCascii_compatible_p,
9038 Fcons (CODING_ATTR_ASCII_COMPAT (attrs),
9039 CODING_ATTR_PLIST (attrs)));
9040
9041 eol_type = args[coding_arg_eol_type];
9042 if (! NILP (eol_type)
9043 && ! EQ (eol_type, Qunix)
9044 && ! EQ (eol_type, Qdos)
9045 && ! EQ (eol_type, Qmac))
9046 error ("Invalid eol-type");
9047
9048 aliases = Fcons (name, Qnil);
9049
9050 if (NILP (eol_type))
9051 {
9052 eol_type = make_subsidiaries (name);
9053 for (i = 0; i < 3; i++)
9054 {
9055 Lisp_Object this_spec, this_name, this_aliases, this_eol_type;
9056
9057 this_name = AREF (eol_type, i);
9058 this_aliases = Fcons (this_name, Qnil);
9059 this_eol_type = (i == 0 ? Qunix : i == 1 ? Qdos : Qmac);
9060 this_spec = Fmake_vector (make_number (3), attrs);
9061 ASET (this_spec, 1, this_aliases);
9062 ASET (this_spec, 2, this_eol_type);
9063 Fputhash (this_name, this_spec, Vcoding_system_hash_table);
9064 Vcoding_system_list = Fcons (this_name, Vcoding_system_list);
9065 val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist);
9066 if (NILP (val))
9067 Vcoding_system_alist
9068 = Fcons (Fcons (Fsymbol_name (this_name), Qnil),
9069 Vcoding_system_alist);
9070 }
9071 }
9072
9073 spec_vec = Fmake_vector (make_number (3), attrs);
9074 ASET (spec_vec, 1, aliases);
9075 ASET (spec_vec, 2, eol_type);
9076
9077 Fputhash (name, spec_vec, Vcoding_system_hash_table);
9078 Vcoding_system_list = Fcons (name, Vcoding_system_list);
9079 val = Fassoc (Fsymbol_name (name), Vcoding_system_alist);
9080 if (NILP (val))
9081 Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (name), Qnil),
9082 Vcoding_system_alist);
9083
9084 {
9085 int id = coding_categories[category].id;
9086
9087 if (id < 0 || EQ (name, CODING_ID_NAME (id)))
9088 setup_coding_system (name, &coding_categories[category]);
9089 }
9090
9091 return Qnil;
9092
9093 short_args:
9094 return Fsignal (Qwrong_number_of_arguments,
9095 Fcons (intern ("define-coding-system-internal"),
9096 make_number (nargs)));
9097 }
9098
9099
9100 DEFUN ("coding-system-put", Fcoding_system_put, Scoding_system_put,
9101 3, 3, 0,
9102 doc: /* Change value in CODING-SYSTEM's property list PROP to VAL. */)
9103 (coding_system, prop, val)
9104 Lisp_Object coding_system, prop, val;
9105 {
9106 Lisp_Object spec, attrs;
9107
9108 CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
9109 attrs = AREF (spec, 0);
9110 if (EQ (prop, QCmnemonic))
9111 {
9112 if (! STRINGP (val))
9113 CHECK_CHARACTER (val);
9114 CODING_ATTR_MNEMONIC (attrs) = val;
9115 }
9116 else if (EQ (prop, QCdefalut_char))
9117 {
9118 if (NILP (val))
9119 val = make_number (' ');
9120 else
9121 CHECK_CHARACTER (val);
9122 CODING_ATTR_DEFAULT_CHAR (attrs) = val;
9123 }
9124 else if (EQ (prop, QCdecode_translation_table))
9125 {
9126 if (! CHAR_TABLE_P (val) && ! CONSP (val))
9127 CHECK_SYMBOL (val);
9128 CODING_ATTR_DECODE_TBL (attrs) = val;
9129 }
9130 else if (EQ (prop, QCencode_translation_table))
9131 {
9132 if (! CHAR_TABLE_P (val) && ! CONSP (val))
9133 CHECK_SYMBOL (val);
9134 CODING_ATTR_ENCODE_TBL (attrs) = val;
9135 }
9136 else if (EQ (prop, QCpost_read_conversion))
9137 {
9138 CHECK_SYMBOL (val);
9139 CODING_ATTR_POST_READ (attrs) = val;
9140 }
9141 else if (EQ (prop, QCpre_write_conversion))
9142 {
9143 CHECK_SYMBOL (val);
9144 CODING_ATTR_PRE_WRITE (attrs) = val;
9145 }
9146 else if (EQ (prop, QCascii_compatible_p))
9147 {
9148 CODING_ATTR_ASCII_COMPAT (attrs) = val;
9149 }
9150
9151 CODING_ATTR_PLIST (attrs)
9152 = Fplist_put (CODING_ATTR_PLIST (attrs), prop, val);
9153 return val;
9154 }
9155
9156
9157 DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias,
9158 Sdefine_coding_system_alias, 2, 2, 0,
9159 doc: /* Define ALIAS as an alias for CODING-SYSTEM. */)
9160 (alias, coding_system)
9161 Lisp_Object alias, coding_system;
9162 {
9163 Lisp_Object spec, aliases, eol_type, val;
9164
9165 CHECK_SYMBOL (alias);
9166 CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
9167 aliases = AREF (spec, 1);
9168 /* ALISES should be a list of length more than zero, and the first
9169 element is a base coding system. Append ALIAS at the tail of the
9170 list. */
9171 while (!NILP (XCDR (aliases)))
9172 aliases = XCDR (aliases);
9173 XSETCDR (aliases, Fcons (alias, Qnil));
9174
9175 eol_type = AREF (spec, 2);
9176 if (VECTORP (eol_type))
9177 {
9178 Lisp_Object subsidiaries;
9179 int i;
9180
9181 subsidiaries = make_subsidiaries (alias);
9182 for (i = 0; i < 3; i++)
9183 Fdefine_coding_system_alias (AREF (subsidiaries, i),
9184 AREF (eol_type, i));
9185 }
9186
9187 Fputhash (alias, spec, Vcoding_system_hash_table);
9188 Vcoding_system_list = Fcons (alias, Vcoding_system_list);
9189 val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist);
9190 if (NILP (val))
9191 Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (alias), Qnil),
9192 Vcoding_system_alist);
9193
9194 return Qnil;
9195 }
9196
9197 DEFUN ("coding-system-base", Fcoding_system_base, Scoding_system_base,
9198 1, 1, 0,
9199 doc: /* Return the base of CODING-SYSTEM.
9200 Any alias or subsidiary coding system is not a base coding system. */)
9201 (coding_system)
9202 Lisp_Object coding_system;
9203 {
9204 Lisp_Object spec, attrs;
9205
9206 if (NILP (coding_system))
9207 return (Qno_conversion);
9208 CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
9209 attrs = AREF (spec, 0);
9210 return CODING_ATTR_BASE_NAME (attrs);
9211 }
9212
9213 DEFUN ("coding-system-plist", Fcoding_system_plist, Scoding_system_plist,
9214 1, 1, 0,
9215 doc: "Return the property list of CODING-SYSTEM.")
9216 (coding_system)
9217 Lisp_Object coding_system;
9218 {
9219 Lisp_Object spec, attrs;
9220
9221 if (NILP (coding_system))
9222 coding_system = Qno_conversion;
9223 CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
9224 attrs = AREF (spec, 0);
9225 return CODING_ATTR_PLIST (attrs);
9226 }
9227
9228
9229 DEFUN ("coding-system-aliases", Fcoding_system_aliases, Scoding_system_aliases,
9230 1, 1, 0,
9231 doc: /* Return the list of aliases of CODING-SYSTEM. */)
9232 (coding_system)
9233 Lisp_Object coding_system;
9234 {
9235 Lisp_Object spec;
9236
9237 if (NILP (coding_system))
9238 coding_system = Qno_conversion;
9239 CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
9240 return AREF (spec, 1);
9241 }
9242
9243 DEFUN ("coding-system-eol-type", Fcoding_system_eol_type,
9244 Scoding_system_eol_type, 1, 1, 0,
9245 doc: /* Return eol-type of CODING-SYSTEM.
9246 An eol-type is integer 0, 1, 2, or a vector of coding systems.
9247
9248 Integer values 0, 1, and 2 indicate a format of end-of-line; LF, CRLF,
9249 and CR respectively.
9250
9251 A vector value indicates that a format of end-of-line should be
9252 detected automatically. Nth element of the vector is the subsidiary
9253 coding system whose eol-type is N. */)
9254 (coding_system)
9255 Lisp_Object coding_system;
9256 {
9257 Lisp_Object spec, eol_type;
9258 int n;
9259
9260 if (NILP (coding_system))
9261 coding_system = Qno_conversion;
9262 if (! CODING_SYSTEM_P (coding_system))
9263 return Qnil;
9264 spec = CODING_SYSTEM_SPEC (coding_system);
9265 eol_type = AREF (spec, 2);
9266 if (VECTORP (eol_type))
9267 return Fcopy_sequence (eol_type);
9268 n = EQ (eol_type, Qunix) ? 0 : EQ (eol_type, Qdos) ? 1 : 2;
9269 return make_number (n);
9270 }
9271
9272 #endif /* emacs */
9273
9274 \f
9275 /*** 9. Post-amble ***/
9276
9277 void
9278 init_coding_once ()
9279 {
9280 int i;
9281
9282 for (i = 0; i < coding_category_max; i++)
9283 {
9284 coding_categories[i].id = -1;
9285 coding_priorities[i] = i;
9286 }
9287
9288 /* ISO2022 specific initialize routine. */
9289 for (i = 0; i < 0x20; i++)
9290 iso_code_class[i] = ISO_control_0;
9291 for (i = 0x21; i < 0x7F; i++)
9292 iso_code_class[i] = ISO_graphic_plane_0;
9293 for (i = 0x80; i < 0xA0; i++)
9294 iso_code_class[i] = ISO_control_1;
9295 for (i = 0xA1; i < 0xFF; i++)
9296 iso_code_class[i] = ISO_graphic_plane_1;
9297 iso_code_class[0x20] = iso_code_class[0x7F] = ISO_0x20_or_0x7F;
9298 iso_code_class[0xA0] = iso_code_class[0xFF] = ISO_0xA0_or_0xFF;
9299 iso_code_class[ISO_CODE_SO] = ISO_shift_out;
9300 iso_code_class[ISO_CODE_SI] = ISO_shift_in;
9301 iso_code_class[ISO_CODE_SS2_7] = ISO_single_shift_2_7;
9302 iso_code_class[ISO_CODE_ESC] = ISO_escape;
9303 iso_code_class[ISO_CODE_SS2] = ISO_single_shift_2;
9304 iso_code_class[ISO_CODE_SS3] = ISO_single_shift_3;
9305 iso_code_class[ISO_CODE_CSI] = ISO_control_sequence_introducer;
9306
9307 for (i = 0; i < 256; i++)
9308 {
9309 emacs_mule_bytes[i] = 1;
9310 }
9311 emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_11] = 3;
9312 emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_12] = 3;
9313 emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_21] = 4;
9314 emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_22] = 4;
9315 }
9316
9317 #ifdef emacs
9318
9319 void
9320 syms_of_coding ()
9321 {
9322 staticpro (&Vcoding_system_hash_table);
9323 {
9324 Lisp_Object args[2];
9325 args[0] = QCtest;
9326 args[1] = Qeq;
9327 Vcoding_system_hash_table = Fmake_hash_table (2, args);
9328 }
9329
9330 staticpro (&Vsjis_coding_system);
9331 Vsjis_coding_system = Qnil;
9332
9333 staticpro (&Vbig5_coding_system);
9334 Vbig5_coding_system = Qnil;
9335
9336 staticpro (&Vcode_conversion_reused_workbuf);
9337 Vcode_conversion_reused_workbuf = Qnil;
9338
9339 staticpro (&Vcode_conversion_workbuf_name);
9340 Vcode_conversion_workbuf_name = build_string (" *code-conversion-work*");
9341
9342 reused_workbuf_in_use = 0;
9343
9344 DEFSYM (Qcharset, "charset");
9345 DEFSYM (Qtarget_idx, "target-idx");
9346 DEFSYM (Qcoding_system_history, "coding-system-history");
9347 Fset (Qcoding_system_history, Qnil);
9348
9349 /* Target FILENAME is the first argument. */
9350 Fput (Qinsert_file_contents, Qtarget_idx, make_number (0));
9351 /* Target FILENAME is the third argument. */
9352 Fput (Qwrite_region, Qtarget_idx, make_number (2));
9353
9354 DEFSYM (Qcall_process, "call-process");
9355 /* Target PROGRAM is the first argument. */
9356 Fput (Qcall_process, Qtarget_idx, make_number (0));
9357
9358 DEFSYM (Qcall_process_region, "call-process-region");
9359 /* Target PROGRAM is the third argument. */
9360 Fput (Qcall_process_region, Qtarget_idx, make_number (2));
9361
9362 DEFSYM (Qstart_process, "start-process");
9363 /* Target PROGRAM is the third argument. */
9364 Fput (Qstart_process, Qtarget_idx, make_number (2));
9365
9366 DEFSYM (Qopen_network_stream, "open-network-stream");
9367 /* Target SERVICE is the fourth argument. */
9368 Fput (Qopen_network_stream, Qtarget_idx, make_number (3));
9369
9370 DEFSYM (Qcoding_system, "coding-system");
9371 DEFSYM (Qcoding_aliases, "coding-aliases");
9372
9373 DEFSYM (Qeol_type, "eol-type");
9374 DEFSYM (Qunix, "unix");
9375 DEFSYM (Qdos, "dos");
9376
9377 DEFSYM (Qbuffer_file_coding_system, "buffer-file-coding-system");
9378 DEFSYM (Qpost_read_conversion, "post-read-conversion");
9379 DEFSYM (Qpre_write_conversion, "pre-write-conversion");
9380 DEFSYM (Qdefault_char, "default-char");
9381 DEFSYM (Qundecided, "undecided");
9382 DEFSYM (Qno_conversion, "no-conversion");
9383 DEFSYM (Qraw_text, "raw-text");
9384
9385 DEFSYM (Qiso_2022, "iso-2022");
9386
9387 DEFSYM (Qutf_8, "utf-8");
9388 DEFSYM (Qutf_8_emacs, "utf-8-emacs");
9389
9390 DEFSYM (Qutf_16, "utf-16");
9391 DEFSYM (Qbig, "big");
9392 DEFSYM (Qlittle, "little");
9393
9394 DEFSYM (Qshift_jis, "shift-jis");
9395 DEFSYM (Qbig5, "big5");
9396
9397 DEFSYM (Qcoding_system_p, "coding-system-p");
9398
9399 DEFSYM (Qcoding_system_error, "coding-system-error");
9400 Fput (Qcoding_system_error, Qerror_conditions,
9401 Fcons (Qcoding_system_error, Fcons (Qerror, Qnil)));
9402 Fput (Qcoding_system_error, Qerror_message,
9403 build_string ("Invalid coding system"));
9404
9405 /* Intern this now in case it isn't already done.
9406 Setting this variable twice is harmless.
9407 But don't staticpro it here--that is done in alloc.c. */
9408 Qchar_table_extra_slots = intern ("char-table-extra-slots");
9409
9410 DEFSYM (Qtranslation_table, "translation-table");
9411 Fput (Qtranslation_table, Qchar_table_extra_slots, make_number (2));
9412 DEFSYM (Qtranslation_table_id, "translation-table-id");
9413 DEFSYM (Qtranslation_table_for_decode, "translation-table-for-decode");
9414 DEFSYM (Qtranslation_table_for_encode, "translation-table-for-encode");
9415
9416 DEFSYM (Qvalid_codes, "valid-codes");
9417
9418 DEFSYM (Qemacs_mule, "emacs-mule");
9419
9420 DEFSYM (QCcategory, ":category");
9421 DEFSYM (QCmnemonic, ":mnemonic");
9422 DEFSYM (QCdefalut_char, ":default-char");
9423 DEFSYM (QCdecode_translation_table, ":decode-translation-table");
9424 DEFSYM (QCencode_translation_table, ":encode-translation-table");
9425 DEFSYM (QCpost_read_conversion, ":post-read-conversion");
9426 DEFSYM (QCpre_write_conversion, ":pre-write-conversion");
9427 DEFSYM (QCascii_compatible_p, ":ascii-compatible-p");
9428
9429 Vcoding_category_table
9430 = Fmake_vector (make_number (coding_category_max), Qnil);
9431 staticpro (&Vcoding_category_table);
9432 /* Followings are target of code detection. */
9433 ASET (Vcoding_category_table, coding_category_iso_7,
9434 intern ("coding-category-iso-7"));
9435 ASET (Vcoding_category_table, coding_category_iso_7_tight,
9436 intern ("coding-category-iso-7-tight"));
9437 ASET (Vcoding_category_table, coding_category_iso_8_1,
9438 intern ("coding-category-iso-8-1"));
9439 ASET (Vcoding_category_table, coding_category_iso_8_2,
9440 intern ("coding-category-iso-8-2"));
9441 ASET (Vcoding_category_table, coding_category_iso_7_else,
9442 intern ("coding-category-iso-7-else"));
9443 ASET (Vcoding_category_table, coding_category_iso_8_else,
9444 intern ("coding-category-iso-8-else"));
9445 ASET (Vcoding_category_table, coding_category_utf_8,
9446 intern ("coding-category-utf-8"));
9447 ASET (Vcoding_category_table, coding_category_utf_16_be,
9448 intern ("coding-category-utf-16-be"));
9449 ASET (Vcoding_category_table, coding_category_utf_16_auto,
9450 intern ("coding-category-utf-16-auto"));
9451 ASET (Vcoding_category_table, coding_category_utf_16_le,
9452 intern ("coding-category-utf-16-le"));
9453 ASET (Vcoding_category_table, coding_category_utf_16_be_nosig,
9454 intern ("coding-category-utf-16-be-nosig"));
9455 ASET (Vcoding_category_table, coding_category_utf_16_le_nosig,
9456 intern ("coding-category-utf-16-le-nosig"));
9457 ASET (Vcoding_category_table, coding_category_charset,
9458 intern ("coding-category-charset"));
9459 ASET (Vcoding_category_table, coding_category_sjis,
9460 intern ("coding-category-sjis"));
9461 ASET (Vcoding_category_table, coding_category_big5,
9462 intern ("coding-category-big5"));
9463 ASET (Vcoding_category_table, coding_category_ccl,
9464 intern ("coding-category-ccl"));
9465 ASET (Vcoding_category_table, coding_category_emacs_mule,
9466 intern ("coding-category-emacs-mule"));
9467 /* Followings are NOT target of code detection. */
9468 ASET (Vcoding_category_table, coding_category_raw_text,
9469 intern ("coding-category-raw-text"));
9470 ASET (Vcoding_category_table, coding_category_undecided,
9471 intern ("coding-category-undecided"));
9472
9473 DEFSYM (Qinsufficient_source, "insufficient-source");
9474 DEFSYM (Qinconsistent_eol, "inconsistent-eol");
9475 DEFSYM (Qinvalid_source, "invalid-source");
9476 DEFSYM (Qinterrupted, "interrupted");
9477 DEFSYM (Qinsufficient_memory, "insufficient-memory");
9478 DEFSYM (Qcoding_system_define_form, "coding-system-define-form");
9479
9480 defsubr (&Scoding_system_p);
9481 defsubr (&Sread_coding_system);
9482 defsubr (&Sread_non_nil_coding_system);
9483 defsubr (&Scheck_coding_system);
9484 defsubr (&Sdetect_coding_region);
9485 defsubr (&Sdetect_coding_string);
9486 defsubr (&Sfind_coding_systems_region_internal);
9487 defsubr (&Sunencodable_char_position);
9488 defsubr (&Scheck_coding_systems_region);
9489 defsubr (&Sdecode_coding_region);
9490 defsubr (&Sencode_coding_region);
9491 defsubr (&Sdecode_coding_string);
9492 defsubr (&Sencode_coding_string);
9493 defsubr (&Sdecode_sjis_char);
9494 defsubr (&Sencode_sjis_char);
9495 defsubr (&Sdecode_big5_char);
9496 defsubr (&Sencode_big5_char);
9497 defsubr (&Sset_terminal_coding_system_internal);
9498 defsubr (&Sset_safe_terminal_coding_system_internal);
9499 defsubr (&Sterminal_coding_system);
9500 defsubr (&Sset_keyboard_coding_system_internal);
9501 defsubr (&Skeyboard_coding_system);
9502 defsubr (&Sfind_operation_coding_system);
9503 defsubr (&Sset_coding_system_priority);
9504 defsubr (&Sdefine_coding_system_internal);
9505 defsubr (&Sdefine_coding_system_alias);
9506 defsubr (&Scoding_system_put);
9507 defsubr (&Scoding_system_base);
9508 defsubr (&Scoding_system_plist);
9509 defsubr (&Scoding_system_aliases);
9510 defsubr (&Scoding_system_eol_type);
9511 defsubr (&Scoding_system_priority_list);
9512
9513 DEFVAR_LISP ("coding-system-list", &Vcoding_system_list,
9514 doc: /* List of coding systems.
9515
9516 Do not alter the value of this variable manually. This variable should be
9517 updated by the functions `define-coding-system' and
9518 `define-coding-system-alias'. */);
9519 Vcoding_system_list = Qnil;
9520
9521 DEFVAR_LISP ("coding-system-alist", &Vcoding_system_alist,
9522 doc: /* Alist of coding system names.
9523 Each element is one element list of coding system name.
9524 This variable is given to `completing-read' as TABLE argument.
9525
9526 Do not alter the value of this variable manually. This variable should be
9527 updated by the functions `make-coding-system' and
9528 `define-coding-system-alias'. */);
9529 Vcoding_system_alist = Qnil;
9530
9531 DEFVAR_LISP ("coding-category-list", &Vcoding_category_list,
9532 doc: /* List of coding-categories (symbols) ordered by priority.
9533
9534 On detecting a coding system, Emacs tries code detection algorithms
9535 associated with each coding-category one by one in this order. When
9536 one algorithm agrees with a byte sequence of source text, the coding
9537 system bound to the corresponding coding-category is selected.
9538
9539 Don't modify this variable directly, but use `set-coding-priority'. */);
9540 {
9541 int i;
9542
9543 Vcoding_category_list = Qnil;
9544 for (i = coding_category_max - 1; i >= 0; i--)
9545 Vcoding_category_list
9546 = Fcons (XVECTOR (Vcoding_category_table)->contents[i],
9547 Vcoding_category_list);
9548 }
9549
9550 DEFVAR_LISP ("coding-system-for-read", &Vcoding_system_for_read,
9551 doc: /* Specify the coding system for read operations.
9552 It is useful to bind this variable with `let', but do not set it globally.
9553 If the value is a coding system, it is used for decoding on read operation.
9554 If not, an appropriate element is used from one of the coding system alists:
9555 There are three such tables, `file-coding-system-alist',
9556 `process-coding-system-alist', and `network-coding-system-alist'. */);
9557 Vcoding_system_for_read = Qnil;
9558
9559 DEFVAR_LISP ("coding-system-for-write", &Vcoding_system_for_write,
9560 doc: /* Specify the coding system for write operations.
9561 Programs bind this variable with `let', but you should not set it globally.
9562 If the value is a coding system, it is used for encoding of output,
9563 when writing it to a file and when sending it to a file or subprocess.
9564
9565 If this does not specify a coding system, an appropriate element
9566 is used from one of the coding system alists:
9567 There are three such tables, `file-coding-system-alist',
9568 `process-coding-system-alist', and `network-coding-system-alist'.
9569 For output to files, if the above procedure does not specify a coding system,
9570 the value of `buffer-file-coding-system' is used. */);
9571 Vcoding_system_for_write = Qnil;
9572
9573 DEFVAR_LISP ("last-coding-system-used", &Vlast_coding_system_used,
9574 doc: /*
9575 Coding system used in the latest file or process I/O. */);
9576 Vlast_coding_system_used = Qnil;
9577
9578 DEFVAR_LISP ("last-code-conversion-error", &Vlast_code_conversion_error,
9579 doc: /*
9580 Error status of the last code conversion.
9581
9582 When an error was detected in the last code conversion, this variable
9583 is set to one of the following symbols.
9584 `insufficient-source'
9585 `inconsistent-eol'
9586 `invalid-source'
9587 `interrupted'
9588 `insufficient-memory'
9589 When no error was detected, the value doesn't change. So, to check
9590 the error status of a code conversion by this variable, you must
9591 explicitly set this variable to nil before performing code
9592 conversion. */);
9593 Vlast_code_conversion_error = Qnil;
9594
9595 DEFVAR_BOOL ("inhibit-eol-conversion", &inhibit_eol_conversion,
9596 doc: /*
9597 *Non-nil means always inhibit code conversion of end-of-line format.
9598 See info node `Coding Systems' and info node `Text and Binary' concerning
9599 such conversion. */);
9600 inhibit_eol_conversion = 0;
9601
9602 DEFVAR_BOOL ("inherit-process-coding-system", &inherit_process_coding_system,
9603 doc: /*
9604 Non-nil means process buffer inherits coding system of process output.
9605 Bind it to t if the process output is to be treated as if it were a file
9606 read from some filesystem. */);
9607 inherit_process_coding_system = 0;
9608
9609 DEFVAR_LISP ("file-coding-system-alist", &Vfile_coding_system_alist,
9610 doc: /*
9611 Alist to decide a coding system to use for a file I/O operation.
9612 The format is ((PATTERN . VAL) ...),
9613 where PATTERN is a regular expression matching a file name,
9614 VAL is a coding system, a cons of coding systems, or a function symbol.
9615 If VAL is a coding system, it is used for both decoding and encoding
9616 the file contents.
9617 If VAL is a cons of coding systems, the car part is used for decoding,
9618 and the cdr part is used for encoding.
9619 If VAL is a function symbol, the function must return a coding system
9620 or a cons of coding systems which are used as above. The function is
9621 called with an argument that is a list of the arguments with which
9622 `find-operation-coding-system' was called. If the function can't decide
9623 a coding system, it can return `undecided' so that the normal
9624 code-detection is performed.
9625
9626 See also the function `find-operation-coding-system'
9627 and the variable `auto-coding-alist'. */);
9628 Vfile_coding_system_alist = Qnil;
9629
9630 DEFVAR_LISP ("process-coding-system-alist", &Vprocess_coding_system_alist,
9631 doc: /*
9632 Alist to decide a coding system to use for a process I/O operation.
9633 The format is ((PATTERN . VAL) ...),
9634 where PATTERN is a regular expression matching a program name,
9635 VAL is a coding system, a cons of coding systems, or a function symbol.
9636 If VAL is a coding system, it is used for both decoding what received
9637 from the program and encoding what sent to the program.
9638 If VAL is a cons of coding systems, the car part is used for decoding,
9639 and the cdr part is used for encoding.
9640 If VAL is a function symbol, the function must return a coding system
9641 or a cons of coding systems which are used as above.
9642
9643 See also the function `find-operation-coding-system'. */);
9644 Vprocess_coding_system_alist = Qnil;
9645
9646 DEFVAR_LISP ("network-coding-system-alist", &Vnetwork_coding_system_alist,
9647 doc: /*
9648 Alist to decide a coding system to use for a network I/O operation.
9649 The format is ((PATTERN . VAL) ...),
9650 where PATTERN is a regular expression matching a network service name
9651 or is a port number to connect to,
9652 VAL is a coding system, a cons of coding systems, or a function symbol.
9653 If VAL is a coding system, it is used for both decoding what received
9654 from the network stream and encoding what sent to the network stream.
9655 If VAL is a cons of coding systems, the car part is used for decoding,
9656 and the cdr part is used for encoding.
9657 If VAL is a function symbol, the function must return a coding system
9658 or a cons of coding systems which are used as above.
9659
9660 See also the function `find-operation-coding-system'. */);
9661 Vnetwork_coding_system_alist = Qnil;
9662
9663 DEFVAR_LISP ("locale-coding-system", &Vlocale_coding_system,
9664 doc: /* Coding system to use with system messages.
9665 Also used for decoding keyboard input on X Window system. */);
9666 Vlocale_coding_system = Qnil;
9667
9668 /* The eol mnemonics are reset in startup.el system-dependently. */
9669 DEFVAR_LISP ("eol-mnemonic-unix", &eol_mnemonic_unix,
9670 doc: /*
9671 *String displayed in mode line for UNIX-like (LF) end-of-line format. */);
9672 eol_mnemonic_unix = build_string (":");
9673
9674 DEFVAR_LISP ("eol-mnemonic-dos", &eol_mnemonic_dos,
9675 doc: /*
9676 *String displayed in mode line for DOS-like (CRLF) end-of-line format. */);
9677 eol_mnemonic_dos = build_string ("\\");
9678
9679 DEFVAR_LISP ("eol-mnemonic-mac", &eol_mnemonic_mac,
9680 doc: /*
9681 *String displayed in mode line for MAC-like (CR) end-of-line format. */);
9682 eol_mnemonic_mac = build_string ("/");
9683
9684 DEFVAR_LISP ("eol-mnemonic-undecided", &eol_mnemonic_undecided,
9685 doc: /*
9686 *String displayed in mode line when end-of-line format is not yet determined. */);
9687 eol_mnemonic_undecided = build_string (":");
9688
9689 DEFVAR_LISP ("enable-character-translation", &Venable_character_translation,
9690 doc: /*
9691 *Non-nil enables character translation while encoding and decoding. */);
9692 Venable_character_translation = Qt;
9693
9694 DEFVAR_LISP ("standard-translation-table-for-decode",
9695 &Vstandard_translation_table_for_decode,
9696 doc: /* Table for translating characters while decoding. */);
9697 Vstandard_translation_table_for_decode = Qnil;
9698
9699 DEFVAR_LISP ("standard-translation-table-for-encode",
9700 &Vstandard_translation_table_for_encode,
9701 doc: /* Table for translating characters while encoding. */);
9702 Vstandard_translation_table_for_encode = Qnil;
9703
9704 DEFVAR_LISP ("charset-revision-table", &Vcharset_revision_table,
9705 doc: /* Alist of charsets vs revision numbers.
9706 While encoding, if a charset (car part of an element) is found,
9707 designate it with the escape sequence identifying revision (cdr part
9708 of the element). */);
9709 Vcharset_revision_table = Qnil;
9710
9711 DEFVAR_LISP ("default-process-coding-system",
9712 &Vdefault_process_coding_system,
9713 doc: /* Cons of coding systems used for process I/O by default.
9714 The car part is used for decoding a process output,
9715 the cdr part is used for encoding a text to be sent to a process. */);
9716 Vdefault_process_coding_system = Qnil;
9717
9718 DEFVAR_LISP ("latin-extra-code-table", &Vlatin_extra_code_table,
9719 doc: /*
9720 Table of extra Latin codes in the range 128..159 (inclusive).
9721 This is a vector of length 256.
9722 If Nth element is non-nil, the existence of code N in a file
9723 \(or output of subprocess) doesn't prevent it to be detected as
9724 a coding system of ISO 2022 variant which has a flag
9725 `accept-latin-extra-code' t (e.g. iso-latin-1) on reading a file
9726 or reading output of a subprocess.
9727 Only 128th through 159th elements has a meaning. */);
9728 Vlatin_extra_code_table = Fmake_vector (make_number (256), Qnil);
9729
9730 DEFVAR_LISP ("select-safe-coding-system-function",
9731 &Vselect_safe_coding_system_function,
9732 doc: /*
9733 Function to call to select safe coding system for encoding a text.
9734
9735 If set, this function is called to force a user to select a proper
9736 coding system which can encode the text in the case that a default
9737 coding system used in each operation can't encode the text.
9738
9739 The default value is `select-safe-coding-system' (which see). */);
9740 Vselect_safe_coding_system_function = Qnil;
9741
9742 DEFVAR_BOOL ("coding-system-require-warning",
9743 &coding_system_require_warning,
9744 doc: /* Internal use only.
9745 If non-nil, on writing a file, `select-safe-coding-system-function' is
9746 called even if `coding-system-for-write' is non-nil. The command
9747 `universal-coding-system-argument' binds this variable to t temporarily. */);
9748 coding_system_require_warning = 0;
9749
9750
9751 DEFVAR_BOOL ("inhibit-iso-escape-detection",
9752 &inhibit_iso_escape_detection,
9753 doc: /*
9754 If non-nil, Emacs ignores ISO2022's escape sequence on code detection.
9755
9756 By default, on reading a file, Emacs tries to detect how the text is
9757 encoded. This code detection is sensitive to escape sequences. If
9758 the sequence is valid as ISO2022, the code is determined as one of
9759 the ISO2022 encodings, and the file is decoded by the corresponding
9760 coding system (e.g. `iso-2022-7bit').
9761
9762 However, there may be a case that you want to read escape sequences in
9763 a file as is. In such a case, you can set this variable to non-nil.
9764 Then, as the code detection ignores any escape sequences, no file is
9765 detected as encoded in some ISO2022 encoding. The result is that all
9766 escape sequences become visible in a buffer.
9767
9768 The default value is nil, and it is strongly recommended not to change
9769 it. That is because many Emacs Lisp source files that contain
9770 non-ASCII characters are encoded by the coding system `iso-2022-7bit'
9771 in Emacs's distribution, and they won't be decoded correctly on
9772 reading if you suppress escape sequence detection.
9773
9774 The other way to read escape sequences in a file without decoding is
9775 to explicitly specify some coding system that doesn't use ISO2022's
9776 escape sequence (e.g `latin-1') on reading by \\[universal-coding-system-argument]. */);
9777 inhibit_iso_escape_detection = 0;
9778
9779 DEFVAR_LISP ("translation-table-for-input", &Vtranslation_table_for_input,
9780 doc: /* Char table for translating self-inserting characters.
9781 This is applied to the result of input methods, not their input. See also
9782 `keyboard-translate-table'. */);
9783 Vtranslation_table_for_input = Qnil;
9784
9785 {
9786 Lisp_Object args[coding_arg_max];
9787 Lisp_Object plist[16];
9788 int i;
9789
9790 for (i = 0; i < coding_arg_max; i++)
9791 args[i] = Qnil;
9792
9793 plist[0] = intern (":name");
9794 plist[1] = args[coding_arg_name] = Qno_conversion;
9795 plist[2] = intern (":mnemonic");
9796 plist[3] = args[coding_arg_mnemonic] = make_number ('=');
9797 plist[4] = intern (":coding-type");
9798 plist[5] = args[coding_arg_coding_type] = Qraw_text;
9799 plist[6] = intern (":ascii-compatible-p");
9800 plist[7] = args[coding_arg_ascii_compatible_p] = Qt;
9801 plist[8] = intern (":default-char");
9802 plist[9] = args[coding_arg_default_char] = make_number (0);
9803 plist[10] = intern (":for-unibyte");
9804 plist[11] = args[coding_arg_for_unibyte] = Qt;
9805 plist[12] = intern (":docstring");
9806 plist[13] = build_string ("Do no conversion.\n\
9807 \n\
9808 When you visit a file with this coding, the file is read into a\n\
9809 unibyte buffer as is, thus each byte of a file is treated as a\n\
9810 character.");
9811 plist[14] = intern (":eol-type");
9812 plist[15] = args[coding_arg_eol_type] = Qunix;
9813 args[coding_arg_plist] = Flist (16, plist);
9814 Fdefine_coding_system_internal (coding_arg_max, args);
9815
9816 plist[1] = args[coding_arg_name] = Qundecided;
9817 plist[3] = args[coding_arg_mnemonic] = make_number ('-');
9818 plist[5] = args[coding_arg_coding_type] = Qundecided;
9819 /* This is already set.
9820 plist[7] = args[coding_arg_ascii_compatible_p] = Qt; */
9821 plist[8] = intern (":charset-list");
9822 plist[9] = args[coding_arg_charset_list] = Fcons (Qascii, Qnil);
9823 plist[11] = args[coding_arg_for_unibyte] = Qnil;
9824 plist[13] = build_string ("No conversion on encoding, automatic conversion on decoding.");
9825 plist[15] = args[coding_arg_eol_type] = Qnil;
9826 args[coding_arg_plist] = Flist (16, plist);
9827 Fdefine_coding_system_internal (coding_arg_max, args);
9828 }
9829
9830 setup_coding_system (Qno_conversion, &safe_terminal_coding);
9831
9832 {
9833 int i;
9834
9835 for (i = 0; i < coding_category_max; i++)
9836 Fset (AREF (Vcoding_category_table, i), Qno_conversion);
9837 }
9838 #if defined (MSDOS) || defined (WINDOWSNT)
9839 system_eol_type = Qdos;
9840 #else
9841 system_eol_type = Qunix;
9842 #endif
9843 staticpro (&system_eol_type);
9844 }
9845
9846 char *
9847 emacs_strerror (error_number)
9848 int error_number;
9849 {
9850 char *str;
9851
9852 synchronize_system_messages_locale ();
9853 str = strerror (error_number);
9854
9855 if (! NILP (Vlocale_coding_system))
9856 {
9857 Lisp_Object dec = code_convert_string_norecord (build_string (str),
9858 Vlocale_coding_system,
9859 0);
9860 str = (char *) SDATA (dec);
9861 }
9862
9863 return str;
9864 }
9865
9866 #endif /* emacs */
9867
9868 /* arch-tag: 3a3a2b01-5ff6-4071-9afe-f5b808d9229d
9869 (do not change this comment) */