HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Fix previous change.
[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
7d9d5480 197 katakana-jisx0201
c71c26e9
KH		 198 korean-ksc5601)
199 "List of charsets supported by `utf-translate-cjk-mode'.")
200
fce59e40
KH		 201(defvar utf-translate-cjk-lang-env nil
202 "Language environment in which tables for `utf-translate-cjk-mode' is loaded.
203The value nil means that the tables are not yet loaded.")
204
205(defvar utf-translate-cjk-unicode-range)
206
207;; String generated from utf-translate-cjk-unicode-range. It is
208;; suitable for an argument to skip-chars-forward.
209(defvar utf-translate-cjk-unicode-range-string nil)
210
211(defun utf-translate-cjk-set-unicode-range (range)
212 (setq utf-translate-cjk-unicode-range range)
213 (setq utf-translate-cjk-unicode-range-string
214 (let ((decode-char-no-trans
215 #'(lambda (x)
216 (cond ((< x #x100) (make-char 'latin-iso8859-1 x))
217 ((< x #x2500)
218 (setq x (- x #x100))
219 (make-char 'mule-unicode-0100-24ff
220 (+ (/ x 96) 32) (+ (% x 96) 32)))
221 ((< x #x3400)
222 (setq x (- x #x2500))
223 (make-char 'mule-unicode-2500-33ff
224 (+ (/ x 96) 32) (+ (% x 96) 32)))
225 (t
226 (setq x (- x #xe000))
227 (make-char 'mule-unicode-e000-ffff
228 (+ (/ x 96) 32) (+ (% x 96) 32))))))
229 ranges from to)
230 (dolist (elt range)
231 (setq from (max #xA0 (car elt)) to (min #xffff (cdr elt)))
232 (if (and (>= to #x3400) (< to #xE000))
233 (setq to #x33FF))
234 (cond ((< from #x100)
235 (if (>= to #xE000)
236 (setq ranges (cons (cons #xE000 to) ranges)
237 to #x33FF))
238 (if (>= to #x2500)
239 (setq ranges (cons (cons #x2500 to) ranges)
240 to #x24FF))
241 (if (>= to #x100)
242 (setq ranges (cons (cons #x100 to) ranges)
243 to #xFF)))
244 ((< from #x2500)
245 (if (>= to #xE000)
246 (setq ranges (cons (cons #xE000 to) ranges)
247 to #x33FF))
248 (if (>= to #x2500)
249 (setq ranges (cons (cons #x2500 to) ranges)
250 to #x24FF)))
251 ((< from #x3400)
252 (if (>= to #xE000)
253 (setq ranges (cons (cons #xE000 to) ranges)
254 to #x33FF))))
255 (if (<= from to)
256 (setq ranges (cons (cons from to) ranges))))
257 (mapconcat #'(lambda (x)
258 (format "%c-%c"
259 (funcall decode-char-no-trans (car x))
260 (funcall decode-char-no-trans (cdr x))))
261 ranges "")))
3ccf95cb
KH		 262 ;; These forces loading and settting tables for
263 ;; utf-translate-cjk-mode.
264 (setq utf-translate-cjk-lang-env nil
265 ucs-mule-cjk-to-unicode (make-hash-table :test 'eq)
266 ucs-unicode-to-mule-cjk (make-hash-table :test 'eq)))
fce59e40
KH		 267
268(defcustom utf-translate-cjk-unicode-range '((#x2e80 . #xd7a3)
269 (#xff00 . #xffef))
270 "List of Unicode code ranges supported by `utf-translate-cjk-mode'.
271Setting this variable directly does not take effect;
272use either \\[customize] or the function
273`utf-translate-cjk-set-unicode-range'."
274 :version "21.4"
275 :type '(repeat (cons integer integer))
276 :set (lambda (symbol value)
277 (utf-translate-cjk-set-unicode-range value))
278 :group 'mule)
c71c26e9
KH		 279
280;; Return non-nil if CODE-POINT is in `utf-translate-cjk-unicode-range'.
281(defsubst utf-translate-cjk-substitutable-p (code-point)
282 (let ((tail utf-translate-cjk-unicode-range)
283 elt)
284 (while tail
285 (setq elt (car tail) tail (cdr tail))
286 (if (and (>= code-point (car elt)) (<= code-point (cdr elt)))
287 (setq tail nil)
288 (setq elt nil)))
289 elt))
290
c71c26e9
KH		 291(defun utf-translate-cjk-load-tables ()
292 "Load tables for `utf-translate-cjk-mode'."
293 ;; Fixme: Allow the use of the CJK charsets to be
294 ;; customized by reordering and possible omission.
295 (let ((redefined (< (hash-table-size ucs-mule-cjk-to-unicode) 43000)))
296 (if redefined
297 ;; Redefine them with realistic initial sizes and a
298 ;; smallish rehash size to avoid wasting significant
299 ;; space after they're built.
300 (setq ucs-mule-cjk-to-unicode
301 (make-hash-table :test 'eq :size 43000 :rehash-size 1000)
302 ucs-unicode-to-mule-cjk
303 (make-hash-table :test 'eq :size 21500 :rehash-size 1000)))
304
305 ;; Load the files explicitly, to avoid having to keep
306 ;; around the large tables they contain (as well as the
307 ;; ones which get built).
308 (cond ((string= "Korean" current-language-environment)
309 (load "subst-jis")
310 (load "subst-big5")
311 (load "subst-gb2312")
312 (load "subst-ksc"))
313 ((string= "Chinese-BIG5" current-language-environment)
314 (load "subst-jis")
315 (load "subst-ksc")
316 (load "subst-gb2312")
317 (load "subst-big5"))
318 ((string= "Chinese-GB" current-language-environment)
319 (load "subst-jis")
320 (load "subst-ksc")
321 (load "subst-big5")
322 (load "subst-gb2312"))
323 (t
324 (load "subst-ksc")
325 (load "subst-gb2312")
326 (load "subst-big5")
327 (load "subst-jis"))) ; jis covers as much as big5, gb2312
328
329 (when redefined
330 (define-translation-hash-table 'utf-subst-table-for-decode
331 ucs-unicode-to-mule-cjk)
332 (define-translation-hash-table 'utf-subst-table-for-encode
333 ucs-mule-cjk-to-unicode)
334 (set-char-table-extra-slot (get 'utf-translation-table-for-encode
335 'translation-table)
336 1 ucs-mule-cjk-to-unicode))
337
338 (setq utf-translate-cjk-lang-env current-language-environment)))
339
340(defun utf-lookup-subst-table-for-decode (code-point)
341 (if (and utf-translate-cjk-mode
342 (not utf-translate-cjk-lang-env)
343 (utf-translate-cjk-substitutable-p code-point))
344 (utf-translate-cjk-load-tables))
345 (gethash code-point
346 (get 'utf-subst-table-for-decode 'translation-hash-table)))
4bcce19c 347
c71c26e9
KH		 348
349(defun utf-lookup-subst-table-for-encode (char)
350 (if (and utf-translate-cjk-mode
351 (not utf-translate-cjk-lang-env)
352 (memq (char-charset char) utf-translate-cjk-charsets))
353 (utf-translate-cjk-load-tables))
354 (gethash char
355 (get 'utf-subst-table-for-encode 'translation-hash-table)))
4bcce19c 356
fcfdeaf6 357(define-minor-mode utf-translate-cjk-mode
4bcce19c
LT		 358 "Toggle whether UTF based coding systems de/encode CJK characters.
359If ARG is an integer, enable if ARG is positive and disable if
360zero or negative. This is a minor mode.
c71c26e9 361Enabling this allows the coding systems mule-utf-8,
72b338a2 362mule-utf-16le and mule-utf-16be to encode characters in the charsets
ccdd5c61
DL		 363`korean-ksc5601', `chinese-gb2312', `chinese-big5-1',
364`chinese-big5-2', `japanese-jisx0208' and `japanese-jisx0212', and to
365decode the corresponding unicodes into such characters.
366
367Where the charsets overlap, the one preferred for decoding is chosen
368according to the language environment in effect when this option is
369turned on: ksc5601 for Korean, gb2312 for Chinese-GB, big5 for
370Chinese-Big5 and jisx for other environments.
371
4bcce19c 372This mode is on by default. If you are not interested in CJK
c71c26e9 373characters and want to avoid some overhead on encoding/decoding
4bcce19c
LT		 374by the above coding systems, you can customize the user option
375`utf-translate-cjk-mode' to nil."
c71c26e9 376 :init-value t
9ca2ac2d
DL		 377 :version "21.4"
378 :type 'boolean
fcfdeaf6
KG		 379 :group 'mule
380 :global t
381 (if utf-translate-cjk-mode
fcfdeaf6 382 (progn
2bf07f07
KH		 383 (define-translation-hash-table 'utf-subst-table-for-decode
384 ucs-unicode-to-mule-cjk)
385 (define-translation-hash-table 'utf-subst-table-for-encode
386 ucs-mule-cjk-to-unicode)
387 (set-char-table-extra-slot (get 'utf-translation-table-for-encode
388 'translation-table)
389 1 ucs-mule-cjk-to-unicode))
aea797fc
KH		 390 (define-translation-hash-table 'utf-subst-table-for-decode
391 (make-hash-table :test 'eq))
392 (define-translation-hash-table 'utf-subst-table-for-encode
2bf07f07
KH		 393 (make-hash-table :test 'eq))
394 (set-char-table-extra-slot (get 'utf-translation-table-for-encode
395 'translation-table)
c71c26e9
KH		 396 1 nil))
397
398 ;; Update safe-chars of mule-utf-* coding systems.
399 (dolist (elt (coding-system-list t))
400 (if (string-match "^mule-utf" (symbol-name elt))
401 (let ((safe-charsets (coding-system-get elt 'safe-charsets))
402 (safe-chars (coding-system-get elt 'safe-chars))
403 (need-update nil))
404 (dolist (charset utf-translate-cjk-charsets)
405 (unless (eq utf-translate-cjk-mode (memq charset safe-charsets))
406 (setq safe-charsets
407 (if utf-translate-cjk-mode
408 (cons charset safe-charsets)
409 (delq charset safe-charsets))
410 need-update t)
411 (aset safe-chars (make-char charset) utf-translate-cjk-mode)))
412 (when need-update
413 (coding-system-put elt 'safe-charsets safe-charsets)
414 (define-coding-system-internal elt))))))
415
416(define-ccl-program ccl-mule-utf-untrans
417 ;; R0 is an untranslatable Unicode code-point (U+3500..U+DFFF or
418 ;; U+10000..U+10FFFF) or an invaid byte (#x00..#xFF). Write
419 ;; eight-bit-control/graphic sequence (2 to 4 chars) representing
420 ;; UTF-8 sequence of r0. Registers r4, r5, r6 are modified.
421 ;;
422 ;; This is a subrountine because we assume that this is called very
423 ;; rarely (so we don't have to worry about the overhead of the
424 ;; call).
425 `(0
426 ((r5 = ,(charset-id 'eight-bit-control))
427 (r6 = ,(charset-id 'eight-bit-graphic))
428 (if (r0 < #x100)
429 ((r4 = ((r0 >> 6) | #xC0))
430 (write-multibyte-character r6 r4))
431 ((if (r0 < #x10000)
432 ((r4 = ((r0 >> 12) | #xE0))
433 (write-multibyte-character r6 r4))
434 ((r4 = ((r0 >> 18) | #xF0))
435 (write-multibyte-character r6 r4)
436 (r4 = (((r0 >> 12) & #x3F) | #x80))
437 (if (r4 < #xA0)
438 (write-multibyte-character r5 r4)
439 (write-multibyte-character r6 r4))))
440 (r4 = (((r0 >> 6) & #x3F) | #x80))
441 (if (r4 < #xA0)
442 (write-multibyte-character r5 r4)
443 (write-multibyte-character r6 r4))))
444 (r4 = ((r0 & #x3F) | #x80))
445 (if (r4 < #xA0)
446 (write-multibyte-character r5 r4)
447 (write-multibyte-character r6 r4)))))
9ca2ac2d 448
5ba7a870
KH		 449(define-ccl-program ccl-decode-mule-utf-8
450 ;;
451 ;; charset | bytes in utf-8 | bytes in emacs
452 ;; -----------------------+----------------+---------------
453 ;; ascii | 1 | 1
454 ;; -----------------------+----------------+---------------
455 ;; eight-bit-control | 2 | 2
aa2e3f49 456 ;; eight-bit-graphic | 2 | 1
5ba7a870
KH		 457 ;; latin-iso8859-1 | 2 | 2
458 ;; -----------------------+----------------+---------------
459 ;; mule-unicode-0100-24ff | 2 | 4
460 ;; (< 0800) | |
461 ;; -----------------------+----------------+---------------
462 ;; mule-unicode-0100-24ff | 3 | 4
463 ;; (>= 8000) | |
464 ;; mule-unicode-2500-33ff | 3 | 4
465 ;; mule-unicode-e000-ffff | 3 | 4
c71c26e9
KH		 466 ;; -----------------------+----------------+---------------
467 ;; invalid byte | 1 | 2
5ba7a870
KH		 468 ;;
469 ;; Thus magnification factor is two.
470 ;;
471 `(2
064cff0b
KH		 472 ((r6 = ,(charset-id 'latin-iso8859-1))
473 (read r0)
3d0e328b 474 (loop
5ba7a870 475 (if (r0 < #x80)
c71c26e9 476 ;; 1-byte encoding, i.e., ascii
064cff0b
KH		 477 (write-read-repeat r0))
478 (if (r0 < #xc2)
479 ;; continuation byte (invalid here) or 1st byte of overlong
480 ;; 2-byte sequence.
c71c26e9 481 ((call ccl-mule-utf-untrans)
064cff0b
KH		 482 (r6 = ,(charset-id 'latin-iso8859-1))
483 (read r0)
c71c26e9
KH		 484 (repeat)))
485
486 ;; Read the 2nd byte.
c71c26e9
KH		 487 (read r1)
488 (if ((r1 & #b11000000) != #b10000000) ; Invalid 2nd byte
489 ((call ccl-mule-utf-untrans)
064cff0b 490 (r6 = ,(charset-id 'latin-iso8859-1))
c71c26e9
KH		 491 ;; Handle it in the next loop.
492 (r0 = r1)
493 (repeat)))
494
495 (if (r0 < #xe0)
496 ;; 2-byte encoding 00000yyyyyxxxxxx = 110yyyyy 10xxxxxx
064cff0b
KH		 497 ((r1 &= #x3F)
498 (r1 |= ((r0 & #x1F) << 6))
3ccf95cb 499 ;; Now r1 holds scalar value. We don't have to check
064cff0b 500 ;; `overlong sequence' because r0 >= 0xC2.
c71c26e9 501
064cff0b 502 (if (r1 >= 256)
c71c26e9 503 ;; mule-unicode-0100-24ff (< 0800)
3ccf95cb
KH		 504 ((r0 = r1)
505 (lookup-integer utf-subst-table-for-decode r0 r1)
506 (if (r7 == 0)
507 ((r0 = ,(charset-id 'mule-unicode-0100-24ff))
508 (r1 -= #x0100)
509 (r2 = (((r1 / 96) + 32) << 7))
510 (r1 %= 96)
511 (r1 += (r2 + 32))
512 (translate-character
513 utf-translation-table-for-decode r0 r1)))
064cff0b
KH		 514 (write-multibyte-character r0 r1)
515 (read r0)
516 (repeat))
517 (if (r1 >= 160)
518 ;; latin-iso8859-1
3ccf95cb
KH		 519 ((r0 = r1)
520 (lookup-integer utf-subst-table-for-decode r0 r1)
521 (if (r7 == 0)
522 ((r1 -= 128)
523 (write-multibyte-character r6 r1))
524 ((write-multibyte-character r0 r1)))
064cff0b
KH		 525 (read r0)
526 (repeat))
527 ;; eight-bit-control
528 ((r0 = ,(charset-id 'eight-bit-control))
529 (write-multibyte-character r0 r1)
530 (read r0)
531 (repeat))))))
c71c26e9
KH		 532
533 ;; Read the 3rd bytes.
c71c26e9
KH		 534 (read r2)
535 (if ((r2 & #b11000000) != #b10000000) ; Invalid 3rd byte
536 ((call ccl-mule-utf-untrans)
537 (r0 = r1)
538 (call ccl-mule-utf-untrans)
064cff0b 539 (r6 = ,(charset-id 'latin-iso8859-1))
c71c26e9
KH		 540 ;; Handle it in the next loop.
541 (r0 = r2)
542 (repeat)))
543
544 (if (r0 < #xF0)
545 ;; 3byte encoding
546 ;; zzzzyyyyyyxxxxxx = 1110zzzz 10yyyyyy 10xxxxxx
547 ((r3 = ((r0 & #xF) << 12))
548 (r3 |= ((r1 & #x3F) << 6))
549 (r3 |= (r2 & #x3F))
550
551 (if (r3 < #x800) ; `overlong sequence'
552 ((call ccl-mule-utf-untrans)
553 (r0 = r1)
554 (call ccl-mule-utf-untrans)
555 (r0 = r2)
556 (call ccl-mule-utf-untrans)
064cff0b
KH		 557 (r6 = ,(charset-id 'latin-iso8859-1))
558 (read r0)
c71c26e9
KH		 559 (repeat)))
560
561 (if (r3 < #x2500)
562 ;; mule-unicode-0100-24ff (>= 0800)
3ccf95cb
KH		 563 ((r0 = r3)
564 (lookup-integer utf-subst-table-for-decode r0 r1)
565 (if (r7 == 0)
566 ((r0 = ,(charset-id 'mule-unicode-0100-24ff))
567 (r3 -= #x0100)
568 (r3 //= 96)
569 (r1 = (r7 + 32))
570 (r1 += ((r3 + 32) << 7))
571 (translate-character
572 utf-translation-table-for-decode r0 r1)))
c71c26e9 573 (write-multibyte-character r0 r1)
064cff0b 574 (read r0)
c71c26e9
KH		 575 (repeat)))
576
577 (if (r3 < #x3400)
578 ;; mule-unicode-2500-33ff
579 ((r0 = r3) ; don't zap r3
580 (lookup-integer utf-subst-table-for-decode r0 r1)
581 (if (r7 == 0)
582 ((r0 = ,(charset-id 'mule-unicode-2500-33ff))
583 (r3 -= #x2500)
584 (r3 //= 96)
585 (r1 = (r7 + 32))
586 (r1 += ((r3 + 32) << 7))))
587 (write-multibyte-character r0 r1)
064cff0b 588 (read r0)
c71c26e9
KH		 589 (repeat)))
590
591 (if (r3 < #xE000)
592 ;; Try to convert to CJK chars, else
593 ;; keep them as eight-bit-{control|graphic}.
594 ((r0 = r3)
595 (lookup-integer utf-subst-table-for-decode r3 r1)
596 (if r7
597 ;; got a translation
064cff0b
KH		 598 ((write-multibyte-character r3 r1)
599 (read r0)
600 (repeat))
601 ((call ccl-mule-utf-untrans)
602 (r6 = ,(charset-id 'latin-iso8859-1))
603 (read r0)
604 (repeat)))))
c71c26e9
KH		 605
606 ;; mule-unicode-e000-ffff
607 ;; Fixme: fffe and ffff are invalid.
608 (r0 = r3) ; don't zap r3
609 (lookup-integer utf-subst-table-for-decode r0 r1)
610 (if (r7 == 0)
611 ((r0 = ,(charset-id 'mule-unicode-e000-ffff))
612 (r3 -= #xe000)
613 (r3 //= 96)
614 (r1 = (r7 + 32))
615 (r1 += ((r3 + 32) << 7))))
616 (write-multibyte-character r0 r1)
064cff0b 617 (read r0)
c71c26e9
KH		 618 (repeat)))
619
620 ;; Read the 4th bytes.
c71c26e9
KH		 621 (read r3)
622 (if ((r3 & #b11000000) != #b10000000) ; Invalid 4th byte
623 ((call ccl-mule-utf-untrans)
624 (r0 = r1)
625 (call ccl-mule-utf-untrans)
064cff0b
KH		 626 (r0 = r2)
627 (call ccl-mule-utf-untrans)
628 (r6 = ,(charset-id 'latin-iso8859-1))
c71c26e9
KH		 629 ;; Handle it in the next loop.
630 (r0 = r3)
631 (repeat)))
632
064cff0b 633 (if (r0 < #xF8)
c71c26e9
KH		 634 ;; 4-byte encoding:
635 ;; wwwzzzzzzyyyyyyxxxxxx = 11110www 10zzzzzz 10yyyyyy 10xxxxxx
636 ;; keep those bytes as eight-bit-{control|graphic}
637 ;; Fixme: allow lookup in utf-subst-table-for-decode.
638 ((r4 = ((r0 & #x7) << 18))
639 (r4 |= ((r1 & #x3F) << 12))
640 (r4 |= ((r2 & #x3F) << 6))
641 (r4 |= (r3 & #x3F))
642
643 (if (r4 < #x10000) ; `overlong sequence'
644 ((call ccl-mule-utf-untrans)
645 (r0 = r1)
646 (call ccl-mule-utf-untrans)
647 (r0 = r2)
648 (call ccl-mule-utf-untrans)
649 (r0 = r3)
650 (call ccl-mule-utf-untrans))
651 ((r0 = r4)
064cff0b 652 (call ccl-mule-utf-untrans))))
c71c26e9 653
064cff0b
KH		 654 ;; Unsupported sequence.
655 ((call ccl-mule-utf-untrans)
656 (r0 = r1)
657 (call ccl-mule-utf-untrans)
658 (r0 = r2)
659 (call ccl-mule-utf-untrans)
660 (r0 = r3)
661 (call ccl-mule-utf-untrans)))
662 (r6 = ,(charset-id 'latin-iso8859-1))
663 (read r0)
67ff2216
KH		 664 (repeat)))
665
064cff0b 666
67ff2216
KH		 667 ;; At EOF...
668 (if (r0 >= 0)
c71c26e9
KH		 669 ;; r0 >= #x80
670 ((call ccl-mule-utf-untrans)
67ff2216 671 (if (r1 >= 0)
c71c26e9
KH		 672 ((r0 = r1)
673 (call ccl-mule-utf-untrans)
67ff2216 674 (if (r2 >= 0)
c71c26e9
KH		 675 ((r0 = r2)
676 (call ccl-mule-utf-untrans)
67ff2216 677 (if (r3 >= 0)
c71c26e9
KH		 678 ((r0 = r3)
679 (call ccl-mule-utf-untrans))))))))))
5ba7a870 680
c49b8288 681 "CCL program to decode UTF-8.
74ace46a 682Basic decoding is done into the charsets ascii, latin-iso8859-1 and
ad88f5c5
KH		 683mule-unicode-*, but see also `utf-fragmentation-table' and
684`ucs-mule-cjk-to-unicode'.
9ca2ac2d
DL		 685Encodings of un-representable Unicode characters are decoded asis into
686eight-bit-control and eight-bit-graphic characters.")
5ba7a870 687
c71c26e9
KH		 688(define-ccl-program ccl-mule-utf-8-encode-untrans
689 ;; UTF-8 decoder generates an UTF-8 sequence represented by a
690 ;; sequence eight-bit-control/graphic chars for an untranslatable
691 ;; character and an invalid byte.
4bcce19c 692 ;;
c71c26e9
KH		 693 ;; This CCL parses that sequence (the first byte is already in r1),
694 ;; writes out the original bytes of that sequence, and sets r5 to
695 ;; -1.
696 ;;
697 ;; If the eight-bit-control/graphic sequence is shorter than what r1
698 ;; suggests, it sets r5 and r6 to the last character read that
699 ;; should be handled by the next loop of a caller.
700 ;;
701 ;; Note: For UTF-8 validation, we only check if a character is
702 ;; eight-bit-control/graphic or not. It may result in incorrect
703 ;; handling of random binary data, but such a data can't be encoded
704 ;; by UTF-8 anyway. At least, UTF-8 decoders doesn't generate such
705 ;; a sequence even if a source contains invalid byte-sequence.
706 `(0
707 (;; Read the 2nd byte.
708 (read-multibyte-character r5 r6)
709 (r0 = (r5 != ,(charset-id 'eight-bit-control)))
710 (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
4bcce19c 711 ((write r1) ; invalid UTF-8
c71c26e9
KH		 712 (r1 = -1)
713 (end)))
714
715 (if (r1 <= #xC3)
716 ;; 2-byte sequence for an originally invalid byte.
717 ((r6 &= #x3F)
718 (r6 |= ((r1 & #x1F) << 6))
719 (write r6)
720 (r5 = -1)
721 (end)))
722
723 (write r1 r6)
724 (r2 = r1)
725 (r1 = -1)
726 ;; Read the 3rd byte.
727 (read-multibyte-character r5 r6)
4bcce19c 728 (r0 = (r5 != ,(charset-id 'eight-bit-control)))
c71c26e9
KH		 729 (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
730 (end)) ; invalid UTF-8
731 (write r6)
732 (if (r2 < #xF0)
733 ;; 3-byte sequence for an untranslated character.
734 ((r5 = -1)
735 (end)))
736 ;; Read the 4th byte.
737 (read-multibyte-character r5 r6)
4bcce19c 738 (r0 = (r5 != ,(charset-id 'eight-bit-control)))
c71c26e9
KH		 739 (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
740 (end)) ; invalid UTF-8
741 ;; 4-byte sequence for an untranslated character.
742 (write r6)
743 (r5 = -1)
744 (end))
745
746 ;; At EOF...
747 ((r5 = -1)
748 (if (r1 >= 0)
749 (write r1)))))
750
5ba7a870
KH		 751(define-ccl-program ccl-encode-mule-utf-8
752 `(1
aa15b3e5
KH		 753 ((r5 = -1)
754 (loop
755 (if (r5 < 0)
c71c26e9
KH		 756 (read-multibyte-character r0 r1)
757 ;; Pre-read character is in r5 (charset-ID) and r6 (code-point).
758 ((r0 = r5)
aa15b3e5
KH		 759 (r1 = r6)
760 (r5 = -1)))
c71c26e9 761 (translate-character utf-translation-table-for-encode r0 r1)
aa15b3e5
KH		 762
763 (if (r0 == ,(charset-id 'ascii))
c71c26e9
KH		 764 (write-repeat r1))
765
766 (if (r0 == ,(charset-id 'latin-iso8859-1))
767 ;; r1 scalar utf-8
768 ;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx
769 ;; 20 0000 0000 1010 0000 1100 0010 1010 0000
770 ;; 7f 0000 0000 1111 1111 1100 0011 1011 1111
c1136bda 771 ((write ((r1 >> 6) | #xc2))
c71c26e9
KH		 772 (r1 &= #x3f)
773 (r1 |= #x80)
c71c26e9
KH		 774 (write-repeat r1)))
775
776 (if (r0 == ,(charset-id 'mule-unicode-0100-24ff))
777 ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
778 ;; #x3f80 == (0011 1111 1000 0000)b
779 (r1 &= #x7f)
780 (r1 += (r0 + 224)) ; 240 == -32 + #x0100
781 ;; now r1 holds scalar value
782 (if (r1 < #x0800)
783 ;; 2byte encoding
784 ((write ((r1 >> 6) | #xC0))
785 (r1 &= #x3F)
786 (r1 |= #x80)
787 (write-repeat r1))
788 ;; 3byte encoding
789 ((write ((r1 >> 12) | #xE0))
790 (write (((r1 & #x0FC0) >> 6) | #x80))
791 (r1 &= #x3F)
792 (r1 |= #x80)
793 (write-repeat r1)))))
794
795 (if (r0 == ,(charset-id 'mule-unicode-2500-33ff))
796 ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
797 (r1 &= #x7f)
798 (r1 += (r0 + 9440)) ; 9440 == -32 + #x2500
799 ;; now r1 holds scalar value
800 (write ((r1 >> 12) | #xE0))
801 (write (((r1 & #x0FC0) >> 6) | #x80))
802 (r1 &= #x3F)
803 (r1 |= #x80)
804 (write-repeat r1)))
805
806 (if (r0 == ,(charset-id 'mule-unicode-e000-ffff))
807 ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
808 (r1 &= #x7f)
809 (r1 += (r0 + 57312)) ; 57312 == -32 + #xe000
810 ;; now r1 holds scalar value
811 (write ((r1 >> 12) | #xE0))
812 (write (((r1 & #x0FC0) >> 6) | #x80))
813 (r1 &= #x3F)
814 (r1 |= #x80)
815 (write-repeat r1)))
816
817 (if (r0 == ,(charset-id 'eight-bit-control))
818 ;; r1 scalar utf-8
819 ;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx
820 ;; 80 0000 0000 1000 0000 1100 0010 1000 0000
821 ;; 9f 0000 0000 1001 1111 1100 0010 1001 1111
822 ((write #xC2)
823 (write-repeat r1)))
824
825 (if (r0 == ,(charset-id 'eight-bit-graphic))
826 ;; r1 scalar utf-8
827 ;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx
828 ;; a0 0000 0000 1010 0000 1100 0010 1010 0000
829 ;; ff 0000 0000 1111 1111 1101 1111 1011 1111
830 ((r0 = (r1 >= #xC0))
831 (r0 &= (r1 <= #xC3))
832 (r4 = (r1 >= #xE1))
833 (r4 &= (r1 <= #xF7))
834 (r0 |= r4)
835 (if r0
836 ((call ccl-mule-utf-8-encode-untrans)
837 (repeat))
838 (write-repeat r1))))
839
840 (lookup-character utf-subst-table-for-encode r0 r1)
841 (if r7 ; lookup succeeded
842 (if (r0 < #x800)
843 ;; 2byte encoding
844 ((write ((r0 >> 6) | #xC0))
c1136bda
KH		 845 (r0 = ((r0 & #x3F) | #x80))
846 (write-repeat r0))
c71c26e9
KH		 847 ;; 3byte encoding
848 ((write ((r0 >> 12) | #xE0))
849 (write (((r0 & #x0FC0) >> 6) | #x80))
c1136bda
KH		 850 (r0 = ((r0 & #x3F) | #x80))
851 (write-repeat r0))))
5ba7a870 852
c71c26e9
KH		 853 ;; Unsupported character.
854 ;; Output U+FFFD, which is `ef bf bd' in UTF-8.
855 (write #xef)
856 (write #xbf)
857 (write-repeat #xbd))))
9ca2ac2d 858 "CCL program to encode into UTF-8.")
5ba7a870 859
aa2e3f49 860
9ca2ac2d
DL		 861(define-ccl-program ccl-untranslated-to-ucs
862 `(0
c71c26e9
KH		 863 (if (r1 == 0)
864 nil
865 (if (r0 <= #xC3) ; 2-byte encoding
866 ((r0 = ((r0 & #x3) << 6))
867 (r0 |= (r1 & #x3F))
868 (r1 = 2))
869 (if (r2 == 0)
870 (r1 = 0)
871 (if (r0 < #xF0) ; 3-byte encoding, as above
872 ((r0 = ((r0 & #xF) << 12))
873 (r0 |= ((r1 & #x3F) << 6))
064cff0b 874 (r0 |= (r2 & #x3F))
c71c26e9
KH		 875 (r1 = 3))
876 (if (r3 == 0)
877 (r1 = 0)
878 ((r0 = ((r0 & #x7) << 18))
879 (r0 |= ((r1 & #x3F) << 12))
880 (r0 |= ((r2 & #x3F) << 6))
881 (r0 |= (r3 & #x3F))
882 (r1 = 4))))))))
883 "Decode 2-, 3-, or 4-byte sequences in r0, r1, r2 [,r3] to unicodes in r0.
884Set r1 to the byte length. r0 == 0 for invalid sequence.")
9ca2ac2d
DL		 885
886(defvar utf-8-ccl-regs (make-vector 8 0))
887
aa2e3f49 888(defsubst utf-8-untranslated-to-ucs ()
9ca2ac2d
DL		 889 "Return the UCS code for an untranslated sequence of raw bytes t point.
890Only for 3- or 4-byte sequences."
891 (aset utf-8-ccl-regs 0 (or (char-after) 0))
892 (aset utf-8-ccl-regs 1 (or (char-after (1+ (point))) 0))
893 (aset utf-8-ccl-regs 2 (or (char-after (+ 2 (point))) 0))
894 (aset utf-8-ccl-regs 3 (or (char-after (+ 3 (point))) 0))
c71c26e9 895 (ccl-execute 'ccl-untranslated-to-ucs utf-8-ccl-regs))
aa2e3f49
DL		 896
897(defun utf-8-help-echo (window object position)
898 (format "Untranslated Unicode U+%04X"
899 (get-char-property position 'untranslated-utf-8 object)))
900
c71c26e9
KH		 901;; We compose the untranslatable sequences into a single character,
902;; and move point to the next character.
aa2e3f49
DL		 903;; This is infelicitous for editing, because there's currently no
904;; mechanism for treating compositions as atomic, but is OK for
9ca2ac2d
DL		 905;; display. They are composed to U+FFFD with help-echo which
906;; indicates the unicodes they represent. This function GCs too much.
c71c26e9
KH		 907
908;; If utf-translate-cjk-mode is non-nil, this function is called with
909;; HASH-TABLE which translates CJK characters into some of CJK
910;; charsets.
911
912(defsubst utf-8-compose (hash-table)
913 "Put a suitable composition on an untranslatable sequence at point.
914If HASH-TABLE is non-nil, try to translate CJK characters by it at first.
915Move point to the end of the sequence."
916 (utf-8-untranslated-to-ucs)
917 (let ((l (aref utf-8-ccl-regs 1))
918 ch)
919 (if (> l 0)
920 (if (and hash-table
921 (setq ch (gethash (aref utf-8-ccl-regs 0) hash-table)))
922 (progn
923 (insert ch)
924 (delete-region (point) (min (point-max) (+ l (point)))))
925 (setq ch (aref utf-8-ccl-regs 0))
926 (put-text-property (point) (min (point-max) (+ l (point)))
927 'untranslated-utf-8 ch)
928 (put-text-property (point) (min (point-max) (+ l (point)))
929 'help-echo 'utf-8-help-echo)
930 (if (= l 2)
931 (put-text-property (point) (min (point-max) (+ l (point)))
932 'display (format "\\%03o" ch))
933 (compose-region (point) (+ l (point)) ?\e$,3u=\e(B))
934 (forward-char l))
935 (forward-char 1))))
aa2e3f49
DL		 936
937(defcustom utf-8-compose-scripts nil
9ca2ac2d 938 "*Non-nil means compose various scripts on decoding utf-8 text."
aa2e3f49 939 :group 'mule
9ca2ac2d
DL		 940 :version "21.4"
941 :type 'boolean)
aa2e3f49
DL		 942
943(defun utf-8-post-read-conversion (length)
944 "Compose untranslated utf-8 sequences into single characters.
c71c26e9 945If `utf-translate-cjk-mode' is non-nil, tries to translate CJK characters.
aa2e3f49
DL		 946Also compose particular scripts if `utf-8-compose-scripts' is non-nil."
947 (save-excursion
c71c26e9
KH		 948 (save-restriction
949 (narrow-to-region (point) (+ (point) length))
950 ;; Can't do eval-when-compile to insert a multibyte constant
951 ;; version of the string in the loop, since it's always loaded as
952 ;; unibyte from a byte-compiled file.
953 (let ((range (string-as-multibyte "^\xc0-\xc3\xe1-\xf7"))
11d2e01b 954 (buffer-multibyte enable-multibyte-characters)
c71c26e9 955 hash-table ch)
11d2e01b 956 (set-buffer-multibyte t)
c71c26e9 957 (when utf-translate-cjk-mode
fce59e40
KH		 958 (unless utf-translate-cjk-lang-env
959 ;; Check these characters in utf-translate-cjk-range.
960 ;; We may have to translate them to CJK charsets.
961 (skip-chars-forward
962 (concat range utf-translate-cjk-unicode-range-string))
963 (unless (eobp)
964 (utf-translate-cjk-load-tables)
965 (setq range
3ccf95cb
KH		 966 (concat range utf-translate-cjk-unicode-range-string)))
967 (setq hash-table (get 'utf-subst-table-for-decode
968 'translation-hash-table))))
c71c26e9
KH		 969 (while (and (skip-chars-forward range)
970 (not (eobp)))
971 (setq ch (following-char))
972 (if (< ch 256)
973 (utf-8-compose hash-table)
974 (if (and hash-table
975 (setq ch (gethash (encode-char ch 'ucs) hash-table)))
976 (progn
977 (insert ch)
978 (delete-char 1))
11d2e01b
KH		 979 (forward-char 1))))
980 (or buffer-multibyte
981 (set-buffer-multibyte nil)))
c71c26e9
KH		 982
983 (when (and utf-8-compose-scripts (> length 1))
984 ;; These currently have definitions which cover the relevant
985 ;; unicodes. We could avoid loading thai-util &c by checking
986 ;; whether the region contains any characters with the appropriate
987 ;; categories. There aren't yet Unicode-based rules for Tibetan.
988 (diacritic-compose-region (point-max) (point-min))
989 (thai-compose-region (point-max) (point-min))
990 (lao-compose-region (point-max) (point-min))
991 (devanagari-compose-region (point-max) (point-min))
992 (malayalam-compose-region (point-max) (point-min))
993 (tamil-compose-region (point-max) (point-min)))
994 (- (point-max) (point-min)))))
995
996(defun utf-8-pre-write-conversion (beg end)
997 "Prepare for `utf-translate-cjk-mode' to encode text between BEG and END.
998This is used as a post-read-conversion of utf-8 coding system."
999 (if (and utf-translate-cjk-mode
1000 (not utf-translate-cjk-lang-env)
1001 (save-excursion
1002 (goto-char beg)
1003 (re-search-forward "\\cc\\|\\cj\\|\\ch" end t)))
1004 (utf-translate-cjk-load-tables))
1005 nil)
aa2e3f49 1006
5ba7a870
KH		 1007(make-coding-system
1008 'mule-utf-8 4 ?u
1009 "UTF-8 encoding for Emacs-supported Unicode characters.
ad88f5c5
KH		 1010It supports Unicode characters of these ranges:
1011 U+0000..U+33FF, U+E000..U+FFFF.
1012They correspond to these Emacs character sets:
1013 ascii, latin-iso8859-1, mule-unicode-0100-24ff,
1014 mule-unicode-2500-33ff, mule-unicode-e000-ffff
1015
1016On decoding (e.g. reading a file), Unicode characters not in the above
1017ranges are decoded into sequences of eight-bit-control and
1018eight-bit-graphic characters to preserve their byte sequences. The
1019byte sequence is preserved on i/o for valid utf-8, but not necessarily
1020for invalid utf-8.
1021
1022On encoding (e.g. writing a file), Emacs characters not belonging to
1023any of the character sets listed above are encoded into the UTF-8 byte
1024sequence representing U+FFFD (REPLACEMENT CHARACTER)."
5ba7a870
KH		 1025
1026 '(ccl-decode-mule-utf-8 . ccl-encode-mule-utf-8)
c71c26e9 1027 `((safe-charsets
5ba7a870
KH		 1028 ascii
1029 eight-bit-control
1030 eight-bit-graphic
1031 latin-iso8859-1
1032 mule-unicode-0100-24ff
1033 mule-unicode-2500-33ff
c71c26e9
KH		 1034 mule-unicode-e000-ffff
1035 ,@(if utf-translate-cjk-mode
1036 utf-translate-cjk-charsets))
87ae7973 1037 (mime-charset . utf-8)
75f6d723 1038 (coding-category . coding-category-utf-8)
aa2e3f49 1039 (valid-codes (0 . 255))
c71c26e9 1040 (pre-write-conversion . utf-8-pre-write-conversion)
ad88f5c5 1041 (post-read-conversion . utf-8-post-read-conversion)
2bf07f07 1042 (translation-table-for-encode . utf-translation-table-for-encode)
ad88f5c5
KH		 1043 (dependency unify-8859-on-encoding-mode
1044 unify-8859-on-decoding-mode
1045 utf-fragment-on-decoding
9e24a165 1046 utf-translate-cjk-mode)))
5ba7a870
KH		 1047
1048(define-coding-system-alias 'utf-8 'mule-utf-8)
e8af40ee 1049
aa2e3f49
DL		 1050;; I think this needs special private charsets defined for the
1051;; untranslated sequences, if it's going to work well.
1052
1053;;; (defun utf-8-compose-function (pos to pattern &optional string)
1054;;; (let* ((prop (get-char-property pos 'composition string))
1055;;; (l (and prop (- (cadr prop) (car prop)))))
1056;;; (cond ((and l (> l (- to pos)))
1057;;; (delete-region pos to))
1058;;; ((and (> (char-after pos) 224)
1059;;; (< (char-after pos) 256)
1060;;; (save-restriction
1061;;; (narrow-to-region pos to)
1062;;; (utf-8-compose)))
1063;;; t))))
1064
1065;;; (dotimes (i 96)
1066;;; (aset composition-function-table
1067;;; (+ 128 i)
1068;;; `((,(string-as-multibyte "[\200-\237\240-\377]")
1069;;; . utf-8-compose-function))))
1070
ab5796a9 1071;;; arch-tag: b08735b7-753b-4ae6-b754-0f3efe4515c5
e8af40ee 1072;;; utf-8.el ends here
Unnamed repository; edit this file 'description' to name the repository.