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