HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(ccl-decode-mule-utf-8): Check utf-subst-table-for-decode for more
[bpt/emacs.git] / lisp / international / utf-8.el
CommitLineData
9ca2ac2d 1;;; utf-8.el --- UTF-8 decoding/encoding support -*- coding: iso-2022-7bit -*-
5ba7a870 2
9e24a165 3;; Copyright (C) 2001, 2004 Electrotechnical Laboratory, JAPAN.
5ba7a870 4;; Licensed to the Free Software Foundation.
9ca2ac2d 5;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
5ba7a870 6
aa15b3e5 7;; Author: TAKAHASHI Naoto <ntakahas@m17n.org>
9ca2ac2d 8;; Maintainer: FSF
c49b8288 9;; Keywords: multilingual, Unicode, UTF-8, i18n
5ba7a870
KH		 10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software; you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation; either version 2, or (at your option)
16;; any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs; see the file COPYING. If not, write to the
25;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26;; Boston, MA 02111-1307, USA.
27
28;;; Commentary:
29
aa2e3f49
DL		 30;; The coding-system `mule-utf-8' basically supports encoding/decoding
31;; of the following character sets to and from UTF-8:
5ba7a870
KH		 32;;
33;; ascii
34;; eight-bit-control
35;; latin-iso8859-1
36;; mule-unicode-0100-24ff
37;; mule-unicode-2500-33ff
38;; mule-unicode-e000-ffff
39;;
c49b8288
DL		 40;; On decoding, Unicode characters that do not fit into the above
41;; character sets are handled as `eight-bit-control' or
42;; `eight-bit-graphic' characters to retain the information about the
9ca2ac2d
DL		 43;; original byte sequence and text properties record the corresponding
44;; unicode.
45;;
46;; Fixme: note that reading and writing invalid utf-8 may not be
47;; idempotent -- to represent the bytes to fix that needs a new charset.
aa2e3f49 48;;
ad88f5c5 49;; Characters from other character sets can be encoded with mule-utf-8
ccdd5c61 50;; by populating the translation table
535665b8 51;; `utf-translation-table-for-encode'. Hash tables
ad88f5c5
KH		 52;; `utf-subst-table-for-decode' and `utf-subst-table-for-encode' are
53;; used to support encoding and decoding of about a quarter of the CJK
54;; space between U+3400 and U+DFFF.
c49b8288 55
81639ac3 56;; UTF-8 is defined in RFC 3629. A sketch of the encoding is:
5ba7a870
KH		 57
58;; scalar | utf-8
59;; value | 1st byte | 2nd byte | 3rd byte
60;; --------------------+-----------+-----------+----------
61;; 0000 0000 0xxx xxxx | 0xxx xxxx | |
62;; 0000 0yyy yyxx xxxx | 110y yyyy | 10xx xxxx |
63;; zzzz yyyy yyxx xxxx | 1110 zzzz | 10yy yyyy | 10xx xxxx
64
65;;; Code:
66
ad88f5c5
KH		 67(defvar ucs-mule-to-mule-unicode (make-char-table 'translation-table nil)
68 "Char table mapping characters to latin-iso8859-1 or mule-unicode-*.
9ca2ac2d 69
ad88f5c5
KH		 70If `unify-8859-on-encoding-mode' is non-nil, this table populates the
71translation-table named `utf-translation-table-for-encode'.")
72
73(define-translation-table 'utf-translation-table-for-encode)
9ca2ac2d 74
9ca2ac2d
DL		 75
76;; Map Cyrillic and Greek to iso-8859 charsets, which take half the
77;; space of mule-unicode. For Latin scripts this isn't very
78;; important. Hebrew and Arabic might go here too when there's proper
79;; support for them.
ad88f5c5
KH		 80
81(defvar utf-fragmentation-table (make-char-table 'translation-table nil)
82 "Char-table normally mapping non-Latin mule-unicode-* chars to iso-8859-*.
83
84If `utf-fragment-on-decoding' is non-nil, this table populates the
85translation-table named `utf-translation-table-for-decode'")
86
87(defvar utf-defragmentation-table (make-char-table 'translation-table nil)
88 "Char-table for reverse mapping of `utf-fragmentation-table'.
89
90If `utf-fragment-on-decoding' is non-nil and
91`unify-8859-on-encoding-mode' is nil, this table populates the
92translation-table named `utf-translation-table-for-encode'")
93
94(define-translation-table 'utf-translation-table-for-decode)
95
96
0c8410d5 97(defvar ucs-mule-cjk-to-unicode (make-hash-table :test 'eq)
ad88f5c5
KH		 98 "Hash table mapping Emacs CJK character sets to Unicode code points.
99
9e24a165 100If `utf-translate-cjk-mode' is non-nil, this table populates the
ad88f5c5
KH		 101translation-hash-table named `utf-subst-table-for-encode'.")
102
0c8410d5
DL		 103(define-translation-hash-table 'utf-subst-table-for-encode
104 ucs-mule-cjk-to-unicode)
ad88f5c5 105
0c8410d5 106(defvar ucs-unicode-to-mule-cjk (make-hash-table :test 'eq)
ad88f5c5
KH		 107 "Hash table mapping Unicode code points to Emacs CJK character sets.
108
9e24a165 109If `utf-translate-cjk-mode' is non-nil, this table populates the
ad88f5c5
KH		 110translation-hash-table named `utf-subst-table-for-decode'.")
111
112(define-translation-hash-table 'utf-subst-table-for-decode
0c8410d5 113 ucs-unicode-to-mule-cjk)
ad88f5c5 114
9ca2ac2d
DL		 115(mapc
116 (lambda (pair)
ad88f5c5
KH		 117 (aset utf-fragmentation-table (car pair) (cdr pair))
118 (aset utf-defragmentation-table (cdr pair) (car pair)))
9ca2ac2d
DL		 119 '((?\e$,1&d\e(B . ?\e,F4\e(B) (?\e$,1&e\e(B . ?\e,F5\e(B) (?\e$,1&f\e(B . ?\e,F6\e(B) (?\e$,1&h\e(B . ?\e,F8\e(B) (?\e$,1&i\e(B . ?\e,F9\e(B)
120 (?\e$,1&j\e(B . ?\e,F:\e(B) (?\e$,1&l\e(B . ?\e,F<\e(B) (?\e$,1&n\e(B . ?\e,F>\e(B) (?\e$,1&o\e(B . ?\e,F?\e(B) (?\e$,1&p\e(B . ?\e,F@\e(B)
121 (?\e$,1&q\e(B . ?\e,FA\e(B) (?\e$,1&r\e(B . ?\e,FB\e(B) (?\e$,1&s\e(B . ?\e,FC\e(B) (?\e$,1&t\e(B . ?\e,FD\e(B) (?\e$,1&u\e(B . ?\e,FE\e(B)
122 (?\e$,1&v\e(B . ?\e,FF\e(B) (?\e$,1&w\e(B . ?\e,FG\e(B) (?\e$,1&x\e(B . ?\e,FH\e(B) (?\e$,1&y\e(B . ?\e,FI\e(B) (?\e$,1&z\e(B . ?\e,FJ\e(B)
123 (?\e$,1&{\e(B . ?\e,FK\e(B) (?\e$,1&|\e(B . ?\e,FL\e(B) (?\e$,1&}\e(B . ?\e,FM\e(B) (?\e$,1&~\e(B . ?\e,FN\e(B) (?\e$,1&\7f\e(B . ?\e,FO\e(B)
124 (?\e$,1' \e(B . ?\e,FP\e(B) (?\e$,1'!\e(B . ?\e,FQ\e(B) (?\e$,1'#\e(B . ?\e,FS\e(B) (?\e$,1'$\e(B . ?\e,FT\e(B) (?\e$,1'%\e(B . ?\e,FU\e(B)
125 (?\e$,1'&\e(B . ?\e,FV\e(B) (?\e$,1''\e(B . ?\e,FW\e(B) (?\e$,1'(\e(B . ?\e,FX\e(B) (?\e$,1')\e(B . ?\e,FY\e(B) (?\e$,1'*\e(B . ?\e,FZ\e(B)
126 (?\e$,1'+\e(B . ?\e,F[\e(B) (?\e$,1',\e(B . ?\e,F\\e(B) (?\e$,1'-\e(B . ?\e,F]\e(B) (?\e$,1'.\e(B . ?\e,F^\e(B) (?\e$,1'/\e(B . ?\e,F_\e(B)
127 (?\e$,1'0\e(B . ?\e,F`\e(B) (?\e$,1'1\e(B . ?\e,Fa\e(B) (?\e$,1'2\e(B . ?\e,Fb\e(B) (?\e$,1'3\e(B . ?\e,Fc\e(B) (?\e$,1'4\e(B . ?\e,Fd\e(B)
128 (?\e$,1'5\e(B . ?\e,Fe\e(B) (?\e$,1'6\e(B . ?\e,Ff\e(B) (?\e$,1'7\e(B . ?\e,Fg\e(B) (?\e$,1'8\e(B . ?\e,Fh\e(B) (?\e$,1'9\e(B . ?\e,Fi\e(B)
129 (?\e$,1':\e(B . ?\e,Fj\e(B) (?\e$,1';\e(B . ?\e,Fk\e(B) (?\e$,1'<\e(B . ?\e,Fl\e(B) (?\e$,1'=\e(B . ?\e,Fm\e(B) (?\e$,1'>\e(B . ?\e,Fn\e(B)
130 (?\e$,1'?\e(B . ?\e,Fo\e(B) (?\e$,1'@\e(B . ?\e,Fp\e(B) (?\e$,1'A\e(B . ?\e,Fq\e(B) (?\e$,1'B\e(B . ?\e,Fr\e(B) (?\e$,1'C\e(B . ?\e,Fs\e(B)
131 (?\e$,1'D\e(B . ?\e,Ft\e(B) (?\e$,1'E\e(B . ?\e,Fu\e(B) (?\e$,1'F\e(B . ?\e,Fv\e(B) (?\e$,1'G\e(B . ?\e,Fw\e(B) (?\e$,1'H\e(B . ?\e,Fx\e(B)
132 (?\e$,1'I\e(B . ?\e,Fy\e(B) (?\e$,1'J\e(B . ?\e,Fz\e(B) (?\e$,1'K\e(B . ?\e,F{\e(B) (?\e$,1'L\e(B . ?\e,F|\e(B) (?\e$,1'M\e(B . ?\e,F}\e(B)
133 (?\e$,1'N\e(B . ?\e,F~\e(B)
134
135 (?\e$,1(!\e(B . ?\e,L!\e(B) (?\e$,1("\e(B . ?\e,L"\e(B) (?\e$,1(#\e(B . ?\e,L#\e(B) (?\e$,1($\e(B . ?\e,L$\e(B)
136 (?\e$,1(%\e(B . ?\e,L%\e(B) (?\e$,1(&\e(B . ?\e,L&\e(B) (?\e$,1('\e(B . ?\e,L'\e(B) (?\e$,1((\e(B . ?\e,L(\e(B) (?\e$,1()\e(B . ?\e,L)\e(B)
137 (?\e$,1(*\e(B . ?\e,L*\e(B) (?\e$,1(+\e(B . ?\e,L+\e(B) (?\e$,1(,\e(B . ?\e,L,\e(B) (?\e$,1(.\e(B . ?\e,L.\e(B) (?\e$,1(/\e(B . ?\e,L/\e(B)
138 (?\e$,1(0\e(B . ?\e,L0\e(B) (?\e$,1(1\e(B . ?\e,L1\e(B) (?\e$,1(2\e(B . ?\e,L2\e(B) (?\e$,1(3\e(B . ?\e,L3\e(B) (?\e$,1(4\e(B . ?\e,L4\e(B)
139 (?\e$,1(5\e(B . ?\e,L5\e(B) (?\e$,1(6\e(B . ?\e,L6\e(B) (?\e$,1(7\e(B . ?\e,L7\e(B) (?\e$,1(8\e(B . ?\e,L8\e(B) (?\e$,1(9\e(B . ?\e,L9\e(B)
140 (?\e$,1(:\e(B . ?\e,L:\e(B) (?\e$,1(;\e(B . ?\e,L;\e(B) (?\e$,1(<\e(B . ?\e,L<\e(B) (?\e$,1(=\e(B . ?\e,L=\e(B) (?\e$,1(>\e(B . ?\e,L>\e(B)
141 (?\e$,1(?\e(B . ?\e,L?\e(B) (?\e$,1(@\e(B . ?\e,L@\e(B) (?\e$,1(A\e(B . ?\e,LA\e(B) (?\e$,1(B\e(B . ?\e,LB\e(B) (?\e$,1(C\e(B . ?\e,LC\e(B)
142 (?\e$,1(D\e(B . ?\e,LD\e(B) (?\e$,1(E\e(B . ?\e,LE\e(B) (?\e$,1(F\e(B . ?\e,LF\e(B) (?\e$,1(G\e(B . ?\e,LG\e(B) (?\e$,1(H\e(B . ?\e,LH\e(B)
143 (?\e$,1(I\e(B . ?\e,LI\e(B) (?\e$,1(J\e(B . ?\e,LJ\e(B) (?\e$,1(K\e(B . ?\e,LK\e(B) (?\e$,1(L\e(B . ?\e,LL\e(B) (?\e$,1(M\e(B . ?\e,LM\e(B)
144 (?\e$,1(N\e(B . ?\e,LN\e(B) (?\e$,1(O\e(B . ?\e,LO\e(B) (?\e$,1(P\e(B . ?\e,LP\e(B) (?\e$,1(Q\e(B . ?\e,LQ\e(B) (?\e$,1(R\e(B . ?\e,LR\e(B)
145 (?\e$,1(S\e(B . ?\e,LS\e(B) (?\e$,1(T\e(B . ?\e,LT\e(B) (?\e$,1(U\e(B . ?\e,LU\e(B) (?\e$,1(V\e(B . ?\e,LV\e(B) (?\e$,1(W\e(B . ?\e,LW\e(B)
146 (?\e$,1(X\e(B . ?\e,LX\e(B) (?\e$,1(Y\e(B . ?\e,LY\e(B) (?\e$,1(Z\e(B . ?\e,LZ\e(B) (?\e$,1([\e(B . ?\e,L[\e(B) (?\e$,1(\\e(B . ?\e,L\\e(B)
147 (?\e$,1(]\e(B . ?\e,L]\e(B) (?\e$,1(^\e(B . ?\e,L^\e(B) (?\e$,1(_\e(B . ?\e,L_\e(B) (?\e$,1(`\e(B . ?\e,L`\e(B) (?\e$,1(a\e(B . ?\e,La\e(B)
148 (?\e$,1(b\e(B . ?\e,Lb\e(B) (?\e$,1(c\e(B . ?\e,Lc\e(B) (?\e$,1(d\e(B . ?\e,Ld\e(B) (?\e$,1(e\e(B . ?\e,Le\e(B) (?\e$,1(f\e(B . ?\e,Lf\e(B)
149 (?\e$,1(g\e(B . ?\e,Lg\e(B) (?\e$,1(h\e(B . ?\e,Lh\e(B) (?\e$,1(i\e(B . ?\e,Li\e(B) (?\e$,1(j\e(B . ?\e,Lj\e(B) (?\e$,1(k\e(B . ?\e,Lk\e(B)
150 (?\e$,1(l\e(B . ?\e,Ll\e(B) (?\e$,1(m\e(B . ?\e,Lm\e(B) (?\e$,1(n\e(B . ?\e,Ln\e(B) (?\e$,1(o\e(B . ?\e,Lo\e(B) (?\e$,1(q\e(B . ?\e,Lq\e(B)
151 (?\e$,1(r\e(B . ?\e,Lr\e(B) (?\e$,1(s\e(B . ?\e,Ls\e(B) (?\e$,1(t\e(B . ?\e,Lt\e(B) (?\e$,1(u\e(B . ?\e,Lu\e(B) (?\e$,1(v\e(B . ?\e,Lv\e(B)
152 (?\e$,1(w\e(B . ?\e,Lw\e(B) (?\e$,1(x\e(B . ?\e,Lx\e(B) (?\e$,1(y\e(B . ?\e,Ly\e(B) (?\e$,1(z\e(B . ?\e,Lz\e(B) (?\e$,1({\e(B . ?\e,L{\e(B)
153 (?\e$,1(|\e(B . ?\e,L|\e(B) (?\e$,1(~\e(B . ?\e,L~\e(B) (?\e$,1(\7f\e(B . ?\e,L\7f\e(B)))
154
ad88f5c5
KH		 155
156(defcustom utf-fragment-on-decoding nil
157 "Whether or not to decode some chars in UTF-8/16 text into iso8859 charsets.
9ca2ac2d
DL		 158Setting this means that the relevant Cyrillic and Greek characters are
159decoded into the iso8859 charsets rather than into
3873f5a5 160mule-unicode-0100-24ff. The iso8859 charsets take half as much space
9ca2ac2d
DL		 161in the buffer, but using them may affect how the buffer can be re-encoded
162and may require a different input method to search for them, for instance.
163See `unify-8859-on-decoding-mode' and `unify-8859-on-encoding-mode'
3873f5a5
KH		 164for mechanisms to make this largely transparent.
165
166Setting this variable outside customize has no effect."
9ca2ac2d 167 :set (lambda (s v)
ad88f5c5
KH		 168 (if v
169 (progn
170 (define-translation-table 'utf-translation-table-for-decode
171 utf-fragmentation-table)
172 ;; Even if unify-8859-on-encoding-mode is off, make
173 ;; mule-utf-* encode characters in
174 ;; utf-fragmentation-table.
175 (unless (eq (get 'utf-translation-table-for-encode
176 'translation-table)
177 ucs-mule-to-mule-unicode)
178 (define-translation-table 'utf-translation-table-for-encode
535665b8 179 utf-defragmentation-table)))
ad88f5c5
KH		 180 (define-translation-table 'utf-translation-table-for-decode)
181 ;; When unify-8859-on-encoding-mode is off, be sure to make
182 ;; mule-utf-* disabled for characters in
183 ;; utf-fragmentation-table.
184 (unless (eq (get 'utf-translation-table-for-encode
185 'translation-table)
186 ucs-mule-to-mule-unicode)
535665b8 187 (define-translation-table 'utf-translation-table-for-encode)))
9ca2ac2d
DL		 188 (set-default s v))
189 :version "21.4"
190 :type 'boolean
191 :group 'mule)
192
c71c26e9
KH		 193
194(defconst utf-translate-cjk-charsets '(chinese-gb2312
195 chinese-big5-1 chinese-big5-2
196 japanese-jisx0208 japanese-jisx0212
197 korean-ksc5601)
198 "List of charsets supported by `utf-translate-cjk-mode'.")
199
fce59e40
KH		 200(defvar utf-translate-cjk-lang-env nil
201 "Language environment in which tables for `utf-translate-cjk-mode' is loaded.
202The value nil means that the tables are not yet loaded.")
203
204(defvar utf-translate-cjk-unicode-range)
205
206;; String generated from utf-translate-cjk-unicode-range. It is
207;; suitable for an argument to skip-chars-forward.
208(defvar utf-translate-cjk-unicode-range-string nil)
209
210(defun utf-translate-cjk-set-unicode-range (range)
211 (setq utf-translate-cjk-unicode-range range)
212 (setq utf-translate-cjk-unicode-range-string
213 (let ((decode-char-no-trans
214 #'(lambda (x)
215 (cond ((< x #x100) (make-char 'latin-iso8859-1 x))
216 ((< x #x2500)
217 (setq x (- x #x100))
218 (make-char 'mule-unicode-0100-24ff
219 (+ (/ x 96) 32) (+ (% x 96) 32)))
220 ((< x #x3400)
221 (setq x (- x #x2500))
222 (make-char 'mule-unicode-2500-33ff
223 (+ (/ x 96) 32) (+ (% x 96) 32)))
224 (t
225 (setq x (- x #xe000))
226 (make-char 'mule-unicode-e000-ffff
227 (+ (/ x 96) 32) (+ (% x 96) 32))))))
228 ranges from to)
229 (dolist (elt range)
230 (setq from (max #xA0 (car elt)) to (min #xffff (cdr elt)))
231 (if (and (>= to #x3400) (< to #xE000))
232 (setq to #x33FF))
233 (cond ((< from #x100)
234 (if (>= to #xE000)
235 (setq ranges (cons (cons #xE000 to) ranges)
236 to #x33FF))
237 (if (>= to #x2500)
238 (setq ranges (cons (cons #x2500 to) ranges)
239 to #x24FF))
240 (if (>= to #x100)
241 (setq ranges (cons (cons #x100 to) ranges)
242 to #xFF)))
243 ((< from #x2500)
244 (if (>= to #xE000)
245 (setq ranges (cons (cons #xE000 to) ranges)
246 to #x33FF))
247 (if (>= to #x2500)
248 (setq ranges (cons (cons #x2500 to) ranges)
249 to #x24FF)))
250 ((< from #x3400)
251 (if (>= to #xE000)
252 (setq ranges (cons (cons #xE000 to) ranges)
253 to #x33FF))))
254 (if (<= from to)
255 (setq ranges (cons (cons from to) ranges))))
256 (mapconcat #'(lambda (x)
257 (format "%c-%c"
258 (funcall decode-char-no-trans (car x))
259 (funcall decode-char-no-trans (cdr x))))
260 ranges "")))
3ccf95cb
KH		 261 ;; These forces loading and settting tables for
262 ;; utf-translate-cjk-mode.
263 (setq utf-translate-cjk-lang-env nil
264 ucs-mule-cjk-to-unicode (make-hash-table :test 'eq)
265 ucs-unicode-to-mule-cjk (make-hash-table :test 'eq)))
fce59e40
KH		 266
267(defcustom utf-translate-cjk-unicode-range '((#x2e80 . #xd7a3)
268 (#xff00 . #xffef))
269 "List of Unicode code ranges supported by `utf-translate-cjk-mode'.
270Setting this variable directly does not take effect;
271use either \\[customize] or the function
272`utf-translate-cjk-set-unicode-range'."
273 :version "21.4"
274 :type '(repeat (cons integer integer))
275 :set (lambda (symbol value)
276 (utf-translate-cjk-set-unicode-range value))
277 :group 'mule)
c71c26e9
KH		 278
279;; Return non-nil if CODE-POINT is in `utf-translate-cjk-unicode-range'.
280(defsubst utf-translate-cjk-substitutable-p (code-point)
281 (let ((tail utf-translate-cjk-unicode-range)
282 elt)
283 (while tail
284 (setq elt (car tail) tail (cdr tail))
285 (if (and (>= code-point (car elt)) (<= code-point (cdr elt)))
286 (setq tail nil)
287 (setq elt nil)))
288 elt))
289
c71c26e9
KH		 290(defun utf-translate-cjk-load-tables ()
291 "Load tables for `utf-translate-cjk-mode'."
292 ;; Fixme: Allow the use of the CJK charsets to be
293 ;; customized by reordering and possible omission.
294 (let ((redefined (< (hash-table-size ucs-mule-cjk-to-unicode) 43000)))
295 (if redefined
296 ;; Redefine them with realistic initial sizes and a
297 ;; smallish rehash size to avoid wasting significant
298 ;; space after they're built.
299 (setq ucs-mule-cjk-to-unicode
300 (make-hash-table :test 'eq :size 43000 :rehash-size 1000)
301 ucs-unicode-to-mule-cjk
302 (make-hash-table :test 'eq :size 21500 :rehash-size 1000)))
303
304 ;; Load the files explicitly, to avoid having to keep
305 ;; around the large tables they contain (as well as the
306 ;; ones which get built).
307 (cond ((string= "Korean" current-language-environment)
308 (load "subst-jis")
309 (load "subst-big5")
310 (load "subst-gb2312")
311 (load "subst-ksc"))
312 ((string= "Chinese-BIG5" current-language-environment)
313 (load "subst-jis")
314 (load "subst-ksc")
315 (load "subst-gb2312")
316 (load "subst-big5"))
317 ((string= "Chinese-GB" current-language-environment)
318 (load "subst-jis")
319 (load "subst-ksc")
320 (load "subst-big5")
321 (load "subst-gb2312"))
322 (t
323 (load "subst-ksc")
324 (load "subst-gb2312")
325 (load "subst-big5")
326 (load "subst-jis"))) ; jis covers as much as big5, gb2312
327
328 (when redefined
329 (define-translation-hash-table 'utf-subst-table-for-decode
330 ucs-unicode-to-mule-cjk)
331 (define-translation-hash-table 'utf-subst-table-for-encode
332 ucs-mule-cjk-to-unicode)
333 (set-char-table-extra-slot (get 'utf-translation-table-for-encode
334 'translation-table)
335 1 ucs-mule-cjk-to-unicode))
336
337 (setq utf-translate-cjk-lang-env current-language-environment)))
338
339(defun utf-lookup-subst-table-for-decode (code-point)
340 (if (and utf-translate-cjk-mode
341 (not utf-translate-cjk-lang-env)
342 (utf-translate-cjk-substitutable-p code-point))
343 (utf-translate-cjk-load-tables))
344 (gethash code-point
345 (get 'utf-subst-table-for-decode 'translation-hash-table)))
4bcce19c 346
c71c26e9
KH		 347
348(defun utf-lookup-subst-table-for-encode (char)
349 (if (and utf-translate-cjk-mode
350 (not utf-translate-cjk-lang-env)
351 (memq (char-charset char) utf-translate-cjk-charsets))
352 (utf-translate-cjk-load-tables))
353 (gethash char
354 (get 'utf-subst-table-for-encode 'translation-hash-table)))
4bcce19c 355
fcfdeaf6 356(define-minor-mode utf-translate-cjk-mode
4bcce19c
LT		 357 "Toggle whether UTF based coding systems de/encode CJK characters.
358If ARG is an integer, enable if ARG is positive and disable if
359zero or negative. This is a minor mode.
c71c26e9 360Enabling this allows the coding systems mule-utf-8,
72b338a2 361mule-utf-16le and mule-utf-16be to encode characters in the charsets
ccdd5c61
DL		 362`korean-ksc5601', `chinese-gb2312', `chinese-big5-1',
363`chinese-big5-2', `japanese-jisx0208' and `japanese-jisx0212', and to
364decode the corresponding unicodes into such characters.
365
366Where the charsets overlap, the one preferred for decoding is chosen
367according to the language environment in effect when this option is
368turned on: ksc5601 for Korean, gb2312 for Chinese-GB, big5 for
369Chinese-Big5 and jisx for other environments.
370
4bcce19c 371This mode is on by default. If you are not interested in CJK
c71c26e9 372characters and want to avoid some overhead on encoding/decoding
4bcce19c
LT		 373by the above coding systems, you can customize the user option
374`utf-translate-cjk-mode' to nil."
c71c26e9 375 :init-value t
9ca2ac2d
DL		 376 :version "21.4"
377 :type 'boolean
fcfdeaf6
KG		 378 :group 'mule
379 :global t
380 (if utf-translate-cjk-mode
fcfdeaf6 381 (progn
2bf07f07
KH		 382 (define-translation-hash-table 'utf-subst-table-for-decode
383 ucs-unicode-to-mule-cjk)
384 (define-translation-hash-table 'utf-subst-table-for-encode
385 ucs-mule-cjk-to-unicode)
386 (set-char-table-extra-slot (get 'utf-translation-table-for-encode
387 'translation-table)
388 1 ucs-mule-cjk-to-unicode))
aea797fc
KH		 389 (define-translation-hash-table 'utf-subst-table-for-decode
390 (make-hash-table :test 'eq))
391 (define-translation-hash-table 'utf-subst-table-for-encode
2bf07f07
KH		 392 (make-hash-table :test 'eq))
393 (set-char-table-extra-slot (get 'utf-translation-table-for-encode
394 'translation-table)
c71c26e9
KH		 395 1 nil))
396
397 ;; Update safe-chars of mule-utf-* coding systems.
398 (dolist (elt (coding-system-list t))
399 (if (string-match "^mule-utf" (symbol-name elt))
400 (let ((safe-charsets (coding-system-get elt 'safe-charsets))
401 (safe-chars (coding-system-get elt 'safe-chars))
402 (need-update nil))
403 (dolist (charset utf-translate-cjk-charsets)
404 (unless (eq utf-translate-cjk-mode (memq charset safe-charsets))
405 (setq safe-charsets
406 (if utf-translate-cjk-mode
407 (cons charset safe-charsets)
408 (delq charset safe-charsets))
409 need-update t)
410 (aset safe-chars (make-char charset) utf-translate-cjk-mode)))
411 (when need-update
412 (coding-system-put elt 'safe-charsets safe-charsets)
413 (define-coding-system-internal elt))))))
414
415(define-ccl-program ccl-mule-utf-untrans
416 ;; R0 is an untranslatable Unicode code-point (U+3500..U+DFFF or
417 ;; U+10000..U+10FFFF) or an invaid byte (#x00..#xFF). Write
418 ;; eight-bit-control/graphic sequence (2 to 4 chars) representing
419 ;; UTF-8 sequence of r0. Registers r4, r5, r6 are modified.
420 ;;
421 ;; This is a subrountine because we assume that this is called very
422 ;; rarely (so we don't have to worry about the overhead of the
423 ;; call).
424 `(0
425 ((r5 = ,(charset-id 'eight-bit-control))
426 (r6 = ,(charset-id 'eight-bit-graphic))
427 (if (r0 < #x100)
428 ((r4 = ((r0 >> 6) | #xC0))
429 (write-multibyte-character r6 r4))
430 ((if (r0 < #x10000)
431 ((r4 = ((r0 >> 12) | #xE0))
432 (write-multibyte-character r6 r4))
433 ((r4 = ((r0 >> 18) | #xF0))
434 (write-multibyte-character r6 r4)
435 (r4 = (((r0 >> 12) & #x3F) | #x80))
436 (if (r4 < #xA0)
437 (write-multibyte-character r5 r4)
438 (write-multibyte-character r6 r4))))
439 (r4 = (((r0 >> 6) & #x3F) | #x80))
440 (if (r4 < #xA0)
441 (write-multibyte-character r5 r4)
442 (write-multibyte-character r6 r4))))
443 (r4 = ((r0 & #x3F) | #x80))
444 (if (r4 < #xA0)
445 (write-multibyte-character r5 r4)
446 (write-multibyte-character r6 r4)))))
9ca2ac2d 447
5ba7a870
KH		 448(define-ccl-program ccl-decode-mule-utf-8
449 ;;
450 ;; charset | bytes in utf-8 | bytes in emacs
451 ;; -----------------------+----------------+---------------
452 ;; ascii | 1 | 1
453 ;; -----------------------+----------------+---------------
454 ;; eight-bit-control | 2 | 2
aa2e3f49 455 ;; eight-bit-graphic | 2 | 1
5ba7a870
KH		 456 ;; latin-iso8859-1 | 2 | 2
457 ;; -----------------------+----------------+---------------
458 ;; mule-unicode-0100-24ff | 2 | 4
459 ;; (< 0800) | |
460 ;; -----------------------+----------------+---------------
461 ;; mule-unicode-0100-24ff | 3 | 4
462 ;; (>= 8000) | |
463 ;; mule-unicode-2500-33ff | 3 | 4
464 ;; mule-unicode-e000-ffff | 3 | 4
c71c26e9
KH		 465 ;; -----------------------+----------------+---------------
466 ;; invalid byte | 1 | 2
5ba7a870
KH		 467 ;;
468 ;; Thus magnification factor is two.
469 ;;
470 `(2
064cff0b
KH		 471 ((r6 = ,(charset-id 'latin-iso8859-1))
472 (read r0)
3d0e328b 473 (loop
5ba7a870 474 (if (r0 < #x80)
c71c26e9 475 ;; 1-byte encoding, i.e., ascii
064cff0b
KH		 476 (write-read-repeat r0))
477 (if (r0 < #xc2)
478 ;; continuation byte (invalid here) or 1st byte of overlong
479 ;; 2-byte sequence.
c71c26e9 480 ((call ccl-mule-utf-untrans)
064cff0b
KH		 481 (r6 = ,(charset-id 'latin-iso8859-1))
482 (read r0)
c71c26e9
KH		 483 (repeat)))
484
485 ;; Read the 2nd byte.
c71c26e9
KH		 486 (read r1)
487 (if ((r1 & #b11000000) != #b10000000) ; Invalid 2nd byte
488 ((call ccl-mule-utf-untrans)
064cff0b 489 (r6 = ,(charset-id 'latin-iso8859-1))
c71c26e9
KH		 490 ;; Handle it in the next loop.
491 (r0 = r1)
492 (repeat)))
493
494 (if (r0 < #xe0)
495 ;; 2-byte encoding 00000yyyyyxxxxxx = 110yyyyy 10xxxxxx
064cff0b
KH		 496 ((r1 &= #x3F)
497 (r1 |= ((r0 & #x1F) << 6))
3ccf95cb 498 ;; Now r1 holds scalar value. We don't have to check
064cff0b 499 ;; `overlong sequence' because r0 >= 0xC2.
c71c26e9 500
064cff0b 501 (if (r1 >= 256)
c71c26e9 502 ;; mule-unicode-0100-24ff (< 0800)
3ccf95cb
KH		 503 ((r0 = r1)
504 (lookup-integer utf-subst-table-for-decode r0 r1)
505 (if (r7 == 0)
506 ((r0 = ,(charset-id 'mule-unicode-0100-24ff))
507 (r1 -= #x0100)
508 (r2 = (((r1 / 96) + 32) << 7))
509 (r1 %= 96)
510 (r1 += (r2 + 32))
511 (translate-character
512 utf-translation-table-for-decode r0 r1)))
064cff0b
KH		 513 (write-multibyte-character r0 r1)
514 (read r0)
515 (repeat))
516 (if (r1 >= 160)
517 ;; latin-iso8859-1
3ccf95cb
KH		 518 ((r0 = r1)
519 (lookup-integer utf-subst-table-for-decode r0 r1)
520 (if (r7 == 0)
521 ((r1 -= 128)
522 (write-multibyte-character r6 r1))
523 ((write-multibyte-character r0 r1)))
064cff0b
KH		 524 (read r0)
525 (repeat))
526 ;; eight-bit-control
527 ((r0 = ,(charset-id 'eight-bit-control))
528 (write-multibyte-character r0 r1)
529 (read r0)
530 (repeat))))))
c71c26e9
KH		 531
532 ;; Read the 3rd bytes.
c71c26e9
KH		 533 (read r2)
534 (if ((r2 & #b11000000) != #b10000000) ; Invalid 3rd byte
535 ((call ccl-mule-utf-untrans)
536 (r0 = r1)
537 (call ccl-mule-utf-untrans)
064cff0b 538 (r6 = ,(charset-id 'latin-iso8859-1))
c71c26e9
KH		 539 ;; Handle it in the next loop.
540 (r0 = r2)
541 (repeat)))
542
543 (if (r0 < #xF0)
544 ;; 3byte encoding
545 ;; zzzzyyyyyyxxxxxx = 1110zzzz 10yyyyyy 10xxxxxx
546 ((r3 = ((r0 & #xF) << 12))
547 (r3 |= ((r1 & #x3F) << 6))
548 (r3 |= (r2 & #x3F))
549
550 (if (r3 < #x800) ; `overlong sequence'
551 ((call ccl-mule-utf-untrans)
552 (r0 = r1)
553 (call ccl-mule-utf-untrans)
554 (r0 = r2)
555 (call ccl-mule-utf-untrans)
064cff0b
KH		 556 (r6 = ,(charset-id 'latin-iso8859-1))
557 (read r0)
c71c26e9
KH		 558 (repeat)))
559
560 (if (r3 < #x2500)
561 ;; mule-unicode-0100-24ff (>= 0800)
3ccf95cb
KH		 562 ((r0 = r3)
563 (lookup-integer utf-subst-table-for-decode r0 r1)
564 (if (r7 == 0)
565 ((r0 = ,(charset-id 'mule-unicode-0100-24ff))
566 (r3 -= #x0100)
567 (r3 //= 96)
568 (r1 = (r7 + 32))
569 (r1 += ((r3 + 32) << 7))
570 (translate-character
571 utf-translation-table-for-decode r0 r1)))
c71c26e9 572 (write-multibyte-character r0 r1)
064cff0b 573 (read r0)
c71c26e9
KH		 574 (repeat)))
575
576 (if (r3 < #x3400)
577 ;; mule-unicode-2500-33ff
578 ((r0 = r3) ; don't zap r3
579 (lookup-integer utf-subst-table-for-decode r0 r1)
580 (if (r7 == 0)
581 ((r0 = ,(charset-id 'mule-unicode-2500-33ff))
582 (r3 -= #x2500)
583 (r3 //= 96)
584 (r1 = (r7 + 32))
585 (r1 += ((r3 + 32) << 7))))
586 (write-multibyte-character r0 r1)
064cff0b 587 (read r0)
c71c26e9
KH		 588 (repeat)))
589
590 (if (r3 < #xE000)
591 ;; Try to convert to CJK chars, else
592 ;; keep them as eight-bit-{control|graphic}.
593 ((r0 = r3)
594 (lookup-integer utf-subst-table-for-decode r3 r1)
595 (if r7
596 ;; got a translation
064cff0b
KH		 597 ((write-multibyte-character r3 r1)
598 (read r0)
599 (repeat))
600 ((call ccl-mule-utf-untrans)
601 (r6 = ,(charset-id 'latin-iso8859-1))
602 (read r0)
603 (repeat)))))
c71c26e9
KH		 604
605 ;; mule-unicode-e000-ffff
606 ;; Fixme: fffe and ffff are invalid.
607 (r0 = r3) ; don't zap r3
608 (lookup-integer utf-subst-table-for-decode r0 r1)
609 (if (r7 == 0)
610 ((r0 = ,(charset-id 'mule-unicode-e000-ffff))
611 (r3 -= #xe000)
612 (r3 //= 96)
613 (r1 = (r7 + 32))
614 (r1 += ((r3 + 32) << 7))))
615 (write-multibyte-character r0 r1)
064cff0b 616 (read r0)
c71c26e9
KH		 617 (repeat)))
618
619 ;; Read the 4th bytes.
c71c26e9
KH		 620 (read r3)
621 (if ((r3 & #b11000000) != #b10000000) ; Invalid 4th byte
622 ((call ccl-mule-utf-untrans)
623 (r0 = r1)
624 (call ccl-mule-utf-untrans)
064cff0b
KH		 625 (r0 = r2)
626 (call ccl-mule-utf-untrans)
627 (r6 = ,(charset-id 'latin-iso8859-1))
c71c26e9
KH		 628 ;; Handle it in the next loop.
629 (r0 = r3)
630 (repeat)))
631
064cff0b 632 (if (r0 < #xF8)
c71c26e9
KH		 633 ;; 4-byte encoding:
634 ;; wwwzzzzzzyyyyyyxxxxxx = 11110www 10zzzzzz 10yyyyyy 10xxxxxx
635 ;; keep those bytes as eight-bit-{control|graphic}
636 ;; Fixme: allow lookup in utf-subst-table-for-decode.
637 ((r4 = ((r0 & #x7) << 18))
638 (r4 |= ((r1 & #x3F) << 12))
639 (r4 |= ((r2 & #x3F) << 6))
640 (r4 |= (r3 & #x3F))
641
642 (if (r4 < #x10000) ; `overlong sequence'
643 ((call ccl-mule-utf-untrans)
644 (r0 = r1)
645 (call ccl-mule-utf-untrans)
646 (r0 = r2)
647 (call ccl-mule-utf-untrans)
648 (r0 = r3)
649 (call ccl-mule-utf-untrans))
650 ((r0 = r4)
064cff0b 651 (call ccl-mule-utf-untrans))))
c71c26e9 652
064cff0b
KH		 653 ;; Unsupported sequence.
654 ((call ccl-mule-utf-untrans)
655 (r0 = r1)
656 (call ccl-mule-utf-untrans)
657 (r0 = r2)
658 (call ccl-mule-utf-untrans)
659 (r0 = r3)
660 (call ccl-mule-utf-untrans)))
661 (r6 = ,(charset-id 'latin-iso8859-1))
662 (read r0)
67ff2216
KH		 663 (repeat)))
664
064cff0b 665
67ff2216
KH		 666 ;; At EOF...
667 (if (r0 >= 0)
c71c26e9
KH		 668 ;; r0 >= #x80
669 ((call ccl-mule-utf-untrans)
67ff2216 670 (if (r1 >= 0)
c71c26e9
KH		 671 ((r0 = r1)
672 (call ccl-mule-utf-untrans)
67ff2216 673 (if (r2 >= 0)
c71c26e9
KH		 674 ((r0 = r2)
675 (call ccl-mule-utf-untrans)
67ff2216 676 (if (r3 >= 0)
c71c26e9
KH		 677 ((r0 = r3)
678 (call ccl-mule-utf-untrans))))))))))
5ba7a870 679
c49b8288 680 "CCL program to decode UTF-8.
74ace46a 681Basic decoding is done into the charsets ascii, latin-iso8859-1 and
ad88f5c5
KH		 682mule-unicode-*, but see also `utf-fragmentation-table' and
683`ucs-mule-cjk-to-unicode'.
9ca2ac2d
DL		 684Encodings of un-representable Unicode characters are decoded asis into
685eight-bit-control and eight-bit-graphic characters.")
5ba7a870 686
c71c26e9
KH		 687(define-ccl-program ccl-mule-utf-8-encode-untrans
688 ;; UTF-8 decoder generates an UTF-8 sequence represented by a
689 ;; sequence eight-bit-control/graphic chars for an untranslatable
690 ;; character and an invalid byte.
4bcce19c 691 ;;
c71c26e9
KH		 692 ;; This CCL parses that sequence (the first byte is already in r1),
693 ;; writes out the original bytes of that sequence, and sets r5 to
694 ;; -1.
695 ;;
696 ;; If the eight-bit-control/graphic sequence is shorter than what r1
697 ;; suggests, it sets r5 and r6 to the last character read that
698 ;; should be handled by the next loop of a caller.
699 ;;
700 ;; Note: For UTF-8 validation, we only check if a character is
701 ;; eight-bit-control/graphic or not. It may result in incorrect
702 ;; handling of random binary data, but such a data can't be encoded
703 ;; by UTF-8 anyway. At least, UTF-8 decoders doesn't generate such
704 ;; a sequence even if a source contains invalid byte-sequence.
705 `(0
706 (;; Read the 2nd byte.
707 (read-multibyte-character r5 r6)
708 (r0 = (r5 != ,(charset-id 'eight-bit-control)))
709 (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
4bcce19c 710 ((write r1) ; invalid UTF-8
c71c26e9
KH		 711 (r1 = -1)
712 (end)))
713
714 (if (r1 <= #xC3)
715 ;; 2-byte sequence for an originally invalid byte.
716 ((r6 &= #x3F)
717 (r6 |= ((r1 & #x1F) << 6))
718 (write r6)
719 (r5 = -1)
720 (end)))
721
722 (write r1 r6)
723 (r2 = r1)
724 (r1 = -1)
725 ;; Read the 3rd byte.
726 (read-multibyte-character r5 r6)
4bcce19c 727 (r0 = (r5 != ,(charset-id 'eight-bit-control)))
c71c26e9
KH		 728 (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
729 (end)) ; invalid UTF-8
730 (write r6)
731 (if (r2 < #xF0)
732 ;; 3-byte sequence for an untranslated character.
733 ((r5 = -1)
734 (end)))
735 ;; Read the 4th byte.
736 (read-multibyte-character r5 r6)
4bcce19c 737 (r0 = (r5 != ,(charset-id 'eight-bit-control)))
c71c26e9
KH		 738 (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
739 (end)) ; invalid UTF-8
740 ;; 4-byte sequence for an untranslated character.
741 (write r6)
742 (r5 = -1)
743 (end))
744
745 ;; At EOF...
746 ((r5 = -1)
747 (if (r1 >= 0)
748 (write r1)))))
749
5ba7a870
KH		 750(define-ccl-program ccl-encode-mule-utf-8
751 `(1
aa15b3e5
KH		 752 ((r5 = -1)
753 (loop
754 (if (r5 < 0)
c71c26e9
KH		 755 (read-multibyte-character r0 r1)
756 ;; Pre-read character is in r5 (charset-ID) and r6 (code-point).
757 ((r0 = r5)
aa15b3e5
KH		 758 (r1 = r6)
759 (r5 = -1)))
c71c26e9 760 (translate-character utf-translation-table-for-encode r0 r1)
aa15b3e5
KH		 761
762 (if (r0 == ,(charset-id 'ascii))
c71c26e9
KH		 763 (write-repeat r1))
764
765 (if (r0 == ,(charset-id 'latin-iso8859-1))
766 ;; r1 scalar utf-8
767 ;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx
768 ;; 20 0000 0000 1010 0000 1100 0010 1010 0000
769 ;; 7f 0000 0000 1111 1111 1100 0011 1011 1111
c1136bda 770 ((write ((r1 >> 6) | #xc2))
c71c26e9
KH		 771 (r1 &= #x3f)
772 (r1 |= #x80)
c71c26e9
KH		 773 (write-repeat r1)))
774
775 (if (r0 == ,(charset-id 'mule-unicode-0100-24ff))
776 ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
777 ;; #x3f80 == (0011 1111 1000 0000)b
778 (r1 &= #x7f)
779 (r1 += (r0 + 224)) ; 240 == -32 + #x0100
780 ;; now r1 holds scalar value
781 (if (r1 < #x0800)
782 ;; 2byte encoding
783 ((write ((r1 >> 6) | #xC0))
784 (r1 &= #x3F)
785 (r1 |= #x80)
786 (write-repeat r1))
787 ;; 3byte encoding
788 ((write ((r1 >> 12) | #xE0))
789 (write (((r1 & #x0FC0) >> 6) | #x80))
790 (r1 &= #x3F)
791 (r1 |= #x80)
792 (write-repeat r1)))))
793
794 (if (r0 == ,(charset-id 'mule-unicode-2500-33ff))
795 ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
796 (r1 &= #x7f)
797 (r1 += (r0 + 9440)) ; 9440 == -32 + #x2500
798 ;; now r1 holds scalar value
799 (write ((r1 >> 12) | #xE0))
800 (write (((r1 & #x0FC0) >> 6) | #x80))
801 (r1 &= #x3F)
802 (r1 |= #x80)
803 (write-repeat r1)))
804
805 (if (r0 == ,(charset-id 'mule-unicode-e000-ffff))
806 ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
807 (r1 &= #x7f)
808 (r1 += (r0 + 57312)) ; 57312 == -32 + #xe000
809 ;; now r1 holds scalar value
810 (write ((r1 >> 12) | #xE0))
811 (write (((r1 & #x0FC0) >> 6) | #x80))
812 (r1 &= #x3F)
813 (r1 |= #x80)
814 (write-repeat r1)))
815
816 (if (r0 == ,(charset-id 'eight-bit-control))
817 ;; r1 scalar utf-8
818 ;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx
819 ;; 80 0000 0000 1000 0000 1100 0010 1000 0000
820 ;; 9f 0000 0000 1001 1111 1100 0010 1001 1111
821 ((write #xC2)
822 (write-repeat r1)))
823
824 (if (r0 == ,(charset-id 'eight-bit-graphic))
825 ;; r1 scalar utf-8
826 ;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx
827 ;; a0 0000 0000 1010 0000 1100 0010 1010 0000
828 ;; ff 0000 0000 1111 1111 1101 1111 1011 1111
829 ((r0 = (r1 >= #xC0))
830 (r0 &= (r1 <= #xC3))
831 (r4 = (r1 >= #xE1))
832 (r4 &= (r1 <= #xF7))
833 (r0 |= r4)
834 (if r0
835 ((call ccl-mule-utf-8-encode-untrans)
836 (repeat))
837 (write-repeat r1))))
838
839 (lookup-character utf-subst-table-for-encode r0 r1)
840 (if r7 ; lookup succeeded
841 (if (r0 < #x800)
842 ;; 2byte encoding
843 ((write ((r0 >> 6) | #xC0))
c1136bda
KH		 844 (r0 = ((r0 & #x3F) | #x80))
845 (write-repeat r0))
c71c26e9
KH		 846 ;; 3byte encoding
847 ((write ((r0 >> 12) | #xE0))
848 (write (((r0 & #x0FC0) >> 6) | #x80))
c1136bda
KH		 849 (r0 = ((r0 & #x3F) | #x80))
850 (write-repeat r0))))
5ba7a870 851
c71c26e9
KH		 852 ;; Unsupported character.
853 ;; Output U+FFFD, which is `ef bf bd' in UTF-8.
854 (write #xef)
855 (write #xbf)
856 (write-repeat #xbd))))
9ca2ac2d 857 "CCL program to encode into UTF-8.")
5ba7a870 858
aa2e3f49 859
9ca2ac2d
DL		 860(define-ccl-program ccl-untranslated-to-ucs
861 `(0
c71c26e9
KH		 862 (if (r1 == 0)
863 nil
864 (if (r0 <= #xC3) ; 2-byte encoding
865 ((r0 = ((r0 & #x3) << 6))
866 (r0 |= (r1 & #x3F))
867 (r1 = 2))
868 (if (r2 == 0)
869 (r1 = 0)
870 (if (r0 < #xF0) ; 3-byte encoding, as above
871 ((r0 = ((r0 & #xF) << 12))
872 (r0 |= ((r1 & #x3F) << 6))
064cff0b 873 (r0 |= (r2 & #x3F))
c71c26e9
KH		 874 (r1 = 3))
875 (if (r3 == 0)
876 (r1 = 0)
877 ((r0 = ((r0 & #x7) << 18))
878 (r0 |= ((r1 & #x3F) << 12))
879 (r0 |= ((r2 & #x3F) << 6))
880 (r0 |= (r3 & #x3F))
881 (r1 = 4))))))))
882 "Decode 2-, 3-, or 4-byte sequences in r0, r1, r2 [,r3] to unicodes in r0.
883Set r1 to the byte length. r0 == 0 for invalid sequence.")
9ca2ac2d
DL		 884
885(defvar utf-8-ccl-regs (make-vector 8 0))
886
aa2e3f49 887(defsubst utf-8-untranslated-to-ucs ()
9ca2ac2d
DL		 888 "Return the UCS code for an untranslated sequence of raw bytes t point.
889Only for 3- or 4-byte sequences."
890 (aset utf-8-ccl-regs 0 (or (char-after) 0))
891 (aset utf-8-ccl-regs 1 (or (char-after (1+ (point))) 0))
892 (aset utf-8-ccl-regs 2 (or (char-after (+ 2 (point))) 0))
893 (aset utf-8-ccl-regs 3 (or (char-after (+ 3 (point))) 0))
c71c26e9 894 (ccl-execute 'ccl-untranslated-to-ucs utf-8-ccl-regs))
aa2e3f49
DL		 895
896(defun utf-8-help-echo (window object position)
897 (format "Untranslated Unicode U+%04X"
898 (get-char-property position 'untranslated-utf-8 object)))
899
c71c26e9
KH		 900;; We compose the untranslatable sequences into a single character,
901;; and move point to the next character.
aa2e3f49
DL		 902;; This is infelicitous for editing, because there's currently no
903;; mechanism for treating compositions as atomic, but is OK for
9ca2ac2d
DL		 904;; display. They are composed to U+FFFD with help-echo which
905;; indicates the unicodes they represent. This function GCs too much.
c71c26e9
KH		 906
907;; If utf-translate-cjk-mode is non-nil, this function is called with
908;; HASH-TABLE which translates CJK characters into some of CJK
909;; charsets.
910
911(defsubst utf-8-compose (hash-table)
912 "Put a suitable composition on an untranslatable sequence at point.
913If HASH-TABLE is non-nil, try to translate CJK characters by it at first.
914Move point to the end of the sequence."
915 (utf-8-untranslated-to-ucs)
916 (let ((l (aref utf-8-ccl-regs 1))
917 ch)
918 (if (> l 0)
919 (if (and hash-table
920 (setq ch (gethash (aref utf-8-ccl-regs 0) hash-table)))
921 (progn
922 (insert ch)
923 (delete-region (point) (min (point-max) (+ l (point)))))
924 (setq ch (aref utf-8-ccl-regs 0))
925 (put-text-property (point) (min (point-max) (+ l (point)))
926 'untranslated-utf-8 ch)
927 (put-text-property (point) (min (point-max) (+ l (point)))
928 'help-echo 'utf-8-help-echo)
929 (if (= l 2)
930 (put-text-property (point) (min (point-max) (+ l (point)))
931 'display (format "\\%03o" ch))
932 (compose-region (point) (+ l (point)) ?\e$,3u=\e(B))
933 (forward-char l))
934 (forward-char 1))))
aa2e3f49
DL		 935
936(defcustom utf-8-compose-scripts nil
9ca2ac2d 937 "*Non-nil means compose various scripts on decoding utf-8 text."
aa2e3f49 938 :group 'mule
9ca2ac2d
DL		 939 :version "21.4"
940 :type 'boolean)
aa2e3f49
DL		 941
942(defun utf-8-post-read-conversion (length)
943 "Compose untranslated utf-8 sequences into single characters.
c71c26e9 944If `utf-translate-cjk-mode' is non-nil, tries to translate CJK characters.
aa2e3f49
DL		 945Also compose particular scripts if `utf-8-compose-scripts' is non-nil."
946 (save-excursion
c71c26e9
KH		 947 (save-restriction
948 (narrow-to-region (point) (+ (point) length))
949 ;; Can't do eval-when-compile to insert a multibyte constant
950 ;; version of the string in the loop, since it's always loaded as
951 ;; unibyte from a byte-compiled file.
952 (let ((range (string-as-multibyte "^\xc0-\xc3\xe1-\xf7"))
11d2e01b 953 (buffer-multibyte enable-multibyte-characters)
c71c26e9 954 hash-table ch)
11d2e01b 955 (set-buffer-multibyte t)
c71c26e9 956 (when utf-translate-cjk-mode
fce59e40
KH		 957 (unless utf-translate-cjk-lang-env
958 ;; Check these characters in utf-translate-cjk-range.
959 ;; We may have to translate them to CJK charsets.
960 (skip-chars-forward
961 (concat range utf-translate-cjk-unicode-range-string))
962 (unless (eobp)
963 (utf-translate-cjk-load-tables)
964 (setq range
3ccf95cb
KH		 965 (concat range utf-translate-cjk-unicode-range-string)))
966 (setq hash-table (get 'utf-subst-table-for-decode
967 'translation-hash-table))))
c71c26e9
KH		 968 (while (and (skip-chars-forward range)
969 (not (eobp)))
970 (setq ch (following-char))
971 (if (< ch 256)
972 (utf-8-compose hash-table)
973 (if (and hash-table
974 (setq ch (gethash (encode-char ch 'ucs) hash-table)))
975 (progn
976 (insert ch)
977 (delete-char 1))
11d2e01b
KH		 978 (forward-char 1))))
979 (or buffer-multibyte
980 (set-buffer-multibyte nil)))
c71c26e9
KH		 981
982 (when (and utf-8-compose-scripts (> length 1))
983 ;; These currently have definitions which cover the relevant
984 ;; unicodes. We could avoid loading thai-util &c by checking
985 ;; whether the region contains any characters with the appropriate
986 ;; categories. There aren't yet Unicode-based rules for Tibetan.
987 (diacritic-compose-region (point-max) (point-min))
988 (thai-compose-region (point-max) (point-min))
989 (lao-compose-region (point-max) (point-min))
990 (devanagari-compose-region (point-max) (point-min))
991 (malayalam-compose-region (point-max) (point-min))
992 (tamil-compose-region (point-max) (point-min)))
993 (- (point-max) (point-min)))))
994
995(defun utf-8-pre-write-conversion (beg end)
996 "Prepare for `utf-translate-cjk-mode' to encode text between BEG and END.
997This is used as a post-read-conversion of utf-8 coding system."
998 (if (and utf-translate-cjk-mode
999 (not utf-translate-cjk-lang-env)
1000 (save-excursion
1001 (goto-char beg)
1002 (re-search-forward "\\cc\\|\\cj\\|\\ch" end t)))
1003 (utf-translate-cjk-load-tables))
1004 nil)
aa2e3f49 1005
5ba7a870
KH		 1006(make-coding-system
1007 'mule-utf-8 4 ?u
1008 "UTF-8 encoding for Emacs-supported Unicode characters.
ad88f5c5
KH		 1009It supports Unicode characters of these ranges:
1010 U+0000..U+33FF, U+E000..U+FFFF.
1011They correspond to these Emacs character sets:
1012 ascii, latin-iso8859-1, mule-unicode-0100-24ff,
1013 mule-unicode-2500-33ff, mule-unicode-e000-ffff
1014
1015On decoding (e.g. reading a file), Unicode characters not in the above
1016ranges are decoded into sequences of eight-bit-control and
1017eight-bit-graphic characters to preserve their byte sequences. The
1018byte sequence is preserved on i/o for valid utf-8, but not necessarily
1019for invalid utf-8.
1020
1021On encoding (e.g. writing a file), Emacs characters not belonging to
1022any of the character sets listed above are encoded into the UTF-8 byte
1023sequence representing U+FFFD (REPLACEMENT CHARACTER)."
5ba7a870
KH		 1024
1025 '(ccl-decode-mule-utf-8 . ccl-encode-mule-utf-8)
c71c26e9 1026 `((safe-charsets
5ba7a870
KH		 1027 ascii
1028 eight-bit-control
1029 eight-bit-graphic
1030 latin-iso8859-1
1031 mule-unicode-0100-24ff
1032 mule-unicode-2500-33ff
c71c26e9
KH		 1033 mule-unicode-e000-ffff
1034 ,@(if utf-translate-cjk-mode
1035 utf-translate-cjk-charsets))
87ae7973 1036 (mime-charset . utf-8)
75f6d723 1037 (coding-category . coding-category-utf-8)
aa2e3f49 1038 (valid-codes (0 . 255))
c71c26e9 1039 (pre-write-conversion . utf-8-pre-write-conversion)
ad88f5c5 1040 (post-read-conversion . utf-8-post-read-conversion)
2bf07f07 1041 (translation-table-for-encode . utf-translation-table-for-encode)
ad88f5c5
KH		 1042 (dependency unify-8859-on-encoding-mode
1043 unify-8859-on-decoding-mode
1044 utf-fragment-on-decoding
9e24a165 1045 utf-translate-cjk-mode)))
5ba7a870
KH		 1046
1047(define-coding-system-alias 'utf-8 'mule-utf-8)
e8af40ee 1048
aa2e3f49
DL		 1049;; I think this needs special private charsets defined for the
1050;; untranslated sequences, if it's going to work well.
1051
1052;;; (defun utf-8-compose-function (pos to pattern &optional string)
1053;;; (let* ((prop (get-char-property pos 'composition string))
1054;;; (l (and prop (- (cadr prop) (car prop)))))
1055;;; (cond ((and l (> l (- to pos)))
1056;;; (delete-region pos to))
1057;;; ((and (> (char-after pos) 224)
1058;;; (< (char-after pos) 256)
1059;;; (save-restriction
1060;;; (narrow-to-region pos to)
1061;;; (utf-8-compose)))
1062;;; t))))
1063
1064;;; (dotimes (i 96)
1065;;; (aset composition-function-table
1066;;; (+ 128 i)
1067;;; `((,(string-as-multibyte "[\200-\237\240-\377]")
1068;;; . utf-8-compose-function))))
1069
ab5796a9 1070;;; arch-tag: b08735b7-753b-4ae6-b754-0f3efe4515c5
e8af40ee 1071;;; utf-8.el ends here
Unnamed repository; edit this file 'description' to name the repository.