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