1 /* Coding system handler (conversion, detection, etc).
2 Copyright (C) 2001, 2002, 2003, 2004, 2005,
3 2006, 2007 Free Software Foundation, Inc.
4 Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
6 National Institute of Advanced Industrial Science and Technology (AIST)
7 Registration Number H14PRO021
9 National Institute of Advanced Industrial Science and Technology (AIST)
10 Registration Number H13PRO009
12 This file is part of GNU Emacs.
14 GNU Emacs is free software; you can redistribute it and/or modify
15 it under the terms of the GNU General Public License as published by
16 the Free Software Foundation; either version 3, or (at your option)
19 GNU Emacs is distributed in the hope that it will be useful,
20 but WITHOUT ANY WARRANTY; without even the implied warranty of
21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 GNU General Public License for more details.
24 You should have received a copy of the GNU General Public License
25 along with GNU Emacs; see the file COPYING. If not, write to
26 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27 Boston, MA 02110-1301, USA. */
29 /*** TABLE OF CONTENTS ***
33 2. Emacs' internal format (emacs-utf-8) handlers
36 5. Charset-base coding systems handlers
37 6. emacs-mule (old Emacs' internal format) handlers
39 8. Shift-JIS and BIG5 handlers
41 10. C library functions
42 11. Emacs Lisp library functions
47 /*** 0. General comments ***
52 A coding system is an object for an encoding mechanism that contains
53 information about how to convert byte sequences to character
54 sequences and vice versa. When we say "decode", it means converting
55 a byte sequence of a specific coding system into a character
56 sequence that is represented by Emacs' internal coding system
57 `emacs-utf-8', and when we say "encode", it means converting a
58 character sequence of emacs-utf-8 to a byte sequence of a specific
61 In Emacs Lisp, a coding system is represented by a Lisp symbol. In
62 C level, a coding system is represented by a vector of attributes
63 stored in the hash table Vcharset_hash_table. The conversion from
64 coding system symbol to attributes vector is done by looking up
65 Vcharset_hash_table by the symbol.
67 Coding systems are classified into the following types depending on
68 the encoding mechanism. Here's a brief description of the types.
74 o Charset-base coding system
76 A coding system defined by one or more (coded) character sets.
77 Decoding and encoding are done by a code converter defined for each
80 o Old Emacs internal format (emacs-mule)
82 The coding system adopted by old versions of Emacs (20 and 21).
84 o ISO2022-base coding system
86 The most famous coding system for multiple character sets. X's
87 Compound Text, various EUCs (Extended Unix Code), and coding systems
88 used in the Internet communication such as ISO-2022-JP are all
91 o SJIS (or Shift-JIS or MS-Kanji-Code)
93 A coding system to encode character sets: ASCII, JISX0201, and
94 JISX0208. Widely used for PC's in Japan. Details are described in
99 A coding system to encode character sets: ASCII and Big5. Widely
100 used for Chinese (mainly in Taiwan and Hong Kong). Details are
101 described in section 8. In this file, when we write "big5" (all
102 lowercase), we mean the coding system, and when we write "Big5"
103 (capitalized), we mean the character set.
107 If a user wants to decode/encode text encoded in a coding system
108 not listed above, he can supply a decoder and an encoder for it in
109 CCL (Code Conversion Language) programs. Emacs executes the CCL
110 program while decoding/encoding.
114 A coding system for text containing raw eight-bit data. Emacs
115 treats each byte of source text as a character (except for
116 end-of-line conversion).
120 Like raw text, but don't do end-of-line conversion.
125 How text end-of-line is encoded depends on operating system. For
126 instance, Unix's format is just one byte of LF (line-feed) code,
127 whereas DOS's format is two-byte sequence of `carriage-return' and
128 `line-feed' codes. MacOS's format is usually one byte of
131 Since text character encoding and end-of-line encoding are
132 independent, any coding system described above can take any format
133 of end-of-line (except for no-conversion).
137 Before using a coding system for code conversion (i.e. decoding and
138 encoding), we setup a structure of type `struct coding_system'.
139 This structure keeps various information about a specific code
140 conversion (e.g. the location of source and destination data).
147 /*** GENERAL NOTES on `detect_coding_XXX ()' functions ***
149 These functions check if a byte sequence specified as a source in
150 CODING conforms to the format of XXX, and update the members of
153 Return 1 if the byte sequence conforms to XXX, otherwise return 0.
155 Below is the template of these functions. */
159 detect_coding_XXX (coding
, detect_info
)
160 struct coding_system
*coding
;
161 struct coding_detection_info
*detect_info
;
163 const unsigned char *src
= coding
->source
;
164 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
165 int multibytep
= coding
->src_multibyte
;
166 int consumed_chars
= 0;
172 /* Get one byte from the source. If the souce is exausted, jump
173 to no_more_source:. */
176 if (! __C_conforms_to_XXX___ (c
))
178 if (! __C_strongly_suggests_XXX__ (c
))
179 found
= CATEGORY_MASK_XXX
;
181 /* The byte sequence is invalid for XXX. */
182 detect_info
->rejected
|= CATEGORY_MASK_XXX
;
186 /* The source exausted successfully. */
187 detect_info
->found
|= found
;
192 /*** GENERAL NOTES on `decode_coding_XXX ()' functions ***
194 These functions decode a byte sequence specified as a source by
195 CODING. The resulting multibyte text goes to a place pointed to by
196 CODING->charbuf, the length of which should not exceed
197 CODING->charbuf_size;
199 These functions set the information of original and decoded texts in
200 CODING->consumed, CODING->consumed_char, and CODING->charbuf_used.
201 They also set CODING->result to one of CODING_RESULT_XXX indicating
202 how the decoding is finished.
204 Below is the template of these functions. */
208 decode_coding_XXXX (coding
)
209 struct coding_system
*coding
;
211 const unsigned char *src
= coding
->source
+ coding
->consumed
;
212 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
213 /* SRC_BASE remembers the start position in source in each loop.
214 The loop will be exited when there's not enough source code, or
215 when there's no room in CHARBUF for a decoded character. */
216 const unsigned char *src_base
;
217 /* A buffer to produce decoded characters. */
218 int *charbuf
= coding
->charbuf
+ coding
->charbuf_used
;
219 int *charbuf_end
= coding
->charbuf
+ coding
->charbuf_size
;
220 int multibytep
= coding
->src_multibyte
;
225 if (charbuf
< charbuf_end
)
226 /* No more room to produce a decoded character. */
233 if (src_base
< src_end
234 && coding
->mode
& CODING_MODE_LAST_BLOCK
)
235 /* If the source ends by partial bytes to construct a character,
236 treat them as eight-bit raw data. */
237 while (src_base
< src_end
&& charbuf
< charbuf_end
)
238 *charbuf
++ = *src_base
++;
239 /* Remember how many bytes and characters we consumed. If the
240 source is multibyte, the bytes and chars are not identical. */
241 coding
->consumed
= coding
->consumed_char
= src_base
- coding
->source
;
242 /* Remember how many characters we produced. */
243 coding
->charbuf_used
= charbuf
- coding
->charbuf
;
247 /*** GENERAL NOTES on `encode_coding_XXX ()' functions ***
249 These functions encode SRC_BYTES length text at SOURCE of Emacs'
250 internal multibyte format by CODING. The resulting byte sequence
251 goes to a place pointed to by DESTINATION, the length of which
252 should not exceed DST_BYTES.
254 These functions set the information of original and encoded texts in
255 the members produced, produced_char, consumed, and consumed_char of
256 the structure *CODING. They also set the member result to one of
257 CODING_RESULT_XXX indicating how the encoding finished.
259 DST_BYTES zero means that source area and destination area are
260 overlapped, which means that we can produce a encoded text until it
261 reaches at the head of not-yet-encoded source text.
263 Below is a template of these functions. */
266 encode_coding_XXX (coding
)
267 struct coding_system
*coding
;
269 int multibytep
= coding
->dst_multibyte
;
270 int *charbuf
= coding
->charbuf
;
271 int *charbuf_end
= charbuf
->charbuf
+ coding
->charbuf_used
;
272 unsigned char *dst
= coding
->destination
+ coding
->produced
;
273 unsigned char *dst_end
= coding
->destination
+ coding
->dst_bytes
;
274 unsigned char *adjusted_dst_end
= dst_end
- _MAX_BYTES_PRODUCED_IN_LOOP_
;
275 int produced_chars
= 0;
277 for (; charbuf
< charbuf_end
&& dst
< adjusted_dst_end
; charbuf
++)
280 /* Encode C into DST, and increment DST. */
282 label_no_more_destination
:
283 /* How many chars and bytes we produced. */
284 coding
->produced_char
+= produced_chars
;
285 coding
->produced
= dst
- coding
->destination
;
290 /*** 1. Preamble ***/
297 #include "character.h"
300 #include "composite.h"
304 #include "termhooks.h"
306 Lisp_Object Vcoding_system_hash_table
;
308 Lisp_Object Qcoding_system
, Qcoding_aliases
, Qeol_type
;
309 Lisp_Object Qunix
, Qdos
;
310 extern Lisp_Object Qmac
; /* frame.c */
311 Lisp_Object Qbuffer_file_coding_system
;
312 Lisp_Object Qpost_read_conversion
, Qpre_write_conversion
;
313 Lisp_Object Qdefault_char
;
314 Lisp_Object Qno_conversion
, Qundecided
;
315 Lisp_Object Qcharset
, Qiso_2022
, Qutf_8
, Qutf_16
, Qshift_jis
, Qbig5
;
316 Lisp_Object Qbig
, Qlittle
;
317 Lisp_Object Qcoding_system_history
;
318 Lisp_Object Qvalid_codes
;
319 Lisp_Object QCcategory
, QCmnemonic
, QCdefalut_char
;
320 Lisp_Object QCdecode_translation_table
, QCencode_translation_table
;
321 Lisp_Object QCpost_read_conversion
, QCpre_write_conversion
;
322 Lisp_Object QCascii_compatible_p
;
324 extern Lisp_Object Qinsert_file_contents
, Qwrite_region
;
325 Lisp_Object Qcall_process
, Qcall_process_region
;
326 Lisp_Object Qstart_process
, Qopen_network_stream
;
327 Lisp_Object Qtarget_idx
;
329 Lisp_Object Qinsufficient_source
, Qinconsistent_eol
, Qinvalid_source
;
330 Lisp_Object Qinterrupted
, Qinsufficient_memory
;
332 /* If a symbol has this property, evaluate the value to define the
333 symbol as a coding system. */
334 static Lisp_Object Qcoding_system_define_form
;
336 int coding_system_require_warning
;
338 Lisp_Object Vselect_safe_coding_system_function
;
340 /* Mnemonic string for each format of end-of-line. */
341 Lisp_Object eol_mnemonic_unix
, eol_mnemonic_dos
, eol_mnemonic_mac
;
342 /* Mnemonic string to indicate format of end-of-line is not yet
344 Lisp_Object eol_mnemonic_undecided
;
346 /* Format of end-of-line decided by system. This is Qunix on
347 Unix and Mac, Qdos on DOS/Windows.
348 This has an effect only for external encoding (i.e. for output to
349 file and process), not for in-buffer or Lisp string encoding. */
350 static Lisp_Object system_eol_type
;
354 Lisp_Object Vcoding_system_list
, Vcoding_system_alist
;
356 Lisp_Object Qcoding_system_p
, Qcoding_system_error
;
358 /* Coding system emacs-mule and raw-text are for converting only
359 end-of-line format. */
360 Lisp_Object Qemacs_mule
, Qraw_text
;
361 Lisp_Object Qutf_8_emacs
;
363 /* Coding-systems are handed between Emacs Lisp programs and C internal
364 routines by the following three variables. */
365 /* Coding-system for reading files and receiving data from process. */
366 Lisp_Object Vcoding_system_for_read
;
367 /* Coding-system for writing files and sending data to process. */
368 Lisp_Object Vcoding_system_for_write
;
369 /* Coding-system actually used in the latest I/O. */
370 Lisp_Object Vlast_coding_system_used
;
371 /* Set to non-nil when an error is detected while code conversion. */
372 Lisp_Object Vlast_code_conversion_error
;
373 /* A vector of length 256 which contains information about special
374 Latin codes (especially for dealing with Microsoft codes). */
375 Lisp_Object Vlatin_extra_code_table
;
377 /* Flag to inhibit code conversion of end-of-line format. */
378 int inhibit_eol_conversion
;
380 /* Flag to inhibit ISO2022 escape sequence detection. */
381 int inhibit_iso_escape_detection
;
383 /* Flag to make buffer-file-coding-system inherit from process-coding. */
384 int inherit_process_coding_system
;
386 /* Coding system to be used to encode text for terminal display when
387 terminal coding system is nil. */
388 struct coding_system safe_terminal_coding
;
390 Lisp_Object Vfile_coding_system_alist
;
391 Lisp_Object Vprocess_coding_system_alist
;
392 Lisp_Object Vnetwork_coding_system_alist
;
394 Lisp_Object Vlocale_coding_system
;
398 /* Flag to tell if we look up translation table on character code
400 Lisp_Object Venable_character_translation
;
401 /* Standard translation table to look up on decoding (reading). */
402 Lisp_Object Vstandard_translation_table_for_decode
;
403 /* Standard translation table to look up on encoding (writing). */
404 Lisp_Object Vstandard_translation_table_for_encode
;
406 Lisp_Object Qtranslation_table
;
407 Lisp_Object Qtranslation_table_id
;
408 Lisp_Object Qtranslation_table_for_decode
;
409 Lisp_Object Qtranslation_table_for_encode
;
411 /* Alist of charsets vs revision number. */
412 static Lisp_Object Vcharset_revision_table
;
414 /* Default coding systems used for process I/O. */
415 Lisp_Object Vdefault_process_coding_system
;
417 /* Char table for translating Quail and self-inserting input. */
418 Lisp_Object Vtranslation_table_for_input
;
420 /* Two special coding systems. */
421 Lisp_Object Vsjis_coding_system
;
422 Lisp_Object Vbig5_coding_system
;
424 /* ISO2022 section */
426 #define CODING_ISO_INITIAL(coding, reg) \
427 (XINT (AREF (AREF (CODING_ID_ATTRS ((coding)->id), \
428 coding_attr_iso_initial), \
432 #define CODING_ISO_REQUEST(coding, charset_id) \
433 ((charset_id <= (coding)->max_charset_id \
434 ? (coding)->safe_charsets[charset_id] \
438 #define CODING_ISO_FLAGS(coding) \
439 ((coding)->spec.iso_2022.flags)
440 #define CODING_ISO_DESIGNATION(coding, reg) \
441 ((coding)->spec.iso_2022.current_designation[reg])
442 #define CODING_ISO_INVOCATION(coding, plane) \
443 ((coding)->spec.iso_2022.current_invocation[plane])
444 #define CODING_ISO_SINGLE_SHIFTING(coding) \
445 ((coding)->spec.iso_2022.single_shifting)
446 #define CODING_ISO_BOL(coding) \
447 ((coding)->spec.iso_2022.bol)
448 #define CODING_ISO_INVOKED_CHARSET(coding, plane) \
449 CODING_ISO_DESIGNATION ((coding), CODING_ISO_INVOCATION ((coding), (plane)))
451 /* Control characters of ISO2022. */
452 /* code */ /* function */
453 #define ISO_CODE_LF 0x0A /* line-feed */
454 #define ISO_CODE_CR 0x0D /* carriage-return */
455 #define ISO_CODE_SO 0x0E /* shift-out */
456 #define ISO_CODE_SI 0x0F /* shift-in */
457 #define ISO_CODE_SS2_7 0x19 /* single-shift-2 for 7-bit code */
458 #define ISO_CODE_ESC 0x1B /* escape */
459 #define ISO_CODE_SS2 0x8E /* single-shift-2 */
460 #define ISO_CODE_SS3 0x8F /* single-shift-3 */
461 #define ISO_CODE_CSI 0x9B /* control-sequence-introducer */
463 /* All code (1-byte) of ISO2022 is classified into one of the
465 enum iso_code_class_type
467 ISO_control_0
, /* Control codes in the range
468 0x00..0x1F and 0x7F, except for the
469 following 5 codes. */
470 ISO_shift_out
, /* ISO_CODE_SO (0x0E) */
471 ISO_shift_in
, /* ISO_CODE_SI (0x0F) */
472 ISO_single_shift_2_7
, /* ISO_CODE_SS2_7 (0x19) */
473 ISO_escape
, /* ISO_CODE_SO (0x1B) */
474 ISO_control_1
, /* Control codes in the range
475 0x80..0x9F, except for the
476 following 3 codes. */
477 ISO_single_shift_2
, /* ISO_CODE_SS2 (0x8E) */
478 ISO_single_shift_3
, /* ISO_CODE_SS3 (0x8F) */
479 ISO_control_sequence_introducer
, /* ISO_CODE_CSI (0x9B) */
480 ISO_0x20_or_0x7F
, /* Codes of the values 0x20 or 0x7F. */
481 ISO_graphic_plane_0
, /* Graphic codes in the range 0x21..0x7E. */
482 ISO_0xA0_or_0xFF
, /* Codes of the values 0xA0 or 0xFF. */
483 ISO_graphic_plane_1
/* Graphic codes in the range 0xA1..0xFE. */
486 /** The macros CODING_ISO_FLAG_XXX defines a flag bit of the
487 `iso-flags' attribute of an iso2022 coding system. */
489 /* If set, produce long-form designation sequence (e.g. ESC $ ( A)
490 instead of the correct short-form sequence (e.g. ESC $ A). */
491 #define CODING_ISO_FLAG_LONG_FORM 0x0001
493 /* If set, reset graphic planes and registers at end-of-line to the
495 #define CODING_ISO_FLAG_RESET_AT_EOL 0x0002
497 /* If set, reset graphic planes and registers before any control
498 characters to the initial state. */
499 #define CODING_ISO_FLAG_RESET_AT_CNTL 0x0004
501 /* If set, encode by 7-bit environment. */
502 #define CODING_ISO_FLAG_SEVEN_BITS 0x0008
504 /* If set, use locking-shift function. */
505 #define CODING_ISO_FLAG_LOCKING_SHIFT 0x0010
507 /* If set, use single-shift function. Overwrite
508 CODING_ISO_FLAG_LOCKING_SHIFT. */
509 #define CODING_ISO_FLAG_SINGLE_SHIFT 0x0020
511 /* If set, use designation escape sequence. */
512 #define CODING_ISO_FLAG_DESIGNATION 0x0040
514 /* If set, produce revision number sequence. */
515 #define CODING_ISO_FLAG_REVISION 0x0080
517 /* If set, produce ISO6429's direction specifying sequence. */
518 #define CODING_ISO_FLAG_DIRECTION 0x0100
520 /* If set, assume designation states are reset at beginning of line on
522 #define CODING_ISO_FLAG_INIT_AT_BOL 0x0200
524 /* If set, designation sequence should be placed at beginning of line
526 #define CODING_ISO_FLAG_DESIGNATE_AT_BOL 0x0400
528 /* If set, do not encode unsafe charactes on output. */
529 #define CODING_ISO_FLAG_SAFE 0x0800
531 /* If set, extra latin codes (128..159) are accepted as a valid code
533 #define CODING_ISO_FLAG_LATIN_EXTRA 0x1000
535 #define CODING_ISO_FLAG_COMPOSITION 0x2000
537 #define CODING_ISO_FLAG_EUC_TW_SHIFT 0x4000
539 #define CODING_ISO_FLAG_USE_ROMAN 0x8000
541 #define CODING_ISO_FLAG_USE_OLDJIS 0x10000
543 #define CODING_ISO_FLAG_FULL_SUPPORT 0x100000
545 /* A character to be produced on output if encoding of the original
546 character is prohibited by CODING_ISO_FLAG_SAFE. */
547 #define CODING_INHIBIT_CHARACTER_SUBSTITUTION '?'
551 #define CODING_UTF_16_BOM(coding) \
552 ((coding)->spec.utf_16.bom)
554 #define CODING_UTF_16_ENDIAN(coding) \
555 ((coding)->spec.utf_16.endian)
557 #define CODING_UTF_16_SURROGATE(coding) \
558 ((coding)->spec.utf_16.surrogate)
562 #define CODING_CCL_DECODER(coding) \
563 AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_decoder)
564 #define CODING_CCL_ENCODER(coding) \
565 AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_encoder)
566 #define CODING_CCL_VALIDS(coding) \
567 (SDATA (AREF (CODING_ID_ATTRS ((coding)->id), coding_attr_ccl_valids)))
569 /* Index for each coding category in `coding_categories' */
573 coding_category_iso_7
,
574 coding_category_iso_7_tight
,
575 coding_category_iso_8_1
,
576 coding_category_iso_8_2
,
577 coding_category_iso_7_else
,
578 coding_category_iso_8_else
,
579 coding_category_utf_8
,
580 coding_category_utf_16_auto
,
581 coding_category_utf_16_be
,
582 coding_category_utf_16_le
,
583 coding_category_utf_16_be_nosig
,
584 coding_category_utf_16_le_nosig
,
585 coding_category_charset
,
586 coding_category_sjis
,
587 coding_category_big5
,
589 coding_category_emacs_mule
,
590 /* All above are targets of code detection. */
591 coding_category_raw_text
,
592 coding_category_undecided
,
596 /* Definitions of flag bits used in detect_coding_XXXX. */
597 #define CATEGORY_MASK_ISO_7 (1 << coding_category_iso_7)
598 #define CATEGORY_MASK_ISO_7_TIGHT (1 << coding_category_iso_7_tight)
599 #define CATEGORY_MASK_ISO_8_1 (1 << coding_category_iso_8_1)
600 #define CATEGORY_MASK_ISO_8_2 (1 << coding_category_iso_8_2)
601 #define CATEGORY_MASK_ISO_7_ELSE (1 << coding_category_iso_7_else)
602 #define CATEGORY_MASK_ISO_8_ELSE (1 << coding_category_iso_8_else)
603 #define CATEGORY_MASK_UTF_8 (1 << coding_category_utf_8)
604 #define CATEGORY_MASK_UTF_16_AUTO (1 << coding_category_utf_16_auto)
605 #define CATEGORY_MASK_UTF_16_BE (1 << coding_category_utf_16_be)
606 #define CATEGORY_MASK_UTF_16_LE (1 << coding_category_utf_16_le)
607 #define CATEGORY_MASK_UTF_16_BE_NOSIG (1 << coding_category_utf_16_be_nosig)
608 #define CATEGORY_MASK_UTF_16_LE_NOSIG (1 << coding_category_utf_16_le_nosig)
609 #define CATEGORY_MASK_CHARSET (1 << coding_category_charset)
610 #define CATEGORY_MASK_SJIS (1 << coding_category_sjis)
611 #define CATEGORY_MASK_BIG5 (1 << coding_category_big5)
612 #define CATEGORY_MASK_CCL (1 << coding_category_ccl)
613 #define CATEGORY_MASK_EMACS_MULE (1 << coding_category_emacs_mule)
614 #define CATEGORY_MASK_RAW_TEXT (1 << coding_category_raw_text)
616 /* This value is returned if detect_coding_mask () find nothing other
617 than ASCII characters. */
618 #define CATEGORY_MASK_ANY \
619 (CATEGORY_MASK_ISO_7 \
620 | CATEGORY_MASK_ISO_7_TIGHT \
621 | CATEGORY_MASK_ISO_8_1 \
622 | CATEGORY_MASK_ISO_8_2 \
623 | CATEGORY_MASK_ISO_7_ELSE \
624 | CATEGORY_MASK_ISO_8_ELSE \
625 | CATEGORY_MASK_UTF_8 \
626 | CATEGORY_MASK_UTF_16_BE \
627 | CATEGORY_MASK_UTF_16_LE \
628 | CATEGORY_MASK_UTF_16_BE_NOSIG \
629 | CATEGORY_MASK_UTF_16_LE_NOSIG \
630 | CATEGORY_MASK_CHARSET \
631 | CATEGORY_MASK_SJIS \
632 | CATEGORY_MASK_BIG5 \
633 | CATEGORY_MASK_CCL \
634 | CATEGORY_MASK_EMACS_MULE)
637 #define CATEGORY_MASK_ISO_7BIT \
638 (CATEGORY_MASK_ISO_7 | CATEGORY_MASK_ISO_7_TIGHT)
640 #define CATEGORY_MASK_ISO_8BIT \
641 (CATEGORY_MASK_ISO_8_1 | CATEGORY_MASK_ISO_8_2)
643 #define CATEGORY_MASK_ISO_ELSE \
644 (CATEGORY_MASK_ISO_7_ELSE | CATEGORY_MASK_ISO_8_ELSE)
646 #define CATEGORY_MASK_ISO_ESCAPE \
647 (CATEGORY_MASK_ISO_7 \
648 | CATEGORY_MASK_ISO_7_TIGHT \
649 | CATEGORY_MASK_ISO_7_ELSE \
650 | CATEGORY_MASK_ISO_8_ELSE)
652 #define CATEGORY_MASK_ISO \
653 ( CATEGORY_MASK_ISO_7BIT \
654 | CATEGORY_MASK_ISO_8BIT \
655 | CATEGORY_MASK_ISO_ELSE)
657 #define CATEGORY_MASK_UTF_16 \
658 (CATEGORY_MASK_UTF_16_BE \
659 | CATEGORY_MASK_UTF_16_LE \
660 | CATEGORY_MASK_UTF_16_BE_NOSIG \
661 | CATEGORY_MASK_UTF_16_LE_NOSIG)
664 /* List of symbols `coding-category-xxx' ordered by priority. This
665 variable is exposed to Emacs Lisp. */
666 static Lisp_Object Vcoding_category_list
;
668 /* Table of coding categories (Lisp symbols). This variable is for
670 static Lisp_Object Vcoding_category_table
;
672 /* Table of coding-categories ordered by priority. */
673 static enum coding_category coding_priorities
[coding_category_max
];
675 /* Nth element is a coding context for the coding system bound to the
676 Nth coding category. */
677 static struct coding_system coding_categories
[coding_category_max
];
679 /*** Commonly used macros and functions ***/
682 #define min(a, b) ((a) < (b) ? (a) : (b))
685 #define max(a, b) ((a) > (b) ? (a) : (b))
688 #define CODING_GET_INFO(coding, attrs, charset_list) \
690 (attrs) = CODING_ID_ATTRS ((coding)->id); \
691 (charset_list) = CODING_ATTR_CHARSET_LIST (attrs); \
695 /* Safely get one byte from the source text pointed by SRC which ends
696 at SRC_END, and set C to that byte. If there are not enough bytes
697 in the source, it jumps to `no_more_source'. If multibytep is
698 nonzero, and a multibyte character is found at SRC, set C to the
699 negative value of the character code. The caller should declare
700 and set these variables appropriately in advance:
701 src, src_end, multibytep */
703 #define ONE_MORE_BYTE(c) \
705 if (src == src_end) \
707 if (src_base < src) \
708 record_conversion_result \
709 (coding, CODING_RESULT_INSUFFICIENT_SRC); \
710 goto no_more_source; \
713 if (multibytep && (c & 0x80)) \
715 if ((c & 0xFE) == 0xC0) \
716 c = ((c & 1) << 6) | *src++; \
720 c = - string_char (src, &src, NULL); \
721 record_conversion_result \
722 (coding, CODING_RESULT_INVALID_SRC); \
729 #define ONE_MORE_BYTE_NO_CHECK(c) \
732 if (multibytep && (c & 0x80)) \
734 if ((c & 0xFE) == 0xC0) \
735 c = ((c & 1) << 6) | *src++; \
739 c = - string_char (src, &src, NULL); \
740 record_conversion_result \
741 (coding, CODING_RESULT_INVALID_SRC); \
748 /* Store a byte C in the place pointed by DST and increment DST to the
749 next free point, and increment PRODUCED_CHARS. The caller should
750 assure that C is 0..127, and declare and set the variable `dst'
751 appropriately in advance.
755 #define EMIT_ONE_ASCII_BYTE(c) \
762 /* Like EMIT_ONE_ASCII_BYTE byt store two bytes; C1 and C2. */
764 #define EMIT_TWO_ASCII_BYTES(c1, c2) \
766 produced_chars += 2; \
767 *dst++ = (c1), *dst++ = (c2); \
771 /* Store a byte C in the place pointed by DST and increment DST to the
772 next free point, and increment PRODUCED_CHARS. If MULTIBYTEP is
773 nonzero, store in an appropriate multibyte from. The caller should
774 declare and set the variables `dst' and `multibytep' appropriately
777 #define EMIT_ONE_BYTE(c) \
784 ch = BYTE8_TO_CHAR (ch); \
785 CHAR_STRING_ADVANCE (ch, dst); \
792 /* Like EMIT_ONE_BYTE, but emit two bytes; C1 and C2. */
794 #define EMIT_TWO_BYTES(c1, c2) \
796 produced_chars += 2; \
803 ch = BYTE8_TO_CHAR (ch); \
804 CHAR_STRING_ADVANCE (ch, dst); \
807 ch = BYTE8_TO_CHAR (ch); \
808 CHAR_STRING_ADVANCE (ch, dst); \
818 #define EMIT_THREE_BYTES(c1, c2, c3) \
820 EMIT_ONE_BYTE (c1); \
821 EMIT_TWO_BYTES (c2, c3); \
825 #define EMIT_FOUR_BYTES(c1, c2, c3, c4) \
827 EMIT_TWO_BYTES (c1, c2); \
828 EMIT_TWO_BYTES (c3, c4); \
832 /* Prototypes for static functions. */
833 static void record_conversion_result
P_ ((struct coding_system
*coding
,
834 enum coding_result_code result
));
835 static int detect_coding_utf_8
P_ ((struct coding_system
*,
836 struct coding_detection_info
*info
));
837 static void decode_coding_utf_8
P_ ((struct coding_system
*));
838 static int encode_coding_utf_8
P_ ((struct coding_system
*));
840 static int detect_coding_utf_16
P_ ((struct coding_system
*,
841 struct coding_detection_info
*info
));
842 static void decode_coding_utf_16
P_ ((struct coding_system
*));
843 static int encode_coding_utf_16
P_ ((struct coding_system
*));
845 static int detect_coding_iso_2022
P_ ((struct coding_system
*,
846 struct coding_detection_info
*info
));
847 static void decode_coding_iso_2022
P_ ((struct coding_system
*));
848 static int encode_coding_iso_2022
P_ ((struct coding_system
*));
850 static int detect_coding_emacs_mule
P_ ((struct coding_system
*,
851 struct coding_detection_info
*info
));
852 static void decode_coding_emacs_mule
P_ ((struct coding_system
*));
853 static int encode_coding_emacs_mule
P_ ((struct coding_system
*));
855 static int detect_coding_sjis
P_ ((struct coding_system
*,
856 struct coding_detection_info
*info
));
857 static void decode_coding_sjis
P_ ((struct coding_system
*));
858 static int encode_coding_sjis
P_ ((struct coding_system
*));
860 static int detect_coding_big5
P_ ((struct coding_system
*,
861 struct coding_detection_info
*info
));
862 static void decode_coding_big5
P_ ((struct coding_system
*));
863 static int encode_coding_big5
P_ ((struct coding_system
*));
865 static int detect_coding_ccl
P_ ((struct coding_system
*,
866 struct coding_detection_info
*info
));
867 static void decode_coding_ccl
P_ ((struct coding_system
*));
868 static int encode_coding_ccl
P_ ((struct coding_system
*));
870 static void decode_coding_raw_text
P_ ((struct coding_system
*));
871 static int encode_coding_raw_text
P_ ((struct coding_system
*));
873 static void coding_set_source
P_ ((struct coding_system
*));
874 static void coding_set_destination
P_ ((struct coding_system
*));
875 static void coding_alloc_by_realloc
P_ ((struct coding_system
*, EMACS_INT
));
876 static void coding_alloc_by_making_gap
P_ ((struct coding_system
*,
877 EMACS_INT
, EMACS_INT
));
878 static unsigned char *alloc_destination
P_ ((struct coding_system
*,
879 EMACS_INT
, unsigned char *));
880 static void setup_iso_safe_charsets
P_ ((Lisp_Object
));
881 static unsigned char *encode_designation_at_bol
P_ ((struct coding_system
*,
884 static int detect_eol
P_ ((const unsigned char *,
885 EMACS_INT
, enum coding_category
));
886 static Lisp_Object adjust_coding_eol_type
P_ ((struct coding_system
*, int));
887 static void decode_eol
P_ ((struct coding_system
*));
888 static Lisp_Object get_translation_table
P_ ((Lisp_Object
, int, int *));
889 static Lisp_Object get_translation
P_ ((Lisp_Object
, int *, int *,
891 static int produce_chars
P_ ((struct coding_system
*, Lisp_Object
, int));
892 static INLINE
void produce_composition
P_ ((struct coding_system
*, int *,
894 static INLINE
void produce_charset
P_ ((struct coding_system
*, int *,
896 static void produce_annotation
P_ ((struct coding_system
*, EMACS_INT
));
897 static int decode_coding
P_ ((struct coding_system
*));
898 static INLINE
int *handle_composition_annotation
P_ ((EMACS_INT
, EMACS_INT
,
899 struct coding_system
*,
900 int *, EMACS_INT
*));
901 static INLINE
int *handle_charset_annotation
P_ ((EMACS_INT
, EMACS_INT
,
902 struct coding_system
*,
903 int *, EMACS_INT
*));
904 static void consume_chars
P_ ((struct coding_system
*, Lisp_Object
, int));
905 static int encode_coding
P_ ((struct coding_system
*));
906 static Lisp_Object make_conversion_work_buffer
P_ ((int));
907 static Lisp_Object code_conversion_restore
P_ ((Lisp_Object
));
908 static INLINE
int char_encodable_p
P_ ((int, Lisp_Object
));
909 static Lisp_Object make_subsidiaries
P_ ((Lisp_Object
));
912 record_conversion_result (struct coding_system
*coding
,
913 enum coding_result_code result
)
915 coding
->result
= result
;
918 case CODING_RESULT_INSUFFICIENT_SRC
:
919 Vlast_code_conversion_error
= Qinsufficient_source
;
921 case CODING_RESULT_INCONSISTENT_EOL
:
922 Vlast_code_conversion_error
= Qinconsistent_eol
;
924 case CODING_RESULT_INVALID_SRC
:
925 Vlast_code_conversion_error
= Qinvalid_source
;
927 case CODING_RESULT_INTERRUPT
:
928 Vlast_code_conversion_error
= Qinterrupted
;
930 case CODING_RESULT_INSUFFICIENT_MEM
:
931 Vlast_code_conversion_error
= Qinsufficient_memory
;
934 Vlast_code_conversion_error
= intern ("Unknown error");
938 #define CODING_DECODE_CHAR(coding, src, src_base, src_end, charset, code, c) \
940 charset_map_loaded = 0; \
941 c = DECODE_CHAR (charset, code); \
942 if (charset_map_loaded) \
944 const unsigned char *orig = coding->source; \
947 coding_set_source (coding); \
948 offset = coding->source - orig; \
950 src_base += offset; \
956 #define ASSURE_DESTINATION(bytes) \
958 if (dst + (bytes) >= dst_end) \
960 int more_bytes = charbuf_end - charbuf + (bytes); \
962 dst = alloc_destination (coding, more_bytes, dst); \
963 dst_end = coding->destination + coding->dst_bytes; \
970 coding_set_source (coding
)
971 struct coding_system
*coding
;
973 if (BUFFERP (coding
->src_object
))
975 struct buffer
*buf
= XBUFFER (coding
->src_object
);
977 if (coding
->src_pos
< 0)
978 coding
->source
= BUF_GAP_END_ADDR (buf
) + coding
->src_pos_byte
;
980 coding
->source
= BUF_BYTE_ADDRESS (buf
, coding
->src_pos_byte
);
982 else if (STRINGP (coding
->src_object
))
984 coding
->source
= SDATA (coding
->src_object
) + coding
->src_pos_byte
;
987 /* Otherwise, the source is C string and is never relocated
988 automatically. Thus we don't have to update anything. */
993 coding_set_destination (coding
)
994 struct coding_system
*coding
;
996 if (BUFFERP (coding
->dst_object
))
998 if (coding
->src_pos
< 0)
1000 coding
->destination
= BEG_ADDR
+ coding
->dst_pos_byte
- 1;
1001 coding
->dst_bytes
= (GAP_END_ADDR
1002 - (coding
->src_bytes
- coding
->consumed
)
1003 - coding
->destination
);
1007 /* We are sure that coding->dst_pos_byte is before the gap
1009 coding
->destination
= (BUF_BEG_ADDR (XBUFFER (coding
->dst_object
))
1010 + coding
->dst_pos_byte
- 1);
1011 coding
->dst_bytes
= (BUF_GAP_END_ADDR (XBUFFER (coding
->dst_object
))
1012 - coding
->destination
);
1016 /* Otherwise, the destination is C string and is never relocated
1017 automatically. Thus we don't have to update anything. */
1023 coding_alloc_by_realloc (coding
, bytes
)
1024 struct coding_system
*coding
;
1027 coding
->destination
= (unsigned char *) xrealloc (coding
->destination
,
1028 coding
->dst_bytes
+ bytes
);
1029 coding
->dst_bytes
+= bytes
;
1033 coding_alloc_by_making_gap (coding
, offset
, bytes
)
1034 struct coding_system
*coding
;
1035 EMACS_INT offset
, bytes
;
1037 if (BUFFERP (coding
->dst_object
)
1038 && EQ (coding
->src_object
, coding
->dst_object
))
1040 EMACS_INT add
= offset
+ (coding
->src_bytes
- coding
->consumed
);
1042 GPT
+= offset
, GPT_BYTE
+= offset
;
1043 GAP_SIZE
-= add
; ZV
+= add
; Z
+= add
; ZV_BYTE
+= add
; Z_BYTE
+= add
;
1045 GAP_SIZE
+= add
; ZV
-= add
; Z
-= add
; ZV_BYTE
-= add
; Z_BYTE
-= add
;
1046 GPT
-= offset
, GPT_BYTE
-= offset
;
1050 Lisp_Object this_buffer
;
1052 this_buffer
= Fcurrent_buffer ();
1053 set_buffer_internal (XBUFFER (coding
->dst_object
));
1055 set_buffer_internal (XBUFFER (this_buffer
));
1060 static unsigned char *
1061 alloc_destination (coding
, nbytes
, dst
)
1062 struct coding_system
*coding
;
1066 EMACS_INT offset
= dst
- coding
->destination
;
1068 if (BUFFERP (coding
->dst_object
))
1069 coding_alloc_by_making_gap (coding
, offset
, nbytes
);
1071 coding_alloc_by_realloc (coding
, nbytes
);
1072 record_conversion_result (coding
, CODING_RESULT_SUCCESS
);
1073 coding_set_destination (coding
);
1074 dst
= coding
->destination
+ offset
;
1078 /** Macros for annotations. */
1080 /* Maximum length of annotation data (sum of annotations for
1081 composition and charset). */
1082 #define MAX_ANNOTATION_LENGTH (4 + (MAX_COMPOSITION_COMPONENTS * 2) - 1 + 4)
1084 /* An annotation data is stored in the array coding->charbuf in this
1086 [ -LENGTH ANNOTATION_MASK NCHARS ... ]
1087 LENGTH is the number of elements in the annotation.
1088 ANNOTATION_MASK is one of CODING_ANNOTATE_XXX_MASK.
1089 NCHARS is the number of characters in the text annotated.
1091 The format of the following elements depend on ANNOTATION_MASK.
1093 In the case of CODING_ANNOTATE_COMPOSITION_MASK, these elements
1095 ... METHOD [ COMPOSITION-COMPONENTS ... ]
1096 METHOD is one of enum composition_method.
1097 Optionnal COMPOSITION-COMPONENTS are characters and composition
1100 In the case of CODING_ANNOTATE_CHARSET_MASK, one element CHARSET-ID
1103 #define ADD_ANNOTATION_DATA(buf, len, mask, nchars) \
1105 *(buf)++ = -(len); \
1106 *(buf)++ = (mask); \
1107 *(buf)++ = (nchars); \
1108 coding->annotated = 1; \
1111 #define ADD_COMPOSITION_DATA(buf, nchars, method) \
1113 ADD_ANNOTATION_DATA (buf, 4, CODING_ANNOTATE_COMPOSITION_MASK, nchars); \
1118 #define ADD_CHARSET_DATA(buf, nchars, id) \
1120 ADD_ANNOTATION_DATA (buf, 4, CODING_ANNOTATE_CHARSET_MASK, nchars); \
1125 /*** 2. Emacs' internal format (emacs-utf-8) ***/
1132 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
1133 Check if a text is encoded in UTF-8. If it is, return 1, else
1136 #define UTF_8_1_OCTET_P(c) ((c) < 0x80)
1137 #define UTF_8_EXTRA_OCTET_P(c) (((c) & 0xC0) == 0x80)
1138 #define UTF_8_2_OCTET_LEADING_P(c) (((c) & 0xE0) == 0xC0)
1139 #define UTF_8_3_OCTET_LEADING_P(c) (((c) & 0xF0) == 0xE0)
1140 #define UTF_8_4_OCTET_LEADING_P(c) (((c) & 0xF8) == 0xF0)
1141 #define UTF_8_5_OCTET_LEADING_P(c) (((c) & 0xFC) == 0xF8)
1144 detect_coding_utf_8 (coding
, detect_info
)
1145 struct coding_system
*coding
;
1146 struct coding_detection_info
*detect_info
;
1148 const unsigned char *src
= coding
->source
, *src_base
;
1149 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
1150 int multibytep
= coding
->src_multibyte
;
1151 int consumed_chars
= 0;
1154 detect_info
->checked
|= CATEGORY_MASK_UTF_8
;
1155 /* A coding system of this category is always ASCII compatible. */
1156 src
+= coding
->head_ascii
;
1160 int c
, c1
, c2
, c3
, c4
;
1164 if (c
< 0 || UTF_8_1_OCTET_P (c
))
1167 if (c1
< 0 || ! UTF_8_EXTRA_OCTET_P (c1
))
1169 if (UTF_8_2_OCTET_LEADING_P (c
))
1171 found
= CATEGORY_MASK_UTF_8
;
1175 if (c2
< 0 || ! UTF_8_EXTRA_OCTET_P (c2
))
1177 if (UTF_8_3_OCTET_LEADING_P (c
))
1179 found
= CATEGORY_MASK_UTF_8
;
1183 if (c3
< 0 || ! UTF_8_EXTRA_OCTET_P (c3
))
1185 if (UTF_8_4_OCTET_LEADING_P (c
))
1187 found
= CATEGORY_MASK_UTF_8
;
1191 if (c4
< 0 || ! UTF_8_EXTRA_OCTET_P (c4
))
1193 if (UTF_8_5_OCTET_LEADING_P (c
))
1195 found
= CATEGORY_MASK_UTF_8
;
1200 detect_info
->rejected
|= CATEGORY_MASK_UTF_8
;
1204 if (src_base
< src
&& coding
->mode
& CODING_MODE_LAST_BLOCK
)
1206 detect_info
->rejected
|= CATEGORY_MASK_UTF_8
;
1209 detect_info
->found
|= found
;
1215 decode_coding_utf_8 (coding
)
1216 struct coding_system
*coding
;
1218 const unsigned char *src
= coding
->source
+ coding
->consumed
;
1219 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
1220 const unsigned char *src_base
;
1221 int *charbuf
= coding
->charbuf
+ coding
->charbuf_used
;
1222 int *charbuf_end
= coding
->charbuf
+ coding
->charbuf_size
;
1223 int consumed_chars
= 0, consumed_chars_base
;
1224 int multibytep
= coding
->src_multibyte
;
1225 Lisp_Object attr
, charset_list
;
1227 CODING_GET_INFO (coding
, attr
, charset_list
);
1231 int c
, c1
, c2
, c3
, c4
, c5
;
1234 consumed_chars_base
= consumed_chars
;
1236 if (charbuf
>= charbuf_end
)
1244 else if (UTF_8_1_OCTET_P(c1
))
1251 if (c2
< 0 || ! UTF_8_EXTRA_OCTET_P (c2
))
1253 if (UTF_8_2_OCTET_LEADING_P (c1
))
1255 c
= ((c1
& 0x1F) << 6) | (c2
& 0x3F);
1256 /* Reject overlong sequences here and below. Encoders
1257 producing them are incorrect, they can be misleading,
1258 and they mess up read/write invariance. */
1265 if (c3
< 0 || ! UTF_8_EXTRA_OCTET_P (c3
))
1267 if (UTF_8_3_OCTET_LEADING_P (c1
))
1269 c
= (((c1
& 0xF) << 12)
1270 | ((c2
& 0x3F) << 6) | (c3
& 0x3F));
1272 || (c
>= 0xd800 && c
< 0xe000)) /* surrogates (invalid) */
1278 if (c4
< 0 || ! UTF_8_EXTRA_OCTET_P (c4
))
1280 if (UTF_8_4_OCTET_LEADING_P (c1
))
1282 c
= (((c1
& 0x7) << 18) | ((c2
& 0x3F) << 12)
1283 | ((c3
& 0x3F) << 6) | (c4
& 0x3F));
1290 if (c5
< 0 || ! UTF_8_EXTRA_OCTET_P (c5
))
1292 if (UTF_8_5_OCTET_LEADING_P (c1
))
1294 c
= (((c1
& 0x3) << 24) | ((c2
& 0x3F) << 18)
1295 | ((c3
& 0x3F) << 12) | ((c4
& 0x3F) << 6)
1297 if ((c
> MAX_CHAR
) || (c
< 0x200000))
1312 consumed_chars
= consumed_chars_base
;
1314 *charbuf
++ = ASCII_BYTE_P (c
) ? c
: BYTE8_TO_CHAR (c
);
1319 coding
->consumed_char
+= consumed_chars_base
;
1320 coding
->consumed
= src_base
- coding
->source
;
1321 coding
->charbuf_used
= charbuf
- coding
->charbuf
;
1326 encode_coding_utf_8 (coding
)
1327 struct coding_system
*coding
;
1329 int multibytep
= coding
->dst_multibyte
;
1330 int *charbuf
= coding
->charbuf
;
1331 int *charbuf_end
= charbuf
+ coding
->charbuf_used
;
1332 unsigned char *dst
= coding
->destination
+ coding
->produced
;
1333 unsigned char *dst_end
= coding
->destination
+ coding
->dst_bytes
;
1334 int produced_chars
= 0;
1339 int safe_room
= MAX_MULTIBYTE_LENGTH
* 2;
1341 while (charbuf
< charbuf_end
)
1343 unsigned char str
[MAX_MULTIBYTE_LENGTH
], *p
, *pend
= str
;
1345 ASSURE_DESTINATION (safe_room
);
1347 if (CHAR_BYTE8_P (c
))
1349 c
= CHAR_TO_BYTE8 (c
);
1354 CHAR_STRING_ADVANCE (c
, pend
);
1355 for (p
= str
; p
< pend
; p
++)
1362 int safe_room
= MAX_MULTIBYTE_LENGTH
;
1364 while (charbuf
< charbuf_end
)
1366 ASSURE_DESTINATION (safe_room
);
1368 if (CHAR_BYTE8_P (c
))
1369 *dst
++ = CHAR_TO_BYTE8 (c
);
1371 dst
+= CHAR_STRING (c
, dst
);
1375 record_conversion_result (coding
, CODING_RESULT_SUCCESS
);
1376 coding
->produced_char
+= produced_chars
;
1377 coding
->produced
= dst
- coding
->destination
;
1382 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
1383 Check if a text is encoded in one of UTF-16 based coding systems.
1384 If it is, return 1, else return 0. */
1386 #define UTF_16_HIGH_SURROGATE_P(val) \
1387 (((val) & 0xFC00) == 0xD800)
1389 #define UTF_16_LOW_SURROGATE_P(val) \
1390 (((val) & 0xFC00) == 0xDC00)
1392 #define UTF_16_INVALID_P(val) \
1393 (((val) == 0xFFFE) \
1394 || ((val) == 0xFFFF) \
1395 || UTF_16_LOW_SURROGATE_P (val))
1399 detect_coding_utf_16 (coding
, detect_info
)
1400 struct coding_system
*coding
;
1401 struct coding_detection_info
*detect_info
;
1403 const unsigned char *src
= coding
->source
, *src_base
= src
;
1404 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
1405 int multibytep
= coding
->src_multibyte
;
1406 int consumed_chars
= 0;
1409 detect_info
->checked
|= CATEGORY_MASK_UTF_16
;
1410 if (coding
->mode
& CODING_MODE_LAST_BLOCK
1411 && (coding
->src_chars
& 1))
1413 detect_info
->rejected
|= CATEGORY_MASK_UTF_16
;
1419 if ((c1
== 0xFF) && (c2
== 0xFE))
1421 detect_info
->found
|= (CATEGORY_MASK_UTF_16_LE
1422 | CATEGORY_MASK_UTF_16_AUTO
);
1423 detect_info
->rejected
|= (CATEGORY_MASK_UTF_16_BE
1424 | CATEGORY_MASK_UTF_16_BE_NOSIG
1425 | CATEGORY_MASK_UTF_16_LE_NOSIG
);
1427 else if ((c1
== 0xFE) && (c2
== 0xFF))
1429 detect_info
->found
|= (CATEGORY_MASK_UTF_16_BE
1430 | CATEGORY_MASK_UTF_16_AUTO
);
1431 detect_info
->rejected
|= (CATEGORY_MASK_UTF_16_LE
1432 | CATEGORY_MASK_UTF_16_BE_NOSIG
1433 | CATEGORY_MASK_UTF_16_LE_NOSIG
);
1435 else if (c1
>= 0 && c2
>= 0)
1437 detect_info
->rejected
1438 |= (CATEGORY_MASK_UTF_16_BE
| CATEGORY_MASK_UTF_16_LE
);
1445 decode_coding_utf_16 (coding
)
1446 struct coding_system
*coding
;
1448 const unsigned char *src
= coding
->source
+ coding
->consumed
;
1449 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
1450 const unsigned char *src_base
;
1451 int *charbuf
= coding
->charbuf
+ coding
->charbuf_used
;
1452 int *charbuf_end
= coding
->charbuf
+ coding
->charbuf_size
;
1453 int consumed_chars
= 0, consumed_chars_base
;
1454 int multibytep
= coding
->src_multibyte
;
1455 enum utf_16_bom_type bom
= CODING_UTF_16_BOM (coding
);
1456 enum utf_16_endian_type endian
= CODING_UTF_16_ENDIAN (coding
);
1457 int surrogate
= CODING_UTF_16_SURROGATE (coding
);
1458 Lisp_Object attr
, charset_list
;
1460 CODING_GET_INFO (coding
, attr
, charset_list
);
1462 if (bom
== utf_16_with_bom
)
1471 if (endian
== utf_16_big_endian
1472 ? c
!= 0xFEFF : c
!= 0xFFFE)
1474 /* The first two bytes are not BOM. Treat them as bytes
1475 for a normal character. */
1479 CODING_UTF_16_BOM (coding
) = utf_16_without_bom
;
1481 else if (bom
== utf_16_detect_bom
)
1483 /* We have already tried to detect BOM and failed in
1485 CODING_UTF_16_BOM (coding
) = utf_16_without_bom
;
1493 consumed_chars_base
= consumed_chars
;
1495 if (charbuf
+ 2 >= charbuf_end
)
1507 *charbuf
++ = ASCII_BYTE_P (c1
) ? c1
: BYTE8_TO_CHAR (c1
);
1511 c
= (endian
== utf_16_big_endian
1512 ? ((c1
<< 8) | c2
) : ((c2
<< 8) | c1
));
1515 if (! UTF_16_LOW_SURROGATE_P (c
))
1517 if (endian
== utf_16_big_endian
)
1518 c1
= surrogate
>> 8, c2
= surrogate
& 0xFF;
1520 c1
= surrogate
& 0xFF, c2
= surrogate
>> 8;
1524 if (UTF_16_HIGH_SURROGATE_P (c
))
1525 CODING_UTF_16_SURROGATE (coding
) = surrogate
= c
;
1531 c
= ((surrogate
- 0xD800) << 10) | (c
- 0xDC00);
1532 CODING_UTF_16_SURROGATE (coding
) = surrogate
= 0;
1533 *charbuf
++ = 0x10000 + c
;
1538 if (UTF_16_HIGH_SURROGATE_P (c
))
1539 CODING_UTF_16_SURROGATE (coding
) = surrogate
= c
;
1546 coding
->consumed_char
+= consumed_chars_base
;
1547 coding
->consumed
= src_base
- coding
->source
;
1548 coding
->charbuf_used
= charbuf
- coding
->charbuf
;
1552 encode_coding_utf_16 (coding
)
1553 struct coding_system
*coding
;
1555 int multibytep
= coding
->dst_multibyte
;
1556 int *charbuf
= coding
->charbuf
;
1557 int *charbuf_end
= charbuf
+ coding
->charbuf_used
;
1558 unsigned char *dst
= coding
->destination
+ coding
->produced
;
1559 unsigned char *dst_end
= coding
->destination
+ coding
->dst_bytes
;
1561 enum utf_16_bom_type bom
= CODING_UTF_16_BOM (coding
);
1562 int big_endian
= CODING_UTF_16_ENDIAN (coding
) == utf_16_big_endian
;
1563 int produced_chars
= 0;
1564 Lisp_Object attrs
, charset_list
;
1567 CODING_GET_INFO (coding
, attrs
, charset_list
);
1569 if (bom
!= utf_16_without_bom
)
1571 ASSURE_DESTINATION (safe_room
);
1573 EMIT_TWO_BYTES (0xFE, 0xFF);
1575 EMIT_TWO_BYTES (0xFF, 0xFE);
1576 CODING_UTF_16_BOM (coding
) = utf_16_without_bom
;
1579 while (charbuf
< charbuf_end
)
1581 ASSURE_DESTINATION (safe_room
);
1583 if (c
>= MAX_UNICODE_CHAR
)
1584 c
= coding
->default_char
;
1589 EMIT_TWO_BYTES (c
>> 8, c
& 0xFF);
1591 EMIT_TWO_BYTES (c
& 0xFF, c
>> 8);
1598 c1
= (c
>> 10) + 0xD800;
1599 c2
= (c
& 0x3FF) + 0xDC00;
1601 EMIT_FOUR_BYTES (c1
>> 8, c1
& 0xFF, c2
>> 8, c2
& 0xFF);
1603 EMIT_FOUR_BYTES (c1
& 0xFF, c1
>> 8, c2
& 0xFF, c2
>> 8);
1606 record_conversion_result (coding
, CODING_RESULT_SUCCESS
);
1607 coding
->produced
= dst
- coding
->destination
;
1608 coding
->produced_char
+= produced_chars
;
1613 /*** 6. Old Emacs' internal format (emacs-mule) ***/
1615 /* Emacs' internal format for representation of multiple character
1616 sets is a kind of multi-byte encoding, i.e. characters are
1617 represented by variable-length sequences of one-byte codes.
1619 ASCII characters and control characters (e.g. `tab', `newline') are
1620 represented by one-byte sequences which are their ASCII codes, in
1621 the range 0x00 through 0x7F.
1623 8-bit characters of the range 0x80..0x9F are represented by
1624 two-byte sequences of LEADING_CODE_8_BIT_CONTROL and (their 8-bit
1627 8-bit characters of the range 0xA0..0xFF are represented by
1628 one-byte sequences which are their 8-bit code.
1630 The other characters are represented by a sequence of `base
1631 leading-code', optional `extended leading-code', and one or two
1632 `position-code's. The length of the sequence is determined by the
1633 base leading-code. Leading-code takes the range 0x81 through 0x9D,
1634 whereas extended leading-code and position-code take the range 0xA0
1635 through 0xFF. See `charset.h' for more details about leading-code
1638 --- CODE RANGE of Emacs' internal format ---
1642 eight-bit-control LEADING_CODE_8_BIT_CONTROL + 0xA0..0xBF
1643 eight-bit-graphic 0xA0..0xBF
1644 ELSE 0x81..0x9D + [0xA0..0xFF]+
1645 ---------------------------------------------
1647 As this is the internal character representation, the format is
1648 usually not used externally (i.e. in a file or in a data sent to a
1649 process). But, it is possible to have a text externally in this
1650 format (i.e. by encoding by the coding system `emacs-mule').
1652 In that case, a sequence of one-byte codes has a slightly different
1655 At first, all characters in eight-bit-control are represented by
1656 one-byte sequences which are their 8-bit code.
1658 Next, character composition data are represented by the byte
1659 sequence of the form: 0x80 METHOD BYTES CHARS COMPONENT ...,
1661 METHOD is 0xF0 plus one of composition method (enum
1662 composition_method),
1664 BYTES is 0xA0 plus a byte length of this composition data,
1666 CHARS is 0x20 plus a number of characters composed by this
1669 COMPONENTs are characters of multibye form or composition
1670 rules encoded by two-byte of ASCII codes.
1672 In addition, for backward compatibility, the following formats are
1673 also recognized as composition data on decoding.
1676 0x80 0xFF MSEQ RULE MSEQ RULE ... MSEQ
1679 MSEQ is a multibyte form but in these special format:
1680 ASCII: 0xA0 ASCII_CODE+0x80,
1681 other: LEADING_CODE+0x20 FOLLOWING-BYTE ...,
1682 RULE is a one byte code of the range 0xA0..0xF0 that
1683 represents a composition rule.
1686 char emacs_mule_bytes
[256];
1689 emacs_mule_char (coding
, src
, nbytes
, nchars
, id
)
1690 struct coding_system
*coding
;
1691 const unsigned char *src
;
1692 int *nbytes
, *nchars
, *id
;
1694 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
1695 const unsigned char *src_base
= src
;
1696 int multibytep
= coding
->src_multibyte
;
1697 struct charset
*charset
;
1700 int consumed_chars
= 0;
1706 charset
= emacs_mule_charset
[0];
1712 /* Old style component character of a compostion. */
1722 switch (emacs_mule_bytes
[c
])
1725 if (! (charset
= emacs_mule_charset
[c
]))
1734 if (c
== EMACS_MULE_LEADING_CODE_PRIVATE_11
1735 || c
== EMACS_MULE_LEADING_CODE_PRIVATE_12
)
1738 if (c
< 0xA0 || ! (charset
= emacs_mule_charset
[c
]))
1747 if (! (charset
= emacs_mule_charset
[c
]))
1752 code
= (c
& 0x7F) << 8;
1762 if (c
< 0 || ! (charset
= emacs_mule_charset
[c
]))
1767 code
= (c
& 0x7F) << 8;
1776 charset
= CHARSET_FROM_ID (ASCII_BYTE_P (code
)
1777 ? charset_ascii
: charset_eight_bit
);
1783 c
= DECODE_CHAR (charset
, code
);
1787 *nbytes
= src
- src_base
;
1788 *nchars
= consumed_chars
;
1801 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
1802 Check if a text is encoded in `emacs-mule'. If it is, return 1,
1806 detect_coding_emacs_mule (coding
, detect_info
)
1807 struct coding_system
*coding
;
1808 struct coding_detection_info
*detect_info
;
1810 const unsigned char *src
= coding
->source
, *src_base
;
1811 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
1812 int multibytep
= coding
->src_multibyte
;
1813 int consumed_chars
= 0;
1817 detect_info
->checked
|= CATEGORY_MASK_EMACS_MULE
;
1818 /* A coding system of this category is always ASCII compatible. */
1819 src
+= coding
->head_ascii
;
1829 /* Perhaps the start of composite character. We simple skip
1830 it because analyzing it is too heavy for detecting. But,
1831 at least, we check that the composite character
1832 constitues of more than 4 bytes. */
1833 const unsigned char *src_base
;
1843 if (src
- src_base
<= 4)
1845 found
= CATEGORY_MASK_EMACS_MULE
;
1853 && (c
== ISO_CODE_ESC
|| c
== ISO_CODE_SI
|| c
== ISO_CODE_SO
))
1858 int more_bytes
= emacs_mule_bytes
[*src_base
] - 1;
1860 while (more_bytes
> 0)
1865 src
--; /* Unread the last byte. */
1870 if (more_bytes
!= 0)
1872 found
= CATEGORY_MASK_EMACS_MULE
;
1875 detect_info
->rejected
|= CATEGORY_MASK_EMACS_MULE
;
1879 if (src_base
< src
&& coding
->mode
& CODING_MODE_LAST_BLOCK
)
1881 detect_info
->rejected
|= CATEGORY_MASK_EMACS_MULE
;
1884 detect_info
->found
|= found
;
1889 /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
1891 /* Decode a character represented as a component of composition
1892 sequence of Emacs 20/21 style at SRC. Set C to that character and
1893 update SRC to the head of next character (or an encoded composition
1894 rule). If SRC doesn't points a composition component, set C to -1.
1895 If SRC points an invalid byte sequence, global exit by a return
1898 #define DECODE_EMACS_MULE_COMPOSITION_CHAR(buf) \
1902 int nbytes, nchars; \
1904 if (src == src_end) \
1906 c = emacs_mule_char (coding, src, &nbytes, &nchars, NULL);\
1911 goto invalid_code; \
1915 consumed_chars += nchars; \
1920 /* Decode a composition rule represented as a component of composition
1921 sequence of Emacs 20 style at SRC. Store the decoded rule in *BUF,
1922 and increment BUF. If SRC points an invalid byte sequence, set C
1925 #define DECODE_EMACS_MULE_COMPOSITION_RULE_20(buf) \
1927 int c, gref, nref; \
1929 if (src >= src_end) \
1930 goto invalid_code; \
1931 ONE_MORE_BYTE_NO_CHECK (c); \
1933 if (c < 0 || c >= 81) \
1934 goto invalid_code; \
1936 gref = c / 9, nref = c % 9; \
1937 *buf++ = COMPOSITION_ENCODE_RULE (gref, nref); \
1941 /* Decode a composition rule represented as a component of composition
1942 sequence of Emacs 21 style at SRC. Store the decoded rule in *BUF,
1943 and increment BUF. If SRC points an invalid byte sequence, set C
1946 #define DECODE_EMACS_MULE_COMPOSITION_RULE_21(buf) \
1950 if (src + 1>= src_end) \
1951 goto invalid_code; \
1952 ONE_MORE_BYTE_NO_CHECK (gref); \
1954 ONE_MORE_BYTE_NO_CHECK (nref); \
1956 if (gref < 0 || gref >= 81 \
1957 || nref < 0 || nref >= 81) \
1958 goto invalid_code; \
1959 *buf++ = COMPOSITION_ENCODE_RULE (gref, nref); \
1963 #define DECODE_EMACS_MULE_21_COMPOSITION(c) \
1965 /* Emacs 21 style format. The first three bytes at SRC are \
1966 (METHOD - 0xF2), (BYTES - 0xA0), (CHARS - 0xA0), where BYTES is \
1967 the byte length of this composition information, CHARS is the \
1968 number of characters composed by this composition. */ \
1969 enum composition_method method = c - 0xF2; \
1970 int *charbuf_base = charbuf; \
1971 int consumed_chars_limit; \
1972 int nbytes, nchars; \
1974 ONE_MORE_BYTE (c); \
1976 goto invalid_code; \
1977 nbytes = c - 0xA0; \
1979 goto invalid_code; \
1980 ONE_MORE_BYTE (c); \
1982 goto invalid_code; \
1983 nchars = c - 0xA0; \
1984 ADD_COMPOSITION_DATA (charbuf, nchars, method); \
1985 consumed_chars_limit = consumed_chars_base + nbytes; \
1986 if (method != COMPOSITION_RELATIVE) \
1989 while (consumed_chars < consumed_chars_limit) \
1991 if (i % 2 && method != COMPOSITION_WITH_ALTCHARS) \
1992 DECODE_EMACS_MULE_COMPOSITION_RULE_21 (charbuf); \
1994 DECODE_EMACS_MULE_COMPOSITION_CHAR (charbuf); \
1997 if (consumed_chars < consumed_chars_limit) \
1998 goto invalid_code; \
1999 charbuf_base[0] -= i; \
2004 #define DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION(c) \
2006 /* Emacs 20 style format for relative composition. */ \
2007 /* Store multibyte form of characters to be composed. */ \
2008 enum composition_method method = COMPOSITION_RELATIVE; \
2009 int components[MAX_COMPOSITION_COMPONENTS * 2 - 1]; \
2010 int *buf = components; \
2014 ONE_MORE_BYTE (c); /* skip 0x80 */ \
2015 for (i = 0; *src >= 0xA0 && i < MAX_COMPOSITION_COMPONENTS; i++) \
2016 DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
2018 goto invalid_code; \
2019 ADD_COMPOSITION_DATA (charbuf, i, method); \
2020 for (j = 0; j < i; j++) \
2021 *charbuf++ = components[j]; \
2025 #define DECODE_EMACS_MULE_20_RULEBASE_COMPOSITION(c) \
2027 /* Emacs 20 style format for rule-base composition. */ \
2028 /* Store multibyte form of characters to be composed. */ \
2029 enum composition_method method = COMPOSITION_WITH_RULE; \
2030 int *charbuf_base = charbuf; \
2031 int components[MAX_COMPOSITION_COMPONENTS * 2 - 1]; \
2032 int *buf = components; \
2035 DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
2036 for (i = 1; i < MAX_COMPOSITION_COMPONENTS; i++) \
2040 DECODE_EMACS_MULE_COMPOSITION_RULE_20 (buf); \
2041 DECODE_EMACS_MULE_COMPOSITION_CHAR (buf); \
2043 if (i <= 1 || (buf - components) % 2 == 0) \
2044 goto invalid_code; \
2045 if (charbuf + i + (i / 2) + 1 >= charbuf_end) \
2046 goto no_more_source; \
2047 ADD_COMPOSITION_DATA (charbuf, i, method); \
2049 for (j = 0; j < i; j++) \
2050 *charbuf++ = components[j]; \
2051 charbuf_base[0] -= i; \
2052 for (j = 0; j < i; j += 2) \
2053 *charbuf++ = components[j]; \
2058 decode_coding_emacs_mule (coding
)
2059 struct coding_system
*coding
;
2061 const unsigned char *src
= coding
->source
+ coding
->consumed
;
2062 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
2063 const unsigned char *src_base
;
2064 int *charbuf
= coding
->charbuf
+ coding
->charbuf_used
;
2066 = coding
->charbuf
+ coding
->charbuf_size
- MAX_ANNOTATION_LENGTH
;
2067 int consumed_chars
= 0, consumed_chars_base
;
2068 int multibytep
= coding
->src_multibyte
;
2069 Lisp_Object attrs
, charset_list
;
2070 int char_offset
= coding
->produced_char
;
2071 int last_offset
= char_offset
;
2072 int last_id
= charset_ascii
;
2074 CODING_GET_INFO (coding
, attrs
, charset_list
);
2081 consumed_chars_base
= consumed_chars
;
2083 if (charbuf
>= charbuf_end
)
2102 if (c
- 0xF2 >= COMPOSITION_RELATIVE
2103 && c
- 0xF2 <= COMPOSITION_WITH_RULE_ALTCHARS
)
2104 DECODE_EMACS_MULE_21_COMPOSITION (c
);
2106 DECODE_EMACS_MULE_20_RELATIVE_COMPOSITION (c
);
2108 DECODE_EMACS_MULE_20_RULEBASE_COMPOSITION (c
);
2112 else if (c
< 0xA0 && emacs_mule_bytes
[c
] > 1)
2118 consumed_chars
= consumed_chars_base
;
2119 c
= emacs_mule_char (coding
, src
, &nbytes
, &nchars
, &id
);
2128 if (last_id
!= charset_ascii
)
2129 ADD_CHARSET_DATA (charbuf
, char_offset
- last_offset
, last_id
);
2131 last_offset
= char_offset
;
2135 consumed_chars
+= nchars
;
2144 consumed_chars
= consumed_chars_base
;
2146 *charbuf
++ = ASCII_BYTE_P (c
) ? c
: BYTE8_TO_CHAR (c
);
2152 if (last_id
!= charset_ascii
)
2153 ADD_CHARSET_DATA (charbuf
, char_offset
- last_offset
, last_id
);
2154 coding
->consumed_char
+= consumed_chars_base
;
2155 coding
->consumed
= src_base
- coding
->source
;
2156 coding
->charbuf_used
= charbuf
- coding
->charbuf
;
2160 #define EMACS_MULE_LEADING_CODES(id, codes) \
2163 codes[0] = id, codes[1] = 0; \
2164 else if (id < 0xE0) \
2165 codes[0] = 0x9A, codes[1] = id; \
2166 else if (id < 0xF0) \
2167 codes[0] = 0x9B, codes[1] = id; \
2168 else if (id < 0xF5) \
2169 codes[0] = 0x9C, codes[1] = id; \
2171 codes[0] = 0x9D, codes[1] = id; \
2176 encode_coding_emacs_mule (coding
)
2177 struct coding_system
*coding
;
2179 int multibytep
= coding
->dst_multibyte
;
2180 int *charbuf
= coding
->charbuf
;
2181 int *charbuf_end
= charbuf
+ coding
->charbuf_used
;
2182 unsigned char *dst
= coding
->destination
+ coding
->produced
;
2183 unsigned char *dst_end
= coding
->destination
+ coding
->dst_bytes
;
2185 int produced_chars
= 0;
2186 Lisp_Object attrs
, charset_list
;
2188 int preferred_charset_id
= -1;
2190 CODING_GET_INFO (coding
, attrs
, charset_list
);
2191 if (! EQ (charset_list
, Vemacs_mule_charset_list
))
2193 CODING_ATTR_CHARSET_LIST (attrs
)
2194 = charset_list
= Vemacs_mule_charset_list
;
2197 while (charbuf
< charbuf_end
)
2199 ASSURE_DESTINATION (safe_room
);
2204 /* Handle an annotation. */
2207 case CODING_ANNOTATE_COMPOSITION_MASK
:
2208 /* Not yet implemented. */
2210 case CODING_ANNOTATE_CHARSET_MASK
:
2211 preferred_charset_id
= charbuf
[3];
2212 if (preferred_charset_id
>= 0
2213 && NILP (Fmemq (make_number (preferred_charset_id
),
2215 preferred_charset_id
= -1;
2224 if (ASCII_CHAR_P (c
))
2225 EMIT_ONE_ASCII_BYTE (c
);
2226 else if (CHAR_BYTE8_P (c
))
2228 c
= CHAR_TO_BYTE8 (c
);
2233 struct charset
*charset
;
2237 unsigned char leading_codes
[2];
2239 if (preferred_charset_id
>= 0)
2241 charset
= CHARSET_FROM_ID (preferred_charset_id
);
2242 if (! CHAR_CHARSET_P (c
, charset
))
2243 charset
= char_charset (c
, charset_list
, NULL
);
2246 charset
= char_charset (c
, charset_list
, &code
);
2249 c
= coding
->default_char
;
2250 if (ASCII_CHAR_P (c
))
2252 EMIT_ONE_ASCII_BYTE (c
);
2255 charset
= char_charset (c
, charset_list
, &code
);
2257 dimension
= CHARSET_DIMENSION (charset
);
2258 emacs_mule_id
= CHARSET_EMACS_MULE_ID (charset
);
2259 EMACS_MULE_LEADING_CODES (emacs_mule_id
, leading_codes
);
2260 EMIT_ONE_BYTE (leading_codes
[0]);
2261 if (leading_codes
[1])
2262 EMIT_ONE_BYTE (leading_codes
[1]);
2264 EMIT_ONE_BYTE (code
| 0x80);
2268 EMIT_ONE_BYTE (code
>> 8);
2269 EMIT_ONE_BYTE (code
& 0xFF);
2273 record_conversion_result (coding
, CODING_RESULT_SUCCESS
);
2274 coding
->produced_char
+= produced_chars
;
2275 coding
->produced
= dst
- coding
->destination
;
2280 /*** 7. ISO2022 handlers ***/
2282 /* The following note describes the coding system ISO2022 briefly.
2283 Since the intention of this note is to help understand the
2284 functions in this file, some parts are NOT ACCURATE or are OVERLY
2285 SIMPLIFIED. For thorough understanding, please refer to the
2286 original document of ISO2022. This is equivalent to the standard
2287 ECMA-35, obtainable from <URL:http://www.ecma.ch/> (*).
2289 ISO2022 provides many mechanisms to encode several character sets
2290 in 7-bit and 8-bit environments. For 7-bit environments, all text
2291 is encoded using bytes less than 128. This may make the encoded
2292 text a little bit longer, but the text passes more easily through
2293 several types of gateway, some of which strip off the MSB (Most
2296 There are two kinds of character sets: control character sets and
2297 graphic character sets. The former contain control characters such
2298 as `newline' and `escape' to provide control functions (control
2299 functions are also provided by escape sequences). The latter
2300 contain graphic characters such as 'A' and '-'. Emacs recognizes
2301 two control character sets and many graphic character sets.
2303 Graphic character sets are classified into one of the following
2304 four classes, according to the number of bytes (DIMENSION) and
2305 number of characters in one dimension (CHARS) of the set:
2306 - DIMENSION1_CHARS94
2307 - DIMENSION1_CHARS96
2308 - DIMENSION2_CHARS94
2309 - DIMENSION2_CHARS96
2311 In addition, each character set is assigned an identification tag,
2312 unique for each set, called the "final character" (denoted as <F>
2313 hereafter). The <F> of each character set is decided by ECMA(*)
2314 when it is registered in ISO. The code range of <F> is 0x30..0x7F
2315 (0x30..0x3F are for private use only).
2317 Note (*): ECMA = European Computer Manufacturers Association
2319 Here are examples of graphic character sets [NAME(<F>)]:
2320 o DIMENSION1_CHARS94 -- ASCII('B'), right-half-of-JISX0201('I'), ...
2321 o DIMENSION1_CHARS96 -- right-half-of-ISO8859-1('A'), ...
2322 o DIMENSION2_CHARS94 -- GB2312('A'), JISX0208('B'), ...
2323 o DIMENSION2_CHARS96 -- none for the moment
2325 A code area (1 byte=8 bits) is divided into 4 areas, C0, GL, C1, and GR.
2326 C0 [0x00..0x1F] -- control character plane 0
2327 GL [0x20..0x7F] -- graphic character plane 0
2328 C1 [0x80..0x9F] -- control character plane 1
2329 GR [0xA0..0xFF] -- graphic character plane 1
2331 A control character set is directly designated and invoked to C0 or
2332 C1 by an escape sequence. The most common case is that:
2333 - ISO646's control character set is designated/invoked to C0, and
2334 - ISO6429's control character set is designated/invoked to C1,
2335 and usually these designations/invocations are omitted in encoded
2336 text. In a 7-bit environment, only C0 can be used, and a control
2337 character for C1 is encoded by an appropriate escape sequence to
2338 fit into the environment. All control characters for C1 are
2339 defined to have corresponding escape sequences.
2341 A graphic character set is at first designated to one of four
2342 graphic registers (G0 through G3), then these graphic registers are
2343 invoked to GL or GR. These designations and invocations can be
2344 done independently. The most common case is that G0 is invoked to
2345 GL, G1 is invoked to GR, and ASCII is designated to G0. Usually
2346 these invocations and designations are omitted in encoded text.
2347 In a 7-bit environment, only GL can be used.
2349 When a graphic character set of CHARS94 is invoked to GL, codes
2350 0x20 and 0x7F of the GL area work as control characters SPACE and
2351 DEL respectively, and codes 0xA0 and 0xFF of the GR area should not
2354 There are two ways of invocation: locking-shift and single-shift.
2355 With locking-shift, the invocation lasts until the next different
2356 invocation, whereas with single-shift, the invocation affects the
2357 following character only and doesn't affect the locking-shift
2358 state. Invocations are done by the following control characters or
2361 ----------------------------------------------------------------------
2362 abbrev function cntrl escape seq description
2363 ----------------------------------------------------------------------
2364 SI/LS0 (shift-in) 0x0F none invoke G0 into GL
2365 SO/LS1 (shift-out) 0x0E none invoke G1 into GL
2366 LS2 (locking-shift-2) none ESC 'n' invoke G2 into GL
2367 LS3 (locking-shift-3) none ESC 'o' invoke G3 into GL
2368 LS1R (locking-shift-1 right) none ESC '~' invoke G1 into GR (*)
2369 LS2R (locking-shift-2 right) none ESC '}' invoke G2 into GR (*)
2370 LS3R (locking-shift 3 right) none ESC '|' invoke G3 into GR (*)
2371 SS2 (single-shift-2) 0x8E ESC 'N' invoke G2 for one char
2372 SS3 (single-shift-3) 0x8F ESC 'O' invoke G3 for one char
2373 ----------------------------------------------------------------------
2374 (*) These are not used by any known coding system.
2376 Control characters for these functions are defined by macros
2377 ISO_CODE_XXX in `coding.h'.
2379 Designations are done by the following escape sequences:
2380 ----------------------------------------------------------------------
2381 escape sequence description
2382 ----------------------------------------------------------------------
2383 ESC '(' <F> designate DIMENSION1_CHARS94<F> to G0
2384 ESC ')' <F> designate DIMENSION1_CHARS94<F> to G1
2385 ESC '*' <F> designate DIMENSION1_CHARS94<F> to G2
2386 ESC '+' <F> designate DIMENSION1_CHARS94<F> to G3
2387 ESC ',' <F> designate DIMENSION1_CHARS96<F> to G0 (*)
2388 ESC '-' <F> designate DIMENSION1_CHARS96<F> to G1
2389 ESC '.' <F> designate DIMENSION1_CHARS96<F> to G2
2390 ESC '/' <F> designate DIMENSION1_CHARS96<F> to G3
2391 ESC '$' '(' <F> designate DIMENSION2_CHARS94<F> to G0 (**)
2392 ESC '$' ')' <F> designate DIMENSION2_CHARS94<F> to G1
2393 ESC '$' '*' <F> designate DIMENSION2_CHARS94<F> to G2
2394 ESC '$' '+' <F> designate DIMENSION2_CHARS94<F> to G3
2395 ESC '$' ',' <F> designate DIMENSION2_CHARS96<F> to G0 (*)
2396 ESC '$' '-' <F> designate DIMENSION2_CHARS96<F> to G1
2397 ESC '$' '.' <F> designate DIMENSION2_CHARS96<F> to G2
2398 ESC '$' '/' <F> designate DIMENSION2_CHARS96<F> to G3
2399 ----------------------------------------------------------------------
2401 In this list, "DIMENSION1_CHARS94<F>" means a graphic character set
2402 of dimension 1, chars 94, and final character <F>, etc...
2404 Note (*): Although these designations are not allowed in ISO2022,
2405 Emacs accepts them on decoding, and produces them on encoding
2406 CHARS96 character sets in a coding system which is characterized as
2407 7-bit environment, non-locking-shift, and non-single-shift.
2409 Note (**): If <F> is '@', 'A', or 'B', the intermediate character
2410 '(' must be omitted. We refer to this as "short-form" hereafter.
2412 Now you may notice that there are a lot of ways of encoding the
2413 same multilingual text in ISO2022. Actually, there exist many
2414 coding systems such as Compound Text (used in X11's inter client
2415 communication, ISO-2022-JP (used in Japanese Internet), ISO-2022-KR
2416 (used in Korean Internet), EUC (Extended UNIX Code, used in Asian
2417 localized platforms), and all of these are variants of ISO2022.
2419 In addition to the above, Emacs handles two more kinds of escape
2420 sequences: ISO6429's direction specification and Emacs' private
2421 sequence for specifying character composition.
2423 ISO6429's direction specification takes the following form:
2424 o CSI ']' -- end of the current direction
2425 o CSI '0' ']' -- end of the current direction
2426 o CSI '1' ']' -- start of left-to-right text
2427 o CSI '2' ']' -- start of right-to-left text
2428 The control character CSI (0x9B: control sequence introducer) is
2429 abbreviated to the escape sequence ESC '[' in a 7-bit environment.
2431 Character composition specification takes the following form:
2432 o ESC '0' -- start relative composition
2433 o ESC '1' -- end composition
2434 o ESC '2' -- start rule-base composition (*)
2435 o ESC '3' -- start relative composition with alternate chars (**)
2436 o ESC '4' -- start rule-base composition with alternate chars (**)
2437 Since these are not standard escape sequences of any ISO standard,
2438 the use of them with these meanings is restricted to Emacs only.
2440 (*) This form is used only in Emacs 20.7 and older versions,
2441 but newer versions can safely decode it.
2442 (**) This form is used only in Emacs 21.1 and newer versions,
2443 and older versions can't decode it.
2445 Here's a list of example usages of these composition escape
2446 sequences (categorized by `enum composition_method').
2448 COMPOSITION_RELATIVE:
2449 ESC 0 CHAR [ CHAR ] ESC 1
2450 COMPOSITION_WITH_RULE:
2451 ESC 2 CHAR [ RULE CHAR ] ESC 1
2452 COMPOSITION_WITH_ALTCHARS:
2453 ESC 3 ALTCHAR [ ALTCHAR ] ESC 0 CHAR [ CHAR ] ESC 1
2454 COMPOSITION_WITH_RULE_ALTCHARS:
2455 ESC 4 ALTCHAR [ RULE ALTCHAR ] ESC 0 CHAR [ CHAR ] ESC 1 */
2457 enum iso_code_class_type iso_code_class
[256];
2459 #define SAFE_CHARSET_P(coding, id) \
2460 ((id) <= (coding)->max_charset_id \
2461 && (coding)->safe_charsets[id] >= 0)
2464 #define SHIFT_OUT_OK(category) \
2465 (CODING_ISO_INITIAL (&coding_categories[category], 1) >= 0)
2468 setup_iso_safe_charsets (attrs
)
2471 Lisp_Object charset_list
, safe_charsets
;
2472 Lisp_Object request
;
2473 Lisp_Object reg_usage
;
2476 int flags
= XINT (AREF (attrs
, coding_attr_iso_flags
));
2479 charset_list
= CODING_ATTR_CHARSET_LIST (attrs
);
2480 if ((flags
& CODING_ISO_FLAG_FULL_SUPPORT
)
2481 && ! EQ (charset_list
, Viso_2022_charset_list
))
2483 CODING_ATTR_CHARSET_LIST (attrs
)
2484 = charset_list
= Viso_2022_charset_list
;
2485 ASET (attrs
, coding_attr_safe_charsets
, Qnil
);
2488 if (STRINGP (AREF (attrs
, coding_attr_safe_charsets
)))
2492 for (tail
= charset_list
; CONSP (tail
); tail
= XCDR (tail
))
2494 int id
= XINT (XCAR (tail
));
2495 if (max_charset_id
< id
)
2496 max_charset_id
= id
;
2499 safe_charsets
= Fmake_string (make_number (max_charset_id
+ 1),
2501 request
= AREF (attrs
, coding_attr_iso_request
);
2502 reg_usage
= AREF (attrs
, coding_attr_iso_usage
);
2503 reg94
= XINT (XCAR (reg_usage
));
2504 reg96
= XINT (XCDR (reg_usage
));
2506 for (tail
= charset_list
; CONSP (tail
); tail
= XCDR (tail
))
2510 struct charset
*charset
;
2513 charset
= CHARSET_FROM_ID (XINT (id
));
2514 reg
= Fcdr (Fassq (id
, request
));
2516 SSET (safe_charsets
, XINT (id
), XINT (reg
));
2517 else if (charset
->iso_chars_96
)
2520 SSET (safe_charsets
, XINT (id
), reg96
);
2525 SSET (safe_charsets
, XINT (id
), reg94
);
2528 ASET (attrs
, coding_attr_safe_charsets
, safe_charsets
);
2532 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
2533 Check if a text is encoded in one of ISO-2022 based codig systems.
2534 If it is, return 1, else return 0. */
2537 detect_coding_iso_2022 (coding
, detect_info
)
2538 struct coding_system
*coding
;
2539 struct coding_detection_info
*detect_info
;
2541 const unsigned char *src
= coding
->source
, *src_base
= src
;
2542 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
2543 int multibytep
= coding
->src_multibyte
;
2544 int single_shifting
= 0;
2547 int consumed_chars
= 0;
2552 detect_info
->checked
|= CATEGORY_MASK_ISO
;
2554 for (i
= coding_category_iso_7
; i
<= coding_category_iso_8_else
; i
++)
2556 struct coding_system
*this = &(coding_categories
[i
]);
2557 Lisp_Object attrs
, val
;
2559 attrs
= CODING_ID_ATTRS (this->id
);
2560 if (CODING_ISO_FLAGS (this) & CODING_ISO_FLAG_FULL_SUPPORT
2561 && ! EQ (CODING_ATTR_SAFE_CHARSETS (attrs
), Viso_2022_charset_list
))
2562 setup_iso_safe_charsets (attrs
);
2563 val
= CODING_ATTR_SAFE_CHARSETS (attrs
);
2564 this->max_charset_id
= SCHARS (val
) - 1;
2565 this->safe_charsets
= (char *) SDATA (val
);
2568 /* A coding system of this category is always ASCII compatible. */
2569 src
+= coding
->head_ascii
;
2571 while (rejected
!= CATEGORY_MASK_ISO
)
2578 if (inhibit_iso_escape_detection
)
2580 single_shifting
= 0;
2582 if (c
>= '(' && c
<= '/')
2584 /* Designation sequence for a charset of dimension 1. */
2586 if (c1
< ' ' || c1
>= 0x80
2587 || (id
= iso_charset_table
[0][c
>= ','][c1
]) < 0)
2588 /* Invalid designation sequence. Just ignore. */
2593 /* Designation sequence for a charset of dimension 2. */
2595 if (c
>= '@' && c
<= 'B')
2596 /* Designation for JISX0208.1978, GB2312, or JISX0208. */
2597 id
= iso_charset_table
[1][0][c
];
2598 else if (c
>= '(' && c
<= '/')
2601 if (c1
< ' ' || c1
>= 0x80
2602 || (id
= iso_charset_table
[1][c
>= ','][c1
]) < 0)
2603 /* Invalid designation sequence. Just ignore. */
2607 /* Invalid designation sequence. Just ignore it. */
2610 else if (c
== 'N' || c
== 'O')
2612 /* ESC <Fe> for SS2 or SS3. */
2613 single_shifting
= 1;
2614 rejected
|= CATEGORY_MASK_ISO_7BIT
| CATEGORY_MASK_ISO_8BIT
;
2617 else if (c
>= '0' && c
<= '4')
2619 /* ESC <Fp> for start/end composition. */
2620 found
|= CATEGORY_MASK_ISO
;
2625 /* Invalid escape sequence. Just ignore it. */
2629 /* We found a valid designation sequence for CHARSET. */
2630 rejected
|= CATEGORY_MASK_ISO_8BIT
;
2631 if (SAFE_CHARSET_P (&coding_categories
[coding_category_iso_7
],
2633 found
|= CATEGORY_MASK_ISO_7
;
2635 rejected
|= CATEGORY_MASK_ISO_7
;
2636 if (SAFE_CHARSET_P (&coding_categories
[coding_category_iso_7_tight
],
2638 found
|= CATEGORY_MASK_ISO_7_TIGHT
;
2640 rejected
|= CATEGORY_MASK_ISO_7_TIGHT
;
2641 if (SAFE_CHARSET_P (&coding_categories
[coding_category_iso_7_else
],
2643 found
|= CATEGORY_MASK_ISO_7_ELSE
;
2645 rejected
|= CATEGORY_MASK_ISO_7_ELSE
;
2646 if (SAFE_CHARSET_P (&coding_categories
[coding_category_iso_8_else
],
2648 found
|= CATEGORY_MASK_ISO_8_ELSE
;
2650 rejected
|= CATEGORY_MASK_ISO_8_ELSE
;
2655 /* Locking shift out/in. */
2656 if (inhibit_iso_escape_detection
)
2658 single_shifting
= 0;
2659 rejected
|= CATEGORY_MASK_ISO_7BIT
| CATEGORY_MASK_ISO_8BIT
;
2663 /* Control sequence introducer. */
2664 single_shifting
= 0;
2665 rejected
|= CATEGORY_MASK_ISO_7BIT
| CATEGORY_MASK_ISO_7_ELSE
;
2666 found
|= CATEGORY_MASK_ISO_8_ELSE
;
2667 goto check_extra_latin
;
2672 if (inhibit_iso_escape_detection
)
2674 single_shifting
= 0;
2675 rejected
|= CATEGORY_MASK_ISO_7BIT
;
2676 if (CODING_ISO_FLAGS (&coding_categories
[coding_category_iso_8_1
])
2677 & CODING_ISO_FLAG_SINGLE_SHIFT
)
2678 found
|= CATEGORY_MASK_ISO_8_1
, single_shifting
= 1;
2679 if (CODING_ISO_FLAGS (&coding_categories
[coding_category_iso_8_2
])
2680 & CODING_ISO_FLAG_SINGLE_SHIFT
)
2681 found
|= CATEGORY_MASK_ISO_8_2
, single_shifting
= 1;
2682 if (single_shifting
)
2684 goto check_extra_latin
;
2691 single_shifting
= 0;
2696 rejected
|= CATEGORY_MASK_ISO_7BIT
| CATEGORY_MASK_ISO_7_ELSE
;
2697 found
|= CATEGORY_MASK_ISO_8_1
;
2698 /* Check the length of succeeding codes of the range
2699 0xA0..0FF. If the byte length is even, we include
2700 CATEGORY_MASK_ISO_8_2 in `found'. We can check this
2701 only when we are not single shifting. */
2702 if (! single_shifting
2703 && ! (rejected
& CATEGORY_MASK_ISO_8_2
))
2706 while (src
< src_end
)
2714 if (i
& 1 && src
< src_end
)
2715 rejected
|= CATEGORY_MASK_ISO_8_2
;
2717 found
|= CATEGORY_MASK_ISO_8_2
;
2722 single_shifting
= 0;
2723 if (! VECTORP (Vlatin_extra_code_table
)
2724 || NILP (XVECTOR (Vlatin_extra_code_table
)->contents
[c
]))
2726 rejected
= CATEGORY_MASK_ISO
;
2729 if (CODING_ISO_FLAGS (&coding_categories
[coding_category_iso_8_1
])
2730 & CODING_ISO_FLAG_LATIN_EXTRA
)
2731 found
|= CATEGORY_MASK_ISO_8_1
;
2733 rejected
|= CATEGORY_MASK_ISO_8_1
;
2734 rejected
|= CATEGORY_MASK_ISO_8_2
;
2737 detect_info
->rejected
|= CATEGORY_MASK_ISO
;
2741 detect_info
->rejected
|= rejected
;
2742 detect_info
->found
|= (found
& ~rejected
);
2747 /* Set designation state into CODING. Set CHARS_96 to -1 if the
2748 escape sequence should be kept. */
2749 #define DECODE_DESIGNATION(reg, dim, chars_96, final) \
2753 if (final < '0' || final >= 128 \
2754 || ((id = ISO_CHARSET_TABLE (dim, chars_96, final)) < 0) \
2755 || !SAFE_CHARSET_P (coding, id)) \
2757 CODING_ISO_DESIGNATION (coding, reg) = -2; \
2761 prev = CODING_ISO_DESIGNATION (coding, reg); \
2762 if (id == charset_jisx0201_roman) \
2764 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_ROMAN) \
2765 id = charset_ascii; \
2767 else if (id == charset_jisx0208_1978) \
2769 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_OLDJIS) \
2770 id = charset_jisx0208; \
2772 CODING_ISO_DESIGNATION (coding, reg) = id; \
2773 /* If there was an invalid designation to REG previously, and this \
2774 designation is ASCII to REG, we should keep this designation \
2776 if (prev == -2 && id == charset_ascii) \
2781 #define MAYBE_FINISH_COMPOSITION() \
2784 if (composition_state == COMPOSING_NO) \
2786 /* It is assured that we have enough room for producing \
2787 characters stored in the table `components'. */ \
2788 if (charbuf + component_idx > charbuf_end) \
2789 goto no_more_source; \
2790 composition_state = COMPOSING_NO; \
2791 if (method == COMPOSITION_RELATIVE \
2792 || method == COMPOSITION_WITH_ALTCHARS) \
2794 for (i = 0; i < component_idx; i++) \
2795 *charbuf++ = components[i]; \
2796 char_offset += component_idx; \
2800 for (i = 0; i < component_idx; i += 2) \
2801 *charbuf++ = components[i]; \
2802 char_offset += (component_idx / 2) + 1; \
2807 /* Handle composition start sequence ESC 0, ESC 2, ESC 3, or ESC 4.
2808 ESC 0 : relative composition : ESC 0 CHAR ... ESC 1
2809 ESC 2 : rulebase composition : ESC 2 CHAR RULE CHAR RULE ... CHAR ESC 1
2810 ESC 3 : altchar composition : ESC 3 CHAR ... ESC 0 CHAR ... ESC 1
2811 ESC 4 : alt&rule composition : ESC 4 CHAR RULE ... CHAR ESC 0 CHAR ... ESC 1
2814 #define DECODE_COMPOSITION_START(c1) \
2817 && composition_state == COMPOSING_COMPONENT_RULE) \
2819 component_len = component_idx; \
2820 composition_state = COMPOSING_CHAR; \
2824 const unsigned char *p; \
2826 MAYBE_FINISH_COMPOSITION (); \
2827 if (charbuf + MAX_COMPOSITION_COMPONENTS > charbuf_end) \
2828 goto no_more_source; \
2829 for (p = src; p < src_end - 1; p++) \
2830 if (*p == ISO_CODE_ESC && p[1] == '1') \
2832 if (p == src_end - 1) \
2834 /* The current composition doesn't end in the current \
2836 record_conversion_result \
2837 (coding, CODING_RESULT_INSUFFICIENT_SRC); \
2838 goto no_more_source; \
2841 /* This is surely the start of a composition. */ \
2842 method = (c1 == '0' ? COMPOSITION_RELATIVE \
2843 : c1 == '2' ? COMPOSITION_WITH_RULE \
2844 : c1 == '3' ? COMPOSITION_WITH_ALTCHARS \
2845 : COMPOSITION_WITH_RULE_ALTCHARS); \
2846 composition_state = (c1 <= '2' ? COMPOSING_CHAR \
2847 : COMPOSING_COMPONENT_CHAR); \
2848 component_idx = component_len = 0; \
2853 /* Handle compositoin end sequence ESC 1. */
2855 #define DECODE_COMPOSITION_END() \
2857 int nchars = (component_len > 0 ? component_idx - component_len \
2858 : method == COMPOSITION_RELATIVE ? component_idx \
2859 : (component_idx + 1) / 2); \
2861 int *saved_charbuf = charbuf; \
2863 ADD_COMPOSITION_DATA (charbuf, nchars, method); \
2864 if (method != COMPOSITION_RELATIVE) \
2866 if (component_len == 0) \
2867 for (i = 0; i < component_idx; i++) \
2868 *charbuf++ = components[i]; \
2870 for (i = 0; i < component_len; i++) \
2871 *charbuf++ = components[i]; \
2872 *saved_charbuf = saved_charbuf - charbuf; \
2874 if (method == COMPOSITION_WITH_RULE) \
2875 for (i = 0; i < component_idx; i += 2, char_offset++) \
2876 *charbuf++ = components[i]; \
2878 for (i = component_len; i < component_idx; i++, char_offset++) \
2879 *charbuf++ = components[i]; \
2880 coding->annotated = 1; \
2881 composition_state = COMPOSING_NO; \
2885 /* Decode a composition rule from the byte C1 (and maybe one more byte
2886 from SRC) and store one encoded composition rule in
2887 coding->cmp_data. */
2889 #define DECODE_COMPOSITION_RULE(c1) \
2892 if (c1 < 81) /* old format (before ver.21) */ \
2894 int gref = (c1) / 9; \
2895 int nref = (c1) % 9; \
2896 if (gref == 4) gref = 10; \
2897 if (nref == 4) nref = 10; \
2898 c1 = COMPOSITION_ENCODE_RULE (gref, nref); \
2900 else if (c1 < 93) /* new format (after ver.21) */ \
2902 ONE_MORE_BYTE (c2); \
2903 c1 = COMPOSITION_ENCODE_RULE (c1 - 81, c2 - 32); \
2910 /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
2913 decode_coding_iso_2022 (coding
)
2914 struct coding_system
*coding
;
2916 const unsigned char *src
= coding
->source
+ coding
->consumed
;
2917 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
2918 const unsigned char *src_base
;
2919 int *charbuf
= coding
->charbuf
+ coding
->charbuf_used
;
2921 = coding
->charbuf
+ coding
->charbuf_size
- 4 - MAX_ANNOTATION_LENGTH
;
2922 int consumed_chars
= 0, consumed_chars_base
;
2923 int multibytep
= coding
->src_multibyte
;
2924 /* Charsets invoked to graphic plane 0 and 1 respectively. */
2925 int charset_id_0
= CODING_ISO_INVOKED_CHARSET (coding
, 0);
2926 int charset_id_1
= CODING_ISO_INVOKED_CHARSET (coding
, 1);
2927 int charset_id_2
, charset_id_3
;
2928 struct charset
*charset
;
2930 /* For handling composition sequence. */
2931 #define COMPOSING_NO 0
2932 #define COMPOSING_CHAR 1
2933 #define COMPOSING_RULE 2
2934 #define COMPOSING_COMPONENT_CHAR 3
2935 #define COMPOSING_COMPONENT_RULE 4
2937 int composition_state
= COMPOSING_NO
;
2938 enum composition_method method
;
2939 int components
[MAX_COMPOSITION_COMPONENTS
* 2 + 1];
2942 Lisp_Object attrs
, charset_list
;
2943 int char_offset
= coding
->produced_char
;
2944 int last_offset
= char_offset
;
2945 int last_id
= charset_ascii
;
2947 CODING_GET_INFO (coding
, attrs
, charset_list
);
2948 setup_iso_safe_charsets (attrs
);
2949 /* Charset list may have been changed. */
2950 charset_list
= CODING_ATTR_CHARSET_LIST (attrs
);
2951 coding
->safe_charsets
= (char *) SDATA (CODING_ATTR_SAFE_CHARSETS(attrs
));
2958 consumed_chars_base
= consumed_chars
;
2960 if (charbuf
>= charbuf_end
)
2967 /* We produce at most one character. */
2968 switch (iso_code_class
[c1
])
2970 case ISO_0x20_or_0x7F
:
2971 if (composition_state
!= COMPOSING_NO
)
2973 if (composition_state
== COMPOSING_RULE
2974 || composition_state
== COMPOSING_COMPONENT_RULE
)
2976 DECODE_COMPOSITION_RULE (c1
);
2977 components
[component_idx
++] = c1
;
2978 composition_state
--;
2982 if (charset_id_0
< 0
2983 || ! CHARSET_ISO_CHARS_96 (CHARSET_FROM_ID (charset_id_0
)))
2984 /* This is SPACE or DEL. */
2985 charset
= CHARSET_FROM_ID (charset_ascii
);
2987 charset
= CHARSET_FROM_ID (charset_id_0
);
2990 case ISO_graphic_plane_0
:
2991 if (composition_state
!= COMPOSING_NO
)
2993 if (composition_state
== COMPOSING_RULE
2994 || composition_state
== COMPOSING_COMPONENT_RULE
)
2996 DECODE_COMPOSITION_RULE (c1
);
2997 components
[component_idx
++] = c1
;
2998 composition_state
--;
3002 if (charset_id_0
< 0)
3003 charset
= CHARSET_FROM_ID (charset_ascii
);
3005 charset
= CHARSET_FROM_ID (charset_id_0
);
3008 case ISO_0xA0_or_0xFF
:
3009 if (charset_id_1
< 0
3010 || ! CHARSET_ISO_CHARS_96 (CHARSET_FROM_ID (charset_id_1
))
3011 || CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_SEVEN_BITS
)
3013 /* This is a graphic character, we fall down ... */
3015 case ISO_graphic_plane_1
:
3016 if (charset_id_1
< 0)
3018 charset
= CHARSET_FROM_ID (charset_id_1
);
3022 MAYBE_FINISH_COMPOSITION ();
3023 charset
= CHARSET_FROM_ID (charset_ascii
);
3027 MAYBE_FINISH_COMPOSITION ();
3031 if (! (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_LOCKING_SHIFT
)
3032 || CODING_ISO_DESIGNATION (coding
, 1) < 0)
3034 CODING_ISO_INVOCATION (coding
, 0) = 1;
3035 charset_id_0
= CODING_ISO_INVOKED_CHARSET (coding
, 0);
3039 if (! (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_LOCKING_SHIFT
))
3041 CODING_ISO_INVOCATION (coding
, 0) = 0;
3042 charset_id_0
= CODING_ISO_INVOKED_CHARSET (coding
, 0);
3045 case ISO_single_shift_2_7
:
3046 case ISO_single_shift_2
:
3047 if (! (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_SINGLE_SHIFT
))
3049 /* SS2 is handled as an escape sequence of ESC 'N' */
3051 goto label_escape_sequence
;
3053 case ISO_single_shift_3
:
3054 if (! (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_SINGLE_SHIFT
))
3056 /* SS2 is handled as an escape sequence of ESC 'O' */
3058 goto label_escape_sequence
;
3060 case ISO_control_sequence_introducer
:
3061 /* CSI is handled as an escape sequence of ESC '[' ... */
3063 goto label_escape_sequence
;
3067 label_escape_sequence
:
3068 /* Escape sequences handled here are invocation,
3069 designation, direction specification, and character
3070 composition specification. */
3073 case '&': /* revision of following character set */
3075 if (!(c1
>= '@' && c1
<= '~'))
3078 if (c1
!= ISO_CODE_ESC
)
3081 goto label_escape_sequence
;
3083 case '$': /* designation of 2-byte character set */
3084 if (! (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_DESIGNATION
))
3090 if (c1
>= '@' && c1
<= 'B')
3091 { /* designation of JISX0208.1978, GB2312.1980,
3093 reg
= 0, chars96
= 0;
3095 else if (c1
>= 0x28 && c1
<= 0x2B)
3096 { /* designation of DIMENSION2_CHARS94 character set */
3097 reg
= c1
- 0x28, chars96
= 0;
3100 else if (c1
>= 0x2C && c1
<= 0x2F)
3101 { /* designation of DIMENSION2_CHARS96 character set */
3102 reg
= c1
- 0x2C, chars96
= 1;
3107 DECODE_DESIGNATION (reg
, 2, chars96
, c1
);
3108 /* We must update these variables now. */
3110 charset_id_0
= CODING_ISO_INVOKED_CHARSET (coding
, 0);
3112 charset_id_1
= CODING_ISO_INVOKED_CHARSET (coding
, 1);
3118 case 'n': /* invocation of locking-shift-2 */
3119 if (! (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_LOCKING_SHIFT
)
3120 || CODING_ISO_DESIGNATION (coding
, 2) < 0)
3122 CODING_ISO_INVOCATION (coding
, 0) = 2;
3123 charset_id_0
= CODING_ISO_INVOKED_CHARSET (coding
, 0);
3126 case 'o': /* invocation of locking-shift-3 */
3127 if (! (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_LOCKING_SHIFT
)
3128 || CODING_ISO_DESIGNATION (coding
, 3) < 0)
3130 CODING_ISO_INVOCATION (coding
, 0) = 3;
3131 charset_id_0
= CODING_ISO_INVOKED_CHARSET (coding
, 0);
3134 case 'N': /* invocation of single-shift-2 */
3135 if (! (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_SINGLE_SHIFT
)
3136 || CODING_ISO_DESIGNATION (coding
, 2) < 0)
3138 charset_id_2
= CODING_ISO_DESIGNATION (coding
, 2);
3139 if (charset_id_2
< 0)
3140 charset
= CHARSET_FROM_ID (charset_ascii
);
3142 charset
= CHARSET_FROM_ID (charset_id_2
);
3144 if (c1
< 0x20 || (c1
>= 0x80 && c1
< 0xA0))
3148 case 'O': /* invocation of single-shift-3 */
3149 if (! (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_SINGLE_SHIFT
)
3150 || CODING_ISO_DESIGNATION (coding
, 3) < 0)
3152 charset_id_3
= CODING_ISO_DESIGNATION (coding
, 3);
3153 if (charset_id_3
< 0)
3154 charset
= CHARSET_FROM_ID (charset_ascii
);
3156 charset
= CHARSET_FROM_ID (charset_id_3
);
3158 if (c1
< 0x20 || (c1
>= 0x80 && c1
< 0xA0))
3162 case '0': case '2': case '3': case '4': /* start composition */
3163 if (! (coding
->common_flags
& CODING_ANNOTATE_COMPOSITION_MASK
))
3165 DECODE_COMPOSITION_START (c1
);
3168 case '1': /* end composition */
3169 if (composition_state
== COMPOSING_NO
)
3171 DECODE_COMPOSITION_END ();
3174 case '[': /* specification of direction */
3175 if (! CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_DIRECTION
)
3177 /* For the moment, nested direction is not supported.
3178 So, `coding->mode & CODING_MODE_DIRECTION' zero means
3179 left-to-right, and nozero means right-to-left. */
3183 case ']': /* end of the current direction */
3184 coding
->mode
&= ~CODING_MODE_DIRECTION
;
3186 case '0': /* end of the current direction */
3187 case '1': /* start of left-to-right direction */
3190 coding
->mode
&= ~CODING_MODE_DIRECTION
;
3195 case '2': /* start of right-to-left direction */
3198 coding
->mode
|= CODING_MODE_DIRECTION
;
3212 /* CTEXT extended segment:
3213 ESC % / [0-4] M L --ENCODING-NAME-- \002 --BYTES--
3214 We keep these bytes as is for the moment.
3215 They may be decoded by post-read-conversion. */
3219 ONE_MORE_BYTE (dim
);
3222 size
= ((M
- 128) * 128) + (L
- 128);
3223 if (charbuf
+ 8 + size
> charbuf_end
)
3225 *charbuf
++ = ISO_CODE_ESC
;
3229 *charbuf
++ = BYTE8_TO_CHAR (M
);
3230 *charbuf
++ = BYTE8_TO_CHAR (L
);
3234 *charbuf
++ = ASCII_BYTE_P (c1
) ? c1
: BYTE8_TO_CHAR (c1
);
3239 /* XFree86 extension for embedding UTF-8 in CTEXT:
3240 ESC % G --UTF-8-BYTES-- ESC % @
3241 We keep these bytes as is for the moment.
3242 They may be decoded by post-read-conversion. */
3245 if (p
+ 6 > charbuf_end
)
3247 *p
++ = ISO_CODE_ESC
;
3250 while (p
< charbuf_end
)
3253 if (c1
== ISO_CODE_ESC
3254 && src
+ 1 < src_end
3261 *p
++ = ASCII_BYTE_P (c1
) ? c1
: BYTE8_TO_CHAR (c1
);
3263 if (p
+ 3 > charbuf_end
)
3265 *p
++ = ISO_CODE_ESC
;
3276 if (! (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_DESIGNATION
))
3281 if (c1
>= 0x28 && c1
<= 0x2B)
3282 { /* designation of DIMENSION1_CHARS94 character set */
3283 reg
= c1
- 0x28, chars96
= 0;
3286 else if (c1
>= 0x2C && c1
<= 0x2F)
3287 { /* designation of DIMENSION1_CHARS96 character set */
3288 reg
= c1
- 0x2C, chars96
= 1;
3293 DECODE_DESIGNATION (reg
, 1, chars96
, c1
);
3294 /* We must update these variables now. */
3296 charset_id_0
= CODING_ISO_INVOKED_CHARSET (coding
, 0);
3298 charset_id_1
= CODING_ISO_INVOKED_CHARSET (coding
, 1);
3306 if (charset
->id
!= charset_ascii
3307 && last_id
!= charset
->id
)
3309 if (last_id
!= charset_ascii
)
3310 ADD_CHARSET_DATA (charbuf
, char_offset
- last_offset
, last_id
);
3311 last_id
= charset
->id
;
3312 last_offset
= char_offset
;
3315 /* Now we know CHARSET and 1st position code C1 of a character.
3316 Produce a decoded character while getting 2nd position code
3319 if (CHARSET_DIMENSION (charset
) > 1)
3322 if (c2
< 0x20 || (c2
>= 0x80 && c2
< 0xA0))
3323 /* C2 is not in a valid range. */
3325 c1
= (c1
<< 8) | (c2
& 0x7F);
3326 if (CHARSET_DIMENSION (charset
) > 2)
3329 if (c2
< 0x20 || (c2
>= 0x80 && c2
< 0xA0))
3330 /* C2 is not in a valid range. */
3332 c1
= (c1
<< 8) | (c2
& 0x7F);
3336 CODING_DECODE_CHAR (coding
, src
, src_base
, src_end
, charset
, c1
, c
);
3339 MAYBE_FINISH_COMPOSITION ();
3340 for (; src_base
< src
; src_base
++, char_offset
++)
3342 if (ASCII_BYTE_P (*src_base
))
3343 *charbuf
++ = *src_base
;
3345 *charbuf
++ = BYTE8_TO_CHAR (*src_base
);
3348 else if (composition_state
== COMPOSING_NO
)
3355 components
[component_idx
++] = c
;
3356 if (method
== COMPOSITION_WITH_RULE
3357 || (method
== COMPOSITION_WITH_RULE_ALTCHARS
3358 && composition_state
== COMPOSING_COMPONENT_CHAR
))
3359 composition_state
++;
3364 MAYBE_FINISH_COMPOSITION ();
3366 consumed_chars
= consumed_chars_base
;
3368 *charbuf
++ = c
< 0 ? -c
: ASCII_BYTE_P (c
) ? c
: BYTE8_TO_CHAR (c
);
3378 if (last_id
!= charset_ascii
)
3379 ADD_CHARSET_DATA (charbuf
, char_offset
- last_offset
, last_id
);
3380 coding
->consumed_char
+= consumed_chars_base
;
3381 coding
->consumed
= src_base
- coding
->source
;
3382 coding
->charbuf_used
= charbuf
- coding
->charbuf
;
3386 /* ISO2022 encoding stuff. */
3389 It is not enough to say just "ISO2022" on encoding, we have to
3390 specify more details. In Emacs, each coding system of ISO2022
3391 variant has the following specifications:
3392 1. Initial designation to G0 thru G3.
3393 2. Allows short-form designation?
3394 3. ASCII should be designated to G0 before control characters?
3395 4. ASCII should be designated to G0 at end of line?
3396 5. 7-bit environment or 8-bit environment?
3397 6. Use locking-shift?
3398 7. Use Single-shift?
3399 And the following two are only for Japanese:
3400 8. Use ASCII in place of JIS0201-1976-Roman?
3401 9. Use JISX0208-1983 in place of JISX0208-1978?
3402 These specifications are encoded in CODING_ISO_FLAGS (coding) as flag bits
3403 defined by macros CODING_ISO_FLAG_XXX. See `coding.h' for more
3407 /* Produce codes (escape sequence) for designating CHARSET to graphic
3408 register REG at DST, and increment DST. If <final-char> of CHARSET is
3409 '@', 'A', or 'B' and the coding system CODING allows, produce
3410 designation sequence of short-form. */
3412 #define ENCODE_DESIGNATION(charset, reg, coding) \
3414 unsigned char final_char = CHARSET_ISO_FINAL (charset); \
3415 char *intermediate_char_94 = "()*+"; \
3416 char *intermediate_char_96 = ",-./"; \
3417 int revision = -1; \
3420 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_REVISION) \
3421 revision = CHARSET_ISO_REVISION (charset); \
3423 if (revision >= 0) \
3425 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, '&'); \
3426 EMIT_ONE_BYTE ('@' + revision); \
3428 EMIT_ONE_ASCII_BYTE (ISO_CODE_ESC); \
3429 if (CHARSET_DIMENSION (charset) == 1) \
3431 if (! CHARSET_ISO_CHARS_96 (charset)) \
3432 c = intermediate_char_94[reg]; \
3434 c = intermediate_char_96[reg]; \
3435 EMIT_ONE_ASCII_BYTE (c); \
3439 EMIT_ONE_ASCII_BYTE ('$'); \
3440 if (! CHARSET_ISO_CHARS_96 (charset)) \
3442 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LONG_FORM \
3444 || final_char < '@' || final_char > 'B') \
3445 EMIT_ONE_ASCII_BYTE (intermediate_char_94[reg]); \
3448 EMIT_ONE_ASCII_BYTE (intermediate_char_96[reg]); \
3450 EMIT_ONE_ASCII_BYTE (final_char); \
3452 CODING_ISO_DESIGNATION (coding, reg) = CHARSET_ID (charset); \
3456 /* The following two macros produce codes (control character or escape
3457 sequence) for ISO2022 single-shift functions (single-shift-2 and
3460 #define ENCODE_SINGLE_SHIFT_2 \
3462 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
3463 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'N'); \
3465 EMIT_ONE_BYTE (ISO_CODE_SS2); \
3466 CODING_ISO_SINGLE_SHIFTING (coding) = 1; \
3470 #define ENCODE_SINGLE_SHIFT_3 \
3472 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
3473 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'O'); \
3475 EMIT_ONE_BYTE (ISO_CODE_SS3); \
3476 CODING_ISO_SINGLE_SHIFTING (coding) = 1; \
3480 /* The following four macros produce codes (control character or
3481 escape sequence) for ISO2022 locking-shift functions (shift-in,
3482 shift-out, locking-shift-2, and locking-shift-3). */
3484 #define ENCODE_SHIFT_IN \
3486 EMIT_ONE_ASCII_BYTE (ISO_CODE_SI); \
3487 CODING_ISO_INVOCATION (coding, 0) = 0; \
3491 #define ENCODE_SHIFT_OUT \
3493 EMIT_ONE_ASCII_BYTE (ISO_CODE_SO); \
3494 CODING_ISO_INVOCATION (coding, 0) = 1; \
3498 #define ENCODE_LOCKING_SHIFT_2 \
3500 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'n'); \
3501 CODING_ISO_INVOCATION (coding, 0) = 2; \
3505 #define ENCODE_LOCKING_SHIFT_3 \
3507 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, 'n'); \
3508 CODING_ISO_INVOCATION (coding, 0) = 3; \
3512 /* Produce codes for a DIMENSION1 character whose character set is
3513 CHARSET and whose position-code is C1. Designation and invocation
3514 sequences are also produced in advance if necessary. */
3516 #define ENCODE_ISO_CHARACTER_DIMENSION1(charset, c1) \
3518 int id = CHARSET_ID (charset); \
3520 if ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_ROMAN) \
3521 && id == charset_ascii) \
3523 id = charset_jisx0201_roman; \
3524 charset = CHARSET_FROM_ID (id); \
3527 if (CODING_ISO_SINGLE_SHIFTING (coding)) \
3529 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
3530 EMIT_ONE_ASCII_BYTE (c1 & 0x7F); \
3532 EMIT_ONE_BYTE (c1 | 0x80); \
3533 CODING_ISO_SINGLE_SHIFTING (coding) = 0; \
3536 else if (id == CODING_ISO_INVOKED_CHARSET (coding, 0)) \
3538 EMIT_ONE_ASCII_BYTE (c1 & 0x7F); \
3541 else if (id == CODING_ISO_INVOKED_CHARSET (coding, 1)) \
3543 EMIT_ONE_BYTE (c1 | 0x80); \
3547 /* Since CHARSET is not yet invoked to any graphic planes, we \
3548 must invoke it, or, at first, designate it to some graphic \
3549 register. Then repeat the loop to actually produce the \
3551 dst = encode_invocation_designation (charset, coding, dst, \
3556 /* Produce codes for a DIMENSION2 character whose character set is
3557 CHARSET and whose position-codes are C1 and C2. Designation and
3558 invocation codes are also produced in advance if necessary. */
3560 #define ENCODE_ISO_CHARACTER_DIMENSION2(charset, c1, c2) \
3562 int id = CHARSET_ID (charset); \
3564 if ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_USE_OLDJIS) \
3565 && id == charset_jisx0208) \
3567 id = charset_jisx0208_1978; \
3568 charset = CHARSET_FROM_ID (id); \
3571 if (CODING_ISO_SINGLE_SHIFTING (coding)) \
3573 if (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) \
3574 EMIT_TWO_ASCII_BYTES ((c1) & 0x7F, (c2) & 0x7F); \
3576 EMIT_TWO_BYTES ((c1) | 0x80, (c2) | 0x80); \
3577 CODING_ISO_SINGLE_SHIFTING (coding) = 0; \
3580 else if (id == CODING_ISO_INVOKED_CHARSET (coding, 0)) \
3582 EMIT_TWO_ASCII_BYTES ((c1) & 0x7F, (c2) & 0x7F); \
3585 else if (id == CODING_ISO_INVOKED_CHARSET (coding, 1)) \
3587 EMIT_TWO_BYTES ((c1) | 0x80, (c2) | 0x80); \
3591 /* Since CHARSET is not yet invoked to any graphic planes, we \
3592 must invoke it, or, at first, designate it to some graphic \
3593 register. Then repeat the loop to actually produce the \
3595 dst = encode_invocation_designation (charset, coding, dst, \
3600 #define ENCODE_ISO_CHARACTER(charset, c) \
3602 int code = ENCODE_CHAR ((charset),(c)); \
3604 if (CHARSET_DIMENSION (charset) == 1) \
3605 ENCODE_ISO_CHARACTER_DIMENSION1 ((charset), code); \
3607 ENCODE_ISO_CHARACTER_DIMENSION2 ((charset), code >> 8, code & 0xFF); \
3611 /* Produce designation and invocation codes at a place pointed by DST
3612 to use CHARSET. The element `spec.iso_2022' of *CODING is updated.
3616 encode_invocation_designation (charset
, coding
, dst
, p_nchars
)
3617 struct charset
*charset
;
3618 struct coding_system
*coding
;
3622 int multibytep
= coding
->dst_multibyte
;
3623 int produced_chars
= *p_nchars
;
3624 int reg
; /* graphic register number */
3625 int id
= CHARSET_ID (charset
);
3627 /* At first, check designations. */
3628 for (reg
= 0; reg
< 4; reg
++)
3629 if (id
== CODING_ISO_DESIGNATION (coding
, reg
))
3634 /* CHARSET is not yet designated to any graphic registers. */
3635 /* At first check the requested designation. */
3636 reg
= CODING_ISO_REQUEST (coding
, id
);
3638 /* Since CHARSET requests no special designation, designate it
3639 to graphic register 0. */
3642 ENCODE_DESIGNATION (charset
, reg
, coding
);
3645 if (CODING_ISO_INVOCATION (coding
, 0) != reg
3646 && CODING_ISO_INVOCATION (coding
, 1) != reg
)
3648 /* Since the graphic register REG is not invoked to any graphic
3649 planes, invoke it to graphic plane 0. */
3652 case 0: /* graphic register 0 */
3656 case 1: /* graphic register 1 */
3660 case 2: /* graphic register 2 */
3661 if (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_SINGLE_SHIFT
)
3662 ENCODE_SINGLE_SHIFT_2
;
3664 ENCODE_LOCKING_SHIFT_2
;
3667 case 3: /* graphic register 3 */
3668 if (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_SINGLE_SHIFT
)
3669 ENCODE_SINGLE_SHIFT_3
;
3671 ENCODE_LOCKING_SHIFT_3
;
3676 *p_nchars
= produced_chars
;
3680 /* The following three macros produce codes for indicating direction
3682 #define ENCODE_CONTROL_SEQUENCE_INTRODUCER \
3684 if (CODING_ISO_FLAGS (coding) == CODING_ISO_FLAG_SEVEN_BITS) \
3685 EMIT_TWO_ASCII_BYTES (ISO_CODE_ESC, '['); \
3687 EMIT_ONE_BYTE (ISO_CODE_CSI); \
3691 #define ENCODE_DIRECTION_R2L() \
3693 ENCODE_CONTROL_SEQUENCE_INTRODUCER (dst); \
3694 EMIT_TWO_ASCII_BYTES ('2', ']'); \
3698 #define ENCODE_DIRECTION_L2R() \
3700 ENCODE_CONTROL_SEQUENCE_INTRODUCER (dst); \
3701 EMIT_TWO_ASCII_BYTES ('0', ']'); \
3705 /* Produce codes for designation and invocation to reset the graphic
3706 planes and registers to initial state. */
3707 #define ENCODE_RESET_PLANE_AND_REGISTER() \
3710 struct charset *charset; \
3712 if (CODING_ISO_INVOCATION (coding, 0) != 0) \
3714 for (reg = 0; reg < 4; reg++) \
3715 if (CODING_ISO_INITIAL (coding, reg) >= 0 \
3716 && (CODING_ISO_DESIGNATION (coding, reg) \
3717 != CODING_ISO_INITIAL (coding, reg))) \
3719 charset = CHARSET_FROM_ID (CODING_ISO_INITIAL (coding, reg)); \
3720 ENCODE_DESIGNATION (charset, reg, coding); \
3725 /* Produce designation sequences of charsets in the line started from
3726 SRC to a place pointed by DST, and return updated DST.
3728 If the current block ends before any end-of-line, we may fail to
3729 find all the necessary designations. */
3731 static unsigned char *
3732 encode_designation_at_bol (coding
, charbuf
, charbuf_end
, dst
)
3733 struct coding_system
*coding
;
3734 int *charbuf
, *charbuf_end
;
3737 struct charset
*charset
;
3738 /* Table of charsets to be designated to each graphic register. */
3740 int c
, found
= 0, reg
;
3741 int produced_chars
= 0;
3742 int multibytep
= coding
->dst_multibyte
;
3744 Lisp_Object charset_list
;
3746 attrs
= CODING_ID_ATTRS (coding
->id
);
3747 charset_list
= CODING_ATTR_CHARSET_LIST (attrs
);
3748 if (EQ (charset_list
, Qiso_2022
))
3749 charset_list
= Viso_2022_charset_list
;
3751 for (reg
= 0; reg
< 4; reg
++)
3761 charset
= char_charset (c
, charset_list
, NULL
);
3762 id
= CHARSET_ID (charset
);
3763 reg
= CODING_ISO_REQUEST (coding
, id
);
3764 if (reg
>= 0 && r
[reg
] < 0)
3773 for (reg
= 0; reg
< 4; reg
++)
3775 && CODING_ISO_DESIGNATION (coding
, reg
) != r
[reg
])
3776 ENCODE_DESIGNATION (CHARSET_FROM_ID (r
[reg
]), reg
, coding
);
3782 /* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions". */
3785 encode_coding_iso_2022 (coding
)
3786 struct coding_system
*coding
;
3788 int multibytep
= coding
->dst_multibyte
;
3789 int *charbuf
= coding
->charbuf
;
3790 int *charbuf_end
= charbuf
+ coding
->charbuf_used
;
3791 unsigned char *dst
= coding
->destination
+ coding
->produced
;
3792 unsigned char *dst_end
= coding
->destination
+ coding
->dst_bytes
;
3795 = (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_DESIGNATE_AT_BOL
3796 && CODING_ISO_BOL (coding
));
3797 int produced_chars
= 0;
3798 Lisp_Object attrs
, eol_type
, charset_list
;
3799 int ascii_compatible
;
3801 int preferred_charset_id
= -1;
3803 CODING_GET_INFO (coding
, attrs
, charset_list
);
3804 eol_type
= CODING_ID_EOL_TYPE (coding
->id
);
3805 if (VECTORP (eol_type
))
3808 setup_iso_safe_charsets (attrs
);
3809 /* Charset list may have been changed. */
3810 charset_list
= CODING_ATTR_CHARSET_LIST (attrs
);
3811 coding
->safe_charsets
= (char *) SDATA (CODING_ATTR_SAFE_CHARSETS(attrs
));
3813 ascii_compatible
= ! NILP (CODING_ATTR_ASCII_COMPAT (attrs
));
3815 while (charbuf
< charbuf_end
)
3817 ASSURE_DESTINATION (safe_room
);
3819 if (bol_designation
)
3821 unsigned char *dst_prev
= dst
;
3823 /* We have to produce designation sequences if any now. */
3824 dst
= encode_designation_at_bol (coding
, charbuf
, charbuf_end
, dst
);
3825 bol_designation
= 0;
3826 /* We are sure that designation sequences are all ASCII bytes. */
3827 produced_chars
+= dst
- dst_prev
;
3834 /* Handle an annotation. */
3837 case CODING_ANNOTATE_COMPOSITION_MASK
:
3838 /* Not yet implemented. */
3840 case CODING_ANNOTATE_CHARSET_MASK
:
3841 preferred_charset_id
= charbuf
[2];
3842 if (preferred_charset_id
>= 0
3843 && NILP (Fmemq (make_number (preferred_charset_id
),
3845 preferred_charset_id
= -1;
3854 /* Now encode the character C. */
3855 if (c
< 0x20 || c
== 0x7F)
3858 || (c
== '\r' && EQ (eol_type
, Qmac
)))
3860 if (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_RESET_AT_EOL
)
3861 ENCODE_RESET_PLANE_AND_REGISTER ();
3862 if (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_INIT_AT_BOL
)
3866 for (i
= 0; i
< 4; i
++)
3867 CODING_ISO_DESIGNATION (coding
, i
)
3868 = CODING_ISO_INITIAL (coding
, i
);
3871 = CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_DESIGNATE_AT_BOL
;
3873 else if (CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_RESET_AT_CNTL
)
3874 ENCODE_RESET_PLANE_AND_REGISTER ();
3875 EMIT_ONE_ASCII_BYTE (c
);
3877 else if (ASCII_CHAR_P (c
))
3879 if (ascii_compatible
)
3880 EMIT_ONE_ASCII_BYTE (c
);
3883 struct charset
*charset
= CHARSET_FROM_ID (charset_ascii
);
3884 ENCODE_ISO_CHARACTER (charset
, c
);
3887 else if (CHAR_BYTE8_P (c
))
3889 c
= CHAR_TO_BYTE8 (c
);
3894 struct charset
*charset
;
3896 if (preferred_charset_id
>= 0)
3898 charset
= CHARSET_FROM_ID (preferred_charset_id
);
3899 if (! CHAR_CHARSET_P (c
, charset
))
3900 charset
= char_charset (c
, charset_list
, NULL
);
3903 charset
= char_charset (c
, charset_list
, NULL
);
3906 if (coding
->mode
& CODING_MODE_SAFE_ENCODING
)
3908 c
= CODING_INHIBIT_CHARACTER_SUBSTITUTION
;
3909 charset
= CHARSET_FROM_ID (charset_ascii
);
3913 c
= coding
->default_char
;
3914 charset
= char_charset (c
, charset_list
, NULL
);
3917 ENCODE_ISO_CHARACTER (charset
, c
);
3921 if (coding
->mode
& CODING_MODE_LAST_BLOCK
3922 && CODING_ISO_FLAGS (coding
) & CODING_ISO_FLAG_RESET_AT_EOL
)
3924 ASSURE_DESTINATION (safe_room
);
3925 ENCODE_RESET_PLANE_AND_REGISTER ();
3927 record_conversion_result (coding
, CODING_RESULT_SUCCESS
);
3928 CODING_ISO_BOL (coding
) = bol_designation
;
3929 coding
->produced_char
+= produced_chars
;
3930 coding
->produced
= dst
- coding
->destination
;
3935 /*** 8,9. SJIS and BIG5 handlers ***/
3937 /* Although SJIS and BIG5 are not ISO's coding system, they are used
3938 quite widely. So, for the moment, Emacs supports them in the bare
3939 C code. But, in the future, they may be supported only by CCL. */
3941 /* SJIS is a coding system encoding three character sets: ASCII, right
3942 half of JISX0201-Kana, and JISX0208. An ASCII character is encoded
3943 as is. A character of charset katakana-jisx0201 is encoded by
3944 "position-code + 0x80". A character of charset japanese-jisx0208
3945 is encoded in 2-byte but two position-codes are divided and shifted
3946 so that it fit in the range below.
3948 --- CODE RANGE of SJIS ---
3949 (character set) (range)
3951 KATAKANA-JISX0201 0xA0 .. 0xDF
3952 JISX0208 (1st byte) 0x81 .. 0x9F and 0xE0 .. 0xEF
3953 (2nd byte) 0x40 .. 0x7E and 0x80 .. 0xFC
3954 -------------------------------
3958 /* BIG5 is a coding system encoding two character sets: ASCII and
3959 Big5. An ASCII character is encoded as is. Big5 is a two-byte
3960 character set and is encoded in two-byte.
3962 --- CODE RANGE of BIG5 ---
3963 (character set) (range)
3965 Big5 (1st byte) 0xA1 .. 0xFE
3966 (2nd byte) 0x40 .. 0x7E and 0xA1 .. 0xFE
3967 --------------------------
3971 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
3972 Check if a text is encoded in SJIS. If it is, return
3973 CATEGORY_MASK_SJIS, else return 0. */
3976 detect_coding_sjis (coding
, detect_info
)
3977 struct coding_system
*coding
;
3978 struct coding_detection_info
*detect_info
;
3980 const unsigned char *src
= coding
->source
, *src_base
;
3981 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
3982 int multibytep
= coding
->src_multibyte
;
3983 int consumed_chars
= 0;
3987 detect_info
->checked
|= CATEGORY_MASK_SJIS
;
3988 /* A coding system of this category is always ASCII compatible. */
3989 src
+= coding
->head_ascii
;
3997 if ((c
>= 0x81 && c
<= 0x9F) || (c
>= 0xE0 && c
<= 0xEF))
4000 if (c
< 0x40 || c
== 0x7F || c
> 0xFC)
4002 found
= CATEGORY_MASK_SJIS
;
4004 else if (c
>= 0xA0 && c
< 0xE0)
4005 found
= CATEGORY_MASK_SJIS
;
4009 detect_info
->rejected
|= CATEGORY_MASK_SJIS
;
4013 if (src_base
< src
&& coding
->mode
& CODING_MODE_LAST_BLOCK
)
4015 detect_info
->rejected
|= CATEGORY_MASK_SJIS
;
4018 detect_info
->found
|= found
;
4022 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
4023 Check if a text is encoded in BIG5. If it is, return
4024 CATEGORY_MASK_BIG5, else return 0. */
4027 detect_coding_big5 (coding
, detect_info
)
4028 struct coding_system
*coding
;
4029 struct coding_detection_info
*detect_info
;
4031 const unsigned char *src
= coding
->source
, *src_base
;
4032 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
4033 int multibytep
= coding
->src_multibyte
;
4034 int consumed_chars
= 0;
4038 detect_info
->checked
|= CATEGORY_MASK_BIG5
;
4039 /* A coding system of this category is always ASCII compatible. */
4040 src
+= coding
->head_ascii
;
4051 if (c
< 0x40 || (c
>= 0x7F && c
<= 0xA0))
4053 found
= CATEGORY_MASK_BIG5
;
4058 detect_info
->rejected
|= CATEGORY_MASK_BIG5
;
4062 if (src_base
< src
&& coding
->mode
& CODING_MODE_LAST_BLOCK
)
4064 detect_info
->rejected
|= CATEGORY_MASK_BIG5
;
4067 detect_info
->found
|= found
;
4071 /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions".
4072 If SJIS_P is 1, decode SJIS text, else decode BIG5 test. */
4075 decode_coding_sjis (coding
)
4076 struct coding_system
*coding
;
4078 const unsigned char *src
= coding
->source
+ coding
->consumed
;
4079 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
4080 const unsigned char *src_base
;
4081 int *charbuf
= coding
->charbuf
+ coding
->charbuf_used
;
4083 = coding
->charbuf
+ coding
->charbuf_size
- MAX_ANNOTATION_LENGTH
;
4084 int consumed_chars
= 0, consumed_chars_base
;
4085 int multibytep
= coding
->src_multibyte
;
4086 struct charset
*charset_roman
, *charset_kanji
, *charset_kana
;
4087 struct charset
*charset_kanji2
;
4088 Lisp_Object attrs
, charset_list
, val
;
4089 int char_offset
= coding
->produced_char
;
4090 int last_offset
= char_offset
;
4091 int last_id
= charset_ascii
;
4093 CODING_GET_INFO (coding
, attrs
, charset_list
);
4096 charset_roman
= CHARSET_FROM_ID (XINT (XCAR (val
))), val
= XCDR (val
);
4097 charset_kana
= CHARSET_FROM_ID (XINT (XCAR (val
))), val
= XCDR (val
);
4098 charset_kanji
= CHARSET_FROM_ID (XINT (XCAR (val
))), val
= XCDR (val
);
4099 charset_kanji2
= NILP (val
) ? NULL
: CHARSET_FROM_ID (XINT (XCAR (val
)));
4104 struct charset
*charset
;
4107 consumed_chars_base
= consumed_chars
;
4109 if (charbuf
>= charbuf_end
)
4116 charset
= charset_roman
;
4117 else if (c
== 0x80 || c
== 0xA0)
4119 else if (c
>= 0xA1 && c
<= 0xDF)
4121 /* SJIS -> JISX0201-Kana */
4123 charset
= charset_kana
;
4127 /* SJIS -> JISX0208 */
4129 if (c1
< 0x40 || c1
== 0x7F || c1
> 0xFC)
4133 charset
= charset_kanji
;
4135 else if (c
<= 0xFC && charset_kanji2
)
4137 /* SJIS -> JISX0213-2 */
4139 if (c1
< 0x40 || c1
== 0x7F || c1
> 0xFC)
4143 charset
= charset_kanji2
;
4147 if (charset
->id
!= charset_ascii
4148 && last_id
!= charset
->id
)
4150 if (last_id
!= charset_ascii
)
4151 ADD_CHARSET_DATA (charbuf
, char_offset
- last_offset
, last_id
);
4152 last_id
= charset
->id
;
4153 last_offset
= char_offset
;
4155 CODING_DECODE_CHAR (coding
, src
, src_base
, src_end
, charset
, c
, c
);
4162 consumed_chars
= consumed_chars_base
;
4164 *charbuf
++ = c
< 0 ? -c
: BYTE8_TO_CHAR (c
);
4170 if (last_id
!= charset_ascii
)
4171 ADD_CHARSET_DATA (charbuf
, char_offset
- last_offset
, last_id
);
4172 coding
->consumed_char
+= consumed_chars_base
;
4173 coding
->consumed
= src_base
- coding
->source
;
4174 coding
->charbuf_used
= charbuf
- coding
->charbuf
;
4178 decode_coding_big5 (coding
)
4179 struct coding_system
*coding
;
4181 const unsigned char *src
= coding
->source
+ coding
->consumed
;
4182 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
4183 const unsigned char *src_base
;
4184 int *charbuf
= coding
->charbuf
+ coding
->charbuf_used
;
4186 = coding
->charbuf
+ coding
->charbuf_size
- MAX_ANNOTATION_LENGTH
;
4187 int consumed_chars
= 0, consumed_chars_base
;
4188 int multibytep
= coding
->src_multibyte
;
4189 struct charset
*charset_roman
, *charset_big5
;
4190 Lisp_Object attrs
, charset_list
, val
;
4191 int char_offset
= coding
->produced_char
;
4192 int last_offset
= char_offset
;
4193 int last_id
= charset_ascii
;
4195 CODING_GET_INFO (coding
, attrs
, charset_list
);
4197 charset_roman
= CHARSET_FROM_ID (XINT (XCAR (val
))), val
= XCDR (val
);
4198 charset_big5
= CHARSET_FROM_ID (XINT (XCAR (val
)));
4203 struct charset
*charset
;
4206 consumed_chars_base
= consumed_chars
;
4208 if (charbuf
>= charbuf_end
)
4216 charset
= charset_roman
;
4220 if (c
< 0xA1 || c
> 0xFE)
4223 if (c1
< 0x40 || (c1
> 0x7E && c1
< 0xA1) || c1
> 0xFE)
4226 charset
= charset_big5
;
4228 if (charset
->id
!= charset_ascii
4229 && last_id
!= charset
->id
)
4231 if (last_id
!= charset_ascii
)
4232 ADD_CHARSET_DATA (charbuf
, char_offset
- last_offset
, last_id
);
4233 last_id
= charset
->id
;
4234 last_offset
= char_offset
;
4236 CODING_DECODE_CHAR (coding
, src
, src_base
, src_end
, charset
, c
, c
);
4243 consumed_chars
= consumed_chars_base
;
4245 *charbuf
++ = c
< 0 ? -c
: BYTE8_TO_CHAR (c
);
4251 if (last_id
!= charset_ascii
)
4252 ADD_CHARSET_DATA (charbuf
, char_offset
- last_offset
, last_id
);
4253 coding
->consumed_char
+= consumed_chars_base
;
4254 coding
->consumed
= src_base
- coding
->source
;
4255 coding
->charbuf_used
= charbuf
- coding
->charbuf
;
4258 /* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions".
4259 This function can encode charsets `ascii', `katakana-jisx0201',
4260 `japanese-jisx0208', `chinese-big5-1', and `chinese-big5-2'. We
4261 are sure that all these charsets are registered as official charset
4262 (i.e. do not have extended leading-codes). Characters of other
4263 charsets are produced without any encoding. If SJIS_P is 1, encode
4264 SJIS text, else encode BIG5 text. */
4267 encode_coding_sjis (coding
)
4268 struct coding_system
*coding
;
4270 int multibytep
= coding
->dst_multibyte
;
4271 int *charbuf
= coding
->charbuf
;
4272 int *charbuf_end
= charbuf
+ coding
->charbuf_used
;
4273 unsigned char *dst
= coding
->destination
+ coding
->produced
;
4274 unsigned char *dst_end
= coding
->destination
+ coding
->dst_bytes
;
4276 int produced_chars
= 0;
4277 Lisp_Object attrs
, charset_list
, val
;
4278 int ascii_compatible
;
4279 struct charset
*charset_roman
, *charset_kanji
, *charset_kana
;
4280 struct charset
*charset_kanji2
;
4283 CODING_GET_INFO (coding
, attrs
, charset_list
);
4285 charset_roman
= CHARSET_FROM_ID (XINT (XCAR (val
))), val
= XCDR (val
);
4286 charset_kana
= CHARSET_FROM_ID (XINT (XCAR (val
))), val
= XCDR (val
);
4287 charset_kanji
= CHARSET_FROM_ID (XINT (XCAR (val
))), val
= XCDR (val
);
4288 charset_kanji2
= NILP (val
) ? NULL
: CHARSET_FROM_ID (XINT (XCAR (val
)));
4290 ascii_compatible
= ! NILP (CODING_ATTR_ASCII_COMPAT (attrs
));
4292 while (charbuf
< charbuf_end
)
4294 ASSURE_DESTINATION (safe_room
);
4296 /* Now encode the character C. */
4297 if (ASCII_CHAR_P (c
) && ascii_compatible
)
4298 EMIT_ONE_ASCII_BYTE (c
);
4299 else if (CHAR_BYTE8_P (c
))
4301 c
= CHAR_TO_BYTE8 (c
);
4307 struct charset
*charset
= char_charset (c
, charset_list
, &code
);
4311 if (coding
->mode
& CODING_MODE_SAFE_ENCODING
)
4313 code
= CODING_INHIBIT_CHARACTER_SUBSTITUTION
;
4314 charset
= CHARSET_FROM_ID (charset_ascii
);
4318 c
= coding
->default_char
;
4319 charset
= char_charset (c
, charset_list
, &code
);
4322 if (code
== CHARSET_INVALID_CODE (charset
))
4324 if (charset
== charset_kanji
)
4328 c1
= code
>> 8, c2
= code
& 0xFF;
4329 EMIT_TWO_BYTES (c1
, c2
);
4331 else if (charset
== charset_kana
)
4332 EMIT_ONE_BYTE (code
| 0x80);
4333 else if (charset_kanji2
&& charset
== charset_kanji2
)
4338 if (c1
== 0x21 || (c1
>= 0x23 && c1
< 0x25)
4339 || (c1
>= 0x2C && c1
<= 0x2F) || c1
>= 0x6E)
4341 JIS_TO_SJIS2 (code
);
4342 c1
= code
>> 8, c2
= code
& 0xFF;
4343 EMIT_TWO_BYTES (c1
, c2
);
4346 EMIT_ONE_ASCII_BYTE (code
& 0x7F);
4349 EMIT_ONE_ASCII_BYTE (code
& 0x7F);
4352 record_conversion_result (coding
, CODING_RESULT_SUCCESS
);
4353 coding
->produced_char
+= produced_chars
;
4354 coding
->produced
= dst
- coding
->destination
;
4359 encode_coding_big5 (coding
)
4360 struct coding_system
*coding
;
4362 int multibytep
= coding
->dst_multibyte
;
4363 int *charbuf
= coding
->charbuf
;
4364 int *charbuf_end
= charbuf
+ coding
->charbuf_used
;
4365 unsigned char *dst
= coding
->destination
+ coding
->produced
;
4366 unsigned char *dst_end
= coding
->destination
+ coding
->dst_bytes
;
4368 int produced_chars
= 0;
4369 Lisp_Object attrs
, charset_list
, val
;
4370 int ascii_compatible
;
4371 struct charset
*charset_roman
, *charset_big5
;
4374 CODING_GET_INFO (coding
, attrs
, charset_list
);
4376 charset_roman
= CHARSET_FROM_ID (XINT (XCAR (val
))), val
= XCDR (val
);
4377 charset_big5
= CHARSET_FROM_ID (XINT (XCAR (val
)));
4378 ascii_compatible
= ! NILP (CODING_ATTR_ASCII_COMPAT (attrs
));
4380 while (charbuf
< charbuf_end
)
4382 ASSURE_DESTINATION (safe_room
);
4384 /* Now encode the character C. */
4385 if (ASCII_CHAR_P (c
) && ascii_compatible
)
4386 EMIT_ONE_ASCII_BYTE (c
);
4387 else if (CHAR_BYTE8_P (c
))
4389 c
= CHAR_TO_BYTE8 (c
);
4395 struct charset
*charset
= char_charset (c
, charset_list
, &code
);
4399 if (coding
->mode
& CODING_MODE_SAFE_ENCODING
)
4401 code
= CODING_INHIBIT_CHARACTER_SUBSTITUTION
;
4402 charset
= CHARSET_FROM_ID (charset_ascii
);
4406 c
= coding
->default_char
;
4407 charset
= char_charset (c
, charset_list
, &code
);
4410 if (code
== CHARSET_INVALID_CODE (charset
))
4412 if (charset
== charset_big5
)
4416 c1
= code
>> 8, c2
= code
& 0xFF;
4417 EMIT_TWO_BYTES (c1
, c2
);
4420 EMIT_ONE_ASCII_BYTE (code
& 0x7F);
4423 record_conversion_result (coding
, CODING_RESULT_SUCCESS
);
4424 coding
->produced_char
+= produced_chars
;
4425 coding
->produced
= dst
- coding
->destination
;
4430 /*** 10. CCL handlers ***/
4432 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
4433 Check if a text is encoded in a coding system of which
4434 encoder/decoder are written in CCL program. If it is, return
4435 CATEGORY_MASK_CCL, else return 0. */
4438 detect_coding_ccl (coding
, detect_info
)
4439 struct coding_system
*coding
;
4440 struct coding_detection_info
*detect_info
;
4442 const unsigned char *src
= coding
->source
, *src_base
;
4443 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
4444 int multibytep
= coding
->src_multibyte
;
4445 int consumed_chars
= 0;
4447 unsigned char *valids
;
4448 int head_ascii
= coding
->head_ascii
;
4451 detect_info
->checked
|= CATEGORY_MASK_CCL
;
4453 coding
= &coding_categories
[coding_category_ccl
];
4454 valids
= CODING_CCL_VALIDS (coding
);
4455 attrs
= CODING_ID_ATTRS (coding
->id
);
4456 if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs
)))
4465 if (c
< 0 || ! valids
[c
])
4467 if ((valids
[c
] > 1))
4468 found
= CATEGORY_MASK_CCL
;
4470 detect_info
->rejected
|= CATEGORY_MASK_CCL
;
4474 detect_info
->found
|= found
;
4479 decode_coding_ccl (coding
)
4480 struct coding_system
*coding
;
4482 const unsigned char *src
= coding
->source
+ coding
->consumed
;
4483 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
4484 int *charbuf
= coding
->charbuf
+ coding
->charbuf_used
;
4485 int *charbuf_end
= coding
->charbuf
+ coding
->charbuf_size
;
4486 int consumed_chars
= 0;
4487 int multibytep
= coding
->src_multibyte
;
4488 struct ccl_program ccl
;
4489 int source_charbuf
[1024];
4490 int source_byteidx
[1024];
4491 Lisp_Object attrs
, charset_list
;
4493 CODING_GET_INFO (coding
, attrs
, charset_list
);
4494 setup_ccl_program (&ccl
, CODING_CCL_DECODER (coding
));
4496 while (src
< src_end
)
4498 const unsigned char *p
= src
;
4499 int *source
, *source_end
;
4503 while (i
< 1024 && p
< src_end
)
4505 source_byteidx
[i
] = p
- src
;
4506 source_charbuf
[i
++] = STRING_CHAR_ADVANCE (p
);
4509 while (i
< 1024 && p
< src_end
)
4510 source_charbuf
[i
++] = *p
++;
4512 if (p
== src_end
&& coding
->mode
& CODING_MODE_LAST_BLOCK
)
4515 source
= source_charbuf
;
4516 source_end
= source
+ i
;
4517 while (source
< source_end
)
4519 ccl_driver (&ccl
, source
, charbuf
,
4520 source_end
- source
, charbuf_end
- charbuf
,
4522 source
+= ccl
.consumed
;
4523 charbuf
+= ccl
.produced
;
4524 if (ccl
.status
!= CCL_STAT_SUSPEND_BY_DST
)
4527 if (source
< source_end
)
4528 src
+= source_byteidx
[source
- source_charbuf
];
4531 consumed_chars
+= source
- source_charbuf
;
4533 if (ccl
.status
!= CCL_STAT_SUSPEND_BY_SRC
4534 && ccl
.status
!= CODING_RESULT_INSUFFICIENT_SRC
)
4540 case CCL_STAT_SUSPEND_BY_SRC
:
4541 record_conversion_result (coding
, CODING_RESULT_INSUFFICIENT_SRC
);
4543 case CCL_STAT_SUSPEND_BY_DST
:
4546 case CCL_STAT_INVALID_CMD
:
4547 record_conversion_result (coding
, CODING_RESULT_INTERRUPT
);
4550 record_conversion_result (coding
, CODING_RESULT_SUCCESS
);
4553 coding
->consumed_char
+= consumed_chars
;
4554 coding
->consumed
= src
- coding
->source
;
4555 coding
->charbuf_used
= charbuf
- coding
->charbuf
;
4559 encode_coding_ccl (coding
)
4560 struct coding_system
*coding
;
4562 struct ccl_program ccl
;
4563 int multibytep
= coding
->dst_multibyte
;
4564 int *charbuf
= coding
->charbuf
;
4565 int *charbuf_end
= charbuf
+ coding
->charbuf_used
;
4566 unsigned char *dst
= coding
->destination
+ coding
->produced
;
4567 unsigned char *dst_end
= coding
->destination
+ coding
->dst_bytes
;
4568 int destination_charbuf
[1024];
4569 int i
, produced_chars
= 0;
4570 Lisp_Object attrs
, charset_list
;
4572 CODING_GET_INFO (coding
, attrs
, charset_list
);
4573 setup_ccl_program (&ccl
, CODING_CCL_ENCODER (coding
));
4575 ccl
.last_block
= coding
->mode
& CODING_MODE_LAST_BLOCK
;
4576 ccl
.dst_multibyte
= coding
->dst_multibyte
;
4578 while (charbuf
< charbuf_end
)
4580 ccl_driver (&ccl
, charbuf
, destination_charbuf
,
4581 charbuf_end
- charbuf
, 1024, charset_list
);
4584 ASSURE_DESTINATION (ccl
.produced
* 2);
4585 for (i
= 0; i
< ccl
.produced
; i
++)
4586 EMIT_ONE_BYTE (destination_charbuf
[i
] & 0xFF);
4590 ASSURE_DESTINATION (ccl
.produced
);
4591 for (i
= 0; i
< ccl
.produced
; i
++)
4592 *dst
++ = destination_charbuf
[i
] & 0xFF;
4593 produced_chars
+= ccl
.produced
;
4595 charbuf
+= ccl
.consumed
;
4596 if (ccl
.status
== CCL_STAT_QUIT
4597 || ccl
.status
== CCL_STAT_INVALID_CMD
)
4603 case CCL_STAT_SUSPEND_BY_SRC
:
4604 record_conversion_result (coding
, CODING_RESULT_INSUFFICIENT_SRC
);
4606 case CCL_STAT_SUSPEND_BY_DST
:
4607 record_conversion_result (coding
, CODING_RESULT_INSUFFICIENT_DST
);
4610 case CCL_STAT_INVALID_CMD
:
4611 record_conversion_result (coding
, CODING_RESULT_INTERRUPT
);
4614 record_conversion_result (coding
, CODING_RESULT_SUCCESS
);
4618 coding
->produced_char
+= produced_chars
;
4619 coding
->produced
= dst
- coding
->destination
;
4625 /*** 10, 11. no-conversion handlers ***/
4627 /* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
4630 decode_coding_raw_text (coding
)
4631 struct coding_system
*coding
;
4633 coding
->chars_at_source
= 1;
4634 coding
->consumed_char
= 0;
4635 coding
->consumed
= 0;
4636 record_conversion_result (coding
, CODING_RESULT_SUCCESS
);
4640 encode_coding_raw_text (coding
)
4641 struct coding_system
*coding
;
4643 int multibytep
= coding
->dst_multibyte
;
4644 int *charbuf
= coding
->charbuf
;
4645 int *charbuf_end
= coding
->charbuf
+ coding
->charbuf_used
;
4646 unsigned char *dst
= coding
->destination
+ coding
->produced
;
4647 unsigned char *dst_end
= coding
->destination
+ coding
->dst_bytes
;
4648 int produced_chars
= 0;
4653 int safe_room
= MAX_MULTIBYTE_LENGTH
* 2;
4655 if (coding
->src_multibyte
)
4656 while (charbuf
< charbuf_end
)
4658 ASSURE_DESTINATION (safe_room
);
4660 if (ASCII_CHAR_P (c
))
4661 EMIT_ONE_ASCII_BYTE (c
);
4662 else if (CHAR_BYTE8_P (c
))
4664 c
= CHAR_TO_BYTE8 (c
);
4669 unsigned char str
[MAX_MULTIBYTE_LENGTH
], *p0
= str
, *p1
= str
;
4671 CHAR_STRING_ADVANCE (c
, p1
);
4674 EMIT_ONE_BYTE (*p0
);
4680 while (charbuf
< charbuf_end
)
4682 ASSURE_DESTINATION (safe_room
);
4689 if (coding
->src_multibyte
)
4691 int safe_room
= MAX_MULTIBYTE_LENGTH
;
4693 while (charbuf
< charbuf_end
)
4695 ASSURE_DESTINATION (safe_room
);
4697 if (ASCII_CHAR_P (c
))
4699 else if (CHAR_BYTE8_P (c
))
4700 *dst
++ = CHAR_TO_BYTE8 (c
);
4702 CHAR_STRING_ADVANCE (c
, dst
);
4708 ASSURE_DESTINATION (charbuf_end
- charbuf
);
4709 while (charbuf
< charbuf_end
&& dst
< dst_end
)
4710 *dst
++ = *charbuf
++;
4711 produced_chars
= dst
- (coding
->destination
+ coding
->dst_bytes
);
4714 record_conversion_result (coding
, CODING_RESULT_SUCCESS
);
4715 coding
->produced_char
+= produced_chars
;
4716 coding
->produced
= dst
- coding
->destination
;
4720 /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
4721 Check if a text is encoded in a charset-based coding system. If it
4722 is, return 1, else return 0. */
4725 detect_coding_charset (coding
, detect_info
)
4726 struct coding_system
*coding
;
4727 struct coding_detection_info
*detect_info
;
4729 const unsigned char *src
= coding
->source
, *src_base
;
4730 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
4731 int multibytep
= coding
->src_multibyte
;
4732 int consumed_chars
= 0;
4733 Lisp_Object attrs
, valids
;
4735 int head_ascii
= coding
->head_ascii
;
4737 detect_info
->checked
|= CATEGORY_MASK_CHARSET
;
4739 coding
= &coding_categories
[coding_category_charset
];
4740 attrs
= CODING_ID_ATTRS (coding
->id
);
4741 valids
= AREF (attrs
, coding_attr_charset_valids
);
4743 if (! NILP (CODING_ATTR_ASCII_COMPAT (attrs
)))
4750 struct charset
*charset
;
4757 val
= AREF (valids
, c
);
4761 found
= CATEGORY_MASK_CHARSET
;
4764 charset
= CHARSET_FROM_ID (XFASTINT (val
));
4765 dim
= CHARSET_DIMENSION (charset
);
4766 for (idx
= 1; idx
< dim
; idx
++)
4771 if (c
< charset
->code_space
[(dim
- 1 - idx
) * 2]
4772 || c
> charset
->code_space
[(dim
- 1 - idx
) * 2 + 1])
4781 for (; CONSP (val
); val
= XCDR (val
))
4783 charset
= CHARSET_FROM_ID (XFASTINT (XCAR (val
)));
4784 dim
= CHARSET_DIMENSION (charset
);
4790 if (c
< charset
->code_space
[(dim
- 1 - idx
) * 4]
4791 || c
> charset
->code_space
[(dim
- 1 - idx
) * 4 + 1])
4806 detect_info
->rejected
|= CATEGORY_MASK_CHARSET
;
4810 detect_info
->found
|= found
;
4815 decode_coding_charset (coding
)
4816 struct coding_system
*coding
;
4818 const unsigned char *src
= coding
->source
+ coding
->consumed
;
4819 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
4820 const unsigned char *src_base
;
4821 int *charbuf
= coding
->charbuf
+ coding
->charbuf_used
;
4823 = coding
->charbuf
+ coding
->charbuf_size
- MAX_ANNOTATION_LENGTH
;
4824 int consumed_chars
= 0, consumed_chars_base
;
4825 int multibytep
= coding
->src_multibyte
;
4826 Lisp_Object attrs
, charset_list
, valids
;
4827 int char_offset
= coding
->produced_char
;
4828 int last_offset
= char_offset
;
4829 int last_id
= charset_ascii
;
4831 CODING_GET_INFO (coding
, attrs
, charset_list
);
4832 valids
= AREF (attrs
, coding_attr_charset_valids
);
4838 struct charset
*charset
;
4844 consumed_chars_base
= consumed_chars
;
4846 if (charbuf
>= charbuf_end
)
4854 val
= AREF (valids
, c
);
4859 charset
= CHARSET_FROM_ID (XFASTINT (val
));
4860 dim
= CHARSET_DIMENSION (charset
);
4864 code
= (code
<< 8) | c
;
4867 CODING_DECODE_CHAR (coding
, src
, src_base
, src_end
,
4872 /* VAL is a list of charset IDs. It is assured that the
4873 list is sorted by charset dimensions (smaller one
4877 charset
= CHARSET_FROM_ID (XFASTINT (XCAR (val
)));
4878 dim
= CHARSET_DIMENSION (charset
);
4882 code
= (code
<< 8) | c
;
4885 CODING_DECODE_CHAR (coding
, src
, src_base
,
4886 src_end
, charset
, code
, c
);
4894 if (charset
->id
!= charset_ascii
4895 && last_id
!= charset
->id
)
4897 if (last_id
!= charset_ascii
)
4898 ADD_CHARSET_DATA (charbuf
, char_offset
- last_offset
, last_id
);
4899 last_id
= charset
->id
;
4900 last_offset
= char_offset
;
4909 consumed_chars
= consumed_chars_base
;
4911 *charbuf
++ = c
< 0 ? -c
: ASCII_BYTE_P (c
) ? c
: BYTE8_TO_CHAR (c
);
4917 if (last_id
!= charset_ascii
)
4918 ADD_CHARSET_DATA (charbuf
, char_offset
- last_offset
, last_id
);
4919 coding
->consumed_char
+= consumed_chars_base
;
4920 coding
->consumed
= src_base
- coding
->source
;
4921 coding
->charbuf_used
= charbuf
- coding
->charbuf
;
4925 encode_coding_charset (coding
)
4926 struct coding_system
*coding
;
4928 int multibytep
= coding
->dst_multibyte
;
4929 int *charbuf
= coding
->charbuf
;
4930 int *charbuf_end
= charbuf
+ coding
->charbuf_used
;
4931 unsigned char *dst
= coding
->destination
+ coding
->produced
;
4932 unsigned char *dst_end
= coding
->destination
+ coding
->dst_bytes
;
4933 int safe_room
= MAX_MULTIBYTE_LENGTH
;
4934 int produced_chars
= 0;
4935 Lisp_Object attrs
, charset_list
;
4936 int ascii_compatible
;
4939 CODING_GET_INFO (coding
, attrs
, charset_list
);
4940 ascii_compatible
= ! NILP (CODING_ATTR_ASCII_COMPAT (attrs
));
4942 while (charbuf
< charbuf_end
)
4944 struct charset
*charset
;
4947 ASSURE_DESTINATION (safe_room
);
4949 if (ascii_compatible
&& ASCII_CHAR_P (c
))
4950 EMIT_ONE_ASCII_BYTE (c
);
4951 else if (CHAR_BYTE8_P (c
))
4953 c
= CHAR_TO_BYTE8 (c
);
4958 charset
= char_charset (c
, charset_list
, &code
);
4961 if (CHARSET_DIMENSION (charset
) == 1)
4962 EMIT_ONE_BYTE (code
);
4963 else if (CHARSET_DIMENSION (charset
) == 2)
4964 EMIT_TWO_BYTES (code
>> 8, code
& 0xFF);
4965 else if (CHARSET_DIMENSION (charset
) == 3)
4966 EMIT_THREE_BYTES (code
>> 16, (code
>> 8) & 0xFF, code
& 0xFF);
4968 EMIT_FOUR_BYTES (code
>> 24, (code
>> 16) & 0xFF,
4969 (code
>> 8) & 0xFF, code
& 0xFF);
4973 if (coding
->mode
& CODING_MODE_SAFE_ENCODING
)
4974 c
= CODING_INHIBIT_CHARACTER_SUBSTITUTION
;
4976 c
= coding
->default_char
;
4982 record_conversion_result (coding
, CODING_RESULT_SUCCESS
);
4983 coding
->produced_char
+= produced_chars
;
4984 coding
->produced
= dst
- coding
->destination
;
4989 /*** 7. C library functions ***/
4991 /* Setup coding context CODING from information about CODING_SYSTEM.
4992 If CODING_SYSTEM is nil, `no-conversion' is assumed. If
4993 CODING_SYSTEM is invalid, signal an error. */
4996 setup_coding_system (coding_system
, coding
)
4997 Lisp_Object coding_system
;
4998 struct coding_system
*coding
;
5001 Lisp_Object eol_type
;
5002 Lisp_Object coding_type
;
5005 if (NILP (coding_system
))
5006 coding_system
= Qundecided
;
5008 CHECK_CODING_SYSTEM_GET_ID (coding_system
, coding
->id
);
5010 attrs
= CODING_ID_ATTRS (coding
->id
);
5011 eol_type
= CODING_ID_EOL_TYPE (coding
->id
);
5014 coding
->head_ascii
= -1;
5015 if (VECTORP (eol_type
))
5016 coding
->common_flags
= (CODING_REQUIRE_DECODING_MASK
5017 | CODING_REQUIRE_DETECTION_MASK
);
5018 else if (! EQ (eol_type
, Qunix
))
5019 coding
->common_flags
= (CODING_REQUIRE_DECODING_MASK
5020 | CODING_REQUIRE_ENCODING_MASK
);
5022 coding
->common_flags
= 0;
5023 if (! NILP (CODING_ATTR_POST_READ (attrs
)))
5024 coding
->common_flags
|= CODING_REQUIRE_DECODING_MASK
;
5025 if (! NILP (CODING_ATTR_PRE_WRITE (attrs
)))
5026 coding
->common_flags
|= CODING_REQUIRE_ENCODING_MASK
;
5027 if (! NILP (CODING_ATTR_FOR_UNIBYTE (attrs
)))
5028 coding
->common_flags
|= CODING_FOR_UNIBYTE_MASK
;
5030 val
= CODING_ATTR_SAFE_CHARSETS (attrs
);
5031 coding
->max_charset_id
= SCHARS (val
) - 1;
5032 coding
->safe_charsets
= (char *) SDATA (val
);
5033 coding
->default_char
= XINT (CODING_ATTR_DEFAULT_CHAR (attrs
));
5035 coding_type
= CODING_ATTR_TYPE (attrs
);
5036 if (EQ (coding_type
, Qundecided
))
5038 coding
->detector
= NULL
;
5039 coding
->decoder
= decode_coding_raw_text
;
5040 coding
->encoder
= encode_coding_raw_text
;
5041 coding
->common_flags
|= CODING_REQUIRE_DETECTION_MASK
;
5043 else if (EQ (coding_type
, Qiso_2022
))
5046 int flags
= XINT (AREF (attrs
, coding_attr_iso_flags
));
5048 /* Invoke graphic register 0 to plane 0. */
5049 CODING_ISO_INVOCATION (coding
, 0) = 0;
5050 /* Invoke graphic register 1 to plane 1 if we can use 8-bit. */
5051 CODING_ISO_INVOCATION (coding
, 1)
5052 = (flags
& CODING_ISO_FLAG_SEVEN_BITS
? -1 : 1);
5053 /* Setup the initial status of designation. */
5054 for (i
= 0; i
< 4; i
++)
5055 CODING_ISO_DESIGNATION (coding
, i
) = CODING_ISO_INITIAL (coding
, i
);
5056 /* Not single shifting initially. */
5057 CODING_ISO_SINGLE_SHIFTING (coding
) = 0;
5058 /* Beginning of buffer should also be regarded as bol. */
5059 CODING_ISO_BOL (coding
) = 1;
5060 coding
->detector
= detect_coding_iso_2022
;
5061 coding
->decoder
= decode_coding_iso_2022
;
5062 coding
->encoder
= encode_coding_iso_2022
;
5063 if (flags
& CODING_ISO_FLAG_SAFE
)
5064 coding
->mode
|= CODING_MODE_SAFE_ENCODING
;
5065 coding
->common_flags
5066 |= (CODING_REQUIRE_DECODING_MASK
| CODING_REQUIRE_ENCODING_MASK
5067 | CODING_REQUIRE_FLUSHING_MASK
);
5068 if (flags
& CODING_ISO_FLAG_COMPOSITION
)
5069 coding
->common_flags
|= CODING_ANNOTATE_COMPOSITION_MASK
;
5070 if (flags
& CODING_ISO_FLAG_DESIGNATION
)
5071 coding
->common_flags
|= CODING_ANNOTATE_CHARSET_MASK
;
5072 if (flags
& CODING_ISO_FLAG_FULL_SUPPORT
)
5074 setup_iso_safe_charsets (attrs
);
5075 val
= CODING_ATTR_SAFE_CHARSETS (attrs
);
5076 coding
->max_charset_id
= SCHARS (val
) - 1;
5077 coding
->safe_charsets
= (char *) SDATA (val
);
5079 CODING_ISO_FLAGS (coding
) = flags
;
5081 else if (EQ (coding_type
, Qcharset
))
5083 coding
->detector
= detect_coding_charset
;
5084 coding
->decoder
= decode_coding_charset
;
5085 coding
->encoder
= encode_coding_charset
;
5086 coding
->common_flags
5087 |= (CODING_REQUIRE_DECODING_MASK
| CODING_REQUIRE_ENCODING_MASK
);
5089 else if (EQ (coding_type
, Qutf_8
))
5091 coding
->detector
= detect_coding_utf_8
;
5092 coding
->decoder
= decode_coding_utf_8
;
5093 coding
->encoder
= encode_coding_utf_8
;
5094 coding
->common_flags
5095 |= (CODING_REQUIRE_DECODING_MASK
| CODING_REQUIRE_ENCODING_MASK
);
5097 else if (EQ (coding_type
, Qutf_16
))
5099 val
= AREF (attrs
, coding_attr_utf_16_bom
);
5100 CODING_UTF_16_BOM (coding
) = (CONSP (val
) ? utf_16_detect_bom
5101 : EQ (val
, Qt
) ? utf_16_with_bom
5102 : utf_16_without_bom
);
5103 val
= AREF (attrs
, coding_attr_utf_16_endian
);
5104 CODING_UTF_16_ENDIAN (coding
) = (EQ (val
, Qbig
) ? utf_16_big_endian
5105 : utf_16_little_endian
);
5106 CODING_UTF_16_SURROGATE (coding
) = 0;
5107 coding
->detector
= detect_coding_utf_16
;
5108 coding
->decoder
= decode_coding_utf_16
;
5109 coding
->encoder
= encode_coding_utf_16
;
5110 coding
->common_flags
5111 |= (CODING_REQUIRE_DECODING_MASK
| CODING_REQUIRE_ENCODING_MASK
);
5112 if (CODING_UTF_16_BOM (coding
) == utf_16_detect_bom
)
5113 coding
->common_flags
|= CODING_REQUIRE_DETECTION_MASK
;
5115 else if (EQ (coding_type
, Qccl
))
5117 coding
->detector
= detect_coding_ccl
;
5118 coding
->decoder
= decode_coding_ccl
;
5119 coding
->encoder
= encode_coding_ccl
;
5120 coding
->common_flags
5121 |= (CODING_REQUIRE_DECODING_MASK
| CODING_REQUIRE_ENCODING_MASK
5122 | CODING_REQUIRE_FLUSHING_MASK
);
5124 else if (EQ (coding_type
, Qemacs_mule
))
5126 coding
->detector
= detect_coding_emacs_mule
;
5127 coding
->decoder
= decode_coding_emacs_mule
;
5128 coding
->encoder
= encode_coding_emacs_mule
;
5129 coding
->common_flags
5130 |= (CODING_REQUIRE_DECODING_MASK
| CODING_REQUIRE_ENCODING_MASK
);
5131 if (! NILP (AREF (attrs
, coding_attr_emacs_mule_full
))
5132 && ! EQ (CODING_ATTR_CHARSET_LIST (attrs
), Vemacs_mule_charset_list
))
5134 Lisp_Object tail
, safe_charsets
;
5135 int max_charset_id
= 0;
5137 for (tail
= Vemacs_mule_charset_list
; CONSP (tail
);
5139 if (max_charset_id
< XFASTINT (XCAR (tail
)))
5140 max_charset_id
= XFASTINT (XCAR (tail
));
5141 safe_charsets
= Fmake_string (make_number (max_charset_id
+ 1),
5143 for (tail
= Vemacs_mule_charset_list
; CONSP (tail
);
5145 SSET (safe_charsets
, XFASTINT (XCAR (tail
)), 0);
5146 coding
->max_charset_id
= max_charset_id
;
5147 coding
->safe_charsets
= (char *) SDATA (safe_charsets
);
5150 else if (EQ (coding_type
, Qshift_jis
))
5152 coding
->detector
= detect_coding_sjis
;
5153 coding
->decoder
= decode_coding_sjis
;
5154 coding
->encoder
= encode_coding_sjis
;
5155 coding
->common_flags
5156 |= (CODING_REQUIRE_DECODING_MASK
| CODING_REQUIRE_ENCODING_MASK
);
5158 else if (EQ (coding_type
, Qbig5
))
5160 coding
->detector
= detect_coding_big5
;
5161 coding
->decoder
= decode_coding_big5
;
5162 coding
->encoder
= encode_coding_big5
;
5163 coding
->common_flags
5164 |= (CODING_REQUIRE_DECODING_MASK
| CODING_REQUIRE_ENCODING_MASK
);
5166 else /* EQ (coding_type, Qraw_text) */
5168 coding
->detector
= NULL
;
5169 coding
->decoder
= decode_coding_raw_text
;
5170 coding
->encoder
= encode_coding_raw_text
;
5171 if (! EQ (eol_type
, Qunix
))
5173 coding
->common_flags
|= CODING_REQUIRE_DECODING_MASK
;
5174 if (! VECTORP (eol_type
))
5175 coding
->common_flags
|= CODING_REQUIRE_ENCODING_MASK
;
5183 /* Return a list of charsets supported by CODING. */
5186 coding_charset_list (coding
)
5187 struct coding_system
*coding
;
5189 Lisp_Object attrs
, charset_list
;
5191 CODING_GET_INFO (coding
, attrs
, charset_list
);
5192 if (EQ (CODING_ATTR_TYPE (attrs
), Qiso_2022
))
5194 int flags
= XINT (AREF (attrs
, coding_attr_iso_flags
));
5196 if (flags
& CODING_ISO_FLAG_FULL_SUPPORT
)
5197 charset_list
= Viso_2022_charset_list
;
5199 else if (EQ (CODING_ATTR_TYPE (attrs
), Qemacs_mule
))
5201 charset_list
= Vemacs_mule_charset_list
;
5203 return charset_list
;
5207 /* Return raw-text or one of its subsidiaries that has the same
5208 eol_type as CODING-SYSTEM. */
5211 raw_text_coding_system (coding_system
)
5212 Lisp_Object coding_system
;
5214 Lisp_Object spec
, attrs
;
5215 Lisp_Object eol_type
, raw_text_eol_type
;
5217 if (NILP (coding_system
))
5219 spec
= CODING_SYSTEM_SPEC (coding_system
);
5220 attrs
= AREF (spec
, 0);
5222 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
5223 return coding_system
;
5225 eol_type
= AREF (spec
, 2);
5226 if (VECTORP (eol_type
))
5228 spec
= CODING_SYSTEM_SPEC (Qraw_text
);
5229 raw_text_eol_type
= AREF (spec
, 2);
5230 return (EQ (eol_type
, Qunix
) ? AREF (raw_text_eol_type
, 0)
5231 : EQ (eol_type
, Qdos
) ? AREF (raw_text_eol_type
, 1)
5232 : AREF (raw_text_eol_type
, 2));
5236 /* If CODING_SYSTEM doesn't specify end-of-line format but PARENT
5237 does, return one of the subsidiary that has the same eol-spec as
5238 PARENT. Otherwise, return CODING_SYSTEM. If PARENT is nil,
5239 inherit end-of-line format from the system's setting
5240 (system_eol_type). */
5243 coding_inherit_eol_type (coding_system
, parent
)
5244 Lisp_Object coding_system
, parent
;
5246 Lisp_Object spec
, eol_type
;
5248 if (NILP (coding_system
))
5249 coding_system
= Qraw_text
;
5250 spec
= CODING_SYSTEM_SPEC (coding_system
);
5251 eol_type
= AREF (spec
, 2);
5252 if (VECTORP (eol_type
))
5254 Lisp_Object parent_eol_type
;
5256 if (! NILP (parent
))
5258 Lisp_Object parent_spec
;
5260 parent_spec
= CODING_SYSTEM_SPEC (parent
);
5261 parent_eol_type
= AREF (parent_spec
, 2);
5264 parent_eol_type
= system_eol_type
;
5265 if (EQ (parent_eol_type
, Qunix
))
5266 coding_system
= AREF (eol_type
, 0);
5267 else if (EQ (parent_eol_type
, Qdos
))
5268 coding_system
= AREF (eol_type
, 1);
5269 else if (EQ (parent_eol_type
, Qmac
))
5270 coding_system
= AREF (eol_type
, 2);
5272 return coding_system
;
5275 /* Emacs has a mechanism to automatically detect a coding system if it
5276 is one of Emacs' internal format, ISO2022, SJIS, and BIG5. But,
5277 it's impossible to distinguish some coding systems accurately
5278 because they use the same range of codes. So, at first, coding
5279 systems are categorized into 7, those are:
5281 o coding-category-emacs-mule
5283 The category for a coding system which has the same code range
5284 as Emacs' internal format. Assigned the coding-system (Lisp
5285 symbol) `emacs-mule' by default.
5287 o coding-category-sjis
5289 The category for a coding system which has the same code range
5290 as SJIS. Assigned the coding-system (Lisp
5291 symbol) `japanese-shift-jis' by default.
5293 o coding-category-iso-7
5295 The category for a coding system which has the same code range
5296 as ISO2022 of 7-bit environment. This doesn't use any locking
5297 shift and single shift functions. This can encode/decode all
5298 charsets. Assigned the coding-system (Lisp symbol)
5299 `iso-2022-7bit' by default.
5301 o coding-category-iso-7-tight
5303 Same as coding-category-iso-7 except that this can
5304 encode/decode only the specified charsets.
5306 o coding-category-iso-8-1
5308 The category for a coding system which has the same code range
5309 as ISO2022 of 8-bit environment and graphic plane 1 used only
5310 for DIMENSION1 charset. This doesn't use any locking shift
5311 and single shift functions. Assigned the coding-system (Lisp
5312 symbol) `iso-latin-1' by default.
5314 o coding-category-iso-8-2
5316 The category for a coding system which has the same code range
5317 as ISO2022 of 8-bit environment and graphic plane 1 used only
5318 for DIMENSION2 charset. This doesn't use any locking shift
5319 and single shift functions. Assigned the coding-system (Lisp
5320 symbol) `japanese-iso-8bit' by default.
5322 o coding-category-iso-7-else
5324 The category for a coding system which has the same code range
5325 as ISO2022 of 7-bit environemnt but uses locking shift or
5326 single shift functions. Assigned the coding-system (Lisp
5327 symbol) `iso-2022-7bit-lock' by default.
5329 o coding-category-iso-8-else
5331 The category for a coding system which has the same code range
5332 as ISO2022 of 8-bit environemnt but uses locking shift or
5333 single shift functions. Assigned the coding-system (Lisp
5334 symbol) `iso-2022-8bit-ss2' by default.
5336 o coding-category-big5
5338 The category for a coding system which has the same code range
5339 as BIG5. Assigned the coding-system (Lisp symbol)
5340 `cn-big5' by default.
5342 o coding-category-utf-8
5344 The category for a coding system which has the same code range
5345 as UTF-8 (cf. RFC3629). Assigned the coding-system (Lisp
5346 symbol) `utf-8' by default.
5348 o coding-category-utf-16-be
5350 The category for a coding system in which a text has an
5351 Unicode signature (cf. Unicode Standard) in the order of BIG
5352 endian at the head. Assigned the coding-system (Lisp symbol)
5353 `utf-16-be' by default.
5355 o coding-category-utf-16-le
5357 The category for a coding system in which a text has an
5358 Unicode signature (cf. Unicode Standard) in the order of
5359 LITTLE endian at the head. Assigned the coding-system (Lisp
5360 symbol) `utf-16-le' by default.
5362 o coding-category-ccl
5364 The category for a coding system of which encoder/decoder is
5365 written in CCL programs. The default value is nil, i.e., no
5366 coding system is assigned.
5368 o coding-category-binary
5370 The category for a coding system not categorized in any of the
5371 above. Assigned the coding-system (Lisp symbol)
5372 `no-conversion' by default.
5374 Each of them is a Lisp symbol and the value is an actual
5375 `coding-system's (this is also a Lisp symbol) assigned by a user.
5376 What Emacs does actually is to detect a category of coding system.
5377 Then, it uses a `coding-system' assigned to it. If Emacs can't
5378 decide only one possible category, it selects a category of the
5379 highest priority. Priorities of categories are also specified by a
5380 user in a Lisp variable `coding-category-list'.
5384 #define EOL_SEEN_NONE 0
5385 #define EOL_SEEN_LF 1
5386 #define EOL_SEEN_CR 2
5387 #define EOL_SEEN_CRLF 4
5389 /* Detect how end-of-line of a text of length SRC_BYTES pointed by
5390 SOURCE is encoded. If CATEGORY is one of
5391 coding_category_utf_16_XXXX, assume that CR and LF are encoded by
5392 two-byte, else they are encoded by one-byte.
5394 Return one of EOL_SEEN_XXX. */
5396 #define MAX_EOL_CHECK_COUNT 3
5399 detect_eol (source
, src_bytes
, category
)
5400 const unsigned char *source
;
5401 EMACS_INT src_bytes
;
5402 enum coding_category category
;
5404 const unsigned char *src
= source
, *src_end
= src
+ src_bytes
;
5407 int eol_seen
= EOL_SEEN_NONE
;
5409 if ((1 << category
) & CATEGORY_MASK_UTF_16
)
5413 msb
= category
== (coding_category_utf_16_le
5414 | coding_category_utf_16_le_nosig
);
5417 while (src
+ 1 < src_end
)
5420 if (src
[msb
] == 0 && (c
== '\n' || c
== '\r'))
5425 this_eol
= EOL_SEEN_LF
;
5426 else if (src
+ 3 >= src_end
5427 || src
[msb
+ 2] != 0
5428 || src
[lsb
+ 2] != '\n')
5429 this_eol
= EOL_SEEN_CR
;
5431 this_eol
= EOL_SEEN_CRLF
;
5433 if (eol_seen
== EOL_SEEN_NONE
)
5434 /* This is the first end-of-line. */
5435 eol_seen
= this_eol
;
5436 else if (eol_seen
!= this_eol
)
5438 /* The found type is different from what found before. */
5439 eol_seen
= EOL_SEEN_LF
;
5442 if (++total
== MAX_EOL_CHECK_COUNT
)
5450 while (src
< src_end
)
5453 if (c
== '\n' || c
== '\r')
5458 this_eol
= EOL_SEEN_LF
;
5459 else if (src
>= src_end
|| *src
!= '\n')
5460 this_eol
= EOL_SEEN_CR
;
5462 this_eol
= EOL_SEEN_CRLF
, src
++;
5464 if (eol_seen
== EOL_SEEN_NONE
)
5465 /* This is the first end-of-line. */
5466 eol_seen
= this_eol
;
5467 else if (eol_seen
!= this_eol
)
5469 /* The found type is different from what found before. */
5470 eol_seen
= EOL_SEEN_LF
;
5473 if (++total
== MAX_EOL_CHECK_COUNT
)
5483 adjust_coding_eol_type (coding
, eol_seen
)
5484 struct coding_system
*coding
;
5487 Lisp_Object eol_type
;
5489 eol_type
= CODING_ID_EOL_TYPE (coding
->id
);
5490 if (eol_seen
& EOL_SEEN_LF
)
5492 coding
->id
= CODING_SYSTEM_ID (AREF (eol_type
, 0));
5495 else if (eol_seen
& EOL_SEEN_CRLF
)
5497 coding
->id
= CODING_SYSTEM_ID (AREF (eol_type
, 1));
5500 else if (eol_seen
& EOL_SEEN_CR
)
5502 coding
->id
= CODING_SYSTEM_ID (AREF (eol_type
, 2));
5508 /* Detect how a text specified in CODING is encoded. If a coding
5509 system is detected, update fields of CODING by the detected coding
5513 detect_coding (coding
)
5514 struct coding_system
*coding
;
5516 const unsigned char *src
, *src_end
;
5518 coding
->consumed
= coding
->consumed_char
= 0;
5519 coding
->produced
= coding
->produced_char
= 0;
5520 coding_set_source (coding
);
5522 src_end
= coding
->source
+ coding
->src_bytes
;
5524 /* If we have not yet decided the text encoding type, detect it
5526 if (EQ (CODING_ATTR_TYPE (CODING_ID_ATTRS (coding
->id
)), Qundecided
))
5529 struct coding_detection_info detect_info
;
5531 detect_info
.checked
= detect_info
.found
= detect_info
.rejected
= 0;
5532 for (i
= 0, src
= coding
->source
; src
< src_end
; i
++, src
++)
5538 && (c
== ISO_CODE_ESC
|| c
== ISO_CODE_SI
|| c
== ISO_CODE_SO
)
5539 && ! inhibit_iso_escape_detection
5540 && ! detect_info
.checked
)
5542 coding
->head_ascii
= src
- (coding
->source
+ coding
->consumed
);
5543 if (detect_coding_iso_2022 (coding
, &detect_info
))
5545 /* We have scanned the whole data. */
5546 if (! (detect_info
.rejected
& CATEGORY_MASK_ISO_7_ELSE
))
5547 /* We didn't find an 8-bit code. */
5553 coding
->head_ascii
= src
- (coding
->source
+ coding
->consumed
);
5555 if (coding
->head_ascii
< coding
->src_bytes
5556 || detect_info
.found
)
5558 enum coding_category category
;
5559 struct coding_system
*this;
5561 if (coding
->head_ascii
== coding
->src_bytes
)
5562 /* As all bytes are 7-bit, we can ignore non-ISO-2022 codings. */
5563 for (i
= 0; i
< coding_category_raw_text
; i
++)
5565 category
= coding_priorities
[i
];
5566 this = coding_categories
+ category
;
5567 if (detect_info
.found
& (1 << category
))
5571 for (i
= 0; i
< coding_category_raw_text
; i
++)
5573 category
= coding_priorities
[i
];
5574 this = coding_categories
+ category
;
5577 /* No coding system of this category is defined. */
5578 detect_info
.rejected
|= (1 << category
);
5580 else if (category
>= coding_category_raw_text
)
5582 else if (detect_info
.checked
& (1 << category
))
5584 if (detect_info
.found
& (1 << category
))
5587 else if ((*(this->detector
)) (coding
, &detect_info
)
5588 && detect_info
.found
& (1 << category
))
5590 if (category
== coding_category_utf_16_auto
)
5592 if (detect_info
.found
& CATEGORY_MASK_UTF_16_LE
)
5593 category
= coding_category_utf_16_le
;
5595 category
= coding_category_utf_16_be
;
5601 if (i
< coding_category_raw_text
)
5602 setup_coding_system (CODING_ID_NAME (this->id
), coding
);
5603 else if (detect_info
.rejected
== CATEGORY_MASK_ANY
)
5604 setup_coding_system (Qraw_text
, coding
);
5605 else if (detect_info
.rejected
)
5606 for (i
= 0; i
< coding_category_raw_text
; i
++)
5607 if (! (detect_info
.rejected
& (1 << coding_priorities
[i
])))
5609 this = coding_categories
+ coding_priorities
[i
];
5610 setup_coding_system (CODING_ID_NAME (this->id
), coding
);
5615 else if (XINT (CODING_ATTR_CATEGORY (CODING_ID_ATTRS (coding
->id
)))
5616 == coding_category_utf_16_auto
)
5618 Lisp_Object coding_systems
;
5619 struct coding_detection_info detect_info
;
5622 = AREF (CODING_ID_ATTRS (coding
->id
), coding_attr_utf_16_bom
);
5623 detect_info
.found
= detect_info
.rejected
= 0;
5624 if (CONSP (coding_systems
)
5625 && detect_coding_utf_16 (coding
, &detect_info
))
5627 if (detect_info
.found
& CATEGORY_MASK_UTF_16_LE
)
5628 setup_coding_system (XCAR (coding_systems
), coding
);
5629 else if (detect_info
.found
& CATEGORY_MASK_UTF_16_BE
)
5630 setup_coding_system (XCDR (coding_systems
), coding
);
5638 struct coding_system
*coding
;
5640 Lisp_Object eol_type
;
5641 unsigned char *p
, *pbeg
, *pend
;
5643 eol_type
= CODING_ID_EOL_TYPE (coding
->id
);
5644 if (EQ (eol_type
, Qunix
))
5647 if (NILP (coding
->dst_object
))
5648 pbeg
= coding
->destination
;
5650 pbeg
= BYTE_POS_ADDR (coding
->dst_pos_byte
);
5651 pend
= pbeg
+ coding
->produced
;
5653 if (VECTORP (eol_type
))
5655 int eol_seen
= EOL_SEEN_NONE
;
5657 for (p
= pbeg
; p
< pend
; p
++)
5660 eol_seen
|= EOL_SEEN_LF
;
5661 else if (*p
== '\r')
5663 if (p
+ 1 < pend
&& *(p
+ 1) == '\n')
5665 eol_seen
|= EOL_SEEN_CRLF
;
5669 eol_seen
|= EOL_SEEN_CR
;
5672 if (eol_seen
!= EOL_SEEN_NONE
5673 && eol_seen
!= EOL_SEEN_LF
5674 && eol_seen
!= EOL_SEEN_CRLF
5675 && eol_seen
!= EOL_SEEN_CR
)
5676 eol_seen
= EOL_SEEN_LF
;
5677 if (eol_seen
!= EOL_SEEN_NONE
)
5678 eol_type
= adjust_coding_eol_type (coding
, eol_seen
);
5681 if (EQ (eol_type
, Qmac
))
5683 for (p
= pbeg
; p
< pend
; p
++)
5687 else if (EQ (eol_type
, Qdos
))
5691 if (NILP (coding
->dst_object
))
5693 /* Start deleting '\r' from the tail to minimize the memory
5695 for (p
= pend
- 2; p
>= pbeg
; p
--)
5698 safe_bcopy ((char *) (p
+ 1), (char *) p
, pend
-- - p
- 1);
5704 int pos_byte
= coding
->dst_pos_byte
;
5705 int pos
= coding
->dst_pos
;
5706 int pos_end
= pos
+ coding
->produced_char
- 1;
5708 while (pos
< pos_end
)
5710 p
= BYTE_POS_ADDR (pos_byte
);
5711 if (*p
== '\r' && p
[1] == '\n')
5713 del_range_2 (pos
, pos_byte
, pos
+ 1, pos_byte
+ 1, 0);
5718 pos_byte
+= BYTES_BY_CHAR_HEAD (*p
);
5721 coding
->produced
-= n
;
5722 coding
->produced_char
-= n
;
5727 /* Return a translation table (or list of them) from coding system
5728 attribute vector ATTRS for encoding (ENCODEP is nonzero) or
5729 decoding (ENCODEP is zero). */
5732 get_translation_table (attrs
, encodep
, max_lookup
)
5734 int encodep
, *max_lookup
;
5736 Lisp_Object standard
, translation_table
;
5740 translation_table
= CODING_ATTR_ENCODE_TBL (attrs
),
5741 standard
= Vstandard_translation_table_for_encode
;
5743 translation_table
= CODING_ATTR_DECODE_TBL (attrs
),
5744 standard
= Vstandard_translation_table_for_decode
;
5745 if (NILP (translation_table
))
5746 translation_table
= standard
;
5749 if (SYMBOLP (translation_table
))
5750 translation_table
= Fget (translation_table
, Qtranslation_table
);
5751 else if (CONSP (translation_table
))
5753 translation_table
= Fcopy_sequence (translation_table
);
5754 for (val
= translation_table
; CONSP (val
); val
= XCDR (val
))
5755 if (SYMBOLP (XCAR (val
)))
5756 XSETCAR (val
, Fget (XCAR (val
), Qtranslation_table
));
5758 if (CHAR_TABLE_P (standard
))
5760 if (CONSP (translation_table
))
5761 translation_table
= nconc2 (translation_table
,
5762 Fcons (standard
, Qnil
));
5764 translation_table
= Fcons (translation_table
,
5765 Fcons (standard
, Qnil
));
5772 if (CHAR_TABLE_P (translation_table
)
5773 && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (translation_table
)) > 1)
5775 val
= XCHAR_TABLE (translation_table
)->extras
[1];
5776 if (NATNUMP (val
) && *max_lookup
< XFASTINT (val
))
5777 *max_lookup
= XFASTINT (val
);
5779 else if (CONSP (translation_table
))
5781 Lisp_Object tail
, val
;
5783 for (tail
= translation_table
; CONSP (tail
); tail
= XCDR (tail
))
5784 if (CHAR_TABLE_P (XCAR (tail
))
5785 && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (XCAR (tail
))) > 1)
5787 val
= XCHAR_TABLE (XCAR (tail
))->extras
[1];
5788 if (NATNUMP (val
) && *max_lookup
< XFASTINT (val
))
5789 *max_lookup
= XFASTINT (val
);
5793 return translation_table
;
5796 #define LOOKUP_TRANSLATION_TABLE(table, c, trans) \
5799 if (CHAR_TABLE_P (table)) \
5801 trans = CHAR_TABLE_REF (table, c); \
5802 if (CHARACTERP (trans)) \
5803 c = XFASTINT (trans), trans = Qnil; \
5805 else if (CONSP (table)) \
5809 for (tail = table; CONSP (tail); tail = XCDR (tail)) \
5810 if (CHAR_TABLE_P (XCAR (tail))) \
5812 trans = CHAR_TABLE_REF (XCAR (tail), c); \
5813 if (CHARACTERP (trans)) \
5814 c = XFASTINT (trans), trans = Qnil; \
5815 else if (! NILP (trans)) \
5823 get_translation (val
, buf
, buf_end
, last_block
, from_nchars
, to_nchars
)
5827 int *from_nchars
, *to_nchars
;
5829 /* VAL is TO or (([FROM-CHAR ...] . TO) ...) where TO is TO-CHAR or
5833 Lisp_Object from
, tail
;
5836 for (tail
= val
; CONSP (tail
); tail
= XCDR (tail
))
5841 for (i
= 0; i
< len
; i
++)
5843 if (buf
+ i
== buf_end
)
5849 if (XINT (AREF (from
, i
)) != buf
[i
])
5863 *buf
= XINT (AREF (val
, 0)), *to_nchars
= ASIZE (val
);
5871 produce_chars (coding
, translation_table
, last_block
)
5872 struct coding_system
*coding
;
5873 Lisp_Object translation_table
;
5876 unsigned char *dst
= coding
->destination
+ coding
->produced
;
5877 unsigned char *dst_end
= coding
->destination
+ coding
->dst_bytes
;
5879 int produced_chars
= 0;
5882 if (! coding
->chars_at_source
)
5884 /* Characters are in coding->charbuf. */
5885 int *buf
= coding
->charbuf
;
5886 int *buf_end
= buf
+ coding
->charbuf_used
;
5888 if (BUFFERP (coding
->src_object
)
5889 && EQ (coding
->src_object
, coding
->dst_object
))
5890 dst_end
= ((unsigned char *) coding
->source
) + coding
->consumed
;
5892 while (buf
< buf_end
)
5898 int from_nchars
= 1, to_nchars
= 1;
5899 Lisp_Object trans
= Qnil
;
5901 LOOKUP_TRANSLATION_TABLE (translation_table
, c
, trans
);
5904 trans
= get_translation (trans
, buf
, buf_end
, last_block
,
5905 &from_nchars
, &to_nchars
);
5911 if (dst
+ MAX_MULTIBYTE_LENGTH
* to_nchars
> dst_end
)
5913 dst
= alloc_destination (coding
,
5915 + MAX_MULTIBYTE_LENGTH
* to_nchars
,
5917 dst_end
= coding
->destination
+ coding
->dst_bytes
;
5920 for (i
= 0; i
< to_nchars
; i
++)
5923 c
= XINT (AREF (trans
, i
));
5924 if (coding
->dst_multibyte
5925 || ! CHAR_BYTE8_P (c
))
5926 CHAR_STRING_ADVANCE (c
, dst
);
5928 *dst
++ = CHAR_TO_BYTE8 (c
);
5930 produced_chars
+= to_nchars
;
5932 while (--from_nchars
> 0)
5936 /* This is an annotation datum. (-C) is the length. */
5939 carryover
= buf_end
- buf
;
5943 const unsigned char *src
= coding
->source
;
5944 const unsigned char *src_end
= src
+ coding
->src_bytes
;
5945 Lisp_Object eol_type
;
5947 eol_type
= CODING_ID_EOL_TYPE (coding
->id
);
5949 if (coding
->src_multibyte
!= coding
->dst_multibyte
)
5951 if (coding
->src_multibyte
)
5958 const unsigned char *src_base
= src
;
5964 if (EQ (eol_type
, Qdos
))
5968 record_conversion_result
5969 (coding
, CODING_RESULT_INSUFFICIENT_SRC
);
5970 goto no_more_source
;
5975 else if (EQ (eol_type
, Qmac
))
5980 coding
->consumed
= src
- coding
->source
;
5982 if (EQ (coding
->src_object
, coding
->dst_object
))
5983 dst_end
= (unsigned char *) src
;
5986 dst
= alloc_destination (coding
, src_end
- src
+ 1,
5988 dst_end
= coding
->destination
+ coding
->dst_bytes
;
5989 coding_set_source (coding
);
5990 src
= coding
->source
+ coding
->consumed
;
5991 src_end
= coding
->source
+ coding
->src_bytes
;
6001 while (src
< src_end
)
6008 if (EQ (eol_type
, Qdos
))
6014 else if (EQ (eol_type
, Qmac
))
6017 if (dst
>= dst_end
- 1)
6019 coding
->consumed
= src
- coding
->source
;
6021 if (EQ (coding
->src_object
, coding
->dst_object
))
6022 dst_end
= (unsigned char *) src
;
6023 if (dst
>= dst_end
- 1)
6025 dst
= alloc_destination (coding
, src_end
- src
+ 2,
6027 dst_end
= coding
->destination
+ coding
->dst_bytes
;
6028 coding_set_source (coding
);
6029 src
= coding
->source
+ coding
->consumed
;
6030 src_end
= coding
->source
+ coding
->src_bytes
;
6038 if (!EQ (coding
->src_object
, coding
->dst_object
))
6040 int require
= coding
->src_bytes
- coding
->dst_bytes
;
6044 EMACS_INT offset
= src
- coding
->source
;
6046 dst
= alloc_destination (coding
, require
, dst
);
6047 coding_set_source (coding
);
6048 src
= coding
->source
+ offset
;
6049 src_end
= coding
->source
+ coding
->src_bytes
;
6052 produced_chars
= coding
->src_chars
;
6053 while (src
< src_end
)
6059 if (EQ (eol_type
, Qdos
))
6066 else if (EQ (eol_type
, Qmac
))
6072 coding
->consumed
= coding
->src_bytes
;
6073 coding
->consumed_char
= coding
->src_chars
;
6076 produced
= dst
- (coding
->destination
+ coding
->produced
);
6077 if (BUFFERP (coding
->dst_object
) && produced_chars
> 0)
6078 insert_from_gap (produced_chars
, produced
);
6079 coding
->produced
+= produced
;
6080 coding
->produced_char
+= produced_chars
;
6084 /* Compose text in CODING->object according to the annotation data at
6085 CHARBUF. CHARBUF is an array:
6086 [ -LENGTH ANNOTATION_MASK FROM TO METHOD COMP_LEN [ COMPONENTS... ] ]
6090 produce_composition (coding
, charbuf
, pos
)
6091 struct coding_system
*coding
;
6097 enum composition_method method
;
6098 Lisp_Object components
;
6101 to
= pos
+ charbuf
[2];
6104 method
= (enum composition_method
) (charbuf
[3]);
6106 if (method
== COMPOSITION_RELATIVE
)
6108 else if (method
>= COMPOSITION_WITH_RULE
6109 && method
<= COMPOSITION_WITH_RULE_ALTCHARS
)
6111 Lisp_Object args
[MAX_COMPOSITION_COMPONENTS
* 2 - 1];
6116 for (i
= 0; i
< len
; i
++)
6118 args
[i
] = make_number (charbuf
[i
]);
6122 components
= (method
== COMPOSITION_WITH_ALTCHARS
6123 ? Fstring (len
, args
) : Fvector (len
, args
));
6127 compose_text (pos
, to
, components
, Qnil
, coding
->dst_object
);
6131 /* Put `charset' property on text in CODING->object according to
6132 the annotation data at CHARBUF. CHARBUF is an array:
6133 [ -LENGTH ANNOTATION_MASK NCHARS CHARSET-ID ]
6137 produce_charset (coding
, charbuf
, pos
)
6138 struct coding_system
*coding
;
6142 EMACS_INT from
= pos
- charbuf
[2];
6143 struct charset
*charset
= CHARSET_FROM_ID (charbuf
[3]);
6145 Fput_text_property (make_number (from
), make_number (pos
),
6146 Qcharset
, CHARSET_NAME (charset
),
6147 coding
->dst_object
);
6151 #define CHARBUF_SIZE 0x4000
6153 #define ALLOC_CONVERSION_WORK_AREA(coding) \
6155 int size = CHARBUF_SIZE;; \
6157 coding->charbuf = NULL; \
6158 while (size > 1024) \
6160 coding->charbuf = (int *) alloca (sizeof (int) * size); \
6161 if (coding->charbuf) \
6165 if (! coding->charbuf) \
6167 record_conversion_result (coding, CODING_RESULT_INSUFFICIENT_MEM); \
6168 return coding->result; \
6170 coding->charbuf_size = size; \
6175 produce_annotation (coding
, pos
)
6176 struct coding_system
*coding
;
6179 int *charbuf
= coding
->charbuf
;
6180 int *charbuf_end
= charbuf
+ coding
->charbuf_used
;
6182 if (NILP (coding
->dst_object
))
6185 while (charbuf
< charbuf_end
)
6191 int len
= -*charbuf
;
6194 case CODING_ANNOTATE_COMPOSITION_MASK
:
6195 produce_composition (coding
, charbuf
, pos
);
6197 case CODING_ANNOTATE_CHARSET_MASK
:
6198 produce_charset (coding
, charbuf
, pos
);
6208 /* Decode the data at CODING->src_object into CODING->dst_object.
6209 CODING->src_object is a buffer, a string, or nil.
6210 CODING->dst_object is a buffer.
6212 If CODING->src_object is a buffer, it must be the current buffer.
6213 In this case, if CODING->src_pos is positive, it is a position of
6214 the source text in the buffer, otherwise, the source text is in the
6215 gap area of the buffer, and CODING->src_pos specifies the offset of
6216 the text from GPT (which must be the same as PT). If this is the
6217 same buffer as CODING->dst_object, CODING->src_pos must be
6220 If CODING->src_object is a string, CODING->src_pos is an index to
6223 If CODING->src_object is nil, CODING->source must already point to
6224 the non-relocatable memory area. In this case, CODING->src_pos is
6225 an offset from CODING->source.
6227 The decoded data is inserted at the current point of the buffer
6232 decode_coding (coding
)
6233 struct coding_system
*coding
;
6236 Lisp_Object undo_list
;
6237 Lisp_Object translation_table
;
6241 if (BUFFERP (coding
->src_object
)
6242 && coding
->src_pos
> 0
6243 && coding
->src_pos
< GPT
6244 && coding
->src_pos
+ coding
->src_chars
> GPT
)
6245 move_gap_both (coding
->src_pos
, coding
->src_pos_byte
);
6248 if (BUFFERP (coding
->dst_object
))
6250 if (current_buffer
!= XBUFFER (coding
->dst_object
))
6251 set_buffer_internal (XBUFFER (coding
->dst_object
));
6253 move_gap_both (PT
, PT_BYTE
);
6254 undo_list
= current_buffer
->undo_list
;
6255 current_buffer
->undo_list
= Qt
;
6258 coding
->consumed
= coding
->consumed_char
= 0;
6259 coding
->produced
= coding
->produced_char
= 0;
6260 coding
->chars_at_source
= 0;
6261 record_conversion_result (coding
, CODING_RESULT_SUCCESS
);
6264 ALLOC_CONVERSION_WORK_AREA (coding
);
6266 attrs
= CODING_ID_ATTRS (coding
->id
);
6267 translation_table
= get_translation_table (attrs
, 0, NULL
);
6272 EMACS_INT pos
= coding
->dst_pos
+ coding
->produced_char
;
6274 coding_set_source (coding
);
6275 coding
->annotated
= 0;
6276 coding
->charbuf_used
= carryover
;
6277 (*(coding
->decoder
)) (coding
);
6278 coding_set_destination (coding
);
6279 carryover
= produce_chars (coding
, translation_table
, 0);
6280 if (coding
->annotated
)
6281 produce_annotation (coding
, pos
);
6282 for (i
= 0; i
< carryover
; i
++)
6284 = coding
->charbuf
[coding
->charbuf_used
- carryover
+ i
];
6286 while (coding
->consumed
< coding
->src_bytes
6287 && (coding
->result
== CODING_RESULT_SUCCESS
6288 || coding
->result
== CODING_RESULT_INVALID_SRC
));
6292 coding_set_destination (coding
);
6293 coding
->charbuf_used
= carryover
;
6294 produce_chars (coding
, translation_table
, 1);
6297 coding
->carryover_bytes
= 0;
6298 if (coding
->consumed
< coding
->src_bytes
)
6300 int nbytes
= coding
->src_bytes
- coding
->consumed
;
6301 const unsigned char *src
;
6303 coding_set_source (coding
);
6304 coding_set_destination (coding
);
6305 src
= coding
->source
+ coding
->consumed
;
6307 if (coding
->mode
& CODING_MODE_LAST_BLOCK
)
6309 /* Flush out unprocessed data as binary chars. We are sure
6310 that the number of data is less than the size of
6312 coding
->charbuf_used
= 0;
6313 while (nbytes
-- > 0)
6318 c
= BYTE8_TO_CHAR (c
);
6319 coding
->charbuf
[coding
->charbuf_used
++] = c
;
6321 produce_chars (coding
, Qnil
, 1);
6325 /* Record unprocessed bytes in coding->carryover. We are
6326 sure that the number of data is less than the size of
6327 coding->carryover. */
6328 unsigned char *p
= coding
->carryover
;
6330 coding
->carryover_bytes
= nbytes
;
6331 while (nbytes
-- > 0)
6334 coding
->consumed
= coding
->src_bytes
;
6337 if (! EQ (CODING_ID_EOL_TYPE (coding
->id
), Qunix
))
6338 decode_eol (coding
);
6339 if (BUFFERP (coding
->dst_object
))
6341 current_buffer
->undo_list
= undo_list
;
6342 record_insert (coding
->dst_pos
, coding
->produced_char
);
6344 return coding
->result
;
6348 /* Extract an annotation datum from a composition starting at POS and
6349 ending before LIMIT of CODING->src_object (buffer or string), store
6350 the data in BUF, set *STOP to a starting position of the next
6351 composition (if any) or to LIMIT, and return the address of the
6352 next element of BUF.
6354 If such an annotation is not found, set *STOP to a starting
6355 position of a composition after POS (if any) or to LIMIT, and
6359 handle_composition_annotation (pos
, limit
, coding
, buf
, stop
)
6360 EMACS_INT pos
, limit
;
6361 struct coding_system
*coding
;
6365 EMACS_INT start
, end
;
6368 if (! find_composition (pos
, limit
, &start
, &end
, &prop
, coding
->src_object
)
6371 else if (start
> pos
)
6377 /* We found a composition. Store the corresponding
6378 annotation data in BUF. */
6380 enum composition_method method
= COMPOSITION_METHOD (prop
);
6381 int nchars
= COMPOSITION_LENGTH (prop
);
6383 ADD_COMPOSITION_DATA (buf
, nchars
, method
);
6384 if (method
!= COMPOSITION_RELATIVE
)
6386 Lisp_Object components
;
6389 components
= COMPOSITION_COMPONENTS (prop
);
6390 if (VECTORP (components
))
6392 len
= XVECTOR (components
)->size
;
6393 for (i
= 0; i
< len
; i
++)
6394 *buf
++ = XINT (AREF (components
, i
));
6396 else if (STRINGP (components
))
6398 len
= SCHARS (components
);
6402 FETCH_STRING_CHAR_ADVANCE (*buf
, components
, i
, i_byte
);
6406 else if (INTEGERP (components
))
6409 *buf
++ = XINT (components
);
6411 else if (CONSP (components
))
6413 for (len
= 0; CONSP (components
);
6414 len
++, components
= XCDR (components
))
6415 *buf
++ = XINT (XCAR (components
));
6423 if (find_composition (end
, limit
, &start
, &end
, &prop
,
6434 /* Extract an annotation datum from a text property `charset' at POS of
6435 CODING->src_object (buffer of string), store the data in BUF, set
6436 *STOP to the position where the value of `charset' property changes
6437 (limiting by LIMIT), and return the address of the next element of
6440 If the property value is nil, set *STOP to the position where the
6441 property value is non-nil (limiting by LIMIT), and return BUF. */
6444 handle_charset_annotation (pos
, limit
, coding
, buf
, stop
)
6445 EMACS_INT pos
, limit
;
6446 struct coding_system
*coding
;
6450 Lisp_Object val
, next
;
6453 val
= Fget_text_property (make_number (pos
), Qcharset
, coding
->src_object
);
6454 if (! NILP (val
) && CHARSETP (val
))
6455 id
= XINT (CHARSET_SYMBOL_ID (val
));
6458 ADD_CHARSET_DATA (buf
, 0, id
);
6459 next
= Fnext_single_property_change (make_number (pos
), Qcharset
,
6461 make_number (limit
));
6462 *stop
= XINT (next
);
6468 consume_chars (coding
, translation_table
, max_lookup
)
6469 struct coding_system
*coding
;
6470 Lisp_Object translation_table
;
6473 int *buf
= coding
->charbuf
;
6474 int *buf_end
= coding
->charbuf
+ coding
->charbuf_size
;
6475 const unsigned char *src
= coding
->source
+ coding
->consumed
;
6476 const unsigned char *src_end
= coding
->source
+ coding
->src_bytes
;
6477 EMACS_INT pos
= coding
->src_pos
+ coding
->consumed_char
;
6478 EMACS_INT end_pos
= coding
->src_pos
+ coding
->src_chars
;
6479 int multibytep
= coding
->src_multibyte
;
6480 Lisp_Object eol_type
;
6482 EMACS_INT stop
, stop_composition
, stop_charset
;
6483 int *lookup_buf
= NULL
;
6485 if (! NILP (translation_table
))
6486 lookup_buf
= alloca (sizeof (int) * max_lookup
);
6488 eol_type
= CODING_ID_EOL_TYPE (coding
->id
);
6489 if (VECTORP (eol_type
))
6492 /* Note: composition handling is not yet implemented. */
6493 coding
->common_flags
&= ~CODING_ANNOTATE_COMPOSITION_MASK
;
6495 if (NILP (coding
->src_object
))
6496 stop
= stop_composition
= stop_charset
= end_pos
;
6499 if (coding
->common_flags
& CODING_ANNOTATE_COMPOSITION_MASK
)
6500 stop
= stop_composition
= pos
;
6502 stop
= stop_composition
= end_pos
;
6503 if (coding
->common_flags
& CODING_ANNOTATE_CHARSET_MASK
)
6504 stop
= stop_charset
= pos
;
6506 stop_charset
= end_pos
;
6509 /* Compensate for CRLF and conversion. */
6510 buf_end
-= 1 + MAX_ANNOTATION_LENGTH
;
6511 while (buf
< buf_end
)
6519 if (pos
== stop_composition
)
6520 buf
= handle_composition_annotation (pos
, end_pos
, coding
,
6521 buf
, &stop_composition
);
6522 if (pos
== stop_charset
)
6523 buf
= handle_charset_annotation (pos
, end_pos
, coding
,
6524 buf
, &stop_charset
);
6525 stop
= (stop_composition
< stop_charset
6526 ? stop_composition
: stop_charset
);
6533 if (coding
->encoder
== encode_coding_raw_text
)
6535 else if ((bytes
= MULTIBYTE_LENGTH (src
, src_end
)) > 0)
6536 c
= STRING_CHAR_ADVANCE (src
), pos
+= bytes
;
6538 c
= BYTE8_TO_CHAR (*src
), src
++, pos
++;
6541 c
= STRING_CHAR_ADVANCE (src
), pos
++;
6542 if ((c
== '\r') && (coding
->mode
& CODING_MODE_SELECTIVE_DISPLAY
))
6544 if (! EQ (eol_type
, Qunix
))
6548 if (EQ (eol_type
, Qdos
))
6556 LOOKUP_TRANSLATION_TABLE (translation_table
, c
, trans
);
6561 int from_nchars
= 1, to_nchars
= 1;
6562 int *lookup_buf_end
;
6563 const unsigned char *p
= src
;
6567 for (i
= 1; i
< max_lookup
&& p
< src_end
; i
++)
6568 lookup_buf
[i
] = STRING_CHAR_ADVANCE (p
);
6569 lookup_buf_end
= lookup_buf
+ i
;
6570 trans
= get_translation (trans
, lookup_buf
, lookup_buf_end
, 1,
6571 &from_nchars
, &to_nchars
);
6573 || buf
+ to_nchars
> buf_end
)
6575 *buf
++ = *lookup_buf
;
6576 for (i
= 1; i
< to_nchars
; i
++)
6577 *buf
++ = XINT (AREF (trans
, i
));
6578 for (i
= 1; i
< from_nchars
; i
++, pos
++)
6579 src
+= MULTIBYTE_LENGTH_NO_CHECK (src
);
6583 coding
->consumed
= src
- coding
->source
;
6584 coding
->consumed_char
= pos
- coding
->src_pos
;
6585 coding
->charbuf_used
= buf
- coding
->charbuf
;
6586 coding
->chars_at_source
= 0;
6590 /* Encode the text at CODING->src_object into CODING->dst_object.
6591 CODING->src_object is a buffer or a string.
6592 CODING->dst_object is a buffer or nil.
6594 If CODING->src_object is a buffer, it must be the current buffer.
6595 In this case, if CODING->src_pos is positive, it is a position of
6596 the source text in the buffer, otherwise. the source text is in the
6597 gap area of the buffer, and coding->src_pos specifies the offset of
6598 the text from GPT (which must be the same as PT). If this is the
6599 same buffer as CODING->dst_object, CODING->src_pos must be
6600 negative and CODING should not have `pre-write-conversion'.
6602 If CODING->src_object is a string, CODING should not have
6603 `pre-write-conversion'.
6605 If CODING->dst_object is a buffer, the encoded data is inserted at
6606 the current point of that buffer.
6608 If CODING->dst_object is nil, the encoded data is placed at the
6609 memory area specified by CODING->destination. */
6612 encode_coding (coding
)
6613 struct coding_system
*coding
;
6616 Lisp_Object translation_table
;
6619 attrs
= CODING_ID_ATTRS (coding
->id
);
6620 if (coding
->encoder
== encode_coding_raw_text
)
6621 translation_table
= Qnil
, max_lookup
= 0;
6623 translation_table
= get_translation_table (attrs
, 1, &max_lookup
);
6625 if (BUFFERP (coding
->dst_object
))
6627 set_buffer_internal (XBUFFER (coding
->dst_object
));
6628 coding
->dst_multibyte
6629 = ! NILP (current_buffer
->enable_multibyte_characters
);
6632 coding
->consumed
= coding
->consumed_char
= 0;
6633 coding
->produced
= coding
->produced_char
= 0;
6634 record_conversion_result (coding
, CODING_RESULT_SUCCESS
);
6637 ALLOC_CONVERSION_WORK_AREA (coding
);
6640 coding_set_source (coding
);
6641 consume_chars (coding
, translation_table
, max_lookup
);
6642 coding_set_destination (coding
);
6643 (*(coding
->encoder
)) (coding
);
6644 } while (coding
->consumed_char
< coding
->src_chars
);
6646 if (BUFFERP (coding
->dst_object
) && coding
->produced_char
> 0)
6647 insert_from_gap (coding
->produced_char
, coding
->produced
);
6649 return (coding
->result
);
6653 /* Name (or base name) of work buffer for code conversion. */
6654 static Lisp_Object Vcode_conversion_workbuf_name
;
6656 /* A working buffer used by the top level conversion. Once it is
6657 created, it is never destroyed. It has the name
6658 Vcode_conversion_workbuf_name. The other working buffers are
6659 destroyed after the use is finished, and their names are modified
6660 versions of Vcode_conversion_workbuf_name. */
6661 static Lisp_Object Vcode_conversion_reused_workbuf
;
6663 /* 1 iff Vcode_conversion_reused_workbuf is already in use. */
6664 static int reused_workbuf_in_use
;
6667 /* Return a working buffer of code convesion. MULTIBYTE specifies the
6668 multibyteness of returning buffer. */
6671 make_conversion_work_buffer (multibyte
)
6674 Lisp_Object name
, workbuf
;
6675 struct buffer
*current
;
6677 if (reused_workbuf_in_use
++)
6679 name
= Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name
, Qnil
);
6680 workbuf
= Fget_buffer_create (name
);
6684 name
= Vcode_conversion_workbuf_name
;
6685 workbuf
= Fget_buffer_create (name
);
6686 if (NILP (Vcode_conversion_reused_workbuf
))
6687 Vcode_conversion_reused_workbuf
= workbuf
;
6689 current
= current_buffer
;
6690 set_buffer_internal (XBUFFER (workbuf
));
6692 current_buffer
->undo_list
= Qt
;
6693 current_buffer
->enable_multibyte_characters
= multibyte
? Qt
: Qnil
;
6694 set_buffer_internal (current
);
6700 code_conversion_restore (arg
)
6703 Lisp_Object current
, workbuf
;
6704 struct gcpro gcpro1
;
6707 current
= XCAR (arg
);
6708 workbuf
= XCDR (arg
);
6709 if (! NILP (workbuf
))
6711 if (EQ (workbuf
, Vcode_conversion_reused_workbuf
))
6712 reused_workbuf_in_use
= 0;
6713 else if (! NILP (Fbuffer_live_p (workbuf
)))
6714 Fkill_buffer (workbuf
);
6716 set_buffer_internal (XBUFFER (current
));
6722 code_conversion_save (with_work_buf
, multibyte
)
6723 int with_work_buf
, multibyte
;
6725 Lisp_Object workbuf
= Qnil
;
6728 workbuf
= make_conversion_work_buffer (multibyte
);
6729 record_unwind_protect (code_conversion_restore
,
6730 Fcons (Fcurrent_buffer (), workbuf
));
6735 decode_coding_gap (coding
, chars
, bytes
)
6736 struct coding_system
*coding
;
6737 EMACS_INT chars
, bytes
;
6739 int count
= specpdl_ptr
- specpdl
;
6742 code_conversion_save (0, 0);
6744 coding
->src_object
= Fcurrent_buffer ();
6745 coding
->src_chars
= chars
;
6746 coding
->src_bytes
= bytes
;
6747 coding
->src_pos
= -chars
;
6748 coding
->src_pos_byte
= -bytes
;
6749 coding
->src_multibyte
= chars
< bytes
;
6750 coding
->dst_object
= coding
->src_object
;
6751 coding
->dst_pos
= PT
;
6752 coding
->dst_pos_byte
= PT_BYTE
;
6753 coding
->dst_multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
6755 if (CODING_REQUIRE_DETECTION (coding
))
6756 detect_coding (coding
);
6758 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6759 current_buffer
->text
->inhibit_shrinking
= 1;
6760 decode_coding (coding
);
6761 current_buffer
->text
->inhibit_shrinking
= 0;
6763 attrs
= CODING_ID_ATTRS (coding
->id
);
6764 if (! NILP (CODING_ATTR_POST_READ (attrs
)))
6766 EMACS_INT prev_Z
= Z
, prev_Z_BYTE
= Z_BYTE
;
6769 TEMP_SET_PT_BOTH (coding
->dst_pos
, coding
->dst_pos_byte
);
6770 val
= call1 (CODING_ATTR_POST_READ (attrs
),
6771 make_number (coding
->produced_char
));
6773 coding
->produced_char
+= Z
- prev_Z
;
6774 coding
->produced
+= Z_BYTE
- prev_Z_BYTE
;
6777 unbind_to (count
, Qnil
);
6778 return coding
->result
;
6782 encode_coding_gap (coding
, chars
, bytes
)
6783 struct coding_system
*coding
;
6784 EMACS_INT chars
, bytes
;
6786 int count
= specpdl_ptr
- specpdl
;
6788 code_conversion_save (0, 0);
6790 coding
->src_object
= Fcurrent_buffer ();
6791 coding
->src_chars
= chars
;
6792 coding
->src_bytes
= bytes
;
6793 coding
->src_pos
= -chars
;
6794 coding
->src_pos_byte
= -bytes
;
6795 coding
->src_multibyte
= chars
< bytes
;
6796 coding
->dst_object
= coding
->src_object
;
6797 coding
->dst_pos
= PT
;
6798 coding
->dst_pos_byte
= PT_BYTE
;
6800 encode_coding (coding
);
6802 unbind_to (count
, Qnil
);
6803 return coding
->result
;
6807 /* Decode the text in the range FROM/FROM_BYTE and TO/TO_BYTE in
6808 SRC_OBJECT into DST_OBJECT by coding context CODING.
6810 SRC_OBJECT is a buffer, a string, or Qnil.
6812 If it is a buffer, the text is at point of the buffer. FROM and TO
6813 are positions in the buffer.
6815 If it is a string, the text is at the beginning of the string.
6816 FROM and TO are indices to the string.
6818 If it is nil, the text is at coding->source. FROM and TO are
6819 indices to coding->source.
6821 DST_OBJECT is a buffer, Qt, or Qnil.
6823 If it is a buffer, the decoded text is inserted at point of the
6824 buffer. If the buffer is the same as SRC_OBJECT, the source text
6827 If it is Qt, a string is made from the decoded text, and
6828 set in CODING->dst_object.
6830 If it is Qnil, the decoded text is stored at CODING->destination.
6831 The caller must allocate CODING->dst_bytes bytes at
6832 CODING->destination by xmalloc. If the decoded text is longer than
6833 CODING->dst_bytes, CODING->destination is relocated by xrealloc.
6837 decode_coding_object (coding
, src_object
, from
, from_byte
, to
, to_byte
,
6839 struct coding_system
*coding
;
6840 Lisp_Object src_object
;
6841 EMACS_INT from
, from_byte
, to
, to_byte
;
6842 Lisp_Object dst_object
;
6844 int count
= specpdl_ptr
- specpdl
;
6845 unsigned char *destination
;
6846 EMACS_INT dst_bytes
;
6847 EMACS_INT chars
= to
- from
;
6848 EMACS_INT bytes
= to_byte
- from_byte
;
6851 int saved_pt
= -1, saved_pt_byte
;
6853 buffer
= Fcurrent_buffer ();
6855 if (NILP (dst_object
))
6857 destination
= coding
->destination
;
6858 dst_bytes
= coding
->dst_bytes
;
6861 coding
->src_object
= src_object
;
6862 coding
->src_chars
= chars
;
6863 coding
->src_bytes
= bytes
;
6864 coding
->src_multibyte
= chars
< bytes
;
6866 if (STRINGP (src_object
))
6868 coding
->src_pos
= from
;
6869 coding
->src_pos_byte
= from_byte
;
6871 else if (BUFFERP (src_object
))
6873 set_buffer_internal (XBUFFER (src_object
));
6875 move_gap_both (from
, from_byte
);
6876 if (EQ (src_object
, dst_object
))
6878 saved_pt
= PT
, saved_pt_byte
= PT_BYTE
;
6879 TEMP_SET_PT_BOTH (from
, from_byte
);
6880 del_range_both (from
, from_byte
, to
, to_byte
, 1);
6881 coding
->src_pos
= -chars
;
6882 coding
->src_pos_byte
= -bytes
;
6886 coding
->src_pos
= from
;
6887 coding
->src_pos_byte
= from_byte
;
6891 if (CODING_REQUIRE_DETECTION (coding
))
6892 detect_coding (coding
);
6893 attrs
= CODING_ID_ATTRS (coding
->id
);
6895 if (EQ (dst_object
, Qt
)
6896 || (! NILP (CODING_ATTR_POST_READ (attrs
))
6897 && NILP (dst_object
)))
6899 coding
->dst_object
= code_conversion_save (1, 1);
6900 coding
->dst_pos
= BEG
;
6901 coding
->dst_pos_byte
= BEG_BYTE
;
6902 coding
->dst_multibyte
= 1;
6904 else if (BUFFERP (dst_object
))
6906 code_conversion_save (0, 0);
6907 coding
->dst_object
= dst_object
;
6908 coding
->dst_pos
= BUF_PT (XBUFFER (dst_object
));
6909 coding
->dst_pos_byte
= BUF_PT_BYTE (XBUFFER (dst_object
));
6910 coding
->dst_multibyte
6911 = ! NILP (XBUFFER (dst_object
)->enable_multibyte_characters
);
6915 code_conversion_save (0, 0);
6916 coding
->dst_object
= Qnil
;
6917 coding
->dst_multibyte
= 1;
6920 decode_coding (coding
);
6922 if (BUFFERP (coding
->dst_object
))
6923 set_buffer_internal (XBUFFER (coding
->dst_object
));
6925 if (! NILP (CODING_ATTR_POST_READ (attrs
)))
6927 struct gcpro gcpro1
, gcpro2
;
6928 EMACS_INT prev_Z
= Z
, prev_Z_BYTE
= Z_BYTE
;
6931 TEMP_SET_PT_BOTH (coding
->dst_pos
, coding
->dst_pos_byte
);
6932 GCPRO2 (coding
->src_object
, coding
->dst_object
);
6933 val
= safe_call1 (CODING_ATTR_POST_READ (attrs
),
6934 make_number (coding
->produced_char
));
6937 coding
->produced_char
+= Z
- prev_Z
;
6938 coding
->produced
+= Z_BYTE
- prev_Z_BYTE
;
6941 if (EQ (dst_object
, Qt
))
6943 coding
->dst_object
= Fbuffer_string ();
6945 else if (NILP (dst_object
) && BUFFERP (coding
->dst_object
))
6947 set_buffer_internal (XBUFFER (coding
->dst_object
));
6948 if (dst_bytes
< coding
->produced
)
6951 = (unsigned char *) xrealloc (destination
, coding
->produced
);
6954 record_conversion_result (coding
,
6955 CODING_RESULT_INSUFFICIENT_DST
);
6956 unbind_to (count
, Qnil
);
6959 if (BEGV
< GPT
&& GPT
< BEGV
+ coding
->produced_char
)
6960 move_gap_both (BEGV
, BEGV_BYTE
);
6961 bcopy (BEGV_ADDR
, destination
, coding
->produced
);
6962 coding
->destination
= destination
;
6968 /* This is the case of:
6969 (BUFFERP (src_object) && EQ (src_object, dst_object))
6970 As we have moved PT while replacing the original buffer
6971 contents, we must recover it now. */
6972 set_buffer_internal (XBUFFER (src_object
));
6973 if (saved_pt
< from
)
6974 TEMP_SET_PT_BOTH (saved_pt
, saved_pt_byte
);
6975 else if (saved_pt
< from
+ chars
)
6976 TEMP_SET_PT_BOTH (from
, from_byte
);
6977 else if (! NILP (current_buffer
->enable_multibyte_characters
))
6978 TEMP_SET_PT_BOTH (saved_pt
+ (coding
->produced_char
- chars
),
6979 saved_pt_byte
+ (coding
->produced
- bytes
));
6981 TEMP_SET_PT_BOTH (saved_pt
+ (coding
->produced
- bytes
),
6982 saved_pt_byte
+ (coding
->produced
- bytes
));
6985 unbind_to (count
, coding
->dst_object
);
6990 encode_coding_object (coding
, src_object
, from
, from_byte
, to
, to_byte
,
6992 struct coding_system
*coding
;
6993 Lisp_Object src_object
;
6994 EMACS_INT from
, from_byte
, to
, to_byte
;
6995 Lisp_Object dst_object
;
6997 int count
= specpdl_ptr
- specpdl
;
6998 EMACS_INT chars
= to
- from
;
6999 EMACS_INT bytes
= to_byte
- from_byte
;
7002 int saved_pt
= -1, saved_pt_byte
;
7003 int kill_src_buffer
= 0;
7005 buffer
= Fcurrent_buffer ();
7007 coding
->src_object
= src_object
;
7008 coding
->src_chars
= chars
;
7009 coding
->src_bytes
= bytes
;
7010 coding
->src_multibyte
= chars
< bytes
;
7012 attrs
= CODING_ID_ATTRS (coding
->id
);
7014 if (! NILP (CODING_ATTR_PRE_WRITE (attrs
)))
7016 coding
->src_object
= code_conversion_save (1, coding
->src_multibyte
);
7017 set_buffer_internal (XBUFFER (coding
->src_object
));
7018 if (STRINGP (src_object
))
7019 insert_from_string (src_object
, from
, from_byte
, chars
, bytes
, 0);
7020 else if (BUFFERP (src_object
))
7021 insert_from_buffer (XBUFFER (src_object
), from
, chars
, 0);
7023 insert_1_both (coding
->source
+ from
, chars
, bytes
, 0, 0, 0);
7025 if (EQ (src_object
, dst_object
))
7027 set_buffer_internal (XBUFFER (src_object
));
7028 saved_pt
= PT
, saved_pt_byte
= PT_BYTE
;
7029 del_range_both (from
, from_byte
, to
, to_byte
, 1);
7030 set_buffer_internal (XBUFFER (coding
->src_object
));
7034 Lisp_Object args
[3];
7036 args
[0] = CODING_ATTR_PRE_WRITE (attrs
);
7037 args
[1] = make_number (BEG
);
7038 args
[2] = make_number (Z
);
7039 safe_call (3, args
);
7041 if (XBUFFER (coding
->src_object
) != current_buffer
)
7042 kill_src_buffer
= 1;
7043 coding
->src_object
= Fcurrent_buffer ();
7045 move_gap_both (BEG
, BEG_BYTE
);
7046 coding
->src_chars
= Z
- BEG
;
7047 coding
->src_bytes
= Z_BYTE
- BEG_BYTE
;
7048 coding
->src_pos
= BEG
;
7049 coding
->src_pos_byte
= BEG_BYTE
;
7050 coding
->src_multibyte
= Z
< Z_BYTE
;
7052 else if (STRINGP (src_object
))
7054 code_conversion_save (0, 0);
7055 coding
->src_pos
= from
;
7056 coding
->src_pos_byte
= from_byte
;
7058 else if (BUFFERP (src_object
))
7060 code_conversion_save (0, 0);
7061 set_buffer_internal (XBUFFER (src_object
));
7062 if (EQ (src_object
, dst_object
))
7064 saved_pt
= PT
, saved_pt_byte
= PT_BYTE
;
7065 coding
->src_object
= del_range_1 (from
, to
, 1, 1);
7066 coding
->src_pos
= 0;
7067 coding
->src_pos_byte
= 0;
7071 if (from
< GPT
&& to
>= GPT
)
7072 move_gap_both (from
, from_byte
);
7073 coding
->src_pos
= from
;
7074 coding
->src_pos_byte
= from_byte
;
7078 code_conversion_save (0, 0);
7080 if (BUFFERP (dst_object
))
7082 coding
->dst_object
= dst_object
;
7083 if (EQ (src_object
, dst_object
))
7085 coding
->dst_pos
= from
;
7086 coding
->dst_pos_byte
= from_byte
;
7090 coding
->dst_pos
= BUF_PT (XBUFFER (dst_object
));
7091 coding
->dst_pos_byte
= BUF_PT_BYTE (XBUFFER (dst_object
));
7093 coding
->dst_multibyte
7094 = ! NILP (XBUFFER (dst_object
)->enable_multibyte_characters
);
7096 else if (EQ (dst_object
, Qt
))
7098 coding
->dst_object
= Qnil
;
7099 coding
->dst_bytes
= coding
->src_chars
;
7100 if (coding
->dst_bytes
== 0)
7101 coding
->dst_bytes
= 1;
7102 coding
->destination
= (unsigned char *) xmalloc (coding
->dst_bytes
);
7103 coding
->dst_multibyte
= 0;
7107 coding
->dst_object
= Qnil
;
7108 coding
->dst_multibyte
= 0;
7111 encode_coding (coding
);
7113 if (EQ (dst_object
, Qt
))
7115 if (BUFFERP (coding
->dst_object
))
7116 coding
->dst_object
= Fbuffer_string ();
7120 = make_unibyte_string ((char *) coding
->destination
,
7122 xfree (coding
->destination
);
7128 /* This is the case of:
7129 (BUFFERP (src_object) && EQ (src_object, dst_object))
7130 As we have moved PT while replacing the original buffer
7131 contents, we must recover it now. */
7132 set_buffer_internal (XBUFFER (src_object
));
7133 if (saved_pt
< from
)
7134 TEMP_SET_PT_BOTH (saved_pt
, saved_pt_byte
);
7135 else if (saved_pt
< from
+ chars
)
7136 TEMP_SET_PT_BOTH (from
, from_byte
);
7137 else if (! NILP (current_buffer
->enable_multibyte_characters
))
7138 TEMP_SET_PT_BOTH (saved_pt
+ (coding
->produced_char
- chars
),
7139 saved_pt_byte
+ (coding
->produced
- bytes
));
7141 TEMP_SET_PT_BOTH (saved_pt
+ (coding
->produced
- bytes
),
7142 saved_pt_byte
+ (coding
->produced
- bytes
));
7145 if (kill_src_buffer
)
7146 Fkill_buffer (coding
->src_object
);
7147 unbind_to (count
, Qnil
);
7152 preferred_coding_system ()
7154 int id
= coding_categories
[coding_priorities
[0]].id
;
7156 return CODING_ID_NAME (id
);
7161 /*** 8. Emacs Lisp library functions ***/
7163 DEFUN ("coding-system-p", Fcoding_system_p
, Scoding_system_p
, 1, 1, 0,
7164 doc
: /* Return t if OBJECT is nil or a coding-system.
7165 See the documentation of `define-coding-system' for information
7166 about coding-system objects. */)
7171 || CODING_SYSTEM_ID (obj
) >= 0)
7174 || NILP (Fget (obj
, Qcoding_system_define_form
)))
7179 DEFUN ("read-non-nil-coding-system", Fread_non_nil_coding_system
,
7180 Sread_non_nil_coding_system
, 1, 1, 0,
7181 doc
: /* Read a coding system from the minibuffer, prompting with string PROMPT. */)
7188 val
= Fcompleting_read (prompt
, Vcoding_system_alist
, Qnil
,
7189 Qt
, Qnil
, Qcoding_system_history
, Qnil
, Qnil
);
7191 while (SCHARS (val
) == 0);
7192 return (Fintern (val
, Qnil
));
7195 DEFUN ("read-coding-system", Fread_coding_system
, Sread_coding_system
, 1, 2, 0,
7196 doc
: /* Read a coding system from the minibuffer, prompting with string PROMPT.
7197 If the user enters null input, return second argument DEFAULT-CODING-SYSTEM. */)
7198 (prompt
, default_coding_system
)
7199 Lisp_Object prompt
, default_coding_system
;
7202 if (SYMBOLP (default_coding_system
))
7203 XSETSTRING (default_coding_system
, XPNTR (SYMBOL_NAME (default_coding_system
)));
7204 val
= Fcompleting_read (prompt
, Vcoding_system_alist
, Qnil
,
7205 Qt
, Qnil
, Qcoding_system_history
,
7206 default_coding_system
, Qnil
);
7207 return (SCHARS (val
) == 0 ? Qnil
: Fintern (val
, Qnil
));
7210 DEFUN ("check-coding-system", Fcheck_coding_system
, Scheck_coding_system
,
7212 doc
: /* Check validity of CODING-SYSTEM.
7213 If valid, return CODING-SYSTEM, else signal a `coding-system-error' error.
7214 It is valid if it is nil or a symbol defined as a coding system by the
7215 function `define-coding-system'. */)
7217 Lisp_Object coding_system
;
7219 Lisp_Object define_form
;
7221 define_form
= Fget (coding_system
, Qcoding_system_define_form
);
7222 if (! NILP (define_form
))
7224 Fput (coding_system
, Qcoding_system_define_form
, Qnil
);
7225 safe_eval (define_form
);
7227 if (!NILP (Fcoding_system_p (coding_system
)))
7228 return coding_system
;
7229 xsignal1 (Qcoding_system_error
, coding_system
);
7233 /* Detect how the bytes at SRC of length SRC_BYTES are encoded. If
7234 HIGHEST is nonzero, return the coding system of the highest
7235 priority among the detected coding systems. Otherwize return a
7236 list of detected coding systems sorted by their priorities. If
7237 MULTIBYTEP is nonzero, it is assumed that the bytes are in correct
7238 multibyte form but contains only ASCII and eight-bit chars.
7239 Otherwise, the bytes are raw bytes.
7241 CODING-SYSTEM controls the detection as below:
7243 If it is nil, detect both text-format and eol-format. If the
7244 text-format part of CODING-SYSTEM is already specified
7245 (e.g. `iso-latin-1'), detect only eol-format. If the eol-format
7246 part of CODING-SYSTEM is already specified (e.g. `undecided-unix'),
7247 detect only text-format. */
7250 detect_coding_system (src
, src_chars
, src_bytes
, highest
, multibytep
,
7252 const unsigned char *src
;
7253 int src_chars
, src_bytes
, highest
;
7255 Lisp_Object coding_system
;
7257 const unsigned char *src_end
= src
+ src_bytes
;
7258 Lisp_Object attrs
, eol_type
;
7260 struct coding_system coding
;
7262 struct coding_detection_info detect_info
;
7263 enum coding_category base_category
;
7265 if (NILP (coding_system
))
7266 coding_system
= Qundecided
;
7267 setup_coding_system (coding_system
, &coding
);
7268 attrs
= CODING_ID_ATTRS (coding
.id
);
7269 eol_type
= CODING_ID_EOL_TYPE (coding
.id
);
7270 coding_system
= CODING_ATTR_BASE_NAME (attrs
);
7272 coding
.source
= src
;
7273 coding
.src_chars
= src_chars
;
7274 coding
.src_bytes
= src_bytes
;
7275 coding
.src_multibyte
= multibytep
;
7276 coding
.consumed
= 0;
7277 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
7279 detect_info
.checked
= detect_info
.found
= detect_info
.rejected
= 0;
7281 /* At first, detect text-format if necessary. */
7282 base_category
= XINT (CODING_ATTR_CATEGORY (attrs
));
7283 if (base_category
== coding_category_undecided
)
7285 enum coding_category category
;
7286 struct coding_system
*this;
7289 /* Skip all ASCII bytes except for a few ISO2022 controls. */
7290 for (i
= 0; src
< src_end
; i
++, src
++)
7296 && (c
== ISO_CODE_ESC
|| c
== ISO_CODE_SI
|| c
== ISO_CODE_SO
)
7297 && ! inhibit_iso_escape_detection
)
7299 coding
.head_ascii
= src
- coding
.source
;
7300 if (detect_coding_iso_2022 (&coding
, &detect_info
))
7302 /* We have scanned the whole data. */
7303 if (! (detect_info
.rejected
& CATEGORY_MASK_ISO_7_ELSE
))
7304 /* We didn't find an 8-bit code. */
7310 coding
.head_ascii
= src
- coding
.source
;
7313 || detect_info
.found
)
7316 /* As all bytes are 7-bit, we can ignore non-ISO-2022 codings. */
7317 for (i
= 0; i
< coding_category_raw_text
; i
++)
7319 category
= coding_priorities
[i
];
7320 this = coding_categories
+ category
;
7321 if (detect_info
.found
& (1 << category
))
7325 for (i
= 0; i
< coding_category_raw_text
; i
++)
7327 category
= coding_priorities
[i
];
7328 this = coding_categories
+ category
;
7332 /* No coding system of this category is defined. */
7333 detect_info
.rejected
|= (1 << category
);
7335 else if (category
>= coding_category_raw_text
)
7337 else if (detect_info
.checked
& (1 << category
))
7340 && (detect_info
.found
& (1 << category
)))
7345 if ((*(this->detector
)) (&coding
, &detect_info
)
7347 && (detect_info
.found
& (1 << category
)))
7349 if (category
== coding_category_utf_16_auto
)
7351 if (detect_info
.found
& CATEGORY_MASK_UTF_16_LE
)
7352 category
= coding_category_utf_16_le
;
7354 category
= coding_category_utf_16_be
;
7362 if (detect_info
.rejected
== CATEGORY_MASK_ANY
)
7364 detect_info
.found
= CATEGORY_MASK_RAW_TEXT
;
7365 id
= coding_categories
[coding_category_raw_text
].id
;
7366 val
= Fcons (make_number (id
), Qnil
);
7368 else if (! detect_info
.rejected
&& ! detect_info
.found
)
7370 detect_info
.found
= CATEGORY_MASK_ANY
;
7371 id
= coding_categories
[coding_category_undecided
].id
;
7372 val
= Fcons (make_number (id
), Qnil
);
7376 if (detect_info
.found
)
7378 detect_info
.found
= 1 << category
;
7379 val
= Fcons (make_number (this->id
), Qnil
);
7382 for (i
= 0; i
< coding_category_raw_text
; i
++)
7383 if (! (detect_info
.rejected
& (1 << coding_priorities
[i
])))
7385 detect_info
.found
= 1 << coding_priorities
[i
];
7386 id
= coding_categories
[coding_priorities
[i
]].id
;
7387 val
= Fcons (make_number (id
), Qnil
);
7393 int mask
= detect_info
.rejected
| detect_info
.found
;
7397 for (i
= coding_category_raw_text
- 1; i
>= 0; i
--)
7399 category
= coding_priorities
[i
];
7400 if (! (mask
& (1 << category
)))
7402 found
|= 1 << category
;
7403 id
= coding_categories
[category
].id
;
7405 val
= Fcons (make_number (id
), val
);
7408 for (i
= coding_category_raw_text
- 1; i
>= 0; i
--)
7410 category
= coding_priorities
[i
];
7411 if (detect_info
.found
& (1 << category
))
7413 id
= coding_categories
[category
].id
;
7414 val
= Fcons (make_number (id
), val
);
7417 detect_info
.found
|= found
;
7420 else if (base_category
== coding_category_utf_16_auto
)
7422 if (detect_coding_utf_16 (&coding
, &detect_info
))
7424 struct coding_system
*this;
7426 if (detect_info
.found
& CATEGORY_MASK_UTF_16_LE
)
7427 this = coding_categories
+ coding_category_utf_16_le
;
7428 else if (detect_info
.found
& CATEGORY_MASK_UTF_16_BE
)
7429 this = coding_categories
+ coding_category_utf_16_be
;
7430 else if (detect_info
.rejected
& CATEGORY_MASK_UTF_16_LE_NOSIG
)
7431 this = coding_categories
+ coding_category_utf_16_be_nosig
;
7433 this = coding_categories
+ coding_category_utf_16_le_nosig
;
7434 val
= Fcons (make_number (this->id
), Qnil
);
7439 detect_info
.found
= 1 << XINT (CODING_ATTR_CATEGORY (attrs
));
7440 val
= Fcons (make_number (coding
.id
), Qnil
);
7443 /* Then, detect eol-format if necessary. */
7445 int normal_eol
= -1, utf_16_be_eol
= -1, utf_16_le_eol
;
7448 if (VECTORP (eol_type
))
7450 if (detect_info
.found
& ~CATEGORY_MASK_UTF_16
)
7451 normal_eol
= detect_eol (coding
.source
, src_bytes
,
7452 coding_category_raw_text
);
7453 if (detect_info
.found
& (CATEGORY_MASK_UTF_16_BE
7454 | CATEGORY_MASK_UTF_16_BE_NOSIG
))
7455 utf_16_be_eol
= detect_eol (coding
.source
, src_bytes
,
7456 coding_category_utf_16_be
);
7457 if (detect_info
.found
& (CATEGORY_MASK_UTF_16_LE
7458 | CATEGORY_MASK_UTF_16_LE_NOSIG
))
7459 utf_16_le_eol
= detect_eol (coding
.source
, src_bytes
,
7460 coding_category_utf_16_le
);
7464 if (EQ (eol_type
, Qunix
))
7465 normal_eol
= utf_16_be_eol
= utf_16_le_eol
= EOL_SEEN_LF
;
7466 else if (EQ (eol_type
, Qdos
))
7467 normal_eol
= utf_16_be_eol
= utf_16_le_eol
= EOL_SEEN_CRLF
;
7469 normal_eol
= utf_16_be_eol
= utf_16_le_eol
= EOL_SEEN_CR
;
7472 for (tail
= val
; CONSP (tail
); tail
= XCDR (tail
))
7474 enum coding_category category
;
7477 id
= XINT (XCAR (tail
));
7478 attrs
= CODING_ID_ATTRS (id
);
7479 category
= XINT (CODING_ATTR_CATEGORY (attrs
));
7480 eol_type
= CODING_ID_EOL_TYPE (id
);
7481 if (VECTORP (eol_type
))
7483 if (category
== coding_category_utf_16_be
7484 || category
== coding_category_utf_16_be_nosig
)
7485 this_eol
= utf_16_be_eol
;
7486 else if (category
== coding_category_utf_16_le
7487 || category
== coding_category_utf_16_le_nosig
)
7488 this_eol
= utf_16_le_eol
;
7490 this_eol
= normal_eol
;
7492 if (this_eol
== EOL_SEEN_LF
)
7493 XSETCAR (tail
, AREF (eol_type
, 0));
7494 else if (this_eol
== EOL_SEEN_CRLF
)
7495 XSETCAR (tail
, AREF (eol_type
, 1));
7496 else if (this_eol
== EOL_SEEN_CR
)
7497 XSETCAR (tail
, AREF (eol_type
, 2));
7499 XSETCAR (tail
, CODING_ID_NAME (id
));
7502 XSETCAR (tail
, CODING_ID_NAME (id
));
7506 return (highest
? XCAR (val
) : val
);
7510 DEFUN ("detect-coding-region", Fdetect_coding_region
, Sdetect_coding_region
,
7512 doc
: /* Detect coding system of the text in the region between START and END.
7513 Return a list of possible coding systems ordered by priority.
7515 If only ASCII characters are found (except for such ISO-2022 control
7516 characters ISO-2022 as ESC), it returns a list of single element
7517 `undecided' or its subsidiary coding system according to a detected
7520 If optional argument HIGHEST is non-nil, return the coding system of
7521 highest priority. */)
7522 (start
, end
, highest
)
7523 Lisp_Object start
, end
, highest
;
7526 int from_byte
, to_byte
;
7528 CHECK_NUMBER_COERCE_MARKER (start
);
7529 CHECK_NUMBER_COERCE_MARKER (end
);
7531 validate_region (&start
, &end
);
7532 from
= XINT (start
), to
= XINT (end
);
7533 from_byte
= CHAR_TO_BYTE (from
);
7534 to_byte
= CHAR_TO_BYTE (to
);
7536 if (from
< GPT
&& to
>= GPT
)
7537 move_gap_both (to
, to_byte
);
7539 return detect_coding_system (BYTE_POS_ADDR (from_byte
),
7540 to
- from
, to_byte
- from_byte
,
7542 !NILP (current_buffer
7543 ->enable_multibyte_characters
),
7547 DEFUN ("detect-coding-string", Fdetect_coding_string
, Sdetect_coding_string
,
7549 doc
: /* Detect coding system of the text in STRING.
7550 Return a list of possible coding systems ordered by priority.
7552 If only ASCII characters are found (except for such ISO-2022 control
7553 characters ISO-2022 as ESC), it returns a list of single element
7554 `undecided' or its subsidiary coding system according to a detected
7557 If optional argument HIGHEST is non-nil, return the coding system of
7558 highest priority. */)
7560 Lisp_Object string
, highest
;
7562 CHECK_STRING (string
);
7564 return detect_coding_system (SDATA (string
),
7565 SCHARS (string
), SBYTES (string
),
7566 !NILP (highest
), STRING_MULTIBYTE (string
),
7572 char_encodable_p (c
, attrs
)
7577 struct charset
*charset
;
7578 Lisp_Object translation_table
;
7580 translation_table
= CODING_ATTR_TRANS_TBL (attrs
);
7581 if (! NILP (translation_table
))
7582 c
= translate_char (translation_table
, c
);
7583 for (tail
= CODING_ATTR_CHARSET_LIST (attrs
);
7584 CONSP (tail
); tail
= XCDR (tail
))
7586 charset
= CHARSET_FROM_ID (XINT (XCAR (tail
)));
7587 if (CHAR_CHARSET_P (c
, charset
))
7590 return (! NILP (tail
));
7594 /* Return a list of coding systems that safely encode the text between
7595 START and END. If EXCLUDE is non-nil, it is a list of coding
7596 systems not to check. The returned list doesn't contain any such
7597 coding systems. In any case, if the text contains only ASCII or is
7598 unibyte, return t. */
7600 DEFUN ("find-coding-systems-region-internal",
7601 Ffind_coding_systems_region_internal
,
7602 Sfind_coding_systems_region_internal
, 2, 3, 0,
7603 doc
: /* Internal use only. */)
7604 (start
, end
, exclude
)
7605 Lisp_Object start
, end
, exclude
;
7607 Lisp_Object coding_attrs_list
, safe_codings
;
7608 EMACS_INT start_byte
, end_byte
;
7609 const unsigned char *p
, *pbeg
, *pend
;
7611 Lisp_Object tail
, elt
;
7613 if (STRINGP (start
))
7615 if (!STRING_MULTIBYTE (start
)
7616 || SCHARS (start
) == SBYTES (start
))
7619 end_byte
= SBYTES (start
);
7623 CHECK_NUMBER_COERCE_MARKER (start
);
7624 CHECK_NUMBER_COERCE_MARKER (end
);
7625 if (XINT (start
) < BEG
|| XINT (end
) > Z
|| XINT (start
) > XINT (end
))
7626 args_out_of_range (start
, end
);
7627 if (NILP (current_buffer
->enable_multibyte_characters
))
7629 start_byte
= CHAR_TO_BYTE (XINT (start
));
7630 end_byte
= CHAR_TO_BYTE (XINT (end
));
7631 if (XINT (end
) - XINT (start
) == end_byte
- start_byte
)
7634 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
7636 if ((GPT
- XINT (start
)) < (XINT (end
) - GPT
))
7637 move_gap_both (XINT (start
), start_byte
);
7639 move_gap_both (XINT (end
), end_byte
);
7643 coding_attrs_list
= Qnil
;
7644 for (tail
= Vcoding_system_list
; CONSP (tail
); tail
= XCDR (tail
))
7646 || NILP (Fmemq (XCAR (tail
), exclude
)))
7650 attrs
= AREF (CODING_SYSTEM_SPEC (XCAR (tail
)), 0);
7651 if (EQ (XCAR (tail
), CODING_ATTR_BASE_NAME (attrs
))
7652 && ! EQ (CODING_ATTR_TYPE (attrs
), Qundecided
))
7654 ASET (attrs
, coding_attr_trans_tbl
,
7655 get_translation_table (attrs
, 1, NULL
));
7656 coding_attrs_list
= Fcons (attrs
, coding_attrs_list
);
7660 if (STRINGP (start
))
7661 p
= pbeg
= SDATA (start
);
7663 p
= pbeg
= BYTE_POS_ADDR (start_byte
);
7664 pend
= p
+ (end_byte
- start_byte
);
7666 while (p
< pend
&& ASCII_BYTE_P (*p
)) p
++;
7667 while (p
< pend
&& ASCII_BYTE_P (*(pend
- 1))) pend
--;
7671 if (ASCII_BYTE_P (*p
))
7675 c
= STRING_CHAR_ADVANCE (p
);
7677 charset_map_loaded
= 0;
7678 for (tail
= coding_attrs_list
; CONSP (tail
);)
7683 else if (char_encodable_p (c
, elt
))
7685 else if (CONSP (XCDR (tail
)))
7687 XSETCAR (tail
, XCAR (XCDR (tail
)));
7688 XSETCDR (tail
, XCDR (XCDR (tail
)));
7692 XSETCAR (tail
, Qnil
);
7696 if (charset_map_loaded
)
7698 EMACS_INT p_offset
= p
- pbeg
, pend_offset
= pend
- pbeg
;
7700 if (STRINGP (start
))
7701 pbeg
= SDATA (start
);
7703 pbeg
= BYTE_POS_ADDR (start_byte
);
7704 p
= pbeg
+ p_offset
;
7705 pend
= pbeg
+ pend_offset
;
7710 safe_codings
= list2 (Qraw_text
, Qno_conversion
);
7711 for (tail
= coding_attrs_list
; CONSP (tail
); tail
= XCDR (tail
))
7712 if (! NILP (XCAR (tail
)))
7713 safe_codings
= Fcons (CODING_ATTR_BASE_NAME (XCAR (tail
)), safe_codings
);
7715 return safe_codings
;
7719 DEFUN ("unencodable-char-position", Funencodable_char_position
,
7720 Sunencodable_char_position
, 3, 5, 0,
7722 Return position of first un-encodable character in a region.
7723 START and END specfiy the region and CODING-SYSTEM specifies the
7724 encoding to check. Return nil if CODING-SYSTEM does encode the region.
7726 If optional 4th argument COUNT is non-nil, it specifies at most how
7727 many un-encodable characters to search. In this case, the value is a
7730 If optional 5th argument STRING is non-nil, it is a string to search
7731 for un-encodable characters. In that case, START and END are indexes
7733 (start
, end
, coding_system
, count
, string
)
7734 Lisp_Object start
, end
, coding_system
, count
, string
;
7737 struct coding_system coding
;
7738 Lisp_Object attrs
, charset_list
, translation_table
;
7739 Lisp_Object positions
;
7741 const unsigned char *p
, *stop
, *pend
;
7742 int ascii_compatible
;
7744 setup_coding_system (Fcheck_coding_system (coding_system
), &coding
);
7745 attrs
= CODING_ID_ATTRS (coding
.id
);
7746 if (EQ (CODING_ATTR_TYPE (attrs
), Qraw_text
))
7748 ascii_compatible
= ! NILP (CODING_ATTR_ASCII_COMPAT (attrs
));
7749 charset_list
= CODING_ATTR_CHARSET_LIST (attrs
);
7750 translation_table
= get_translation_table (attrs
, 1, NULL
);
7754 validate_region (&start
, &end
);
7755 from
= XINT (start
);
7757 if (NILP (current_buffer
->enable_multibyte_characters
)
7758 || (ascii_compatible
7759 && (to
- from
) == (CHAR_TO_BYTE (to
) - (CHAR_TO_BYTE (from
)))))
7761 p
= CHAR_POS_ADDR (from
);
7762 pend
= CHAR_POS_ADDR (to
);
7763 if (from
< GPT
&& to
>= GPT
)
7770 CHECK_STRING (string
);
7771 CHECK_NATNUM (start
);
7773 from
= XINT (start
);
7776 || to
> SCHARS (string
))
7777 args_out_of_range_3 (string
, start
, end
);
7778 if (! STRING_MULTIBYTE (string
))
7780 p
= SDATA (string
) + string_char_to_byte (string
, from
);
7781 stop
= pend
= SDATA (string
) + string_char_to_byte (string
, to
);
7782 if (ascii_compatible
&& (to
- from
) == (pend
- p
))
7790 CHECK_NATNUM (count
);
7799 if (ascii_compatible
)
7800 while (p
< stop
&& ASCII_BYTE_P (*p
))
7810 c
= STRING_CHAR_ADVANCE (p
);
7811 if (! (ASCII_CHAR_P (c
) && ascii_compatible
)
7812 && ! char_charset (translate_char (translation_table
, c
),
7813 charset_list
, NULL
))
7815 positions
= Fcons (make_number (from
), positions
);
7824 return (NILP (count
) ? Fcar (positions
) : Fnreverse (positions
));
7828 DEFUN ("check-coding-systems-region", Fcheck_coding_systems_region
,
7829 Scheck_coding_systems_region
, 3, 3, 0,
7830 doc
: /* Check if the region is encodable by coding systems.
7832 START and END are buffer positions specifying the region.
7833 CODING-SYSTEM-LIST is a list of coding systems to check.
7835 The value is an alist ((CODING-SYSTEM POS0 POS1 ...) ...), where
7836 CODING-SYSTEM is a member of CODING-SYSTEM-LIst and can't encode the
7837 whole region, POS0, POS1, ... are buffer positions where non-encodable
7838 characters are found.
7840 If all coding systems in CODING-SYSTEM-LIST can encode the region, the
7843 START may be a string. In that case, check if the string is
7844 encodable, and the value contains indices to the string instead of
7845 buffer positions. END is ignored. */)
7846 (start
, end
, coding_system_list
)
7847 Lisp_Object start
, end
, coding_system_list
;
7850 EMACS_INT start_byte
, end_byte
;
7852 const unsigned char *p
, *pbeg
, *pend
;
7854 Lisp_Object tail
, elt
, attrs
;
7856 if (STRINGP (start
))
7858 if (!STRING_MULTIBYTE (start
)
7859 && SCHARS (start
) != SBYTES (start
))
7862 end_byte
= SBYTES (start
);
7867 CHECK_NUMBER_COERCE_MARKER (start
);
7868 CHECK_NUMBER_COERCE_MARKER (end
);
7869 if (XINT (start
) < BEG
|| XINT (end
) > Z
|| XINT (start
) > XINT (end
))
7870 args_out_of_range (start
, end
);
7871 if (NILP (current_buffer
->enable_multibyte_characters
))
7873 start_byte
= CHAR_TO_BYTE (XINT (start
));
7874 end_byte
= CHAR_TO_BYTE (XINT (end
));
7875 if (XINT (end
) - XINT (start
) == end_byte
- start_byte
)
7878 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
7880 if ((GPT
- XINT (start
)) < (XINT (end
) - GPT
))
7881 move_gap_both (XINT (start
), start_byte
);
7883 move_gap_both (XINT (end
), end_byte
);
7889 for (tail
= coding_system_list
; CONSP (tail
); tail
= XCDR (tail
))
7892 attrs
= AREF (CODING_SYSTEM_SPEC (elt
), 0);
7893 ASET (attrs
, coding_attr_trans_tbl
,
7894 get_translation_table (attrs
, 1, NULL
));
7895 list
= Fcons (Fcons (elt
, Fcons (attrs
, Qnil
)), list
);
7898 if (STRINGP (start
))
7899 p
= pbeg
= SDATA (start
);
7901 p
= pbeg
= BYTE_POS_ADDR (start_byte
);
7902 pend
= p
+ (end_byte
- start_byte
);
7904 while (p
< pend
&& ASCII_BYTE_P (*p
)) p
++, pos
++;
7905 while (p
< pend
&& ASCII_BYTE_P (*(pend
- 1))) pend
--;
7909 if (ASCII_BYTE_P (*p
))
7913 c
= STRING_CHAR_ADVANCE (p
);
7915 charset_map_loaded
= 0;
7916 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
7918 elt
= XCDR (XCAR (tail
));
7919 if (! char_encodable_p (c
, XCAR (elt
)))
7920 XSETCDR (elt
, Fcons (make_number (pos
), XCDR (elt
)));
7922 if (charset_map_loaded
)
7924 EMACS_INT p_offset
= p
- pbeg
, pend_offset
= pend
- pbeg
;
7926 if (STRINGP (start
))
7927 pbeg
= SDATA (start
);
7929 pbeg
= BYTE_POS_ADDR (start_byte
);
7930 p
= pbeg
+ p_offset
;
7931 pend
= pbeg
+ pend_offset
;
7939 for (; CONSP (tail
); tail
= XCDR (tail
))
7942 if (CONSP (XCDR (XCDR (elt
))))
7943 list
= Fcons (Fcons (XCAR (elt
), Fnreverse (XCDR (XCDR (elt
)))),
7952 code_convert_region (start
, end
, coding_system
, dst_object
, encodep
, norecord
)
7953 Lisp_Object start
, end
, coding_system
, dst_object
;
7954 int encodep
, norecord
;
7956 struct coding_system coding
;
7957 EMACS_INT from
, from_byte
, to
, to_byte
;
7958 Lisp_Object src_object
;
7960 CHECK_NUMBER_COERCE_MARKER (start
);
7961 CHECK_NUMBER_COERCE_MARKER (end
);
7962 if (NILP (coding_system
))
7963 coding_system
= Qno_conversion
;
7965 CHECK_CODING_SYSTEM (coding_system
);
7966 src_object
= Fcurrent_buffer ();
7967 if (NILP (dst_object
))
7968 dst_object
= src_object
;
7969 else if (! EQ (dst_object
, Qt
))
7970 CHECK_BUFFER (dst_object
);
7972 validate_region (&start
, &end
);
7973 from
= XFASTINT (start
);
7974 from_byte
= CHAR_TO_BYTE (from
);
7975 to
= XFASTINT (end
);
7976 to_byte
= CHAR_TO_BYTE (to
);
7978 setup_coding_system (coding_system
, &coding
);
7979 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
7982 encode_coding_object (&coding
, src_object
, from
, from_byte
, to
, to_byte
,
7985 decode_coding_object (&coding
, src_object
, from
, from_byte
, to
, to_byte
,
7988 Vlast_coding_system_used
= CODING_ID_NAME (coding
.id
);
7990 return (BUFFERP (dst_object
)
7991 ? make_number (coding
.produced_char
)
7992 : coding
.dst_object
);
7996 DEFUN ("decode-coding-region", Fdecode_coding_region
, Sdecode_coding_region
,
7997 3, 4, "r\nzCoding system: ",
7998 doc
: /* Decode the current region from the specified coding system.
7999 When called from a program, takes four arguments:
8000 START, END, CODING-SYSTEM, and DESTINATION.
8001 START and END are buffer positions.
8003 Optional 4th arguments DESTINATION specifies where the decoded text goes.
8004 If nil, the region between START and END is replace by the decoded text.
8005 If buffer, the decoded text is inserted in the buffer.
8006 If t, the decoded text is returned.
8008 This function sets `last-coding-system-used' to the precise coding system
8009 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
8010 not fully specified.)
8011 It returns the length of the decoded text. */)
8012 (start
, end
, coding_system
, destination
)
8013 Lisp_Object start
, end
, coding_system
, destination
;
8015 return code_convert_region (start
, end
, coding_system
, destination
, 0, 0);
8018 DEFUN ("encode-coding-region", Fencode_coding_region
, Sencode_coding_region
,
8019 3, 4, "r\nzCoding system: ",
8020 doc
: /* Encode the current region by specified coding system.
8021 When called from a program, takes three arguments:
8022 START, END, and CODING-SYSTEM. START and END are buffer positions.
8024 Optional 4th arguments DESTINATION specifies where the encoded text goes.
8025 If nil, the region between START and END is replace by the encoded text.
8026 If buffer, the encoded text is inserted in the buffer.
8027 If t, the encoded text is returned.
8029 This function sets `last-coding-system-used' to the precise coding system
8030 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
8031 not fully specified.)
8032 It returns the length of the encoded text. */)
8033 (start
, end
, coding_system
, destination
)
8034 Lisp_Object start
, end
, coding_system
, destination
;
8036 return code_convert_region (start
, end
, coding_system
, destination
, 1, 0);
8040 code_convert_string (string
, coding_system
, dst_object
,
8041 encodep
, nocopy
, norecord
)
8042 Lisp_Object string
, coding_system
, dst_object
;
8043 int encodep
, nocopy
, norecord
;
8045 struct coding_system coding
;
8046 EMACS_INT chars
, bytes
;
8048 CHECK_STRING (string
);
8049 if (NILP (coding_system
))
8052 Vlast_coding_system_used
= Qno_conversion
;
8053 if (NILP (dst_object
))
8054 return (nocopy
? Fcopy_sequence (string
) : string
);
8057 if (NILP (coding_system
))
8058 coding_system
= Qno_conversion
;
8060 CHECK_CODING_SYSTEM (coding_system
);
8061 if (NILP (dst_object
))
8063 else if (! EQ (dst_object
, Qt
))
8064 CHECK_BUFFER (dst_object
);
8066 setup_coding_system (coding_system
, &coding
);
8067 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
8068 chars
= SCHARS (string
);
8069 bytes
= SBYTES (string
);
8071 encode_coding_object (&coding
, string
, 0, 0, chars
, bytes
, dst_object
);
8073 decode_coding_object (&coding
, string
, 0, 0, chars
, bytes
, dst_object
);
8075 Vlast_coding_system_used
= CODING_ID_NAME (coding
.id
);
8077 return (BUFFERP (dst_object
)
8078 ? make_number (coding
.produced_char
)
8079 : coding
.dst_object
);
8083 /* Encode or decode STRING according to CODING_SYSTEM.
8084 Do not set Vlast_coding_system_used.
8086 This function is called only from macros DECODE_FILE and
8087 ENCODE_FILE, thus we ignore character composition. */
8090 code_convert_string_norecord (string
, coding_system
, encodep
)
8091 Lisp_Object string
, coding_system
;
8094 return code_convert_string (string
, coding_system
, Qt
, encodep
, 0, 1);
8098 DEFUN ("decode-coding-string", Fdecode_coding_string
, Sdecode_coding_string
,
8100 doc
: /* Decode STRING which is encoded in CODING-SYSTEM, and return the result.
8102 Optional third arg NOCOPY non-nil means it is OK to return STRING itself
8103 if the decoding operation is trivial.
8105 Optional fourth arg BUFFER non-nil meant that the decoded text is
8106 inserted in BUFFER instead of returned as a string. In this case,
8107 the return value is BUFFER.
8109 This function sets `last-coding-system-used' to the precise coding system
8110 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
8111 not fully specified. */)
8112 (string
, coding_system
, nocopy
, buffer
)
8113 Lisp_Object string
, coding_system
, nocopy
, buffer
;
8115 return code_convert_string (string
, coding_system
, buffer
,
8116 0, ! NILP (nocopy
), 0);
8119 DEFUN ("encode-coding-string", Fencode_coding_string
, Sencode_coding_string
,
8121 doc
: /* Encode STRING to CODING-SYSTEM, and return the result.
8123 Optional third arg NOCOPY non-nil means it is OK to return STRING
8124 itself if the encoding operation is trivial.
8126 Optional fourth arg BUFFER non-nil meant that the encoded text is
8127 inserted in BUFFER instead of returned as a string. In this case,
8128 the return value is BUFFER.
8130 This function sets `last-coding-system-used' to the precise coding system
8131 used (which may be different from CODING-SYSTEM if CODING-SYSTEM is
8132 not fully specified.) */)
8133 (string
, coding_system
, nocopy
, buffer
)
8134 Lisp_Object string
, coding_system
, nocopy
, buffer
;
8136 return code_convert_string (string
, coding_system
, buffer
,
8137 1, ! NILP (nocopy
), 1);
8141 DEFUN ("decode-sjis-char", Fdecode_sjis_char
, Sdecode_sjis_char
, 1, 1, 0,
8142 doc
: /* Decode a Japanese character which has CODE in shift_jis encoding.
8143 Return the corresponding character. */)
8147 Lisp_Object spec
, attrs
, val
;
8148 struct charset
*charset_roman
, *charset_kanji
, *charset_kana
, *charset
;
8151 CHECK_NATNUM (code
);
8152 c
= XFASTINT (code
);
8153 CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system
, spec
);
8154 attrs
= AREF (spec
, 0);
8156 if (ASCII_BYTE_P (c
)
8157 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs
)))
8160 val
= CODING_ATTR_CHARSET_LIST (attrs
);
8161 charset_roman
= CHARSET_FROM_ID (XINT (XCAR (val
))), val
= XCDR (val
);
8162 charset_kana
= CHARSET_FROM_ID (XINT (XCAR (val
))), val
= XCDR (val
);
8163 charset_kanji
= CHARSET_FROM_ID (XINT (XCAR (val
)));
8166 charset
= charset_roman
;
8167 else if (c
>= 0xA0 && c
< 0xDF)
8169 charset
= charset_kana
;
8174 int s1
= c
>> 8, s2
= c
& 0xFF;
8176 if (s1
< 0x81 || (s1
> 0x9F && s1
< 0xE0) || s1
> 0xEF
8177 || s2
< 0x40 || s2
== 0x7F || s2
> 0xFC)
8178 error ("Invalid code: %d", code
);
8180 charset
= charset_kanji
;
8182 c
= DECODE_CHAR (charset
, c
);
8184 error ("Invalid code: %d", code
);
8185 return make_number (c
);
8189 DEFUN ("encode-sjis-char", Fencode_sjis_char
, Sencode_sjis_char
, 1, 1, 0,
8190 doc
: /* Encode a Japanese character CH to shift_jis encoding.
8191 Return the corresponding code in SJIS. */)
8195 Lisp_Object spec
, attrs
, charset_list
;
8197 struct charset
*charset
;
8200 CHECK_CHARACTER (ch
);
8202 CHECK_CODING_SYSTEM_GET_SPEC (Vsjis_coding_system
, spec
);
8203 attrs
= AREF (spec
, 0);
8205 if (ASCII_CHAR_P (c
)
8206 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs
)))
8209 charset_list
= CODING_ATTR_CHARSET_LIST (attrs
);
8210 charset
= char_charset (c
, charset_list
, &code
);
8211 if (code
== CHARSET_INVALID_CODE (charset
))
8212 error ("Can't encode by shift_jis encoding: %d", c
);
8215 return make_number (code
);
8218 DEFUN ("decode-big5-char", Fdecode_big5_char
, Sdecode_big5_char
, 1, 1, 0,
8219 doc
: /* Decode a Big5 character which has CODE in BIG5 coding system.
8220 Return the corresponding character. */)
8224 Lisp_Object spec
, attrs
, val
;
8225 struct charset
*charset_roman
, *charset_big5
, *charset
;
8228 CHECK_NATNUM (code
);
8229 c
= XFASTINT (code
);
8230 CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system
, spec
);
8231 attrs
= AREF (spec
, 0);
8233 if (ASCII_BYTE_P (c
)
8234 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs
)))
8237 val
= CODING_ATTR_CHARSET_LIST (attrs
);
8238 charset_roman
= CHARSET_FROM_ID (XINT (XCAR (val
))), val
= XCDR (val
);
8239 charset_big5
= CHARSET_FROM_ID (XINT (XCAR (val
)));
8242 charset
= charset_roman
;
8245 int b1
= c
>> 8, b2
= c
& 0x7F;
8246 if (b1
< 0xA1 || b1
> 0xFE
8247 || b2
< 0x40 || (b2
> 0x7E && b2
< 0xA1) || b2
> 0xFE)
8248 error ("Invalid code: %d", code
);
8249 charset
= charset_big5
;
8251 c
= DECODE_CHAR (charset
, (unsigned )c
);
8253 error ("Invalid code: %d", code
);
8254 return make_number (c
);
8257 DEFUN ("encode-big5-char", Fencode_big5_char
, Sencode_big5_char
, 1, 1, 0,
8258 doc
: /* Encode the Big5 character CH to BIG5 coding system.
8259 Return the corresponding character code in Big5. */)
8263 Lisp_Object spec
, attrs
, charset_list
;
8264 struct charset
*charset
;
8268 CHECK_CHARACTER (ch
);
8270 CHECK_CODING_SYSTEM_GET_SPEC (Vbig5_coding_system
, spec
);
8271 attrs
= AREF (spec
, 0);
8272 if (ASCII_CHAR_P (c
)
8273 && ! NILP (CODING_ATTR_ASCII_COMPAT (attrs
)))
8276 charset_list
= CODING_ATTR_CHARSET_LIST (attrs
);
8277 charset
= char_charset (c
, charset_list
, &code
);
8278 if (code
== CHARSET_INVALID_CODE (charset
))
8279 error ("Can't encode by Big5 encoding: %d", c
);
8281 return make_number (code
);
8285 DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_internal
,
8286 Sset_terminal_coding_system_internal
, 1, 2, 0,
8287 doc
: /* Internal use only. */)
8288 (coding_system
, terminal
)
8289 Lisp_Object coding_system
;
8290 Lisp_Object terminal
;
8292 struct coding_system
*terminal_coding
= TERMINAL_TERMINAL_CODING (get_terminal (terminal
, 1));
8293 CHECK_SYMBOL (coding_system
);
8294 setup_coding_system (Fcheck_coding_system (coding_system
), terminal_coding
);
8295 /* We had better not send unsafe characters to terminal. */
8296 terminal_coding
->mode
|= CODING_MODE_SAFE_ENCODING
;
8297 /* Characer composition should be disabled. */
8298 terminal_coding
->common_flags
&= ~CODING_ANNOTATE_COMPOSITION_MASK
;
8299 terminal_coding
->src_multibyte
= 1;
8300 terminal_coding
->dst_multibyte
= 0;
8304 DEFUN ("set-safe-terminal-coding-system-internal",
8305 Fset_safe_terminal_coding_system_internal
,
8306 Sset_safe_terminal_coding_system_internal
, 1, 1, 0,
8307 doc
: /* Internal use only. */)
8309 Lisp_Object coding_system
;
8311 CHECK_SYMBOL (coding_system
);
8312 setup_coding_system (Fcheck_coding_system (coding_system
),
8313 &safe_terminal_coding
);
8314 /* Characer composition should be disabled. */
8315 safe_terminal_coding
.common_flags
&= ~CODING_ANNOTATE_COMPOSITION_MASK
;
8316 safe_terminal_coding
.src_multibyte
= 1;
8317 safe_terminal_coding
.dst_multibyte
= 0;
8321 DEFUN ("terminal-coding-system", Fterminal_coding_system
,
8322 Sterminal_coding_system
, 0, 1, 0,
8323 doc
: /* Return coding system specified for terminal output on the given terminal.
8324 TERMINAL may be a terminal id, a frame, or nil for the selected
8325 frame's terminal device. */)
8327 Lisp_Object terminal
;
8329 struct coding_system
*terminal_coding
8330 = TERMINAL_TERMINAL_CODING (get_terminal (terminal
, 1));
8331 Lisp_Object coding_system
= CODING_ID_NAME (terminal_coding
->id
);
8333 /* For backward compatibility, return nil if it is `undecided'. */
8334 return (! EQ (coding_system
, Qundecided
) ? coding_system
: Qnil
);
8337 DEFUN ("set-keyboard-coding-system-internal", Fset_keyboard_coding_system_internal
,
8338 Sset_keyboard_coding_system_internal
, 1, 2, 0,
8339 doc
: /* Internal use only. */)
8340 (coding_system
, terminal
)
8341 Lisp_Object coding_system
;
8342 Lisp_Object terminal
;
8344 struct terminal
*t
= get_terminal (terminal
, 1);
8345 CHECK_SYMBOL (coding_system
);
8346 setup_coding_system (Fcheck_coding_system (coding_system
),
8347 TERMINAL_KEYBOARD_CODING (t
));
8348 /* Characer composition should be disabled. */
8349 TERMINAL_KEYBOARD_CODING (t
)->common_flags
8350 &= ~CODING_ANNOTATE_COMPOSITION_MASK
;
8354 DEFUN ("keyboard-coding-system",
8355 Fkeyboard_coding_system
, Skeyboard_coding_system
, 0, 1, 0,
8356 doc
: /* Return coding system specified for decoding keyboard input. */)
8358 Lisp_Object terminal
;
8360 return CODING_ID_NAME (TERMINAL_KEYBOARD_CODING
8361 (get_terminal (terminal
, 1))->id
);
8365 DEFUN ("find-operation-coding-system", Ffind_operation_coding_system
,
8366 Sfind_operation_coding_system
, 1, MANY
, 0,
8367 doc
: /* Choose a coding system for an operation based on the target name.
8368 The value names a pair of coding systems: (DECODING-SYSTEM . ENCODING-SYSTEM).
8369 DECODING-SYSTEM is the coding system to use for decoding
8370 \(in case OPERATION does decoding), and ENCODING-SYSTEM is the coding system
8371 for encoding (in case OPERATION does encoding).
8373 The first argument OPERATION specifies an I/O primitive:
8374 For file I/O, `insert-file-contents' or `write-region'.
8375 For process I/O, `call-process', `call-process-region', or `start-process'.
8376 For network I/O, `open-network-stream'.
8378 The remaining arguments should be the same arguments that were passed
8379 to the primitive. Depending on which primitive, one of those arguments
8380 is selected as the TARGET. For example, if OPERATION does file I/O,
8381 whichever argument specifies the file name is TARGET.
8383 TARGET has a meaning which depends on OPERATION:
8384 For file I/O, TARGET is a file name (except for the special case below).
8385 For process I/O, TARGET is a process name.
8386 For network I/O, TARGET is a service name or a port number
8388 This function looks up what specified for TARGET in,
8389 `file-coding-system-alist', `process-coding-system-alist',
8390 or `network-coding-system-alist' depending on OPERATION.
8391 They may specify a coding system, a cons of coding systems,
8392 or a function symbol to call.
8393 In the last case, we call the function with one argument,
8394 which is a list of all the arguments given to this function.
8395 If the function can't decide a coding system, it can return
8396 `undecided' so that the normal code-detection is performed.
8398 If OPERATION is `insert-file-contents', the argument corresponding to
8399 TARGET may be a cons (FILENAME . BUFFER). In that case, FILENAME is a
8400 file name to look up, and BUFFER is a buffer that contains the file's
8401 contents (not yet decoded). If `file-coding-system-alist' specifies a
8402 function to call for FILENAME, that function should examine the
8403 contents of BUFFER instead of reading the file.
8405 usage: (find-operation-coding-system OPERATION ARGUMENTS...) */)
8410 Lisp_Object operation
, target_idx
, target
, val
;
8411 register Lisp_Object chain
;
8414 error ("Too few arguments");
8415 operation
= args
[0];
8416 if (!SYMBOLP (operation
)
8417 || !INTEGERP (target_idx
= Fget (operation
, Qtarget_idx
)))
8418 error ("Invalid first arguement");
8419 if (nargs
< 1 + XINT (target_idx
))
8420 error ("Too few arguments for operation: %s",
8421 SDATA (SYMBOL_NAME (operation
)));
8422 target
= args
[XINT (target_idx
) + 1];
8423 if (!(STRINGP (target
)
8424 || (EQ (operation
, Qinsert_file_contents
) && CONSP (target
)
8425 && STRINGP (XCAR (target
)) && BUFFERP (XCDR (target
)))
8426 || (EQ (operation
, Qopen_network_stream
) && INTEGERP (target
))))
8427 error ("Invalid %dth argument", XINT (target_idx
) + 1);
8429 target
= XCAR (target
);
8431 chain
= ((EQ (operation
, Qinsert_file_contents
)
8432 || EQ (operation
, Qwrite_region
))
8433 ? Vfile_coding_system_alist
8434 : (EQ (operation
, Qopen_network_stream
)
8435 ? Vnetwork_coding_system_alist
8436 : Vprocess_coding_system_alist
));
8440 for (; CONSP (chain
); chain
= XCDR (chain
))
8446 && ((STRINGP (target
)
8447 && STRINGP (XCAR (elt
))
8448 && fast_string_match (XCAR (elt
), target
) >= 0)
8449 || (INTEGERP (target
) && EQ (target
, XCAR (elt
)))))
8452 /* Here, if VAL is both a valid coding system and a valid
8453 function symbol, we return VAL as a coding system. */
8456 if (! SYMBOLP (val
))
8458 if (! NILP (Fcoding_system_p (val
)))
8459 return Fcons (val
, val
);
8460 if (! NILP (Ffboundp (val
)))
8462 /* We use call1 rather than safe_call1
8463 so as to get bug reports about functions called here
8464 which don't handle the current interface. */
8465 val
= call1 (val
, Flist (nargs
, args
));
8468 if (SYMBOLP (val
) && ! NILP (Fcoding_system_p (val
)))
8469 return Fcons (val
, val
);
8477 DEFUN ("set-coding-system-priority", Fset_coding_system_priority
,
8478 Sset_coding_system_priority
, 0, MANY
, 0,
8479 doc
: /* Assign higher priority to the coding systems given as arguments.
8480 If multiple coding systems belongs to the same category,
8481 all but the first one are ignored.
8483 usage: (set-coding-system-priority ...) */)
8489 int changed
[coding_category_max
];
8490 enum coding_category priorities
[coding_category_max
];
8492 bzero (changed
, sizeof changed
);
8494 for (i
= j
= 0; i
< nargs
; i
++)
8496 enum coding_category category
;
8497 Lisp_Object spec
, attrs
;
8499 CHECK_CODING_SYSTEM_GET_SPEC (args
[i
], spec
);
8500 attrs
= AREF (spec
, 0);
8501 category
= XINT (CODING_ATTR_CATEGORY (attrs
));
8502 if (changed
[category
])
8503 /* Ignore this coding system because a coding system of the
8504 same category already had a higher priority. */
8506 changed
[category
] = 1;
8507 priorities
[j
++] = category
;
8508 if (coding_categories
[category
].id
>= 0
8509 && ! EQ (args
[i
], CODING_ID_NAME (coding_categories
[category
].id
)))
8510 setup_coding_system (args
[i
], &coding_categories
[category
]);
8511 Fset (AREF (Vcoding_category_table
, category
), args
[i
]);
8514 /* Now we have decided top J priorities. Reflect the order of the
8515 original priorities to the remaining priorities. */
8517 for (i
= j
, j
= 0; i
< coding_category_max
; i
++, j
++)
8519 while (j
< coding_category_max
8520 && changed
[coding_priorities
[j
]])
8522 if (j
== coding_category_max
)
8524 priorities
[i
] = coding_priorities
[j
];
8527 bcopy (priorities
, coding_priorities
, sizeof priorities
);
8529 /* Update `coding-category-list'. */
8530 Vcoding_category_list
= Qnil
;
8531 for (i
= coding_category_max
- 1; i
>= 0; i
--)
8532 Vcoding_category_list
8533 = Fcons (AREF (Vcoding_category_table
, priorities
[i
]),
8534 Vcoding_category_list
);
8539 DEFUN ("coding-system-priority-list", Fcoding_system_priority_list
,
8540 Scoding_system_priority_list
, 0, 1, 0,
8541 doc
: /* Return a list of coding systems ordered by their priorities.
8542 HIGHESTP non-nil means just return the highest priority one. */)
8544 Lisp_Object highestp
;
8549 for (i
= 0, val
= Qnil
; i
< coding_category_max
; i
++)
8551 enum coding_category category
= coding_priorities
[i
];
8552 int id
= coding_categories
[category
].id
;
8557 attrs
= CODING_ID_ATTRS (id
);
8558 if (! NILP (highestp
))
8559 return CODING_ATTR_BASE_NAME (attrs
);
8560 val
= Fcons (CODING_ATTR_BASE_NAME (attrs
), val
);
8562 return Fnreverse (val
);
8565 static char *suffixes
[] = { "-unix", "-dos", "-mac" };
8568 make_subsidiaries (base
)
8571 Lisp_Object subsidiaries
;
8572 int base_name_len
= SBYTES (SYMBOL_NAME (base
));
8573 char *buf
= (char *) alloca (base_name_len
+ 6);
8576 bcopy (SDATA (SYMBOL_NAME (base
)), buf
, base_name_len
);
8577 subsidiaries
= Fmake_vector (make_number (3), Qnil
);
8578 for (i
= 0; i
< 3; i
++)
8580 bcopy (suffixes
[i
], buf
+ base_name_len
, strlen (suffixes
[i
]) + 1);
8581 ASET (subsidiaries
, i
, intern (buf
));
8583 return subsidiaries
;
8587 DEFUN ("define-coding-system-internal", Fdefine_coding_system_internal
,
8588 Sdefine_coding_system_internal
, coding_arg_max
, MANY
, 0,
8589 doc
: /* For internal use only.
8590 usage: (define-coding-system-internal ...) */)
8596 Lisp_Object spec_vec
; /* [ ATTRS ALIASE EOL_TYPE ] */
8597 Lisp_Object attrs
; /* Vector of attributes. */
8598 Lisp_Object eol_type
;
8599 Lisp_Object aliases
;
8600 Lisp_Object coding_type
, charset_list
, safe_charsets
;
8601 enum coding_category category
;
8602 Lisp_Object tail
, val
;
8603 int max_charset_id
= 0;
8606 if (nargs
< coding_arg_max
)
8609 attrs
= Fmake_vector (make_number (coding_attr_last_index
), Qnil
);
8611 name
= args
[coding_arg_name
];
8612 CHECK_SYMBOL (name
);
8613 CODING_ATTR_BASE_NAME (attrs
) = name
;
8615 val
= args
[coding_arg_mnemonic
];
8616 if (! STRINGP (val
))
8617 CHECK_CHARACTER (val
);
8618 CODING_ATTR_MNEMONIC (attrs
) = val
;
8620 coding_type
= args
[coding_arg_coding_type
];
8621 CHECK_SYMBOL (coding_type
);
8622 CODING_ATTR_TYPE (attrs
) = coding_type
;
8624 charset_list
= args
[coding_arg_charset_list
];
8625 if (SYMBOLP (charset_list
))
8627 if (EQ (charset_list
, Qiso_2022
))
8629 if (! EQ (coding_type
, Qiso_2022
))
8630 error ("Invalid charset-list");
8631 charset_list
= Viso_2022_charset_list
;
8633 else if (EQ (charset_list
, Qemacs_mule
))
8635 if (! EQ (coding_type
, Qemacs_mule
))
8636 error ("Invalid charset-list");
8637 charset_list
= Vemacs_mule_charset_list
;
8639 for (tail
= charset_list
; CONSP (tail
); tail
= XCDR (tail
))
8640 if (max_charset_id
< XFASTINT (XCAR (tail
)))
8641 max_charset_id
= XFASTINT (XCAR (tail
));
8645 charset_list
= Fcopy_sequence (charset_list
);
8646 for (tail
= charset_list
; CONSP (tail
); tail
= XCDR (tail
))
8648 struct charset
*charset
;
8651 CHECK_CHARSET_GET_CHARSET (val
, charset
);
8652 if (EQ (coding_type
, Qiso_2022
)
8653 ? CHARSET_ISO_FINAL (charset
) < 0
8654 : EQ (coding_type
, Qemacs_mule
)
8655 ? CHARSET_EMACS_MULE_ID (charset
) < 0
8657 error ("Can't handle charset `%s'",
8658 SDATA (SYMBOL_NAME (CHARSET_NAME (charset
))));
8660 XSETCAR (tail
, make_number (charset
->id
));
8661 if (max_charset_id
< charset
->id
)
8662 max_charset_id
= charset
->id
;
8665 CODING_ATTR_CHARSET_LIST (attrs
) = charset_list
;
8667 safe_charsets
= Fmake_string (make_number (max_charset_id
+ 1),
8669 for (tail
= charset_list
; CONSP (tail
); tail
= XCDR (tail
))
8670 SSET (safe_charsets
, XFASTINT (XCAR (tail
)), 0);
8671 CODING_ATTR_SAFE_CHARSETS (attrs
) = safe_charsets
;
8673 CODING_ATTR_ASCII_COMPAT (attrs
) = args
[coding_arg_ascii_compatible_p
];
8675 val
= args
[coding_arg_decode_translation_table
];
8676 if (! CHAR_TABLE_P (val
) && ! CONSP (val
))
8678 CODING_ATTR_DECODE_TBL (attrs
) = val
;
8680 val
= args
[coding_arg_encode_translation_table
];
8681 if (! CHAR_TABLE_P (val
) && ! CONSP (val
))
8683 CODING_ATTR_ENCODE_TBL (attrs
) = val
;
8685 val
= args
[coding_arg_post_read_conversion
];
8687 CODING_ATTR_POST_READ (attrs
) = val
;
8689 val
= args
[coding_arg_pre_write_conversion
];
8691 CODING_ATTR_PRE_WRITE (attrs
) = val
;
8693 val
= args
[coding_arg_default_char
];
8695 CODING_ATTR_DEFAULT_CHAR (attrs
) = make_number (' ');
8698 CHECK_CHARACTER (val
);
8699 CODING_ATTR_DEFAULT_CHAR (attrs
) = val
;
8702 val
= args
[coding_arg_for_unibyte
];
8703 CODING_ATTR_FOR_UNIBYTE (attrs
) = NILP (val
) ? Qnil
: Qt
;
8705 val
= args
[coding_arg_plist
];
8707 CODING_ATTR_PLIST (attrs
) = val
;
8709 if (EQ (coding_type
, Qcharset
))
8711 /* Generate a lisp vector of 256 elements. Each element is nil,
8712 integer, or a list of charset IDs.
8714 If Nth element is nil, the byte code N is invalid in this
8717 If Nth element is a number NUM, N is the first byte of a
8718 charset whose ID is NUM.
8720 If Nth element is a list of charset IDs, N is the first byte
8721 of one of them. The list is sorted by dimensions of the
8722 charsets. A charset of smaller dimension comes firtst. */
8723 val
= Fmake_vector (make_number (256), Qnil
);
8725 for (tail
= charset_list
; CONSP (tail
); tail
= XCDR (tail
))
8727 struct charset
*charset
= CHARSET_FROM_ID (XFASTINT (XCAR (tail
)));
8728 int dim
= CHARSET_DIMENSION (charset
);
8729 int idx
= (dim
- 1) * 4;
8731 if (CHARSET_ASCII_COMPATIBLE_P (charset
))
8732 CODING_ATTR_ASCII_COMPAT (attrs
) = Qt
;
8734 for (i
= charset
->code_space
[idx
];
8735 i
<= charset
->code_space
[idx
+ 1]; i
++)
8737 Lisp_Object tmp
, tmp2
;
8740 tmp
= AREF (val
, i
);
8743 else if (NUMBERP (tmp
))
8745 dim2
= CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (tmp
)));
8747 tmp
= Fcons (XCAR (tail
), Fcons (tmp
, Qnil
));
8749 tmp
= Fcons (tmp
, Fcons (XCAR (tail
), Qnil
));
8753 for (tmp2
= tmp
; CONSP (tmp2
); tmp2
= XCDR (tmp2
))
8755 dim2
= CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (XCAR (tmp2
))));
8760 tmp
= nconc2 (tmp
, Fcons (XCAR (tail
), Qnil
));
8763 XSETCDR (tmp2
, Fcons (XCAR (tmp2
), XCDR (tmp2
)));
8764 XSETCAR (tmp2
, XCAR (tail
));
8770 ASET (attrs
, coding_attr_charset_valids
, val
);
8771 category
= coding_category_charset
;
8773 else if (EQ (coding_type
, Qccl
))
8777 if (nargs
< coding_arg_ccl_max
)
8780 val
= args
[coding_arg_ccl_decoder
];
8781 CHECK_CCL_PROGRAM (val
);
8783 val
= Fcopy_sequence (val
);
8784 ASET (attrs
, coding_attr_ccl_decoder
, val
);
8786 val
= args
[coding_arg_ccl_encoder
];
8787 CHECK_CCL_PROGRAM (val
);
8789 val
= Fcopy_sequence (val
);
8790 ASET (attrs
, coding_attr_ccl_encoder
, val
);
8792 val
= args
[coding_arg_ccl_valids
];
8793 valids
= Fmake_string (make_number (256), make_number (0));
8794 for (tail
= val
; !NILP (tail
); tail
= Fcdr (tail
))
8801 from
= to
= XINT (val
);
8802 if (from
< 0 || from
> 255)
8803 args_out_of_range_3 (val
, make_number (0), make_number (255));
8808 CHECK_NATNUM_CAR (val
);
8809 CHECK_NATNUM_CDR (val
);
8810 from
= XINT (XCAR (val
));
8812 args_out_of_range_3 (XCAR (val
),
8813 make_number (0), make_number (255));
8814 to
= XINT (XCDR (val
));
8815 if (to
< from
|| to
> 255)
8816 args_out_of_range_3 (XCDR (val
),
8817 XCAR (val
), make_number (255));
8819 for (i
= from
; i
<= to
; i
++)
8820 SSET (valids
, i
, 1);
8822 ASET (attrs
, coding_attr_ccl_valids
, valids
);
8824 category
= coding_category_ccl
;
8826 else if (EQ (coding_type
, Qutf_16
))
8828 Lisp_Object bom
, endian
;
8830 CODING_ATTR_ASCII_COMPAT (attrs
) = Qnil
;
8832 if (nargs
< coding_arg_utf16_max
)
8835 bom
= args
[coding_arg_utf16_bom
];
8836 if (! NILP (bom
) && ! EQ (bom
, Qt
))
8840 CHECK_CODING_SYSTEM (val
);
8842 CHECK_CODING_SYSTEM (val
);
8844 ASET (attrs
, coding_attr_utf_16_bom
, bom
);
8846 endian
= args
[coding_arg_utf16_endian
];
8847 CHECK_SYMBOL (endian
);
8850 else if (! EQ (endian
, Qbig
) && ! EQ (endian
, Qlittle
))
8851 error ("Invalid endian: %s", SDATA (SYMBOL_NAME (endian
)));
8852 ASET (attrs
, coding_attr_utf_16_endian
, endian
);
8854 category
= (CONSP (bom
)
8855 ? coding_category_utf_16_auto
8857 ? (EQ (endian
, Qbig
)
8858 ? coding_category_utf_16_be_nosig
8859 : coding_category_utf_16_le_nosig
)
8860 : (EQ (endian
, Qbig
)
8861 ? coding_category_utf_16_be
8862 : coding_category_utf_16_le
));
8864 else if (EQ (coding_type
, Qiso_2022
))
8866 Lisp_Object initial
, reg_usage
, request
, flags
;
8869 if (nargs
< coding_arg_iso2022_max
)
8872 initial
= Fcopy_sequence (args
[coding_arg_iso2022_initial
]);
8873 CHECK_VECTOR (initial
);
8874 for (i
= 0; i
< 4; i
++)
8876 val
= Faref (initial
, make_number (i
));
8879 struct charset
*charset
;
8881 CHECK_CHARSET_GET_CHARSET (val
, charset
);
8882 ASET (initial
, i
, make_number (CHARSET_ID (charset
)));
8883 if (i
== 0 && CHARSET_ASCII_COMPATIBLE_P (charset
))
8884 CODING_ATTR_ASCII_COMPAT (attrs
) = Qt
;
8887 ASET (initial
, i
, make_number (-1));
8890 reg_usage
= args
[coding_arg_iso2022_reg_usage
];
8891 CHECK_CONS (reg_usage
);
8892 CHECK_NUMBER_CAR (reg_usage
);
8893 CHECK_NUMBER_CDR (reg_usage
);
8895 request
= Fcopy_sequence (args
[coding_arg_iso2022_request
]);
8896 for (tail
= request
; ! NILP (tail
); tail
= Fcdr (tail
))
8904 CHECK_CHARSET_GET_ID (tmp
, id
);
8905 CHECK_NATNUM_CDR (val
);
8906 if (XINT (XCDR (val
)) >= 4)
8907 error ("Invalid graphic register number: %d", XINT (XCDR (val
)));
8908 XSETCAR (val
, make_number (id
));
8911 flags
= args
[coding_arg_iso2022_flags
];
8912 CHECK_NATNUM (flags
);
8914 if (EQ (args
[coding_arg_charset_list
], Qiso_2022
))
8915 flags
= make_number (i
| CODING_ISO_FLAG_FULL_SUPPORT
);
8917 ASET (attrs
, coding_attr_iso_initial
, initial
);
8918 ASET (attrs
, coding_attr_iso_usage
, reg_usage
);
8919 ASET (attrs
, coding_attr_iso_request
, request
);
8920 ASET (attrs
, coding_attr_iso_flags
, flags
);
8921 setup_iso_safe_charsets (attrs
);
8923 if (i
& CODING_ISO_FLAG_SEVEN_BITS
)
8924 category
= ((i
& (CODING_ISO_FLAG_LOCKING_SHIFT
8925 | CODING_ISO_FLAG_SINGLE_SHIFT
))
8926 ? coding_category_iso_7_else
8927 : EQ (args
[coding_arg_charset_list
], Qiso_2022
)
8928 ? coding_category_iso_7
8929 : coding_category_iso_7_tight
);
8932 int id
= XINT (AREF (initial
, 1));
8934 category
= (((i
& CODING_ISO_FLAG_LOCKING_SHIFT
)
8935 || EQ (args
[coding_arg_charset_list
], Qiso_2022
)
8937 ? coding_category_iso_8_else
8938 : (CHARSET_DIMENSION (CHARSET_FROM_ID (id
)) == 1)
8939 ? coding_category_iso_8_1
8940 : coding_category_iso_8_2
);
8942 if (category
!= coding_category_iso_8_1
8943 && category
!= coding_category_iso_8_2
)
8944 CODING_ATTR_ASCII_COMPAT (attrs
) = Qnil
;
8946 else if (EQ (coding_type
, Qemacs_mule
))
8948 if (EQ (args
[coding_arg_charset_list
], Qemacs_mule
))
8949 ASET (attrs
, coding_attr_emacs_mule_full
, Qt
);
8950 CODING_ATTR_ASCII_COMPAT (attrs
) = Qt
;
8951 category
= coding_category_emacs_mule
;
8953 else if (EQ (coding_type
, Qshift_jis
))
8956 struct charset
*charset
;
8958 if (XINT (Flength (charset_list
)) != 3
8959 && XINT (Flength (charset_list
)) != 4)
8960 error ("There should be three or four charsets");
8962 charset
= CHARSET_FROM_ID (XINT (XCAR (charset_list
)));
8963 if (CHARSET_DIMENSION (charset
) != 1)
8964 error ("Dimension of charset %s is not one",
8965 SDATA (SYMBOL_NAME (CHARSET_NAME (charset
))));
8966 if (CHARSET_ASCII_COMPATIBLE_P (charset
))
8967 CODING_ATTR_ASCII_COMPAT (attrs
) = Qt
;
8969 charset_list
= XCDR (charset_list
);
8970 charset
= CHARSET_FROM_ID (XINT (XCAR (charset_list
)));
8971 if (CHARSET_DIMENSION (charset
) != 1)
8972 error ("Dimension of charset %s is not one",
8973 SDATA (SYMBOL_NAME (CHARSET_NAME (charset
))));
8975 charset_list
= XCDR (charset_list
);
8976 charset
= CHARSET_FROM_ID (XINT (XCAR (charset_list
)));
8977 if (CHARSET_DIMENSION (charset
) != 2)
8978 error ("Dimension of charset %s is not two",
8979 SDATA (SYMBOL_NAME (CHARSET_NAME (charset
))));
8981 charset_list
= XCDR (charset_list
);
8982 if (! NILP (charset_list
))
8984 charset
= CHARSET_FROM_ID (XINT (XCAR (charset_list
)));
8985 if (CHARSET_DIMENSION (charset
) != 2)
8986 error ("Dimension of charset %s is not two",
8987 SDATA (SYMBOL_NAME (CHARSET_NAME (charset
))));
8990 category
= coding_category_sjis
;
8991 Vsjis_coding_system
= name
;
8993 else if (EQ (coding_type
, Qbig5
))
8995 struct charset
*charset
;
8997 if (XINT (Flength (charset_list
)) != 2)
8998 error ("There should be just two charsets");
9000 charset
= CHARSET_FROM_ID (XINT (XCAR (charset_list
)));
9001 if (CHARSET_DIMENSION (charset
) != 1)
9002 error ("Dimension of charset %s is not one",
9003 SDATA (SYMBOL_NAME (CHARSET_NAME (charset
))));
9004 if (CHARSET_ASCII_COMPATIBLE_P (charset
))
9005 CODING_ATTR_ASCII_COMPAT (attrs
) = Qt
;
9007 charset_list
= XCDR (charset_list
);
9008 charset
= CHARSET_FROM_ID (XINT (XCAR (charset_list
)));
9009 if (CHARSET_DIMENSION (charset
) != 2)
9010 error ("Dimension of charset %s is not two",
9011 SDATA (SYMBOL_NAME (CHARSET_NAME (charset
))));
9013 category
= coding_category_big5
;
9014 Vbig5_coding_system
= name
;
9016 else if (EQ (coding_type
, Qraw_text
))
9018 category
= coding_category_raw_text
;
9019 CODING_ATTR_ASCII_COMPAT (attrs
) = Qt
;
9021 else if (EQ (coding_type
, Qutf_8
))
9023 category
= coding_category_utf_8
;
9024 CODING_ATTR_ASCII_COMPAT (attrs
) = Qt
;
9026 else if (EQ (coding_type
, Qundecided
))
9027 category
= coding_category_undecided
;
9029 error ("Invalid coding system type: %s",
9030 SDATA (SYMBOL_NAME (coding_type
)));
9032 CODING_ATTR_CATEGORY (attrs
) = make_number (category
);
9033 CODING_ATTR_PLIST (attrs
)
9034 = Fcons (QCcategory
, Fcons (AREF (Vcoding_category_table
, category
),
9035 CODING_ATTR_PLIST (attrs
)));
9036 CODING_ATTR_PLIST (attrs
)
9037 = Fcons (QCascii_compatible_p
,
9038 Fcons (CODING_ATTR_ASCII_COMPAT (attrs
),
9039 CODING_ATTR_PLIST (attrs
)));
9041 eol_type
= args
[coding_arg_eol_type
];
9042 if (! NILP (eol_type
)
9043 && ! EQ (eol_type
, Qunix
)
9044 && ! EQ (eol_type
, Qdos
)
9045 && ! EQ (eol_type
, Qmac
))
9046 error ("Invalid eol-type");
9048 aliases
= Fcons (name
, Qnil
);
9050 if (NILP (eol_type
))
9052 eol_type
= make_subsidiaries (name
);
9053 for (i
= 0; i
< 3; i
++)
9055 Lisp_Object this_spec
, this_name
, this_aliases
, this_eol_type
;
9057 this_name
= AREF (eol_type
, i
);
9058 this_aliases
= Fcons (this_name
, Qnil
);
9059 this_eol_type
= (i
== 0 ? Qunix
: i
== 1 ? Qdos
: Qmac
);
9060 this_spec
= Fmake_vector (make_number (3), attrs
);
9061 ASET (this_spec
, 1, this_aliases
);
9062 ASET (this_spec
, 2, this_eol_type
);
9063 Fputhash (this_name
, this_spec
, Vcoding_system_hash_table
);
9064 Vcoding_system_list
= Fcons (this_name
, Vcoding_system_list
);
9065 val
= Fassoc (Fsymbol_name (this_name
), Vcoding_system_alist
);
9067 Vcoding_system_alist
9068 = Fcons (Fcons (Fsymbol_name (this_name
), Qnil
),
9069 Vcoding_system_alist
);
9073 spec_vec
= Fmake_vector (make_number (3), attrs
);
9074 ASET (spec_vec
, 1, aliases
);
9075 ASET (spec_vec
, 2, eol_type
);
9077 Fputhash (name
, spec_vec
, Vcoding_system_hash_table
);
9078 Vcoding_system_list
= Fcons (name
, Vcoding_system_list
);
9079 val
= Fassoc (Fsymbol_name (name
), Vcoding_system_alist
);
9081 Vcoding_system_alist
= Fcons (Fcons (Fsymbol_name (name
), Qnil
),
9082 Vcoding_system_alist
);
9085 int id
= coding_categories
[category
].id
;
9087 if (id
< 0 || EQ (name
, CODING_ID_NAME (id
)))
9088 setup_coding_system (name
, &coding_categories
[category
]);
9094 return Fsignal (Qwrong_number_of_arguments
,
9095 Fcons (intern ("define-coding-system-internal"),
9096 make_number (nargs
)));
9100 DEFUN ("coding-system-put", Fcoding_system_put
, Scoding_system_put
,
9102 doc
: /* Change value in CODING-SYSTEM's property list PROP to VAL. */)
9103 (coding_system
, prop
, val
)
9104 Lisp_Object coding_system
, prop
, val
;
9106 Lisp_Object spec
, attrs
;
9108 CHECK_CODING_SYSTEM_GET_SPEC (coding_system
, spec
);
9109 attrs
= AREF (spec
, 0);
9110 if (EQ (prop
, QCmnemonic
))
9112 if (! STRINGP (val
))
9113 CHECK_CHARACTER (val
);
9114 CODING_ATTR_MNEMONIC (attrs
) = val
;
9116 else if (EQ (prop
, QCdefalut_char
))
9119 val
= make_number (' ');
9121 CHECK_CHARACTER (val
);
9122 CODING_ATTR_DEFAULT_CHAR (attrs
) = val
;
9124 else if (EQ (prop
, QCdecode_translation_table
))
9126 if (! CHAR_TABLE_P (val
) && ! CONSP (val
))
9128 CODING_ATTR_DECODE_TBL (attrs
) = val
;
9130 else if (EQ (prop
, QCencode_translation_table
))
9132 if (! CHAR_TABLE_P (val
) && ! CONSP (val
))
9134 CODING_ATTR_ENCODE_TBL (attrs
) = val
;
9136 else if (EQ (prop
, QCpost_read_conversion
))
9139 CODING_ATTR_POST_READ (attrs
) = val
;
9141 else if (EQ (prop
, QCpre_write_conversion
))
9144 CODING_ATTR_PRE_WRITE (attrs
) = val
;
9146 else if (EQ (prop
, QCascii_compatible_p
))
9148 CODING_ATTR_ASCII_COMPAT (attrs
) = val
;
9151 CODING_ATTR_PLIST (attrs
)
9152 = Fplist_put (CODING_ATTR_PLIST (attrs
), prop
, val
);
9157 DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias
,
9158 Sdefine_coding_system_alias
, 2, 2, 0,
9159 doc
: /* Define ALIAS as an alias for CODING-SYSTEM. */)
9160 (alias
, coding_system
)
9161 Lisp_Object alias
, coding_system
;
9163 Lisp_Object spec
, aliases
, eol_type
, val
;
9165 CHECK_SYMBOL (alias
);
9166 CHECK_CODING_SYSTEM_GET_SPEC (coding_system
, spec
);
9167 aliases
= AREF (spec
, 1);
9168 /* ALISES should be a list of length more than zero, and the first
9169 element is a base coding system. Append ALIAS at the tail of the
9171 while (!NILP (XCDR (aliases
)))
9172 aliases
= XCDR (aliases
);
9173 XSETCDR (aliases
, Fcons (alias
, Qnil
));
9175 eol_type
= AREF (spec
, 2);
9176 if (VECTORP (eol_type
))
9178 Lisp_Object subsidiaries
;
9181 subsidiaries
= make_subsidiaries (alias
);
9182 for (i
= 0; i
< 3; i
++)
9183 Fdefine_coding_system_alias (AREF (subsidiaries
, i
),
9184 AREF (eol_type
, i
));
9187 Fputhash (alias
, spec
, Vcoding_system_hash_table
);
9188 Vcoding_system_list
= Fcons (alias
, Vcoding_system_list
);
9189 val
= Fassoc (Fsymbol_name (alias
), Vcoding_system_alist
);
9191 Vcoding_system_alist
= Fcons (Fcons (Fsymbol_name (alias
), Qnil
),
9192 Vcoding_system_alist
);
9197 DEFUN ("coding-system-base", Fcoding_system_base
, Scoding_system_base
,
9199 doc
: /* Return the base of CODING-SYSTEM.
9200 Any alias or subsidiary coding system is not a base coding system. */)
9202 Lisp_Object coding_system
;
9204 Lisp_Object spec
, attrs
;
9206 if (NILP (coding_system
))
9207 return (Qno_conversion
);
9208 CHECK_CODING_SYSTEM_GET_SPEC (coding_system
, spec
);
9209 attrs
= AREF (spec
, 0);
9210 return CODING_ATTR_BASE_NAME (attrs
);
9213 DEFUN ("coding-system-plist", Fcoding_system_plist
, Scoding_system_plist
,
9215 doc
: "Return the property list of CODING-SYSTEM.")
9217 Lisp_Object coding_system
;
9219 Lisp_Object spec
, attrs
;
9221 if (NILP (coding_system
))
9222 coding_system
= Qno_conversion
;
9223 CHECK_CODING_SYSTEM_GET_SPEC (coding_system
, spec
);
9224 attrs
= AREF (spec
, 0);
9225 return CODING_ATTR_PLIST (attrs
);
9229 DEFUN ("coding-system-aliases", Fcoding_system_aliases
, Scoding_system_aliases
,
9231 doc
: /* Return the list of aliases of CODING-SYSTEM. */)
9233 Lisp_Object coding_system
;
9237 if (NILP (coding_system
))
9238 coding_system
= Qno_conversion
;
9239 CHECK_CODING_SYSTEM_GET_SPEC (coding_system
, spec
);
9240 return AREF (spec
, 1);
9243 DEFUN ("coding-system-eol-type", Fcoding_system_eol_type
,
9244 Scoding_system_eol_type
, 1, 1, 0,
9245 doc
: /* Return eol-type of CODING-SYSTEM.
9246 An eol-type is integer 0, 1, 2, or a vector of coding systems.
9248 Integer values 0, 1, and 2 indicate a format of end-of-line; LF, CRLF,
9249 and CR respectively.
9251 A vector value indicates that a format of end-of-line should be
9252 detected automatically. Nth element of the vector is the subsidiary
9253 coding system whose eol-type is N. */)
9255 Lisp_Object coding_system
;
9257 Lisp_Object spec
, eol_type
;
9260 if (NILP (coding_system
))
9261 coding_system
= Qno_conversion
;
9262 if (! CODING_SYSTEM_P (coding_system
))
9264 spec
= CODING_SYSTEM_SPEC (coding_system
);
9265 eol_type
= AREF (spec
, 2);
9266 if (VECTORP (eol_type
))
9267 return Fcopy_sequence (eol_type
);
9268 n
= EQ (eol_type
, Qunix
) ? 0 : EQ (eol_type
, Qdos
) ? 1 : 2;
9269 return make_number (n
);
9275 /*** 9. Post-amble ***/
9282 for (i
= 0; i
< coding_category_max
; i
++)
9284 coding_categories
[i
].id
= -1;
9285 coding_priorities
[i
] = i
;
9288 /* ISO2022 specific initialize routine. */
9289 for (i
= 0; i
< 0x20; i
++)
9290 iso_code_class
[i
] = ISO_control_0
;
9291 for (i
= 0x21; i
< 0x7F; i
++)
9292 iso_code_class
[i
] = ISO_graphic_plane_0
;
9293 for (i
= 0x80; i
< 0xA0; i
++)
9294 iso_code_class
[i
] = ISO_control_1
;
9295 for (i
= 0xA1; i
< 0xFF; i
++)
9296 iso_code_class
[i
] = ISO_graphic_plane_1
;
9297 iso_code_class
[0x20] = iso_code_class
[0x7F] = ISO_0x20_or_0x7F
;
9298 iso_code_class
[0xA0] = iso_code_class
[0xFF] = ISO_0xA0_or_0xFF
;
9299 iso_code_class
[ISO_CODE_SO
] = ISO_shift_out
;
9300 iso_code_class
[ISO_CODE_SI
] = ISO_shift_in
;
9301 iso_code_class
[ISO_CODE_SS2_7
] = ISO_single_shift_2_7
;
9302 iso_code_class
[ISO_CODE_ESC
] = ISO_escape
;
9303 iso_code_class
[ISO_CODE_SS2
] = ISO_single_shift_2
;
9304 iso_code_class
[ISO_CODE_SS3
] = ISO_single_shift_3
;
9305 iso_code_class
[ISO_CODE_CSI
] = ISO_control_sequence_introducer
;
9307 for (i
= 0; i
< 256; i
++)
9309 emacs_mule_bytes
[i
] = 1;
9311 emacs_mule_bytes
[EMACS_MULE_LEADING_CODE_PRIVATE_11
] = 3;
9312 emacs_mule_bytes
[EMACS_MULE_LEADING_CODE_PRIVATE_12
] = 3;
9313 emacs_mule_bytes
[EMACS_MULE_LEADING_CODE_PRIVATE_21
] = 4;
9314 emacs_mule_bytes
[EMACS_MULE_LEADING_CODE_PRIVATE_22
] = 4;
9322 staticpro (&Vcoding_system_hash_table
);
9324 Lisp_Object args
[2];
9327 Vcoding_system_hash_table
= Fmake_hash_table (2, args
);
9330 staticpro (&Vsjis_coding_system
);
9331 Vsjis_coding_system
= Qnil
;
9333 staticpro (&Vbig5_coding_system
);
9334 Vbig5_coding_system
= Qnil
;
9336 staticpro (&Vcode_conversion_reused_workbuf
);
9337 Vcode_conversion_reused_workbuf
= Qnil
;
9339 staticpro (&Vcode_conversion_workbuf_name
);
9340 Vcode_conversion_workbuf_name
= build_string (" *code-conversion-work*");
9342 reused_workbuf_in_use
= 0;
9344 DEFSYM (Qcharset
, "charset");
9345 DEFSYM (Qtarget_idx
, "target-idx");
9346 DEFSYM (Qcoding_system_history
, "coding-system-history");
9347 Fset (Qcoding_system_history
, Qnil
);
9349 /* Target FILENAME is the first argument. */
9350 Fput (Qinsert_file_contents
, Qtarget_idx
, make_number (0));
9351 /* Target FILENAME is the third argument. */
9352 Fput (Qwrite_region
, Qtarget_idx
, make_number (2));
9354 DEFSYM (Qcall_process
, "call-process");
9355 /* Target PROGRAM is the first argument. */
9356 Fput (Qcall_process
, Qtarget_idx
, make_number (0));
9358 DEFSYM (Qcall_process_region
, "call-process-region");
9359 /* Target PROGRAM is the third argument. */
9360 Fput (Qcall_process_region
, Qtarget_idx
, make_number (2));
9362 DEFSYM (Qstart_process
, "start-process");
9363 /* Target PROGRAM is the third argument. */
9364 Fput (Qstart_process
, Qtarget_idx
, make_number (2));
9366 DEFSYM (Qopen_network_stream
, "open-network-stream");
9367 /* Target SERVICE is the fourth argument. */
9368 Fput (Qopen_network_stream
, Qtarget_idx
, make_number (3));
9370 DEFSYM (Qcoding_system
, "coding-system");
9371 DEFSYM (Qcoding_aliases
, "coding-aliases");
9373 DEFSYM (Qeol_type
, "eol-type");
9374 DEFSYM (Qunix
, "unix");
9375 DEFSYM (Qdos
, "dos");
9377 DEFSYM (Qbuffer_file_coding_system
, "buffer-file-coding-system");
9378 DEFSYM (Qpost_read_conversion
, "post-read-conversion");
9379 DEFSYM (Qpre_write_conversion
, "pre-write-conversion");
9380 DEFSYM (Qdefault_char
, "default-char");
9381 DEFSYM (Qundecided
, "undecided");
9382 DEFSYM (Qno_conversion
, "no-conversion");
9383 DEFSYM (Qraw_text
, "raw-text");
9385 DEFSYM (Qiso_2022
, "iso-2022");
9387 DEFSYM (Qutf_8
, "utf-8");
9388 DEFSYM (Qutf_8_emacs
, "utf-8-emacs");
9390 DEFSYM (Qutf_16
, "utf-16");
9391 DEFSYM (Qbig
, "big");
9392 DEFSYM (Qlittle
, "little");
9394 DEFSYM (Qshift_jis
, "shift-jis");
9395 DEFSYM (Qbig5
, "big5");
9397 DEFSYM (Qcoding_system_p
, "coding-system-p");
9399 DEFSYM (Qcoding_system_error
, "coding-system-error");
9400 Fput (Qcoding_system_error
, Qerror_conditions
,
9401 Fcons (Qcoding_system_error
, Fcons (Qerror
, Qnil
)));
9402 Fput (Qcoding_system_error
, Qerror_message
,
9403 build_string ("Invalid coding system"));
9405 /* Intern this now in case it isn't already done.
9406 Setting this variable twice is harmless.
9407 But don't staticpro it here--that is done in alloc.c. */
9408 Qchar_table_extra_slots
= intern ("char-table-extra-slots");
9410 DEFSYM (Qtranslation_table
, "translation-table");
9411 Fput (Qtranslation_table
, Qchar_table_extra_slots
, make_number (2));
9412 DEFSYM (Qtranslation_table_id
, "translation-table-id");
9413 DEFSYM (Qtranslation_table_for_decode
, "translation-table-for-decode");
9414 DEFSYM (Qtranslation_table_for_encode
, "translation-table-for-encode");
9416 DEFSYM (Qvalid_codes
, "valid-codes");
9418 DEFSYM (Qemacs_mule
, "emacs-mule");
9420 DEFSYM (QCcategory
, ":category");
9421 DEFSYM (QCmnemonic
, ":mnemonic");
9422 DEFSYM (QCdefalut_char
, ":default-char");
9423 DEFSYM (QCdecode_translation_table
, ":decode-translation-table");
9424 DEFSYM (QCencode_translation_table
, ":encode-translation-table");
9425 DEFSYM (QCpost_read_conversion
, ":post-read-conversion");
9426 DEFSYM (QCpre_write_conversion
, ":pre-write-conversion");
9427 DEFSYM (QCascii_compatible_p
, ":ascii-compatible-p");
9429 Vcoding_category_table
9430 = Fmake_vector (make_number (coding_category_max
), Qnil
);
9431 staticpro (&Vcoding_category_table
);
9432 /* Followings are target of code detection. */
9433 ASET (Vcoding_category_table
, coding_category_iso_7
,
9434 intern ("coding-category-iso-7"));
9435 ASET (Vcoding_category_table
, coding_category_iso_7_tight
,
9436 intern ("coding-category-iso-7-tight"));
9437 ASET (Vcoding_category_table
, coding_category_iso_8_1
,
9438 intern ("coding-category-iso-8-1"));
9439 ASET (Vcoding_category_table
, coding_category_iso_8_2
,
9440 intern ("coding-category-iso-8-2"));
9441 ASET (Vcoding_category_table
, coding_category_iso_7_else
,
9442 intern ("coding-category-iso-7-else"));
9443 ASET (Vcoding_category_table
, coding_category_iso_8_else
,
9444 intern ("coding-category-iso-8-else"));
9445 ASET (Vcoding_category_table
, coding_category_utf_8
,
9446 intern ("coding-category-utf-8"));
9447 ASET (Vcoding_category_table
, coding_category_utf_16_be
,
9448 intern ("coding-category-utf-16-be"));
9449 ASET (Vcoding_category_table
, coding_category_utf_16_auto
,
9450 intern ("coding-category-utf-16-auto"));
9451 ASET (Vcoding_category_table
, coding_category_utf_16_le
,
9452 intern ("coding-category-utf-16-le"));
9453 ASET (Vcoding_category_table
, coding_category_utf_16_be_nosig
,
9454 intern ("coding-category-utf-16-be-nosig"));
9455 ASET (Vcoding_category_table
, coding_category_utf_16_le_nosig
,
9456 intern ("coding-category-utf-16-le-nosig"));
9457 ASET (Vcoding_category_table
, coding_category_charset
,
9458 intern ("coding-category-charset"));
9459 ASET (Vcoding_category_table
, coding_category_sjis
,
9460 intern ("coding-category-sjis"));
9461 ASET (Vcoding_category_table
, coding_category_big5
,
9462 intern ("coding-category-big5"));
9463 ASET (Vcoding_category_table
, coding_category_ccl
,
9464 intern ("coding-category-ccl"));
9465 ASET (Vcoding_category_table
, coding_category_emacs_mule
,
9466 intern ("coding-category-emacs-mule"));
9467 /* Followings are NOT target of code detection. */
9468 ASET (Vcoding_category_table
, coding_category_raw_text
,
9469 intern ("coding-category-raw-text"));
9470 ASET (Vcoding_category_table
, coding_category_undecided
,
9471 intern ("coding-category-undecided"));
9473 DEFSYM (Qinsufficient_source
, "insufficient-source");
9474 DEFSYM (Qinconsistent_eol
, "inconsistent-eol");
9475 DEFSYM (Qinvalid_source
, "invalid-source");
9476 DEFSYM (Qinterrupted
, "interrupted");
9477 DEFSYM (Qinsufficient_memory
, "insufficient-memory");
9478 DEFSYM (Qcoding_system_define_form
, "coding-system-define-form");
9480 defsubr (&Scoding_system_p
);
9481 defsubr (&Sread_coding_system
);
9482 defsubr (&Sread_non_nil_coding_system
);
9483 defsubr (&Scheck_coding_system
);
9484 defsubr (&Sdetect_coding_region
);
9485 defsubr (&Sdetect_coding_string
);
9486 defsubr (&Sfind_coding_systems_region_internal
);
9487 defsubr (&Sunencodable_char_position
);
9488 defsubr (&Scheck_coding_systems_region
);
9489 defsubr (&Sdecode_coding_region
);
9490 defsubr (&Sencode_coding_region
);
9491 defsubr (&Sdecode_coding_string
);
9492 defsubr (&Sencode_coding_string
);
9493 defsubr (&Sdecode_sjis_char
);
9494 defsubr (&Sencode_sjis_char
);
9495 defsubr (&Sdecode_big5_char
);
9496 defsubr (&Sencode_big5_char
);
9497 defsubr (&Sset_terminal_coding_system_internal
);
9498 defsubr (&Sset_safe_terminal_coding_system_internal
);
9499 defsubr (&Sterminal_coding_system
);
9500 defsubr (&Sset_keyboard_coding_system_internal
);
9501 defsubr (&Skeyboard_coding_system
);
9502 defsubr (&Sfind_operation_coding_system
);
9503 defsubr (&Sset_coding_system_priority
);
9504 defsubr (&Sdefine_coding_system_internal
);
9505 defsubr (&Sdefine_coding_system_alias
);
9506 defsubr (&Scoding_system_put
);
9507 defsubr (&Scoding_system_base
);
9508 defsubr (&Scoding_system_plist
);
9509 defsubr (&Scoding_system_aliases
);
9510 defsubr (&Scoding_system_eol_type
);
9511 defsubr (&Scoding_system_priority_list
);
9513 DEFVAR_LISP ("coding-system-list", &Vcoding_system_list
,
9514 doc
: /* List of coding systems.
9516 Do not alter the value of this variable manually. This variable should be
9517 updated by the functions `define-coding-system' and
9518 `define-coding-system-alias'. */);
9519 Vcoding_system_list
= Qnil
;
9521 DEFVAR_LISP ("coding-system-alist", &Vcoding_system_alist
,
9522 doc
: /* Alist of coding system names.
9523 Each element is one element list of coding system name.
9524 This variable is given to `completing-read' as TABLE argument.
9526 Do not alter the value of this variable manually. This variable should be
9527 updated by the functions `make-coding-system' and
9528 `define-coding-system-alias'. */);
9529 Vcoding_system_alist
= Qnil
;
9531 DEFVAR_LISP ("coding-category-list", &Vcoding_category_list
,
9532 doc
: /* List of coding-categories (symbols) ordered by priority.
9534 On detecting a coding system, Emacs tries code detection algorithms
9535 associated with each coding-category one by one in this order. When
9536 one algorithm agrees with a byte sequence of source text, the coding
9537 system bound to the corresponding coding-category is selected.
9539 Don't modify this variable directly, but use `set-coding-priority'. */);
9543 Vcoding_category_list
= Qnil
;
9544 for (i
= coding_category_max
- 1; i
>= 0; i
--)
9545 Vcoding_category_list
9546 = Fcons (XVECTOR (Vcoding_category_table
)->contents
[i
],
9547 Vcoding_category_list
);
9550 DEFVAR_LISP ("coding-system-for-read", &Vcoding_system_for_read
,
9551 doc
: /* Specify the coding system for read operations.
9552 It is useful to bind this variable with `let', but do not set it globally.
9553 If the value is a coding system, it is used for decoding on read operation.
9554 If not, an appropriate element is used from one of the coding system alists:
9555 There are three such tables, `file-coding-system-alist',
9556 `process-coding-system-alist', and `network-coding-system-alist'. */);
9557 Vcoding_system_for_read
= Qnil
;
9559 DEFVAR_LISP ("coding-system-for-write", &Vcoding_system_for_write
,
9560 doc
: /* Specify the coding system for write operations.
9561 Programs bind this variable with `let', but you should not set it globally.
9562 If the value is a coding system, it is used for encoding of output,
9563 when writing it to a file and when sending it to a file or subprocess.
9565 If this does not specify a coding system, an appropriate element
9566 is used from one of the coding system alists:
9567 There are three such tables, `file-coding-system-alist',
9568 `process-coding-system-alist', and `network-coding-system-alist'.
9569 For output to files, if the above procedure does not specify a coding system,
9570 the value of `buffer-file-coding-system' is used. */);
9571 Vcoding_system_for_write
= Qnil
;
9573 DEFVAR_LISP ("last-coding-system-used", &Vlast_coding_system_used
,
9575 Coding system used in the latest file or process I/O. */);
9576 Vlast_coding_system_used
= Qnil
;
9578 DEFVAR_LISP ("last-code-conversion-error", &Vlast_code_conversion_error
,
9580 Error status of the last code conversion.
9582 When an error was detected in the last code conversion, this variable
9583 is set to one of the following symbols.
9584 `insufficient-source'
9588 `insufficient-memory'
9589 When no error was detected, the value doesn't change. So, to check
9590 the error status of a code conversion by this variable, you must
9591 explicitly set this variable to nil before performing code
9593 Vlast_code_conversion_error
= Qnil
;
9595 DEFVAR_BOOL ("inhibit-eol-conversion", &inhibit_eol_conversion
,
9597 *Non-nil means always inhibit code conversion of end-of-line format.
9598 See info node `Coding Systems' and info node `Text and Binary' concerning
9599 such conversion. */);
9600 inhibit_eol_conversion
= 0;
9602 DEFVAR_BOOL ("inherit-process-coding-system", &inherit_process_coding_system
,
9604 Non-nil means process buffer inherits coding system of process output.
9605 Bind it to t if the process output is to be treated as if it were a file
9606 read from some filesystem. */);
9607 inherit_process_coding_system
= 0;
9609 DEFVAR_LISP ("file-coding-system-alist", &Vfile_coding_system_alist
,
9611 Alist to decide a coding system to use for a file I/O operation.
9612 The format is ((PATTERN . VAL) ...),
9613 where PATTERN is a regular expression matching a file name,
9614 VAL is a coding system, a cons of coding systems, or a function symbol.
9615 If VAL is a coding system, it is used for both decoding and encoding
9617 If VAL is a cons of coding systems, the car part is used for decoding,
9618 and the cdr part is used for encoding.
9619 If VAL is a function symbol, the function must return a coding system
9620 or a cons of coding systems which are used as above. The function is
9621 called with an argument that is a list of the arguments with which
9622 `find-operation-coding-system' was called. If the function can't decide
9623 a coding system, it can return `undecided' so that the normal
9624 code-detection is performed.
9626 See also the function `find-operation-coding-system'
9627 and the variable `auto-coding-alist'. */);
9628 Vfile_coding_system_alist
= Qnil
;
9630 DEFVAR_LISP ("process-coding-system-alist", &Vprocess_coding_system_alist
,
9632 Alist to decide a coding system to use for a process I/O operation.
9633 The format is ((PATTERN . VAL) ...),
9634 where PATTERN is a regular expression matching a program name,
9635 VAL is a coding system, a cons of coding systems, or a function symbol.
9636 If VAL is a coding system, it is used for both decoding what received
9637 from the program and encoding what sent to the program.
9638 If VAL is a cons of coding systems, the car part is used for decoding,
9639 and the cdr part is used for encoding.
9640 If VAL is a function symbol, the function must return a coding system
9641 or a cons of coding systems which are used as above.
9643 See also the function `find-operation-coding-system'. */);
9644 Vprocess_coding_system_alist
= Qnil
;
9646 DEFVAR_LISP ("network-coding-system-alist", &Vnetwork_coding_system_alist
,
9648 Alist to decide a coding system to use for a network I/O operation.
9649 The format is ((PATTERN . VAL) ...),
9650 where PATTERN is a regular expression matching a network service name
9651 or is a port number to connect to,
9652 VAL is a coding system, a cons of coding systems, or a function symbol.
9653 If VAL is a coding system, it is used for both decoding what received
9654 from the network stream and encoding what sent to the network stream.
9655 If VAL is a cons of coding systems, the car part is used for decoding,
9656 and the cdr part is used for encoding.
9657 If VAL is a function symbol, the function must return a coding system
9658 or a cons of coding systems which are used as above.
9660 See also the function `find-operation-coding-system'. */);
9661 Vnetwork_coding_system_alist
= Qnil
;
9663 DEFVAR_LISP ("locale-coding-system", &Vlocale_coding_system
,
9664 doc
: /* Coding system to use with system messages.
9665 Also used for decoding keyboard input on X Window system. */);
9666 Vlocale_coding_system
= Qnil
;
9668 /* The eol mnemonics are reset in startup.el system-dependently. */
9669 DEFVAR_LISP ("eol-mnemonic-unix", &eol_mnemonic_unix
,
9671 *String displayed in mode line for UNIX-like (LF) end-of-line format. */);
9672 eol_mnemonic_unix
= build_string (":");
9674 DEFVAR_LISP ("eol-mnemonic-dos", &eol_mnemonic_dos
,
9676 *String displayed in mode line for DOS-like (CRLF) end-of-line format. */);
9677 eol_mnemonic_dos
= build_string ("\\");
9679 DEFVAR_LISP ("eol-mnemonic-mac", &eol_mnemonic_mac
,
9681 *String displayed in mode line for MAC-like (CR) end-of-line format. */);
9682 eol_mnemonic_mac
= build_string ("/");
9684 DEFVAR_LISP ("eol-mnemonic-undecided", &eol_mnemonic_undecided
,
9686 *String displayed in mode line when end-of-line format is not yet determined. */);
9687 eol_mnemonic_undecided
= build_string (":");
9689 DEFVAR_LISP ("enable-character-translation", &Venable_character_translation
,
9691 *Non-nil enables character translation while encoding and decoding. */);
9692 Venable_character_translation
= Qt
;
9694 DEFVAR_LISP ("standard-translation-table-for-decode",
9695 &Vstandard_translation_table_for_decode
,
9696 doc
: /* Table for translating characters while decoding. */);
9697 Vstandard_translation_table_for_decode
= Qnil
;
9699 DEFVAR_LISP ("standard-translation-table-for-encode",
9700 &Vstandard_translation_table_for_encode
,
9701 doc
: /* Table for translating characters while encoding. */);
9702 Vstandard_translation_table_for_encode
= Qnil
;
9704 DEFVAR_LISP ("charset-revision-table", &Vcharset_revision_table
,
9705 doc
: /* Alist of charsets vs revision numbers.
9706 While encoding, if a charset (car part of an element) is found,
9707 designate it with the escape sequence identifying revision (cdr part
9708 of the element). */);
9709 Vcharset_revision_table
= Qnil
;
9711 DEFVAR_LISP ("default-process-coding-system",
9712 &Vdefault_process_coding_system
,
9713 doc
: /* Cons of coding systems used for process I/O by default.
9714 The car part is used for decoding a process output,
9715 the cdr part is used for encoding a text to be sent to a process. */);
9716 Vdefault_process_coding_system
= Qnil
;
9718 DEFVAR_LISP ("latin-extra-code-table", &Vlatin_extra_code_table
,
9720 Table of extra Latin codes in the range 128..159 (inclusive).
9721 This is a vector of length 256.
9722 If Nth element is non-nil, the existence of code N in a file
9723 \(or output of subprocess) doesn't prevent it to be detected as
9724 a coding system of ISO 2022 variant which has a flag
9725 `accept-latin-extra-code' t (e.g. iso-latin-1) on reading a file
9726 or reading output of a subprocess.
9727 Only 128th through 159th elements has a meaning. */);
9728 Vlatin_extra_code_table
= Fmake_vector (make_number (256), Qnil
);
9730 DEFVAR_LISP ("select-safe-coding-system-function",
9731 &Vselect_safe_coding_system_function
,
9733 Function to call to select safe coding system for encoding a text.
9735 If set, this function is called to force a user to select a proper
9736 coding system which can encode the text in the case that a default
9737 coding system used in each operation can't encode the text.
9739 The default value is `select-safe-coding-system' (which see). */);
9740 Vselect_safe_coding_system_function
= Qnil
;
9742 DEFVAR_BOOL ("coding-system-require-warning",
9743 &coding_system_require_warning
,
9744 doc
: /* Internal use only.
9745 If non-nil, on writing a file, `select-safe-coding-system-function' is
9746 called even if `coding-system-for-write' is non-nil. The command
9747 `universal-coding-system-argument' binds this variable to t temporarily. */);
9748 coding_system_require_warning
= 0;
9751 DEFVAR_BOOL ("inhibit-iso-escape-detection",
9752 &inhibit_iso_escape_detection
,
9754 If non-nil, Emacs ignores ISO2022's escape sequence on code detection.
9756 By default, on reading a file, Emacs tries to detect how the text is
9757 encoded. This code detection is sensitive to escape sequences. If
9758 the sequence is valid as ISO2022, the code is determined as one of
9759 the ISO2022 encodings, and the file is decoded by the corresponding
9760 coding system (e.g. `iso-2022-7bit').
9762 However, there may be a case that you want to read escape sequences in
9763 a file as is. In such a case, you can set this variable to non-nil.
9764 Then, as the code detection ignores any escape sequences, no file is
9765 detected as encoded in some ISO2022 encoding. The result is that all
9766 escape sequences become visible in a buffer.
9768 The default value is nil, and it is strongly recommended not to change
9769 it. That is because many Emacs Lisp source files that contain
9770 non-ASCII characters are encoded by the coding system `iso-2022-7bit'
9771 in Emacs's distribution, and they won't be decoded correctly on
9772 reading if you suppress escape sequence detection.
9774 The other way to read escape sequences in a file without decoding is
9775 to explicitly specify some coding system that doesn't use ISO2022's
9776 escape sequence (e.g `latin-1') on reading by \\[universal-coding-system-argument]. */);
9777 inhibit_iso_escape_detection
= 0;
9779 DEFVAR_LISP ("translation-table-for-input", &Vtranslation_table_for_input
,
9780 doc
: /* Char table for translating self-inserting characters.
9781 This is applied to the result of input methods, not their input. See also
9782 `keyboard-translate-table'. */);
9783 Vtranslation_table_for_input
= Qnil
;
9786 Lisp_Object args
[coding_arg_max
];
9787 Lisp_Object plist
[16];
9790 for (i
= 0; i
< coding_arg_max
; i
++)
9793 plist
[0] = intern (":name");
9794 plist
[1] = args
[coding_arg_name
] = Qno_conversion
;
9795 plist
[2] = intern (":mnemonic");
9796 plist
[3] = args
[coding_arg_mnemonic
] = make_number ('=');
9797 plist
[4] = intern (":coding-type");
9798 plist
[5] = args
[coding_arg_coding_type
] = Qraw_text
;
9799 plist
[6] = intern (":ascii-compatible-p");
9800 plist
[7] = args
[coding_arg_ascii_compatible_p
] = Qt
;
9801 plist
[8] = intern (":default-char");
9802 plist
[9] = args
[coding_arg_default_char
] = make_number (0);
9803 plist
[10] = intern (":for-unibyte");
9804 plist
[11] = args
[coding_arg_for_unibyte
] = Qt
;
9805 plist
[12] = intern (":docstring");
9806 plist
[13] = build_string ("Do no conversion.\n\
9808 When you visit a file with this coding, the file is read into a\n\
9809 unibyte buffer as is, thus each byte of a file is treated as a\n\
9811 plist
[14] = intern (":eol-type");
9812 plist
[15] = args
[coding_arg_eol_type
] = Qunix
;
9813 args
[coding_arg_plist
] = Flist (16, plist
);
9814 Fdefine_coding_system_internal (coding_arg_max
, args
);
9816 plist
[1] = args
[coding_arg_name
] = Qundecided
;
9817 plist
[3] = args
[coding_arg_mnemonic
] = make_number ('-');
9818 plist
[5] = args
[coding_arg_coding_type
] = Qundecided
;
9819 /* This is already set.
9820 plist[7] = args[coding_arg_ascii_compatible_p] = Qt; */
9821 plist
[8] = intern (":charset-list");
9822 plist
[9] = args
[coding_arg_charset_list
] = Fcons (Qascii
, Qnil
);
9823 plist
[11] = args
[coding_arg_for_unibyte
] = Qnil
;
9824 plist
[13] = build_string ("No conversion on encoding, automatic conversion on decoding.");
9825 plist
[15] = args
[coding_arg_eol_type
] = Qnil
;
9826 args
[coding_arg_plist
] = Flist (16, plist
);
9827 Fdefine_coding_system_internal (coding_arg_max
, args
);
9830 setup_coding_system (Qno_conversion
, &safe_terminal_coding
);
9835 for (i
= 0; i
< coding_category_max
; i
++)
9836 Fset (AREF (Vcoding_category_table
, i
), Qno_conversion
);
9838 #if defined (MSDOS) || defined (WINDOWSNT)
9839 system_eol_type
= Qdos
;
9841 system_eol_type
= Qunix
;
9843 staticpro (&system_eol_type
);
9847 emacs_strerror (error_number
)
9852 synchronize_system_messages_locale ();
9853 str
= strerror (error_number
);
9855 if (! NILP (Vlocale_coding_system
))
9857 Lisp_Object dec
= code_convert_string_norecord (build_string (str
),
9858 Vlocale_coding_system
,
9860 str
= (char *) SDATA (dec
);
9868 /* arch-tag: 3a3a2b01-5ff6-4071-9afe-f5b808d9229d
9869 (do not change this comment) */