* test/automated/ruby-mode-tests.el:
[emacs.git] / src / coding.c
blob6c0633f2d9369825efa7eaf2377eda0cb5321b5f
1 /* Coding system handler (conversion, detection, etc).
2 Copyright (C) 2001-2013 Free Software Foundation, Inc.
3 Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009, 2010, 2011
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H14PRO021
7 Copyright (C) 2003
8 National Institute of Advanced Industrial Science and Technology (AIST)
9 Registration Number H13PRO009
11 This file is part of GNU Emacs.
13 GNU Emacs is free software: you can redistribute it and/or modify
14 it under the terms of the GNU General Public License as published by
15 the Free Software Foundation, either version 3 of the License, or
16 (at your option) any later version.
18 GNU Emacs is distributed in the hope that it will be useful,
19 but WITHOUT ANY WARRANTY; without even the implied warranty of
20 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 GNU General Public License for more details.
23 You should have received a copy of the GNU General Public License
24 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
26 /*** TABLE OF CONTENTS ***
28 0. General comments
29 1. Preamble
30 2. Emacs' internal format (emacs-utf-8) handlers
31 3. UTF-8 handlers
32 4. UTF-16 handlers
33 5. Charset-base coding systems handlers
34 6. emacs-mule (old Emacs' internal format) handlers
35 7. ISO2022 handlers
36 8. Shift-JIS and BIG5 handlers
37 9. CCL handlers
38 10. C library functions
39 11. Emacs Lisp library functions
40 12. Postamble
44 /*** 0. General comments ***
47 CODING SYSTEM
49 A coding system is an object for an encoding mechanism that contains
50 information about how to convert byte sequences to character
51 sequences and vice versa. When we say "decode", it means converting
52 a byte sequence of a specific coding system into a character
53 sequence that is represented by Emacs' internal coding system
54 `emacs-utf-8', and when we say "encode", it means converting a
55 character sequence of emacs-utf-8 to a byte sequence of a specific
56 coding system.
58 In Emacs Lisp, a coding system is represented by a Lisp symbol. On
59 the C level, a coding system is represented by a vector of attributes
60 stored in the hash table Vcharset_hash_table. The conversion from
61 coding system symbol to attributes vector is done by looking up
62 Vcharset_hash_table by the symbol.
64 Coding systems are classified into the following types depending on
65 the encoding mechanism. Here's a brief description of the types.
67 o UTF-8
69 o UTF-16
71 o Charset-base coding system
73 A coding system defined by one or more (coded) character sets.
74 Decoding and encoding are done by a code converter defined for each
75 character set.
77 o Old Emacs internal format (emacs-mule)
79 The coding system adopted by old versions of Emacs (20 and 21).
81 o ISO2022-base coding system
83 The most famous coding system for multiple character sets. X's
84 Compound Text, various EUCs (Extended Unix Code), and coding systems
85 used in the Internet communication such as ISO-2022-JP are all
86 variants of ISO2022.
88 o SJIS (or Shift-JIS or MS-Kanji-Code)
90 A coding system to encode character sets: ASCII, JISX0201, and
91 JISX0208. Widely used for PC's in Japan. Details are described in
92 section 8.
94 o BIG5
96 A coding system to encode character sets: ASCII and Big5. Widely
97 used for Chinese (mainly in Taiwan and Hong Kong). Details are
98 described in section 8. In this file, when we write "big5" (all
99 lowercase), we mean the coding system, and when we write "Big5"
100 (capitalized), we mean the character set.
102 o CCL
104 If a user wants to decode/encode text encoded in a coding system
105 not listed above, he can supply a decoder and an encoder for it in
106 CCL (Code Conversion Language) programs. Emacs executes the CCL
107 program while decoding/encoding.
109 o Raw-text
111 A coding system for text containing raw eight-bit data. Emacs
112 treats each byte of source text as a character (except for
113 end-of-line conversion).
115 o No-conversion
117 Like raw text, but don't do end-of-line conversion.
120 END-OF-LINE FORMAT
122 How text end-of-line is encoded depends on operating system. For
123 instance, Unix's format is just one byte of LF (line-feed) code,
124 whereas DOS's format is two-byte sequence of `carriage-return' and
125 `line-feed' codes. MacOS's format is usually one byte of
126 `carriage-return'.
128 Since text character encoding and end-of-line encoding are
129 independent, any coding system described above can take any format
130 of end-of-line (except for no-conversion).
132 STRUCT CODING_SYSTEM
134 Before using a coding system for code conversion (i.e. decoding and
135 encoding), we setup a structure of type `struct coding_system'.
136 This structure keeps various information about a specific code
137 conversion (e.g. the location of source and destination data).
141 /* COMMON MACROS */
144 /*** GENERAL NOTES on `detect_coding_XXX ()' functions ***
146 These functions check if a byte sequence specified as a source in
147 CODING conforms to the format of XXX, and update the members of
148 DETECT_INFO.
150 Return true if the byte sequence conforms to XXX.
152 Below is the template of these functions. */
154 #if 0
155 static bool
156 detect_coding_XXX (struct coding_system *coding,
157 struct coding_detection_info *detect_info)
159 const unsigned char *src = coding->source;
160 const unsigned char *src_end = coding->source + coding->src_bytes;
161 bool multibytep = coding->src_multibyte;
162 ptrdiff_t consumed_chars = 0;
163 int found = 0;
164 ...;
166 while (1)
168 /* Get one byte from the source. If the source is exhausted, jump
169 to no_more_source:. */
170 ONE_MORE_BYTE (c);
172 if (! __C_conforms_to_XXX___ (c))
173 break;
174 if (! __C_strongly_suggests_XXX__ (c))
175 found = CATEGORY_MASK_XXX;
177 /* The byte sequence is invalid for XXX. */
178 detect_info->rejected |= CATEGORY_MASK_XXX;
179 return 0;
181 no_more_source:
182 /* The source exhausted successfully. */
183 detect_info->found |= found;
184 return 1;
186 #endif
188 /*** GENERAL NOTES on `decode_coding_XXX ()' functions ***
190 These functions decode a byte sequence specified as a source by
191 CODING. The resulting multibyte text goes to a place pointed to by
192 CODING->charbuf, the length of which should not exceed
193 CODING->charbuf_size;
195 These functions set the information of original and decoded texts in
196 CODING->consumed, CODING->consumed_char, and CODING->charbuf_used.
197 They also set CODING->result to one of CODING_RESULT_XXX indicating
198 how the decoding is finished.
200 Below is the template of these functions. */
202 #if 0
203 static void
204 decode_coding_XXXX (struct coding_system *coding)
206 const unsigned char *src = coding->source + coding->consumed;
207 const unsigned char *src_end = coding->source + coding->src_bytes;
208 /* SRC_BASE remembers the start position in source in each loop.
209 The loop will be exited when there's not enough source code, or
210 when there's no room in CHARBUF for a decoded character. */
211 const unsigned char *src_base;
212 /* A buffer to produce decoded characters. */
213 int *charbuf = coding->charbuf + coding->charbuf_used;
214 int *charbuf_end = coding->charbuf + coding->charbuf_size;
215 bool multibytep = coding->src_multibyte;
217 while (1)
219 src_base = src;
220 if (charbuf < charbuf_end)
221 /* No more room to produce a decoded character. */
222 break;
223 ONE_MORE_BYTE (c);
224 /* Decode it. */
227 no_more_source:
228 if (src_base < src_end
229 && coding->mode & CODING_MODE_LAST_BLOCK)
230 /* If the source ends by partial bytes to construct a character,
231 treat them as eight-bit raw data. */
232 while (src_base < src_end && charbuf < charbuf_end)
233 *charbuf++ = *src_base++;
234 /* Remember how many bytes and characters we consumed. If the
235 source is multibyte, the bytes and chars are not identical. */
236 coding->consumed = coding->consumed_char = src_base - coding->source;
237 /* Remember how many characters we produced. */
238 coding->charbuf_used = charbuf - coding->charbuf;
240 #endif
242 /*** GENERAL NOTES on `encode_coding_XXX ()' functions ***
244 These functions encode SRC_BYTES length text at SOURCE of Emacs'
245 internal multibyte format by CODING. The resulting byte sequence
246 goes to a place pointed to by DESTINATION, the length of which
247 should not exceed DST_BYTES.
249 These functions set the information of original and encoded texts in
250 the members produced, produced_char, consumed, and consumed_char of
251 the structure *CODING. They also set the member result to one of
252 CODING_RESULT_XXX indicating how the encoding finished.
254 DST_BYTES zero means that source area and destination area are
255 overlapped, which means that we can produce a encoded text until it
256 reaches at the head of not-yet-encoded source text.
258 Below is a template of these functions. */
259 #if 0
260 static void
261 encode_coding_XXX (struct coding_system *coding)
263 bool multibytep = coding->dst_multibyte;
264 int *charbuf = coding->charbuf;
265 int *charbuf_end = charbuf->charbuf + coding->charbuf_used;
266 unsigned char *dst = coding->destination + coding->produced;
267 unsigned char *dst_end = coding->destination + coding->dst_bytes;
268 unsigned char *adjusted_dst_end = dst_end - _MAX_BYTES_PRODUCED_IN_LOOP_;
269 ptrdiff_t produced_chars = 0;
271 for (; charbuf < charbuf_end && dst < adjusted_dst_end; charbuf++)
273 int c = *charbuf;
274 /* Encode C into DST, and increment DST. */
276 label_no_more_destination:
277 /* How many chars and bytes we produced. */
278 coding->produced_char += produced_chars;
279 coding->produced = dst - coding->destination;
281 #endif
284 /*** 1. Preamble ***/
286 #include <config.h>
287 #include <stdio.h>
289 #ifdef HAVE_WCHAR_H
290 #include <wchar.h>
291 #endif /* HAVE_WCHAR_H */
293 #include "lisp.h"
294 #include "character.h"
295 #include "buffer.h"
296 #include "charset.h"
297 #include "ccl.h"
298 #include "composite.h"
299 #include "coding.h"
300 #include "window.h"
301 #include "frame.h"
302 #include "termhooks.h"
304 Lisp_Object Vcoding_system_hash_table;
306 static Lisp_Object Qcoding_system, Qeol_type;
307 static Lisp_Object Qcoding_aliases;
308 Lisp_Object Qunix, Qdos;
309 static Lisp_Object Qmac;
310 Lisp_Object Qbuffer_file_coding_system;
311 static Lisp_Object Qpost_read_conversion, Qpre_write_conversion;
312 static Lisp_Object Qdefault_char;
313 Lisp_Object Qno_conversion, Qundecided;
314 Lisp_Object Qcharset, Qutf_8;
315 static Lisp_Object Qiso_2022;
316 static Lisp_Object Qutf_16, Qshift_jis, Qbig5;
317 static Lisp_Object Qbig, Qlittle;
318 static Lisp_Object Qcoding_system_history;
319 static Lisp_Object Qvalid_codes;
320 static Lisp_Object QCcategory, QCmnemonic, QCdefault_char;
321 static Lisp_Object QCdecode_translation_table, QCencode_translation_table;
322 static Lisp_Object QCpost_read_conversion, QCpre_write_conversion;
323 static Lisp_Object QCascii_compatible_p;
325 Lisp_Object Qcall_process, Qcall_process_region;
326 Lisp_Object Qstart_process, Qopen_network_stream;
327 static Lisp_Object Qtarget_idx;
329 static Lisp_Object Qinsufficient_source, Qinvalid_source, Qinterrupted;
331 /* If a symbol has this property, evaluate the value to define the
332 symbol as a coding system. */
333 static Lisp_Object Qcoding_system_define_form;
335 /* Format of end-of-line decided by system. This is Qunix on
336 Unix and Mac, Qdos on DOS/Windows.
337 This has an effect only for external encoding (i.e. for output to
338 file and process), not for in-buffer or Lisp string encoding. */
339 static Lisp_Object system_eol_type;
341 #ifdef emacs
343 Lisp_Object Qcoding_system_p, Qcoding_system_error;
345 /* Coding system emacs-mule and raw-text are for converting only
346 end-of-line format. */
347 Lisp_Object Qemacs_mule, Qraw_text;
348 Lisp_Object Qutf_8_emacs;
350 #if defined (WINDOWSNT) || defined (CYGWIN)
351 static Lisp_Object Qutf_16le;
352 #endif
354 /* Coding-systems are handed between Emacs Lisp programs and C internal
355 routines by the following three variables. */
356 /* Coding system to be used to encode text for terminal display when
357 terminal coding system is nil. */
358 struct coding_system safe_terminal_coding;
360 #endif /* emacs */
362 Lisp_Object Qtranslation_table;
363 Lisp_Object Qtranslation_table_id;
364 static Lisp_Object Qtranslation_table_for_decode;
365 static Lisp_Object Qtranslation_table_for_encode;
367 /* Two special coding systems. */
368 static Lisp_Object Vsjis_coding_system;
369 static Lisp_Object Vbig5_coding_system;
371 /* ISO2022 section */
373 #define CODING_ISO_INITIAL(coding, reg) \
374 (XINT (AREF (AREF (CODING_ID_ATTRS ((coding)->id), \
375 coding_attr_iso_initial), \
376 reg)))
379 #define CODING_ISO_REQUEST(coding, charset_id) \
380 (((charset_id) <= (coding)->max_charset_id \
381 ? ((coding)->safe_charsets[charset_id] != 255 \
382 ? (coding)->safe_charsets[charset_id] \
383 : -1) \
384 : -1))
387 #define CODING_ISO_FLAGS(coding) \
388 ((coding)->spec.iso_2022.flags)
389 #define CODING_ISO_DESIGNATION(coding, reg) \
390 ((coding)->spec.iso_2022.current_designation[reg])
391 #define CODING_ISO_INVOCATION(coding, plane) \
392 ((coding)->spec.iso_2022.current_invocation[plane])
393 #define CODING_ISO_SINGLE_SHIFTING(coding) \
394 ((coding)->spec.iso_2022.single_shifting)
395 #define CODING_ISO_BOL(coding) \
396 ((coding)->spec.iso_2022.bol)
397 #define CODING_ISO_INVOKED_CHARSET(coding, plane) \
398 CODING_ISO_DESIGNATION ((coding), CODING_ISO_INVOCATION ((coding), (plane)))
399 #define CODING_ISO_CMP_STATUS(coding) \
400 (&(coding)->spec.iso_2022.cmp_status)
401 #define CODING_ISO_EXTSEGMENT_LEN(coding) \
402 ((coding)->spec.iso_2022.ctext_extended_segment_len)
403 #define CODING_ISO_EMBEDDED_UTF_8(coding) \
404 ((coding)->spec.iso_2022.embedded_utf_8)
406 /* Control characters of ISO2022. */
407 /* code */ /* function */
408 #define ISO_CODE_SO 0x0E /* shift-out */
409 #define ISO_CODE_SI 0x0F /* shift-in */
410 #define ISO_CODE_SS2_7 0x19 /* single-shift-2 for 7-bit code */
411 #define ISO_CODE_ESC 0x1B /* escape */
412 #define ISO_CODE_SS2 0x8E /* single-shift-2 */
413 #define ISO_CODE_SS3 0x8F /* single-shift-3 */
414 #define ISO_CODE_CSI 0x9B /* control-sequence-introducer */
416 /* All code (1-byte) of ISO2022 is classified into one of the
417 followings. */
418 enum iso_code_class_type
420 ISO_control_0, /* Control codes in the range
421 0x00..0x1F and 0x7F, except for the
422 following 5 codes. */
423 ISO_shift_out, /* ISO_CODE_SO (0x0E) */
424 ISO_shift_in, /* ISO_CODE_SI (0x0F) */
425 ISO_single_shift_2_7, /* ISO_CODE_SS2_7 (0x19) */
426 ISO_escape, /* ISO_CODE_ESC (0x1B) */
427 ISO_control_1, /* Control codes in the range
428 0x80..0x9F, except for the
429 following 3 codes. */
430 ISO_single_shift_2, /* ISO_CODE_SS2 (0x8E) */
431 ISO_single_shift_3, /* ISO_CODE_SS3 (0x8F) */
432 ISO_control_sequence_introducer, /* ISO_CODE_CSI (0x9B) */
433 ISO_0x20_or_0x7F, /* Codes of the values 0x20 or 0x7F. */
434 ISO_graphic_plane_0, /* Graphic codes in the range 0x21..0x7E. */
435 ISO_0xA0_or_0xFF, /* Codes of the values 0xA0 or 0xFF. */
436 ISO_graphic_plane_1 /* Graphic codes in the range 0xA1..0xFE. */
439 /** The macros CODING_ISO_FLAG_XXX defines a flag bit of the
440 `iso-flags' attribute of an iso2022 coding system. */
442 /* If set, produce long-form designation sequence (e.g. ESC $ ( A)
443 instead of the correct short-form sequence (e.g. ESC $ A). */
444 #define CODING_ISO_FLAG_LONG_FORM 0x0001
446 /* If set, reset graphic planes and registers at end-of-line to the
447 initial state. */
448 #define CODING_ISO_FLAG_RESET_AT_EOL 0x0002
450 /* If set, reset graphic planes and registers before any control
451 characters to the initial state. */
452 #define CODING_ISO_FLAG_RESET_AT_CNTL 0x0004
454 /* If set, encode by 7-bit environment. */
455 #define CODING_ISO_FLAG_SEVEN_BITS 0x0008
457 /* If set, use locking-shift function. */
458 #define CODING_ISO_FLAG_LOCKING_SHIFT 0x0010
460 /* If set, use single-shift function. Overwrite
461 CODING_ISO_FLAG_LOCKING_SHIFT. */
462 #define CODING_ISO_FLAG_SINGLE_SHIFT 0x0020
464 /* If set, use designation escape sequence. */
465 #define CODING_ISO_FLAG_DESIGNATION 0x0040
467 /* If set, produce revision number sequence. */
468 #define CODING_ISO_FLAG_REVISION 0x0080
470 /* If set, produce ISO6429's direction specifying sequence. */
471 #define CODING_ISO_FLAG_DIRECTION 0x0100
473 /* If set, assume designation states are reset at beginning of line on
474 output. */
475 #define CODING_ISO_FLAG_INIT_AT_BOL 0x0200
477 /* If set, designation sequence should be placed at beginning of line
478 on output. */
479 #define CODING_ISO_FLAG_DESIGNATE_AT_BOL 0x0400
481 /* If set, do not encode unsafe characters on output. */
482 #define CODING_ISO_FLAG_SAFE 0x0800
484 /* If set, extra latin codes (128..159) are accepted as a valid code
485 on input. */
486 #define CODING_ISO_FLAG_LATIN_EXTRA 0x1000
488 #define CODING_ISO_FLAG_COMPOSITION 0x2000
490 /* #define CODING_ISO_FLAG_EUC_TW_SHIFT 0x4000 */
492 #define CODING_ISO_FLAG_USE_ROMAN 0x8000
494 #define CODING_ISO_FLAG_USE_OLDJIS 0x10000
496 #define CODING_ISO_FLAG_LEVEL_4 0x20000
498 #define CODING_ISO_FLAG_FULL_SUPPORT 0x100000
500 /* A character to be produced on output if encoding of the original
501 character is prohibited by CODING_ISO_FLAG_SAFE. */
502 #define CODING_INHIBIT_CHARACTER_SUBSTITUTION '?'
504 /* UTF-8 section */
505 #define CODING_UTF_8_BOM(coding) \
506 ((coding)->spec.utf_8_bom)
508 /* UTF-16 section */
509 #define CODING_UTF_16_BOM(coding) \
510 ((coding)->spec.utf_16.bom)
512 #define CODING_UTF_16_ENDIAN(coding) \
513 ((coding)->spec.utf_16.endian)
515 #define CODING_UTF_16_SURROGATE(coding) \
516 ((coding)->spec.utf_16.surrogate)
519 /* CCL section */
520 #define CODING_CCL_DECODER(coding) \
521 AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_decoder)
522 #define CODING_CCL_ENCODER(coding) \
523 AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_encoder)
524 #define CODING_CCL_VALIDS(coding) \
525 (SDATA (AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_valids)))
527 /* Index for each coding category in `coding_categories' */
529 enum coding_category
531 coding_category_iso_7,
532 coding_category_iso_7_tight,
533 coding_category_iso_8_1,
534 coding_category_iso_8_2,
535 coding_category_iso_7_else,
536 coding_category_iso_8_else,
537 coding_category_utf_8_auto,
538 coding_category_utf_8_nosig,
539 coding_category_utf_8_sig,
540 coding_category_utf_16_auto,
541 coding_category_utf_16_be,
542 coding_category_utf_16_le,
543 coding_category_utf_16_be_nosig,
544 coding_category_utf_16_le_nosig,
545 coding_category_charset,
546 coding_category_sjis,
547 coding_category_big5,
548 coding_category_ccl,
549 coding_category_emacs_mule,
550 /* All above are targets of code detection. */
551 coding_category_raw_text,
552 coding_category_undecided,
553 coding_category_max
556 /* Definitions of flag bits used in detect_coding_XXXX. */
557 #define CATEGORY_MASK_ISO_7 (1 << coding_category_iso_7)
558 #define CATEGORY_MASK_ISO_7_TIGHT (1 << coding_category_iso_7_tight)
559 #define CATEGORY_MASK_ISO_8_1 (1 << coding_category_iso_8_1)
560 #define CATEGORY_MASK_ISO_8_2 (1 << coding_category_iso_8_2)
561 #define CATEGORY_MASK_ISO_7_ELSE (1 << coding_category_iso_7_else)
562 #define CATEGORY_MASK_ISO_8_ELSE (1 << coding_category_iso_8_else)
563 #define CATEGORY_MASK_UTF_8_AUTO (1 << coding_category_utf_8_auto)
564 #define CATEGORY_MASK_UTF_8_NOSIG (1 << coding_category_utf_8_nosig)
565 #define CATEGORY_MASK_UTF_8_SIG (1 << coding_category_utf_8_sig)
566 #define CATEGORY_MASK_UTF_16_AUTO (1 << coding_category_utf_16_auto)
567 #define CATEGORY_MASK_UTF_16_BE (1 << coding_category_utf_16_be)
568 #define CATEGORY_MASK_UTF_16_LE (1 << coding_category_utf_16_le)
569 #define CATEGORY_MASK_UTF_16_BE_NOSIG (1 << coding_category_utf_16_be_nosig)
570 #define CATEGORY_MASK_UTF_16_LE_NOSIG (1 << coding_category_utf_16_le_nosig)
571 #define CATEGORY_MASK_CHARSET (1 << coding_category_charset)
572 #define CATEGORY_MASK_SJIS (1 << coding_category_sjis)
573 #define CATEGORY_MASK_BIG5 (1 << coding_category_big5)
574 #define CATEGORY_MASK_CCL (1 << coding_category_ccl)
575 #define CATEGORY_MASK_EMACS_MULE (1 << coding_category_emacs_mule)
576 #define CATEGORY_MASK_RAW_TEXT (1 << coding_category_raw_text)
578 /* This value is returned if detect_coding_mask () find nothing other
579 than ASCII characters. */
580 #define CATEGORY_MASK_ANY \
581 (CATEGORY_MASK_ISO_7 \
582 | CATEGORY_MASK_ISO_7_TIGHT \
583 | CATEGORY_MASK_ISO_8_1 \
584 | CATEGORY_MASK_ISO_8_2 \
585 | CATEGORY_MASK_ISO_7_ELSE \
586 | CATEGORY_MASK_ISO_8_ELSE \
587 | CATEGORY_MASK_UTF_8_AUTO \
588 | CATEGORY_MASK_UTF_8_NOSIG \
589 | CATEGORY_MASK_UTF_8_SIG \
590 | CATEGORY_MASK_UTF_16_AUTO \
591 | CATEGORY_MASK_UTF_16_BE \
592 | CATEGORY_MASK_UTF_16_LE \
593 | CATEGORY_MASK_UTF_16_BE_NOSIG \
594 | CATEGORY_MASK_UTF_16_LE_NOSIG \
595 | CATEGORY_MASK_CHARSET \
596 | CATEGORY_MASK_SJIS \
597 | CATEGORY_MASK_BIG5 \
598 | CATEGORY_MASK_CCL \
599 | CATEGORY_MASK_EMACS_MULE)
602 #define CATEGORY_MASK_ISO_7BIT \
603 (CATEGORY_MASK_ISO_7 | CATEGORY_MASK_ISO_7_TIGHT)
605 #define CATEGORY_MASK_ISO_8BIT \
606 (CATEGORY_MASK_ISO_8_1 | CATEGORY_MASK_ISO_8_2)
608 #define CATEGORY_MASK_ISO_ELSE \
609 (CATEGORY_MASK_ISO_7_ELSE | CATEGORY_MASK_ISO_8_ELSE)
611 #define CATEGORY_MASK_ISO_ESCAPE \
612 (CATEGORY_MASK_ISO_7 \
613 | CATEGORY_MASK_ISO_7_TIGHT \
614 | CATEGORY_MASK_ISO_7_ELSE \
615 | CATEGORY_MASK_ISO_8_ELSE)
617 #define CATEGORY_MASK_ISO \
618 ( CATEGORY_MASK_ISO_7BIT \
619 | CATEGORY_MASK_ISO_8BIT \
620 | CATEGORY_MASK_ISO_ELSE)
622 #define CATEGORY_MASK_UTF_16 \
623 (CATEGORY_MASK_UTF_16_AUTO \
624 | CATEGORY_MASK_UTF_16_BE \
625 | CATEGORY_MASK_UTF_16_LE \
626 | CATEGORY_MASK_UTF_16_BE_NOSIG \
627 | CATEGORY_MASK_UTF_16_LE_NOSIG)
629 #define CATEGORY_MASK_UTF_8 \
630 (CATEGORY_MASK_UTF_8_AUTO \
631 | CATEGORY_MASK_UTF_8_NOSIG \
632 | CATEGORY_MASK_UTF_8_SIG)
634 /* Table of coding categories (Lisp symbols). This variable is for
635 internal use only. */
636 static Lisp_Object Vcoding_category_table;
638 /* Table of coding-categories ordered by priority. */
639 static enum coding_category coding_priorities[coding_category_max];
641 /* Nth element is a coding context for the coding system bound to the
642 Nth coding category. */
643 static struct coding_system coding_categories[coding_category_max];
645 /*** Commonly used macros and functions ***/
647 #ifndef min
648 #define min(a, b) ((a) < (b) ? (a) : (b))
649 #endif
650 #ifndef max
651 #define max(a, b) ((a) > (b) ? (a) : (b))
652 #endif
654 /* Encode a flag that can be nil, something else, or t as -1, 0, 1. */
656 static int
657 encode_inhibit_flag (Lisp_Object flag)
659 return NILP (flag) ? -1 : EQ (flag, Qt);
662 /* True if the value of ENCODED_FLAG says a flag should be treated as set.
663 1 means yes, -1 means no, 0 means ask the user variable VAR. */
665 static bool
666 inhibit_flag (int encoded_flag, bool var)
668 return 0 < encoded_flag + var;
671 #define CODING_GET_INFO(coding, attrs, charset_list) \
672 do { \
673 (attrs) = CODING_ID_ATTRS ((coding)->id); \
674 (charset_list) = CODING_ATTR_CHARSET_LIST (attrs); \
675 } while (0)
677 static void
678 CHECK_NATNUM_CAR (Lisp_Object x)
680 Lisp_Object tmp = XCAR (x);
681 CHECK_NATNUM (tmp);
682 XSETCAR (x, tmp);
685 static void
686 CHECK_NATNUM_CDR (Lisp_Object x)
688 Lisp_Object tmp = XCDR (x);
689 CHECK_NATNUM (tmp);
690 XSETCDR (x, tmp);
694 /* Safely get one byte from the source text pointed by SRC which ends
695 at SRC_END, and set C to that byte. If there are not enough bytes
696 in the source, it jumps to 'no_more_source'. If MULTIBYTEP,
697 and a multibyte character is found at SRC, set C to the
698 negative value of the character code. The caller should declare
699 and set these variables appropriately in advance:
700 src, src_end, multibytep */
702 #define ONE_MORE_BYTE(c) \
703 do { \
704 if (src == src_end) \
706 if (src_base < src) \
707 record_conversion_result \
708 (coding, CODING_RESULT_INSUFFICIENT_SRC); \
709 goto no_more_source; \
711 c = *src++; \
712 if (multibytep && (c & 0x80)) \
714 if ((c & 0xFE) == 0xC0) \
715 c = ((c & 1) << 6) | *src++; \
716 else \
718 src--; \
719 c = - string_char (src, &src, NULL); \
720 record_conversion_result \
721 (coding, CODING_RESULT_INVALID_SRC); \
724 consumed_chars++; \
725 } while (0)
727 /* Safely get two bytes from the source text pointed by SRC which ends
728 at SRC_END, and set C1 and C2 to those bytes while skipping the
729 heading multibyte characters. If there are not enough bytes in the
730 source, it jumps to 'no_more_source'. If MULTIBYTEP and
731 a multibyte character is found for C2, set C2 to the negative value
732 of the character code. The caller should declare and set these
733 variables appropriately in advance:
734 src, src_end, multibytep
735 It is intended that this macro is used in detect_coding_utf_16. */
737 #define TWO_MORE_BYTES(c1, c2) \
738 do { \
739 do { \
740 if (src == src_end) \
741 goto no_more_source; \
742 c1 = *src++; \
743 if (multibytep && (c1 & 0x80)) \
745 if ((c1 & 0xFE) == 0xC0) \
746 c1 = ((c1 & 1) << 6) | *src++; \
747 else \
749 src += BYTES_BY_CHAR_HEAD (c1) - 1; \
750 c1 = -1; \
753 } while (c1 < 0); \
754 if (src == src_end) \
755 goto no_more_source; \
756 c2 = *src++; \
757 if (multibytep && (c2 & 0x80)) \
759 if ((c2 & 0xFE) == 0xC0) \
760 c2 = ((c2 & 1) << 6) | *src++; \
761 else \
762 c2 = -1; \
764 } while (0)
767 /* Store a byte C in the place pointed by DST and increment DST to the
768 next free point, and increment PRODUCED_CHARS. The caller should
769 assure that C is 0..127, and declare and set the variable `dst'
770 appropriately in advance.
774 #define EMIT_ONE_ASCII_BYTE(c) \
775 do { \
776 produced_chars++; \
777 *dst++ = (c); \
778 } while (0)
781 /* Like EMIT_ONE_ASCII_BYTE but store two bytes; C1 and C2. */
783 #define EMIT_TWO_ASCII_BYTES(c1, c2) \
784 do { \
785 produced_chars += 2; \
786 *dst++ = (c1), *dst++ = (c2); \
787 } while (0)
790 /* Store a byte C in the place pointed by DST and increment DST to the
791 next free point, and increment PRODUCED_CHARS. If MULTIBYTEP,
792 store in an appropriate multibyte form. The caller should
793 declare and set the variables `dst' and `multibytep' appropriately
794 in advance. */
796 #define EMIT_ONE_BYTE(c) \
797 do { \
798 produced_chars++; \
799 if (multibytep) \
801 unsigned ch = (c); \
802 if (ch >= 0x80) \
803 ch = BYTE8_TO_CHAR (ch); \
804 CHAR_STRING_ADVANCE (ch, dst); \
806 else \
807 *dst++ = (c); \
808 } while (0)
811 /* Like EMIT_ONE_BYTE, but emit two bytes; C1 and C2. */
813 #define EMIT_TWO_BYTES(c1, c2) \
814 do { \
815 produced_chars += 2; \
816 if (multibytep) \
818 unsigned ch; \
820 ch = (c1); \
821 if (ch >= 0x80) \
822 ch = BYTE8_TO_CHAR (ch); \
823 CHAR_STRING_ADVANCE (ch, dst); \
824 ch = (c2); \
825 if (ch >= 0x80) \
826 ch = BYTE8_TO_CHAR (ch); \
827 CHAR_STRING_ADVANCE (ch, dst); \
829 else \
831 *dst++ = (c1); \
832 *dst++ = (c2); \
834 } while (0)
837 #define EMIT_THREE_BYTES(c1, c2, c3) \
838 do { \
839 EMIT_ONE_BYTE (c1); \
840 EMIT_TWO_BYTES (c2, c3); \
841 } while (0)
844 #define EMIT_FOUR_BYTES(c1, c2, c3, c4) \
845 do { \
846 EMIT_TWO_BYTES (c1, c2); \
847 EMIT_TWO_BYTES (c3, c4); \
848 } while (0)
851 static void
852 record_conversion_result (struct coding_system *coding,
853 enum coding_result_code result)
855 coding->result = result;
856 switch (result)
858 case CODING_RESULT_INSUFFICIENT_SRC:
859 Vlast_code_conversion_error = Qinsufficient_source;
860 break;
861 case CODING_RESULT_INVALID_SRC:
862 Vlast_code_conversion_error = Qinvalid_source;
863 break;
864 case CODING_RESULT_INTERRUPT:
865 Vlast_code_conversion_error = Qinterrupted;
866 break;
867 case CODING_RESULT_INSUFFICIENT_DST:
868 /* Don't record this error in Vlast_code_conversion_error
869 because it happens just temporarily and is resolved when the
870 whole conversion is finished. */
871 break;
872 case CODING_RESULT_SUCCESS:
873 break;
874 default:
875 Vlast_code_conversion_error = intern ("Unknown error");
879 /* These wrapper macros are used to preserve validity of pointers into
880 buffer text across calls to decode_char, encode_char, etc, which
881 could cause relocation of buffers if it loads a charset map,
882 because loading a charset map allocates large structures. */
884 #define CODING_DECODE_CHAR(coding, src, src_base, src_end, charset, code, c) \
885 do { \
886 ptrdiff_t offset; \
888 charset_map_loaded = 0; \
889 c = DECODE_CHAR (charset, code); \
890 if (charset_map_loaded \
891 && (offset = coding_change_source (coding))) \
893 src += offset; \
894 src_base += offset; \
895 src_end += offset; \
897 } while (0)
899 #define CODING_ENCODE_CHAR(coding, dst, dst_end, charset, c, code) \
900 do { \
901 ptrdiff_t offset; \
903 charset_map_loaded = 0; \
904 code = ENCODE_CHAR (charset, c); \
905 if (charset_map_loaded \
906 && (offset = coding_change_destination (coding))) \
908 dst += offset; \
909 dst_end += offset; \
911 } while (0)
913 #define CODING_CHAR_CHARSET(coding, dst, dst_end, c, charset_list, code_return, charset) \
914 do { \
915 ptrdiff_t offset; \
917 charset_map_loaded = 0; \
918 charset = char_charset (c, charset_list, code_return); \
919 if (charset_map_loaded \
920 && (offset = coding_change_destination (coding))) \
922 dst += offset; \
923 dst_end += offset; \
925 } while (0)
927 #define CODING_CHAR_CHARSET_P(coding, dst, dst_end, c, charset, result) \
928 do { \
929 ptrdiff_t offset; \
931 charset_map_loaded = 0; \
932 result = CHAR_CHARSET_P (c, charset); \
933 if (charset_map_loaded \
934 && (offset = coding_change_destination (coding))) \
936 dst += offset; \
937 dst_end += offset; \
939 } while (0)
942 /* If there are at least BYTES length of room at dst, allocate memory
943 for coding->destination and update dst and dst_end. We don't have
944 to take care of coding->source which will be relocated. It is
945 handled by calling coding_set_source in encode_coding. */
947 #define ASSURE_DESTINATION(bytes) \
948 do { \
949 if (dst + (bytes) >= dst_end) \
951 ptrdiff_t more_bytes = charbuf_end - charbuf + (bytes); \
953 dst = alloc_destination (coding, more_bytes, dst); \
954 dst_end = coding->destination + coding->dst_bytes; \
956 } while (0)
959 /* Store multibyte form of the character C in P, and advance P to the
960 end of the multibyte form. This used to be like CHAR_STRING_ADVANCE
961 without ever calling MAYBE_UNIFY_CHAR, but nowadays we don't call
962 MAYBE_UNIFY_CHAR in CHAR_STRING_ADVANCE. */
964 #define CHAR_STRING_ADVANCE_NO_UNIFY(c, p) CHAR_STRING_ADVANCE(c, p)
966 /* Return the character code of character whose multibyte form is at
967 P, and advance P to the end of the multibyte form. This used to be
968 like STRING_CHAR_ADVANCE without ever calling MAYBE_UNIFY_CHAR, but
969 nowadays STRING_CHAR_ADVANCE doesn't call MAYBE_UNIFY_CHAR. */
971 #define STRING_CHAR_ADVANCE_NO_UNIFY(p) STRING_CHAR_ADVANCE(p)
973 /* Set coding->source from coding->src_object. */
975 static void
976 coding_set_source (struct coding_system *coding)
978 if (BUFFERP (coding->src_object))
980 struct buffer *buf = XBUFFER (coding->src_object);
982 if (coding->src_pos < 0)
983 coding->source = BUF_GAP_END_ADDR (buf) + coding->src_pos_byte;
984 else
985 coding->source = BUF_BYTE_ADDRESS (buf, coding->src_pos_byte);
987 else if (STRINGP (coding->src_object))
989 coding->source = SDATA (coding->src_object) + coding->src_pos_byte;
991 else
993 /* Otherwise, the source is C string and is never relocated
994 automatically. Thus we don't have to update anything. */
999 /* Set coding->source from coding->src_object, and return how many
1000 bytes coding->source was changed. */
1002 static ptrdiff_t
1003 coding_change_source (struct coding_system *coding)
1005 const unsigned char *orig = coding->source;
1006 coding_set_source (coding);
1007 return coding->source - orig;
1011 /* Set coding->destination from coding->dst_object. */
1013 static void
1014 coding_set_destination (struct coding_system *coding)
1016 if (BUFFERP (coding->dst_object))
1018 if (BUFFERP (coding->src_object) && coding->src_pos < 0)
1020 coding->destination = BEG_ADDR + coding->dst_pos_byte - BEG_BYTE;
1021 coding->dst_bytes = (GAP_END_ADDR
1022 - (coding->src_bytes - coding->consumed)
1023 - coding->destination);
1025 else
1027 /* We are sure that coding->dst_pos_byte is before the gap
1028 of the buffer. */
1029 coding->destination = (BUF_BEG_ADDR (XBUFFER (coding->dst_object))
1030 + coding->dst_pos_byte - BEG_BYTE);
1031 coding->dst_bytes = (BUF_GAP_END_ADDR (XBUFFER (coding->dst_object))
1032 - coding->destination);
1035 else
1037 /* Otherwise, the destination is C string and is never relocated
1038 automatically. Thus we don't have to update anything. */
1043 /* Set coding->destination from coding->dst_object, and return how
1044 many bytes coding->destination was changed. */
1046 static ptrdiff_t
1047 coding_change_destination (struct coding_system *coding)
1049 const unsigned char *orig = coding->destination;
1050 coding_set_destination (coding);
1051 return coding->destination - orig;
1055 static void
1056 coding_alloc_by_realloc (struct coding_system *coding, ptrdiff_t bytes)
1058 if (STRING_BYTES_BOUND - coding->dst_bytes < bytes)
1059 string_overflow ();
1060 coding->destination = xrealloc (coding->destination,
1061 coding->dst_bytes + bytes);
1062 coding->dst_bytes += bytes;
1065 static void
1066 coding_alloc_by_making_gap (struct coding_system *coding,
1067 ptrdiff_t gap_head_used, ptrdiff_t bytes)
1069 if (EQ (coding->src_object, coding->dst_object))
1071 /* The gap may contain the produced data at the head and not-yet
1072 consumed data at the tail. To preserve those data, we at
1073 first make the gap size to zero, then increase the gap
1074 size. */
1075 ptrdiff_t add = GAP_SIZE;
1077 GPT += gap_head_used, GPT_BYTE += gap_head_used;
1078 GAP_SIZE = 0; ZV += add; Z += add; ZV_BYTE += add; Z_BYTE += add;
1079 make_gap (bytes);
1080 GAP_SIZE += add; ZV -= add; Z -= add; ZV_BYTE -= add; Z_BYTE -= add;
1081 GPT -= gap_head_used, GPT_BYTE -= gap_head_used;
1083 else
1084 make_gap_1 (XBUFFER (coding->dst_object), bytes);
1088 static unsigned char *
1089 alloc_destination (struct coding_system *coding, ptrdiff_t nbytes,
1090 unsigned char *dst)
1092 ptrdiff_t offset = dst - coding->destination;
1094 if (BUFFERP (coding->dst_object))
1096 struct buffer *buf = XBUFFER (coding->dst_object);
1098 coding_alloc_by_making_gap (coding, dst - BUF_GPT_ADDR (buf), nbytes);
1100 else
1101 coding_alloc_by_realloc (coding, nbytes);
1102 coding_set_destination (coding);
1103 dst = coding->destination + offset;
1104 return dst;
1107 /** Macros for annotations. */
1109 /* An annotation data is stored in the array coding->charbuf in this
1110 format:
1111 [ -LENGTH ANNOTATION_MASK NCHARS ... ]
1112 LENGTH is the number of elements in the annotation.
1113 ANNOTATION_MASK is one of CODING_ANNOTATE_XXX_MASK.
1114 NCHARS is the number of characters in the text annotated.
1116 The format of the following elements depend on ANNOTATION_MASK.
1118 In the case of CODING_ANNOTATE_COMPOSITION_MASK, these elements
1119 follows:
1120 ... NBYTES METHOD [ COMPOSITION-COMPONENTS ... ]
1122 NBYTES is the number of bytes specified in the header part of
1123 old-style emacs-mule encoding, or 0 for the other kind of
1124 composition.
1126 METHOD is one of enum composition_method.
1128 Optional COMPOSITION-COMPONENTS are characters and composition
1129 rules.
1131 In the case of CODING_ANNOTATE_CHARSET_MASK, one element CHARSET-ID
1132 follows.
1134 If ANNOTATION_MASK is 0, this annotation is just a space holder to
1135 recover from an invalid annotation, and should be skipped by
1136 produce_annotation. */
1138 /* Maximum length of the header of annotation data. */
1139 #define MAX_ANNOTATION_LENGTH 5
1141 #define ADD_ANNOTATION_DATA(buf, len, mask, nchars) \
1142 do { \
1143 *(buf)++ = -(len); \
1144 *(buf)++ = (mask); \
1145 *(buf)++ = (nchars); \
1146 coding->annotated = 1; \
1147 } while (0);
1149 #define ADD_COMPOSITION_DATA(buf, nchars, nbytes, method) \
1150 do { \
1151 ADD_ANNOTATION_DATA (buf, 5, CODING_ANNOTATE_COMPOSITION_MASK, nchars); \
1152 *buf++ = nbytes; \
1153 *buf++ = method; \
1154 } while (0)
1157 #define ADD_CHARSET_DATA(buf, nchars, id) \
1158 do { \
1159 ADD_ANNOTATION_DATA (buf, 4, CODING_ANNOTATE_CHARSET_MASK, nchars); \
1160 *buf++ = id; \
1161 } while (0)
1164 /* Bitmasks for coding->eol_seen. */
1166 #define EOL_SEEN_NONE 0
1167 #define EOL_SEEN_LF 1
1168 #define EOL_SEEN_CR 2
1169 #define EOL_SEEN_CRLF 4
1172 /*** 2. Emacs' internal format (emacs-utf-8) ***/
1177 /*** 3. UTF-8 ***/
1179 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
1180 Return true if a text is encoded in UTF-8. */
1182 #define UTF_8_1_OCTET_P(c) ((c) < 0x80)
1183 #define UTF_8_EXTRA_OCTET_P(c) (((c) & 0xC0) == 0x80)
1184 #define UTF_8_2_OCTET_LEADING_P(c) (((c) & 0xE0) == 0xC0)
1185 #define UTF_8_3_OCTET_LEADING_P(c) (((c) & 0xF0) == 0xE0)
1186 #define UTF_8_4_OCTET_LEADING_P(c) (((c) & 0xF8) == 0xF0)
1187 #define UTF_8_5_OCTET_LEADING_P(c) (((c) & 0xFC) == 0xF8)
1189 #define UTF_8_BOM_1 0xEF
1190 #define UTF_8_BOM_2 0xBB
1191 #define UTF_8_BOM_3 0xBF
1193 /* Unlike the other detect_coding_XXX, this function counts number of
1194 characters and check EOL format. */
1196 static bool
1197 detect_coding_utf_8 (struct coding_system *coding,
1198 struct coding_detection_info *detect_info)
1200 const unsigned char *src = coding->source, *src_base;
1201 const unsigned char *src_end = coding->source + coding->src_bytes;
1202 bool multibytep = coding->src_multibyte;
1203 ptrdiff_t consumed_chars = 0;
1204 bool bom_found = 0;
1205 int nchars = coding->head_ascii;
1206 int eol_seen = coding->eol_seen;
1208 detect_info->checked |= CATEGORY_MASK_UTF_8;
1209 /* A coding system of this category is always ASCII compatible. */
1210 src += nchars;
1212 if (src == coding->source /* BOM should be at the head. */
1213 && src + 3 < src_end /* BOM is 3-byte long. */
1214 && src[0] == UTF_8_BOM_1
1215 && src[1] == UTF_8_BOM_2
1216 && src[2] == UTF_8_BOM_3)
1218 bom_found = 1;
1219 src += 3;
1220 nchars++;
1223 while (1)
1225 int c, c1, c2, c3, c4;
1227 src_base = src;
1228 ONE_MORE_BYTE (c);
1229 if (c < 0 || UTF_8_1_OCTET_P (c))
1231 nchars++;
1232 if (c == '\r')
1234 if (src < src_end && *src == '\n')
1236 eol_seen |= EOL_SEEN_CRLF;
1237 src++;
1238 nchars++;
1240 else
1241 eol_seen |= EOL_SEEN_CR;
1243 else if (c == '\n')
1244 eol_seen |= EOL_SEEN_LF;
1245 continue;
1247 ONE_MORE_BYTE (c1);
1248 if (c1 < 0 || ! UTF_8_EXTRA_OCTET_P (c1))
1249 break;
1250 if (UTF_8_2_OCTET_LEADING_P (c))
1252 nchars++;
1253 continue;
1255 ONE_MORE_BYTE (c2);
1256 if (c2 < 0 || ! UTF_8_EXTRA_OCTET_P (c2))
1257 break;
1258 if (UTF_8_3_OCTET_LEADING_P (c))
1260 nchars++;
1261 continue;
1263 ONE_MORE_BYTE (c3);
1264 if (c3 < 0 || ! UTF_8_EXTRA_OCTET_P (c3))
1265 break;
1266 if (UTF_8_4_OCTET_LEADING_P (c))
1268 nchars++;
1269 continue;
1271 ONE_MORE_BYTE (c4);
1272 if (c4 < 0 || ! UTF_8_EXTRA_OCTET_P (c4))
1273 break;
1274 if (UTF_8_5_OCTET_LEADING_P (c))
1276 nchars++;
1277 continue;
1279 break;
1281 detect_info->rejected |= CATEGORY_MASK_UTF_8;
1282 return 0;
1284 no_more_source:
1285 if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK)
1287 detect_info->rejected |= CATEGORY_MASK_UTF_8;
1288 return 0;
1290 if (bom_found)
1292 /* The first character 0xFFFE doesn't necessarily mean a BOM. */
1293 detect_info->found |= CATEGORY_MASK_UTF_8_AUTO | CATEGORY_MASK_UTF_8_SIG | CATEGORY_MASK_UTF_8_NOSIG;
1295 else
1297 detect_info->rejected |= CATEGORY_MASK_UTF_8_SIG;
1298 if (nchars < src_end - coding->source)
1299 /* The found characters are less than source bytes, which
1300 means that we found a valid non-ASCII characters. */
1301 detect_info->found |= CATEGORY_MASK_UTF_8_AUTO | CATEGORY_MASK_UTF_8_NOSIG;
1303 coding->detected_utf8_chars = nchars;
1304 return 1;
1308 static void
1309 decode_coding_utf_8 (struct coding_system *coding)
1311 const unsigned char *src = coding->source + coding->consumed;
1312 const unsigned char *src_end = coding->source + coding->src_bytes;
1313 const unsigned char *src_base;
1314 int *charbuf = coding->charbuf + coding->charbuf_used;
1315 int *charbuf_end = coding->charbuf + coding->charbuf_size;
1316 ptrdiff_t consumed_chars = 0, consumed_chars_base = 0;
1317 bool multibytep = coding->src_multibyte;
1318 enum utf_bom_type bom = CODING_UTF_8_BOM (coding);
1319 bool eol_dos
1320 = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
1321 int byte_after_cr = -1;
1323 if (bom != utf_without_bom)
1325 int c1, c2, c3;
1327 src_base = src;
1328 ONE_MORE_BYTE (c1);
1329 if (! UTF_8_3_OCTET_LEADING_P (c1))
1330 src = src_base;
1331 else
1333 ONE_MORE_BYTE (c2);
1334 if (! UTF_8_EXTRA_OCTET_P (c2))
1335 src = src_base;
1336 else
1338 ONE_MORE_BYTE (c3);
1339 if (! UTF_8_EXTRA_OCTET_P (c3))
1340 src = src_base;
1341 else
1343 if ((c1 != UTF_8_BOM_1)
1344 || (c2 != UTF_8_BOM_2) || (c3 != UTF_8_BOM_3))
1345 src = src_base;
1346 else
1347 CODING_UTF_8_BOM (coding) = utf_without_bom;
1352 CODING_UTF_8_BOM (coding) = utf_without_bom;
1354 while (1)
1356 int c, c1, c2, c3, c4, c5;
1358 src_base = src;
1359 consumed_chars_base = consumed_chars;
1361 if (charbuf >= charbuf_end)
1363 if (byte_after_cr >= 0)
1364 src_base--;
1365 break;
1368 /* In the simple case, rapidly handle ordinary characters */
1369 if (multibytep && ! eol_dos
1370 && charbuf < charbuf_end - 6 && src < src_end - 6)
1372 while (charbuf < charbuf_end - 6 && src < src_end - 6)
1374 c1 = *src;
1375 if (c1 & 0x80)
1376 break;
1377 src++;
1378 consumed_chars++;
1379 *charbuf++ = c1;
1381 c1 = *src;
1382 if (c1 & 0x80)
1383 break;
1384 src++;
1385 consumed_chars++;
1386 *charbuf++ = c1;
1388 c1 = *src;
1389 if (c1 & 0x80)
1390 break;
1391 src++;
1392 consumed_chars++;
1393 *charbuf++ = c1;
1395 c1 = *src;
1396 if (c1 & 0x80)
1397 break;
1398 src++;
1399 consumed_chars++;
1400 *charbuf++ = c1;
1402 /* If we handled at least one character, restart the main loop. */
1403 if (src != src_base)
1404 continue;
1407 if (byte_after_cr >= 0)
1408 c1 = byte_after_cr, byte_after_cr = -1;
1409 else
1410 ONE_MORE_BYTE (c1);
1411 if (c1 < 0)
1413 c = - c1;
1415 else if (UTF_8_1_OCTET_P (c1))
1417 if (eol_dos && c1 == '\r')
1418 ONE_MORE_BYTE (byte_after_cr);
1419 c = c1;
1421 else
1423 ONE_MORE_BYTE (c2);
1424 if (c2 < 0 || ! UTF_8_EXTRA_OCTET_P (c2))
1425 goto invalid_code;
1426 if (UTF_8_2_OCTET_LEADING_P (c1))
1428 c = ((c1 & 0x1F) << 6) | (c2 & 0x3F);
1429 /* Reject overlong sequences here and below. Encoders
1430 producing them are incorrect, they can be misleading,
1431 and they mess up read/write invariance. */
1432 if (c < 128)
1433 goto invalid_code;
1435 else
1437 ONE_MORE_BYTE (c3);
1438 if (c3 < 0 || ! UTF_8_EXTRA_OCTET_P (c3))
1439 goto invalid_code;
1440 if (UTF_8_3_OCTET_LEADING_P (c1))
1442 c = (((c1 & 0xF) << 12)
1443 | ((c2 & 0x3F) << 6) | (c3 & 0x3F));
1444 if (c < 0x800
1445 || (c >= 0xd800 && c < 0xe000)) /* surrogates (invalid) */
1446 goto invalid_code;
1448 else
1450 ONE_MORE_BYTE (c4);
1451 if (c4 < 0 || ! UTF_8_EXTRA_OCTET_P (c4))
1452 goto invalid_code;
1453 if (UTF_8_4_OCTET_LEADING_P (c1))
1455 c = (((c1 & 0x7) << 18) | ((c2 & 0x3F) << 12)
1456 | ((c3 & 0x3F) << 6) | (c4 & 0x3F));
1457 if (c < 0x10000)
1458 goto invalid_code;
1460 else
1462 ONE_MORE_BYTE (c5);
1463 if (c5 < 0 || ! UTF_8_EXTRA_OCTET_P (c5))
1464 goto invalid_code;
1465 if (UTF_8_5_OCTET_LEADING_P (c1))
1467 c = (((c1 & 0x3) << 24) | ((c2 & 0x3F) << 18)
1468 | ((c3 & 0x3F) << 12) | ((c4 & 0x3F) << 6)
1469 | (c5 & 0x3F));
1470 if ((c > MAX_CHAR) || (c < 0x200000))
1471 goto invalid_code;
1473 else
1474 goto invalid_code;
1480 *charbuf++ = c;
1481 continue;
1483 invalid_code:
1484 src = src_base;
1485 consumed_chars = consumed_chars_base;
1486 ONE_MORE_BYTE (c);
1487 *charbuf++ = ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c);
1488 coding->errors++;
1491 no_more_source:
1492 coding->consumed_char += consumed_chars_base;
1493 coding->consumed = src_base - coding->source;
1494 coding->charbuf_used = charbuf - coding->charbuf;
1498 static bool
1499 encode_coding_utf_8 (struct coding_system *coding)
1501 bool multibytep = coding->dst_multibyte;
1502 int *charbuf = coding->charbuf;
1503 int *charbuf_end = charbuf + coding->charbuf_used;
1504 unsigned char *dst = coding->destination + coding->produced;
1505 unsigned char *dst_end = coding->destination + coding->dst_bytes;
1506 ptrdiff_t produced_chars = 0;
1507 int c;
1509 if (CODING_UTF_8_BOM (coding) == utf_with_bom)
1511 ASSURE_DESTINATION (3);
1512 EMIT_THREE_BYTES (UTF_8_BOM_1, UTF_8_BOM_2, UTF_8_BOM_3);
1513 CODING_UTF_8_BOM (coding) = utf_without_bom;
1516 if (multibytep)
1518 int safe_room = MAX_MULTIBYTE_LENGTH * 2;
1520 while (charbuf < charbuf_end)
1522 unsigned char str[MAX_MULTIBYTE_LENGTH], *p, *pend = str;
1524 ASSURE_DESTINATION (safe_room);
1525 c = *charbuf++;
1526 if (CHAR_BYTE8_P (c))
1528 c = CHAR_TO_BYTE8 (c);
1529 EMIT_ONE_BYTE (c);
1531 else
1533 CHAR_STRING_ADVANCE_NO_UNIFY (c, pend);
1534 for (p = str; p < pend; p++)
1535 EMIT_ONE_BYTE (*p);
1539 else
1541 int safe_room = MAX_MULTIBYTE_LENGTH;
1543 while (charbuf < charbuf_end)
1545 ASSURE_DESTINATION (safe_room);
1546 c = *charbuf++;
1547 if (CHAR_BYTE8_P (c))
1548 *dst++ = CHAR_TO_BYTE8 (c);
1549 else
1550 CHAR_STRING_ADVANCE_NO_UNIFY (c, dst);
1551 produced_chars++;
1554 record_conversion_result (coding, CODING_RESULT_SUCCESS);
1555 coding->produced_char += produced_chars;
1556 coding->produced = dst - coding->destination;
1557 return 0;
1561 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
1562 Return true if a text is encoded in one of UTF-16 based coding systems. */
1564 #define UTF_16_HIGH_SURROGATE_P(val) \
1565 (((val) & 0xFC00) == 0xD800)
1567 #define UTF_16_LOW_SURROGATE_P(val) \
1568 (((val) & 0xFC00) == 0xDC00)
1571 static bool
1572 detect_coding_utf_16 (struct coding_system *coding,
1573 struct coding_detection_info *detect_info)
1575 const unsigned char *src = coding->source;
1576 const unsigned char *src_end = coding->source + coding->src_bytes;
1577 bool multibytep = coding->src_multibyte;
1578 int c1, c2;
1580 detect_info->checked |= CATEGORY_MASK_UTF_16;
1581 if (coding->mode & CODING_MODE_LAST_BLOCK
1582 && (coding->src_chars & 1))
1584 detect_info->rejected |= CATEGORY_MASK_UTF_16;
1585 return 0;
1588 TWO_MORE_BYTES (c1, c2);
1589 if ((c1 == 0xFF) && (c2 == 0xFE))
1591 detect_info->found |= (CATEGORY_MASK_UTF_16_LE
1592 | CATEGORY_MASK_UTF_16_AUTO);
1593 detect_info->rejected |= (CATEGORY_MASK_UTF_16_BE
1594 | CATEGORY_MASK_UTF_16_BE_NOSIG
1595 | CATEGORY_MASK_UTF_16_LE_NOSIG);
1597 else if ((c1 == 0xFE) && (c2 == 0xFF))
1599 detect_info->found |= (CATEGORY_MASK_UTF_16_BE
1600 | CATEGORY_MASK_UTF_16_AUTO);
1601 detect_info->rejected |= (CATEGORY_MASK_UTF_16_LE
1602 | CATEGORY_MASK_UTF_16_BE_NOSIG
1603 | CATEGORY_MASK_UTF_16_LE_NOSIG);
1605 else if (c2 < 0)
1607 detect_info->rejected |= CATEGORY_MASK_UTF_16;
1608 return 0;
1610 else
1612 /* We check the dispersion of Eth and Oth bytes where E is even and
1613 O is odd. If both are high, we assume binary data.*/
1614 unsigned char e[256], o[256];
1615 unsigned e_num = 1, o_num = 1;
1617 memset (e, 0, 256);
1618 memset (o, 0, 256);
1619 e[c1] = 1;
1620 o[c2] = 1;
1622 detect_info->rejected |= (CATEGORY_MASK_UTF_16_AUTO
1623 |CATEGORY_MASK_UTF_16_BE
1624 | CATEGORY_MASK_UTF_16_LE);
1626 while ((detect_info->rejected & CATEGORY_MASK_UTF_16)
1627 != CATEGORY_MASK_UTF_16)
1629 TWO_MORE_BYTES (c1, c2);
1630 if (c2 < 0)
1631 break;
1632 if (! e[c1])
1634 e[c1] = 1;
1635 e_num++;
1636 if (e_num >= 128)
1637 detect_info->rejected |= CATEGORY_MASK_UTF_16_BE_NOSIG;
1639 if (! o[c2])
1641 o[c2] = 1;
1642 o_num++;
1643 if (o_num >= 128)
1644 detect_info->rejected |= CATEGORY_MASK_UTF_16_LE_NOSIG;
1647 return 0;
1650 no_more_source:
1651 return 1;
1654 static void
1655 decode_coding_utf_16 (struct coding_system *coding)
1657 const unsigned char *src = coding->source + coding->consumed;
1658 const unsigned char *src_end = coding->source + coding->src_bytes;
1659 const unsigned char *src_base;
1660 int *charbuf = coding->charbuf + coding->charbuf_used;
1661 /* We may produces at most 3 chars in one loop. */
1662 int *charbuf_end = coding->charbuf + coding->charbuf_size - 2;
1663 ptrdiff_t consumed_chars = 0, consumed_chars_base = 0;
1664 bool multibytep = coding->src_multibyte;
1665 enum utf_bom_type bom = CODING_UTF_16_BOM (coding);
1666 enum utf_16_endian_type endian = CODING_UTF_16_ENDIAN (coding);
1667 int surrogate = CODING_UTF_16_SURROGATE (coding);
1668 bool eol_dos
1669 = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
1670 int byte_after_cr1 = -1, byte_after_cr2 = -1;
1672 if (bom == utf_with_bom)
1674 int c, c1, c2;
1676 src_base = src;
1677 ONE_MORE_BYTE (c1);
1678 ONE_MORE_BYTE (c2);
1679 c = (c1 << 8) | c2;
1681 if (endian == utf_16_big_endian
1682 ? c != 0xFEFF : c != 0xFFFE)
1684 /* The first two bytes are not BOM. Treat them as bytes
1685 for a normal character. */
1686 src = src_base;
1687 coding->errors++;
1689 CODING_UTF_16_BOM (coding) = utf_without_bom;
1691 else if (bom == utf_detect_bom)
1693 /* We have already tried to detect BOM and failed in
1694 detect_coding. */
1695 CODING_UTF_16_BOM (coding) = utf_without_bom;
1698 while (1)
1700 int c, c1, c2;
1702 src_base = src;
1703 consumed_chars_base = consumed_chars;
1705 if (charbuf >= charbuf_end)
1707 if (byte_after_cr1 >= 0)
1708 src_base -= 2;
1709 break;
1712 if (byte_after_cr1 >= 0)
1713 c1 = byte_after_cr1, byte_after_cr1 = -1;
1714 else
1715 ONE_MORE_BYTE (c1);
1716 if (c1 < 0)
1718 *charbuf++ = -c1;
1719 continue;
1721 if (byte_after_cr2 >= 0)
1722 c2 = byte_after_cr2, byte_after_cr2 = -1;
1723 else
1724 ONE_MORE_BYTE (c2);
1725 if (c2 < 0)
1727 *charbuf++ = ASCII_BYTE_P (c1) ? c1 : BYTE8_TO_CHAR (c1);
1728 *charbuf++ = -c2;
1729 continue;
1731 c = (endian == utf_16_big_endian
1732 ? ((c1 << 8) | c2) : ((c2 << 8) | c1));
1734 if (surrogate)
1736 if (! UTF_16_LOW_SURROGATE_P (c))
1738 if (endian == utf_16_big_endian)
1739 c1 = surrogate >> 8, c2 = surrogate & 0xFF;
1740 else
1741 c1 = surrogate & 0xFF, c2 = surrogate >> 8;
1742 *charbuf++ = c1;
1743 *charbuf++ = c2;
1744 coding->errors++;
1745 if (UTF_16_HIGH_SURROGATE_P (c))
1746 CODING_UTF_16_SURROGATE (coding) = surrogate = c;
1747 else
1748 *charbuf++ = c;
1750 else
1752 c = ((surrogate - 0xD800) << 10) | (c - 0xDC00);
1753 CODING_UTF_16_SURROGATE (coding) = surrogate = 0;
1754 *charbuf++ = 0x10000 + c;
1757 else
1759 if (UTF_16_HIGH_SURROGATE_P (c))
1760 CODING_UTF_16_SURROGATE (coding) = surrogate = c;
1761 else
1763 if (eol_dos && c == '\r')
1765 ONE_MORE_BYTE (byte_after_cr1);
1766 ONE_MORE_BYTE (byte_after_cr2);
1768 *charbuf++ = c;
1773 no_more_source:
1774 coding->consumed_char += consumed_chars_base;
1775 coding->consumed = src_base - coding->source;
1776 coding->charbuf_used = charbuf - coding->charbuf;
1779 static bool
1780 encode_coding_utf_16 (struct coding_system *coding)
1782 bool multibytep = coding->dst_multibyte;
1783 int *charbuf = coding->charbuf;
1784 int *charbuf_end = charbuf + coding->charbuf_used;
1785 unsigned char *dst = coding->destination + coding->produced;
1786 unsigned char *dst_end = coding->destination + coding->dst_bytes;
1787 int safe_room = 8;
1788 enum utf_bom_type bom = CODING_UTF_16_BOM (coding);
1789 bool big_endian = CODING_UTF_16_ENDIAN (coding) == utf_16_big_endian;
1790 ptrdiff_t produced_chars = 0;
1791 int c;
1793 if (bom != utf_without_bom)
1795 ASSURE_DESTINATION (safe_room);
1796 if (big_endian)
1797 EMIT_TWO_BYTES (0xFE, 0xFF);
1798 else
1799 EMIT_TWO_BYTES (0xFF, 0xFE);
1800 CODING_UTF_16_BOM (coding) = utf_without_bom;
1803 while (charbuf < charbuf_end)
1805 ASSURE_DESTINATION (safe_room);
1806 c = *charbuf++;
1807 if (c > MAX_UNICODE_CHAR)
1808 c = coding->default_char;
1810 if (c < 0x10000)
1812 if (big_endian)
1813 EMIT_TWO_BYTES (c >> 8, c & 0xFF);
1814 else
1815 EMIT_TWO_BYTES (c & 0xFF, c >> 8);
1817 else
1819 int c1, c2;
1821 c -= 0x10000;
1822 c1 = (c >> 10) + 0xD800;
1823 c2 = (c & 0x3FF) + 0xDC00;
1824 if (big_endian)
1825 EMIT_FOUR_BYTES (c1 >> 8, c1 & 0xFF, c2 >> 8, c2 & 0xFF);
1826 else
1827 EMIT_FOUR_BYTES (c1 & 0xFF, c1 >> 8, c2 & 0xFF, c2 >> 8);
1830 record_conversion_result (coding, CODING_RESULT_SUCCESS);
1831 coding->produced = dst - coding->destination;
1832 coding->produced_char += produced_chars;
1833 return 0;
1837 /*** 6. Old Emacs' internal format (emacs-mule) ***/
1839 /* Emacs' internal format for representation of multiple character
1840 sets is a kind of multi-byte encoding, i.e. characters are
1841 represented by variable-length sequences of one-byte codes.
1843 ASCII characters and control characters (e.g. `tab', `newline') are
1844 represented by one-byte sequences which are their ASCII codes, in
1845 the range 0x00 through 0x7F.
1847 8-bit characters of the range 0x80..0x9F are represented by
1848 two-byte sequences of LEADING_CODE_8_BIT_CONTROL and (their 8-bit
1849 code + 0x20).
1851 8-bit characters of the range 0xA0..0xFF are represented by
1852 one-byte sequences which are their 8-bit code.
1854 The other characters are represented by a sequence of `base
1855 leading-code', optional `extended leading-code', and one or two
1856 `position-code's. The length of the sequence is determined by the
1857 base leading-code. Leading-code takes the range 0x81 through 0x9D,
1858 whereas extended leading-code and position-code take the range 0xA0
1859 through 0xFF. See `charset.h' for more details about leading-code
1860 and position-code.
1862 --- CODE RANGE of Emacs' internal format ---
1863 character set range
1864 ------------- -----
1865 ascii 0x00..0x7F
1866 eight-bit-control LEADING_CODE_8_BIT_CONTROL + 0xA0..0xBF
1867 eight-bit-graphic 0xA0..0xBF
1868 ELSE 0x81..0x9D + [0xA0..0xFF]+
1869 ---------------------------------------------
1871 As this is the internal character representation, the format is
1872 usually not used externally (i.e. in a file or in a data sent to a
1873 process). But, it is possible to have a text externally in this
1874 format (i.e. by encoding by the coding system `emacs-mule').
1876 In that case, a sequence of one-byte codes has a slightly different
1877 form.
1879 At first, all characters in eight-bit-control are represented by
1880 one-byte sequences which are their 8-bit code.
1882 Next, character composition data are represented by the byte
1883 sequence of the form: 0x80 METHOD BYTES CHARS COMPONENT ...,
1884 where,
1885 METHOD is 0xF2 plus one of composition method (enum
1886 composition_method),
1888 BYTES is 0xA0 plus a byte length of this composition data,
1890 CHARS is 0xA0 plus a number of characters composed by this
1891 data,
1893 COMPONENTs are characters of multibyte form or composition
1894 rules encoded by two-byte of ASCII codes.
1896 In addition, for backward compatibility, the following formats are
1897 also recognized as composition data on decoding.
1899 0x80 MSEQ ...
1900 0x80 0xFF MSEQ RULE MSEQ RULE ... MSEQ
1902 Here,
1903 MSEQ is a multibyte form but in these special format:
1904 ASCII: 0xA0 ASCII_CODE+0x80,
1905 other: LEADING_CODE+0x20 FOLLOWING-BYTE ...,
1906 RULE is a one byte code of the range 0xA0..0xF0 that
1907 represents a composition rule.
1910 char emacs_mule_bytes[256];
1913 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
1914 Return true if a text is encoded in 'emacs-mule'. */
1916 static bool
1917 detect_coding_emacs_mule (struct coding_system *coding,
1918 struct coding_detection_info *detect_info)
1920 const unsigned char *src = coding->source, *src_base;
1921 const unsigned char *src_end = coding->source + coding->src_bytes;
1922 bool multibytep = coding->src_multibyte;
1923 ptrdiff_t consumed_chars = 0;
1924 int c;
1925 int found = 0;
1927 detect_info->checked |= CATEGORY_MASK_EMACS_MULE;
1928 /* A coding system of this category is always ASCII compatible. */
1929 src += coding->head_ascii;
1931 while (1)
1933 src_base = src;
1934 ONE_MORE_BYTE (c);
1935 if (c < 0)
1936 continue;
1937 if (c == 0x80)
1939 /* Perhaps the start of composite character. We simply skip
1940 it because analyzing it is too heavy for detecting. But,
1941 at least, we check that the composite character
1942 constitutes of more than 4 bytes. */
1943 const unsigned char *src_start;
1945 repeat:
1946 src_start = src;
1949 ONE_MORE_BYTE (c);
1951 while (c >= 0xA0);
1953 if (src - src_start <= 4)
1954 break;
1955 found = CATEGORY_MASK_EMACS_MULE;
1956 if (c == 0x80)
1957 goto repeat;
1960 if (c < 0x80)
1962 if (c < 0x20
1963 && (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO))
1964 break;
1966 else
1968 int more_bytes = emacs_mule_bytes[c] - 1;
1970 while (more_bytes > 0)
1972 ONE_MORE_BYTE (c);
1973 if (c < 0xA0)
1975 src--; /* Unread the last byte. */
1976 break;
1978 more_bytes--;
1980 if (more_bytes != 0)
1981 break;
1982 found = CATEGORY_MASK_EMACS_MULE;
1985 detect_info->rejected |= CATEGORY_MASK_EMACS_MULE;
1986 return 0;
1988 no_more_source:
1989 if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK)
1991 detect_info->rejected |= CATEGORY_MASK_EMACS_MULE;
1992 return 0;
1994 detect_info->found |= found;
1995 return 1;
1999 /* Parse emacs-mule multibyte sequence at SRC and return the decoded
2000 character. If CMP_STATUS indicates that we must expect MSEQ or
2001 RULE described above, decode it and return the negative value of
2002 the decoded character or rule. If an invalid byte is found, return
2003 -1. If SRC is too short, return -2. */
2005 static int
2006 emacs_mule_char (struct coding_system *coding, const unsigned char *src,
2007 int *nbytes, int *nchars, int *id,
2008 struct composition_status *cmp_status)
2010 const unsigned char *src_end = coding->source + coding->src_bytes;
2011 const unsigned char *src_base = src;
2012 bool multibytep = coding->src_multibyte;
2013 int charset_ID;
2014 unsigned code;
2015 int c;
2016 int consumed_chars = 0;
2017 bool mseq_found = 0;
2019 ONE_MORE_BYTE (c);
2020 if (c < 0)
2022 c = -c;
2023 charset_ID = emacs_mule_charset[0];
2025 else
2027 if (c >= 0xA0)
2029 if (cmp_status->state != COMPOSING_NO
2030 && cmp_status->old_form)
2032 if (cmp_status->state == COMPOSING_CHAR)
2034 if (c == 0xA0)
2036 ONE_MORE_BYTE (c);
2037 c -= 0x80;
2038 if (c < 0)
2039 goto invalid_code;
2041 else
2042 c -= 0x20;
2043 mseq_found = 1;
2045 else
2047 *nbytes = src - src_base;
2048 *nchars = consumed_chars;
2049 return -c;
2052 else
2053 goto invalid_code;
2056 switch (emacs_mule_bytes[c])
2058 case 2:
2059 if ((charset_ID = emacs_mule_charset[c]) < 0)
2060 goto invalid_code;
2061 ONE_MORE_BYTE (c);
2062 if (c < 0xA0)
2063 goto invalid_code;
2064 code = c & 0x7F;
2065 break;
2067 case 3:
2068 if (c == EMACS_MULE_LEADING_CODE_PRIVATE_11
2069 || c == EMACS_MULE_LEADING_CODE_PRIVATE_12)
2071 ONE_MORE_BYTE (c);
2072 if (c < 0xA0 || (charset_ID = emacs_mule_charset[c]) < 0)
2073 goto invalid_code;
2074 ONE_MORE_BYTE (c);
2075 if (c < 0xA0)
2076 goto invalid_code;
2077 code = c & 0x7F;
2079 else
2081 if ((charset_ID = emacs_mule_charset[c]) < 0)
2082 goto invalid_code;
2083 ONE_MORE_BYTE (c);
2084 if (c < 0xA0)
2085 goto invalid_code;
2086 code = (c & 0x7F) << 8;
2087 ONE_MORE_BYTE (c);
2088 if (c < 0xA0)
2089 goto invalid_code;
2090 code |= c & 0x7F;
2092 break;
2094 case 4:
2095 ONE_MORE_BYTE (c);
2096 if (c < 0 || (charset_ID = emacs_mule_charset[c]) < 0)
2097 goto invalid_code;
2098 ONE_MORE_BYTE (c);
2099 if (c < 0xA0)
2100 goto invalid_code;
2101 code = (c & 0x7F) << 8;
2102 ONE_MORE_BYTE (c);
2103 if (c < 0xA0)
2104 goto invalid_code;
2105 code |= c & 0x7F;
2106 break;
2108 case 1:
2109 code = c;
2110 charset_ID = ASCII_BYTE_P (code) ? charset_ascii : charset_eight_bit;
2111 break;
2113 default:
2114 emacs_abort ();
2116 CODING_DECODE_CHAR (coding, src, src_base, src_end,
2117 CHARSET_FROM_ID (charset_ID), code, c);
2118 if (c < 0)
2119 goto invalid_code;
2121 *nbytes = src - src_base;
2122 *nchars = consumed_chars;
2123 if (id)
2124 *id = charset_ID;
2125 return (mseq_found ? -c : c);
2127 no_more_source:
2128 return -2;
2130 invalid_code:
2131 return -1;
2135 /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
2137 /* Handle these composition sequence ('|': the end of header elements,
2138 BYTES and CHARS >= 0xA0):
2140 (1) relative composition: 0x80 0xF2 BYTES CHARS | CHAR ...
2141 (2) altchar composition: 0x80 0xF4 BYTES CHARS | ALT ... ALT CHAR ...
2142 (3) alt&rule composition: 0x80 0xF5 BYTES CHARS | ALT RULE ... ALT CHAR ...
2144 and these old form:
2146 (4) relative composition: 0x80 | MSEQ ... MSEQ
2147 (5) rulebase composition: 0x80 0xFF | MSEQ MRULE ... MSEQ
2149 When the starter 0x80 and the following header elements are found,
2150 this annotation header is produced.
2152 [ -LENGTH(==-5) CODING_ANNOTATE_COMPOSITION_MASK NCHARS NBYTES METHOD ]
2154 NCHARS is CHARS - 0xA0 for (1), (2), (3), and 0 for (4), (5).
2155 NBYTES is BYTES - 0xA0 for (1), (2), (3), and 0 for (4), (5).
2157 Then, upon reading the following elements, these codes are produced
2158 until the composition end is found:
2160 (1) CHAR ... CHAR
2161 (2) ALT ... ALT CHAR ... CHAR
2162 (3) ALT -2 DECODED-RULE ALT -2 DECODED-RULE ... ALT CHAR ... CHAR
2163 (4) CHAR ... CHAR
2164 (5) CHAR -2 DECODED-RULE CHAR -2 DECODED-RULE ... CHAR
2166 When the composition end is found, LENGTH and NCHARS in the
2167 annotation header is updated as below:
2169 (1) LENGTH: unchanged, NCHARS: unchanged
2170 (2) LENGTH: length of the whole sequence minus NCHARS, NCHARS: unchanged
2171 (3) LENGTH: length of the whole sequence minus NCHARS, NCHARS: unchanged
2172 (4) LENGTH: unchanged, NCHARS: number of CHARs
2173 (5) LENGTH: unchanged, NCHARS: number of CHARs
2175 If an error is found while composing, the annotation header is
2176 changed to the original composition header (plus filler -1s) as
2177 below:
2179 (1),(2),(3) [ 0x80 0xF2+METHOD BYTES CHARS -1 ]
2180 (5) [ 0x80 0xFF -1 -1- -1 ]
2182 and the sequence [ -2 DECODED-RULE ] is changed to the original
2183 byte sequence as below:
2184 o the original byte sequence is B: [ B -1 ]
2185 o the original byte sequence is B1 B2: [ B1 B2 ]
2187 Most of the routines are implemented by macros because many
2188 variables and labels in the caller decode_coding_emacs_mule must be
2189 accessible, and they are usually called just once (thus doesn't
2190 increase the size of compiled object). */
2192 /* Decode a composition rule represented by C as a component of
2193 composition sequence of Emacs 20 style. Set RULE to the decoded
2194 rule. */
2196 #define DECODE_EMACS_MULE_COMPOSITION_RULE_20(c, rule) \
2197 do { \
2198 int gref, nref; \
2200 c -= 0xA0; \
2201 if (c < 0 || c >= 81) \
2202 goto invalid_code; \
2203 gref = c / 9, nref = c % 9; \
2204 if (gref == 4) gref = 10; \
2205 if (nref == 4) nref = 10; \
2206 rule = COMPOSITION_ENCODE_RULE (gref, nref); \
2207 } while (0)
2210 /* Decode a composition rule represented by C and the following byte
2211 at SRC as a component of composition sequence of Emacs 21 style.
2212 Set RULE to the decoded rule. */
2214 #define DECODE_EMACS_MULE_COMPOSITION_RULE_21(c, rule) \
2215 do { \
2216 int gref, nref; \
2218 gref = c - 0x20; \
2219 if (gref < 0 || gref >= 81) \
2220 goto invalid_code; \
2221 ONE_MORE_BYTE (c); \
2222 nref = c - 0x20; \
2223 if (nref < 0 || nref >= 81) \
2224 goto invalid_code; \
2225 rule = COMPOSITION_ENCODE_RULE (gref, nref); \
2226 } while (0)
2229 /* Start of Emacs 21 style format. The first three bytes at SRC are
2230 (METHOD - 0xF2), (BYTES - 0xA0), (CHARS - 0xA0), where BYTES is the
2231 byte length of this composition information, CHARS is the number of
2232 characters composed by this composition. */
2234 #define DECODE_EMACS_MULE_21_COMPOSITION() \
2235 do { \
2236 enum composition_method method = c - 0xF2; \
2237 int nbytes, nchars; \
2239 ONE_MORE_BYTE (c); \
2240 if (c < 0) \
2241 goto invalid_code; \
2242 nbytes = c - 0xA0; \
2243 if (nbytes < 3 || (method == COMPOSITION_RELATIVE && nbytes != 4)) \
2244 goto invalid_code; \
2245 ONE_MORE_BYTE (c); \
2246 nchars = c - 0xA0; \
2247 if (nchars <= 0 || nchars >= MAX_COMPOSITION_COMPONENTS) \
2248 goto invalid_code; \
2249 cmp_status->old_form = 0; \
2250 cmp_status->method = method; \
2251 if (method == COMPOSITION_RELATIVE) \
2252 cmp_status->state = COMPOSING_CHAR; \
2253 else \
2254 cmp_status->state = COMPOSING_COMPONENT_CHAR; \
2255 cmp_status->length = MAX_ANNOTATION_LENGTH; \
2256 cmp_status->nchars = nchars; \
2257 cmp_status->ncomps = nbytes - 4; \
2258 ADD_COMPOSITION_DATA (charbuf, nchars, nbytes, method); \
2259 } while (0)
2262 /* Start of Emacs 20 style format for relative composition. */
2264 #define DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION() \
2265 do { \
2266 cmp_status->old_form = 1; \
2267 cmp_status->method = COMPOSITION_RELATIVE; \
2268 cmp_status->state = COMPOSING_CHAR; \
2269 cmp_status->length = MAX_ANNOTATION_LENGTH; \
2270 cmp_status->nchars = cmp_status->ncomps = 0; \
2271 ADD_COMPOSITION_DATA (charbuf, 0, 0, cmp_status->method); \
2272 } while (0)
2275 /* Start of Emacs 20 style format for rule-base composition. */
2277 #define DECODE_EMACS_MULE_20_RULEBASE_COMPOSITION() \
2278 do { \
2279 cmp_status->old_form = 1; \
2280 cmp_status->method = COMPOSITION_WITH_RULE; \
2281 cmp_status->state = COMPOSING_CHAR; \
2282 cmp_status->length = MAX_ANNOTATION_LENGTH; \
2283 cmp_status->nchars = cmp_status->ncomps = 0; \
2284 ADD_COMPOSITION_DATA (charbuf, 0, 0, cmp_status->method); \
2285 } while (0)
2288 #define DECODE_EMACS_MULE_COMPOSITION_START() \
2289 do { \
2290 const unsigned char *current_src = src; \
2292 ONE_MORE_BYTE (c); \
2293 if (c < 0) \
2294 goto invalid_code; \
2295 if (c - 0xF2 >= COMPOSITION_RELATIVE \
2296 && c - 0xF2 <= COMPOSITION_WITH_RULE_ALTCHARS) \
2297 DECODE_EMACS_MULE_21_COMPOSITION (); \
2298 else if (c < 0xA0) \
2299 goto invalid_code; \
2300 else if (c < 0xC0) \
2302 DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION (); \
2303 /* Re-read C as a composition component. */ \
2304 src = current_src; \
2306 else if (c == 0xFF) \
2307 DECODE_EMACS_MULE_20_RULEBASE_COMPOSITION (); \
2308 else \
2309 goto invalid_code; \
2310 } while (0)
2312 #define EMACS_MULE_COMPOSITION_END() \
2313 do { \
2314 int idx = - cmp_status->length; \
2316 if (cmp_status->old_form) \
2317 charbuf[idx + 2] = cmp_status->nchars; \
2318 else if (cmp_status->method > COMPOSITION_RELATIVE) \
2319 charbuf[idx] = charbuf[idx + 2] - cmp_status->length; \
2320 cmp_status->state = COMPOSING_NO; \
2321 } while (0)
2324 static int
2325 emacs_mule_finish_composition (int *charbuf,
2326 struct composition_status *cmp_status)
2328 int idx = - cmp_status->length;
2329 int new_chars;
2331 if (cmp_status->old_form && cmp_status->nchars > 0)
2333 charbuf[idx + 2] = cmp_status->nchars;
2334 new_chars = 0;
2335 if (cmp_status->method == COMPOSITION_WITH_RULE
2336 && cmp_status->state == COMPOSING_CHAR)
2338 /* The last rule was invalid. */
2339 int rule = charbuf[-1] + 0xA0;
2341 charbuf[-2] = BYTE8_TO_CHAR (rule);
2342 charbuf[-1] = -1;
2343 new_chars = 1;
2346 else
2348 charbuf[idx++] = BYTE8_TO_CHAR (0x80);
2350 if (cmp_status->method == COMPOSITION_WITH_RULE)
2352 charbuf[idx++] = BYTE8_TO_CHAR (0xFF);
2353 charbuf[idx++] = -3;
2354 charbuf[idx++] = 0;
2355 new_chars = 1;
2357 else
2359 int nchars = charbuf[idx + 1] + 0xA0;
2360 int nbytes = charbuf[idx + 2] + 0xA0;
2362 charbuf[idx++] = BYTE8_TO_CHAR (0xF2 + cmp_status->method);
2363 charbuf[idx++] = BYTE8_TO_CHAR (nbytes);
2364 charbuf[idx++] = BYTE8_TO_CHAR (nchars);
2365 charbuf[idx++] = -1;
2366 new_chars = 4;
2369 cmp_status->state = COMPOSING_NO;
2370 return new_chars;
2373 #define EMACS_MULE_MAYBE_FINISH_COMPOSITION() \
2374 do { \
2375 if (cmp_status->state != COMPOSING_NO) \
2376 char_offset += emacs_mule_finish_composition (charbuf, cmp_status); \
2377 } while (0)
2380 static void
2381 decode_coding_emacs_mule (struct coding_system *coding)
2383 const unsigned char *src = coding->source + coding->consumed;
2384 const unsigned char *src_end = coding->source + coding->src_bytes;
2385 const unsigned char *src_base;
2386 int *charbuf = coding->charbuf + coding->charbuf_used;
2387 /* We may produce two annotations (charset and composition) in one
2388 loop and one more charset annotation at the end. */
2389 int *charbuf_end
2390 = coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 3)
2391 /* We can produce up to 2 characters in a loop. */
2392 - 1;
2393 ptrdiff_t consumed_chars = 0, consumed_chars_base;
2394 bool multibytep = coding->src_multibyte;
2395 ptrdiff_t char_offset = coding->produced_char;
2396 ptrdiff_t last_offset = char_offset;
2397 int last_id = charset_ascii;
2398 bool eol_dos
2399 = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
2400 int byte_after_cr = -1;
2401 struct composition_status *cmp_status = &coding->spec.emacs_mule.cmp_status;
2403 if (cmp_status->state != COMPOSING_NO)
2405 int i;
2407 if (charbuf_end - charbuf < cmp_status->length)
2408 emacs_abort ();
2409 for (i = 0; i < cmp_status->length; i++)
2410 *charbuf++ = cmp_status->carryover[i];
2411 coding->annotated = 1;
2414 while (1)
2416 int c, id IF_LINT (= 0);
2418 src_base = src;
2419 consumed_chars_base = consumed_chars;
2421 if (charbuf >= charbuf_end)
2423 if (byte_after_cr >= 0)
2424 src_base--;
2425 break;
2428 if (byte_after_cr >= 0)
2429 c = byte_after_cr, byte_after_cr = -1;
2430 else
2431 ONE_MORE_BYTE (c);
2433 if (c < 0 || c == 0x80)
2435 EMACS_MULE_MAYBE_FINISH_COMPOSITION ();
2436 if (c < 0)
2438 *charbuf++ = -c;
2439 char_offset++;
2441 else
2442 DECODE_EMACS_MULE_COMPOSITION_START ();
2443 continue;
2446 if (c < 0x80)
2448 if (eol_dos && c == '\r')
2449 ONE_MORE_BYTE (byte_after_cr);
2450 id = charset_ascii;
2451 if (cmp_status->state != COMPOSING_NO)
2453 if (cmp_status->old_form)
2454 EMACS_MULE_MAYBE_FINISH_COMPOSITION ();
2455 else if (cmp_status->state >= COMPOSING_COMPONENT_CHAR)
2456 cmp_status->ncomps--;
2459 else
2461 int nchars IF_LINT (= 0), nbytes IF_LINT (= 0);
2462 /* emacs_mule_char can load a charset map from a file, which
2463 allocates a large structure and might cause buffer text
2464 to be relocated as result. Thus, we need to remember the
2465 original pointer to buffer text, and fix up all related
2466 pointers after the call. */
2467 const unsigned char *orig = coding->source;
2468 ptrdiff_t offset;
2470 c = emacs_mule_char (coding, src_base, &nbytes, &nchars, &id,
2471 cmp_status);
2472 offset = coding->source - orig;
2473 if (offset)
2475 src += offset;
2476 src_base += offset;
2477 src_end += offset;
2479 if (c < 0)
2481 if (c == -1)
2482 goto invalid_code;
2483 if (c == -2)
2484 break;
2486 src = src_base + nbytes;
2487 consumed_chars = consumed_chars_base + nchars;
2488 if (cmp_status->state >= COMPOSING_COMPONENT_CHAR)
2489 cmp_status->ncomps -= nchars;
2492 /* Now if C >= 0, we found a normally encoded character, if C <
2493 0, we found an old-style composition component character or
2494 rule. */
2496 if (cmp_status->state == COMPOSING_NO)
2498 if (last_id != id)
2500 if (last_id != charset_ascii)
2501 ADD_CHARSET_DATA (charbuf, char_offset - last_offset,
2502 last_id);
2503 last_id = id;
2504 last_offset = char_offset;
2506 *charbuf++ = c;
2507 char_offset++;
2509 else if (cmp_status->state == COMPOSING_CHAR)
2511 if (cmp_status->old_form)
2513 if (c >= 0)
2515 EMACS_MULE_MAYBE_FINISH_COMPOSITION ();
2516 *charbuf++ = c;
2517 char_offset++;
2519 else
2521 *charbuf++ = -c;
2522 cmp_status->nchars++;
2523 cmp_status->length++;
2524 if (cmp_status->nchars == MAX_COMPOSITION_COMPONENTS)
2525 EMACS_MULE_COMPOSITION_END ();
2526 else if (cmp_status->method == COMPOSITION_WITH_RULE)
2527 cmp_status->state = COMPOSING_RULE;
2530 else
2532 *charbuf++ = c;
2533 cmp_status->length++;
2534 cmp_status->nchars--;
2535 if (cmp_status->nchars == 0)
2536 EMACS_MULE_COMPOSITION_END ();
2539 else if (cmp_status->state == COMPOSING_RULE)
2541 int rule;
2543 if (c >= 0)
2545 EMACS_MULE_COMPOSITION_END ();
2546 *charbuf++ = c;
2547 char_offset++;
2549 else
2551 c = -c;
2552 DECODE_EMACS_MULE_COMPOSITION_RULE_20 (c, rule);
2553 if (rule < 0)
2554 goto invalid_code;
2555 *charbuf++ = -2;
2556 *charbuf++ = rule;
2557 cmp_status->length += 2;
2558 cmp_status->state = COMPOSING_CHAR;
2561 else if (cmp_status->state == COMPOSING_COMPONENT_CHAR)
2563 *charbuf++ = c;
2564 cmp_status->length++;
2565 if (cmp_status->ncomps == 0)
2566 cmp_status->state = COMPOSING_CHAR;
2567 else if (cmp_status->ncomps > 0)
2569 if (cmp_status->method == COMPOSITION_WITH_RULE_ALTCHARS)
2570 cmp_status->state = COMPOSING_COMPONENT_RULE;
2572 else
2573 EMACS_MULE_MAYBE_FINISH_COMPOSITION ();
2575 else /* COMPOSING_COMPONENT_RULE */
2577 int rule;
2579 DECODE_EMACS_MULE_COMPOSITION_RULE_21 (c, rule);
2580 if (rule < 0)
2581 goto invalid_code;
2582 *charbuf++ = -2;
2583 *charbuf++ = rule;
2584 cmp_status->length += 2;
2585 cmp_status->ncomps--;
2586 if (cmp_status->ncomps > 0)
2587 cmp_status->state = COMPOSING_COMPONENT_CHAR;
2588 else
2589 EMACS_MULE_MAYBE_FINISH_COMPOSITION ();
2591 continue;
2593 invalid_code:
2594 EMACS_MULE_MAYBE_FINISH_COMPOSITION ();
2595 src = src_base;
2596 consumed_chars = consumed_chars_base;
2597 ONE_MORE_BYTE (c);
2598 *charbuf++ = ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c);
2599 char_offset++;
2600 coding->errors++;
2603 no_more_source:
2604 if (cmp_status->state != COMPOSING_NO)
2606 if (coding->mode & CODING_MODE_LAST_BLOCK)
2607 EMACS_MULE_MAYBE_FINISH_COMPOSITION ();
2608 else
2610 int i;
2612 charbuf -= cmp_status->length;
2613 for (i = 0; i < cmp_status->length; i++)
2614 cmp_status->carryover[i] = charbuf[i];
2617 if (last_id != charset_ascii)
2618 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
2619 coding->consumed_char += consumed_chars_base;
2620 coding->consumed = src_base - coding->source;
2621 coding->charbuf_used = charbuf - coding->charbuf;
2625 #define EMACS_MULE_LEADING_CODES(id, codes) \
2626 do { \
2627 if (id < 0xA0) \
2628 codes[0] = id, codes[1] = 0; \
2629 else if (id < 0xE0) \
2630 codes[0] = 0x9A, codes[1] = id; \
2631 else if (id < 0xF0) \
2632 codes[0] = 0x9B, codes[1] = id; \
2633 else if (id < 0xF5) \
2634 codes[0] = 0x9C, codes[1] = id; \
2635 else \
2636 codes[0] = 0x9D, codes[1] = id; \
2637 } while (0);
2640 static bool
2641 encode_coding_emacs_mule (struct coding_system *coding)
2643 bool multibytep = coding->dst_multibyte;
2644 int *charbuf = coding->charbuf;
2645 int *charbuf_end = charbuf + coding->charbuf_used;
2646 unsigned char *dst = coding->destination + coding->produced;
2647 unsigned char *dst_end = coding->destination + coding->dst_bytes;
2648 int safe_room = 8;
2649 ptrdiff_t produced_chars = 0;
2650 Lisp_Object attrs, charset_list;
2651 int c;
2652 int preferred_charset_id = -1;
2654 CODING_GET_INFO (coding, attrs, charset_list);
2655 if (! EQ (charset_list, Vemacs_mule_charset_list))
2657 charset_list = Vemacs_mule_charset_list;
2658 ASET (attrs, coding_attr_charset_list, charset_list);
2661 while (charbuf < charbuf_end)
2663 ASSURE_DESTINATION (safe_room);
2664 c = *charbuf++;
2666 if (c < 0)
2668 /* Handle an annotation. */
2669 switch (*charbuf)
2671 case CODING_ANNOTATE_COMPOSITION_MASK:
2672 /* Not yet implemented. */
2673 break;
2674 case CODING_ANNOTATE_CHARSET_MASK:
2675 preferred_charset_id = charbuf[3];
2676 if (preferred_charset_id >= 0
2677 && NILP (Fmemq (make_number (preferred_charset_id),
2678 charset_list)))
2679 preferred_charset_id = -1;
2680 break;
2681 default:
2682 emacs_abort ();
2684 charbuf += -c - 1;
2685 continue;
2688 if (ASCII_CHAR_P (c))
2689 EMIT_ONE_ASCII_BYTE (c);
2690 else if (CHAR_BYTE8_P (c))
2692 c = CHAR_TO_BYTE8 (c);
2693 EMIT_ONE_BYTE (c);
2695 else
2697 struct charset *charset;
2698 unsigned code;
2699 int dimension;
2700 int emacs_mule_id;
2701 unsigned char leading_codes[2];
2703 if (preferred_charset_id >= 0)
2705 bool result;
2707 charset = CHARSET_FROM_ID (preferred_charset_id);
2708 CODING_CHAR_CHARSET_P (coding, dst, dst_end, c, charset, result);
2709 if (result)
2710 code = ENCODE_CHAR (charset, c);
2711 else
2712 CODING_CHAR_CHARSET (coding, dst, dst_end, c, charset_list,
2713 &code, charset);
2715 else
2716 CODING_CHAR_CHARSET (coding, dst, dst_end, c, charset_list,
2717 &code, charset);
2718 if (! charset)
2720 c = coding->default_char;
2721 if (ASCII_CHAR_P (c))
2723 EMIT_ONE_ASCII_BYTE (c);
2724 continue;
2726 CODING_CHAR_CHARSET (coding, dst, dst_end, c, charset_list,
2727 &code, charset);
2729 dimension = CHARSET_DIMENSION (charset);
2730 emacs_mule_id = CHARSET_EMACS_MULE_ID (charset);
2731 EMACS_MULE_LEADING_CODES (emacs_mule_id, leading_codes);
2732 EMIT_ONE_BYTE (leading_codes[0]);
2733 if (leading_codes[1])
2734 EMIT_ONE_BYTE (leading_codes[1]);
2735 if (dimension == 1)
2736 EMIT_ONE_BYTE (code | 0x80);
2737 else
2739 code |= 0x8080;
2740 EMIT_ONE_BYTE (code >> 8);
2741 EMIT_ONE_BYTE (code & 0xFF);
2745 record_conversion_result (coding, CODING_RESULT_SUCCESS);
2746 coding->produced_char += produced_chars;
2747 coding->produced = dst - coding->destination;
2748 return 0;
2752 /*** 7. ISO2022 handlers ***/
2754 /* The following note describes the coding system ISO2022 briefly.
2755 Since the intention of this note is to help understand the
2756 functions in this file, some parts are NOT ACCURATE or are OVERLY
2757 SIMPLIFIED. For thorough understanding, please refer to the
2758 original document of ISO2022. This is equivalent to the standard
2759 ECMA-35, obtainable from <URL:http://www.ecma.ch/> (*).
2761 ISO2022 provides many mechanisms to encode several character sets
2762 in 7-bit and 8-bit environments. For 7-bit environments, all text
2763 is encoded using bytes less than 128. This may make the encoded
2764 text a little bit longer, but the text passes more easily through
2765 several types of gateway, some of which strip off the MSB (Most
2766 Significant Bit).
2768 There are two kinds of character sets: control character sets and
2769 graphic character sets. The former contain control characters such
2770 as `newline' and `escape' to provide control functions (control
2771 functions are also provided by escape sequences). The latter
2772 contain graphic characters such as 'A' and '-'. Emacs recognizes
2773 two control character sets and many graphic character sets.
2775 Graphic character sets are classified into one of the following
2776 four classes, according to the number of bytes (DIMENSION) and
2777 number of characters in one dimension (CHARS) of the set:
2778 - DIMENSION1_CHARS94
2779 - DIMENSION1_CHARS96
2780 - DIMENSION2_CHARS94
2781 - DIMENSION2_CHARS96
2783 In addition, each character set is assigned an identification tag,
2784 unique for each set, called the "final character" (denoted as <F>
2785 hereafter). The <F> of each character set is decided by ECMA(*)
2786 when it is registered in ISO. The code range of <F> is 0x30..0x7F
2787 (0x30..0x3F are for private use only).
2789 Note (*): ECMA = European Computer Manufacturers Association
2791 Here are examples of graphic character sets [NAME(<F>)]:
2792 o DIMENSION1_CHARS94 -- ASCII('B'), right-half-of-JISX0201('I'), ...
2793 o DIMENSION1_CHARS96 -- right-half-of-ISO8859-1('A'), ...
2794 o DIMENSION2_CHARS94 -- GB2312('A'), JISX0208('B'), ...
2795 o DIMENSION2_CHARS96 -- none for the moment
2797 A code area (1 byte=8 bits) is divided into 4 areas, C0, GL, C1, and GR.
2798 C0 [0x00..0x1F] -- control character plane 0
2799 GL [0x20..0x7F] -- graphic character plane 0
2800 C1 [0x80..0x9F] -- control character plane 1
2801 GR [0xA0..0xFF] -- graphic character plane 1
2803 A control character set is directly designated and invoked to C0 or
2804 C1 by an escape sequence. The most common case is that:
2805 - ISO646's control character set is designated/invoked to C0, and
2806 - ISO6429's control character set is designated/invoked to C1,
2807 and usually these designations/invocations are omitted in encoded
2808 text. In a 7-bit environment, only C0 can be used, and a control
2809 character for C1 is encoded by an appropriate escape sequence to
2810 fit into the environment. All control characters for C1 are
2811 defined to have corresponding escape sequences.
2813 A graphic character set is at first designated to one of four
2814 graphic registers (G0 through G3), then these graphic registers are
2815 invoked to GL or GR. These designations and invocations can be
2816 done independently. The most common case is that G0 is invoked to
2817 GL, G1 is invoked to GR, and ASCII is designated to G0. Usually
2818 these invocations and designations are omitted in encoded text.
2819 In a 7-bit environment, only GL can be used.
2821 When a graphic character set of CHARS94 is invoked to GL, codes
2822 0x20 and 0x7F of the GL area work as control characters SPACE and
2823 DEL respectively, and codes 0xA0 and 0xFF of the GR area should not
2824 be used.
2826 There are two ways of invocation: locking-shift and single-shift.
2827 With locking-shift, the invocation lasts until the next different
2828 invocation, whereas with single-shift, the invocation affects the
2829 following character only and doesn't affect the locking-shift
2830 state. Invocations are done by the following control characters or
2831 escape sequences:
2833 ----------------------------------------------------------------------
2834 abbrev function cntrl escape seq description
2835 ----------------------------------------------------------------------
2836 SI/LS0 (shift-in) 0x0F none invoke G0 into GL
2837 SO/LS1 (shift-out) 0x0E none invoke G1 into GL
2838 LS2 (locking-shift-2) none ESC 'n' invoke G2 into GL
2839 LS3 (locking-shift-3) none ESC 'o' invoke G3 into GL
2840 LS1R (locking-shift-1 right) none ESC '~' invoke G1 into GR (*)
2841 LS2R (locking-shift-2 right) none ESC '}' invoke G2 into GR (*)
2842 LS3R (locking-shift 3 right) none ESC '|' invoke G3 into GR (*)
2843 SS2 (single-shift-2) 0x8E ESC 'N' invoke G2 for one char
2844 SS3 (single-shift-3) 0x8F ESC 'O' invoke G3 for one char
2845 ----------------------------------------------------------------------
2846 (*) These are not used by any known coding system.
2848 Control characters for these functions are defined by macros
2849 ISO_CODE_XXX in `coding.h'.
2851 Designations are done by the following escape sequences:
2852 ----------------------------------------------------------------------
2853 escape sequence description
2854 ----------------------------------------------------------------------
2855 ESC '(' <F> designate DIMENSION1_CHARS94<F> to G0
2856 ESC ')' <F> designate DIMENSION1_CHARS94<F> to G1
2857 ESC '*' <F> designate DIMENSION1_CHARS94<F> to G2
2858 ESC '+' <F> designate DIMENSION1_CHARS94<F> to G3
2859 ESC ',' <F> designate DIMENSION1_CHARS96<F> to G0 (*)
2860 ESC '-' <F> designate DIMENSION1_CHARS96<F> to G1
2861 ESC '.' <F> designate DIMENSION1_CHARS96<F> to G2
2862 ESC '/' <F> designate DIMENSION1_CHARS96<F> to G3
2863 ESC '$' '(' <F> designate DIMENSION2_CHARS94<F> to G0 (**)
2864 ESC '$' ')' <F> designate DIMENSION2_CHARS94<F> to G1
2865 ESC '$' '*' <F> designate DIMENSION2_CHARS94<F> to G2
2866 ESC '$' '+' <F> designate DIMENSION2_CHARS94<F> to G3
2867 ESC '$' ',' <F> designate DIMENSION2_CHARS96<F> to G0 (*)
2868 ESC '$' '-' <F> designate DIMENSION2_CHARS96<F> to G1
2869 ESC '$' '.' <F> designate DIMENSION2_CHARS96<F> to G2
2870 ESC '$' '/' <F> designate DIMENSION2_CHARS96<F> to G3
2871 ----------------------------------------------------------------------
2873 In this list, "DIMENSION1_CHARS94<F>" means a graphic character set
2874 of dimension 1, chars 94, and final character <F>, etc...
2876 Note (*): Although these designations are not allowed in ISO2022,
2877 Emacs accepts them on decoding, and produces them on encoding
2878 CHARS96 character sets in a coding system which is characterized as
2879 7-bit environment, non-locking-shift, and non-single-shift.
2881 Note (**): If <F> is '@', 'A', or 'B', the intermediate character
2882 '(' must be omitted. We refer to this as "short-form" hereafter.
2884 Now you may notice that there are a lot of ways of encoding the
2885 same multilingual text in ISO2022. Actually, there exist many
2886 coding systems such as Compound Text (used in X11's inter client
2887 communication, ISO-2022-JP (used in Japanese Internet), ISO-2022-KR
2888 (used in Korean Internet), EUC (Extended UNIX Code, used in Asian
2889 localized platforms), and all of these are variants of ISO2022.
2891 In addition to the above, Emacs handles two more kinds of escape
2892 sequences: ISO6429's direction specification and Emacs' private
2893 sequence for specifying character composition.
2895 ISO6429's direction specification takes the following form:
2896 o CSI ']' -- end of the current direction
2897 o CSI '0' ']' -- end of the current direction
2898 o CSI '1' ']' -- start of left-to-right text
2899 o CSI '2' ']' -- start of right-to-left text
2900 The control character CSI (0x9B: control sequence introducer) is
2901 abbreviated to the escape sequence ESC '[' in a 7-bit environment.
2903 Character composition specification takes the following form:
2904 o ESC '0' -- start relative composition
2905 o ESC '1' -- end composition
2906 o ESC '2' -- start rule-base composition (*)
2907 o ESC '3' -- start relative composition with alternate chars (**)
2908 o ESC '4' -- start rule-base composition with alternate chars (**)
2909 Since these are not standard escape sequences of any ISO standard,
2910 the use of them with these meanings is restricted to Emacs only.
2912 (*) This form is used only in Emacs 20.7 and older versions,
2913 but newer versions can safely decode it.
2914 (**) This form is used only in Emacs 21.1 and newer versions,
2915 and older versions can't decode it.
2917 Here's a list of example usages of these composition escape
2918 sequences (categorized by `enum composition_method').
2920 COMPOSITION_RELATIVE:
2921 ESC 0 CHAR [ CHAR ] ESC 1
2922 COMPOSITION_WITH_RULE:
2923 ESC 2 CHAR [ RULE CHAR ] ESC 1
2924 COMPOSITION_WITH_ALTCHARS:
2925 ESC 3 ALTCHAR [ ALTCHAR ] ESC 0 CHAR [ CHAR ] ESC 1
2926 COMPOSITION_WITH_RULE_ALTCHARS:
2927 ESC 4 ALTCHAR [ RULE ALTCHAR ] ESC 0 CHAR [ CHAR ] ESC 1 */
2929 static enum iso_code_class_type iso_code_class[256];
2931 #define SAFE_CHARSET_P(coding, id) \
2932 ((id) <= (coding)->max_charset_id \
2933 && (coding)->safe_charsets[id] != 255)
2935 static void
2936 setup_iso_safe_charsets (Lisp_Object attrs)
2938 Lisp_Object charset_list, safe_charsets;
2939 Lisp_Object request;
2940 Lisp_Object reg_usage;
2941 Lisp_Object tail;
2942 EMACS_INT reg94, reg96;
2943 int flags = XINT (AREF (attrs, coding_attr_iso_flags));
2944 int max_charset_id;
2946 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
2947 if ((flags & CODING_ISO_FLAG_FULL_SUPPORT)
2948 && ! EQ (charset_list, Viso_2022_charset_list))
2950 charset_list = Viso_2022_charset_list;
2951 ASET (attrs, coding_attr_charset_list, charset_list);
2952 ASET (attrs, coding_attr_safe_charsets, Qnil);
2955 if (STRINGP (AREF (attrs, coding_attr_safe_charsets)))
2956 return;
2958 max_charset_id = 0;
2959 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
2961 int id = XINT (XCAR (tail));
2962 if (max_charset_id < id)
2963 max_charset_id = id;
2966 safe_charsets = make_uninit_string (max_charset_id + 1);
2967 memset (SDATA (safe_charsets), 255, max_charset_id + 1);
2968 request = AREF (attrs, coding_attr_iso_request);
2969 reg_usage = AREF (attrs, coding_attr_iso_usage);
2970 reg94 = XINT (XCAR (reg_usage));
2971 reg96 = XINT (XCDR (reg_usage));
2973 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
2975 Lisp_Object id;
2976 Lisp_Object reg;
2977 struct charset *charset;
2979 id = XCAR (tail);
2980 charset = CHARSET_FROM_ID (XINT (id));
2981 reg = Fcdr (Fassq (id, request));
2982 if (! NILP (reg))
2983 SSET (safe_charsets, XINT (id), XINT (reg));
2984 else if (charset->iso_chars_96)
2986 if (reg96 < 4)
2987 SSET (safe_charsets, XINT (id), reg96);
2989 else
2991 if (reg94 < 4)
2992 SSET (safe_charsets, XINT (id), reg94);
2995 ASET (attrs, coding_attr_safe_charsets, safe_charsets);
2999 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
3000 Return true if a text is encoded in one of ISO-2022 based coding
3001 systems. */
3003 static bool
3004 detect_coding_iso_2022 (struct coding_system *coding,
3005 struct coding_detection_info *detect_info)
3007 const unsigned char *src = coding->source, *src_base = src;
3008 const unsigned char *src_end = coding->source + coding->src_bytes;
3009 bool multibytep = coding->src_multibyte;
3010 bool single_shifting = 0;
3011 int id;
3012 int c, c1;
3013 ptrdiff_t consumed_chars = 0;
3014 int i;
3015 int rejected = 0;
3016 int found = 0;
3017 int composition_count = -1;
3019 detect_info->checked |= CATEGORY_MASK_ISO;
3021 for (i = coding_category_iso_7; i <= coding_category_iso_8_else; i++)
3023 struct coding_system *this = &(coding_categories[i]);
3024 Lisp_Object attrs, val;
3026 if (this->id < 0)
3027 continue;
3028 attrs = CODING_ID_ATTRS (this->id);
3029 if (CODING_ISO_FLAGS (this) & CODING_ISO_FLAG_FULL_SUPPORT
3030 && ! EQ (CODING_ATTR_CHARSET_LIST (attrs), Viso_2022_charset_list))
3031 setup_iso_safe_charsets (attrs);
3032 val = CODING_ATTR_SAFE_CHARSETS (attrs);
3033 this->max_charset_id = SCHARS (val) - 1;
3034 this->safe_charsets = SDATA (val);
3037 /* A coding system of this category is always ASCII compatible. */
3038 src += coding->head_ascii;
3040 while (rejected != CATEGORY_MASK_ISO)
3042 src_base = src;
3043 ONE_MORE_BYTE (c);
3044 switch (c)
3046 case ISO_CODE_ESC:
3047 if (inhibit_iso_escape_detection)
3048 break;
3049 single_shifting = 0;
3050 ONE_MORE_BYTE (c);
3051 if (c == 'N' || c == 'O')
3053 /* ESC <Fe> for SS2 or SS3. */
3054 single_shifting = 1;
3055 rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_8BIT;
3057 else if (c == '1')
3059 /* End of composition. */
3060 if (composition_count < 0
3061 || composition_count > MAX_COMPOSITION_COMPONENTS)
3062 /* Invalid */
3063 break;
3064 composition_count = -1;
3065 found |= CATEGORY_MASK_ISO;
3067 else if (c >= '0' && c <= '4')
3069 /* ESC <Fp> for start/end composition. */
3070 composition_count = 0;
3072 else
3074 if (c >= '(' && c <= '/')
3076 /* Designation sequence for a charset of dimension 1. */
3077 ONE_MORE_BYTE (c1);
3078 if (c1 < ' ' || c1 >= 0x80
3079 || (id = iso_charset_table[0][c >= ','][c1]) < 0)
3080 /* Invalid designation sequence. Just ignore. */
3081 break;
3083 else if (c == '$')
3085 /* Designation sequence for a charset of dimension 2. */
3086 ONE_MORE_BYTE (c);
3087 if (c >= '@' && c <= 'B')
3088 /* Designation for JISX0208.1978, GB2312, or JISX0208. */
3089 id = iso_charset_table[1][0][c];
3090 else if (c >= '(' && c <= '/')
3092 ONE_MORE_BYTE (c1);
3093 if (c1 < ' ' || c1 >= 0x80
3094 || (id = iso_charset_table[1][c >= ','][c1]) < 0)
3095 /* Invalid designation sequence. Just ignore. */
3096 break;
3098 else
3099 /* Invalid designation sequence. Just ignore it. */
3100 break;
3102 else
3104 /* Invalid escape sequence. Just ignore it. */
3105 break;
3108 /* We found a valid designation sequence for CHARSET. */
3109 rejected |= CATEGORY_MASK_ISO_8BIT;
3110 if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_7],
3111 id))
3112 found |= CATEGORY_MASK_ISO_7;
3113 else
3114 rejected |= CATEGORY_MASK_ISO_7;
3115 if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_7_tight],
3116 id))
3117 found |= CATEGORY_MASK_ISO_7_TIGHT;
3118 else
3119 rejected |= CATEGORY_MASK_ISO_7_TIGHT;
3120 if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_7_else],
3121 id))
3122 found |= CATEGORY_MASK_ISO_7_ELSE;
3123 else
3124 rejected |= CATEGORY_MASK_ISO_7_ELSE;
3125 if (SAFE_CHARSET_P (&coding_categories[coding_category_iso_8_else],
3126 id))
3127 found |= CATEGORY_MASK_ISO_8_ELSE;
3128 else
3129 rejected |= CATEGORY_MASK_ISO_8_ELSE;
3131 break;
3133 case ISO_CODE_SO:
3134 case ISO_CODE_SI:
3135 /* Locking shift out/in. */
3136 if (inhibit_iso_escape_detection)
3137 break;
3138 single_shifting = 0;
3139 rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_8BIT;
3140 break;
3142 case ISO_CODE_CSI:
3143 /* Control sequence introducer. */
3144 single_shifting = 0;
3145 rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_7_ELSE;
3146 found |= CATEGORY_MASK_ISO_8_ELSE;
3147 goto check_extra_latin;
3149 case ISO_CODE_SS2:
3150 case ISO_CODE_SS3:
3151 /* Single shift. */
3152 if (inhibit_iso_escape_detection)
3153 break;
3154 single_shifting = 0;
3155 rejected |= CATEGORY_MASK_ISO_7BIT;
3156 if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_1])
3157 & CODING_ISO_FLAG_SINGLE_SHIFT)
3159 found |= CATEGORY_MASK_ISO_8_1;
3160 single_shifting = 1;
3162 if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_2])
3163 & CODING_ISO_FLAG_SINGLE_SHIFT)
3165 found |= CATEGORY_MASK_ISO_8_2;
3166 single_shifting = 1;
3168 if (single_shifting)
3169 break;
3170 goto check_extra_latin;
3172 default:
3173 if (c < 0)
3174 continue;
3175 if (c < 0x80)
3177 if (composition_count >= 0)
3178 composition_count++;
3179 single_shifting = 0;
3180 break;
3182 if (c >= 0xA0)
3184 rejected |= CATEGORY_MASK_ISO_7BIT | CATEGORY_MASK_ISO_7_ELSE;
3185 found |= CATEGORY_MASK_ISO_8_1;
3186 /* Check the length of succeeding codes of the range
3187 0xA0..0FF. If the byte length is even, we include
3188 CATEGORY_MASK_ISO_8_2 in `found'. We can check this
3189 only when we are not single shifting. */
3190 if (! single_shifting
3191 && ! (rejected & CATEGORY_MASK_ISO_8_2))
3193 int len = 1;
3194 while (src < src_end)
3196 src_base = src;
3197 ONE_MORE_BYTE (c);
3198 if (c < 0xA0)
3200 src = src_base;
3201 break;
3203 len++;
3206 if (len & 1 && src < src_end)
3208 rejected |= CATEGORY_MASK_ISO_8_2;
3209 if (composition_count >= 0)
3210 composition_count += len;
3212 else
3214 found |= CATEGORY_MASK_ISO_8_2;
3215 if (composition_count >= 0)
3216 composition_count += len / 2;
3219 break;
3221 check_extra_latin:
3222 if (! VECTORP (Vlatin_extra_code_table)
3223 || NILP (AREF (Vlatin_extra_code_table, c)))
3225 rejected = CATEGORY_MASK_ISO;
3226 break;
3228 if (CODING_ISO_FLAGS (&coding_categories[coding_category_iso_8_1])
3229 & CODING_ISO_FLAG_LATIN_EXTRA)
3230 found |= CATEGORY_MASK_ISO_8_1;
3231 else
3232 rejected |= CATEGORY_MASK_ISO_8_1;
3233 rejected |= CATEGORY_MASK_ISO_8_2;
3234 break;
3237 detect_info->rejected |= CATEGORY_MASK_ISO;
3238 return 0;
3240 no_more_source:
3241 detect_info->rejected |= rejected;
3242 detect_info->found |= (found & ~rejected);
3243 return 1;
3247 /* Set designation state into CODING. Set CHARS_96 to -1 if the
3248 escape sequence should be kept. */
3249 #define DECODE_DESIGNATION(reg, dim, chars_96, final) \
3250 do { \
3251 int id, prev; \
3253 if (final < '0' || final >= 128 \
3254 || ((id = ISO_CHARSET_TABLE (dim, chars_96, final)) < 0) \
3255 || !SAFE_CHARSET_P (coding, id)) \
3257 CODING_ISO_DESIGNATION (coding, reg) = -2; \
3258 chars_96 = -1; \
3259 break; \
3261 prev = CODING_ISO_DESIGNATION (coding, reg); \
3262 if (id == charset_jisx0201_roman) \
3264 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_ROMAN) \
3265 id = charset_ascii; \
3267 else if (id == charset_jisx0208_1978) \
3269 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_OLDJIS) \
3270 id = charset_jisx0208; \
3272 CODING_ISO_DESIGNATION (coding, reg) = id; \
3273 /* If there was an invalid designation to REG previously, and this \
3274 designation is ASCII to REG, we should keep this designation \
3275 sequence. */ \
3276 if (prev == -2 && id == charset_ascii) \
3277 chars_96 = -1; \
3278 } while (0)
3281 /* Handle these composition sequence (ALT: alternate char):
3283 (1) relative composition: ESC 0 CHAR ... ESC 1
3284 (2) rulebase composition: ESC 2 CHAR RULE CHAR RULE ... CHAR ESC 1
3285 (3) altchar composition: ESC 3 ALT ... ALT ESC 0 CHAR ... ESC 1
3286 (4) alt&rule composition: ESC 4 ALT RULE ... ALT ESC 0 CHAR ... ESC 1
3288 When the start sequence (ESC 0/2/3/4) is found, this annotation
3289 header is produced.
3291 [ -LENGTH(==-5) CODING_ANNOTATE_COMPOSITION_MASK NCHARS(==0) 0 METHOD ]
3293 Then, upon reading CHAR or RULE (one or two bytes), these codes are
3294 produced until the end sequence (ESC 1) is found:
3296 (1) CHAR ... CHAR
3297 (2) CHAR -2 DECODED-RULE CHAR -2 DECODED-RULE ... CHAR
3298 (3) ALT ... ALT -1 -1 CHAR ... CHAR
3299 (4) ALT -2 DECODED-RULE ALT -2 DECODED-RULE ... ALT -1 -1 CHAR ... CHAR
3301 When the end sequence (ESC 1) is found, LENGTH and NCHARS in the
3302 annotation header is updated as below:
3304 (1) LENGTH: unchanged, NCHARS: number of CHARs
3305 (2) LENGTH: unchanged, NCHARS: number of CHARs
3306 (3) LENGTH: += number of ALTs + 2, NCHARS: number of CHARs
3307 (4) LENGTH: += number of ALTs * 3, NCHARS: number of CHARs
3309 If an error is found while composing, the annotation header is
3310 changed to:
3312 [ ESC '0'/'2'/'3'/'4' -2 0 ]
3314 and the sequence [ -2 DECODED-RULE ] is changed to the original
3315 byte sequence as below:
3316 o the original byte sequence is B: [ B -1 ]
3317 o the original byte sequence is B1 B2: [ B1 B2 ]
3318 and the sequence [ -1 -1 ] is changed to the original byte
3319 sequence:
3320 [ ESC '0' ]
3323 /* Decode a composition rule C1 and maybe one more byte from the
3324 source, and set RULE to the encoded composition rule. If the rule
3325 is invalid, goto invalid_code. */
3327 #define DECODE_COMPOSITION_RULE(rule) \
3328 do { \
3329 rule = c1 - 32; \
3330 if (rule < 0) \
3331 goto invalid_code; \
3332 if (rule < 81) /* old format (before ver.21) */ \
3334 int gref = (rule) / 9; \
3335 int nref = (rule) % 9; \
3336 if (gref == 4) gref = 10; \
3337 if (nref == 4) nref = 10; \
3338 rule = COMPOSITION_ENCODE_RULE (gref, nref); \
3340 else /* new format (after ver.21) */ \
3342 int b; \
3344 ONE_MORE_BYTE (b); \
3345 if (! COMPOSITION_ENCODE_RULE_VALID (rule - 81, b - 32)) \
3346 goto invalid_code; \
3347 rule = COMPOSITION_ENCODE_RULE (rule - 81, b - 32); \
3348 rule += 0x100; /* Distinguish it from the old format. */ \
3350 } while (0)
3352 #define ENCODE_COMPOSITION_RULE(rule) \
3353 do { \
3354 int gref = (rule % 0x100) / 12, nref = (rule % 0x100) % 12; \
3356 if (rule < 0x100) /* old format */ \
3358 if (gref == 10) gref = 4; \
3359 if (nref == 10) nref = 4; \
3360 charbuf[idx] = 32 + gref * 9 + nref; \
3361 charbuf[idx + 1] = -1; \
3362 new_chars++; \
3364 else /* new format */ \
3366 charbuf[idx] = 32 + 81 + gref; \
3367 charbuf[idx + 1] = 32 + nref; \
3368 new_chars += 2; \
3370 } while (0)
3372 /* Finish the current composition as invalid. */
3374 static int
3375 finish_composition (int *charbuf, struct composition_status *cmp_status)
3377 int idx = - cmp_status->length;
3378 int new_chars;
3380 /* Recover the original ESC sequence */
3381 charbuf[idx++] = ISO_CODE_ESC;
3382 charbuf[idx++] = (cmp_status->method == COMPOSITION_RELATIVE ? '0'
3383 : cmp_status->method == COMPOSITION_WITH_RULE ? '2'
3384 : cmp_status->method == COMPOSITION_WITH_ALTCHARS ? '3'
3385 /* cmp_status->method == COMPOSITION_WITH_RULE_ALTCHARS */
3386 : '4');
3387 charbuf[idx++] = -2;
3388 charbuf[idx++] = 0;
3389 charbuf[idx++] = -1;
3390 new_chars = cmp_status->nchars;
3391 if (cmp_status->method >= COMPOSITION_WITH_RULE)
3392 for (; idx < 0; idx++)
3394 int elt = charbuf[idx];
3396 if (elt == -2)
3398 ENCODE_COMPOSITION_RULE (charbuf[idx + 1]);
3399 idx++;
3401 else if (elt == -1)
3403 charbuf[idx++] = ISO_CODE_ESC;
3404 charbuf[idx] = '0';
3405 new_chars += 2;
3408 cmp_status->state = COMPOSING_NO;
3409 return new_chars;
3412 /* If characters are under composition, finish the composition. */
3413 #define MAYBE_FINISH_COMPOSITION() \
3414 do { \
3415 if (cmp_status->state != COMPOSING_NO) \
3416 char_offset += finish_composition (charbuf, cmp_status); \
3417 } while (0)
3419 /* Handle composition start sequence ESC 0, ESC 2, ESC 3, or ESC 4.
3421 ESC 0 : relative composition : ESC 0 CHAR ... ESC 1
3422 ESC 2 : rulebase composition : ESC 2 CHAR RULE CHAR RULE ... CHAR ESC 1
3423 ESC 3 : altchar composition : ESC 3 CHAR ... ESC 0 CHAR ... ESC 1
3424 ESC 4 : alt&rule composition : ESC 4 CHAR RULE ... CHAR ESC 0 CHAR ... ESC 1
3426 Produce this annotation sequence now:
3428 [ -LENGTH(==-4) CODING_ANNOTATE_COMPOSITION_MASK NCHARS(==0) METHOD ]
3431 #define DECODE_COMPOSITION_START(c1) \
3432 do { \
3433 if (c1 == '0' \
3434 && ((cmp_status->state == COMPOSING_COMPONENT_CHAR \
3435 && cmp_status->method == COMPOSITION_WITH_ALTCHARS) \
3436 || (cmp_status->state == COMPOSING_COMPONENT_RULE \
3437 && cmp_status->method == COMPOSITION_WITH_RULE_ALTCHARS))) \
3439 *charbuf++ = -1; \
3440 *charbuf++= -1; \
3441 cmp_status->state = COMPOSING_CHAR; \
3442 cmp_status->length += 2; \
3444 else \
3446 MAYBE_FINISH_COMPOSITION (); \
3447 cmp_status->method = (c1 == '0' ? COMPOSITION_RELATIVE \
3448 : c1 == '2' ? COMPOSITION_WITH_RULE \
3449 : c1 == '3' ? COMPOSITION_WITH_ALTCHARS \
3450 : COMPOSITION_WITH_RULE_ALTCHARS); \
3451 cmp_status->state \
3452 = (c1 <= '2' ? COMPOSING_CHAR : COMPOSING_COMPONENT_CHAR); \
3453 ADD_COMPOSITION_DATA (charbuf, 0, 0, cmp_status->method); \
3454 cmp_status->length = MAX_ANNOTATION_LENGTH; \
3455 cmp_status->nchars = cmp_status->ncomps = 0; \
3456 coding->annotated = 1; \
3458 } while (0)
3461 /* Handle composition end sequence ESC 1. */
3463 #define DECODE_COMPOSITION_END() \
3464 do { \
3465 if (cmp_status->nchars == 0 \
3466 || ((cmp_status->state == COMPOSING_CHAR) \
3467 == (cmp_status->method == COMPOSITION_WITH_RULE))) \
3469 MAYBE_FINISH_COMPOSITION (); \
3470 goto invalid_code; \
3472 if (cmp_status->method == COMPOSITION_WITH_ALTCHARS) \
3473 charbuf[- cmp_status->length] -= cmp_status->ncomps + 2; \
3474 else if (cmp_status->method == COMPOSITION_WITH_RULE_ALTCHARS) \
3475 charbuf[- cmp_status->length] -= cmp_status->ncomps * 3; \
3476 charbuf[- cmp_status->length + 2] = cmp_status->nchars; \
3477 char_offset += cmp_status->nchars; \
3478 cmp_status->state = COMPOSING_NO; \
3479 } while (0)
3481 /* Store a composition rule RULE in charbuf, and update cmp_status. */
3483 #define STORE_COMPOSITION_RULE(rule) \
3484 do { \
3485 *charbuf++ = -2; \
3486 *charbuf++ = rule; \
3487 cmp_status->length += 2; \
3488 cmp_status->state--; \
3489 } while (0)
3491 /* Store a composed char or a component char C in charbuf, and update
3492 cmp_status. */
3494 #define STORE_COMPOSITION_CHAR(c) \
3495 do { \
3496 *charbuf++ = (c); \
3497 cmp_status->length++; \
3498 if (cmp_status->state == COMPOSING_CHAR) \
3499 cmp_status->nchars++; \
3500 else \
3501 cmp_status->ncomps++; \
3502 if (cmp_status->method == COMPOSITION_WITH_RULE \
3503 || (cmp_status->method == COMPOSITION_WITH_RULE_ALTCHARS \
3504 && cmp_status->state == COMPOSING_COMPONENT_CHAR)) \
3505 cmp_status->state++; \
3506 } while (0)
3509 /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
3511 static void
3512 decode_coding_iso_2022 (struct coding_system *coding)
3514 const unsigned char *src = coding->source + coding->consumed;
3515 const unsigned char *src_end = coding->source + coding->src_bytes;
3516 const unsigned char *src_base;
3517 int *charbuf = coding->charbuf + coding->charbuf_used;
3518 /* We may produce two annotations (charset and composition) in one
3519 loop and one more charset annotation at the end. */
3520 int *charbuf_end
3521 = coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 3);
3522 ptrdiff_t consumed_chars = 0, consumed_chars_base;
3523 bool multibytep = coding->src_multibyte;
3524 /* Charsets invoked to graphic plane 0 and 1 respectively. */
3525 int charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
3526 int charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1);
3527 int charset_id_2, charset_id_3;
3528 struct charset *charset;
3529 int c;
3530 struct composition_status *cmp_status = CODING_ISO_CMP_STATUS (coding);
3531 Lisp_Object attrs = CODING_ID_ATTRS (coding->id);
3532 ptrdiff_t char_offset = coding->produced_char;
3533 ptrdiff_t last_offset = char_offset;
3534 int last_id = charset_ascii;
3535 bool eol_dos
3536 = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
3537 int byte_after_cr = -1;
3538 int i;
3540 setup_iso_safe_charsets (attrs);
3541 coding->safe_charsets = SDATA (CODING_ATTR_SAFE_CHARSETS (attrs));
3543 if (cmp_status->state != COMPOSING_NO)
3545 if (charbuf_end - charbuf < cmp_status->length)
3546 emacs_abort ();
3547 for (i = 0; i < cmp_status->length; i++)
3548 *charbuf++ = cmp_status->carryover[i];
3549 coding->annotated = 1;
3552 while (1)
3554 int c1, c2, c3;
3556 src_base = src;
3557 consumed_chars_base = consumed_chars;
3559 if (charbuf >= charbuf_end)
3561 if (byte_after_cr >= 0)
3562 src_base--;
3563 break;
3566 if (byte_after_cr >= 0)
3567 c1 = byte_after_cr, byte_after_cr = -1;
3568 else
3569 ONE_MORE_BYTE (c1);
3570 if (c1 < 0)
3571 goto invalid_code;
3573 if (CODING_ISO_EXTSEGMENT_LEN (coding) > 0)
3575 *charbuf++ = ASCII_BYTE_P (c1) ? c1 : BYTE8_TO_CHAR (c1);
3576 char_offset++;
3577 CODING_ISO_EXTSEGMENT_LEN (coding)--;
3578 continue;
3581 if (CODING_ISO_EMBEDDED_UTF_8 (coding))
3583 if (c1 == ISO_CODE_ESC)
3585 if (src + 1 >= src_end)
3586 goto no_more_source;
3587 *charbuf++ = ISO_CODE_ESC;
3588 char_offset++;
3589 if (src[0] == '%' && src[1] == '@')
3591 src += 2;
3592 consumed_chars += 2;
3593 char_offset += 2;
3594 /* We are sure charbuf can contain two more chars. */
3595 *charbuf++ = '%';
3596 *charbuf++ = '@';
3597 CODING_ISO_EMBEDDED_UTF_8 (coding) = 0;
3600 else
3602 *charbuf++ = ASCII_BYTE_P (c1) ? c1 : BYTE8_TO_CHAR (c1);
3603 char_offset++;
3605 continue;
3608 if ((cmp_status->state == COMPOSING_RULE
3609 || cmp_status->state == COMPOSING_COMPONENT_RULE)
3610 && c1 != ISO_CODE_ESC)
3612 int rule;
3614 DECODE_COMPOSITION_RULE (rule);
3615 STORE_COMPOSITION_RULE (rule);
3616 continue;
3619 /* We produce at most one character. */
3620 switch (iso_code_class [c1])
3622 case ISO_0x20_or_0x7F:
3623 if (charset_id_0 < 0
3624 || ! CHARSET_ISO_CHARS_96 (CHARSET_FROM_ID (charset_id_0)))
3625 /* This is SPACE or DEL. */
3626 charset = CHARSET_FROM_ID (charset_ascii);
3627 else
3628 charset = CHARSET_FROM_ID (charset_id_0);
3629 break;
3631 case ISO_graphic_plane_0:
3632 if (charset_id_0 < 0)
3633 charset = CHARSET_FROM_ID (charset_ascii);
3634 else
3635 charset = CHARSET_FROM_ID (charset_id_0);
3636 break;
3638 case ISO_0xA0_or_0xFF:
3639 if (charset_id_1 < 0
3640 || ! CHARSET_ISO_CHARS_96 (CHARSET_FROM_ID (charset_id_1))
3641 || CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS)
3642 goto invalid_code;
3643 /* This is a graphic character, we fall down ... */
3645 case ISO_graphic_plane_1:
3646 if (charset_id_1 < 0)
3647 goto invalid_code;
3648 charset = CHARSET_FROM_ID (charset_id_1);
3649 break;
3651 case ISO_control_0:
3652 if (eol_dos && c1 == '\r')
3653 ONE_MORE_BYTE (byte_after_cr);
3654 MAYBE_FINISH_COMPOSITION ();
3655 charset = CHARSET_FROM_ID (charset_ascii);
3656 break;
3658 case ISO_control_1:
3659 goto invalid_code;
3661 case ISO_shift_out:
3662 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT)
3663 || CODING_ISO_DESIGNATION (coding, 1) < 0)
3664 goto invalid_code;
3665 CODING_ISO_INVOCATION (coding, 0) = 1;
3666 charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
3667 continue;
3669 case ISO_shift_in:
3670 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT))
3671 goto invalid_code;
3672 CODING_ISO_INVOCATION (coding, 0) = 0;
3673 charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
3674 continue;
3676 case ISO_single_shift_2_7:
3677 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS))
3678 goto invalid_code;
3679 case ISO_single_shift_2:
3680 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT))
3681 goto invalid_code;
3682 /* SS2 is handled as an escape sequence of ESC 'N' */
3683 c1 = 'N';
3684 goto label_escape_sequence;
3686 case ISO_single_shift_3:
3687 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT))
3688 goto invalid_code;
3689 /* SS2 is handled as an escape sequence of ESC 'O' */
3690 c1 = 'O';
3691 goto label_escape_sequence;
3693 case ISO_control_sequence_introducer:
3694 /* CSI is handled as an escape sequence of ESC '[' ... */
3695 c1 = '[';
3696 goto label_escape_sequence;
3698 case ISO_escape:
3699 ONE_MORE_BYTE (c1);
3700 label_escape_sequence:
3701 /* Escape sequences handled here are invocation,
3702 designation, direction specification, and character
3703 composition specification. */
3704 switch (c1)
3706 case '&': /* revision of following character set */
3707 ONE_MORE_BYTE (c1);
3708 if (!(c1 >= '@' && c1 <= '~'))
3709 goto invalid_code;
3710 ONE_MORE_BYTE (c1);
3711 if (c1 != ISO_CODE_ESC)
3712 goto invalid_code;
3713 ONE_MORE_BYTE (c1);
3714 goto label_escape_sequence;
3716 case '$': /* designation of 2-byte character set */
3717 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATION))
3718 goto invalid_code;
3720 int reg, chars96;
3722 ONE_MORE_BYTE (c1);
3723 if (c1 >= '@' && c1 <= 'B')
3724 { /* designation of JISX0208.1978, GB2312.1980,
3725 or JISX0208.1980 */
3726 reg = 0, chars96 = 0;
3728 else if (c1 >= 0x28 && c1 <= 0x2B)
3729 { /* designation of DIMENSION2_CHARS94 character set */
3730 reg = c1 - 0x28, chars96 = 0;
3731 ONE_MORE_BYTE (c1);
3733 else if (c1 >= 0x2C && c1 <= 0x2F)
3734 { /* designation of DIMENSION2_CHARS96 character set */
3735 reg = c1 - 0x2C, chars96 = 1;
3736 ONE_MORE_BYTE (c1);
3738 else
3739 goto invalid_code;
3740 DECODE_DESIGNATION (reg, 2, chars96, c1);
3741 /* We must update these variables now. */
3742 if (reg == 0)
3743 charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
3744 else if (reg == 1)
3745 charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1);
3746 if (chars96 < 0)
3747 goto invalid_code;
3749 continue;
3751 case 'n': /* invocation of locking-shift-2 */
3752 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT)
3753 || CODING_ISO_DESIGNATION (coding, 2) < 0)
3754 goto invalid_code;
3755 CODING_ISO_INVOCATION (coding, 0) = 2;
3756 charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
3757 continue;
3759 case 'o': /* invocation of locking-shift-3 */
3760 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LOCKING_SHIFT)
3761 || CODING_ISO_DESIGNATION (coding, 3) < 0)
3762 goto invalid_code;
3763 CODING_ISO_INVOCATION (coding, 0) = 3;
3764 charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
3765 continue;
3767 case 'N': /* invocation of single-shift-2 */
3768 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT)
3769 || CODING_ISO_DESIGNATION (coding, 2) < 0)
3770 goto invalid_code;
3771 charset_id_2 = CODING_ISO_DESIGNATION (coding, 2);
3772 if (charset_id_2 < 0)
3773 charset = CHARSET_FROM_ID (charset_ascii);
3774 else
3775 charset = CHARSET_FROM_ID (charset_id_2);
3776 ONE_MORE_BYTE (c1);
3777 if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0)
3778 || (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS)
3779 && ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LEVEL_4)
3780 ? c1 >= 0x80 : c1 < 0x80)))
3781 goto invalid_code;
3782 break;
3784 case 'O': /* invocation of single-shift-3 */
3785 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT)
3786 || CODING_ISO_DESIGNATION (coding, 3) < 0)
3787 goto invalid_code;
3788 charset_id_3 = CODING_ISO_DESIGNATION (coding, 3);
3789 if (charset_id_3 < 0)
3790 charset = CHARSET_FROM_ID (charset_ascii);
3791 else
3792 charset = CHARSET_FROM_ID (charset_id_3);
3793 ONE_MORE_BYTE (c1);
3794 if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0)
3795 || (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS)
3796 && ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LEVEL_4)
3797 ? c1 >= 0x80 : c1 < 0x80)))
3798 goto invalid_code;
3799 break;
3801 case '0': case '2': case '3': case '4': /* start composition */
3802 if (! (coding->common_flags & CODING_ANNOTATE_COMPOSITION_MASK))
3803 goto invalid_code;
3804 if (last_id != charset_ascii)
3806 ADD_CHARSET_DATA (charbuf, char_offset- last_offset, last_id);
3807 last_id = charset_ascii;
3808 last_offset = char_offset;
3810 DECODE_COMPOSITION_START (c1);
3811 continue;
3813 case '1': /* end composition */
3814 if (cmp_status->state == COMPOSING_NO)
3815 goto invalid_code;
3816 DECODE_COMPOSITION_END ();
3817 continue;
3819 case '[': /* specification of direction */
3820 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DIRECTION))
3821 goto invalid_code;
3822 /* For the moment, nested direction is not supported.
3823 So, `coding->mode & CODING_MODE_DIRECTION' zero means
3824 left-to-right, and nonzero means right-to-left. */
3825 ONE_MORE_BYTE (c1);
3826 switch (c1)
3828 case ']': /* end of the current direction */
3829 coding->mode &= ~CODING_MODE_DIRECTION;
3831 case '0': /* end of the current direction */
3832 case '1': /* start of left-to-right direction */
3833 ONE_MORE_BYTE (c1);
3834 if (c1 == ']')
3835 coding->mode &= ~CODING_MODE_DIRECTION;
3836 else
3837 goto invalid_code;
3838 break;
3840 case '2': /* start of right-to-left direction */
3841 ONE_MORE_BYTE (c1);
3842 if (c1 == ']')
3843 coding->mode |= CODING_MODE_DIRECTION;
3844 else
3845 goto invalid_code;
3846 break;
3848 default:
3849 goto invalid_code;
3851 continue;
3853 case '%':
3854 ONE_MORE_BYTE (c1);
3855 if (c1 == '/')
3857 /* CTEXT extended segment:
3858 ESC % / [0-4] M L --ENCODING-NAME-- \002 --BYTES--
3859 We keep these bytes as is for the moment.
3860 They may be decoded by post-read-conversion. */
3861 int dim, M, L;
3862 int size;
3864 ONE_MORE_BYTE (dim);
3865 if (dim < '0' || dim > '4')
3866 goto invalid_code;
3867 ONE_MORE_BYTE (M);
3868 if (M < 128)
3869 goto invalid_code;
3870 ONE_MORE_BYTE (L);
3871 if (L < 128)
3872 goto invalid_code;
3873 size = ((M - 128) * 128) + (L - 128);
3874 if (charbuf + 6 > charbuf_end)
3875 goto break_loop;
3876 *charbuf++ = ISO_CODE_ESC;
3877 *charbuf++ = '%';
3878 *charbuf++ = '/';
3879 *charbuf++ = dim;
3880 *charbuf++ = BYTE8_TO_CHAR (M);
3881 *charbuf++ = BYTE8_TO_CHAR (L);
3882 CODING_ISO_EXTSEGMENT_LEN (coding) = size;
3884 else if (c1 == 'G')
3886 /* XFree86 extension for embedding UTF-8 in CTEXT:
3887 ESC % G --UTF-8-BYTES-- ESC % @
3888 We keep these bytes as is for the moment.
3889 They may be decoded by post-read-conversion. */
3890 if (charbuf + 3 > charbuf_end)
3891 goto break_loop;
3892 *charbuf++ = ISO_CODE_ESC;
3893 *charbuf++ = '%';
3894 *charbuf++ = 'G';
3895 CODING_ISO_EMBEDDED_UTF_8 (coding) = 1;
3897 else
3898 goto invalid_code;
3899 continue;
3900 break;
3902 default:
3903 if (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATION))
3904 goto invalid_code;
3906 int reg, chars96;
3908 if (c1 >= 0x28 && c1 <= 0x2B)
3909 { /* designation of DIMENSION1_CHARS94 character set */
3910 reg = c1 - 0x28, chars96 = 0;
3911 ONE_MORE_BYTE (c1);
3913 else if (c1 >= 0x2C && c1 <= 0x2F)
3914 { /* designation of DIMENSION1_CHARS96 character set */
3915 reg = c1 - 0x2C, chars96 = 1;
3916 ONE_MORE_BYTE (c1);
3918 else
3919 goto invalid_code;
3920 DECODE_DESIGNATION (reg, 1, chars96, c1);
3921 /* We must update these variables now. */
3922 if (reg == 0)
3923 charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
3924 else if (reg == 1)
3925 charset_id_1 = CODING_ISO_INVOKED_CHARSET (coding, 1);
3926 if (chars96 < 0)
3927 goto invalid_code;
3929 continue;
3931 break;
3933 default:
3934 emacs_abort ();
3937 if (cmp_status->state == COMPOSING_NO
3938 && charset->id != charset_ascii
3939 && last_id != charset->id)
3941 if (last_id != charset_ascii)
3942 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
3943 last_id = charset->id;
3944 last_offset = char_offset;
3947 /* Now we know CHARSET and 1st position code C1 of a character.
3948 Produce a decoded character while getting 2nd and 3rd
3949 position codes C2, C3 if necessary. */
3950 if (CHARSET_DIMENSION (charset) > 1)
3952 ONE_MORE_BYTE (c2);
3953 if (c2 < 0x20 || (c2 >= 0x80 && c2 < 0xA0)
3954 || ((c1 & 0x80) != (c2 & 0x80)))
3955 /* C2 is not in a valid range. */
3956 goto invalid_code;
3957 if (CHARSET_DIMENSION (charset) == 2)
3958 c1 = (c1 << 8) | c2;
3959 else
3961 ONE_MORE_BYTE (c3);
3962 if (c3 < 0x20 || (c3 >= 0x80 && c3 < 0xA0)
3963 || ((c1 & 0x80) != (c3 & 0x80)))
3964 /* C3 is not in a valid range. */
3965 goto invalid_code;
3966 c1 = (c1 << 16) | (c2 << 8) | c2;
3969 c1 &= 0x7F7F7F;
3970 CODING_DECODE_CHAR (coding, src, src_base, src_end, charset, c1, c);
3971 if (c < 0)
3973 MAYBE_FINISH_COMPOSITION ();
3974 for (; src_base < src; src_base++, char_offset++)
3976 if (ASCII_BYTE_P (*src_base))
3977 *charbuf++ = *src_base;
3978 else
3979 *charbuf++ = BYTE8_TO_CHAR (*src_base);
3982 else if (cmp_status->state == COMPOSING_NO)
3984 *charbuf++ = c;
3985 char_offset++;
3987 else if ((cmp_status->state == COMPOSING_CHAR
3988 ? cmp_status->nchars
3989 : cmp_status->ncomps)
3990 >= MAX_COMPOSITION_COMPONENTS)
3992 /* Too long composition. */
3993 MAYBE_FINISH_COMPOSITION ();
3994 *charbuf++ = c;
3995 char_offset++;
3997 else
3998 STORE_COMPOSITION_CHAR (c);
3999 continue;
4001 invalid_code:
4002 MAYBE_FINISH_COMPOSITION ();
4003 src = src_base;
4004 consumed_chars = consumed_chars_base;
4005 ONE_MORE_BYTE (c);
4006 *charbuf++ = c < 0 ? -c : ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c);
4007 char_offset++;
4008 coding->errors++;
4009 /* Reset the invocation and designation status to the safest
4010 one; i.e. designate ASCII to the graphic register 0, and
4011 invoke that register to the graphic plane 0. This typically
4012 helps the case that an designation sequence for ASCII "ESC (
4013 B" is somehow broken (e.g. broken by a newline). */
4014 CODING_ISO_INVOCATION (coding, 0) = 0;
4015 CODING_ISO_DESIGNATION (coding, 0) = charset_ascii;
4016 charset_id_0 = charset_ascii;
4017 continue;
4019 break_loop:
4020 break;
4023 no_more_source:
4024 if (cmp_status->state != COMPOSING_NO)
4026 if (coding->mode & CODING_MODE_LAST_BLOCK)
4027 MAYBE_FINISH_COMPOSITION ();
4028 else
4030 charbuf -= cmp_status->length;
4031 for (i = 0; i < cmp_status->length; i++)
4032 cmp_status->carryover[i] = charbuf[i];
4035 else if (last_id != charset_ascii)
4036 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
4037 coding->consumed_char += consumed_chars_base;
4038 coding->consumed = src_base - coding->source;
4039 coding->charbuf_used = charbuf - coding->charbuf;
4043 /* ISO2022 encoding stuff. */
4046 It is not enough to say just "ISO2022" on encoding, we have to
4047 specify more details. In Emacs, each coding system of ISO2022
4048 variant has the following specifications:
4049 1. Initial designation to G0 thru G3.
4050 2. Allows short-form designation?
4051 3. ASCII should be designated to G0 before control characters?
4052 4. ASCII should be designated to G0 at end of line?
4053 5. 7-bit environment or 8-bit environment?
4054 6. Use locking-shift?
4055 7. Use Single-shift?
4056 And the following two are only for Japanese:
4057 8. Use ASCII in place of JIS0201-1976-Roman?
4058 9. Use JISX0208-1983 in place of JISX0208-1978?
4059 These specifications are encoded in CODING_ISO_FLAGS (coding) as flag bits
4060 defined by macros CODING_ISO_FLAG_XXX. See `coding.h' for more
4061 details.
4064 /* Produce codes (escape sequence) for designating CHARSET to graphic
4065 register REG at DST, and increment DST. If <final-char> of CHARSET is
4066 '@', 'A', or 'B' and the coding system CODING allows, produce
4067 designation sequence of short-form. */
4069 #define ENCODE_DESIGNATION(charset, reg, coding) \
4070 do { \
4071 unsigned char final_char = CHARSET_ISO_FINAL (charset); \
4072 const char *intermediate_char_94 = "()*+"; \
4073 const char *intermediate_char_96 = ",-./"; \
4074 int revision = -1; \
4076 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_REVISION) \
4077 revision = CHARSET_ISO_REVISION (charset); \
4079 if (revision >= 0) \
4081 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, '&'); \
4082 EMIT_ONE_BYTE ('@' + revision); \
4084 EMIT_ONE_ASCII_BYTE (ISO_CODE_ESC); \
4085 if (CHARSET_DIMENSION (charset) == 1) \
4087 int b; \
4088 if (! CHARSET_ISO_CHARS_96 (charset)) \
4089 b = intermediate_char_94[reg]; \
4090 else \
4091 b = intermediate_char_96[reg]; \
4092 EMIT_ONE_ASCII_BYTE (b); \
4094 else \
4096 EMIT_ONE_ASCII_BYTE ('$'); \
4097 if (! CHARSET_ISO_CHARS_96 (charset)) \
4099 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LONG_FORM \
4100 || reg != 0 \
4101 || final_char < '@' || final_char > 'B') \
4102 EMIT_ONE_ASCII_BYTE (intermediate_char_94[reg]); \
4104 else \
4105 EMIT_ONE_ASCII_BYTE (intermediate_char_96[reg]); \
4107 EMIT_ONE_ASCII_BYTE (final_char); \
4109 CODING_ISO_DESIGNATION (coding, reg) = CHARSET_ID (charset); \
4110 } while (0)
4113 /* The following two macros produce codes (control character or escape
4114 sequence) for ISO2022 single-shift functions (single-shift-2 and
4115 single-shift-3). */
4117 #define ENCODE_SINGLE_SHIFT_2 \
4118 do { \
4119 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
4120 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'N'); \
4121 else \
4122 EMIT_ONE_BYTE (ISO_CODE_SS2); \
4123 CODING_ISO_SINGLE_SHIFTING (coding) = 1; \
4124 } while (0)
4127 #define ENCODE_SINGLE_SHIFT_3 \
4128 do { \
4129 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
4130 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'O'); \
4131 else \
4132 EMIT_ONE_BYTE (ISO_CODE_SS3); \
4133 CODING_ISO_SINGLE_SHIFTING (coding) = 1; \
4134 } while (0)
4137 /* The following four macros produce codes (control character or
4138 escape sequence) for ISO2022 locking-shift functions (shift-in,
4139 shift-out, locking-shift-2, and locking-shift-3). */
4141 #define ENCODE_SHIFT_IN \
4142 do { \
4143 EMIT_ONE_ASCII_BYTE (ISO_CODE_SI); \
4144 CODING_ISO_INVOCATION (coding, 0) = 0; \
4145 } while (0)
4148 #define ENCODE_SHIFT_OUT \
4149 do { \
4150 EMIT_ONE_ASCII_BYTE (ISO_CODE_SO); \
4151 CODING_ISO_INVOCATION (coding, 0) = 1; \
4152 } while (0)
4155 #define ENCODE_LOCKING_SHIFT_2 \
4156 do { \
4157 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'n'); \
4158 CODING_ISO_INVOCATION (coding, 0) = 2; \
4159 } while (0)
4162 #define ENCODE_LOCKING_SHIFT_3 \
4163 do { \
4164 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'n'); \
4165 CODING_ISO_INVOCATION (coding, 0) = 3; \
4166 } while (0)
4169 /* Produce codes for a DIMENSION1 character whose character set is
4170 CHARSET and whose position-code is C1. Designation and invocation
4171 sequences are also produced in advance if necessary. */
4173 #define ENCODE_ISO_CHARACTER_DIMENSION1(charset, c1) \
4174 do { \
4175 int id = CHARSET_ID (charset); \
4177 if ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_ROMAN) \
4178 && id == charset_ascii) \
4180 id = charset_jisx0201_roman; \
4181 charset = CHARSET_FROM_ID (id); \
4184 if (CODING_ISO_SINGLE_SHIFTING (coding)) \
4186 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
4187 EMIT_ONE_ASCII_BYTE (c1 & 0x7F); \
4188 else \
4189 EMIT_ONE_BYTE (c1 | 0x80); \
4190 CODING_ISO_SINGLE_SHIFTING (coding) = 0; \
4191 break; \
4193 else if (id == CODING_ISO_INVOKED_CHARSET (coding, 0)) \
4195 EMIT_ONE_ASCII_BYTE (c1 & 0x7F); \
4196 break; \
4198 else if (id == CODING_ISO_INVOKED_CHARSET (coding, 1)) \
4200 EMIT_ONE_BYTE (c1 | 0x80); \
4201 break; \
4203 else \
4204 /* Since CHARSET is not yet invoked to any graphic planes, we \
4205 must invoke it, or, at first, designate it to some graphic \
4206 register. Then repeat the loop to actually produce the \
4207 character. */ \
4208 dst = encode_invocation_designation (charset, coding, dst, \
4209 &produced_chars); \
4210 } while (1)
4213 /* Produce codes for a DIMENSION2 character whose character set is
4214 CHARSET and whose position-codes are C1 and C2. Designation and
4215 invocation codes are also produced in advance if necessary. */
4217 #define ENCODE_ISO_CHARACTER_DIMENSION2(charset, c1, c2) \
4218 do { \
4219 int id = CHARSET_ID (charset); \
4221 if ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_OLDJIS) \
4222 && id == charset_jisx0208) \
4224 id = charset_jisx0208_1978; \
4225 charset = CHARSET_FROM_ID (id); \
4228 if (CODING_ISO_SINGLE_SHIFTING (coding)) \
4230 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
4231 EMIT_TWO_ASCII_BYTES ((c1) & 0x7F, (c2) & 0x7F); \
4232 else \
4233 EMIT_TWO_BYTES ((c1) | 0x80, (c2) | 0x80); \
4234 CODING_ISO_SINGLE_SHIFTING (coding) = 0; \
4235 break; \
4237 else if (id == CODING_ISO_INVOKED_CHARSET (coding, 0)) \
4239 EMIT_TWO_ASCII_BYTES ((c1) & 0x7F, (c2) & 0x7F); \
4240 break; \
4242 else if (id == CODING_ISO_INVOKED_CHARSET (coding, 1)) \
4244 EMIT_TWO_BYTES ((c1) | 0x80, (c2) | 0x80); \
4245 break; \
4247 else \
4248 /* Since CHARSET is not yet invoked to any graphic planes, we \
4249 must invoke it, or, at first, designate it to some graphic \
4250 register. Then repeat the loop to actually produce the \
4251 character. */ \
4252 dst = encode_invocation_designation (charset, coding, dst, \
4253 &produced_chars); \
4254 } while (1)
4257 #define ENCODE_ISO_CHARACTER(charset, c) \
4258 do { \
4259 unsigned code; \
4260 CODING_ENCODE_CHAR (coding, dst, dst_end, (charset), (c), code); \
4262 if (CHARSET_DIMENSION (charset) == 1) \
4263 ENCODE_ISO_CHARACTER_DIMENSION1 ((charset), code); \
4264 else \
4265 ENCODE_ISO_CHARACTER_DIMENSION2 ((charset), code >> 8, code & 0xFF); \
4266 } while (0)
4269 /* Produce designation and invocation codes at a place pointed by DST
4270 to use CHARSET. The element `spec.iso_2022' of *CODING is updated.
4271 Return new DST. */
4273 static unsigned char *
4274 encode_invocation_designation (struct charset *charset,
4275 struct coding_system *coding,
4276 unsigned char *dst, ptrdiff_t *p_nchars)
4278 bool multibytep = coding->dst_multibyte;
4279 ptrdiff_t produced_chars = *p_nchars;
4280 int reg; /* graphic register number */
4281 int id = CHARSET_ID (charset);
4283 /* At first, check designations. */
4284 for (reg = 0; reg < 4; reg++)
4285 if (id == CODING_ISO_DESIGNATION (coding, reg))
4286 break;
4288 if (reg >= 4)
4290 /* CHARSET is not yet designated to any graphic registers. */
4291 /* At first check the requested designation. */
4292 reg = CODING_ISO_REQUEST (coding, id);
4293 if (reg < 0)
4294 /* Since CHARSET requests no special designation, designate it
4295 to graphic register 0. */
4296 reg = 0;
4298 ENCODE_DESIGNATION (charset, reg, coding);
4301 if (CODING_ISO_INVOCATION (coding, 0) != reg
4302 && CODING_ISO_INVOCATION (coding, 1) != reg)
4304 /* Since the graphic register REG is not invoked to any graphic
4305 planes, invoke it to graphic plane 0. */
4306 switch (reg)
4308 case 0: /* graphic register 0 */
4309 ENCODE_SHIFT_IN;
4310 break;
4312 case 1: /* graphic register 1 */
4313 ENCODE_SHIFT_OUT;
4314 break;
4316 case 2: /* graphic register 2 */
4317 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT)
4318 ENCODE_SINGLE_SHIFT_2;
4319 else
4320 ENCODE_LOCKING_SHIFT_2;
4321 break;
4323 case 3: /* graphic register 3 */
4324 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SINGLE_SHIFT)
4325 ENCODE_SINGLE_SHIFT_3;
4326 else
4327 ENCODE_LOCKING_SHIFT_3;
4328 break;
4332 *p_nchars = produced_chars;
4333 return dst;
4337 /* Produce codes for designation and invocation to reset the graphic
4338 planes and registers to initial state. */
4339 #define ENCODE_RESET_PLANE_AND_REGISTER() \
4340 do { \
4341 int reg; \
4342 struct charset *charset; \
4344 if (CODING_ISO_INVOCATION (coding, 0) != 0) \
4345 ENCODE_SHIFT_IN; \
4346 for (reg = 0; reg < 4; reg++) \
4347 if (CODING_ISO_INITIAL (coding, reg) >= 0 \
4348 && (CODING_ISO_DESIGNATION (coding, reg) \
4349 != CODING_ISO_INITIAL (coding, reg))) \
4351 charset = CHARSET_FROM_ID (CODING_ISO_INITIAL (coding, reg)); \
4352 ENCODE_DESIGNATION (charset, reg, coding); \
4354 } while (0)
4357 /* Produce designation sequences of charsets in the line started from
4358 CHARBUF to a place pointed by DST, and return the number of
4359 produced bytes. DST should not directly point a buffer text area
4360 which may be relocated by char_charset call.
4362 If the current block ends before any end-of-line, we may fail to
4363 find all the necessary designations. */
4365 static ptrdiff_t
4366 encode_designation_at_bol (struct coding_system *coding,
4367 int *charbuf, int *charbuf_end,
4368 unsigned char *dst)
4370 unsigned char *orig = dst;
4371 struct charset *charset;
4372 /* Table of charsets to be designated to each graphic register. */
4373 int r[4];
4374 int c, found = 0, reg;
4375 ptrdiff_t produced_chars = 0;
4376 bool multibytep = coding->dst_multibyte;
4377 Lisp_Object attrs;
4378 Lisp_Object charset_list;
4380 attrs = CODING_ID_ATTRS (coding->id);
4381 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
4382 if (EQ (charset_list, Qiso_2022))
4383 charset_list = Viso_2022_charset_list;
4385 for (reg = 0; reg < 4; reg++)
4386 r[reg] = -1;
4388 while (charbuf < charbuf_end && found < 4)
4390 int id;
4392 c = *charbuf++;
4393 if (c == '\n')
4394 break;
4395 charset = char_charset (c, charset_list, NULL);
4396 id = CHARSET_ID (charset);
4397 reg = CODING_ISO_REQUEST (coding, id);
4398 if (reg >= 0 && r[reg] < 0)
4400 found++;
4401 r[reg] = id;
4405 if (found)
4407 for (reg = 0; reg < 4; reg++)
4408 if (r[reg] >= 0
4409 && CODING_ISO_DESIGNATION (coding, reg) != r[reg])
4410 ENCODE_DESIGNATION (CHARSET_FROM_ID (r[reg]), reg, coding);
4413 return dst - orig;
4416 /* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions". */
4418 static bool
4419 encode_coding_iso_2022 (struct coding_system *coding)
4421 bool multibytep = coding->dst_multibyte;
4422 int *charbuf = coding->charbuf;
4423 int *charbuf_end = charbuf + coding->charbuf_used;
4424 unsigned char *dst = coding->destination + coding->produced;
4425 unsigned char *dst_end = coding->destination + coding->dst_bytes;
4426 int safe_room = 16;
4427 bool bol_designation
4428 = (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATE_AT_BOL
4429 && CODING_ISO_BOL (coding));
4430 ptrdiff_t produced_chars = 0;
4431 Lisp_Object attrs, eol_type, charset_list;
4432 bool ascii_compatible;
4433 int c;
4434 int preferred_charset_id = -1;
4436 CODING_GET_INFO (coding, attrs, charset_list);
4437 eol_type = inhibit_eol_conversion ? Qunix : CODING_ID_EOL_TYPE (coding->id);
4438 if (VECTORP (eol_type))
4439 eol_type = Qunix;
4441 setup_iso_safe_charsets (attrs);
4442 /* Charset list may have been changed. */
4443 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
4444 coding->safe_charsets = SDATA (CODING_ATTR_SAFE_CHARSETS (attrs));
4446 ascii_compatible
4447 = (! NILP (CODING_ATTR_ASCII_COMPAT (attrs))
4448 && ! (CODING_ISO_FLAGS (coding) & (CODING_ISO_FLAG_DESIGNATION
4449 | CODING_ISO_FLAG_LOCKING_SHIFT)));
4451 while (charbuf < charbuf_end)
4453 ASSURE_DESTINATION (safe_room);
4455 if (bol_designation)
4457 /* We have to produce designation sequences if any now. */
4458 unsigned char desig_buf[16];
4459 int nbytes;
4460 ptrdiff_t offset;
4462 charset_map_loaded = 0;
4463 nbytes = encode_designation_at_bol (coding, charbuf, charbuf_end,
4464 desig_buf);
4465 if (charset_map_loaded
4466 && (offset = coding_change_destination (coding)))
4468 dst += offset;
4469 dst_end += offset;
4471 memcpy (dst, desig_buf, nbytes);
4472 dst += nbytes;
4473 /* We are sure that designation sequences are all ASCII bytes. */
4474 produced_chars += nbytes;
4475 bol_designation = 0;
4476 ASSURE_DESTINATION (safe_room);
4479 c = *charbuf++;
4481 if (c < 0)
4483 /* Handle an annotation. */
4484 switch (*charbuf)
4486 case CODING_ANNOTATE_COMPOSITION_MASK:
4487 /* Not yet implemented. */
4488 break;
4489 case CODING_ANNOTATE_CHARSET_MASK:
4490 preferred_charset_id = charbuf[2];
4491 if (preferred_charset_id >= 0
4492 && NILP (Fmemq (make_number (preferred_charset_id),
4493 charset_list)))
4494 preferred_charset_id = -1;
4495 break;
4496 default:
4497 emacs_abort ();
4499 charbuf += -c - 1;
4500 continue;
4503 /* Now encode the character C. */
4504 if (c < 0x20 || c == 0x7F)
4506 if (c == '\n'
4507 || (c == '\r' && EQ (eol_type, Qmac)))
4509 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_RESET_AT_EOL)
4510 ENCODE_RESET_PLANE_AND_REGISTER ();
4511 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_INIT_AT_BOL)
4513 int i;
4515 for (i = 0; i < 4; i++)
4516 CODING_ISO_DESIGNATION (coding, i)
4517 = CODING_ISO_INITIAL (coding, i);
4519 bol_designation = ((CODING_ISO_FLAGS (coding)
4520 & CODING_ISO_FLAG_DESIGNATE_AT_BOL)
4521 != 0);
4523 else if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_RESET_AT_CNTL)
4524 ENCODE_RESET_PLANE_AND_REGISTER ();
4525 EMIT_ONE_ASCII_BYTE (c);
4527 else if (ASCII_CHAR_P (c))
4529 if (ascii_compatible)
4530 EMIT_ONE_ASCII_BYTE (c);
4531 else
4533 struct charset *charset = CHARSET_FROM_ID (charset_ascii);
4534 ENCODE_ISO_CHARACTER (charset, c);
4537 else if (CHAR_BYTE8_P (c))
4539 c = CHAR_TO_BYTE8 (c);
4540 EMIT_ONE_BYTE (c);
4542 else
4544 struct charset *charset;
4546 if (preferred_charset_id >= 0)
4548 bool result;
4550 charset = CHARSET_FROM_ID (preferred_charset_id);
4551 CODING_CHAR_CHARSET_P (coding, dst, dst_end, c, charset, result);
4552 if (! result)
4553 CODING_CHAR_CHARSET (coding, dst, dst_end, c, charset_list,
4554 NULL, charset);
4556 else
4557 CODING_CHAR_CHARSET (coding, dst, dst_end, c, charset_list,
4558 NULL, charset);
4559 if (!charset)
4561 if (coding->mode & CODING_MODE_SAFE_ENCODING)
4563 c = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
4564 charset = CHARSET_FROM_ID (charset_ascii);
4566 else
4568 c = coding->default_char;
4569 CODING_CHAR_CHARSET (coding, dst, dst_end, c,
4570 charset_list, NULL, charset);
4573 ENCODE_ISO_CHARACTER (charset, c);
4577 if (coding->mode & CODING_MODE_LAST_BLOCK
4578 && CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_RESET_AT_EOL)
4580 ASSURE_DESTINATION (safe_room);
4581 ENCODE_RESET_PLANE_AND_REGISTER ();
4583 record_conversion_result (coding, CODING_RESULT_SUCCESS);
4584 CODING_ISO_BOL (coding) = bol_designation;
4585 coding->produced_char += produced_chars;
4586 coding->produced = dst - coding->destination;
4587 return 0;
4591 /*** 8,9. SJIS and BIG5 handlers ***/
4593 /* Although SJIS and BIG5 are not ISO's coding system, they are used
4594 quite widely. So, for the moment, Emacs supports them in the bare
4595 C code. But, in the future, they may be supported only by CCL. */
4597 /* SJIS is a coding system encoding three character sets: ASCII, right
4598 half of JISX0201-Kana, and JISX0208. An ASCII character is encoded
4599 as is. A character of charset katakana-jisx0201 is encoded by
4600 "position-code + 0x80". A character of charset japanese-jisx0208
4601 is encoded in 2-byte but two position-codes are divided and shifted
4602 so that it fit in the range below.
4604 --- CODE RANGE of SJIS ---
4605 (character set) (range)
4606 ASCII 0x00 .. 0x7F
4607 KATAKANA-JISX0201 0xA0 .. 0xDF
4608 JISX0208 (1st byte) 0x81 .. 0x9F and 0xE0 .. 0xEF
4609 (2nd byte) 0x40 .. 0x7E and 0x80 .. 0xFC
4610 -------------------------------
4614 /* BIG5 is a coding system encoding two character sets: ASCII and
4615 Big5. An ASCII character is encoded as is. Big5 is a two-byte
4616 character set and is encoded in two-byte.
4618 --- CODE RANGE of BIG5 ---
4619 (character set) (range)
4620 ASCII 0x00 .. 0x7F
4621 Big5 (1st byte) 0xA1 .. 0xFE
4622 (2nd byte) 0x40 .. 0x7E and 0xA1 .. 0xFE
4623 --------------------------
4627 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
4628 Return true if a text is encoded in SJIS. */
4630 static bool
4631 detect_coding_sjis (struct coding_system *coding,
4632 struct coding_detection_info *detect_info)
4634 const unsigned char *src = coding->source, *src_base;
4635 const unsigned char *src_end = coding->source + coding->src_bytes;
4636 bool multibytep = coding->src_multibyte;
4637 ptrdiff_t consumed_chars = 0;
4638 int found = 0;
4639 int c;
4640 Lisp_Object attrs, charset_list;
4641 int max_first_byte_of_2_byte_code;
4643 CODING_GET_INFO (coding, attrs, charset_list);
4644 max_first_byte_of_2_byte_code
4645 = (XINT (Flength (charset_list)) > 3 ? 0xFC : 0xEF);
4647 detect_info->checked |= CATEGORY_MASK_SJIS;
4648 /* A coding system of this category is always ASCII compatible. */
4649 src += coding->head_ascii;
4651 while (1)
4653 src_base = src;
4654 ONE_MORE_BYTE (c);
4655 if (c < 0x80)
4656 continue;
4657 if ((c >= 0x81 && c <= 0x9F)
4658 || (c >= 0xE0 && c <= max_first_byte_of_2_byte_code))
4660 ONE_MORE_BYTE (c);
4661 if (c < 0x40 || c == 0x7F || c > 0xFC)
4662 break;
4663 found = CATEGORY_MASK_SJIS;
4665 else if (c >= 0xA0 && c < 0xE0)
4666 found = CATEGORY_MASK_SJIS;
4667 else
4668 break;
4670 detect_info->rejected |= CATEGORY_MASK_SJIS;
4671 return 0;
4673 no_more_source:
4674 if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK)
4676 detect_info->rejected |= CATEGORY_MASK_SJIS;
4677 return 0;
4679 detect_info->found |= found;
4680 return 1;
4683 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
4684 Return true if a text is encoded in BIG5. */
4686 static bool
4687 detect_coding_big5 (struct coding_system *coding,
4688 struct coding_detection_info *detect_info)
4690 const unsigned char *src = coding->source, *src_base;
4691 const unsigned char *src_end = coding->source + coding->src_bytes;
4692 bool multibytep = coding->src_multibyte;
4693 ptrdiff_t consumed_chars = 0;
4694 int found = 0;
4695 int c;
4697 detect_info->checked |= CATEGORY_MASK_BIG5;
4698 /* A coding system of this category is always ASCII compatible. */
4699 src += coding->head_ascii;
4701 while (1)
4703 src_base = src;
4704 ONE_MORE_BYTE (c);
4705 if (c < 0x80)
4706 continue;
4707 if (c >= 0xA1)
4709 ONE_MORE_BYTE (c);
4710 if (c < 0x40 || (c >= 0x7F && c <= 0xA0))
4711 return 0;
4712 found = CATEGORY_MASK_BIG5;
4714 else
4715 break;
4717 detect_info->rejected |= CATEGORY_MASK_BIG5;
4718 return 0;
4720 no_more_source:
4721 if (src_base < src && coding->mode & CODING_MODE_LAST_BLOCK)
4723 detect_info->rejected |= CATEGORY_MASK_BIG5;
4724 return 0;
4726 detect_info->found |= found;
4727 return 1;
4730 /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
4732 static void
4733 decode_coding_sjis (struct coding_system *coding)
4735 const unsigned char *src = coding->source + coding->consumed;
4736 const unsigned char *src_end = coding->source + coding->src_bytes;
4737 const unsigned char *src_base;
4738 int *charbuf = coding->charbuf + coding->charbuf_used;
4739 /* We may produce one charset annotation in one loop and one more at
4740 the end. */
4741 int *charbuf_end
4742 = coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 2);
4743 ptrdiff_t consumed_chars = 0, consumed_chars_base;
4744 bool multibytep = coding->src_multibyte;
4745 struct charset *charset_roman, *charset_kanji, *charset_kana;
4746 struct charset *charset_kanji2;
4747 Lisp_Object attrs, charset_list, val;
4748 ptrdiff_t char_offset = coding->produced_char;
4749 ptrdiff_t last_offset = char_offset;
4750 int last_id = charset_ascii;
4751 bool eol_dos
4752 = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
4753 int byte_after_cr = -1;
4755 CODING_GET_INFO (coding, attrs, charset_list);
4757 val = charset_list;
4758 charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
4759 charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
4760 charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
4761 charset_kanji2 = NILP (val) ? NULL : CHARSET_FROM_ID (XINT (XCAR (val)));
4763 while (1)
4765 int c, c1;
4766 struct charset *charset;
4768 src_base = src;
4769 consumed_chars_base = consumed_chars;
4771 if (charbuf >= charbuf_end)
4773 if (byte_after_cr >= 0)
4774 src_base--;
4775 break;
4778 if (byte_after_cr >= 0)
4779 c = byte_after_cr, byte_after_cr = -1;
4780 else
4781 ONE_MORE_BYTE (c);
4782 if (c < 0)
4783 goto invalid_code;
4784 if (c < 0x80)
4786 if (eol_dos && c == '\r')
4787 ONE_MORE_BYTE (byte_after_cr);
4788 charset = charset_roman;
4790 else if (c == 0x80 || c == 0xA0)
4791 goto invalid_code;
4792 else if (c >= 0xA1 && c <= 0xDF)
4794 /* SJIS -> JISX0201-Kana */
4795 c &= 0x7F;
4796 charset = charset_kana;
4798 else if (c <= 0xEF)
4800 /* SJIS -> JISX0208 */
4801 ONE_MORE_BYTE (c1);
4802 if (c1 < 0x40 || c1 == 0x7F || c1 > 0xFC)
4803 goto invalid_code;
4804 c = (c << 8) | c1;
4805 SJIS_TO_JIS (c);
4806 charset = charset_kanji;
4808 else if (c <= 0xFC && charset_kanji2)
4810 /* SJIS -> JISX0213-2 */
4811 ONE_MORE_BYTE (c1);
4812 if (c1 < 0x40 || c1 == 0x7F || c1 > 0xFC)
4813 goto invalid_code;
4814 c = (c << 8) | c1;
4815 SJIS_TO_JIS2 (c);
4816 charset = charset_kanji2;
4818 else
4819 goto invalid_code;
4820 if (charset->id != charset_ascii
4821 && last_id != charset->id)
4823 if (last_id != charset_ascii)
4824 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
4825 last_id = charset->id;
4826 last_offset = char_offset;
4828 CODING_DECODE_CHAR (coding, src, src_base, src_end, charset, c, c);
4829 *charbuf++ = c;
4830 char_offset++;
4831 continue;
4833 invalid_code:
4834 src = src_base;
4835 consumed_chars = consumed_chars_base;
4836 ONE_MORE_BYTE (c);
4837 *charbuf++ = c < 0 ? -c : BYTE8_TO_CHAR (c);
4838 char_offset++;
4839 coding->errors++;
4842 no_more_source:
4843 if (last_id != charset_ascii)
4844 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
4845 coding->consumed_char += consumed_chars_base;
4846 coding->consumed = src_base - coding->source;
4847 coding->charbuf_used = charbuf - coding->charbuf;
4850 static void
4851 decode_coding_big5 (struct coding_system *coding)
4853 const unsigned char *src = coding->source + coding->consumed;
4854 const unsigned char *src_end = coding->source + coding->src_bytes;
4855 const unsigned char *src_base;
4856 int *charbuf = coding->charbuf + coding->charbuf_used;
4857 /* We may produce one charset annotation in one loop and one more at
4858 the end. */
4859 int *charbuf_end
4860 = coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 2);
4861 ptrdiff_t consumed_chars = 0, consumed_chars_base;
4862 bool multibytep = coding->src_multibyte;
4863 struct charset *charset_roman, *charset_big5;
4864 Lisp_Object attrs, charset_list, val;
4865 ptrdiff_t char_offset = coding->produced_char;
4866 ptrdiff_t last_offset = char_offset;
4867 int last_id = charset_ascii;
4868 bool eol_dos
4869 = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
4870 int byte_after_cr = -1;
4872 CODING_GET_INFO (coding, attrs, charset_list);
4873 val = charset_list;
4874 charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
4875 charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val)));
4877 while (1)
4879 int c, c1;
4880 struct charset *charset;
4882 src_base = src;
4883 consumed_chars_base = consumed_chars;
4885 if (charbuf >= charbuf_end)
4887 if (byte_after_cr >= 0)
4888 src_base--;
4889 break;
4892 if (byte_after_cr >= 0)
4893 c = byte_after_cr, byte_after_cr = -1;
4894 else
4895 ONE_MORE_BYTE (c);
4897 if (c < 0)
4898 goto invalid_code;
4899 if (c < 0x80)
4901 if (eol_dos && c == '\r')
4902 ONE_MORE_BYTE (byte_after_cr);
4903 charset = charset_roman;
4905 else
4907 /* BIG5 -> Big5 */
4908 if (c < 0xA1 || c > 0xFE)
4909 goto invalid_code;
4910 ONE_MORE_BYTE (c1);
4911 if (c1 < 0x40 || (c1 > 0x7E && c1 < 0xA1) || c1 > 0xFE)
4912 goto invalid_code;
4913 c = c << 8 | c1;
4914 charset = charset_big5;
4916 if (charset->id != charset_ascii
4917 && last_id != charset->id)
4919 if (last_id != charset_ascii)
4920 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
4921 last_id = charset->id;
4922 last_offset = char_offset;
4924 CODING_DECODE_CHAR (coding, src, src_base, src_end, charset, c, c);
4925 *charbuf++ = c;
4926 char_offset++;
4927 continue;
4929 invalid_code:
4930 src = src_base;
4931 consumed_chars = consumed_chars_base;
4932 ONE_MORE_BYTE (c);
4933 *charbuf++ = c < 0 ? -c : BYTE8_TO_CHAR (c);
4934 char_offset++;
4935 coding->errors++;
4938 no_more_source:
4939 if (last_id != charset_ascii)
4940 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
4941 coding->consumed_char += consumed_chars_base;
4942 coding->consumed = src_base - coding->source;
4943 coding->charbuf_used = charbuf - coding->charbuf;
4946 /* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions".
4947 This function can encode charsets `ascii', `katakana-jisx0201',
4948 `japanese-jisx0208', `chinese-big5-1', and `chinese-big5-2'. We
4949 are sure that all these charsets are registered as official charset
4950 (i.e. do not have extended leading-codes). Characters of other
4951 charsets are produced without any encoding. */
4953 static bool
4954 encode_coding_sjis (struct coding_system *coding)
4956 bool multibytep = coding->dst_multibyte;
4957 int *charbuf = coding->charbuf;
4958 int *charbuf_end = charbuf + coding->charbuf_used;
4959 unsigned char *dst = coding->destination + coding->produced;
4960 unsigned char *dst_end = coding->destination + coding->dst_bytes;
4961 int safe_room = 4;
4962 ptrdiff_t produced_chars = 0;
4963 Lisp_Object attrs, charset_list, val;
4964 bool ascii_compatible;
4965 struct charset *charset_kanji, *charset_kana;
4966 struct charset *charset_kanji2;
4967 int c;
4969 CODING_GET_INFO (coding, attrs, charset_list);
4970 val = XCDR (charset_list);
4971 charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
4972 charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
4973 charset_kanji2 = NILP (val) ? NULL : CHARSET_FROM_ID (XINT (XCAR (val)));
4975 ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
4977 while (charbuf < charbuf_end)
4979 ASSURE_DESTINATION (safe_room);
4980 c = *charbuf++;
4981 /* Now encode the character C. */
4982 if (ASCII_CHAR_P (c) && ascii_compatible)
4983 EMIT_ONE_ASCII_BYTE (c);
4984 else if (CHAR_BYTE8_P (c))
4986 c = CHAR_TO_BYTE8 (c);
4987 EMIT_ONE_BYTE (c);
4989 else
4991 unsigned code;
4992 struct charset *charset;
4993 CODING_CHAR_CHARSET (coding, dst, dst_end, c, charset_list,
4994 &code, charset);
4996 if (!charset)
4998 if (coding->mode & CODING_MODE_SAFE_ENCODING)
5000 code = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
5001 charset = CHARSET_FROM_ID (charset_ascii);
5003 else
5005 c = coding->default_char;
5006 CODING_CHAR_CHARSET (coding, dst, dst_end, c,
5007 charset_list, &code, charset);
5010 if (code == CHARSET_INVALID_CODE (charset))
5011 emacs_abort ();
5012 if (charset == charset_kanji)
5014 int c1, c2;
5015 JIS_TO_SJIS (code);
5016 c1 = code >> 8, c2 = code & 0xFF;
5017 EMIT_TWO_BYTES (c1, c2);
5019 else if (charset == charset_kana)
5020 EMIT_ONE_BYTE (code | 0x80);
5021 else if (charset_kanji2 && charset == charset_kanji2)
5023 int c1, c2;
5025 c1 = code >> 8;
5026 if (c1 == 0x21 || (c1 >= 0x23 && c1 <= 0x25)
5027 || c1 == 0x28
5028 || (c1 >= 0x2C && c1 <= 0x2F) || c1 >= 0x6E)
5030 JIS_TO_SJIS2 (code);
5031 c1 = code >> 8, c2 = code & 0xFF;
5032 EMIT_TWO_BYTES (c1, c2);
5034 else
5035 EMIT_ONE_ASCII_BYTE (code & 0x7F);
5037 else
5038 EMIT_ONE_ASCII_BYTE (code & 0x7F);
5041 record_conversion_result (coding, CODING_RESULT_SUCCESS);
5042 coding->produced_char += produced_chars;
5043 coding->produced = dst - coding->destination;
5044 return 0;
5047 static bool
5048 encode_coding_big5 (struct coding_system *coding)
5050 bool multibytep = coding->dst_multibyte;
5051 int *charbuf = coding->charbuf;
5052 int *charbuf_end = charbuf + coding->charbuf_used;
5053 unsigned char *dst = coding->destination + coding->produced;
5054 unsigned char *dst_end = coding->destination + coding->dst_bytes;
5055 int safe_room = 4;
5056 ptrdiff_t produced_chars = 0;
5057 Lisp_Object attrs, charset_list, val;
5058 bool ascii_compatible;
5059 struct charset *charset_big5;
5060 int c;
5062 CODING_GET_INFO (coding, attrs, charset_list);
5063 val = XCDR (charset_list);
5064 charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val)));
5065 ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
5067 while (charbuf < charbuf_end)
5069 ASSURE_DESTINATION (safe_room);
5070 c = *charbuf++;
5071 /* Now encode the character C. */
5072 if (ASCII_CHAR_P (c) && ascii_compatible)
5073 EMIT_ONE_ASCII_BYTE (c);
5074 else if (CHAR_BYTE8_P (c))
5076 c = CHAR_TO_BYTE8 (c);
5077 EMIT_ONE_BYTE (c);
5079 else
5081 unsigned code;
5082 struct charset *charset;
5083 CODING_CHAR_CHARSET (coding, dst, dst_end, c, charset_list,
5084 &code, charset);
5086 if (! charset)
5088 if (coding->mode & CODING_MODE_SAFE_ENCODING)
5090 code = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
5091 charset = CHARSET_FROM_ID (charset_ascii);
5093 else
5095 c = coding->default_char;
5096 CODING_CHAR_CHARSET (coding, dst, dst_end, c,
5097 charset_list, &code, charset);
5100 if (code == CHARSET_INVALID_CODE (charset))
5101 emacs_abort ();
5102 if (charset == charset_big5)
5104 int c1, c2;
5106 c1 = code >> 8, c2 = code & 0xFF;
5107 EMIT_TWO_BYTES (c1, c2);
5109 else
5110 EMIT_ONE_ASCII_BYTE (code & 0x7F);
5113 record_conversion_result (coding, CODING_RESULT_SUCCESS);
5114 coding->produced_char += produced_chars;
5115 coding->produced = dst - coding->destination;
5116 return 0;
5120 /*** 10. CCL handlers ***/
5122 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
5123 Return true if a text is encoded in a coding system of which
5124 encoder/decoder are written in CCL program. */
5126 static bool
5127 detect_coding_ccl (struct coding_system *coding,
5128 struct coding_detection_info *detect_info)
5130 const unsigned char *src = coding->source, *src_base;
5131 const unsigned char *src_end = coding->source + coding->src_bytes;
5132 bool multibytep = coding->src_multibyte;
5133 ptrdiff_t consumed_chars = 0;
5134 int found = 0;
5135 unsigned char *valids;
5136 ptrdiff_t head_ascii = coding->head_ascii;
5137 Lisp_Object attrs;
5139 detect_info->checked |= CATEGORY_MASK_CCL;
5141 coding = &coding_categories[coding_category_ccl];
5142 valids = CODING_CCL_VALIDS (coding);
5143 attrs = CODING_ID_ATTRS (coding->id);
5144 if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
5145 src += head_ascii;
5147 while (1)
5149 int c;
5151 src_base = src;
5152 ONE_MORE_BYTE (c);
5153 if (c < 0 || ! valids[c])
5154 break;
5155 if ((valids[c] > 1))
5156 found = CATEGORY_MASK_CCL;
5158 detect_info->rejected |= CATEGORY_MASK_CCL;
5159 return 0;
5161 no_more_source:
5162 detect_info->found |= found;
5163 return 1;
5166 static void
5167 decode_coding_ccl (struct coding_system *coding)
5169 const unsigned char *src = coding->source + coding->consumed;
5170 const unsigned char *src_end = coding->source + coding->src_bytes;
5171 int *charbuf = coding->charbuf + coding->charbuf_used;
5172 int *charbuf_end = coding->charbuf + coding->charbuf_size;
5173 ptrdiff_t consumed_chars = 0;
5174 bool multibytep = coding->src_multibyte;
5175 struct ccl_program *ccl = &coding->spec.ccl->ccl;
5176 int source_charbuf[1024];
5177 int source_byteidx[1025];
5178 Lisp_Object attrs, charset_list;
5180 CODING_GET_INFO (coding, attrs, charset_list);
5182 while (1)
5184 const unsigned char *p = src;
5185 ptrdiff_t offset;
5186 int i = 0;
5188 if (multibytep)
5190 while (i < 1024 && p < src_end)
5192 source_byteidx[i] = p - src;
5193 source_charbuf[i++] = STRING_CHAR_ADVANCE (p);
5195 source_byteidx[i] = p - src;
5197 else
5198 while (i < 1024 && p < src_end)
5199 source_charbuf[i++] = *p++;
5201 if (p == src_end && coding->mode & CODING_MODE_LAST_BLOCK)
5202 ccl->last_block = 1;
5203 /* As ccl_driver calls DECODE_CHAR, buffer may be relocated. */
5204 charset_map_loaded = 0;
5205 ccl_driver (ccl, source_charbuf, charbuf, i, charbuf_end - charbuf,
5206 charset_list);
5207 if (charset_map_loaded
5208 && (offset = coding_change_source (coding)))
5210 p += offset;
5211 src += offset;
5212 src_end += offset;
5214 charbuf += ccl->produced;
5215 if (multibytep)
5216 src += source_byteidx[ccl->consumed];
5217 else
5218 src += ccl->consumed;
5219 consumed_chars += ccl->consumed;
5220 if (p == src_end || ccl->status != CCL_STAT_SUSPEND_BY_SRC)
5221 break;
5224 switch (ccl->status)
5226 case CCL_STAT_SUSPEND_BY_SRC:
5227 record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_SRC);
5228 break;
5229 case CCL_STAT_SUSPEND_BY_DST:
5230 record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_DST);
5231 break;
5232 case CCL_STAT_QUIT:
5233 case CCL_STAT_INVALID_CMD:
5234 record_conversion_result (coding, CODING_RESULT_INTERRUPT);
5235 break;
5236 default:
5237 record_conversion_result (coding, CODING_RESULT_SUCCESS);
5238 break;
5240 coding->consumed_char += consumed_chars;
5241 coding->consumed = src - coding->source;
5242 coding->charbuf_used = charbuf - coding->charbuf;
5245 static bool
5246 encode_coding_ccl (struct coding_system *coding)
5248 struct ccl_program *ccl = &coding->spec.ccl->ccl;
5249 bool multibytep = coding->dst_multibyte;
5250 int *charbuf = coding->charbuf;
5251 int *charbuf_end = charbuf + coding->charbuf_used;
5252 unsigned char *dst = coding->destination + coding->produced;
5253 unsigned char *dst_end = coding->destination + coding->dst_bytes;
5254 int destination_charbuf[1024];
5255 ptrdiff_t produced_chars = 0;
5256 int i;
5257 Lisp_Object attrs, charset_list;
5259 CODING_GET_INFO (coding, attrs, charset_list);
5260 if (coding->consumed_char == coding->src_chars
5261 && coding->mode & CODING_MODE_LAST_BLOCK)
5262 ccl->last_block = 1;
5266 ptrdiff_t offset;
5268 /* As ccl_driver calls DECODE_CHAR, buffer may be relocated. */
5269 charset_map_loaded = 0;
5270 ccl_driver (ccl, charbuf, destination_charbuf,
5271 charbuf_end - charbuf, 1024, charset_list);
5272 if (charset_map_loaded
5273 && (offset = coding_change_destination (coding)))
5274 dst += offset;
5275 if (multibytep)
5277 ASSURE_DESTINATION (ccl->produced * 2);
5278 for (i = 0; i < ccl->produced; i++)
5279 EMIT_ONE_BYTE (destination_charbuf[i] & 0xFF);
5281 else
5283 ASSURE_DESTINATION (ccl->produced);
5284 for (i = 0; i < ccl->produced; i++)
5285 *dst++ = destination_charbuf[i] & 0xFF;
5286 produced_chars += ccl->produced;
5288 charbuf += ccl->consumed;
5289 if (ccl->status == CCL_STAT_QUIT
5290 || ccl->status == CCL_STAT_INVALID_CMD)
5291 break;
5293 while (charbuf < charbuf_end);
5295 switch (ccl->status)
5297 case CCL_STAT_SUSPEND_BY_SRC:
5298 record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_SRC);
5299 break;
5300 case CCL_STAT_SUSPEND_BY_DST:
5301 record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_DST);
5302 break;
5303 case CCL_STAT_QUIT:
5304 case CCL_STAT_INVALID_CMD:
5305 record_conversion_result (coding, CODING_RESULT_INTERRUPT);
5306 break;
5307 default:
5308 record_conversion_result (coding, CODING_RESULT_SUCCESS);
5309 break;
5312 coding->produced_char += produced_chars;
5313 coding->produced = dst - coding->destination;
5314 return 0;
5318 /*** 10, 11. no-conversion handlers ***/
5320 /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
5322 static void
5323 decode_coding_raw_text (struct coding_system *coding)
5325 bool eol_dos
5326 = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
5328 coding->chars_at_source = 1;
5329 coding->consumed_char = coding->src_chars;
5330 coding->consumed = coding->src_bytes;
5331 if (eol_dos && coding->source[coding->src_bytes - 1] == '\r')
5333 coding->consumed_char--;
5334 coding->consumed--;
5335 record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_SRC);
5337 else
5338 record_conversion_result (coding, CODING_RESULT_SUCCESS);
5341 static bool
5342 encode_coding_raw_text (struct coding_system *coding)
5344 bool multibytep = coding->dst_multibyte;
5345 int *charbuf = coding->charbuf;
5346 int *charbuf_end = coding->charbuf + coding->charbuf_used;
5347 unsigned char *dst = coding->destination + coding->produced;
5348 unsigned char *dst_end = coding->destination + coding->dst_bytes;
5349 ptrdiff_t produced_chars = 0;
5350 int c;
5352 if (multibytep)
5354 int safe_room = MAX_MULTIBYTE_LENGTH * 2;
5356 if (coding->src_multibyte)
5357 while (charbuf < charbuf_end)
5359 ASSURE_DESTINATION (safe_room);
5360 c = *charbuf++;
5361 if (ASCII_CHAR_P (c))
5362 EMIT_ONE_ASCII_BYTE (c);
5363 else if (CHAR_BYTE8_P (c))
5365 c = CHAR_TO_BYTE8 (c);
5366 EMIT_ONE_BYTE (c);
5368 else
5370 unsigned char str[MAX_MULTIBYTE_LENGTH], *p0 = str, *p1 = str;
5372 CHAR_STRING_ADVANCE (c, p1);
5375 EMIT_ONE_BYTE (*p0);
5376 p0++;
5378 while (p0 < p1);
5381 else
5382 while (charbuf < charbuf_end)
5384 ASSURE_DESTINATION (safe_room);
5385 c = *charbuf++;
5386 EMIT_ONE_BYTE (c);
5389 else
5391 if (coding->src_multibyte)
5393 int safe_room = MAX_MULTIBYTE_LENGTH;
5395 while (charbuf < charbuf_end)
5397 ASSURE_DESTINATION (safe_room);
5398 c = *charbuf++;
5399 if (ASCII_CHAR_P (c))
5400 *dst++ = c;
5401 else if (CHAR_BYTE8_P (c))
5402 *dst++ = CHAR_TO_BYTE8 (c);
5403 else
5404 CHAR_STRING_ADVANCE (c, dst);
5407 else
5409 ASSURE_DESTINATION (charbuf_end - charbuf);
5410 while (charbuf < charbuf_end && dst < dst_end)
5411 *dst++ = *charbuf++;
5413 produced_chars = dst - (coding->destination + coding->produced);
5415 record_conversion_result (coding, CODING_RESULT_SUCCESS);
5416 coding->produced_char += produced_chars;
5417 coding->produced = dst - coding->destination;
5418 return 0;
5421 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
5422 Return true if a text is encoded in a charset-based coding system. */
5424 static bool
5425 detect_coding_charset (struct coding_system *coding,
5426 struct coding_detection_info *detect_info)
5428 const unsigned char *src = coding->source, *src_base;
5429 const unsigned char *src_end = coding->source + coding->src_bytes;
5430 bool multibytep = coding->src_multibyte;
5431 ptrdiff_t consumed_chars = 0;
5432 Lisp_Object attrs, valids, name;
5433 int found = 0;
5434 ptrdiff_t head_ascii = coding->head_ascii;
5435 bool check_latin_extra = 0;
5437 detect_info->checked |= CATEGORY_MASK_CHARSET;
5439 coding = &coding_categories[coding_category_charset];
5440 attrs = CODING_ID_ATTRS (coding->id);
5441 valids = AREF (attrs, coding_attr_charset_valids);
5442 name = CODING_ID_NAME (coding->id);
5443 if (strncmp (SSDATA (SYMBOL_NAME (name)),
5444 "iso-8859-", sizeof ("iso-8859-") - 1) == 0
5445 || strncmp (SSDATA (SYMBOL_NAME (name)),
5446 "iso-latin-", sizeof ("iso-latin-") - 1) == 0)
5447 check_latin_extra = 1;
5449 if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
5450 src += head_ascii;
5452 while (1)
5454 int c;
5455 Lisp_Object val;
5456 struct charset *charset;
5457 int dim, idx;
5459 src_base = src;
5460 ONE_MORE_BYTE (c);
5461 if (c < 0)
5462 continue;
5463 val = AREF (valids, c);
5464 if (NILP (val))
5465 break;
5466 if (c >= 0x80)
5468 if (c < 0xA0
5469 && check_latin_extra
5470 && (!VECTORP (Vlatin_extra_code_table)
5471 || NILP (AREF (Vlatin_extra_code_table, c))))
5472 break;
5473 found = CATEGORY_MASK_CHARSET;
5475 if (INTEGERP (val))
5477 charset = CHARSET_FROM_ID (XFASTINT (val));
5478 dim = CHARSET_DIMENSION (charset);
5479 for (idx = 1; idx < dim; idx++)
5481 if (src == src_end)
5482 goto too_short;
5483 ONE_MORE_BYTE (c);
5484 if (c < charset->code_space[(dim - 1 - idx) * 4]
5485 || c > charset->code_space[(dim - 1 - idx) * 4 + 1])
5486 break;
5488 if (idx < dim)
5489 break;
5491 else
5493 idx = 1;
5494 for (; CONSP (val); val = XCDR (val))
5496 charset = CHARSET_FROM_ID (XFASTINT (XCAR (val)));
5497 dim = CHARSET_DIMENSION (charset);
5498 while (idx < dim)
5500 if (src == src_end)
5501 goto too_short;
5502 ONE_MORE_BYTE (c);
5503 if (c < charset->code_space[(dim - 1 - idx) * 4]
5504 || c > charset->code_space[(dim - 1 - idx) * 4 + 1])
5505 break;
5506 idx++;
5508 if (idx == dim)
5510 val = Qnil;
5511 break;
5514 if (CONSP (val))
5515 break;
5518 too_short:
5519 detect_info->rejected |= CATEGORY_MASK_CHARSET;
5520 return 0;
5522 no_more_source:
5523 detect_info->found |= found;
5524 return 1;
5527 static void
5528 decode_coding_charset (struct coding_system *coding)
5530 const unsigned char *src = coding->source + coding->consumed;
5531 const unsigned char *src_end = coding->source + coding->src_bytes;
5532 const unsigned char *src_base;
5533 int *charbuf = coding->charbuf + coding->charbuf_used;
5534 /* We may produce one charset annotation in one loop and one more at
5535 the end. */
5536 int *charbuf_end
5537 = coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 2);
5538 ptrdiff_t consumed_chars = 0, consumed_chars_base;
5539 bool multibytep = coding->src_multibyte;
5540 Lisp_Object attrs = CODING_ID_ATTRS (coding->id);
5541 Lisp_Object valids;
5542 ptrdiff_t char_offset = coding->produced_char;
5543 ptrdiff_t last_offset = char_offset;
5544 int last_id = charset_ascii;
5545 bool eol_dos
5546 = !inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
5547 int byte_after_cr = -1;
5549 valids = AREF (attrs, coding_attr_charset_valids);
5551 while (1)
5553 int c;
5554 Lisp_Object val;
5555 struct charset *charset;
5556 int dim;
5557 int len = 1;
5558 unsigned code;
5560 src_base = src;
5561 consumed_chars_base = consumed_chars;
5563 if (charbuf >= charbuf_end)
5565 if (byte_after_cr >= 0)
5566 src_base--;
5567 break;
5570 if (byte_after_cr >= 0)
5572 c = byte_after_cr;
5573 byte_after_cr = -1;
5575 else
5577 ONE_MORE_BYTE (c);
5578 if (eol_dos && c == '\r')
5579 ONE_MORE_BYTE (byte_after_cr);
5581 if (c < 0)
5582 goto invalid_code;
5583 code = c;
5585 val = AREF (valids, c);
5586 if (! INTEGERP (val) && ! CONSP (val))
5587 goto invalid_code;
5588 if (INTEGERP (val))
5590 charset = CHARSET_FROM_ID (XFASTINT (val));
5591 dim = CHARSET_DIMENSION (charset);
5592 while (len < dim)
5594 ONE_MORE_BYTE (c);
5595 code = (code << 8) | c;
5596 len++;
5598 CODING_DECODE_CHAR (coding, src, src_base, src_end,
5599 charset, code, c);
5601 else
5603 /* VAL is a list of charset IDs. It is assured that the
5604 list is sorted by charset dimensions (smaller one
5605 comes first). */
5606 while (CONSP (val))
5608 charset = CHARSET_FROM_ID (XFASTINT (XCAR (val)));
5609 dim = CHARSET_DIMENSION (charset);
5610 while (len < dim)
5612 ONE_MORE_BYTE (c);
5613 code = (code << 8) | c;
5614 len++;
5616 CODING_DECODE_CHAR (coding, src, src_base,
5617 src_end, charset, code, c);
5618 if (c >= 0)
5619 break;
5620 val = XCDR (val);
5623 if (c < 0)
5624 goto invalid_code;
5625 if (charset->id != charset_ascii
5626 && last_id != charset->id)
5628 if (last_id != charset_ascii)
5629 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
5630 last_id = charset->id;
5631 last_offset = char_offset;
5634 *charbuf++ = c;
5635 char_offset++;
5636 continue;
5638 invalid_code:
5639 src = src_base;
5640 consumed_chars = consumed_chars_base;
5641 ONE_MORE_BYTE (c);
5642 *charbuf++ = c < 0 ? -c : ASCII_BYTE_P (c) ? c : BYTE8_TO_CHAR (c);
5643 char_offset++;
5644 coding->errors++;
5647 no_more_source:
5648 if (last_id != charset_ascii)
5649 ADD_CHARSET_DATA (charbuf, char_offset - last_offset, last_id);
5650 coding->consumed_char += consumed_chars_base;
5651 coding->consumed = src_base - coding->source;
5652 coding->charbuf_used = charbuf - coding->charbuf;
5655 static bool
5656 encode_coding_charset (struct coding_system *coding)
5658 bool multibytep = coding->dst_multibyte;
5659 int *charbuf = coding->charbuf;
5660 int *charbuf_end = charbuf + coding->charbuf_used;
5661 unsigned char *dst = coding->destination + coding->produced;
5662 unsigned char *dst_end = coding->destination + coding->dst_bytes;
5663 int safe_room = MAX_MULTIBYTE_LENGTH;
5664 ptrdiff_t produced_chars = 0;
5665 Lisp_Object attrs, charset_list;
5666 bool ascii_compatible;
5667 int c;
5669 CODING_GET_INFO (coding, attrs, charset_list);
5670 ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
5672 while (charbuf < charbuf_end)
5674 struct charset *charset;
5675 unsigned code;
5677 ASSURE_DESTINATION (safe_room);
5678 c = *charbuf++;
5679 if (ascii_compatible && ASCII_CHAR_P (c))
5680 EMIT_ONE_ASCII_BYTE (c);
5681 else if (CHAR_BYTE8_P (c))
5683 c = CHAR_TO_BYTE8 (c);
5684 EMIT_ONE_BYTE (c);
5686 else
5688 CODING_CHAR_CHARSET (coding, dst, dst_end, c, charset_list,
5689 &code, charset);
5691 if (charset)
5693 if (CHARSET_DIMENSION (charset) == 1)
5694 EMIT_ONE_BYTE (code);
5695 else if (CHARSET_DIMENSION (charset) == 2)
5696 EMIT_TWO_BYTES (code >> 8, code & 0xFF);
5697 else if (CHARSET_DIMENSION (charset) == 3)
5698 EMIT_THREE_BYTES (code >> 16, (code >> 8) & 0xFF, code & 0xFF);
5699 else
5700 EMIT_FOUR_BYTES (code >> 24, (code >> 16) & 0xFF,
5701 (code >> 8) & 0xFF, code & 0xFF);
5703 else
5705 if (coding->mode & CODING_MODE_SAFE_ENCODING)
5706 c = CODING_INHIBIT_CHARACTER_SUBSTITUTION;
5707 else
5708 c = coding->default_char;
5709 EMIT_ONE_BYTE (c);
5714 record_conversion_result (coding, CODING_RESULT_SUCCESS);
5715 coding->produced_char += produced_chars;
5716 coding->produced = dst - coding->destination;
5717 return 0;
5721 /*** 7. C library functions ***/
5723 /* Setup coding context CODING from information about CODING_SYSTEM.
5724 If CODING_SYSTEM is nil, `no-conversion' is assumed. If
5725 CODING_SYSTEM is invalid, signal an error. */
5727 void
5728 setup_coding_system (Lisp_Object coding_system, struct coding_system *coding)
5730 Lisp_Object attrs;
5731 Lisp_Object eol_type;
5732 Lisp_Object coding_type;
5733 Lisp_Object val;
5735 if (NILP (coding_system))
5736 coding_system = Qundecided;
5738 CHECK_CODING_SYSTEM_GET_ID (coding_system, coding->id);
5740 attrs = CODING_ID_ATTRS (coding->id);
5741 eol_type = inhibit_eol_conversion ? Qunix : CODING_ID_EOL_TYPE (coding->id);
5743 coding->mode = 0;
5744 if (VECTORP (eol_type))
5745 coding->common_flags = (CODING_REQUIRE_DECODING_MASK
5746 | CODING_REQUIRE_DETECTION_MASK);
5747 else if (! EQ (eol_type, Qunix))
5748 coding->common_flags = (CODING_REQUIRE_DECODING_MASK
5749 | CODING_REQUIRE_ENCODING_MASK);
5750 else
5751 coding->common_flags = 0;
5752 if (! NILP (CODING_ATTR_POST_READ (attrs)))
5753 coding->common_flags |= CODING_REQUIRE_DECODING_MASK;
5754 if (! NILP (CODING_ATTR_PRE_WRITE (attrs)))
5755 coding->common_flags |= CODING_REQUIRE_ENCODING_MASK;
5756 if (! NILP (CODING_ATTR_FOR_UNIBYTE (attrs)))
5757 coding->common_flags |= CODING_FOR_UNIBYTE_MASK;
5759 val = CODING_ATTR_SAFE_CHARSETS (attrs);
5760 coding->max_charset_id = SCHARS (val) - 1;
5761 coding->safe_charsets = SDATA (val);
5762 coding->default_char = XINT (CODING_ATTR_DEFAULT_CHAR (attrs));
5763 coding->carryover_bytes = 0;
5764 coding->raw_destination = 0;
5766 coding_type = CODING_ATTR_TYPE (attrs);
5767 if (EQ (coding_type, Qundecided))
5769 coding->detector = NULL;
5770 coding->decoder = decode_coding_raw_text;
5771 coding->encoder = encode_coding_raw_text;
5772 coding->common_flags |= CODING_REQUIRE_DETECTION_MASK;
5773 coding->spec.undecided.inhibit_nbd
5774 = (encode_inhibit_flag
5775 (AREF (attrs, coding_attr_undecided_inhibit_null_byte_detection)));
5776 coding->spec.undecided.inhibit_ied
5777 = (encode_inhibit_flag
5778 (AREF (attrs, coding_attr_undecided_inhibit_iso_escape_detection)));
5779 coding->spec.undecided.prefer_utf_8
5780 = ! NILP (AREF (attrs, coding_attr_undecided_prefer_utf_8));
5782 else if (EQ (coding_type, Qiso_2022))
5784 int i;
5785 int flags = XINT (AREF (attrs, coding_attr_iso_flags));
5787 /* Invoke graphic register 0 to plane 0. */
5788 CODING_ISO_INVOCATION (coding, 0) = 0;
5789 /* Invoke graphic register 1 to plane 1 if we can use 8-bit. */
5790 CODING_ISO_INVOCATION (coding, 1)
5791 = (flags & CODING_ISO_FLAG_SEVEN_BITS ? -1 : 1);
5792 /* Setup the initial status of designation. */
5793 for (i = 0; i < 4; i++)
5794 CODING_ISO_DESIGNATION (coding, i) = CODING_ISO_INITIAL (coding, i);
5795 /* Not single shifting initially. */
5796 CODING_ISO_SINGLE_SHIFTING (coding) = 0;
5797 /* Beginning of buffer should also be regarded as bol. */
5798 CODING_ISO_BOL (coding) = 1;
5799 coding->detector = detect_coding_iso_2022;
5800 coding->decoder = decode_coding_iso_2022;
5801 coding->encoder = encode_coding_iso_2022;
5802 if (flags & CODING_ISO_FLAG_SAFE)
5803 coding->mode |= CODING_MODE_SAFE_ENCODING;
5804 coding->common_flags
5805 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK
5806 | CODING_REQUIRE_FLUSHING_MASK);
5807 if (flags & CODING_ISO_FLAG_COMPOSITION)
5808 coding->common_flags |= CODING_ANNOTATE_COMPOSITION_MASK;
5809 if (flags & CODING_ISO_FLAG_DESIGNATION)
5810 coding->common_flags |= CODING_ANNOTATE_CHARSET_MASK;
5811 if (flags & CODING_ISO_FLAG_FULL_SUPPORT)
5813 setup_iso_safe_charsets (attrs);
5814 val = CODING_ATTR_SAFE_CHARSETS (attrs);
5815 coding->max_charset_id = SCHARS (val) - 1;
5816 coding->safe_charsets = SDATA (val);
5818 CODING_ISO_FLAGS (coding) = flags;
5819 CODING_ISO_CMP_STATUS (coding)->state = COMPOSING_NO;
5820 CODING_ISO_CMP_STATUS (coding)->method = COMPOSITION_NO;
5821 CODING_ISO_EXTSEGMENT_LEN (coding) = 0;
5822 CODING_ISO_EMBEDDED_UTF_8 (coding) = 0;
5824 else if (EQ (coding_type, Qcharset))
5826 coding->detector = detect_coding_charset;
5827 coding->decoder = decode_coding_charset;
5828 coding->encoder = encode_coding_charset;
5829 coding->common_flags
5830 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
5832 else if (EQ (coding_type, Qutf_8))
5834 val = AREF (attrs, coding_attr_utf_bom);
5835 CODING_UTF_8_BOM (coding) = (CONSP (val) ? utf_detect_bom
5836 : EQ (val, Qt) ? utf_with_bom
5837 : utf_without_bom);
5838 coding->detector = detect_coding_utf_8;
5839 coding->decoder = decode_coding_utf_8;
5840 coding->encoder = encode_coding_utf_8;
5841 coding->common_flags
5842 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
5843 if (CODING_UTF_8_BOM (coding) == utf_detect_bom)
5844 coding->common_flags |= CODING_REQUIRE_DETECTION_MASK;
5846 else if (EQ (coding_type, Qutf_16))
5848 val = AREF (attrs, coding_attr_utf_bom);
5849 CODING_UTF_16_BOM (coding) = (CONSP (val) ? utf_detect_bom
5850 : EQ (val, Qt) ? utf_with_bom
5851 : utf_without_bom);
5852 val = AREF (attrs, coding_attr_utf_16_endian);
5853 CODING_UTF_16_ENDIAN (coding) = (EQ (val, Qbig) ? utf_16_big_endian
5854 : utf_16_little_endian);
5855 CODING_UTF_16_SURROGATE (coding) = 0;
5856 coding->detector = detect_coding_utf_16;
5857 coding->decoder = decode_coding_utf_16;
5858 coding->encoder = encode_coding_utf_16;
5859 coding->common_flags
5860 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
5861 if (CODING_UTF_16_BOM (coding) == utf_detect_bom)
5862 coding->common_flags |= CODING_REQUIRE_DETECTION_MASK;
5864 else if (EQ (coding_type, Qccl))
5866 coding->detector = detect_coding_ccl;
5867 coding->decoder = decode_coding_ccl;
5868 coding->encoder = encode_coding_ccl;
5869 coding->common_flags
5870 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK
5871 | CODING_REQUIRE_FLUSHING_MASK);
5873 else if (EQ (coding_type, Qemacs_mule))
5875 coding->detector = detect_coding_emacs_mule;
5876 coding->decoder = decode_coding_emacs_mule;
5877 coding->encoder = encode_coding_emacs_mule;
5878 coding->common_flags
5879 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
5880 if (! NILP (AREF (attrs, coding_attr_emacs_mule_full))
5881 && ! EQ (CODING_ATTR_CHARSET_LIST (attrs), Vemacs_mule_charset_list))
5883 Lisp_Object tail, safe_charsets;
5884 int max_charset_id = 0;
5886 for (tail = Vemacs_mule_charset_list; CONSP (tail);
5887 tail = XCDR (tail))
5888 if (max_charset_id < XFASTINT (XCAR (tail)))
5889 max_charset_id = XFASTINT (XCAR (tail));
5890 safe_charsets = make_uninit_string (max_charset_id + 1);
5891 memset (SDATA (safe_charsets), 255, max_charset_id + 1);
5892 for (tail = Vemacs_mule_charset_list; CONSP (tail);
5893 tail = XCDR (tail))
5894 SSET (safe_charsets, XFASTINT (XCAR (tail)), 0);
5895 coding->max_charset_id = max_charset_id;
5896 coding->safe_charsets = SDATA (safe_charsets);
5898 coding->spec.emacs_mule.cmp_status.state = COMPOSING_NO;
5899 coding->spec.emacs_mule.cmp_status.method = COMPOSITION_NO;
5901 else if (EQ (coding_type, Qshift_jis))
5903 coding->detector = detect_coding_sjis;
5904 coding->decoder = decode_coding_sjis;
5905 coding->encoder = encode_coding_sjis;
5906 coding->common_flags
5907 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
5909 else if (EQ (coding_type, Qbig5))
5911 coding->detector = detect_coding_big5;
5912 coding->decoder = decode_coding_big5;
5913 coding->encoder = encode_coding_big5;
5914 coding->common_flags
5915 |= (CODING_REQUIRE_DECODING_MASK | CODING_REQUIRE_ENCODING_MASK);
5917 else /* EQ (coding_type, Qraw_text) */
5919 coding->detector = NULL;
5920 coding->decoder = decode_coding_raw_text;
5921 coding->encoder = encode_coding_raw_text;
5922 if (! EQ (eol_type, Qunix))
5924 coding->common_flags |= CODING_REQUIRE_DECODING_MASK;
5925 if (! VECTORP (eol_type))
5926 coding->common_flags |= CODING_REQUIRE_ENCODING_MASK;
5931 return;
5934 /* Return a list of charsets supported by CODING. */
5936 Lisp_Object
5937 coding_charset_list (struct coding_system *coding)
5939 Lisp_Object attrs, charset_list;
5941 CODING_GET_INFO (coding, attrs, charset_list);
5942 if (EQ (CODING_ATTR_TYPE (attrs), Qiso_2022))
5944 int flags = XINT (AREF (attrs, coding_attr_iso_flags));
5946 if (flags & CODING_ISO_FLAG_FULL_SUPPORT)
5947 charset_list = Viso_2022_charset_list;
5949 else if (EQ (CODING_ATTR_TYPE (attrs), Qemacs_mule))
5951 charset_list = Vemacs_mule_charset_list;
5953 return charset_list;
5957 /* Return a list of charsets supported by CODING-SYSTEM. */
5959 Lisp_Object
5960 coding_system_charset_list (Lisp_Object coding_system)
5962 ptrdiff_t id;
5963 Lisp_Object attrs, charset_list;
5965 CHECK_CODING_SYSTEM_GET_ID (coding_system, id);
5966 attrs = CODING_ID_ATTRS (id);
5968 if (EQ (CODING_ATTR_TYPE (attrs), Qiso_2022))
5970 int flags = XINT (AREF (attrs, coding_attr_iso_flags));
5972 if (flags & CODING_ISO_FLAG_FULL_SUPPORT)
5973 charset_list = Viso_2022_charset_list;
5974 else
5975 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
5977 else if (EQ (CODING_ATTR_TYPE (attrs), Qemacs_mule))
5979 charset_list = Vemacs_mule_charset_list;
5981 else
5983 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
5985 return charset_list;
5989 /* Return raw-text or one of its subsidiaries that has the same
5990 eol_type as CODING-SYSTEM. */
5992 Lisp_Object
5993 raw_text_coding_system (Lisp_Object coding_system)
5995 Lisp_Object spec, attrs;
5996 Lisp_Object eol_type, raw_text_eol_type;
5998 if (NILP (coding_system))
5999 return Qraw_text;
6000 spec = CODING_SYSTEM_SPEC (coding_system);
6001 attrs = AREF (spec, 0);
6003 if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
6004 return coding_system;
6006 eol_type = AREF (spec, 2);
6007 if (VECTORP (eol_type))
6008 return Qraw_text;
6009 spec = CODING_SYSTEM_SPEC (Qraw_text);
6010 raw_text_eol_type = AREF (spec, 2);
6011 return (EQ (eol_type, Qunix) ? AREF (raw_text_eol_type, 0)
6012 : EQ (eol_type, Qdos) ? AREF (raw_text_eol_type, 1)
6013 : AREF (raw_text_eol_type, 2));
6017 /* If CODING_SYSTEM doesn't specify end-of-line format, return one of
6018 the subsidiary that has the same eol-spec as PARENT (if it is not
6019 nil and specifies end-of-line format) or the system's setting
6020 (system_eol_type). */
6022 Lisp_Object
6023 coding_inherit_eol_type (Lisp_Object coding_system, Lisp_Object parent)
6025 Lisp_Object spec, eol_type;
6027 if (NILP (coding_system))
6028 coding_system = Qraw_text;
6029 spec = CODING_SYSTEM_SPEC (coding_system);
6030 eol_type = AREF (spec, 2);
6031 if (VECTORP (eol_type))
6033 Lisp_Object parent_eol_type;
6035 if (! NILP (parent))
6037 Lisp_Object parent_spec;
6039 parent_spec = CODING_SYSTEM_SPEC (parent);
6040 parent_eol_type = AREF (parent_spec, 2);
6041 if (VECTORP (parent_eol_type))
6042 parent_eol_type = system_eol_type;
6044 else
6045 parent_eol_type = system_eol_type;
6046 if (EQ (parent_eol_type, Qunix))
6047 coding_system = AREF (eol_type, 0);
6048 else if (EQ (parent_eol_type, Qdos))
6049 coding_system = AREF (eol_type, 1);
6050 else if (EQ (parent_eol_type, Qmac))
6051 coding_system = AREF (eol_type, 2);
6053 return coding_system;
6057 /* Check if text-conversion and eol-conversion of CODING_SYSTEM are
6058 decided for writing to a process. If not, complement them, and
6059 return a new coding system. */
6061 Lisp_Object
6062 complement_process_encoding_system (Lisp_Object coding_system)
6064 Lisp_Object coding_base = Qnil, eol_base = Qnil;
6065 Lisp_Object spec, attrs;
6066 int i;
6068 for (i = 0; i < 3; i++)
6070 if (i == 1)
6071 coding_system = CDR_SAFE (Vdefault_process_coding_system);
6072 else if (i == 2)
6073 coding_system = preferred_coding_system ();
6074 spec = CODING_SYSTEM_SPEC (coding_system);
6075 if (NILP (spec))
6076 continue;
6077 attrs = AREF (spec, 0);
6078 if (NILP (coding_base) && ! EQ (CODING_ATTR_TYPE (attrs), Qundecided))
6079 coding_base = CODING_ATTR_BASE_NAME (attrs);
6080 if (NILP (eol_base) && ! VECTORP (AREF (spec, 2)))
6081 eol_base = coding_system;
6082 if (! NILP (coding_base) && ! NILP (eol_base))
6083 break;
6086 if (i > 0)
6087 /* The original CODING_SYSTEM didn't specify text-conversion or
6088 eol-conversion. Be sure that we return a fully complemented
6089 coding system. */
6090 coding_system = coding_inherit_eol_type (coding_base, eol_base);
6091 return coding_system;
6095 /* Emacs has a mechanism to automatically detect a coding system if it
6096 is one of Emacs' internal format, ISO2022, SJIS, and BIG5. But,
6097 it's impossible to distinguish some coding systems accurately
6098 because they use the same range of codes. So, at first, coding
6099 systems are categorized into 7, those are:
6101 o coding-category-emacs-mule
6103 The category for a coding system which has the same code range
6104 as Emacs' internal format. Assigned the coding-system (Lisp
6105 symbol) `emacs-mule' by default.
6107 o coding-category-sjis
6109 The category for a coding system which has the same code range
6110 as SJIS. Assigned the coding-system (Lisp
6111 symbol) `japanese-shift-jis' by default.
6113 o coding-category-iso-7
6115 The category for a coding system which has the same code range
6116 as ISO2022 of 7-bit environment. This doesn't use any locking
6117 shift and single shift functions. This can encode/decode all
6118 charsets. Assigned the coding-system (Lisp symbol)
6119 `iso-2022-7bit' by default.
6121 o coding-category-iso-7-tight
6123 Same as coding-category-iso-7 except that this can
6124 encode/decode only the specified charsets.
6126 o coding-category-iso-8-1
6128 The category for a coding system which has the same code range
6129 as ISO2022 of 8-bit environment and graphic plane 1 used only
6130 for DIMENSION1 charset. This doesn't use any locking shift
6131 and single shift functions. Assigned the coding-system (Lisp
6132 symbol) `iso-latin-1' by default.
6134 o coding-category-iso-8-2
6136 The category for a coding system which has the same code range
6137 as ISO2022 of 8-bit environment and graphic plane 1 used only
6138 for DIMENSION2 charset. This doesn't use any locking shift
6139 and single shift functions. Assigned the coding-system (Lisp
6140 symbol) `japanese-iso-8bit' by default.
6142 o coding-category-iso-7-else
6144 The category for a coding system which has the same code range
6145 as ISO2022 of 7-bit environment but uses locking shift or
6146 single shift functions. Assigned the coding-system (Lisp
6147 symbol) `iso-2022-7bit-lock' by default.
6149 o coding-category-iso-8-else
6151 The category for a coding system which has the same code range
6152 as ISO2022 of 8-bit environment but uses locking shift or
6153 single shift functions. Assigned the coding-system (Lisp
6154 symbol) `iso-2022-8bit-ss2' by default.
6156 o coding-category-big5
6158 The category for a coding system which has the same code range
6159 as BIG5. Assigned the coding-system (Lisp symbol)
6160 `cn-big5' by default.
6162 o coding-category-utf-8
6164 The category for a coding system which has the same code range
6165 as UTF-8 (cf. RFC3629). Assigned the coding-system (Lisp
6166 symbol) `utf-8' by default.
6168 o coding-category-utf-16-be
6170 The category for a coding system in which a text has an
6171 Unicode signature (cf. Unicode Standard) in the order of BIG
6172 endian at the head. Assigned the coding-system (Lisp symbol)
6173 `utf-16-be' by default.
6175 o coding-category-utf-16-le
6177 The category for a coding system in which a text has an
6178 Unicode signature (cf. Unicode Standard) in the order of
6179 LITTLE endian at the head. Assigned the coding-system (Lisp
6180 symbol) `utf-16-le' by default.
6182 o coding-category-ccl
6184 The category for a coding system of which encoder/decoder is
6185 written in CCL programs. The default value is nil, i.e., no
6186 coding system is assigned.
6188 o coding-category-binary
6190 The category for a coding system not categorized in any of the
6191 above. Assigned the coding-system (Lisp symbol)
6192 `no-conversion' by default.
6194 Each of them is a Lisp symbol and the value is an actual
6195 `coding-system's (this is also a Lisp symbol) assigned by a user.
6196 What Emacs does actually is to detect a category of coding system.
6197 Then, it uses a `coding-system' assigned to it. If Emacs can't
6198 decide only one possible category, it selects a category of the
6199 highest priority. Priorities of categories are also specified by a
6200 user in a Lisp variable `coding-category-list'.
6204 static Lisp_Object adjust_coding_eol_type (struct coding_system *coding,
6205 int eol_seen);
6208 /* Return the number of ASCII characters at the head of the source.
6209 By side effects, set coding->head_ascii and update
6210 coding->eol_seen. The value of coding->eol_seen is "logical or" of
6211 EOL_SEEN_LF, EOL_SEEN_CR, and EOL_SEEN_CRLF, but the value is
6212 reliable only when all the source bytes are ASCII. */
6214 static int
6215 check_ascii (struct coding_system *coding)
6217 const unsigned char *src, *end;
6218 Lisp_Object eol_type = CODING_ID_EOL_TYPE (coding->id);
6219 int eol_seen = coding->eol_seen;
6221 coding_set_source (coding);
6222 src = coding->source;
6223 end = src + coding->src_bytes;
6225 if (inhibit_eol_conversion
6226 || SYMBOLP (eol_type))
6228 /* We don't have to check EOL format. */
6229 while (src < end && !( *src & 0x80))
6231 if (*src++ == '\n')
6232 eol_seen |= EOL_SEEN_LF;
6235 else
6237 end--; /* We look ahead one byte for "CR LF". */
6238 while (src < end)
6240 int c = *src;
6242 if (c & 0x80)
6243 break;
6244 src++;
6245 if (c == '\r')
6247 if (*src == '\n')
6249 eol_seen |= EOL_SEEN_CRLF;
6250 src++;
6252 else
6253 eol_seen |= EOL_SEEN_CR;
6255 else if (c == '\n')
6256 eol_seen |= EOL_SEEN_LF;
6258 if (src == end)
6260 int c = *src;
6262 /* All bytes but the last one C are ASCII. */
6263 if (! (c & 0x80))
6265 if (c == '\r')
6266 eol_seen |= EOL_SEEN_CR;
6267 else if (c == '\n')
6268 eol_seen |= EOL_SEEN_LF;
6269 src++;
6273 coding->head_ascii = src - coding->source;
6274 coding->eol_seen = eol_seen;
6275 return (coding->head_ascii);
6279 /* Return the number of characters at the source if all the bytes are
6280 valid UTF-8 (of Unicode range). Otherwise, return -1. By side
6281 effects, update coding->eol_seen. The value of coding->eol_seen is
6282 "logical or" of EOL_SEEN_LF, EOL_SEEN_CR, and EOL_SEEN_CRLF, but
6283 the value is reliable only when all the source bytes are valid
6284 UTF-8. */
6286 static int
6287 check_utf_8 (struct coding_system *coding)
6289 const unsigned char *src, *end;
6290 int eol_seen;
6291 int nchars = coding->head_ascii;
6293 if (coding->head_ascii < 0)
6294 check_ascii (coding);
6295 else
6296 coding_set_source (coding);
6297 src = coding->source + coding->head_ascii;
6298 /* We look ahead one byte for CR LF. */
6299 end = coding->source + coding->src_bytes - 1;
6300 eol_seen = coding->eol_seen;
6301 while (src < end)
6303 int c = *src;
6305 if (UTF_8_1_OCTET_P (*src))
6307 src++;
6308 if (c < 0x20)
6310 if (c == '\r')
6312 if (*src == '\n')
6314 eol_seen |= EOL_SEEN_CRLF;
6315 src++;
6316 nchars++;
6318 else
6319 eol_seen |= EOL_SEEN_CR;
6321 else if (c == '\n')
6322 eol_seen |= EOL_SEEN_LF;
6325 else if (UTF_8_2_OCTET_LEADING_P (c))
6327 if (c < 0xC2 /* overlong sequence */
6328 || src + 1 >= end
6329 || ! UTF_8_EXTRA_OCTET_P (src[1]))
6330 return -1;
6331 src += 2;
6333 else if (UTF_8_3_OCTET_LEADING_P (c))
6335 if (src + 2 >= end
6336 || ! (UTF_8_EXTRA_OCTET_P (src[1])
6337 && UTF_8_EXTRA_OCTET_P (src[2])))
6338 return -1;
6339 c = (((c & 0xF) << 12)
6340 | ((src[1] & 0x3F) << 6) | (src[2] & 0x3F));
6341 if (c < 0x800 /* overlong sequence */
6342 || (c >= 0xd800 && c < 0xe000)) /* surrogates (invalid) */
6343 return -1;
6344 src += 3;
6346 else if (UTF_8_4_OCTET_LEADING_P (c))
6348 if (src + 3 >= end
6349 || ! (UTF_8_EXTRA_OCTET_P (src[1])
6350 && UTF_8_EXTRA_OCTET_P (src[2])
6351 && UTF_8_EXTRA_OCTET_P (src[3])))
6352 return -1;
6353 c = (((c & 0x7) << 18) | ((src[1] & 0x3F) << 12)
6354 | ((src[2] & 0x3F) << 6) | (src[3] & 0x3F));
6355 if (c < 0x10000 /* overlong sequence */
6356 || c >= 0x110000) /* non-Unicode character */
6357 return -1;
6358 src += 4;
6360 else
6361 return -1;
6362 nchars++;
6365 if (src == end)
6367 if (! UTF_8_1_OCTET_P (*src))
6368 return -1;
6369 nchars++;
6370 if (*src == '\r')
6371 eol_seen |= EOL_SEEN_CR;
6372 else if (*src == '\n')
6373 eol_seen |= EOL_SEEN_LF;
6375 coding->eol_seen = eol_seen;
6376 return nchars;
6380 /* Detect how end-of-line of a text of length SRC_BYTES pointed by
6381 SOURCE is encoded. If CATEGORY is one of
6382 coding_category_utf_16_XXXX, assume that CR and LF are encoded by
6383 two-byte, else they are encoded by one-byte.
6385 Return one of EOL_SEEN_XXX. */
6387 #define MAX_EOL_CHECK_COUNT 3
6389 static int
6390 detect_eol (const unsigned char *source, ptrdiff_t src_bytes,
6391 enum coding_category category)
6393 const unsigned char *src = source, *src_end = src + src_bytes;
6394 unsigned char c;
6395 int total = 0;
6396 int eol_seen = EOL_SEEN_NONE;
6398 if ((1 << category) & CATEGORY_MASK_UTF_16)
6400 bool msb = category == (coding_category_utf_16_le
6401 | coding_category_utf_16_le_nosig);
6402 bool lsb = !msb;
6404 while (src + 1 < src_end)
6406 c = src[lsb];
6407 if (src[msb] == 0 && (c == '\n' || c == '\r'))
6409 int this_eol;
6411 if (c == '\n')
6412 this_eol = EOL_SEEN_LF;
6413 else if (src + 3 >= src_end
6414 || src[msb + 2] != 0
6415 || src[lsb + 2] != '\n')
6416 this_eol = EOL_SEEN_CR;
6417 else
6419 this_eol = EOL_SEEN_CRLF;
6420 src += 2;
6423 if (eol_seen == EOL_SEEN_NONE)
6424 /* This is the first end-of-line. */
6425 eol_seen = this_eol;
6426 else if (eol_seen != this_eol)
6428 /* The found type is different from what found before.
6429 Allow for stray ^M characters in DOS EOL files. */
6430 if ((eol_seen == EOL_SEEN_CR && this_eol == EOL_SEEN_CRLF)
6431 || (eol_seen == EOL_SEEN_CRLF
6432 && this_eol == EOL_SEEN_CR))
6433 eol_seen = EOL_SEEN_CRLF;
6434 else
6436 eol_seen = EOL_SEEN_LF;
6437 break;
6440 if (++total == MAX_EOL_CHECK_COUNT)
6441 break;
6443 src += 2;
6446 else
6447 while (src < src_end)
6449 c = *src++;
6450 if (c == '\n' || c == '\r')
6452 int this_eol;
6454 if (c == '\n')
6455 this_eol = EOL_SEEN_LF;
6456 else if (src >= src_end || *src != '\n')
6457 this_eol = EOL_SEEN_CR;
6458 else
6459 this_eol = EOL_SEEN_CRLF, src++;
6461 if (eol_seen == EOL_SEEN_NONE)
6462 /* This is the first end-of-line. */
6463 eol_seen = this_eol;
6464 else if (eol_seen != this_eol)
6466 /* The found type is different from what found before.
6467 Allow for stray ^M characters in DOS EOL files. */
6468 if ((eol_seen == EOL_SEEN_CR && this_eol == EOL_SEEN_CRLF)
6469 || (eol_seen == EOL_SEEN_CRLF && this_eol == EOL_SEEN_CR))
6470 eol_seen = EOL_SEEN_CRLF;
6471 else
6473 eol_seen = EOL_SEEN_LF;
6474 break;
6477 if (++total == MAX_EOL_CHECK_COUNT)
6478 break;
6481 return eol_seen;
6485 static Lisp_Object
6486 adjust_coding_eol_type (struct coding_system *coding, int eol_seen)
6488 Lisp_Object eol_type;
6490 eol_type = CODING_ID_EOL_TYPE (coding->id);
6491 if (! VECTORP (eol_type))
6492 /* Already adjusted. */
6493 return eol_type;
6494 if (eol_seen & EOL_SEEN_LF)
6496 coding->id = CODING_SYSTEM_ID (AREF (eol_type, 0));
6497 eol_type = Qunix;
6499 else if (eol_seen & EOL_SEEN_CRLF)
6501 coding->id = CODING_SYSTEM_ID (AREF (eol_type, 1));
6502 eol_type = Qdos;
6504 else if (eol_seen & EOL_SEEN_CR)
6506 coding->id = CODING_SYSTEM_ID (AREF (eol_type, 2));
6507 eol_type = Qmac;
6509 return eol_type;
6512 /* Detect how a text specified in CODING is encoded. If a coding
6513 system is detected, update fields of CODING by the detected coding
6514 system. */
6516 static void
6517 detect_coding (struct coding_system *coding)
6519 const unsigned char *src, *src_end;
6520 unsigned int saved_mode = coding->mode;
6521 Lisp_Object found = Qnil;
6522 Lisp_Object eol_type = CODING_ID_EOL_TYPE (coding->id);
6524 coding->consumed = coding->consumed_char = 0;
6525 coding->produced = coding->produced_char = 0;
6526 coding_set_source (coding);
6528 src_end = coding->source + coding->src_bytes;
6530 coding->eol_seen = EOL_SEEN_NONE;
6531 /* If we have not yet decided the text encoding type, detect it
6532 now. */
6533 if (EQ (CODING_ATTR_TYPE (CODING_ID_ATTRS (coding->id)), Qundecided))
6535 int c, i;
6536 struct coding_detection_info detect_info;
6537 bool null_byte_found = 0, eight_bit_found = 0;
6538 bool inhibit_nbd = inhibit_flag (coding->spec.undecided.inhibit_nbd,
6539 inhibit_null_byte_detection);
6540 bool inhibit_ied = inhibit_flag (coding->spec.undecided.inhibit_ied,
6541 inhibit_iso_escape_detection);
6542 bool prefer_utf_8 = coding->spec.undecided.prefer_utf_8;
6544 coding->head_ascii = 0;
6545 detect_info.checked = detect_info.found = detect_info.rejected = 0;
6546 for (src = coding->source; src < src_end; src++)
6548 c = *src;
6549 if (c & 0x80)
6551 eight_bit_found = 1;
6552 if (null_byte_found)
6553 break;
6555 else if (c < 0x20)
6557 if ((c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
6558 && ! inhibit_ied
6559 && ! detect_info.checked)
6561 if (detect_coding_iso_2022 (coding, &detect_info))
6563 /* We have scanned the whole data. */
6564 if (! (detect_info.rejected & CATEGORY_MASK_ISO_7_ELSE))
6566 /* We didn't find an 8-bit code. We may
6567 have found a null-byte, but it's very
6568 rare that a binary file conforms to
6569 ISO-2022. */
6570 src = src_end;
6571 coding->head_ascii = src - coding->source;
6573 detect_info.rejected |= ~CATEGORY_MASK_ISO_ESCAPE;
6574 break;
6577 else if (! c && !inhibit_nbd)
6579 null_byte_found = 1;
6580 if (eight_bit_found)
6581 break;
6583 else if (! disable_ascii_optimization
6584 && ! inhibit_eol_conversion)
6586 if (c == '\r')
6588 if (src < src_end && src[1] == '\n')
6590 coding->eol_seen |= EOL_SEEN_CRLF;
6591 src++;
6592 if (! eight_bit_found)
6593 coding->head_ascii++;
6595 else
6596 coding->eol_seen |= EOL_SEEN_CR;
6598 else if (c == '\n')
6600 coding->eol_seen |= EOL_SEEN_LF;
6604 if (! eight_bit_found)
6605 coding->head_ascii++;
6607 else if (! eight_bit_found)
6608 coding->head_ascii++;
6611 if (null_byte_found || eight_bit_found
6612 || coding->head_ascii < coding->src_bytes
6613 || detect_info.found)
6615 enum coding_category category;
6616 struct coding_system *this;
6618 if (coding->head_ascii == coding->src_bytes)
6619 /* As all bytes are 7-bit, we can ignore non-ISO-2022 codings. */
6620 for (i = 0; i < coding_category_raw_text; i++)
6622 category = coding_priorities[i];
6623 this = coding_categories + category;
6624 if (detect_info.found & (1 << category))
6625 break;
6627 else
6629 if (null_byte_found)
6631 detect_info.checked |= ~CATEGORY_MASK_UTF_16;
6632 detect_info.rejected |= ~CATEGORY_MASK_UTF_16;
6634 else if (prefer_utf_8
6635 && detect_coding_utf_8 (coding, &detect_info))
6637 detect_info.checked |= ~CATEGORY_MASK_UTF_8;
6638 detect_info.rejected |= ~CATEGORY_MASK_UTF_8;
6640 for (i = 0; i < coding_category_raw_text; i++)
6642 category = coding_priorities[i];
6643 this = coding_categories + category;
6644 /* Some of this->detector (e.g. detect_coding_sjis)
6645 require this information. */
6646 coding->id = this->id;
6647 if (this->id < 0)
6649 /* No coding system of this category is defined. */
6650 detect_info.rejected |= (1 << category);
6652 else if (category >= coding_category_raw_text)
6653 continue;
6654 else if (detect_info.checked & (1 << category))
6656 if (detect_info.found & (1 << category))
6657 break;
6659 else if ((*(this->detector)) (coding, &detect_info)
6660 && detect_info.found & (1 << category))
6661 break;
6665 if (i < coding_category_raw_text)
6667 if (category == coding_category_utf_8_auto)
6669 Lisp_Object coding_systems;
6671 coding_systems = AREF (CODING_ID_ATTRS (this->id),
6672 coding_attr_utf_bom);
6673 if (CONSP (coding_systems))
6675 if (detect_info.found & CATEGORY_MASK_UTF_8_SIG)
6676 found = XCAR (coding_systems);
6677 else
6678 found = XCDR (coding_systems);
6680 else
6681 found = CODING_ID_NAME (this->id);
6683 else if (category == coding_category_utf_16_auto)
6685 Lisp_Object coding_systems;
6687 coding_systems = AREF (CODING_ID_ATTRS (this->id),
6688 coding_attr_utf_bom);
6689 if (CONSP (coding_systems))
6691 if (detect_info.found & CATEGORY_MASK_UTF_16_LE)
6692 found = XCAR (coding_systems);
6693 else if (detect_info.found & CATEGORY_MASK_UTF_16_BE)
6694 found = XCDR (coding_systems);
6696 else
6697 found = CODING_ID_NAME (this->id);
6699 else
6700 found = CODING_ID_NAME (this->id);
6702 else if (null_byte_found)
6703 found = Qno_conversion;
6704 else if ((detect_info.rejected & CATEGORY_MASK_ANY)
6705 == CATEGORY_MASK_ANY)
6706 found = Qraw_text;
6707 else if (detect_info.rejected)
6708 for (i = 0; i < coding_category_raw_text; i++)
6709 if (! (detect_info.rejected & (1 << coding_priorities[i])))
6711 this = coding_categories + coding_priorities[i];
6712 found = CODING_ID_NAME (this->id);
6713 break;
6717 else if (XINT (CODING_ATTR_CATEGORY (CODING_ID_ATTRS (coding->id)))
6718 == coding_category_utf_8_auto)
6720 Lisp_Object coding_systems;
6721 struct coding_detection_info detect_info;
6723 coding_systems
6724 = AREF (CODING_ID_ATTRS (coding->id), coding_attr_utf_bom);
6725 detect_info.found = detect_info.rejected = 0;
6726 if (check_ascii (coding) == coding->src_bytes)
6728 if (CONSP (coding_systems))
6729 found = XCDR (coding_systems);
6731 else
6733 if (CONSP (coding_systems)
6734 && detect_coding_utf_8 (coding, &detect_info))
6736 if (detect_info.found & CATEGORY_MASK_UTF_8_SIG)
6737 found = XCAR (coding_systems);
6738 else
6739 found = XCDR (coding_systems);
6743 else if (XINT (CODING_ATTR_CATEGORY (CODING_ID_ATTRS (coding->id)))
6744 == coding_category_utf_16_auto)
6746 Lisp_Object coding_systems;
6747 struct coding_detection_info detect_info;
6749 coding_systems
6750 = AREF (CODING_ID_ATTRS (coding->id), coding_attr_utf_bom);
6751 detect_info.found = detect_info.rejected = 0;
6752 coding->head_ascii = 0;
6753 if (CONSP (coding_systems)
6754 && detect_coding_utf_16 (coding, &detect_info))
6756 if (detect_info.found & CATEGORY_MASK_UTF_16_LE)
6757 found = XCAR (coding_systems);
6758 else if (detect_info.found & CATEGORY_MASK_UTF_16_BE)
6759 found = XCDR (coding_systems);
6763 if (! NILP (found))
6765 int specified_eol = (VECTORP (eol_type) ? EOL_SEEN_NONE
6766 : EQ (eol_type, Qdos) ? EOL_SEEN_CRLF
6767 : EQ (eol_type, Qmac) ? EOL_SEEN_CR
6768 : EOL_SEEN_LF);
6770 setup_coding_system (found, coding);
6771 if (specified_eol != EOL_SEEN_NONE)
6772 adjust_coding_eol_type (coding, specified_eol);
6775 coding->mode = saved_mode;
6779 static void
6780 decode_eol (struct coding_system *coding)
6782 Lisp_Object eol_type;
6783 unsigned char *p, *pbeg, *pend;
6785 eol_type = CODING_ID_EOL_TYPE (coding->id);
6786 if (EQ (eol_type, Qunix) || inhibit_eol_conversion)
6787 return;
6789 if (NILP (coding->dst_object))
6790 pbeg = coding->destination;
6791 else
6792 pbeg = BYTE_POS_ADDR (coding->dst_pos_byte);
6793 pend = pbeg + coding->produced;
6795 if (VECTORP (eol_type))
6797 int eol_seen = EOL_SEEN_NONE;
6799 for (p = pbeg; p < pend; p++)
6801 if (*p == '\n')
6802 eol_seen |= EOL_SEEN_LF;
6803 else if (*p == '\r')
6805 if (p + 1 < pend && *(p + 1) == '\n')
6807 eol_seen |= EOL_SEEN_CRLF;
6808 p++;
6810 else
6811 eol_seen |= EOL_SEEN_CR;
6814 /* Handle DOS-style EOLs in a file with stray ^M characters. */
6815 if ((eol_seen & EOL_SEEN_CRLF) != 0
6816 && (eol_seen & EOL_SEEN_CR) != 0
6817 && (eol_seen & EOL_SEEN_LF) == 0)
6818 eol_seen = EOL_SEEN_CRLF;
6819 else if (eol_seen != EOL_SEEN_NONE
6820 && eol_seen != EOL_SEEN_LF
6821 && eol_seen != EOL_SEEN_CRLF
6822 && eol_seen != EOL_SEEN_CR)
6823 eol_seen = EOL_SEEN_LF;
6824 if (eol_seen != EOL_SEEN_NONE)
6825 eol_type = adjust_coding_eol_type (coding, eol_seen);
6828 if (EQ (eol_type, Qmac))
6830 for (p = pbeg; p < pend; p++)
6831 if (*p == '\r')
6832 *p = '\n';
6834 else if (EQ (eol_type, Qdos))
6836 ptrdiff_t n = 0;
6838 if (NILP (coding->dst_object))
6840 /* Start deleting '\r' from the tail to minimize the memory
6841 movement. */
6842 for (p = pend - 2; p >= pbeg; p--)
6843 if (*p == '\r')
6845 memmove (p, p + 1, pend-- - p - 1);
6846 n++;
6849 else
6851 ptrdiff_t pos_byte = coding->dst_pos_byte;
6852 ptrdiff_t pos = coding->dst_pos;
6853 ptrdiff_t pos_end = pos + coding->produced_char - 1;
6855 while (pos < pos_end)
6857 p = BYTE_POS_ADDR (pos_byte);
6858 if (*p == '\r' && p[1] == '\n')
6860 del_range_2 (pos, pos_byte, pos + 1, pos_byte + 1, 0);
6861 n++;
6862 pos_end--;
6864 pos++;
6865 if (coding->dst_multibyte)
6866 pos_byte += BYTES_BY_CHAR_HEAD (*p);
6867 else
6868 pos_byte++;
6871 coding->produced -= n;
6872 coding->produced_char -= n;
6877 /* Return a translation table (or list of them) from coding system
6878 attribute vector ATTRS for encoding (if ENCODEP) or decoding (if
6879 not ENCODEP). */
6881 static Lisp_Object
6882 get_translation_table (Lisp_Object attrs, bool encodep, int *max_lookup)
6884 Lisp_Object standard, translation_table;
6885 Lisp_Object val;
6887 if (NILP (Venable_character_translation))
6889 if (max_lookup)
6890 *max_lookup = 0;
6891 return Qnil;
6893 if (encodep)
6894 translation_table = CODING_ATTR_ENCODE_TBL (attrs),
6895 standard = Vstandard_translation_table_for_encode;
6896 else
6897 translation_table = CODING_ATTR_DECODE_TBL (attrs),
6898 standard = Vstandard_translation_table_for_decode;
6899 if (NILP (translation_table))
6900 translation_table = standard;
6901 else
6903 if (SYMBOLP (translation_table))
6904 translation_table = Fget (translation_table, Qtranslation_table);
6905 else if (CONSP (translation_table))
6907 translation_table = Fcopy_sequence (translation_table);
6908 for (val = translation_table; CONSP (val); val = XCDR (val))
6909 if (SYMBOLP (XCAR (val)))
6910 XSETCAR (val, Fget (XCAR (val), Qtranslation_table));
6912 if (CHAR_TABLE_P (standard))
6914 if (CONSP (translation_table))
6915 translation_table = nconc2 (translation_table, list1 (standard));
6916 else
6917 translation_table = list2 (translation_table, standard);
6921 if (max_lookup)
6923 *max_lookup = 1;
6924 if (CHAR_TABLE_P (translation_table)
6925 && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (translation_table)) > 1)
6927 val = XCHAR_TABLE (translation_table)->extras[1];
6928 if (NATNUMP (val) && *max_lookup < XFASTINT (val))
6929 *max_lookup = XFASTINT (val);
6931 else if (CONSP (translation_table))
6933 Lisp_Object tail;
6935 for (tail = translation_table; CONSP (tail); tail = XCDR (tail))
6936 if (CHAR_TABLE_P (XCAR (tail))
6937 && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (XCAR (tail))) > 1)
6939 Lisp_Object tailval = XCHAR_TABLE (XCAR (tail))->extras[1];
6940 if (NATNUMP (tailval) && *max_lookup < XFASTINT (tailval))
6941 *max_lookup = XFASTINT (tailval);
6945 return translation_table;
6948 #define LOOKUP_TRANSLATION_TABLE(table, c, trans) \
6949 do { \
6950 trans = Qnil; \
6951 if (CHAR_TABLE_P (table)) \
6953 trans = CHAR_TABLE_REF (table, c); \
6954 if (CHARACTERP (trans)) \
6955 c = XFASTINT (trans), trans = Qnil; \
6957 else if (CONSP (table)) \
6959 Lisp_Object tail; \
6961 for (tail = table; CONSP (tail); tail = XCDR (tail)) \
6962 if (CHAR_TABLE_P (XCAR (tail))) \
6964 trans = CHAR_TABLE_REF (XCAR (tail), c); \
6965 if (CHARACTERP (trans)) \
6966 c = XFASTINT (trans), trans = Qnil; \
6967 else if (! NILP (trans)) \
6968 break; \
6971 } while (0)
6974 /* Return a translation of character(s) at BUF according to TRANS.
6975 TRANS is TO-CHAR or ((FROM . TO) ...) where
6976 FROM = [FROM-CHAR ...], TO is TO-CHAR or [TO-CHAR ...].
6977 The return value is TO-CHAR or ([FROM-CHAR ...] . TO) if a
6978 translation is found, and Qnil if not found..
6979 If BUF is too short to lookup characters in FROM, return Qt. */
6981 static Lisp_Object
6982 get_translation (Lisp_Object trans, int *buf, int *buf_end)
6985 if (INTEGERP (trans))
6986 return trans;
6987 for (; CONSP (trans); trans = XCDR (trans))
6989 Lisp_Object val = XCAR (trans);
6990 Lisp_Object from = XCAR (val);
6991 ptrdiff_t len = ASIZE (from);
6992 ptrdiff_t i;
6994 for (i = 0; i < len; i++)
6996 if (buf + i == buf_end)
6997 return Qt;
6998 if (XINT (AREF (from, i)) != buf[i])
6999 break;
7001 if (i == len)
7002 return val;
7004 return Qnil;
7008 static int
7009 produce_chars (struct coding_system *coding, Lisp_Object translation_table,
7010 bool last_block)
7012 unsigned char *dst = coding->destination + coding->produced;
7013 unsigned char *dst_end = coding->destination + coding->dst_bytes;
7014 ptrdiff_t produced;
7015 ptrdiff_t produced_chars = 0;
7016 int carryover = 0;
7018 if (! coding->chars_at_source)
7020 /* Source characters are in coding->charbuf. */
7021 int *buf = coding->charbuf;
7022 int *buf_end = buf + coding->charbuf_used;
7024 if (EQ (coding->src_object, coding->dst_object))
7026 coding_set_source (coding);
7027 dst_end = ((unsigned char *) coding->source) + coding->consumed;
7030 while (buf < buf_end)
7032 int c = *buf;
7033 ptrdiff_t i;
7035 if (c >= 0)
7037 ptrdiff_t from_nchars = 1, to_nchars = 1;
7038 Lisp_Object trans = Qnil;
7040 LOOKUP_TRANSLATION_TABLE (translation_table, c, trans);
7041 if (! NILP (trans))
7043 trans = get_translation (trans, buf, buf_end);
7044 if (INTEGERP (trans))
7045 c = XINT (trans);
7046 else if (CONSP (trans))
7048 from_nchars = ASIZE (XCAR (trans));
7049 trans = XCDR (trans);
7050 if (INTEGERP (trans))
7051 c = XINT (trans);
7052 else
7054 to_nchars = ASIZE (trans);
7055 c = XINT (AREF (trans, 0));
7058 else if (EQ (trans, Qt) && ! last_block)
7059 break;
7062 if ((dst_end - dst) / MAX_MULTIBYTE_LENGTH < to_nchars)
7064 if (((min (PTRDIFF_MAX, SIZE_MAX) - (buf_end - buf))
7065 / MAX_MULTIBYTE_LENGTH)
7066 < to_nchars)
7067 memory_full (SIZE_MAX);
7068 dst = alloc_destination (coding,
7069 buf_end - buf
7070 + MAX_MULTIBYTE_LENGTH * to_nchars,
7071 dst);
7072 if (EQ (coding->src_object, coding->dst_object))
7074 coding_set_source (coding);
7075 dst_end = (((unsigned char *) coding->source)
7076 + coding->consumed);
7078 else
7079 dst_end = coding->destination + coding->dst_bytes;
7082 for (i = 0; i < to_nchars; i++)
7084 if (i > 0)
7085 c = XINT (AREF (trans, i));
7086 if (coding->dst_multibyte
7087 || ! CHAR_BYTE8_P (c))
7088 CHAR_STRING_ADVANCE_NO_UNIFY (c, dst);
7089 else
7090 *dst++ = CHAR_TO_BYTE8 (c);
7092 produced_chars += to_nchars;
7093 buf += from_nchars;
7095 else
7096 /* This is an annotation datum. (-C) is the length. */
7097 buf += -c;
7099 carryover = buf_end - buf;
7101 else
7103 /* Source characters are at coding->source. */
7104 const unsigned char *src = coding->source;
7105 const unsigned char *src_end = src + coding->consumed;
7107 if (EQ (coding->dst_object, coding->src_object))
7108 dst_end = (unsigned char *) src;
7109 if (coding->src_multibyte != coding->dst_multibyte)
7111 if (coding->src_multibyte)
7113 bool multibytep = 1;
7114 ptrdiff_t consumed_chars = 0;
7116 while (1)
7118 const unsigned char *src_base = src;
7119 int c;
7121 ONE_MORE_BYTE (c);
7122 if (dst == dst_end)
7124 if (EQ (coding->src_object, coding->dst_object))
7125 dst_end = (unsigned char *) src;
7126 if (dst == dst_end)
7128 ptrdiff_t offset = src - coding->source;
7130 dst = alloc_destination (coding, src_end - src + 1,
7131 dst);
7132 dst_end = coding->destination + coding->dst_bytes;
7133 coding_set_source (coding);
7134 src = coding->source + offset;
7135 src_end = coding->source + coding->consumed;
7136 if (EQ (coding->src_object, coding->dst_object))
7137 dst_end = (unsigned char *) src;
7140 *dst++ = c;
7141 produced_chars++;
7143 no_more_source:
7146 else
7147 while (src < src_end)
7149 bool multibytep = 1;
7150 int c = *src++;
7152 if (dst >= dst_end - 1)
7154 if (EQ (coding->src_object, coding->dst_object))
7155 dst_end = (unsigned char *) src;
7156 if (dst >= dst_end - 1)
7158 ptrdiff_t offset = src - coding->source;
7159 ptrdiff_t more_bytes;
7161 if (EQ (coding->src_object, coding->dst_object))
7162 more_bytes = ((src_end - src) / 2) + 2;
7163 else
7164 more_bytes = src_end - src + 2;
7165 dst = alloc_destination (coding, more_bytes, dst);
7166 dst_end = coding->destination + coding->dst_bytes;
7167 coding_set_source (coding);
7168 src = coding->source + offset;
7169 src_end = coding->source + coding->consumed;
7170 if (EQ (coding->src_object, coding->dst_object))
7171 dst_end = (unsigned char *) src;
7174 EMIT_ONE_BYTE (c);
7177 else
7179 if (!EQ (coding->src_object, coding->dst_object))
7181 ptrdiff_t require = coding->src_bytes - coding->dst_bytes;
7183 if (require > 0)
7185 ptrdiff_t offset = src - coding->source;
7187 dst = alloc_destination (coding, require, dst);
7188 coding_set_source (coding);
7189 src = coding->source + offset;
7190 src_end = coding->source + coding->consumed;
7193 produced_chars = coding->consumed_char;
7194 while (src < src_end)
7195 *dst++ = *src++;
7199 produced = dst - (coding->destination + coding->produced);
7200 if (BUFFERP (coding->dst_object) && produced_chars > 0)
7201 insert_from_gap (produced_chars, produced, 0);
7202 coding->produced += produced;
7203 coding->produced_char += produced_chars;
7204 return carryover;
7207 /* Compose text in CODING->object according to the annotation data at
7208 CHARBUF. CHARBUF is an array:
7209 [ -LENGTH ANNOTATION_MASK NCHARS NBYTES METHOD [ COMPONENTS... ] ]
7212 static void
7213 produce_composition (struct coding_system *coding, int *charbuf, ptrdiff_t pos)
7215 int len;
7216 ptrdiff_t to;
7217 enum composition_method method;
7218 Lisp_Object components;
7220 len = -charbuf[0] - MAX_ANNOTATION_LENGTH;
7221 to = pos + charbuf[2];
7222 method = (enum composition_method) (charbuf[4]);
7224 if (method == COMPOSITION_RELATIVE)
7225 components = Qnil;
7226 else
7228 Lisp_Object args[MAX_COMPOSITION_COMPONENTS * 2 - 1];
7229 int i, j;
7231 if (method == COMPOSITION_WITH_RULE)
7232 len = charbuf[2] * 3 - 2;
7233 charbuf += MAX_ANNOTATION_LENGTH;
7234 /* charbuf = [ CHRA ... CHAR] or [ CHAR -2 RULE ... CHAR ] */
7235 for (i = j = 0; i < len && charbuf[i] != -1; i++, j++)
7237 if (charbuf[i] >= 0)
7238 args[j] = make_number (charbuf[i]);
7239 else
7241 i++;
7242 args[j] = make_number (charbuf[i] % 0x100);
7245 components = (i == j ? Fstring (j, args) : Fvector (j, args));
7247 compose_text (pos, to, components, Qnil, coding->dst_object);
7251 /* Put `charset' property on text in CODING->object according to
7252 the annotation data at CHARBUF. CHARBUF is an array:
7253 [ -LENGTH ANNOTATION_MASK NCHARS CHARSET-ID ]
7256 static void
7257 produce_charset (struct coding_system *coding, int *charbuf, ptrdiff_t pos)
7259 ptrdiff_t from = pos - charbuf[2];
7260 struct charset *charset = CHARSET_FROM_ID (charbuf[3]);
7262 Fput_text_property (make_number (from), make_number (pos),
7263 Qcharset, CHARSET_NAME (charset),
7264 coding->dst_object);
7268 #define CHARBUF_SIZE 0x4000
7270 #define ALLOC_CONVERSION_WORK_AREA(coding) \
7271 do { \
7272 coding->charbuf = SAFE_ALLOCA (CHARBUF_SIZE * sizeof (int)); \
7273 coding->charbuf_size = CHARBUF_SIZE; \
7274 } while (0)
7277 static void
7278 produce_annotation (struct coding_system *coding, ptrdiff_t pos)
7280 int *charbuf = coding->charbuf;
7281 int *charbuf_end = charbuf + coding->charbuf_used;
7283 if (NILP (coding->dst_object))
7284 return;
7286 while (charbuf < charbuf_end)
7288 if (*charbuf >= 0)
7289 pos++, charbuf++;
7290 else
7292 int len = -*charbuf;
7294 if (len > 2)
7295 switch (charbuf[1])
7297 case CODING_ANNOTATE_COMPOSITION_MASK:
7298 produce_composition (coding, charbuf, pos);
7299 break;
7300 case CODING_ANNOTATE_CHARSET_MASK:
7301 produce_charset (coding, charbuf, pos);
7302 break;
7304 charbuf += len;
7309 /* Decode the data at CODING->src_object into CODING->dst_object.
7310 CODING->src_object is a buffer, a string, or nil.
7311 CODING->dst_object is a buffer.
7313 If CODING->src_object is a buffer, it must be the current buffer.
7314 In this case, if CODING->src_pos is positive, it is a position of
7315 the source text in the buffer, otherwise, the source text is in the
7316 gap area of the buffer, and CODING->src_pos specifies the offset of
7317 the text from GPT (which must be the same as PT). If this is the
7318 same buffer as CODING->dst_object, CODING->src_pos must be
7319 negative.
7321 If CODING->src_object is a string, CODING->src_pos is an index to
7322 that string.
7324 If CODING->src_object is nil, CODING->source must already point to
7325 the non-relocatable memory area. In this case, CODING->src_pos is
7326 an offset from CODING->source.
7328 The decoded data is inserted at the current point of the buffer
7329 CODING->dst_object.
7332 static void
7333 decode_coding (struct coding_system *coding)
7335 Lisp_Object attrs;
7336 Lisp_Object undo_list;
7337 Lisp_Object translation_table;
7338 struct ccl_spec cclspec;
7339 int carryover;
7340 int i;
7342 USE_SAFE_ALLOCA;
7344 if (BUFFERP (coding->src_object)
7345 && coding->src_pos > 0
7346 && coding->src_pos < GPT
7347 && coding->src_pos + coding->src_chars > GPT)
7348 move_gap_both (coding->src_pos, coding->src_pos_byte);
7350 undo_list = Qt;
7351 if (BUFFERP (coding->dst_object))
7353 set_buffer_internal (XBUFFER (coding->dst_object));
7354 if (GPT != PT)
7355 move_gap_both (PT, PT_BYTE);
7357 /* We must disable undo_list in order to record the whole insert
7358 transaction via record_insert at the end. But doing so also
7359 disables the recording of the first change to the undo_list.
7360 Therefore we check for first change here and record it via
7361 record_first_change if needed. */
7362 if (MODIFF <= SAVE_MODIFF)
7363 record_first_change ();
7365 undo_list = BVAR (current_buffer, undo_list);
7366 bset_undo_list (current_buffer, Qt);
7369 coding->consumed = coding->consumed_char = 0;
7370 coding->produced = coding->produced_char = 0;
7371 coding->chars_at_source = 0;
7372 record_conversion_result (coding, CODING_RESULT_SUCCESS);
7373 coding->errors = 0;
7375 ALLOC_CONVERSION_WORK_AREA (coding);
7377 attrs = CODING_ID_ATTRS (coding->id);
7378 translation_table = get_translation_table (attrs, 0, NULL);
7380 carryover = 0;
7381 if (coding->decoder == decode_coding_ccl)
7383 coding->spec.ccl = &cclspec;
7384 setup_ccl_program (&cclspec.ccl, CODING_CCL_DECODER (coding));
7388 ptrdiff_t pos = coding->dst_pos + coding->produced_char;
7390 coding_set_source (coding);
7391 coding->annotated = 0;
7392 coding->charbuf_used = carryover;
7393 (*(coding->decoder)) (coding);
7394 coding_set_destination (coding);
7395 carryover = produce_chars (coding, translation_table, 0);
7396 if (coding->annotated)
7397 produce_annotation (coding, pos);
7398 for (i = 0; i < carryover; i++)
7399 coding->charbuf[i]
7400 = coding->charbuf[coding->charbuf_used - carryover + i];
7402 while (coding->result == CODING_RESULT_INSUFFICIENT_DST
7403 || (coding->consumed < coding->src_bytes
7404 && (coding->result == CODING_RESULT_SUCCESS
7405 || coding->result == CODING_RESULT_INVALID_SRC)));
7407 if (carryover > 0)
7409 coding_set_destination (coding);
7410 coding->charbuf_used = carryover;
7411 produce_chars (coding, translation_table, 1);
7414 coding->carryover_bytes = 0;
7415 if (coding->consumed < coding->src_bytes)
7417 int nbytes = coding->src_bytes - coding->consumed;
7418 const unsigned char *src;
7420 coding_set_source (coding);
7421 coding_set_destination (coding);
7422 src = coding->source + coding->consumed;
7424 if (coding->mode & CODING_MODE_LAST_BLOCK)
7426 /* Flush out unprocessed data as binary chars. We are sure
7427 that the number of data is less than the size of
7428 coding->charbuf. */
7429 coding->charbuf_used = 0;
7430 coding->chars_at_source = 0;
7432 while (nbytes-- > 0)
7434 int c = *src++;
7436 if (c & 0x80)
7437 c = BYTE8_TO_CHAR (c);
7438 coding->charbuf[coding->charbuf_used++] = c;
7440 produce_chars (coding, Qnil, 1);
7442 else
7444 /* Record unprocessed bytes in coding->carryover. We are
7445 sure that the number of data is less than the size of
7446 coding->carryover. */
7447 unsigned char *p = coding->carryover;
7449 if (nbytes > sizeof coding->carryover)
7450 nbytes = sizeof coding->carryover;
7451 coding->carryover_bytes = nbytes;
7452 while (nbytes-- > 0)
7453 *p++ = *src++;
7455 coding->consumed = coding->src_bytes;
7458 if (! EQ (CODING_ID_EOL_TYPE (coding->id), Qunix)
7459 && !inhibit_eol_conversion)
7460 decode_eol (coding);
7461 if (BUFFERP (coding->dst_object))
7463 bset_undo_list (current_buffer, undo_list);
7464 record_insert (coding->dst_pos, coding->produced_char);
7467 SAFE_FREE ();
7471 /* Extract an annotation datum from a composition starting at POS and
7472 ending before LIMIT of CODING->src_object (buffer or string), store
7473 the data in BUF, set *STOP to a starting position of the next
7474 composition (if any) or to LIMIT, and return the address of the
7475 next element of BUF.
7477 If such an annotation is not found, set *STOP to a starting
7478 position of a composition after POS (if any) or to LIMIT, and
7479 return BUF. */
7481 static int *
7482 handle_composition_annotation (ptrdiff_t pos, ptrdiff_t limit,
7483 struct coding_system *coding, int *buf,
7484 ptrdiff_t *stop)
7486 ptrdiff_t start, end;
7487 Lisp_Object prop;
7489 if (! find_composition (pos, limit, &start, &end, &prop, coding->src_object)
7490 || end > limit)
7491 *stop = limit;
7492 else if (start > pos)
7493 *stop = start;
7494 else
7496 if (start == pos)
7498 /* We found a composition. Store the corresponding
7499 annotation data in BUF. */
7500 int *head = buf;
7501 enum composition_method method = composition_method (prop);
7502 int nchars = COMPOSITION_LENGTH (prop);
7504 ADD_COMPOSITION_DATA (buf, nchars, 0, method);
7505 if (method != COMPOSITION_RELATIVE)
7507 Lisp_Object components;
7508 ptrdiff_t i, len, i_byte;
7510 components = COMPOSITION_COMPONENTS (prop);
7511 if (VECTORP (components))
7513 len = ASIZE (components);
7514 for (i = 0; i < len; i++)
7515 *buf++ = XINT (AREF (components, i));
7517 else if (STRINGP (components))
7519 len = SCHARS (components);
7520 i = i_byte = 0;
7521 while (i < len)
7523 FETCH_STRING_CHAR_ADVANCE (*buf, components, i, i_byte);
7524 buf++;
7527 else if (INTEGERP (components))
7529 len = 1;
7530 *buf++ = XINT (components);
7532 else if (CONSP (components))
7534 for (len = 0; CONSP (components);
7535 len++, components = XCDR (components))
7536 *buf++ = XINT (XCAR (components));
7538 else
7539 emacs_abort ();
7540 *head -= len;
7544 if (find_composition (end, limit, &start, &end, &prop,
7545 coding->src_object)
7546 && end <= limit)
7547 *stop = start;
7548 else
7549 *stop = limit;
7551 return buf;
7555 /* Extract an annotation datum from a text property `charset' at POS of
7556 CODING->src_object (buffer of string), store the data in BUF, set
7557 *STOP to the position where the value of `charset' property changes
7558 (limiting by LIMIT), and return the address of the next element of
7559 BUF.
7561 If the property value is nil, set *STOP to the position where the
7562 property value is non-nil (limiting by LIMIT), and return BUF. */
7564 static int *
7565 handle_charset_annotation (ptrdiff_t pos, ptrdiff_t limit,
7566 struct coding_system *coding, int *buf,
7567 ptrdiff_t *stop)
7569 Lisp_Object val, next;
7570 int id;
7572 val = Fget_text_property (make_number (pos), Qcharset, coding->src_object);
7573 if (! NILP (val) && CHARSETP (val))
7574 id = XINT (CHARSET_SYMBOL_ID (val));
7575 else
7576 id = -1;
7577 ADD_CHARSET_DATA (buf, 0, id);
7578 next = Fnext_single_property_change (make_number (pos), Qcharset,
7579 coding->src_object,
7580 make_number (limit));
7581 *stop = XINT (next);
7582 return buf;
7586 static void
7587 consume_chars (struct coding_system *coding, Lisp_Object translation_table,
7588 int max_lookup)
7590 int *buf = coding->charbuf;
7591 int *buf_end = coding->charbuf + coding->charbuf_size;
7592 const unsigned char *src = coding->source + coding->consumed;
7593 const unsigned char *src_end = coding->source + coding->src_bytes;
7594 ptrdiff_t pos = coding->src_pos + coding->consumed_char;
7595 ptrdiff_t end_pos = coding->src_pos + coding->src_chars;
7596 bool multibytep = coding->src_multibyte;
7597 Lisp_Object eol_type;
7598 int c;
7599 ptrdiff_t stop, stop_composition, stop_charset;
7600 int *lookup_buf = NULL;
7602 if (! NILP (translation_table))
7603 lookup_buf = alloca (sizeof (int) * max_lookup);
7605 eol_type = inhibit_eol_conversion ? Qunix : CODING_ID_EOL_TYPE (coding->id);
7606 if (VECTORP (eol_type))
7607 eol_type = Qunix;
7609 /* Note: composition handling is not yet implemented. */
7610 coding->common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
7612 if (NILP (coding->src_object))
7613 stop = stop_composition = stop_charset = end_pos;
7614 else
7616 if (coding->common_flags & CODING_ANNOTATE_COMPOSITION_MASK)
7617 stop = stop_composition = pos;
7618 else
7619 stop = stop_composition = end_pos;
7620 if (coding->common_flags & CODING_ANNOTATE_CHARSET_MASK)
7621 stop = stop_charset = pos;
7622 else
7623 stop_charset = end_pos;
7626 /* Compensate for CRLF and conversion. */
7627 buf_end -= 1 + MAX_ANNOTATION_LENGTH;
7628 while (buf < buf_end)
7630 Lisp_Object trans;
7632 if (pos == stop)
7634 if (pos == end_pos)
7635 break;
7636 if (pos == stop_composition)
7637 buf = handle_composition_annotation (pos, end_pos, coding,
7638 buf, &stop_composition);
7639 if (pos == stop_charset)
7640 buf = handle_charset_annotation (pos, end_pos, coding,
7641 buf, &stop_charset);
7642 stop = (stop_composition < stop_charset
7643 ? stop_composition : stop_charset);
7646 if (! multibytep)
7648 int bytes;
7650 if (coding->encoder == encode_coding_raw_text
7651 || coding->encoder == encode_coding_ccl)
7652 c = *src++, pos++;
7653 else if ((bytes = MULTIBYTE_LENGTH (src, src_end)) > 0)
7654 c = STRING_CHAR_ADVANCE_NO_UNIFY (src), pos += bytes;
7655 else
7656 c = BYTE8_TO_CHAR (*src), src++, pos++;
7658 else
7659 c = STRING_CHAR_ADVANCE_NO_UNIFY (src), pos++;
7660 if ((c == '\r') && (coding->mode & CODING_MODE_SELECTIVE_DISPLAY))
7661 c = '\n';
7662 if (! EQ (eol_type, Qunix))
7664 if (c == '\n')
7666 if (EQ (eol_type, Qdos))
7667 *buf++ = '\r';
7668 else
7669 c = '\r';
7673 trans = Qnil;
7674 LOOKUP_TRANSLATION_TABLE (translation_table, c, trans);
7675 if (NILP (trans))
7676 *buf++ = c;
7677 else
7679 ptrdiff_t from_nchars = 1, to_nchars = 1;
7680 int *lookup_buf_end;
7681 const unsigned char *p = src;
7682 int i;
7684 lookup_buf[0] = c;
7685 for (i = 1; i < max_lookup && p < src_end; i++)
7686 lookup_buf[i] = STRING_CHAR_ADVANCE (p);
7687 lookup_buf_end = lookup_buf + i;
7688 trans = get_translation (trans, lookup_buf, lookup_buf_end);
7689 if (INTEGERP (trans))
7690 c = XINT (trans);
7691 else if (CONSP (trans))
7693 from_nchars = ASIZE (XCAR (trans));
7694 trans = XCDR (trans);
7695 if (INTEGERP (trans))
7696 c = XINT (trans);
7697 else
7699 to_nchars = ASIZE (trans);
7700 if (buf_end - buf < to_nchars)
7701 break;
7702 c = XINT (AREF (trans, 0));
7705 else
7706 break;
7707 *buf++ = c;
7708 for (i = 1; i < to_nchars; i++)
7709 *buf++ = XINT (AREF (trans, i));
7710 for (i = 1; i < from_nchars; i++, pos++)
7711 src += MULTIBYTE_LENGTH_NO_CHECK (src);
7715 coding->consumed = src - coding->source;
7716 coding->consumed_char = pos - coding->src_pos;
7717 coding->charbuf_used = buf - coding->charbuf;
7718 coding->chars_at_source = 0;
7722 /* Encode the text at CODING->src_object into CODING->dst_object.
7723 CODING->src_object is a buffer or a string.
7724 CODING->dst_object is a buffer or nil.
7726 If CODING->src_object is a buffer, it must be the current buffer.
7727 In this case, if CODING->src_pos is positive, it is a position of
7728 the source text in the buffer, otherwise. the source text is in the
7729 gap area of the buffer, and coding->src_pos specifies the offset of
7730 the text from GPT (which must be the same as PT). If this is the
7731 same buffer as CODING->dst_object, CODING->src_pos must be
7732 negative and CODING should not have `pre-write-conversion'.
7734 If CODING->src_object is a string, CODING should not have
7735 `pre-write-conversion'.
7737 If CODING->dst_object is a buffer, the encoded data is inserted at
7738 the current point of that buffer.
7740 If CODING->dst_object is nil, the encoded data is placed at the
7741 memory area specified by CODING->destination. */
7743 static void
7744 encode_coding (struct coding_system *coding)
7746 Lisp_Object attrs;
7747 Lisp_Object translation_table;
7748 int max_lookup;
7749 struct ccl_spec cclspec;
7751 USE_SAFE_ALLOCA;
7753 attrs = CODING_ID_ATTRS (coding->id);
7754 if (coding->encoder == encode_coding_raw_text)
7755 translation_table = Qnil, max_lookup = 0;
7756 else
7757 translation_table = get_translation_table (attrs, 1, &max_lookup);
7759 if (BUFFERP (coding->dst_object))
7761 set_buffer_internal (XBUFFER (coding->dst_object));
7762 coding->dst_multibyte
7763 = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
7766 coding->consumed = coding->consumed_char = 0;
7767 coding->produced = coding->produced_char = 0;
7768 record_conversion_result (coding, CODING_RESULT_SUCCESS);
7769 coding->errors = 0;
7771 ALLOC_CONVERSION_WORK_AREA (coding);
7773 if (coding->encoder == encode_coding_ccl)
7775 coding->spec.ccl = &cclspec;
7776 setup_ccl_program (&cclspec.ccl, CODING_CCL_ENCODER (coding));
7778 do {
7779 coding_set_source (coding);
7780 consume_chars (coding, translation_table, max_lookup);
7781 coding_set_destination (coding);
7782 (*(coding->encoder)) (coding);
7783 } while (coding->consumed_char < coding->src_chars);
7785 if (BUFFERP (coding->dst_object) && coding->produced_char > 0)
7786 insert_from_gap (coding->produced_char, coding->produced, 0);
7788 SAFE_FREE ();
7792 /* Name (or base name) of work buffer for code conversion. */
7793 static Lisp_Object Vcode_conversion_workbuf_name;
7795 /* A working buffer used by the top level conversion. Once it is
7796 created, it is never destroyed. It has the name
7797 Vcode_conversion_workbuf_name. The other working buffers are
7798 destroyed after the use is finished, and their names are modified
7799 versions of Vcode_conversion_workbuf_name. */
7800 static Lisp_Object Vcode_conversion_reused_workbuf;
7802 /* True iff Vcode_conversion_reused_workbuf is already in use. */
7803 static bool reused_workbuf_in_use;
7806 /* Return a working buffer of code conversion. MULTIBYTE specifies the
7807 multibyteness of returning buffer. */
7809 static Lisp_Object
7810 make_conversion_work_buffer (bool multibyte)
7812 Lisp_Object name, workbuf;
7813 struct buffer *current;
7815 if (reused_workbuf_in_use)
7817 name = Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name, Qnil);
7818 workbuf = Fget_buffer_create (name);
7820 else
7822 reused_workbuf_in_use = 1;
7823 if (NILP (Fbuffer_live_p (Vcode_conversion_reused_workbuf)))
7824 Vcode_conversion_reused_workbuf
7825 = Fget_buffer_create (Vcode_conversion_workbuf_name);
7826 workbuf = Vcode_conversion_reused_workbuf;
7828 current = current_buffer;
7829 set_buffer_internal (XBUFFER (workbuf));
7830 /* We can't allow modification hooks to run in the work buffer. For
7831 instance, directory_files_internal assumes that file decoding
7832 doesn't compile new regexps. */
7833 Fset (Fmake_local_variable (Qinhibit_modification_hooks), Qt);
7834 Ferase_buffer ();
7835 bset_undo_list (current_buffer, Qt);
7836 bset_enable_multibyte_characters (current_buffer, multibyte ? Qt : Qnil);
7837 set_buffer_internal (current);
7838 return workbuf;
7842 static void
7843 code_conversion_restore (Lisp_Object arg)
7845 Lisp_Object current, workbuf;
7846 struct gcpro gcpro1;
7848 GCPRO1 (arg);
7849 current = XCAR (arg);
7850 workbuf = XCDR (arg);
7851 if (! NILP (workbuf))
7853 if (EQ (workbuf, Vcode_conversion_reused_workbuf))
7854 reused_workbuf_in_use = 0;
7855 else
7856 Fkill_buffer (workbuf);
7858 set_buffer_internal (XBUFFER (current));
7859 UNGCPRO;
7862 Lisp_Object
7863 code_conversion_save (bool with_work_buf, bool multibyte)
7865 Lisp_Object workbuf = Qnil;
7867 if (with_work_buf)
7868 workbuf = make_conversion_work_buffer (multibyte);
7869 record_unwind_protect (code_conversion_restore,
7870 Fcons (Fcurrent_buffer (), workbuf));
7871 return workbuf;
7874 void
7875 decode_coding_gap (struct coding_system *coding,
7876 ptrdiff_t chars, ptrdiff_t bytes)
7878 ptrdiff_t count = SPECPDL_INDEX ();
7879 Lisp_Object attrs;
7881 coding->src_object = Fcurrent_buffer ();
7882 coding->src_chars = chars;
7883 coding->src_bytes = bytes;
7884 coding->src_pos = -chars;
7885 coding->src_pos_byte = -bytes;
7886 coding->src_multibyte = chars < bytes;
7887 coding->dst_object = coding->src_object;
7888 coding->dst_pos = PT;
7889 coding->dst_pos_byte = PT_BYTE;
7890 coding->dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
7892 coding->head_ascii = -1;
7893 coding->detected_utf8_chars = -1;
7894 coding->eol_seen = EOL_SEEN_NONE;
7895 if (CODING_REQUIRE_DETECTION (coding))
7896 detect_coding (coding);
7897 attrs = CODING_ID_ATTRS (coding->id);
7898 if (! disable_ascii_optimization
7899 && ! coding->src_multibyte
7900 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs))
7901 && NILP (CODING_ATTR_POST_READ (attrs))
7902 && NILP (get_translation_table (attrs, 0, NULL)))
7904 chars = coding->head_ascii;
7905 if (chars < 0)
7906 chars = check_ascii (coding);
7907 if (chars != bytes)
7909 /* There exists a non-ASCII byte. */
7910 if (EQ (CODING_ATTR_TYPE (attrs), Qutf_8))
7912 if (coding->detected_utf8_chars >= 0)
7913 chars = coding->detected_utf8_chars;
7914 else
7915 chars = check_utf_8 (coding);
7916 if (CODING_UTF_8_BOM (coding) != utf_without_bom
7917 && coding->head_ascii == 0
7918 && coding->source[0] == UTF_8_BOM_1
7919 && coding->source[1] == UTF_8_BOM_2
7920 && coding->source[2] == UTF_8_BOM_3)
7922 chars--;
7923 bytes -= 3;
7924 coding->src_bytes -= 3;
7927 else
7928 chars = -1;
7930 if (chars >= 0)
7932 Lisp_Object eol_type;
7934 eol_type = CODING_ID_EOL_TYPE (coding->id);
7935 if (VECTORP (eol_type))
7937 if (coding->eol_seen != EOL_SEEN_NONE)
7938 eol_type = adjust_coding_eol_type (coding, coding->eol_seen);
7940 if (EQ (eol_type, Qmac))
7942 unsigned char *src_end = GAP_END_ADDR;
7943 unsigned char *src = src_end - coding->src_bytes;
7945 while (src < src_end)
7947 if (*src++ == '\r')
7948 src[-1] = '\n';
7951 else if (EQ (eol_type, Qdos))
7953 unsigned char *src = GAP_END_ADDR;
7954 unsigned char *src_beg = src - coding->src_bytes;
7955 unsigned char *dst = src;
7956 ptrdiff_t diff;
7958 while (src_beg < src)
7960 *--dst = *--src;
7961 if (*src == '\n' && src > src_beg && src[-1] == '\r')
7962 src--;
7964 diff = dst - src;
7965 bytes -= diff;
7966 chars -= diff;
7968 coding->produced = bytes;
7969 coding->produced_char = chars;
7970 insert_from_gap (chars, bytes, 1);
7971 return;
7974 code_conversion_save (0, 0);
7976 coding->mode |= CODING_MODE_LAST_BLOCK;
7977 current_buffer->text->inhibit_shrinking = 1;
7978 decode_coding (coding);
7979 current_buffer->text->inhibit_shrinking = 0;
7981 if (! NILP (CODING_ATTR_POST_READ (attrs)))
7983 ptrdiff_t prev_Z = Z, prev_Z_BYTE = Z_BYTE;
7984 Lisp_Object val;
7986 TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
7987 val = call1 (CODING_ATTR_POST_READ (attrs),
7988 make_number (coding->produced_char));
7989 CHECK_NATNUM (val);
7990 coding->produced_char += Z - prev_Z;
7991 coding->produced += Z_BYTE - prev_Z_BYTE;
7994 unbind_to (count, Qnil);
7998 /* Decode the text in the range FROM/FROM_BYTE and TO/TO_BYTE in
7999 SRC_OBJECT into DST_OBJECT by coding context CODING.
8001 SRC_OBJECT is a buffer, a string, or Qnil.
8003 If it is a buffer, the text is at point of the buffer. FROM and TO
8004 are positions in the buffer.
8006 If it is a string, the text is at the beginning of the string.
8007 FROM and TO are indices to the string.
8009 If it is nil, the text is at coding->source. FROM and TO are
8010 indices to coding->source.
8012 DST_OBJECT is a buffer, Qt, or Qnil.
8014 If it is a buffer, the decoded text is inserted at point of the
8015 buffer. If the buffer is the same as SRC_OBJECT, the source text
8016 is deleted.
8018 If it is Qt, a string is made from the decoded text, and
8019 set in CODING->dst_object.
8021 If it is Qnil, the decoded text is stored at CODING->destination.
8022 The caller must allocate CODING->dst_bytes bytes at
8023 CODING->destination by xmalloc. If the decoded text is longer than
8024 CODING->dst_bytes, CODING->destination is relocated by xrealloc.
8027 void
8028 decode_coding_object (struct coding_system *coding,
8029 Lisp_Object src_object,
8030 ptrdiff_t from, ptrdiff_t from_byte,
8031 ptrdiff_t to, ptrdiff_t to_byte,
8032 Lisp_Object dst_object)
8034 ptrdiff_t count = SPECPDL_INDEX ();
8035 unsigned char *destination IF_LINT (= NULL);
8036 ptrdiff_t dst_bytes IF_LINT (= 0);
8037 ptrdiff_t chars = to - from;
8038 ptrdiff_t bytes = to_byte - from_byte;
8039 Lisp_Object attrs;
8040 ptrdiff_t saved_pt = -1, saved_pt_byte IF_LINT (= 0);
8041 bool need_marker_adjustment = 0;
8042 Lisp_Object old_deactivate_mark;
8044 old_deactivate_mark = Vdeactivate_mark;
8046 if (NILP (dst_object))
8048 destination = coding->destination;
8049 dst_bytes = coding->dst_bytes;
8052 coding->src_object = src_object;
8053 coding->src_chars = chars;
8054 coding->src_bytes = bytes;
8055 coding->src_multibyte = chars < bytes;
8057 if (STRINGP (src_object))
8059 coding->src_pos = from;
8060 coding->src_pos_byte = from_byte;
8062 else if (BUFFERP (src_object))
8064 set_buffer_internal (XBUFFER (src_object));
8065 if (from != GPT)
8066 move_gap_both (from, from_byte);
8067 if (EQ (src_object, dst_object))
8069 struct Lisp_Marker *tail;
8071 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
8073 tail->need_adjustment
8074 = tail->charpos == (tail->insertion_type ? from : to);
8075 need_marker_adjustment |= tail->need_adjustment;
8077 saved_pt = PT, saved_pt_byte = PT_BYTE;
8078 TEMP_SET_PT_BOTH (from, from_byte);
8079 current_buffer->text->inhibit_shrinking = 1;
8080 del_range_both (from, from_byte, to, to_byte, 1);
8081 coding->src_pos = -chars;
8082 coding->src_pos_byte = -bytes;
8084 else
8086 coding->src_pos = from;
8087 coding->src_pos_byte = from_byte;
8091 if (CODING_REQUIRE_DETECTION (coding))
8092 detect_coding (coding);
8093 attrs = CODING_ID_ATTRS (coding->id);
8095 if (EQ (dst_object, Qt)
8096 || (! NILP (CODING_ATTR_POST_READ (attrs))
8097 && NILP (dst_object)))
8099 coding->dst_multibyte = !CODING_FOR_UNIBYTE (coding);
8100 coding->dst_object = code_conversion_save (1, coding->dst_multibyte);
8101 coding->dst_pos = BEG;
8102 coding->dst_pos_byte = BEG_BYTE;
8104 else if (BUFFERP (dst_object))
8106 code_conversion_save (0, 0);
8107 coding->dst_object = dst_object;
8108 coding->dst_pos = BUF_PT (XBUFFER (dst_object));
8109 coding->dst_pos_byte = BUF_PT_BYTE (XBUFFER (dst_object));
8110 coding->dst_multibyte
8111 = ! NILP (BVAR (XBUFFER (dst_object), enable_multibyte_characters));
8113 else
8115 code_conversion_save (0, 0);
8116 coding->dst_object = Qnil;
8117 /* Most callers presume this will return a multibyte result, and they
8118 won't use `binary' or `raw-text' anyway, so let's not worry about
8119 CODING_FOR_UNIBYTE. */
8120 coding->dst_multibyte = 1;
8123 decode_coding (coding);
8125 if (BUFFERP (coding->dst_object))
8126 set_buffer_internal (XBUFFER (coding->dst_object));
8128 if (! NILP (CODING_ATTR_POST_READ (attrs)))
8130 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
8131 ptrdiff_t prev_Z = Z, prev_Z_BYTE = Z_BYTE;
8132 Lisp_Object val;
8134 TEMP_SET_PT_BOTH (coding->dst_pos, coding->dst_pos_byte);
8135 GCPRO5 (coding->src_object, coding->dst_object, src_object, dst_object,
8136 old_deactivate_mark);
8137 val = safe_call1 (CODING_ATTR_POST_READ (attrs),
8138 make_number (coding->produced_char));
8139 UNGCPRO;
8140 CHECK_NATNUM (val);
8141 coding->produced_char += Z - prev_Z;
8142 coding->produced += Z_BYTE - prev_Z_BYTE;
8145 if (EQ (dst_object, Qt))
8147 coding->dst_object = Fbuffer_string ();
8149 else if (NILP (dst_object) && BUFFERP (coding->dst_object))
8151 set_buffer_internal (XBUFFER (coding->dst_object));
8152 if (dst_bytes < coding->produced)
8154 eassert (coding->produced > 0);
8155 destination = xrealloc (destination, coding->produced);
8156 if (BEGV < GPT && GPT < BEGV + coding->produced_char)
8157 move_gap_both (BEGV, BEGV_BYTE);
8158 memcpy (destination, BEGV_ADDR, coding->produced);
8159 coding->destination = destination;
8163 if (saved_pt >= 0)
8165 /* This is the case of:
8166 (BUFFERP (src_object) && EQ (src_object, dst_object))
8167 As we have moved PT while replacing the original buffer
8168 contents, we must recover it now. */
8169 set_buffer_internal (XBUFFER (src_object));
8170 current_buffer->text->inhibit_shrinking = 0;
8171 if (saved_pt < from)
8172 TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte);
8173 else if (saved_pt < from + chars)
8174 TEMP_SET_PT_BOTH (from, from_byte);
8175 else if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
8176 TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars),
8177 saved_pt_byte + (coding->produced - bytes));
8178 else
8179 TEMP_SET_PT_BOTH (saved_pt + (coding->produced - bytes),
8180 saved_pt_byte + (coding->produced - bytes));
8182 if (need_marker_adjustment)
8184 struct Lisp_Marker *tail;
8186 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
8187 if (tail->need_adjustment)
8189 tail->need_adjustment = 0;
8190 if (tail->insertion_type)
8192 tail->bytepos = from_byte;
8193 tail->charpos = from;
8195 else
8197 tail->bytepos = from_byte + coding->produced;
8198 tail->charpos
8199 = (NILP (BVAR (current_buffer, enable_multibyte_characters))
8200 ? tail->bytepos : from + coding->produced_char);
8206 Vdeactivate_mark = old_deactivate_mark;
8207 unbind_to (count, coding->dst_object);
8211 void
8212 encode_coding_object (struct coding_system *coding,
8213 Lisp_Object src_object,
8214 ptrdiff_t from, ptrdiff_t from_byte,
8215 ptrdiff_t to, ptrdiff_t to_byte,
8216 Lisp_Object dst_object)
8218 ptrdiff_t count = SPECPDL_INDEX ();
8219 ptrdiff_t chars = to - from;
8220 ptrdiff_t bytes = to_byte - from_byte;
8221 Lisp_Object attrs;
8222 ptrdiff_t saved_pt = -1, saved_pt_byte IF_LINT (= 0);
8223 bool need_marker_adjustment = 0;
8224 bool kill_src_buffer = 0;
8225 Lisp_Object old_deactivate_mark;
8227 old_deactivate_mark = Vdeactivate_mark;
8229 coding->src_object = src_object;
8230 coding->src_chars = chars;
8231 coding->src_bytes = bytes;
8232 coding->src_multibyte = chars < bytes;
8234 attrs = CODING_ID_ATTRS (coding->id);
8236 if (EQ (src_object, dst_object))
8238 struct Lisp_Marker *tail;
8240 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
8242 tail->need_adjustment
8243 = tail->charpos == (tail->insertion_type ? from : to);
8244 need_marker_adjustment |= tail->need_adjustment;
8248 if (! NILP (CODING_ATTR_PRE_WRITE (attrs)))
8250 coding->src_object = code_conversion_save (1, coding->src_multibyte);
8251 set_buffer_internal (XBUFFER (coding->src_object));
8252 if (STRINGP (src_object))
8253 insert_from_string (src_object, from, from_byte, chars, bytes, 0);
8254 else if (BUFFERP (src_object))
8255 insert_from_buffer (XBUFFER (src_object), from, chars, 0);
8256 else
8257 insert_1_both ((char *) coding->source + from, chars, bytes, 0, 0, 0);
8259 if (EQ (src_object, dst_object))
8261 set_buffer_internal (XBUFFER (src_object));
8262 saved_pt = PT, saved_pt_byte = PT_BYTE;
8263 del_range_both (from, from_byte, to, to_byte, 1);
8264 set_buffer_internal (XBUFFER (coding->src_object));
8268 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
8270 GCPRO5 (coding->src_object, coding->dst_object, src_object, dst_object,
8271 old_deactivate_mark);
8272 safe_call2 (CODING_ATTR_PRE_WRITE (attrs),
8273 make_number (BEG), make_number (Z));
8274 UNGCPRO;
8276 if (XBUFFER (coding->src_object) != current_buffer)
8277 kill_src_buffer = 1;
8278 coding->src_object = Fcurrent_buffer ();
8279 if (BEG != GPT)
8280 move_gap_both (BEG, BEG_BYTE);
8281 coding->src_chars = Z - BEG;
8282 coding->src_bytes = Z_BYTE - BEG_BYTE;
8283 coding->src_pos = BEG;
8284 coding->src_pos_byte = BEG_BYTE;
8285 coding->src_multibyte = Z < Z_BYTE;
8287 else if (STRINGP (src_object))
8289 code_conversion_save (0, 0);
8290 coding->src_pos = from;
8291 coding->src_pos_byte = from_byte;
8293 else if (BUFFERP (src_object))
8295 code_conversion_save (0, 0);
8296 set_buffer_internal (XBUFFER (src_object));
8297 if (EQ (src_object, dst_object))
8299 saved_pt = PT, saved_pt_byte = PT_BYTE;
8300 coding->src_object = del_range_1 (from, to, 1, 1);
8301 coding->src_pos = 0;
8302 coding->src_pos_byte = 0;
8304 else
8306 if (from < GPT && to >= GPT)
8307 move_gap_both (from, from_byte);
8308 coding->src_pos = from;
8309 coding->src_pos_byte = from_byte;
8312 else
8313 code_conversion_save (0, 0);
8315 if (BUFFERP (dst_object))
8317 coding->dst_object = dst_object;
8318 if (EQ (src_object, dst_object))
8320 coding->dst_pos = from;
8321 coding->dst_pos_byte = from_byte;
8323 else
8325 struct buffer *current = current_buffer;
8327 set_buffer_temp (XBUFFER (dst_object));
8328 coding->dst_pos = PT;
8329 coding->dst_pos_byte = PT_BYTE;
8330 move_gap_both (coding->dst_pos, coding->dst_pos_byte);
8331 set_buffer_temp (current);
8333 coding->dst_multibyte
8334 = ! NILP (BVAR (XBUFFER (dst_object), enable_multibyte_characters));
8336 else if (EQ (dst_object, Qt))
8338 ptrdiff_t dst_bytes = max (1, coding->src_chars);
8339 coding->dst_object = Qnil;
8340 coding->destination = xmalloc (dst_bytes);
8341 coding->dst_bytes = dst_bytes;
8342 coding->dst_multibyte = 0;
8344 else
8346 coding->dst_object = Qnil;
8347 coding->dst_multibyte = 0;
8350 encode_coding (coding);
8352 if (EQ (dst_object, Qt))
8354 if (BUFFERP (coding->dst_object))
8355 coding->dst_object = Fbuffer_string ();
8356 else if (coding->raw_destination)
8357 /* This is used to avoid creating huge Lisp string.
8358 NOTE: caller who sets `raw_destination' is also
8359 responsible for freeing `destination' buffer. */
8360 coding->dst_object = Qnil;
8361 else
8363 coding->dst_object
8364 = make_unibyte_string ((char *) coding->destination,
8365 coding->produced);
8366 xfree (coding->destination);
8370 if (saved_pt >= 0)
8372 /* This is the case of:
8373 (BUFFERP (src_object) && EQ (src_object, dst_object))
8374 As we have moved PT while replacing the original buffer
8375 contents, we must recover it now. */
8376 set_buffer_internal (XBUFFER (src_object));
8377 if (saved_pt < from)
8378 TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte);
8379 else if (saved_pt < from + chars)
8380 TEMP_SET_PT_BOTH (from, from_byte);
8381 else if (! NILP (BVAR (current_buffer, enable_multibyte_characters)))
8382 TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars),
8383 saved_pt_byte + (coding->produced - bytes));
8384 else
8385 TEMP_SET_PT_BOTH (saved_pt + (coding->produced - bytes),
8386 saved_pt_byte + (coding->produced - bytes));
8388 if (need_marker_adjustment)
8390 struct Lisp_Marker *tail;
8392 for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next)
8393 if (tail->need_adjustment)
8395 tail->need_adjustment = 0;
8396 if (tail->insertion_type)
8398 tail->bytepos = from_byte;
8399 tail->charpos = from;
8401 else
8403 tail->bytepos = from_byte + coding->produced;
8404 tail->charpos
8405 = (NILP (BVAR (current_buffer, enable_multibyte_characters))
8406 ? tail->bytepos : from + coding->produced_char);
8412 if (kill_src_buffer)
8413 Fkill_buffer (coding->src_object);
8415 Vdeactivate_mark = old_deactivate_mark;
8416 unbind_to (count, Qnil);
8420 Lisp_Object
8421 preferred_coding_system (void)
8423 int id = coding_categories[coding_priorities[0]].id;
8425 return CODING_ID_NAME (id);
8428 #if defined (WINDOWSNT) || defined (CYGWIN)
8430 Lisp_Object
8431 from_unicode (Lisp_Object str)
8433 CHECK_STRING (str);
8434 if (!STRING_MULTIBYTE (str) &&
8435 SBYTES (str) & 1)
8437 str = Fsubstring (str, make_number (0), make_number (-1));
8440 return code_convert_string_norecord (str, Qutf_16le, 0);
8443 Lisp_Object
8444 from_unicode_buffer (const wchar_t* wstr)
8446 return from_unicode (
8447 make_unibyte_string (
8448 (char*) wstr,
8449 /* we get one of the two final 0 bytes for free. */
8450 1 + sizeof (wchar_t) * wcslen (wstr)));
8453 wchar_t *
8454 to_unicode (Lisp_Object str, Lisp_Object *buf)
8456 *buf = code_convert_string_norecord (str, Qutf_16le, 1);
8457 /* We need to make another copy (in addition to the one made by
8458 code_convert_string_norecord) to ensure that the final string is
8459 _doubly_ zero terminated --- that is, that the string is
8460 terminated by two zero bytes and one utf-16le null character.
8461 Because strings are already terminated with a single zero byte,
8462 we just add one additional zero. */
8463 str = make_uninit_string (SBYTES (*buf) + 1);
8464 memcpy (SDATA (str), SDATA (*buf), SBYTES (*buf));
8465 SDATA (str) [SBYTES (*buf)] = '\0';
8466 *buf = str;
8467 return WCSDATA (*buf);
8470 #endif /* WINDOWSNT || CYGWIN */
8473 #ifdef emacs
8474 /*** 8. Emacs Lisp library functions ***/
8476 DEFUN ("coding-system-p", Fcoding_system_p, Scoding_system_p, 1, 1, 0,
8477 doc: /* Return t if OBJECT is nil or a coding-system.
8478 See the documentation of `define-coding-system' for information
8479 about coding-system objects. */)
8480 (Lisp_Object object)
8482 if (NILP (object)
8483 || CODING_SYSTEM_ID (object) >= 0)
8484 return Qt;
8485 if (! SYMBOLP (object)
8486 || NILP (Fget (object, Qcoding_system_define_form)))
8487 return Qnil;
8488 return Qt;
8491 DEFUN ("read-non-nil-coding-system", Fread_non_nil_coding_system,
8492 Sread_non_nil_coding_system, 1, 1, 0,
8493 doc: /* Read a coding system from the minibuffer, prompting with string PROMPT. */)
8494 (Lisp_Object prompt)
8496 Lisp_Object val;
8499 val = Fcompleting_read (prompt, Vcoding_system_alist, Qnil,
8500 Qt, Qnil, Qcoding_system_history, Qnil, Qnil);
8502 while (SCHARS (val) == 0);
8503 return (Fintern (val, Qnil));
8506 DEFUN ("read-coding-system", Fread_coding_system, Sread_coding_system, 1, 2, 0,
8507 doc: /* Read a coding system from the minibuffer, prompting with string PROMPT.
8508 If the user enters null input, return second argument DEFAULT-CODING-SYSTEM.
8509 Ignores case when completing coding systems (all Emacs coding systems
8510 are lower-case). */)
8511 (Lisp_Object prompt, Lisp_Object default_coding_system)
8513 Lisp_Object val;
8514 ptrdiff_t count = SPECPDL_INDEX ();
8516 if (SYMBOLP (default_coding_system))
8517 default_coding_system = SYMBOL_NAME (default_coding_system);
8518 specbind (Qcompletion_ignore_case, Qt);
8519 val = Fcompleting_read (prompt, Vcoding_system_alist, Qnil,
8520 Qt, Qnil, Qcoding_system_history,
8521 default_coding_system, Qnil);
8522 unbind_to (count, Qnil);
8523 return (SCHARS (val) == 0 ? Qnil : Fintern (val, Qnil));
8526 DEFUN ("check-coding-system", Fcheck_coding_system, Scheck_coding_system,
8527 1, 1, 0,
8528 doc: /* Check validity of CODING-SYSTEM.
8529 If valid, return CODING-SYSTEM, else signal a `coding-system-error' error.
8530 It is valid if it is nil or a symbol defined as a coding system by the
8531 function `define-coding-system'. */)
8532 (Lisp_Object coding_system)
8534 Lisp_Object define_form;
8536 define_form = Fget (coding_system, Qcoding_system_define_form);
8537 if (! NILP (define_form))
8539 Fput (coding_system, Qcoding_system_define_form, Qnil);
8540 safe_eval (define_form);
8542 if (!NILP (Fcoding_system_p (coding_system)))
8543 return coding_system;
8544 xsignal1 (Qcoding_system_error, coding_system);
8548 /* Detect how the bytes at SRC of length SRC_BYTES are encoded. If
8549 HIGHEST, return the coding system of the highest
8550 priority among the detected coding systems. Otherwise return a
8551 list of detected coding systems sorted by their priorities. If
8552 MULTIBYTEP, it is assumed that the bytes are in correct
8553 multibyte form but contains only ASCII and eight-bit chars.
8554 Otherwise, the bytes are raw bytes.
8556 CODING-SYSTEM controls the detection as below:
8558 If it is nil, detect both text-format and eol-format. If the
8559 text-format part of CODING-SYSTEM is already specified
8560 (e.g. `iso-latin-1'), detect only eol-format. If the eol-format
8561 part of CODING-SYSTEM is already specified (e.g. `undecided-unix'),
8562 detect only text-format. */
8564 Lisp_Object
8565 detect_coding_system (const unsigned char *src,
8566 ptrdiff_t src_chars, ptrdiff_t src_bytes,
8567 bool highest, bool multibytep,
8568 Lisp_Object coding_system)
8570 const unsigned char *src_end = src + src_bytes;
8571 Lisp_Object attrs, eol_type;
8572 Lisp_Object val = Qnil;
8573 struct coding_system coding;
8574 ptrdiff_t id;
8575 struct coding_detection_info detect_info;
8576 enum coding_category base_category;
8577 bool null_byte_found = 0, eight_bit_found = 0;
8579 if (NILP (coding_system))
8580 coding_system = Qundecided;
8581 setup_coding_system (coding_system, &coding);
8582 attrs = CODING_ID_ATTRS (coding.id);
8583 eol_type = CODING_ID_EOL_TYPE (coding.id);
8584 coding_system = CODING_ATTR_BASE_NAME (attrs);
8586 coding.source = src;
8587 coding.src_chars = src_chars;
8588 coding.src_bytes = src_bytes;
8589 coding.src_multibyte = multibytep;
8590 coding.consumed = 0;
8591 coding.mode |= CODING_MODE_LAST_BLOCK;
8592 coding.head_ascii = 0;
8594 detect_info.checked = detect_info.found = detect_info.rejected = 0;
8596 /* At first, detect text-format if necessary. */
8597 base_category = XINT (CODING_ATTR_CATEGORY (attrs));
8598 if (base_category == coding_category_undecided)
8600 enum coding_category category IF_LINT (= 0);
8601 struct coding_system *this IF_LINT (= NULL);
8602 int c, i;
8603 bool inhibit_nbd = inhibit_flag (coding.spec.undecided.inhibit_nbd,
8604 inhibit_null_byte_detection);
8605 bool inhibit_ied = inhibit_flag (coding.spec.undecided.inhibit_ied,
8606 inhibit_iso_escape_detection);
8607 bool prefer_utf_8 = coding.spec.undecided.prefer_utf_8;
8609 /* Skip all ASCII bytes except for a few ISO2022 controls. */
8610 for (; src < src_end; src++)
8612 c = *src;
8613 if (c & 0x80)
8615 eight_bit_found = 1;
8616 if (null_byte_found)
8617 break;
8619 else if (c < 0x20)
8621 if ((c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
8622 && ! inhibit_ied
8623 && ! detect_info.checked)
8625 if (detect_coding_iso_2022 (&coding, &detect_info))
8627 /* We have scanned the whole data. */
8628 if (! (detect_info.rejected & CATEGORY_MASK_ISO_7_ELSE))
8630 /* We didn't find an 8-bit code. We may
8631 have found a null-byte, but it's very
8632 rare that a binary file confirm to
8633 ISO-2022. */
8634 src = src_end;
8635 coding.head_ascii = src - coding.source;
8637 detect_info.rejected |= ~CATEGORY_MASK_ISO_ESCAPE;
8638 break;
8641 else if (! c && !inhibit_nbd)
8643 null_byte_found = 1;
8644 if (eight_bit_found)
8645 break;
8647 if (! eight_bit_found)
8648 coding.head_ascii++;
8650 else if (! eight_bit_found)
8651 coding.head_ascii++;
8654 if (null_byte_found || eight_bit_found
8655 || coding.head_ascii < coding.src_bytes
8656 || detect_info.found)
8658 if (coding.head_ascii == coding.src_bytes)
8659 /* As all bytes are 7-bit, we can ignore non-ISO-2022 codings. */
8660 for (i = 0; i < coding_category_raw_text; i++)
8662 category = coding_priorities[i];
8663 this = coding_categories + category;
8664 if (detect_info.found & (1 << category))
8665 break;
8667 else
8669 if (null_byte_found)
8671 detect_info.checked |= ~CATEGORY_MASK_UTF_16;
8672 detect_info.rejected |= ~CATEGORY_MASK_UTF_16;
8674 else if (prefer_utf_8
8675 && detect_coding_utf_8 (&coding, &detect_info))
8677 detect_info.checked |= ~CATEGORY_MASK_UTF_8;
8678 detect_info.rejected |= ~CATEGORY_MASK_UTF_8;
8680 for (i = 0; i < coding_category_raw_text; i++)
8682 category = coding_priorities[i];
8683 this = coding_categories + category;
8685 if (this->id < 0)
8687 /* No coding system of this category is defined. */
8688 detect_info.rejected |= (1 << category);
8690 else if (category >= coding_category_raw_text)
8691 continue;
8692 else if (detect_info.checked & (1 << category))
8694 if (highest
8695 && (detect_info.found & (1 << category)))
8696 break;
8698 else if ((*(this->detector)) (&coding, &detect_info)
8699 && highest
8700 && (detect_info.found & (1 << category)))
8702 if (category == coding_category_utf_16_auto)
8704 if (detect_info.found & CATEGORY_MASK_UTF_16_LE)
8705 category = coding_category_utf_16_le;
8706 else
8707 category = coding_category_utf_16_be;
8709 break;
8715 if ((detect_info.rejected & CATEGORY_MASK_ANY) == CATEGORY_MASK_ANY
8716 || null_byte_found)
8718 detect_info.found = CATEGORY_MASK_RAW_TEXT;
8719 id = CODING_SYSTEM_ID (Qno_conversion);
8720 val = list1 (make_number (id));
8722 else if (! detect_info.rejected && ! detect_info.found)
8724 detect_info.found = CATEGORY_MASK_ANY;
8725 id = coding_categories[coding_category_undecided].id;
8726 val = list1 (make_number (id));
8728 else if (highest)
8730 if (detect_info.found)
8732 detect_info.found = 1 << category;
8733 val = list1 (make_number (this->id));
8735 else
8736 for (i = 0; i < coding_category_raw_text; i++)
8737 if (! (detect_info.rejected & (1 << coding_priorities[i])))
8739 detect_info.found = 1 << coding_priorities[i];
8740 id = coding_categories[coding_priorities[i]].id;
8741 val = list1 (make_number (id));
8742 break;
8745 else
8747 int mask = detect_info.rejected | detect_info.found;
8748 int found = 0;
8750 for (i = coding_category_raw_text - 1; i >= 0; i--)
8752 category = coding_priorities[i];
8753 if (! (mask & (1 << category)))
8755 found |= 1 << category;
8756 id = coding_categories[category].id;
8757 if (id >= 0)
8758 val = list1 (make_number (id));
8761 for (i = coding_category_raw_text - 1; i >= 0; i--)
8763 category = coding_priorities[i];
8764 if (detect_info.found & (1 << category))
8766 id = coding_categories[category].id;
8767 val = Fcons (make_number (id), val);
8770 detect_info.found |= found;
8773 else if (base_category == coding_category_utf_8_auto)
8775 if (detect_coding_utf_8 (&coding, &detect_info))
8777 struct coding_system *this;
8779 if (detect_info.found & CATEGORY_MASK_UTF_8_SIG)
8780 this = coding_categories + coding_category_utf_8_sig;
8781 else
8782 this = coding_categories + coding_category_utf_8_nosig;
8783 val = list1 (make_number (this->id));
8786 else if (base_category == coding_category_utf_16_auto)
8788 if (detect_coding_utf_16 (&coding, &detect_info))
8790 struct coding_system *this;
8792 if (detect_info.found & CATEGORY_MASK_UTF_16_LE)
8793 this = coding_categories + coding_category_utf_16_le;
8794 else if (detect_info.found & CATEGORY_MASK_UTF_16_BE)
8795 this = coding_categories + coding_category_utf_16_be;
8796 else if (detect_info.rejected & CATEGORY_MASK_UTF_16_LE_NOSIG)
8797 this = coding_categories + coding_category_utf_16_be_nosig;
8798 else
8799 this = coding_categories + coding_category_utf_16_le_nosig;
8800 val = list1 (make_number (this->id));
8803 else
8805 detect_info.found = 1 << XINT (CODING_ATTR_CATEGORY (attrs));
8806 val = list1 (make_number (coding.id));
8809 /* Then, detect eol-format if necessary. */
8811 int normal_eol = -1, utf_16_be_eol = -1, utf_16_le_eol = -1;
8812 Lisp_Object tail;
8814 if (VECTORP (eol_type))
8816 if (detect_info.found & ~CATEGORY_MASK_UTF_16)
8818 if (null_byte_found)
8819 normal_eol = EOL_SEEN_LF;
8820 else
8821 normal_eol = detect_eol (coding.source, src_bytes,
8822 coding_category_raw_text);
8824 if (detect_info.found & (CATEGORY_MASK_UTF_16_BE
8825 | CATEGORY_MASK_UTF_16_BE_NOSIG))
8826 utf_16_be_eol = detect_eol (coding.source, src_bytes,
8827 coding_category_utf_16_be);
8828 if (detect_info.found & (CATEGORY_MASK_UTF_16_LE
8829 | CATEGORY_MASK_UTF_16_LE_NOSIG))
8830 utf_16_le_eol = detect_eol (coding.source, src_bytes,
8831 coding_category_utf_16_le);
8833 else
8835 if (EQ (eol_type, Qunix))
8836 normal_eol = utf_16_be_eol = utf_16_le_eol = EOL_SEEN_LF;
8837 else if (EQ (eol_type, Qdos))
8838 normal_eol = utf_16_be_eol = utf_16_le_eol = EOL_SEEN_CRLF;
8839 else
8840 normal_eol = utf_16_be_eol = utf_16_le_eol = EOL_SEEN_CR;
8843 for (tail = val; CONSP (tail); tail = XCDR (tail))
8845 enum coding_category category;
8846 int this_eol;
8848 id = XINT (XCAR (tail));
8849 attrs = CODING_ID_ATTRS (id);
8850 category = XINT (CODING_ATTR_CATEGORY (attrs));
8851 eol_type = CODING_ID_EOL_TYPE (id);
8852 if (VECTORP (eol_type))
8854 if (category == coding_category_utf_16_be
8855 || category == coding_category_utf_16_be_nosig)
8856 this_eol = utf_16_be_eol;
8857 else if (category == coding_category_utf_16_le
8858 || category == coding_category_utf_16_le_nosig)
8859 this_eol = utf_16_le_eol;
8860 else
8861 this_eol = normal_eol;
8863 if (this_eol == EOL_SEEN_LF)
8864 XSETCAR (tail, AREF (eol_type, 0));
8865 else if (this_eol == EOL_SEEN_CRLF)
8866 XSETCAR (tail, AREF (eol_type, 1));
8867 else if (this_eol == EOL_SEEN_CR)
8868 XSETCAR (tail, AREF (eol_type, 2));
8869 else
8870 XSETCAR (tail, CODING_ID_NAME (id));
8872 else
8873 XSETCAR (tail, CODING_ID_NAME (id));
8877 return (highest ? (CONSP (val) ? XCAR (val) : Qnil) : val);
8881 DEFUN ("detect-coding-region", Fdetect_coding_region, Sdetect_coding_region,
8882 2, 3, 0,
8883 doc: /* Detect coding system of the text in the region between START and END.
8884 Return a list of possible coding systems ordered by priority.
8885 The coding systems to try and their priorities follows what
8886 the function `coding-system-priority-list' (which see) returns.
8888 If only ASCII characters are found (except for such ISO-2022 control
8889 characters as ESC), it returns a list of single element `undecided'
8890 or its subsidiary coding system according to a detected end-of-line
8891 format.
8893 If optional argument HIGHEST is non-nil, return the coding system of
8894 highest priority. */)
8895 (Lisp_Object start, Lisp_Object end, Lisp_Object highest)
8897 ptrdiff_t from, to;
8898 ptrdiff_t from_byte, to_byte;
8900 validate_region (&start, &end);
8901 from = XINT (start), to = XINT (end);
8902 from_byte = CHAR_TO_BYTE (from);
8903 to_byte = CHAR_TO_BYTE (to);
8905 if (from < GPT && to >= GPT)
8906 move_gap_both (to, to_byte);
8908 return detect_coding_system (BYTE_POS_ADDR (from_byte),
8909 to - from, to_byte - from_byte,
8910 !NILP (highest),
8911 !NILP (BVAR (current_buffer
8912 , enable_multibyte_characters)),
8913 Qnil);
8916 DEFUN ("detect-coding-string", Fdetect_coding_string, Sdetect_coding_string,
8917 1, 2, 0,
8918 doc: /* Detect coding system of the text in STRING.
8919 Return a list of possible coding systems ordered by priority.
8920 The coding systems to try and their priorities follows what
8921 the function `coding-system-priority-list' (which see) returns.
8923 If only ASCII characters are found (except for such ISO-2022 control
8924 characters as ESC), it returns a list of single element `undecided'
8925 or its subsidiary coding system according to a detected end-of-line
8926 format.
8928 If optional argument HIGHEST is non-nil, return the coding system of
8929 highest priority. */)
8930 (Lisp_Object string, Lisp_Object highest)
8932 CHECK_STRING (string);
8934 return detect_coding_system (SDATA (string),
8935 SCHARS (string), SBYTES (string),
8936 !NILP (highest), STRING_MULTIBYTE (string),
8937 Qnil);
8941 static bool
8942 char_encodable_p (int c, Lisp_Object attrs)
8944 Lisp_Object tail;
8945 struct charset *charset;
8946 Lisp_Object translation_table;
8948 translation_table = CODING_ATTR_TRANS_TBL (attrs);
8949 if (! NILP (translation_table))
8950 c = translate_char (translation_table, c);
8951 for (tail = CODING_ATTR_CHARSET_LIST (attrs);
8952 CONSP (tail); tail = XCDR (tail))
8954 charset = CHARSET_FROM_ID (XINT (XCAR (tail)));
8955 if (CHAR_CHARSET_P (c, charset))
8956 break;
8958 return (! NILP (tail));
8962 /* Return a list of coding systems that safely encode the text between
8963 START and END. If EXCLUDE is non-nil, it is a list of coding
8964 systems not to check. The returned list doesn't contain any such
8965 coding systems. In any case, if the text contains only ASCII or is
8966 unibyte, return t. */
8968 DEFUN ("find-coding-systems-region-internal",
8969 Ffind_coding_systems_region_internal,
8970 Sfind_coding_systems_region_internal, 2, 3, 0,
8971 doc: /* Internal use only. */)
8972 (Lisp_Object start, Lisp_Object end, Lisp_Object exclude)
8974 Lisp_Object coding_attrs_list, safe_codings;
8975 ptrdiff_t start_byte, end_byte;
8976 const unsigned char *p, *pbeg, *pend;
8977 int c;
8978 Lisp_Object tail, elt, work_table;
8980 if (STRINGP (start))
8982 if (!STRING_MULTIBYTE (start)
8983 || SCHARS (start) == SBYTES (start))
8984 return Qt;
8985 start_byte = 0;
8986 end_byte = SBYTES (start);
8988 else
8990 CHECK_NUMBER_COERCE_MARKER (start);
8991 CHECK_NUMBER_COERCE_MARKER (end);
8992 if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end))
8993 args_out_of_range (start, end);
8994 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
8995 return Qt;
8996 start_byte = CHAR_TO_BYTE (XINT (start));
8997 end_byte = CHAR_TO_BYTE (XINT (end));
8998 if (XINT (end) - XINT (start) == end_byte - start_byte)
8999 return Qt;
9001 if (XINT (start) < GPT && XINT (end) > GPT)
9003 if ((GPT - XINT (start)) < (XINT (end) - GPT))
9004 move_gap_both (XINT (start), start_byte);
9005 else
9006 move_gap_both (XINT (end), end_byte);
9010 coding_attrs_list = Qnil;
9011 for (tail = Vcoding_system_list; CONSP (tail); tail = XCDR (tail))
9012 if (NILP (exclude)
9013 || NILP (Fmemq (XCAR (tail), exclude)))
9015 Lisp_Object attrs;
9017 attrs = AREF (CODING_SYSTEM_SPEC (XCAR (tail)), 0);
9018 if (EQ (XCAR (tail), CODING_ATTR_BASE_NAME (attrs)))
9020 ASET (attrs, coding_attr_trans_tbl,
9021 get_translation_table (attrs, 1, NULL));
9022 coding_attrs_list = Fcons (attrs, coding_attrs_list);
9026 if (STRINGP (start))
9027 p = pbeg = SDATA (start);
9028 else
9029 p = pbeg = BYTE_POS_ADDR (start_byte);
9030 pend = p + (end_byte - start_byte);
9032 while (p < pend && ASCII_BYTE_P (*p)) p++;
9033 while (p < pend && ASCII_BYTE_P (*(pend - 1))) pend--;
9035 work_table = Fmake_char_table (Qnil, Qnil);
9036 while (p < pend)
9038 if (ASCII_BYTE_P (*p))
9039 p++;
9040 else
9042 c = STRING_CHAR_ADVANCE (p);
9043 if (!NILP (char_table_ref (work_table, c)))
9044 /* This character was already checked. Ignore it. */
9045 continue;
9047 charset_map_loaded = 0;
9048 for (tail = coding_attrs_list; CONSP (tail);)
9050 elt = XCAR (tail);
9051 if (NILP (elt))
9052 tail = XCDR (tail);
9053 else if (char_encodable_p (c, elt))
9054 tail = XCDR (tail);
9055 else if (CONSP (XCDR (tail)))
9057 XSETCAR (tail, XCAR (XCDR (tail)));
9058 XSETCDR (tail, XCDR (XCDR (tail)));
9060 else
9062 XSETCAR (tail, Qnil);
9063 tail = XCDR (tail);
9066 if (charset_map_loaded)
9068 ptrdiff_t p_offset = p - pbeg, pend_offset = pend - pbeg;
9070 if (STRINGP (start))
9071 pbeg = SDATA (start);
9072 else
9073 pbeg = BYTE_POS_ADDR (start_byte);
9074 p = pbeg + p_offset;
9075 pend = pbeg + pend_offset;
9077 char_table_set (work_table, c, Qt);
9081 safe_codings = list2 (Qraw_text, Qno_conversion);
9082 for (tail = coding_attrs_list; CONSP (tail); tail = XCDR (tail))
9083 if (! NILP (XCAR (tail)))
9084 safe_codings = Fcons (CODING_ATTR_BASE_NAME (XCAR (tail)), safe_codings);
9086 return safe_codings;
9090 DEFUN ("unencodable-char-position", Funencodable_char_position,
9091 Sunencodable_char_position, 3, 5, 0,
9092 doc: /*
9093 Return position of first un-encodable character in a region.
9094 START and END specify the region and CODING-SYSTEM specifies the
9095 encoding to check. Return nil if CODING-SYSTEM does encode the region.
9097 If optional 4th argument COUNT is non-nil, it specifies at most how
9098 many un-encodable characters to search. In this case, the value is a
9099 list of positions.
9101 If optional 5th argument STRING is non-nil, it is a string to search
9102 for un-encodable characters. In that case, START and END are indexes
9103 to the string. */)
9104 (Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object count, Lisp_Object string)
9106 EMACS_INT n;
9107 struct coding_system coding;
9108 Lisp_Object attrs, charset_list, translation_table;
9109 Lisp_Object positions;
9110 ptrdiff_t from, to;
9111 const unsigned char *p, *stop, *pend;
9112 bool ascii_compatible;
9114 setup_coding_system (Fcheck_coding_system (coding_system), &coding);
9115 attrs = CODING_ID_ATTRS (coding.id);
9116 if (EQ (CODING_ATTR_TYPE (attrs), Qraw_text))
9117 return Qnil;
9118 ascii_compatible = ! NILP (CODING_ATTR_ASCII_COMPAT (attrs));
9119 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
9120 translation_table = get_translation_table (attrs, 1, NULL);
9122 if (NILP (string))
9124 validate_region (&start, &end);
9125 from = XINT (start);
9126 to = XINT (end);
9127 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
9128 || (ascii_compatible
9129 && (to - from) == (CHAR_TO_BYTE (to) - (CHAR_TO_BYTE (from)))))
9130 return Qnil;
9131 p = CHAR_POS_ADDR (from);
9132 pend = CHAR_POS_ADDR (to);
9133 if (from < GPT && to >= GPT)
9134 stop = GPT_ADDR;
9135 else
9136 stop = pend;
9138 else
9140 CHECK_STRING (string);
9141 CHECK_NATNUM (start);
9142 CHECK_NATNUM (end);
9143 if (! (XINT (start) <= XINT (end) && XINT (end) <= SCHARS (string)))
9144 args_out_of_range_3 (string, start, end);
9145 from = XINT (start);
9146 to = XINT (end);
9147 if (! STRING_MULTIBYTE (string))
9148 return Qnil;
9149 p = SDATA (string) + string_char_to_byte (string, from);
9150 stop = pend = SDATA (string) + string_char_to_byte (string, to);
9151 if (ascii_compatible && (to - from) == (pend - p))
9152 return Qnil;
9155 if (NILP (count))
9156 n = 1;
9157 else
9159 CHECK_NATNUM (count);
9160 n = XINT (count);
9163 positions = Qnil;
9164 charset_map_loaded = 0;
9165 while (1)
9167 int c;
9169 if (ascii_compatible)
9170 while (p < stop && ASCII_BYTE_P (*p))
9171 p++, from++;
9172 if (p >= stop)
9174 if (p >= pend)
9175 break;
9176 stop = pend;
9177 p = GAP_END_ADDR;
9180 c = STRING_CHAR_ADVANCE (p);
9181 if (! (ASCII_CHAR_P (c) && ascii_compatible)
9182 && ! char_charset (translate_char (translation_table, c),
9183 charset_list, NULL))
9185 positions = Fcons (make_number (from), positions);
9186 n--;
9187 if (n == 0)
9188 break;
9191 from++;
9192 if (charset_map_loaded && NILP (string))
9194 p = CHAR_POS_ADDR (from);
9195 pend = CHAR_POS_ADDR (to);
9196 if (from < GPT && to >= GPT)
9197 stop = GPT_ADDR;
9198 else
9199 stop = pend;
9200 charset_map_loaded = 0;
9204 return (NILP (count) ? Fcar (positions) : Fnreverse (positions));
9208 DEFUN ("check-coding-systems-region", Fcheck_coding_systems_region,
9209 Scheck_coding_systems_region, 3, 3, 0,
9210 doc: /* Check if the region is encodable by coding systems.
9212 START and END are buffer positions specifying the region.
9213 CODING-SYSTEM-LIST is a list of coding systems to check.
9215 The value is an alist ((CODING-SYSTEM POS0 POS1 ...) ...), where
9216 CODING-SYSTEM is a member of CODING-SYSTEM-LIST and can't encode the
9217 whole region, POS0, POS1, ... are buffer positions where non-encodable
9218 characters are found.
9220 If all coding systems in CODING-SYSTEM-LIST can encode the region, the
9221 value is nil.
9223 START may be a string. In that case, check if the string is
9224 encodable, and the value contains indices to the string instead of
9225 buffer positions. END is ignored.
9227 If the current buffer (or START if it is a string) is unibyte, the value
9228 is nil. */)
9229 (Lisp_Object start, Lisp_Object end, Lisp_Object coding_system_list)
9231 Lisp_Object list;
9232 ptrdiff_t start_byte, end_byte;
9233 ptrdiff_t pos;
9234 const unsigned char *p, *pbeg, *pend;
9235 int c;
9236 Lisp_Object tail, elt, attrs;
9238 if (STRINGP (start))
9240 if (!STRING_MULTIBYTE (start)
9241 || SCHARS (start) == SBYTES (start))
9242 return Qnil;
9243 start_byte = 0;
9244 end_byte = SBYTES (start);
9245 pos = 0;
9247 else
9249 CHECK_NUMBER_COERCE_MARKER (start);
9250 CHECK_NUMBER_COERCE_MARKER (end);
9251 if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end))
9252 args_out_of_range (start, end);
9253 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
9254 return Qnil;
9255 start_byte = CHAR_TO_BYTE (XINT (start));
9256 end_byte = CHAR_TO_BYTE (XINT (end));
9257 if (XINT (end) - XINT (start) == end_byte - start_byte)
9258 return Qnil;
9260 if (XINT (start) < GPT && XINT (end) > GPT)
9262 if ((GPT - XINT (start)) < (XINT (end) - GPT))
9263 move_gap_both (XINT (start), start_byte);
9264 else
9265 move_gap_both (XINT (end), end_byte);
9267 pos = XINT (start);
9270 list = Qnil;
9271 for (tail = coding_system_list; CONSP (tail); tail = XCDR (tail))
9273 elt = XCAR (tail);
9274 attrs = AREF (CODING_SYSTEM_SPEC (elt), 0);
9275 ASET (attrs, coding_attr_trans_tbl,
9276 get_translation_table (attrs, 1, NULL));
9277 list = Fcons (list2 (elt, attrs), list);
9280 if (STRINGP (start))
9281 p = pbeg = SDATA (start);
9282 else
9283 p = pbeg = BYTE_POS_ADDR (start_byte);
9284 pend = p + (end_byte - start_byte);
9286 while (p < pend && ASCII_BYTE_P (*p)) p++, pos++;
9287 while (p < pend && ASCII_BYTE_P (*(pend - 1))) pend--;
9289 while (p < pend)
9291 if (ASCII_BYTE_P (*p))
9292 p++;
9293 else
9295 c = STRING_CHAR_ADVANCE (p);
9297 charset_map_loaded = 0;
9298 for (tail = list; CONSP (tail); tail = XCDR (tail))
9300 elt = XCDR (XCAR (tail));
9301 if (! char_encodable_p (c, XCAR (elt)))
9302 XSETCDR (elt, Fcons (make_number (pos), XCDR (elt)));
9304 if (charset_map_loaded)
9306 ptrdiff_t p_offset = p - pbeg, pend_offset = pend - pbeg;
9308 if (STRINGP (start))
9309 pbeg = SDATA (start);
9310 else
9311 pbeg = BYTE_POS_ADDR (start_byte);
9312 p = pbeg + p_offset;
9313 pend = pbeg + pend_offset;
9316 pos++;
9319 tail = list;
9320 list = Qnil;
9321 for (; CONSP (tail); tail = XCDR (tail))
9323 elt = XCAR (tail);
9324 if (CONSP (XCDR (XCDR (elt))))
9325 list = Fcons (Fcons (XCAR (elt), Fnreverse (XCDR (XCDR (elt)))),
9326 list);
9329 return list;
9333 static Lisp_Object
9334 code_convert_region (Lisp_Object start, Lisp_Object end,
9335 Lisp_Object coding_system, Lisp_Object dst_object,
9336 bool encodep, bool norecord)
9338 struct coding_system coding;
9339 ptrdiff_t from, from_byte, to, to_byte;
9340 Lisp_Object src_object;
9342 if (NILP (coding_system))
9343 coding_system = Qno_conversion;
9344 else
9345 CHECK_CODING_SYSTEM (coding_system);
9346 src_object = Fcurrent_buffer ();
9347 if (NILP (dst_object))
9348 dst_object = src_object;
9349 else if (! EQ (dst_object, Qt))
9350 CHECK_BUFFER (dst_object);
9352 validate_region (&start, &end);
9353 from = XFASTINT (start);
9354 from_byte = CHAR_TO_BYTE (from);
9355 to = XFASTINT (end);
9356 to_byte = CHAR_TO_BYTE (to);
9358 setup_coding_system (coding_system, &coding);
9359 coding.mode |= CODING_MODE_LAST_BLOCK;
9361 if (BUFFERP (dst_object) && !EQ (dst_object, src_object))
9363 struct buffer *buf = XBUFFER (dst_object);
9364 ptrdiff_t buf_pt = BUF_PT (buf);
9366 invalidate_buffer_caches (buf, buf_pt, buf_pt);
9369 if (encodep)
9370 encode_coding_object (&coding, src_object, from, from_byte, to, to_byte,
9371 dst_object);
9372 else
9373 decode_coding_object (&coding, src_object, from, from_byte, to, to_byte,
9374 dst_object);
9375 if (! norecord)
9376 Vlast_coding_system_used = CODING_ID_NAME (coding.id);
9378 return (BUFFERP (dst_object)
9379 ? make_number (coding.produced_char)
9380 : coding.dst_object);
9384 DEFUN ("decode-coding-region", Fdecode_coding_region, Sdecode_coding_region,
9385 3, 4, "r\nzCoding system: ",
9386 doc: /* Decode the current region from the specified coding system.
9387 When called from a program, takes four arguments:
9388 START, END, CODING-SYSTEM, and DESTINATION.
9389 START and END are buffer positions.
9391 Optional 4th arguments DESTINATION specifies where the decoded text goes.
9392 If nil, the region between START and END is replaced by the decoded text.
9393 If buffer, the decoded text is inserted in that buffer after point (point
9394 does not move).
9395 In those cases, the length of the decoded text is returned.
9396 If DESTINATION is t, the decoded text is returned.
9398 This function sets `last-coding-system-used' to the precise coding system
9399 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
9400 not fully specified.) */)
9401 (Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object destination)
9403 return code_convert_region (start, end, coding_system, destination, 0, 0);
9406 DEFUN ("encode-coding-region", Fencode_coding_region, Sencode_coding_region,
9407 3, 4, "r\nzCoding system: ",
9408 doc: /* Encode the current region by specified coding system.
9409 When called from a program, takes four arguments:
9410 START, END, CODING-SYSTEM and DESTINATION.
9411 START and END are buffer positions.
9413 Optional 4th arguments DESTINATION specifies where the encoded text goes.
9414 If nil, the region between START and END is replace by the encoded text.
9415 If buffer, the encoded text is inserted in that buffer after point (point
9416 does not move).
9417 In those cases, the length of the encoded text is returned.
9418 If DESTINATION is t, the encoded text is returned.
9420 This function sets `last-coding-system-used' to the precise coding system
9421 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
9422 not fully specified.) */)
9423 (Lisp_Object start, Lisp_Object end, Lisp_Object coding_system, Lisp_Object destination)
9425 return code_convert_region (start, end, coding_system, destination, 1, 0);
9428 Lisp_Object
9429 code_convert_string (Lisp_Object string, Lisp_Object coding_system,
9430 Lisp_Object dst_object, bool encodep, bool nocopy,
9431 bool norecord)
9433 struct coding_system coding;
9434 ptrdiff_t chars, bytes;
9436 CHECK_STRING (string);
9437 if (NILP (coding_system))
9439 if (! norecord)
9440 Vlast_coding_system_used = Qno_conversion;
9441 if (NILP (dst_object))
9442 return (nocopy ? Fcopy_sequence (string) : string);
9445 if (NILP (coding_system))
9446 coding_system = Qno_conversion;
9447 else
9448 CHECK_CODING_SYSTEM (coding_system);
9449 if (NILP (dst_object))
9450 dst_object = Qt;
9451 else if (! EQ (dst_object, Qt))
9452 CHECK_BUFFER (dst_object);
9454 setup_coding_system (coding_system, &coding);
9455 coding.mode |= CODING_MODE_LAST_BLOCK;
9456 chars = SCHARS (string);
9457 bytes = SBYTES (string);
9459 if (BUFFERP (dst_object))
9461 struct buffer *buf = XBUFFER (dst_object);
9462 ptrdiff_t buf_pt = BUF_PT (buf);
9464 invalidate_buffer_caches (buf, buf_pt, buf_pt);
9467 if (encodep)
9468 encode_coding_object (&coding, string, 0, 0, chars, bytes, dst_object);
9469 else
9470 decode_coding_object (&coding, string, 0, 0, chars, bytes, dst_object);
9471 if (! norecord)
9472 Vlast_coding_system_used = CODING_ID_NAME (coding.id);
9474 return (BUFFERP (dst_object)
9475 ? make_number (coding.produced_char)
9476 : coding.dst_object);
9480 /* Encode or decode STRING according to CODING_SYSTEM.
9481 Do not set Vlast_coding_system_used.
9483 This function is called only from macros DECODE_FILE and
9484 ENCODE_FILE, thus we ignore character composition. */
9486 Lisp_Object
9487 code_convert_string_norecord (Lisp_Object string, Lisp_Object coding_system,
9488 bool encodep)
9490 return code_convert_string (string, coding_system, Qt, encodep, 0, 1);
9494 DEFUN ("decode-coding-string", Fdecode_coding_string, Sdecode_coding_string,
9495 2, 4, 0,
9496 doc: /* Decode STRING which is encoded in CODING-SYSTEM, and return the result.
9498 Optional third arg NOCOPY non-nil means it is OK to return STRING itself
9499 if the decoding operation is trivial.
9501 Optional fourth arg BUFFER non-nil means that the decoded text is
9502 inserted in that buffer after point (point does not move). In this
9503 case, the return value is the length of the decoded text.
9505 This function sets `last-coding-system-used' to the precise coding system
9506 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
9507 not fully specified.) */)
9508 (Lisp_Object string, Lisp_Object coding_system, Lisp_Object nocopy, Lisp_Object buffer)
9510 return code_convert_string (string, coding_system, buffer,
9511 0, ! NILP (nocopy), 0);
9514 DEFUN ("encode-coding-string", Fencode_coding_string, Sencode_coding_string,
9515 2, 4, 0,
9516 doc: /* Encode STRING to CODING-SYSTEM, and return the result.
9518 Optional third arg NOCOPY non-nil means it is OK to return STRING
9519 itself if the encoding operation is trivial.
9521 Optional fourth arg BUFFER non-nil means that the encoded text is
9522 inserted in that buffer after point (point does not move). In this
9523 case, the return value is the length of the encoded text.
9525 This function sets `last-coding-system-used' to the precise coding system
9526 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
9527 not fully specified.) */)
9528 (Lisp_Object string, Lisp_Object coding_system, Lisp_Object nocopy, Lisp_Object buffer)
9530 return code_convert_string (string, coding_system, buffer,
9531 1, ! NILP (nocopy), 0);
9535 DEFUN ("decode-sjis-char", Fdecode_sjis_char, Sdecode_sjis_char, 1, 1, 0,
9536 doc: /* Decode a Japanese character which has CODE in shift_jis encoding.
9537 Return the corresponding character. */)
9538 (Lisp_Object code)
9540 Lisp_Object spec, attrs, val;
9541 struct charset *charset_roman, *charset_kanji, *charset_kana, *charset;
9542 EMACS_INT ch;
9543 int c;
9545 CHECK_NATNUM (code);
9546 ch = XFASTINT (code);
9547 CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system, spec);
9548 attrs = AREF (spec, 0);
9550 if (ASCII_BYTE_P (ch)
9551 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
9552 return code;
9554 val = CODING_ATTR_CHARSET_LIST (attrs);
9555 charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
9556 charset_kana = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
9557 charset_kanji = CHARSET_FROM_ID (XINT (XCAR (val)));
9559 if (ch <= 0x7F)
9561 c = ch;
9562 charset = charset_roman;
9564 else if (ch >= 0xA0 && ch < 0xDF)
9566 c = ch - 0x80;
9567 charset = charset_kana;
9569 else
9571 EMACS_INT c1 = ch >> 8;
9572 int c2 = ch & 0xFF;
9574 if (c1 < 0x81 || (c1 > 0x9F && c1 < 0xE0) || c1 > 0xEF
9575 || c2 < 0x40 || c2 == 0x7F || c2 > 0xFC)
9576 error ("Invalid code: %"pI"d", ch);
9577 c = ch;
9578 SJIS_TO_JIS (c);
9579 charset = charset_kanji;
9581 c = DECODE_CHAR (charset, c);
9582 if (c < 0)
9583 error ("Invalid code: %"pI"d", ch);
9584 return make_number (c);
9588 DEFUN ("encode-sjis-char", Fencode_sjis_char, Sencode_sjis_char, 1, 1, 0,
9589 doc: /* Encode a Japanese character CH to shift_jis encoding.
9590 Return the corresponding code in SJIS. */)
9591 (Lisp_Object ch)
9593 Lisp_Object spec, attrs, charset_list;
9594 int c;
9595 struct charset *charset;
9596 unsigned code;
9598 CHECK_CHARACTER (ch);
9599 c = XFASTINT (ch);
9600 CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system, spec);
9601 attrs = AREF (spec, 0);
9603 if (ASCII_CHAR_P (c)
9604 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
9605 return ch;
9607 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
9608 charset = char_charset (c, charset_list, &code);
9609 if (code == CHARSET_INVALID_CODE (charset))
9610 error ("Can't encode by shift_jis encoding: %c", c);
9611 JIS_TO_SJIS (code);
9613 return make_number (code);
9616 DEFUN ("decode-big5-char", Fdecode_big5_char, Sdecode_big5_char, 1, 1, 0,
9617 doc: /* Decode a Big5 character which has CODE in BIG5 coding system.
9618 Return the corresponding character. */)
9619 (Lisp_Object code)
9621 Lisp_Object spec, attrs, val;
9622 struct charset *charset_roman, *charset_big5, *charset;
9623 EMACS_INT ch;
9624 int c;
9626 CHECK_NATNUM (code);
9627 ch = XFASTINT (code);
9628 CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system, spec);
9629 attrs = AREF (spec, 0);
9631 if (ASCII_BYTE_P (ch)
9632 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
9633 return code;
9635 val = CODING_ATTR_CHARSET_LIST (attrs);
9636 charset_roman = CHARSET_FROM_ID (XINT (XCAR (val))), val = XCDR (val);
9637 charset_big5 = CHARSET_FROM_ID (XINT (XCAR (val)));
9639 if (ch <= 0x7F)
9641 c = ch;
9642 charset = charset_roman;
9644 else
9646 EMACS_INT b1 = ch >> 8;
9647 int b2 = ch & 0x7F;
9648 if (b1 < 0xA1 || b1 > 0xFE
9649 || b2 < 0x40 || (b2 > 0x7E && b2 < 0xA1) || b2 > 0xFE)
9650 error ("Invalid code: %"pI"d", ch);
9651 c = ch;
9652 charset = charset_big5;
9654 c = DECODE_CHAR (charset, c);
9655 if (c < 0)
9656 error ("Invalid code: %"pI"d", ch);
9657 return make_number (c);
9660 DEFUN ("encode-big5-char", Fencode_big5_char, Sencode_big5_char, 1, 1, 0,
9661 doc: /* Encode the Big5 character CH to BIG5 coding system.
9662 Return the corresponding character code in Big5. */)
9663 (Lisp_Object ch)
9665 Lisp_Object spec, attrs, charset_list;
9666 struct charset *charset;
9667 int c;
9668 unsigned code;
9670 CHECK_CHARACTER (ch);
9671 c = XFASTINT (ch);
9672 CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system, spec);
9673 attrs = AREF (spec, 0);
9674 if (ASCII_CHAR_P (c)
9675 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs)))
9676 return ch;
9678 charset_list = CODING_ATTR_CHARSET_LIST (attrs);
9679 charset = char_charset (c, charset_list, &code);
9680 if (code == CHARSET_INVALID_CODE (charset))
9681 error ("Can't encode by Big5 encoding: %c", c);
9683 return make_number (code);
9687 DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_internal,
9688 Sset_terminal_coding_system_internal, 1, 2, 0,
9689 doc: /* Internal use only. */)
9690 (Lisp_Object coding_system, Lisp_Object terminal)
9692 struct terminal *term = get_terminal (terminal, 1);
9693 struct coding_system *terminal_coding = TERMINAL_TERMINAL_CODING (term);
9694 CHECK_SYMBOL (coding_system);
9695 setup_coding_system (Fcheck_coding_system (coding_system), terminal_coding);
9696 /* We had better not send unsafe characters to terminal. */
9697 terminal_coding->mode |= CODING_MODE_SAFE_ENCODING;
9698 /* Character composition should be disabled. */
9699 terminal_coding->common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
9700 terminal_coding->src_multibyte = 1;
9701 terminal_coding->dst_multibyte = 0;
9702 tset_charset_list
9703 (term, (terminal_coding->common_flags & CODING_REQUIRE_ENCODING_MASK
9704 ? coding_charset_list (terminal_coding)
9705 : list1 (make_number (charset_ascii))));
9706 return Qnil;
9709 DEFUN ("set-safe-terminal-coding-system-internal",
9710 Fset_safe_terminal_coding_system_internal,
9711 Sset_safe_terminal_coding_system_internal, 1, 1, 0,
9712 doc: /* Internal use only. */)
9713 (Lisp_Object coding_system)
9715 CHECK_SYMBOL (coding_system);
9716 setup_coding_system (Fcheck_coding_system (coding_system),
9717 &safe_terminal_coding);
9718 /* Character composition should be disabled. */
9719 safe_terminal_coding.common_flags &= ~CODING_ANNOTATE_COMPOSITION_MASK;
9720 safe_terminal_coding.src_multibyte = 1;
9721 safe_terminal_coding.dst_multibyte = 0;
9722 return Qnil;
9725 DEFUN ("terminal-coding-system", Fterminal_coding_system,
9726 Sterminal_coding_system, 0, 1, 0,
9727 doc: /* Return coding system specified for terminal output on the given terminal.
9728 TERMINAL may be a terminal object, a frame, or nil for the selected
9729 frame's terminal device. */)
9730 (Lisp_Object terminal)
9732 struct coding_system *terminal_coding
9733 = TERMINAL_TERMINAL_CODING (get_terminal (terminal, 1));
9734 Lisp_Object coding_system = CODING_ID_NAME (terminal_coding->id);
9736 /* For backward compatibility, return nil if it is `undecided'. */
9737 return (! EQ (coding_system, Qundecided) ? coding_system : Qnil);
9740 DEFUN ("set-keyboard-coding-system-internal", Fset_keyboard_coding_system_internal,
9741 Sset_keyboard_coding_system_internal, 1, 2, 0,
9742 doc: /* Internal use only. */)
9743 (Lisp_Object coding_system, Lisp_Object terminal)
9745 struct terminal *t = get_terminal (terminal, 1);
9746 CHECK_SYMBOL (coding_system);
9747 if (NILP (coding_system))
9748 coding_system = Qno_conversion;
9749 else
9750 Fcheck_coding_system (coding_system);
9751 setup_coding_system (coding_system, TERMINAL_KEYBOARD_CODING (t));
9752 /* Character composition should be disabled. */
9753 TERMINAL_KEYBOARD_CODING (t)->common_flags
9754 &= ~CODING_ANNOTATE_COMPOSITION_MASK;
9755 return Qnil;
9758 DEFUN ("keyboard-coding-system",
9759 Fkeyboard_coding_system, Skeyboard_coding_system, 0, 1, 0,
9760 doc: /* Return coding system specified for decoding keyboard input. */)
9761 (Lisp_Object terminal)
9763 return CODING_ID_NAME (TERMINAL_KEYBOARD_CODING
9764 (get_terminal (terminal, 1))->id);
9768 DEFUN ("find-operation-coding-system", Ffind_operation_coding_system,
9769 Sfind_operation_coding_system, 1, MANY, 0,
9770 doc: /* Choose a coding system for an operation based on the target name.
9771 The value names a pair of coding systems: (DECODING-SYSTEM . ENCODING-SYSTEM).
9772 DECODING-SYSTEM is the coding system to use for decoding
9773 \(in case OPERATION does decoding), and ENCODING-SYSTEM is the coding system
9774 for encoding (in case OPERATION does encoding).
9776 The first argument OPERATION specifies an I/O primitive:
9777 For file I/O, `insert-file-contents' or `write-region'.
9778 For process I/O, `call-process', `call-process-region', or `start-process'.
9779 For network I/O, `open-network-stream'.
9781 The remaining arguments should be the same arguments that were passed
9782 to the primitive. Depending on which primitive, one of those arguments
9783 is selected as the TARGET. For example, if OPERATION does file I/O,
9784 whichever argument specifies the file name is TARGET.
9786 TARGET has a meaning which depends on OPERATION:
9787 For file I/O, TARGET is a file name (except for the special case below).
9788 For process I/O, TARGET is a process name.
9789 For network I/O, TARGET is a service name or a port number.
9791 This function looks up what is specified for TARGET in
9792 `file-coding-system-alist', `process-coding-system-alist',
9793 or `network-coding-system-alist' depending on OPERATION.
9794 They may specify a coding system, a cons of coding systems,
9795 or a function symbol to call.
9796 In the last case, we call the function with one argument,
9797 which is a list of all the arguments given to this function.
9798 If the function can't decide a coding system, it can return
9799 `undecided' so that the normal code-detection is performed.
9801 If OPERATION is `insert-file-contents', the argument corresponding to
9802 TARGET may be a cons (FILENAME . BUFFER). In that case, FILENAME is a
9803 file name to look up, and BUFFER is a buffer that contains the file's
9804 contents (not yet decoded). If `file-coding-system-alist' specifies a
9805 function to call for FILENAME, that function should examine the
9806 contents of BUFFER instead of reading the file.
9808 usage: (find-operation-coding-system OPERATION ARGUMENTS...) */)
9809 (ptrdiff_t nargs, Lisp_Object *args)
9811 Lisp_Object operation, target_idx, target, val;
9812 register Lisp_Object chain;
9814 if (nargs < 2)
9815 error ("Too few arguments");
9816 operation = args[0];
9817 if (!SYMBOLP (operation)
9818 || (target_idx = Fget (operation, Qtarget_idx), !NATNUMP (target_idx)))
9819 error ("Invalid first argument");
9820 if (nargs <= 1 + XFASTINT (target_idx))
9821 error ("Too few arguments for operation `%s'",
9822 SDATA (SYMBOL_NAME (operation)));
9823 target = args[XFASTINT (target_idx) + 1];
9824 if (!(STRINGP (target)
9825 || (EQ (operation, Qinsert_file_contents) && CONSP (target)
9826 && STRINGP (XCAR (target)) && BUFFERP (XCDR (target)))
9827 || (EQ (operation, Qopen_network_stream) && INTEGERP (target))))
9828 error ("Invalid argument %"pI"d of operation `%s'",
9829 XFASTINT (target_idx) + 1, SDATA (SYMBOL_NAME (operation)));
9830 if (CONSP (target))
9831 target = XCAR (target);
9833 chain = ((EQ (operation, Qinsert_file_contents)
9834 || EQ (operation, Qwrite_region))
9835 ? Vfile_coding_system_alist
9836 : (EQ (operation, Qopen_network_stream)
9837 ? Vnetwork_coding_system_alist
9838 : Vprocess_coding_system_alist));
9839 if (NILP (chain))
9840 return Qnil;
9842 for (; CONSP (chain); chain = XCDR (chain))
9844 Lisp_Object elt;
9846 elt = XCAR (chain);
9847 if (CONSP (elt)
9848 && ((STRINGP (target)
9849 && STRINGP (XCAR (elt))
9850 && fast_string_match (XCAR (elt), target) >= 0)
9851 || (INTEGERP (target) && EQ (target, XCAR (elt)))))
9853 val = XCDR (elt);
9854 /* Here, if VAL is both a valid coding system and a valid
9855 function symbol, we return VAL as a coding system. */
9856 if (CONSP (val))
9857 return val;
9858 if (! SYMBOLP (val))
9859 return Qnil;
9860 if (! NILP (Fcoding_system_p (val)))
9861 return Fcons (val, val);
9862 if (! NILP (Ffboundp (val)))
9864 /* We use call1 rather than safe_call1
9865 so as to get bug reports about functions called here
9866 which don't handle the current interface. */
9867 val = call1 (val, Flist (nargs, args));
9868 if (CONSP (val))
9869 return val;
9870 if (SYMBOLP (val) && ! NILP (Fcoding_system_p (val)))
9871 return Fcons (val, val);
9873 return Qnil;
9876 return Qnil;
9879 DEFUN ("set-coding-system-priority", Fset_coding_system_priority,
9880 Sset_coding_system_priority, 0, MANY, 0,
9881 doc: /* Assign higher priority to the coding systems given as arguments.
9882 If multiple coding systems belong to the same category,
9883 all but the first one are ignored.
9885 usage: (set-coding-system-priority &rest coding-systems) */)
9886 (ptrdiff_t nargs, Lisp_Object *args)
9888 ptrdiff_t i, j;
9889 bool changed[coding_category_max];
9890 enum coding_category priorities[coding_category_max];
9892 memset (changed, 0, sizeof changed);
9894 for (i = j = 0; i < nargs; i++)
9896 enum coding_category category;
9897 Lisp_Object spec, attrs;
9899 CHECK_CODING_SYSTEM_GET_SPEC (args[i], spec);
9900 attrs = AREF (spec, 0);
9901 category = XINT (CODING_ATTR_CATEGORY (attrs));
9902 if (changed[category])
9903 /* Ignore this coding system because a coding system of the
9904 same category already had a higher priority. */
9905 continue;
9906 changed[category] = 1;
9907 priorities[j++] = category;
9908 if (coding_categories[category].id >= 0
9909 && ! EQ (args[i], CODING_ID_NAME (coding_categories[category].id)))
9910 setup_coding_system (args[i], &coding_categories[category]);
9911 Fset (AREF (Vcoding_category_table, category), args[i]);
9914 /* Now we have decided top J priorities. Reflect the order of the
9915 original priorities to the remaining priorities. */
9917 for (i = j, j = 0; i < coding_category_max; i++, j++)
9919 while (j < coding_category_max
9920 && changed[coding_priorities[j]])
9921 j++;
9922 if (j == coding_category_max)
9923 emacs_abort ();
9924 priorities[i] = coding_priorities[j];
9927 memcpy (coding_priorities, priorities, sizeof priorities);
9929 /* Update `coding-category-list'. */
9930 Vcoding_category_list = Qnil;
9931 for (i = coding_category_max; i-- > 0; )
9932 Vcoding_category_list
9933 = Fcons (AREF (Vcoding_category_table, priorities[i]),
9934 Vcoding_category_list);
9936 return Qnil;
9939 DEFUN ("coding-system-priority-list", Fcoding_system_priority_list,
9940 Scoding_system_priority_list, 0, 1, 0,
9941 doc: /* Return a list of coding systems ordered by their priorities.
9942 The list contains a subset of coding systems; i.e. coding systems
9943 assigned to each coding category (see `coding-category-list').
9945 HIGHESTP non-nil means just return the highest priority one. */)
9946 (Lisp_Object highestp)
9948 int i;
9949 Lisp_Object val;
9951 for (i = 0, val = Qnil; i < coding_category_max; i++)
9953 enum coding_category category = coding_priorities[i];
9954 int id = coding_categories[category].id;
9955 Lisp_Object attrs;
9957 if (id < 0)
9958 continue;
9959 attrs = CODING_ID_ATTRS (id);
9960 if (! NILP (highestp))
9961 return CODING_ATTR_BASE_NAME (attrs);
9962 val = Fcons (CODING_ATTR_BASE_NAME (attrs), val);
9964 return Fnreverse (val);
9967 static const char *const suffixes[] = { "-unix", "-dos", "-mac" };
9969 static Lisp_Object
9970 make_subsidiaries (Lisp_Object base)
9972 Lisp_Object subsidiaries;
9973 ptrdiff_t base_name_len = SBYTES (SYMBOL_NAME (base));
9974 char *buf = alloca (base_name_len + 6);
9975 int i;
9977 memcpy (buf, SDATA (SYMBOL_NAME (base)), base_name_len);
9978 subsidiaries = make_uninit_vector (3);
9979 for (i = 0; i < 3; i++)
9981 strcpy (buf + base_name_len, suffixes[i]);
9982 ASET (subsidiaries, i, intern (buf));
9984 return subsidiaries;
9988 DEFUN ("define-coding-system-internal", Fdefine_coding_system_internal,
9989 Sdefine_coding_system_internal, coding_arg_max, MANY, 0,
9990 doc: /* For internal use only.
9991 usage: (define-coding-system-internal ...) */)
9992 (ptrdiff_t nargs, Lisp_Object *args)
9994 Lisp_Object name;
9995 Lisp_Object spec_vec; /* [ ATTRS ALIASE EOL_TYPE ] */
9996 Lisp_Object attrs; /* Vector of attributes. */
9997 Lisp_Object eol_type;
9998 Lisp_Object aliases;
9999 Lisp_Object coding_type, charset_list, safe_charsets;
10000 enum coding_category category;
10001 Lisp_Object tail, val;
10002 int max_charset_id = 0;
10003 int i;
10005 if (nargs < coding_arg_max)
10006 goto short_args;
10008 attrs = Fmake_vector (make_number (coding_attr_last_index), Qnil);
10010 name = args[coding_arg_name];
10011 CHECK_SYMBOL (name);
10012 ASET (attrs, coding_attr_base_name, name);
10014 val = args[coding_arg_mnemonic];
10015 if (! STRINGP (val))
10016 CHECK_CHARACTER (val);
10017 ASET (attrs, coding_attr_mnemonic, val);
10019 coding_type = args[coding_arg_coding_type];
10020 CHECK_SYMBOL (coding_type);
10021 ASET (attrs, coding_attr_type, coding_type);
10023 charset_list = args[coding_arg_charset_list];
10024 if (SYMBOLP (charset_list))
10026 if (EQ (charset_list, Qiso_2022))
10028 if (! EQ (coding_type, Qiso_2022))
10029 error ("Invalid charset-list");
10030 charset_list = Viso_2022_charset_list;
10032 else if (EQ (charset_list, Qemacs_mule))
10034 if (! EQ (coding_type, Qemacs_mule))
10035 error ("Invalid charset-list");
10036 charset_list = Vemacs_mule_charset_list;
10038 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
10040 if (! RANGED_INTEGERP (0, XCAR (tail), INT_MAX - 1))
10041 error ("Invalid charset-list");
10042 if (max_charset_id < XFASTINT (XCAR (tail)))
10043 max_charset_id = XFASTINT (XCAR (tail));
10046 else
10048 charset_list = Fcopy_sequence (charset_list);
10049 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
10051 struct charset *charset;
10053 val = XCAR (tail);
10054 CHECK_CHARSET_GET_CHARSET (val, charset);
10055 if (EQ (coding_type, Qiso_2022)
10056 ? CHARSET_ISO_FINAL (charset) < 0
10057 : EQ (coding_type, Qemacs_mule)
10058 ? CHARSET_EMACS_MULE_ID (charset) < 0
10059 : 0)
10060 error ("Can't handle charset `%s'",
10061 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
10063 XSETCAR (tail, make_number (charset->id));
10064 if (max_charset_id < charset->id)
10065 max_charset_id = charset->id;
10068 ASET (attrs, coding_attr_charset_list, charset_list);
10070 safe_charsets = make_uninit_string (max_charset_id + 1);
10071 memset (SDATA (safe_charsets), 255, max_charset_id + 1);
10072 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
10073 SSET (safe_charsets, XFASTINT (XCAR (tail)), 0);
10074 ASET (attrs, coding_attr_safe_charsets, safe_charsets);
10076 ASET (attrs, coding_attr_ascii_compat, args[coding_arg_ascii_compatible_p]);
10078 val = args[coding_arg_decode_translation_table];
10079 if (! CHAR_TABLE_P (val) && ! CONSP (val))
10080 CHECK_SYMBOL (val);
10081 ASET (attrs, coding_attr_decode_tbl, val);
10083 val = args[coding_arg_encode_translation_table];
10084 if (! CHAR_TABLE_P (val) && ! CONSP (val))
10085 CHECK_SYMBOL (val);
10086 ASET (attrs, coding_attr_encode_tbl, val);
10088 val = args[coding_arg_post_read_conversion];
10089 CHECK_SYMBOL (val);
10090 ASET (attrs, coding_attr_post_read, val);
10092 val = args[coding_arg_pre_write_conversion];
10093 CHECK_SYMBOL (val);
10094 ASET (attrs, coding_attr_pre_write, val);
10096 val = args[coding_arg_default_char];
10097 if (NILP (val))
10098 ASET (attrs, coding_attr_default_char, make_number (' '));
10099 else
10101 CHECK_CHARACTER (val);
10102 ASET (attrs, coding_attr_default_char, val);
10105 val = args[coding_arg_for_unibyte];
10106 ASET (attrs, coding_attr_for_unibyte, NILP (val) ? Qnil : Qt);
10108 val = args[coding_arg_plist];
10109 CHECK_LIST (val);
10110 ASET (attrs, coding_attr_plist, val);
10112 if (EQ (coding_type, Qcharset))
10114 /* Generate a lisp vector of 256 elements. Each element is nil,
10115 integer, or a list of charset IDs.
10117 If Nth element is nil, the byte code N is invalid in this
10118 coding system.
10120 If Nth element is a number NUM, N is the first byte of a
10121 charset whose ID is NUM.
10123 If Nth element is a list of charset IDs, N is the first byte
10124 of one of them. The list is sorted by dimensions of the
10125 charsets. A charset of smaller dimension comes first. */
10126 val = Fmake_vector (make_number (256), Qnil);
10128 for (tail = charset_list; CONSP (tail); tail = XCDR (tail))
10130 struct charset *charset = CHARSET_FROM_ID (XFASTINT (XCAR (tail)));
10131 int dim = CHARSET_DIMENSION (charset);
10132 int idx = (dim - 1) * 4;
10134 if (CHARSET_ASCII_COMPATIBLE_P (charset))
10135 ASET (attrs, coding_attr_ascii_compat, Qt);
10137 for (i = charset->code_space[idx];
10138 i <= charset->code_space[idx + 1]; i++)
10140 Lisp_Object tmp, tmp2;
10141 int dim2;
10143 tmp = AREF (val, i);
10144 if (NILP (tmp))
10145 tmp = XCAR (tail);
10146 else if (NUMBERP (tmp))
10148 dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (tmp)));
10149 if (dim < dim2)
10150 tmp = list2 (XCAR (tail), tmp);
10151 else
10152 tmp = list2 (tmp, XCAR (tail));
10154 else
10156 for (tmp2 = tmp; CONSP (tmp2); tmp2 = XCDR (tmp2))
10158 dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (XCAR (tmp2))));
10159 if (dim < dim2)
10160 break;
10162 if (NILP (tmp2))
10163 tmp = nconc2 (tmp, list1 (XCAR (tail)));
10164 else
10166 XSETCDR (tmp2, Fcons (XCAR (tmp2), XCDR (tmp2)));
10167 XSETCAR (tmp2, XCAR (tail));
10170 ASET (val, i, tmp);
10173 ASET (attrs, coding_attr_charset_valids, val);
10174 category = coding_category_charset;
10176 else if (EQ (coding_type, Qccl))
10178 Lisp_Object valids;
10180 if (nargs < coding_arg_ccl_max)
10181 goto short_args;
10183 val = args[coding_arg_ccl_decoder];
10184 CHECK_CCL_PROGRAM (val);
10185 if (VECTORP (val))
10186 val = Fcopy_sequence (val);
10187 ASET (attrs, coding_attr_ccl_decoder, val);
10189 val = args[coding_arg_ccl_encoder];
10190 CHECK_CCL_PROGRAM (val);
10191 if (VECTORP (val))
10192 val = Fcopy_sequence (val);
10193 ASET (attrs, coding_attr_ccl_encoder, val);
10195 val = args[coding_arg_ccl_valids];
10196 valids = Fmake_string (make_number (256), make_number (0));
10197 for (tail = val; CONSP (tail); tail = XCDR (tail))
10199 int from, to;
10201 val = XCAR (tail);
10202 if (INTEGERP (val))
10204 if (! (0 <= XINT (val) && XINT (val) <= 255))
10205 args_out_of_range_3 (val, make_number (0), make_number (255));
10206 from = to = XINT (val);
10208 else
10210 CHECK_CONS (val);
10211 CHECK_NATNUM_CAR (val);
10212 CHECK_NUMBER_CDR (val);
10213 if (XINT (XCAR (val)) > 255)
10214 args_out_of_range_3 (XCAR (val),
10215 make_number (0), make_number (255));
10216 from = XINT (XCAR (val));
10217 if (! (from <= XINT (XCDR (val)) && XINT (XCDR (val)) <= 255))
10218 args_out_of_range_3 (XCDR (val),
10219 XCAR (val), make_number (255));
10220 to = XINT (XCDR (val));
10222 for (i = from; i <= to; i++)
10223 SSET (valids, i, 1);
10225 ASET (attrs, coding_attr_ccl_valids, valids);
10227 category = coding_category_ccl;
10229 else if (EQ (coding_type, Qutf_16))
10231 Lisp_Object bom, endian;
10233 ASET (attrs, coding_attr_ascii_compat, Qnil);
10235 if (nargs < coding_arg_utf16_max)
10236 goto short_args;
10238 bom = args[coding_arg_utf16_bom];
10239 if (! NILP (bom) && ! EQ (bom, Qt))
10241 CHECK_CONS (bom);
10242 val = XCAR (bom);
10243 CHECK_CODING_SYSTEM (val);
10244 val = XCDR (bom);
10245 CHECK_CODING_SYSTEM (val);
10247 ASET (attrs, coding_attr_utf_bom, bom);
10249 endian = args[coding_arg_utf16_endian];
10250 CHECK_SYMBOL (endian);
10251 if (NILP (endian))
10252 endian = Qbig;
10253 else if (! EQ (endian, Qbig) && ! EQ (endian, Qlittle))
10254 error ("Invalid endian: %s", SDATA (SYMBOL_NAME (endian)));
10255 ASET (attrs, coding_attr_utf_16_endian, endian);
10257 category = (CONSP (bom)
10258 ? coding_category_utf_16_auto
10259 : NILP (bom)
10260 ? (EQ (endian, Qbig)
10261 ? coding_category_utf_16_be_nosig
10262 : coding_category_utf_16_le_nosig)
10263 : (EQ (endian, Qbig)
10264 ? coding_category_utf_16_be
10265 : coding_category_utf_16_le));
10267 else if (EQ (coding_type, Qiso_2022))
10269 Lisp_Object initial, reg_usage, request, flags;
10271 if (nargs < coding_arg_iso2022_max)
10272 goto short_args;
10274 initial = Fcopy_sequence (args[coding_arg_iso2022_initial]);
10275 CHECK_VECTOR (initial);
10276 for (i = 0; i < 4; i++)
10278 val = AREF (initial, i);
10279 if (! NILP (val))
10281 struct charset *charset;
10283 CHECK_CHARSET_GET_CHARSET (val, charset);
10284 ASET (initial, i, make_number (CHARSET_ID (charset)));
10285 if (i == 0 && CHARSET_ASCII_COMPATIBLE_P (charset))
10286 ASET (attrs, coding_attr_ascii_compat, Qt);
10288 else
10289 ASET (initial, i, make_number (-1));
10292 reg_usage = args[coding_arg_iso2022_reg_usage];
10293 CHECK_CONS (reg_usage);
10294 CHECK_NUMBER_CAR (reg_usage);
10295 CHECK_NUMBER_CDR (reg_usage);
10297 request = Fcopy_sequence (args[coding_arg_iso2022_request]);
10298 for (tail = request; CONSP (tail); tail = XCDR (tail))
10300 int id;
10301 Lisp_Object tmp1;
10303 val = XCAR (tail);
10304 CHECK_CONS (val);
10305 tmp1 = XCAR (val);
10306 CHECK_CHARSET_GET_ID (tmp1, id);
10307 CHECK_NATNUM_CDR (val);
10308 if (XINT (XCDR (val)) >= 4)
10309 error ("Invalid graphic register number: %"pI"d", XINT (XCDR (val)));
10310 XSETCAR (val, make_number (id));
10313 flags = args[coding_arg_iso2022_flags];
10314 CHECK_NATNUM (flags);
10315 i = XINT (flags) & INT_MAX;
10316 if (EQ (args[coding_arg_charset_list], Qiso_2022))
10317 i |= CODING_ISO_FLAG_FULL_SUPPORT;
10318 flags = make_number (i);
10320 ASET (attrs, coding_attr_iso_initial, initial);
10321 ASET (attrs, coding_attr_iso_usage, reg_usage);
10322 ASET (attrs, coding_attr_iso_request, request);
10323 ASET (attrs, coding_attr_iso_flags, flags);
10324 setup_iso_safe_charsets (attrs);
10326 if (i & CODING_ISO_FLAG_SEVEN_BITS)
10327 category = ((i & (CODING_ISO_FLAG_LOCKING_SHIFT
10328 | CODING_ISO_FLAG_SINGLE_SHIFT))
10329 ? coding_category_iso_7_else
10330 : EQ (args[coding_arg_charset_list], Qiso_2022)
10331 ? coding_category_iso_7
10332 : coding_category_iso_7_tight);
10333 else
10335 int id = XINT (AREF (initial, 1));
10337 category = (((i & CODING_ISO_FLAG_LOCKING_SHIFT)
10338 || EQ (args[coding_arg_charset_list], Qiso_2022)
10339 || id < 0)
10340 ? coding_category_iso_8_else
10341 : (CHARSET_DIMENSION (CHARSET_FROM_ID (id)) == 1)
10342 ? coding_category_iso_8_1
10343 : coding_category_iso_8_2);
10345 if (category != coding_category_iso_8_1
10346 && category != coding_category_iso_8_2)
10347 ASET (attrs, coding_attr_ascii_compat, Qnil);
10349 else if (EQ (coding_type, Qemacs_mule))
10351 if (EQ (args[coding_arg_charset_list], Qemacs_mule))
10352 ASET (attrs, coding_attr_emacs_mule_full, Qt);
10353 ASET (attrs, coding_attr_ascii_compat, Qt);
10354 category = coding_category_emacs_mule;
10356 else if (EQ (coding_type, Qshift_jis))
10359 struct charset *charset;
10361 if (XINT (Flength (charset_list)) != 3
10362 && XINT (Flength (charset_list)) != 4)
10363 error ("There should be three or four charsets");
10365 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
10366 if (CHARSET_DIMENSION (charset) != 1)
10367 error ("Dimension of charset %s is not one",
10368 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
10369 if (CHARSET_ASCII_COMPATIBLE_P (charset))
10370 ASET (attrs, coding_attr_ascii_compat, Qt);
10372 charset_list = XCDR (charset_list);
10373 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
10374 if (CHARSET_DIMENSION (charset) != 1)
10375 error ("Dimension of charset %s is not one",
10376 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
10378 charset_list = XCDR (charset_list);
10379 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
10380 if (CHARSET_DIMENSION (charset) != 2)
10381 error ("Dimension of charset %s is not two",
10382 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
10384 charset_list = XCDR (charset_list);
10385 if (! NILP (charset_list))
10387 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
10388 if (CHARSET_DIMENSION (charset) != 2)
10389 error ("Dimension of charset %s is not two",
10390 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
10393 category = coding_category_sjis;
10394 Vsjis_coding_system = name;
10396 else if (EQ (coding_type, Qbig5))
10398 struct charset *charset;
10400 if (XINT (Flength (charset_list)) != 2)
10401 error ("There should be just two charsets");
10403 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
10404 if (CHARSET_DIMENSION (charset) != 1)
10405 error ("Dimension of charset %s is not one",
10406 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
10407 if (CHARSET_ASCII_COMPATIBLE_P (charset))
10408 ASET (attrs, coding_attr_ascii_compat, Qt);
10410 charset_list = XCDR (charset_list);
10411 charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
10412 if (CHARSET_DIMENSION (charset) != 2)
10413 error ("Dimension of charset %s is not two",
10414 SDATA (SYMBOL_NAME (CHARSET_NAME (charset))));
10416 category = coding_category_big5;
10417 Vbig5_coding_system = name;
10419 else if (EQ (coding_type, Qraw_text))
10421 category = coding_category_raw_text;
10422 ASET (attrs, coding_attr_ascii_compat, Qt);
10424 else if (EQ (coding_type, Qutf_8))
10426 Lisp_Object bom;
10428 if (nargs < coding_arg_utf8_max)
10429 goto short_args;
10431 bom = args[coding_arg_utf8_bom];
10432 if (! NILP (bom) && ! EQ (bom, Qt))
10434 CHECK_CONS (bom);
10435 val = XCAR (bom);
10436 CHECK_CODING_SYSTEM (val);
10437 val = XCDR (bom);
10438 CHECK_CODING_SYSTEM (val);
10440 ASET (attrs, coding_attr_utf_bom, bom);
10441 if (NILP (bom))
10442 ASET (attrs, coding_attr_ascii_compat, Qt);
10444 category = (CONSP (bom) ? coding_category_utf_8_auto
10445 : NILP (bom) ? coding_category_utf_8_nosig
10446 : coding_category_utf_8_sig);
10448 else if (EQ (coding_type, Qundecided))
10450 if (nargs < coding_arg_undecided_max)
10451 goto short_args;
10452 ASET (attrs, coding_attr_undecided_inhibit_null_byte_detection,
10453 args[coding_arg_undecided_inhibit_null_byte_detection]);
10454 ASET (attrs, coding_attr_undecided_inhibit_iso_escape_detection,
10455 args[coding_arg_undecided_inhibit_iso_escape_detection]);
10456 ASET (attrs, coding_attr_undecided_prefer_utf_8,
10457 args[coding_arg_undecided_prefer_utf_8]);
10458 category = coding_category_undecided;
10460 else
10461 error ("Invalid coding system type: %s",
10462 SDATA (SYMBOL_NAME (coding_type)));
10464 ASET (attrs, coding_attr_category, make_number (category));
10465 ASET (attrs, coding_attr_plist,
10466 Fcons (QCcategory,
10467 Fcons (AREF (Vcoding_category_table, category),
10468 CODING_ATTR_PLIST (attrs))));
10469 ASET (attrs, coding_attr_plist,
10470 Fcons (QCascii_compatible_p,
10471 Fcons (CODING_ATTR_ASCII_COMPAT (attrs),
10472 CODING_ATTR_PLIST (attrs))));
10474 eol_type = args[coding_arg_eol_type];
10475 if (! NILP (eol_type)
10476 && ! EQ (eol_type, Qunix)
10477 && ! EQ (eol_type, Qdos)
10478 && ! EQ (eol_type, Qmac))
10479 error ("Invalid eol-type");
10481 aliases = list1 (name);
10483 if (NILP (eol_type))
10485 eol_type = make_subsidiaries (name);
10486 for (i = 0; i < 3; i++)
10488 Lisp_Object this_spec, this_name, this_aliases, this_eol_type;
10490 this_name = AREF (eol_type, i);
10491 this_aliases = list1 (this_name);
10492 this_eol_type = (i == 0 ? Qunix : i == 1 ? Qdos : Qmac);
10493 this_spec = make_uninit_vector (3);
10494 ASET (this_spec, 0, attrs);
10495 ASET (this_spec, 1, this_aliases);
10496 ASET (this_spec, 2, this_eol_type);
10497 Fputhash (this_name, this_spec, Vcoding_system_hash_table);
10498 Vcoding_system_list = Fcons (this_name, Vcoding_system_list);
10499 val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist);
10500 if (NILP (val))
10501 Vcoding_system_alist
10502 = Fcons (Fcons (Fsymbol_name (this_name), Qnil),
10503 Vcoding_system_alist);
10507 spec_vec = make_uninit_vector (3);
10508 ASET (spec_vec, 0, attrs);
10509 ASET (spec_vec, 1, aliases);
10510 ASET (spec_vec, 2, eol_type);
10512 Fputhash (name, spec_vec, Vcoding_system_hash_table);
10513 Vcoding_system_list = Fcons (name, Vcoding_system_list);
10514 val = Fassoc (Fsymbol_name (name), Vcoding_system_alist);
10515 if (NILP (val))
10516 Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (name), Qnil),
10517 Vcoding_system_alist);
10520 int id = coding_categories[category].id;
10522 if (id < 0 || EQ (name, CODING_ID_NAME (id)))
10523 setup_coding_system (name, &coding_categories[category]);
10526 return Qnil;
10528 short_args:
10529 return Fsignal (Qwrong_number_of_arguments,
10530 Fcons (intern ("define-coding-system-internal"),
10531 make_number (nargs)));
10535 DEFUN ("coding-system-put", Fcoding_system_put, Scoding_system_put,
10536 3, 3, 0,
10537 doc: /* Change value in CODING-SYSTEM's property list PROP to VAL. */)
10538 (Lisp_Object coding_system, Lisp_Object prop, Lisp_Object val)
10540 Lisp_Object spec, attrs;
10542 CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
10543 attrs = AREF (spec, 0);
10544 if (EQ (prop, QCmnemonic))
10546 if (! STRINGP (val))
10547 CHECK_CHARACTER (val);
10548 ASET (attrs, coding_attr_mnemonic, val);
10550 else if (EQ (prop, QCdefault_char))
10552 if (NILP (val))
10553 val = make_number (' ');
10554 else
10555 CHECK_CHARACTER (val);
10556 ASET (attrs, coding_attr_default_char, val);
10558 else if (EQ (prop, QCdecode_translation_table))
10560 if (! CHAR_TABLE_P (val) && ! CONSP (val))
10561 CHECK_SYMBOL (val);
10562 ASET (attrs, coding_attr_decode_tbl, val);
10564 else if (EQ (prop, QCencode_translation_table))
10566 if (! CHAR_TABLE_P (val) && ! CONSP (val))
10567 CHECK_SYMBOL (val);
10568 ASET (attrs, coding_attr_encode_tbl, val);
10570 else if (EQ (prop, QCpost_read_conversion))
10572 CHECK_SYMBOL (val);
10573 ASET (attrs, coding_attr_post_read, val);
10575 else if (EQ (prop, QCpre_write_conversion))
10577 CHECK_SYMBOL (val);
10578 ASET (attrs, coding_attr_pre_write, val);
10580 else if (EQ (prop, QCascii_compatible_p))
10582 ASET (attrs, coding_attr_ascii_compat, val);
10585 ASET (attrs, coding_attr_plist,
10586 Fplist_put (CODING_ATTR_PLIST (attrs), prop, val));
10587 return val;
10591 DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias,
10592 Sdefine_coding_system_alias, 2, 2, 0,
10593 doc: /* Define ALIAS as an alias for CODING-SYSTEM. */)
10594 (Lisp_Object alias, Lisp_Object coding_system)
10596 Lisp_Object spec, aliases, eol_type, val;
10598 CHECK_SYMBOL (alias);
10599 CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
10600 aliases = AREF (spec, 1);
10601 /* ALIASES should be a list of length more than zero, and the first
10602 element is a base coding system. Append ALIAS at the tail of the
10603 list. */
10604 while (!NILP (XCDR (aliases)))
10605 aliases = XCDR (aliases);
10606 XSETCDR (aliases, list1 (alias));
10608 eol_type = AREF (spec, 2);
10609 if (VECTORP (eol_type))
10611 Lisp_Object subsidiaries;
10612 int i;
10614 subsidiaries = make_subsidiaries (alias);
10615 for (i = 0; i < 3; i++)
10616 Fdefine_coding_system_alias (AREF (subsidiaries, i),
10617 AREF (eol_type, i));
10620 Fputhash (alias, spec, Vcoding_system_hash_table);
10621 Vcoding_system_list = Fcons (alias, Vcoding_system_list);
10622 val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist);
10623 if (NILP (val))
10624 Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (alias), Qnil),
10625 Vcoding_system_alist);
10627 return Qnil;
10630 DEFUN ("coding-system-base", Fcoding_system_base, Scoding_system_base,
10631 1, 1, 0,
10632 doc: /* Return the base of CODING-SYSTEM.
10633 Any alias or subsidiary coding system is not a base coding system. */)
10634 (Lisp_Object coding_system)
10636 Lisp_Object spec, attrs;
10638 if (NILP (coding_system))
10639 return (Qno_conversion);
10640 CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
10641 attrs = AREF (spec, 0);
10642 return CODING_ATTR_BASE_NAME (attrs);
10645 DEFUN ("coding-system-plist", Fcoding_system_plist, Scoding_system_plist,
10646 1, 1, 0,
10647 doc: "Return the property list of CODING-SYSTEM.")
10648 (Lisp_Object coding_system)
10650 Lisp_Object spec, attrs;
10652 if (NILP (coding_system))
10653 coding_system = Qno_conversion;
10654 CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
10655 attrs = AREF (spec, 0);
10656 return CODING_ATTR_PLIST (attrs);
10660 DEFUN ("coding-system-aliases", Fcoding_system_aliases, Scoding_system_aliases,
10661 1, 1, 0,
10662 doc: /* Return the list of aliases of CODING-SYSTEM. */)
10663 (Lisp_Object coding_system)
10665 Lisp_Object spec;
10667 if (NILP (coding_system))
10668 coding_system = Qno_conversion;
10669 CHECK_CODING_SYSTEM_GET_SPEC (coding_system, spec);
10670 return AREF (spec, 1);
10673 DEFUN ("coding-system-eol-type", Fcoding_system_eol_type,
10674 Scoding_system_eol_type, 1, 1, 0,
10675 doc: /* Return eol-type of CODING-SYSTEM.
10676 An eol-type is an integer 0, 1, 2, or a vector of coding systems.
10678 Integer values 0, 1, and 2 indicate a format of end-of-line; LF, CRLF,
10679 and CR respectively.
10681 A vector value indicates that a format of end-of-line should be
10682 detected automatically. Nth element of the vector is the subsidiary
10683 coding system whose eol-type is N. */)
10684 (Lisp_Object coding_system)
10686 Lisp_Object spec, eol_type;
10687 int n;
10689 if (NILP (coding_system))
10690 coding_system = Qno_conversion;
10691 if (! CODING_SYSTEM_P (coding_system))
10692 return Qnil;
10693 spec = CODING_SYSTEM_SPEC (coding_system);
10694 eol_type = AREF (spec, 2);
10695 if (VECTORP (eol_type))
10696 return Fcopy_sequence (eol_type);
10697 n = EQ (eol_type, Qunix) ? 0 : EQ (eol_type, Qdos) ? 1 : 2;
10698 return make_number (n);
10701 #endif /* emacs */
10704 /*** 9. Post-amble ***/
10706 void
10707 init_coding_once (void)
10709 int i;
10711 for (i = 0; i < coding_category_max; i++)
10713 coding_categories[i].id = -1;
10714 coding_priorities[i] = i;
10717 /* ISO2022 specific initialize routine. */
10718 for (i = 0; i < 0x20; i++)
10719 iso_code_class[i] = ISO_control_0;
10720 for (i = 0x21; i < 0x7F; i++)
10721 iso_code_class[i] = ISO_graphic_plane_0;
10722 for (i = 0x80; i < 0xA0; i++)
10723 iso_code_class[i] = ISO_control_1;
10724 for (i = 0xA1; i < 0xFF; i++)
10725 iso_code_class[i] = ISO_graphic_plane_1;
10726 iso_code_class[0x20] = iso_code_class[0x7F] = ISO_0x20_or_0x7F;
10727 iso_code_class[0xA0] = iso_code_class[0xFF] = ISO_0xA0_or_0xFF;
10728 iso_code_class[ISO_CODE_SO] = ISO_shift_out;
10729 iso_code_class[ISO_CODE_SI] = ISO_shift_in;
10730 iso_code_class[ISO_CODE_SS2_7] = ISO_single_shift_2_7;
10731 iso_code_class[ISO_CODE_ESC] = ISO_escape;
10732 iso_code_class[ISO_CODE_SS2] = ISO_single_shift_2;
10733 iso_code_class[ISO_CODE_SS3] = ISO_single_shift_3;
10734 iso_code_class[ISO_CODE_CSI] = ISO_control_sequence_introducer;
10736 for (i = 0; i < 256; i++)
10738 emacs_mule_bytes[i] = 1;
10740 emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_11] = 3;
10741 emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_12] = 3;
10742 emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_21] = 4;
10743 emacs_mule_bytes[EMACS_MULE_LEADING_CODE_PRIVATE_22] = 4;
10746 #ifdef emacs
10748 void
10749 syms_of_coding (void)
10751 staticpro (&Vcoding_system_hash_table);
10753 Lisp_Object args[2];
10754 args[0] = QCtest;
10755 args[1] = Qeq;
10756 Vcoding_system_hash_table = Fmake_hash_table (2, args);
10759 staticpro (&Vsjis_coding_system);
10760 Vsjis_coding_system = Qnil;
10762 staticpro (&Vbig5_coding_system);
10763 Vbig5_coding_system = Qnil;
10765 staticpro (&Vcode_conversion_reused_workbuf);
10766 Vcode_conversion_reused_workbuf = Qnil;
10768 staticpro (&Vcode_conversion_workbuf_name);
10769 Vcode_conversion_workbuf_name = build_pure_c_string (" *code-conversion-work*");
10771 reused_workbuf_in_use = 0;
10773 DEFSYM (Qcharset, "charset");
10774 DEFSYM (Qtarget_idx, "target-idx");
10775 DEFSYM (Qcoding_system_history, "coding-system-history");
10776 Fset (Qcoding_system_history, Qnil);
10778 /* Target FILENAME is the first argument. */
10779 Fput (Qinsert_file_contents, Qtarget_idx, make_number (0));
10780 /* Target FILENAME is the third argument. */
10781 Fput (Qwrite_region, Qtarget_idx, make_number (2));
10783 DEFSYM (Qcall_process, "call-process");
10784 /* Target PROGRAM is the first argument. */
10785 Fput (Qcall_process, Qtarget_idx, make_number (0));
10787 DEFSYM (Qcall_process_region, "call-process-region");
10788 /* Target PROGRAM is the third argument. */
10789 Fput (Qcall_process_region, Qtarget_idx, make_number (2));
10791 DEFSYM (Qstart_process, "start-process");
10792 /* Target PROGRAM is the third argument. */
10793 Fput (Qstart_process, Qtarget_idx, make_number (2));
10795 DEFSYM (Qopen_network_stream, "open-network-stream");
10796 /* Target SERVICE is the fourth argument. */
10797 Fput (Qopen_network_stream, Qtarget_idx, make_number (3));
10799 DEFSYM (Qcoding_system, "coding-system");
10800 DEFSYM (Qcoding_aliases, "coding-aliases");
10802 DEFSYM (Qeol_type, "eol-type");
10803 DEFSYM (Qunix, "unix");
10804 DEFSYM (Qdos, "dos");
10805 DEFSYM (Qmac, "mac");
10807 DEFSYM (Qbuffer_file_coding_system, "buffer-file-coding-system");
10808 DEFSYM (Qpost_read_conversion, "post-read-conversion");
10809 DEFSYM (Qpre_write_conversion, "pre-write-conversion");
10810 DEFSYM (Qdefault_char, "default-char");
10811 DEFSYM (Qundecided, "undecided");
10812 DEFSYM (Qno_conversion, "no-conversion");
10813 DEFSYM (Qraw_text, "raw-text");
10815 DEFSYM (Qiso_2022, "iso-2022");
10817 DEFSYM (Qutf_8, "utf-8");
10818 DEFSYM (Qutf_8_emacs, "utf-8-emacs");
10820 #if defined (WINDOWSNT) || defined (CYGWIN)
10821 /* No, not utf-16-le: that one has a BOM. */
10822 DEFSYM (Qutf_16le, "utf-16le");
10823 #endif
10825 DEFSYM (Qutf_16, "utf-16");
10826 DEFSYM (Qbig, "big");
10827 DEFSYM (Qlittle, "little");
10829 DEFSYM (Qshift_jis, "shift-jis");
10830 DEFSYM (Qbig5, "big5");
10832 DEFSYM (Qcoding_system_p, "coding-system-p");
10834 DEFSYM (Qcoding_system_error, "coding-system-error");
10835 Fput (Qcoding_system_error, Qerror_conditions,
10836 listn (CONSTYPE_PURE, 2, Qcoding_system_error, Qerror));
10837 Fput (Qcoding_system_error, Qerror_message,
10838 build_pure_c_string ("Invalid coding system"));
10840 DEFSYM (Qtranslation_table, "translation-table");
10841 Fput (Qtranslation_table, Qchar_table_extra_slots, make_number (2));
10842 DEFSYM (Qtranslation_table_id, "translation-table-id");
10843 DEFSYM (Qtranslation_table_for_decode, "translation-table-for-decode");
10844 DEFSYM (Qtranslation_table_for_encode, "translation-table-for-encode");
10846 DEFSYM (Qvalid_codes, "valid-codes");
10848 DEFSYM (Qemacs_mule, "emacs-mule");
10850 DEFSYM (QCcategory, ":category");
10851 DEFSYM (QCmnemonic, ":mnemonic");
10852 DEFSYM (QCdefault_char, ":default-char");
10853 DEFSYM (QCdecode_translation_table, ":decode-translation-table");
10854 DEFSYM (QCencode_translation_table, ":encode-translation-table");
10855 DEFSYM (QCpost_read_conversion, ":post-read-conversion");
10856 DEFSYM (QCpre_write_conversion, ":pre-write-conversion");
10857 DEFSYM (QCascii_compatible_p, ":ascii-compatible-p");
10859 Vcoding_category_table
10860 = Fmake_vector (make_number (coding_category_max), Qnil);
10861 staticpro (&Vcoding_category_table);
10862 /* Followings are target of code detection. */
10863 ASET (Vcoding_category_table, coding_category_iso_7,
10864 intern_c_string ("coding-category-iso-7"));
10865 ASET (Vcoding_category_table, coding_category_iso_7_tight,
10866 intern_c_string ("coding-category-iso-7-tight"));
10867 ASET (Vcoding_category_table, coding_category_iso_8_1,
10868 intern_c_string ("coding-category-iso-8-1"));
10869 ASET (Vcoding_category_table, coding_category_iso_8_2,
10870 intern_c_string ("coding-category-iso-8-2"));
10871 ASET (Vcoding_category_table, coding_category_iso_7_else,
10872 intern_c_string ("coding-category-iso-7-else"));
10873 ASET (Vcoding_category_table, coding_category_iso_8_else,
10874 intern_c_string ("coding-category-iso-8-else"));
10875 ASET (Vcoding_category_table, coding_category_utf_8_auto,
10876 intern_c_string ("coding-category-utf-8-auto"));
10877 ASET (Vcoding_category_table, coding_category_utf_8_nosig,
10878 intern_c_string ("coding-category-utf-8"));
10879 ASET (Vcoding_category_table, coding_category_utf_8_sig,
10880 intern_c_string ("coding-category-utf-8-sig"));
10881 ASET (Vcoding_category_table, coding_category_utf_16_be,
10882 intern_c_string ("coding-category-utf-16-be"));
10883 ASET (Vcoding_category_table, coding_category_utf_16_auto,
10884 intern_c_string ("coding-category-utf-16-auto"));
10885 ASET (Vcoding_category_table, coding_category_utf_16_le,
10886 intern_c_string ("coding-category-utf-16-le"));
10887 ASET (Vcoding_category_table, coding_category_utf_16_be_nosig,
10888 intern_c_string ("coding-category-utf-16-be-nosig"));
10889 ASET (Vcoding_category_table, coding_category_utf_16_le_nosig,
10890 intern_c_string ("coding-category-utf-16-le-nosig"));
10891 ASET (Vcoding_category_table, coding_category_charset,
10892 intern_c_string ("coding-category-charset"));
10893 ASET (Vcoding_category_table, coding_category_sjis,
10894 intern_c_string ("coding-category-sjis"));
10895 ASET (Vcoding_category_table, coding_category_big5,
10896 intern_c_string ("coding-category-big5"));
10897 ASET (Vcoding_category_table, coding_category_ccl,
10898 intern_c_string ("coding-category-ccl"));
10899 ASET (Vcoding_category_table, coding_category_emacs_mule,
10900 intern_c_string ("coding-category-emacs-mule"));
10901 /* Followings are NOT target of code detection. */
10902 ASET (Vcoding_category_table, coding_category_raw_text,
10903 intern_c_string ("coding-category-raw-text"));
10904 ASET (Vcoding_category_table, coding_category_undecided,
10905 intern_c_string ("coding-category-undecided"));
10907 DEFSYM (Qinsufficient_source, "insufficient-source");
10908 DEFSYM (Qinvalid_source, "invalid-source");
10909 DEFSYM (Qinterrupted, "interrupted");
10910 DEFSYM (Qcoding_system_define_form, "coding-system-define-form");
10912 defsubr (&Scoding_system_p);
10913 defsubr (&Sread_coding_system);
10914 defsubr (&Sread_non_nil_coding_system);
10915 defsubr (&Scheck_coding_system);
10916 defsubr (&Sdetect_coding_region);
10917 defsubr (&Sdetect_coding_string);
10918 defsubr (&Sfind_coding_systems_region_internal);
10919 defsubr (&Sunencodable_char_position);
10920 defsubr (&Scheck_coding_systems_region);
10921 defsubr (&Sdecode_coding_region);
10922 defsubr (&Sencode_coding_region);
10923 defsubr (&Sdecode_coding_string);
10924 defsubr (&Sencode_coding_string);
10925 defsubr (&Sdecode_sjis_char);
10926 defsubr (&Sencode_sjis_char);
10927 defsubr (&Sdecode_big5_char);
10928 defsubr (&Sencode_big5_char);
10929 defsubr (&Sset_terminal_coding_system_internal);
10930 defsubr (&Sset_safe_terminal_coding_system_internal);
10931 defsubr (&Sterminal_coding_system);
10932 defsubr (&Sset_keyboard_coding_system_internal);
10933 defsubr (&Skeyboard_coding_system);
10934 defsubr (&Sfind_operation_coding_system);
10935 defsubr (&Sset_coding_system_priority);
10936 defsubr (&Sdefine_coding_system_internal);
10937 defsubr (&Sdefine_coding_system_alias);
10938 defsubr (&Scoding_system_put);
10939 defsubr (&Scoding_system_base);
10940 defsubr (&Scoding_system_plist);
10941 defsubr (&Scoding_system_aliases);
10942 defsubr (&Scoding_system_eol_type);
10943 defsubr (&Scoding_system_priority_list);
10945 DEFVAR_LISP ("coding-system-list", Vcoding_system_list,
10946 doc: /* List of coding systems.
10948 Do not alter the value of this variable manually. This variable should be
10949 updated by the functions `define-coding-system' and
10950 `define-coding-system-alias'. */);
10951 Vcoding_system_list = Qnil;
10953 DEFVAR_LISP ("coding-system-alist", Vcoding_system_alist,
10954 doc: /* Alist of coding system names.
10955 Each element is one element list of coding system name.
10956 This variable is given to `completing-read' as COLLECTION argument.
10958 Do not alter the value of this variable manually. This variable should be
10959 updated by the functions `make-coding-system' and
10960 `define-coding-system-alias'. */);
10961 Vcoding_system_alist = Qnil;
10963 DEFVAR_LISP ("coding-category-list", Vcoding_category_list,
10964 doc: /* List of coding-categories (symbols) ordered by priority.
10966 On detecting a coding system, Emacs tries code detection algorithms
10967 associated with each coding-category one by one in this order. When
10968 one algorithm agrees with a byte sequence of source text, the coding
10969 system bound to the corresponding coding-category is selected.
10971 Don't modify this variable directly, but use `set-coding-system-priority'. */);
10973 int i;
10975 Vcoding_category_list = Qnil;
10976 for (i = coding_category_max - 1; i >= 0; i--)
10977 Vcoding_category_list
10978 = Fcons (AREF (Vcoding_category_table, i),
10979 Vcoding_category_list);
10982 DEFVAR_LISP ("coding-system-for-read", Vcoding_system_for_read,
10983 doc: /* Specify the coding system for read operations.
10984 It is useful to bind this variable with `let', but do not set it globally.
10985 If the value is a coding system, it is used for decoding on read operation.
10986 If not, an appropriate element is used from one of the coding system alists.
10987 There are three such tables: `file-coding-system-alist',
10988 `process-coding-system-alist', and `network-coding-system-alist'. */);
10989 Vcoding_system_for_read = Qnil;
10991 DEFVAR_LISP ("coding-system-for-write", Vcoding_system_for_write,
10992 doc: /* Specify the coding system for write operations.
10993 Programs bind this variable with `let', but you should not set it globally.
10994 If the value is a coding system, it is used for encoding of output,
10995 when writing it to a file and when sending it to a file or subprocess.
10997 If this does not specify a coding system, an appropriate element
10998 is used from one of the coding system alists.
10999 There are three such tables: `file-coding-system-alist',
11000 `process-coding-system-alist', and `network-coding-system-alist'.
11001 For output to files, if the above procedure does not specify a coding system,
11002 the value of `buffer-file-coding-system' is used. */);
11003 Vcoding_system_for_write = Qnil;
11005 DEFVAR_LISP ("last-coding-system-used", Vlast_coding_system_used,
11006 doc: /*
11007 Coding system used in the latest file or process I/O. */);
11008 Vlast_coding_system_used = Qnil;
11010 DEFVAR_LISP ("last-code-conversion-error", Vlast_code_conversion_error,
11011 doc: /*
11012 Error status of the last code conversion.
11014 When an error was detected in the last code conversion, this variable
11015 is set to one of the following symbols.
11016 `insufficient-source'
11017 `inconsistent-eol'
11018 `invalid-source'
11019 `interrupted'
11020 `insufficient-memory'
11021 When no error was detected, the value doesn't change. So, to check
11022 the error status of a code conversion by this variable, you must
11023 explicitly set this variable to nil before performing code
11024 conversion. */);
11025 Vlast_code_conversion_error = Qnil;
11027 DEFVAR_BOOL ("inhibit-eol-conversion", inhibit_eol_conversion,
11028 doc: /*
11029 *Non-nil means always inhibit code conversion of end-of-line format.
11030 See info node `Coding Systems' and info node `Text and Binary' concerning
11031 such conversion. */);
11032 inhibit_eol_conversion = 0;
11034 DEFVAR_BOOL ("inherit-process-coding-system", inherit_process_coding_system,
11035 doc: /*
11036 Non-nil means process buffer inherits coding system of process output.
11037 Bind it to t if the process output is to be treated as if it were a file
11038 read from some filesystem. */);
11039 inherit_process_coding_system = 0;
11041 DEFVAR_LISP ("file-coding-system-alist", Vfile_coding_system_alist,
11042 doc: /*
11043 Alist to decide a coding system to use for a file I/O operation.
11044 The format is ((PATTERN . VAL) ...),
11045 where PATTERN is a regular expression matching a file name,
11046 VAL is a coding system, a cons of coding systems, or a function symbol.
11047 If VAL is a coding system, it is used for both decoding and encoding
11048 the file contents.
11049 If VAL is a cons of coding systems, the car part is used for decoding,
11050 and the cdr part is used for encoding.
11051 If VAL is a function symbol, the function must return a coding system
11052 or a cons of coding systems which are used as above. The function is
11053 called with an argument that is a list of the arguments with which
11054 `find-operation-coding-system' was called. If the function can't decide
11055 a coding system, it can return `undecided' so that the normal
11056 code-detection is performed.
11058 See also the function `find-operation-coding-system'
11059 and the variable `auto-coding-alist'. */);
11060 Vfile_coding_system_alist = Qnil;
11062 DEFVAR_LISP ("process-coding-system-alist", Vprocess_coding_system_alist,
11063 doc: /*
11064 Alist to decide a coding system to use for a process I/O operation.
11065 The format is ((PATTERN . VAL) ...),
11066 where PATTERN is a regular expression matching a program name,
11067 VAL is a coding system, a cons of coding systems, or a function symbol.
11068 If VAL is a coding system, it is used for both decoding what received
11069 from the program and encoding what sent to the program.
11070 If VAL is a cons of coding systems, the car part is used for decoding,
11071 and the cdr part is used for encoding.
11072 If VAL is a function symbol, the function must return a coding system
11073 or a cons of coding systems which are used as above.
11075 See also the function `find-operation-coding-system'. */);
11076 Vprocess_coding_system_alist = Qnil;
11078 DEFVAR_LISP ("network-coding-system-alist", Vnetwork_coding_system_alist,
11079 doc: /*
11080 Alist to decide a coding system to use for a network I/O operation.
11081 The format is ((PATTERN . VAL) ...),
11082 where PATTERN is a regular expression matching a network service name
11083 or is a port number to connect to,
11084 VAL is a coding system, a cons of coding systems, or a function symbol.
11085 If VAL is a coding system, it is used for both decoding what received
11086 from the network stream and encoding what sent to the network stream.
11087 If VAL is a cons of coding systems, the car part is used for decoding,
11088 and the cdr part is used for encoding.
11089 If VAL is a function symbol, the function must return a coding system
11090 or a cons of coding systems which are used as above.
11092 See also the function `find-operation-coding-system'. */);
11093 Vnetwork_coding_system_alist = Qnil;
11095 DEFVAR_LISP ("locale-coding-system", Vlocale_coding_system,
11096 doc: /* Coding system to use with system messages.
11097 Also used for decoding keyboard input on X Window system. */);
11098 Vlocale_coding_system = Qnil;
11100 /* The eol mnemonics are reset in startup.el system-dependently. */
11101 DEFVAR_LISP ("eol-mnemonic-unix", eol_mnemonic_unix,
11102 doc: /*
11103 *String displayed in mode line for UNIX-like (LF) end-of-line format. */);
11104 eol_mnemonic_unix = build_pure_c_string (":");
11106 DEFVAR_LISP ("eol-mnemonic-dos", eol_mnemonic_dos,
11107 doc: /*
11108 *String displayed in mode line for DOS-like (CRLF) end-of-line format. */);
11109 eol_mnemonic_dos = build_pure_c_string ("\\");
11111 DEFVAR_LISP ("eol-mnemonic-mac", eol_mnemonic_mac,
11112 doc: /*
11113 *String displayed in mode line for MAC-like (CR) end-of-line format. */);
11114 eol_mnemonic_mac = build_pure_c_string ("/");
11116 DEFVAR_LISP ("eol-mnemonic-undecided", eol_mnemonic_undecided,
11117 doc: /*
11118 *String displayed in mode line when end-of-line format is not yet determined. */);
11119 eol_mnemonic_undecided = build_pure_c_string (":");
11121 DEFVAR_LISP ("enable-character-translation", Venable_character_translation,
11122 doc: /*
11123 *Non-nil enables character translation while encoding and decoding. */);
11124 Venable_character_translation = Qt;
11126 DEFVAR_LISP ("standard-translation-table-for-decode",
11127 Vstandard_translation_table_for_decode,
11128 doc: /* Table for translating characters while decoding. */);
11129 Vstandard_translation_table_for_decode = Qnil;
11131 DEFVAR_LISP ("standard-translation-table-for-encode",
11132 Vstandard_translation_table_for_encode,
11133 doc: /* Table for translating characters while encoding. */);
11134 Vstandard_translation_table_for_encode = Qnil;
11136 DEFVAR_LISP ("charset-revision-table", Vcharset_revision_table,
11137 doc: /* Alist of charsets vs revision numbers.
11138 While encoding, if a charset (car part of an element) is found,
11139 designate it with the escape sequence identifying revision (cdr part
11140 of the element). */);
11141 Vcharset_revision_table = Qnil;
11143 DEFVAR_LISP ("default-process-coding-system",
11144 Vdefault_process_coding_system,
11145 doc: /* Cons of coding systems used for process I/O by default.
11146 The car part is used for decoding a process output,
11147 the cdr part is used for encoding a text to be sent to a process. */);
11148 Vdefault_process_coding_system = Qnil;
11150 DEFVAR_LISP ("latin-extra-code-table", Vlatin_extra_code_table,
11151 doc: /*
11152 Table of extra Latin codes in the range 128..159 (inclusive).
11153 This is a vector of length 256.
11154 If Nth element is non-nil, the existence of code N in a file
11155 \(or output of subprocess) doesn't prevent it to be detected as
11156 a coding system of ISO 2022 variant which has a flag
11157 `accept-latin-extra-code' t (e.g. iso-latin-1) on reading a file
11158 or reading output of a subprocess.
11159 Only 128th through 159th elements have a meaning. */);
11160 Vlatin_extra_code_table = Fmake_vector (make_number (256), Qnil);
11162 DEFVAR_LISP ("select-safe-coding-system-function",
11163 Vselect_safe_coding_system_function,
11164 doc: /*
11165 Function to call to select safe coding system for encoding a text.
11167 If set, this function is called to force a user to select a proper
11168 coding system which can encode the text in the case that a default
11169 coding system used in each operation can't encode the text. The
11170 function should take care that the buffer is not modified while
11171 the coding system is being selected.
11173 The default value is `select-safe-coding-system' (which see). */);
11174 Vselect_safe_coding_system_function = Qnil;
11176 DEFVAR_BOOL ("coding-system-require-warning",
11177 coding_system_require_warning,
11178 doc: /* Internal use only.
11179 If non-nil, on writing a file, `select-safe-coding-system-function' is
11180 called even if `coding-system-for-write' is non-nil. The command
11181 `universal-coding-system-argument' binds this variable to t temporarily. */);
11182 coding_system_require_warning = 0;
11185 DEFVAR_BOOL ("inhibit-iso-escape-detection",
11186 inhibit_iso_escape_detection,
11187 doc: /*
11188 If non-nil, Emacs ignores ISO-2022 escape sequences during code detection.
11190 When Emacs reads text, it tries to detect how the text is encoded.
11191 This code detection is sensitive to escape sequences. If Emacs sees
11192 a valid ISO-2022 escape sequence, it assumes the text is encoded in one
11193 of the ISO2022 encodings, and decodes text by the corresponding coding
11194 system (e.g. `iso-2022-7bit').
11196 However, there may be a case that you want to read escape sequences in
11197 a file as is. In such a case, you can set this variable to non-nil.
11198 Then the code detection will ignore any escape sequences, and no text is
11199 detected as encoded in some ISO-2022 encoding. The result is that all
11200 escape sequences become visible in a buffer.
11202 The default value is nil, and it is strongly recommended not to change
11203 it. That is because many Emacs Lisp source files that contain
11204 non-ASCII characters are encoded by the coding system `iso-2022-7bit'
11205 in Emacs's distribution, and they won't be decoded correctly on
11206 reading if you suppress escape sequence detection.
11208 The other way to read escape sequences in a file without decoding is
11209 to explicitly specify some coding system that doesn't use ISO-2022
11210 escape sequence (e.g., `latin-1') on reading by \\[universal-coding-system-argument]. */);
11211 inhibit_iso_escape_detection = 0;
11213 DEFVAR_BOOL ("inhibit-null-byte-detection",
11214 inhibit_null_byte_detection,
11215 doc: /* If non-nil, Emacs ignores null bytes on code detection.
11216 By default, Emacs treats it as binary data, and does not attempt to
11217 decode it. The effect is as if you specified `no-conversion' for
11218 reading that text.
11220 Set this to non-nil when a regular text happens to include null bytes.
11221 Examples are Index nodes of Info files and null-byte delimited output
11222 from GNU Find and GNU Grep. Emacs will then ignore the null bytes and
11223 decode text as usual. */);
11224 inhibit_null_byte_detection = 0;
11226 DEFVAR_BOOL ("disable-ascii-optimization", disable_ascii_optimization,
11227 doc: /* If non-nil, Emacs does not optimize code decoder for ASCII files.
11228 Internal use only. Removed after the experimental optimizer gets stable. */);
11229 disable_ascii_optimization = 0;
11231 DEFVAR_LISP ("translation-table-for-input", Vtranslation_table_for_input,
11232 doc: /* Char table for translating self-inserting characters.
11233 This is applied to the result of input methods, not their input.
11234 See also `keyboard-translate-table'.
11236 Use of this variable for character code unification was rendered
11237 obsolete in Emacs 23.1 and later, since Unicode is now the basis of
11238 internal character representation. */);
11239 Vtranslation_table_for_input = Qnil;
11242 Lisp_Object args[coding_arg_undecided_max];
11243 Lisp_Object plist[16];
11244 int i;
11246 for (i = 0; i < coding_arg_undecided_max; i++)
11247 args[i] = Qnil;
11249 plist[0] = intern_c_string (":name");
11250 plist[1] = args[coding_arg_name] = Qno_conversion;
11251 plist[2] = intern_c_string (":mnemonic");
11252 plist[3] = args[coding_arg_mnemonic] = make_number ('=');
11253 plist[4] = intern_c_string (":coding-type");
11254 plist[5] = args[coding_arg_coding_type] = Qraw_text;
11255 plist[6] = intern_c_string (":ascii-compatible-p");
11256 plist[7] = args[coding_arg_ascii_compatible_p] = Qt;
11257 plist[8] = intern_c_string (":default-char");
11258 plist[9] = args[coding_arg_default_char] = make_number (0);
11259 plist[10] = intern_c_string (":for-unibyte");
11260 plist[11] = args[coding_arg_for_unibyte] = Qt;
11261 plist[12] = intern_c_string (":docstring");
11262 plist[13] = build_pure_c_string ("Do no conversion.\n\
11264 When you visit a file with this coding, the file is read into a\n\
11265 unibyte buffer as is, thus each byte of a file is treated as a\n\
11266 character.");
11267 plist[14] = intern_c_string (":eol-type");
11268 plist[15] = args[coding_arg_eol_type] = Qunix;
11269 args[coding_arg_plist] = Flist (16, plist);
11270 Fdefine_coding_system_internal (coding_arg_max, args);
11272 plist[1] = args[coding_arg_name] = Qundecided;
11273 plist[3] = args[coding_arg_mnemonic] = make_number ('-');
11274 plist[5] = args[coding_arg_coding_type] = Qundecided;
11275 /* This is already set.
11276 plist[7] = args[coding_arg_ascii_compatible_p] = Qt; */
11277 plist[8] = intern_c_string (":charset-list");
11278 plist[9] = args[coding_arg_charset_list] = Fcons (Qascii, Qnil);
11279 plist[11] = args[coding_arg_for_unibyte] = Qnil;
11280 plist[13] = build_pure_c_string ("No conversion on encoding, automatic conversion on decoding.");
11281 plist[15] = args[coding_arg_eol_type] = Qnil;
11282 args[coding_arg_plist] = Flist (16, plist);
11283 args[coding_arg_undecided_inhibit_null_byte_detection] = make_number (0);
11284 args[coding_arg_undecided_inhibit_iso_escape_detection] = make_number (0);
11285 Fdefine_coding_system_internal (coding_arg_undecided_max, args);
11288 setup_coding_system (Qno_conversion, &safe_terminal_coding);
11291 int i;
11293 for (i = 0; i < coding_category_max; i++)
11294 Fset (AREF (Vcoding_category_table, i), Qno_conversion);
11296 #if defined (DOS_NT)
11297 system_eol_type = Qdos;
11298 #else
11299 system_eol_type = Qunix;
11300 #endif
11301 staticpro (&system_eol_type);
11304 char *
11305 emacs_strerror (int error_number)
11307 char *str;
11309 synchronize_system_messages_locale ();
11310 str = strerror (error_number);
11312 if (! NILP (Vlocale_coding_system))
11314 Lisp_Object dec = code_convert_string_norecord (build_string (str),
11315 Vlocale_coding_system,
11317 str = SSDATA (dec);
11320 return str;
11323 #endif /* emacs */