HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
New directory
[bpt/emacs.git] / lisp / international / utf-8.el
CommitLineData
9ca2ac2d 1;;; utf-8.el --- UTF-8 decoding/encoding support -*- coding: iso-2022-7bit -*-
5ba7a870
KH		 2
3;; Copyright (C) 2001 Electrotechnical Laboratory, JAPAN.
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
DL		 55
56;; UTF-8 is defined in RFC 2279. 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
100If `utf-translate-cjk' is non-nil, this table populates the
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
109If `utf-translate-cjk' is non-nil, this table populates the
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
fcfdeaf6 193(define-minor-mode utf-translate-cjk-mode
ad88f5c5 194 "Whether the UTF based coding systems should decode/encode CJK characters.
ccdd5c61 195Enabling this loads tables which allow the coding systems mule-utf-8,
72b338a2 196mule-utf-16le and mule-utf-16be to encode characters in the charsets
ccdd5c61
DL		 197`korean-ksc5601', `chinese-gb2312', `chinese-big5-1',
198`chinese-big5-2', `japanese-jisx0208' and `japanese-jisx0212', and to
199decode the corresponding unicodes into such characters.
200
201Where the charsets overlap, the one preferred for decoding is chosen
202according to the language environment in effect when this option is
203turned on: ksc5601 for Korean, gb2312 for Chinese-GB, big5 for
204Chinese-Big5 and jisx for other environments.
205
206The tables are large (over 40000 entries), so this option is not the
207default. Also, installing them may be rather slow."
fcfdeaf6 208 :init-value nil
9ca2ac2d
DL		 209 :version "21.4"
210 :type 'boolean
ccdd5c61 211 :set-after '(current-language-environment)
fcfdeaf6
KG		 212 :group 'mule
213 :global t
214 (if utf-translate-cjk-mode
215 ;; Fixme: Allow the use of the CJK charsets to be
216 ;; customized by reordering and possible omission.
217 (progn
218 ;; Redefine them with realistic initial sizes and a
219 ;; smallish rehash size to avoid wasting significant
220 ;; space after they're built.
221 (setq ucs-mule-cjk-to-unicode
222 (make-hash-table :test 'eq :size 43000 :rehash-size 1000)
223 ucs-unicode-to-mule-cjk
463f5630 224 (make-hash-table :test 'eq :size 43000 :rehash-size 1000))
fcfdeaf6
KG		 225 ;; Load the files explicitly, to avoid having to keep
226 ;; around the large tables they contain (as well as the
227 ;; ones which get built).
228 (cond
229 ((string= "Korean" current-language-environment)
230 (load "subst-jis")
231 (load "subst-big5")
232 (load "subst-gb2312")
233 (load "subst-ksc"))
234 ((string= "Chinese-BIG5" current-language-environment)
235 (load "subst-jis")
236 (load "subst-ksc")
237 (load "subst-gb2312")
238 (load "subst-big5"))
239 ((string= "Chinese-GB" current-language-environment)
240 (load "subst-jis")
241 (load "subst-ksc")
242 (load "subst-big5")
243 (load "subst-gb2312"))
244 (t
245 (load "subst-ksc")
246 (load "subst-gb2312")
247 (load "subst-big5")
248 (load "subst-jis"))) ; jis covers as much as big5, gb2312
2bf07f07
KH		 249 (define-translation-hash-table 'utf-subst-table-for-decode
250 ucs-unicode-to-mule-cjk)
251 (define-translation-hash-table 'utf-subst-table-for-encode
252 ucs-mule-cjk-to-unicode)
253 (set-char-table-extra-slot (get 'utf-translation-table-for-encode
254 'translation-table)
255 1 ucs-mule-cjk-to-unicode))
aea797fc
KH		 256 (define-translation-hash-table 'utf-subst-table-for-decode
257 (make-hash-table :test 'eq))
258 (define-translation-hash-table 'utf-subst-table-for-encode
2bf07f07
KH		 259 (make-hash-table :test 'eq))
260 (set-char-table-extra-slot (get 'utf-translation-table-for-encode
261 'translation-table)
262 1 nil)))
9ca2ac2d 263
5ba7a870
KH		 264(define-ccl-program ccl-decode-mule-utf-8
265 ;;
266 ;; charset | bytes in utf-8 | bytes in emacs
267 ;; -----------------------+----------------+---------------
268 ;; ascii | 1 | 1
269 ;; -----------------------+----------------+---------------
270 ;; eight-bit-control | 2 | 2
aa2e3f49 271 ;; eight-bit-graphic | 2 | 1
5ba7a870
KH		 272 ;; latin-iso8859-1 | 2 | 2
273 ;; -----------------------+----------------+---------------
274 ;; mule-unicode-0100-24ff | 2 | 4
275 ;; (< 0800) | |
276 ;; -----------------------+----------------+---------------
277 ;; mule-unicode-0100-24ff | 3 | 4
278 ;; (>= 8000) | |
279 ;; mule-unicode-2500-33ff | 3 | 4
280 ;; mule-unicode-e000-ffff | 3 | 4
281 ;;
282 ;; Thus magnification factor is two.
283 ;;
284 `(2
3d0e328b
GM		 285 ((r5 = ,(charset-id 'eight-bit-control))
286 (r6 = ,(charset-id 'eight-bit-graphic))
287 (loop
67ff2216 288 (r0 = -1)
5ba7a870
KH		 289 (read r0)
290
291 ;; 1byte encoding, i.e., ascii
292 (if (r0 < #x80)
67ff2216 293 ((write r0))
9ca2ac2d 294 (if (r0 < #xc0) ; continuation byte (invalid here)
67ff2216
KH		 295 ((if (r0 < #xa0)
296 (write-multibyte-character r5 r0)
297 (write-multibyte-character r6 r0)))
9ca2ac2d
DL		 298 ;; 2 byte encoding 00000yyyyyxxxxxx = 110yyyyy 10xxxxxx
299 (if (r0 < #xe0)
67ff2216
KH		 300 ((r1 = -1)
301 (read r1)
9ca2ac2d
DL		 302
303 (if ((r1 & #b11000000) != #b10000000)
304 ;; Invalid 2-byte sequence
3d0e328b
GM		 305 ((if (r0 < #xa0)
306 (write-multibyte-character r5 r0)
307 (write-multibyte-character r6 r0))
308 (if (r1 < #x80)
309 (write r1)
310 (if (r1 < #xa0)
311 (write-multibyte-character r5 r1)
9ca2ac2d
DL		 312 (write-multibyte-character r6 r1))))
313
314 ((r3 = r0) ; save in case of overlong sequence
315 (r2 = r1)
316 (r0 &= #x1f)
317 (r0 <<= 6)
9ca2ac2d
DL		 318 (r1 &= #x3f)
319 (r1 += r0)
320 ;; Now r1 holds scalar value
321
322 (if (r1 < 128) ; `overlong sequence'
323 ((if (r3 < #xa0)
324 (write-multibyte-character r5 r3)
325 (write-multibyte-character r6 r3))
326 (if (r2 < #x80)
327 (write r2)
328 (if (r2 < #xa0)
329 (write-multibyte-character r5 r2)
330 (write-multibyte-character r6 r2))))
331
332 ;; eight-bit-control
333 (if (r1 < 160)
334 ((write-multibyte-character r5 r1))
335
336 ;; latin-iso8859-1
337 (if (r1 < 256)
338 ((r0 = ,(charset-id 'latin-iso8859-1))
339 (r1 -= 128)
340 (write-multibyte-character r0 r1))
341
342 ;; mule-unicode-0100-24ff (< 0800)
343 ((r0 = ,(charset-id 'mule-unicode-0100-24ff))
344 (r1 -= #x0100)
345 (r2 = (((r1 / 96) + 32) << 7))
346 (r1 %= 96)
347 (r1 += (r2 + 32))
348 (translate-character
ad88f5c5 349 utf-translation-table-for-decode r0 r1)
9ca2ac2d
DL		 350 (write-multibyte-character r0 r1))))))))
351
352 ;; 3byte encoding
353 ;; zzzzyyyyyyxxxxxx = 1110zzzz 10yyyyyy 10xxxxxx
354 (if (r0 < #xf0)
67ff2216
KH		 355 ((r1 = -1)
356 (r2 = -1)
357 (read r1 r2)
9ca2ac2d
DL		 358
359 ;; This is set to 1 if the encoding is invalid.
360 (r4 = 0)
361
362 (r3 = (r1 & #b11000000))
363 (r3 |= ((r2 >> 2) & #b00110000))
364 (if (r3 != #b10100000)
365 (r4 = 1)
366 ((r3 = ((r0 & #x0f) << 12))
367 (r3 += ((r1 & #x3f) << 6))
368 (r3 += (r2 & #x3f))
369 (if (r3 < #x0800)
370 (r4 = 1))))
371
372 (if (r4 != 0)
373 ;; Invalid 3-byte sequence
374 ((if (r0 < #xa0)
375 (write-multibyte-character r5 r0)
376 (write-multibyte-character r6 r0))
377 (if (r1 < #x80)
378 (write r1)
379 (if (r1 < #xa0)
380 (write-multibyte-character r5 r1)
381 (write-multibyte-character r6 r1)))
382 (if (r2 < #x80)
383 (write r2)
384 (if (r2 < #xa0)
385 (write-multibyte-character r5 r2)
386 (write-multibyte-character r6 r2))))
a1506d29 387
9ca2ac2d
DL		 388 ;; mule-unicode-0100-24ff (>= 0800)
389 ((if (r3 < #x2500)
390 ((r0 = ,(charset-id 'mule-unicode-0100-24ff))
391 (r3 -= #x0100)
3d0e328b
GM		 392 (r3 //= 96)
393 (r1 = (r7 + 32))
394 (r1 += ((r3 + 32) << 7))
9ca2ac2d 395 (translate-character
ad88f5c5 396 utf-translation-table-for-decode r0 r1)
3d0e328b 397 (write-multibyte-character r0 r1))
a1506d29 398
9ca2ac2d 399 ;; mule-unicode-2500-33ff
9ca2ac2d 400 (if (r3 < #x3400)
ccdd5c61
DL		 401 ((r4 = r3) ; don't zap r3
402 (lookup-integer utf-subst-table-for-decode r4 r5)
403 (if r7
404 ;; got a translation
405 ((write-multibyte-character r4 r5)
406 ;; Zapped through register starvation.
407 (r5 = ,(charset-id 'eight-bit-control)))
408 ((r0 = ,(charset-id 'mule-unicode-2500-33ff))
409 (r3 -= #x2500)
410 (r3 //= 96)
411 (r1 = (r7 + 32))
412 (r1 += ((r3 + 32) << 7))
413 (write-multibyte-character r0 r1))))
9ca2ac2d
DL		 414
415 ;; U+3400 .. U+D7FF
416 ;; Try to convert to CJK chars, else keep
417 ;; them as eight-bit-{control|graphic}.
418 (if (r3 < #xd800)
419 ((r4 = r3) ; don't zap r3
ad88f5c5 420 (lookup-integer utf-subst-table-for-decode r4 r5)
9ca2ac2d
DL		 421 (if r7
422 ;; got a translation
423 ((write-multibyte-character r4 r5)
424 ;; Zapped through register starvation.
425 (r5 = ,(charset-id 'eight-bit-control)))
426 ;; #xe0 <= r0 < #xf0, so r0 is eight-bit-graphic
427 ((r3 = r6)
428 (write-multibyte-character r3 r0)
429 (if (r1 < #xa0)
430 (r3 = r5))
431 (write-multibyte-character r3 r1)
432 (if (r2 < #xa0)
433 (r3 = r5)
434 (r3 = r6))
435 (write-multibyte-character r3 r2))))
436
437 ;; Surrogates, U+D800 .. U+DFFF
9ca2ac2d
DL		 438 (if (r3 < #xe000)
439 ((r3 = r6)
440 (write-multibyte-character r3 r0) ; eight-bit-graphic
441 (if (r1 < #xa0)
442 (r3 = r5))
443 (write-multibyte-character r3 r1)
444 (if (r2 < #xa0)
445 (r3 = r5)
446 (r3 = r6))
447 (write-multibyte-character r3 r2))
a1506d29 448
9ca2ac2d
DL		 449 ;; mule-unicode-e000-ffff
450 ;; Fixme: fffe and ffff are invalid.
451 ((r0 = ,(charset-id 'mule-unicode-e000-ffff))
452 (r3 -= #xe000)
453 (r3 //= 96)
454 (r1 = (r7 + 32))
455 (r1 += ((r3 + 32) << 7))
456 (write-multibyte-character r0 r1)))))))))
457
458 (if (r0 < #xfe)
459 ;; 4byte encoding
460 ;; keep those bytes as eight-bit-{control|graphic}
ad88f5c5 461 ;; Fixme: allow lookup in utf-subst-table-for-decode.
67ff2216
KH		 462 ((r1 = -1)
463 (r2 = -1)
464 (r3 = -1)
465 (read r1 r2 r3)
9ca2ac2d
DL		 466 ;; r0 > #xf0, thus eight-bit-graphic
467 (write-multibyte-character r6 r0)
468 (if (r1 < #xa0)
469 (if (r1 < #x80) ; invalid byte
470 (write r1)
471 (write-multibyte-character r5 r1))
472 (write-multibyte-character r6 r1))
473 (if (r2 < #xa0)
474 (if (r2 < #x80) ; invalid byte
475 (write r2)
476 (write-multibyte-character r5 r2))
477 (write-multibyte-character r6 r2))
478 (if (r3 < #xa0)
479 (if (r3 < #x80) ; invalid byte
480 (write r3)
481 (write-multibyte-character r5 r3))
482 (write-multibyte-character r6 r3))
483 (if (r0 >= #xf8) ; 5- or 6-byte encoding
76b7fded
KH		 484 ((r0 = -1)
485 (read r0)
486 (if (r0 < #xa0)
487 (if (r0 < #x80) ; invalid byte
488 (write r0)
489 (write-multibyte-character r5 r0))
490 (write-multibyte-character r6 r0))
9ca2ac2d 491 (if (r0 >= #xfc) ; 6-byte
76b7fded
KH		 492 ((r0 = -1)
493 (read r0)
494 (if (r0 < #xa0)
495 (if (r0 < #x80) ; invalid byte
496 (write r0)
497 (write-multibyte-character r5 r0))
498 (write-multibyte-character r6 r0)))))))
9ca2ac2d
DL		 499 ;; else invalid byte >= #xfe
500 (write-multibyte-character r6 r0))))))
67ff2216
KH		 501 (repeat)))
502
503 ;; At EOF...
504 (if (r0 >= 0)
505 ((if (r0 < #x80)
506 (write r0)
507 (if (r0 < #xa0)
508 (write-multibyte-character r5 r0)
509 ((write-multibyte-character r6 r0))))
510 (if (r1 >= 0)
511 ((if (r1 < #x80)
512 (write r1)
513 (if (r1 < #xa0)
514 (write-multibyte-character r5 r1)
515 ((write-multibyte-character r6 r1))))
516 (if (r2 >= 0)
517 ((if (r2 < #x80)
518 (write r2)
519 (if (r2 < #xa0)
520 (write-multibyte-character r5 r2)
521 ((write-multibyte-character r6 r2))))
522 (if (r3 >= 0)
523 (if (r3 < #x80)
524 (write r3)
525 (if (r3 < #xa0)
526 (write-multibyte-character r5 r3)
527 ((write-multibyte-character r6 r3))))))))))))
5ba7a870 528
c49b8288 529 "CCL program to decode UTF-8.
74ace46a 530Basic decoding is done into the charsets ascii, latin-iso8859-1 and
ad88f5c5
KH		 531mule-unicode-*, but see also `utf-fragmentation-table' and
532`ucs-mule-cjk-to-unicode'.
9ca2ac2d
DL		 533Encodings of un-representable Unicode characters are decoded asis into
534eight-bit-control and eight-bit-graphic characters.")
5ba7a870
KH		 535
536(define-ccl-program ccl-encode-mule-utf-8
537 `(1
aa15b3e5
KH		 538 ((r5 = -1)
539 (loop
540 (if (r5 < 0)
541 ((r1 = -1)
aa2e3f49 542 (read-multibyte-character r0 r1)
ad88f5c5 543 (translate-character utf-translation-table-for-encode r0 r1))
aa15b3e5
KH		 544 (;; We have already done read-multibyte-character.
545 (r0 = r5)
546 (r1 = r6)
547 (r5 = -1)))
548
549 (if (r0 == ,(charset-id 'ascii))
550 (write r1)
551
552 (if (r0 == ,(charset-id 'latin-iso8859-1))
553 ;; r1 scalar utf-8
554 ;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx
555 ;; 20 0000 0000 1010 0000 1100 0010 1010 0000
556 ;; 7f 0000 0000 1111 1111 1100 0011 1011 1111
557 ((r0 = (((r1 & #x40) >> 6) | #xc2))
558 (r1 &= #x3f)
559 (r1 |= #x80)
560 (write r0 r1))
561
562 (if (r0 == ,(charset-id 'mule-unicode-0100-24ff))
563 ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
564 ;; #x3f80 == (0011 1111 1000 0000)b
565 (r1 &= #x7f)
566 (r1 += (r0 + 224)) ; 240 == -32 + #x0100
567 ;; now r1 holds scalar value
568 (if (r1 < #x0800)
569 ;; 2byte encoding
570 ((r0 = (((r1 & #x07c0) >> 6) | #xc0))
571 ;; #x07c0 == (0000 0111 1100 0000)b
572 (r1 &= #x3f)
573 (r1 |= #x80)
574 (write r0 r1))
575 ;; 3byte encoding
576 ((r0 = (((r1 & #xf000) >> 12) | #xe0))
5ba7a870
KH		 577 (r2 = ((r1 & #x3f) | #x80))
578 (r1 &= #x0fc0)
579 (r1 >>= 6)
580 (r1 |= #x80)
aa15b3e5
KH		 581 (write r0 r1 r2))))
582
583 (if (r0 == ,(charset-id 'mule-unicode-2500-33ff))
584 ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
585 (r1 &= #x7f)
586 (r1 += (r0 + 9440)) ; 9440 == -32 + #x2500
587 (r0 = (((r1 & #xf000) >> 12) | #xe0))
588 (r2 = ((r1 & #x3f) | #x80))
589 (r1 &= #x0fc0)
590 (r1 >>= 6)
591 (r1 |= #x80)
592 (write r0 r1 r2))
593
594 (if (r0 == ,(charset-id 'mule-unicode-e000-ffff))
595 ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
596 (r1 &= #x7f)
9ca2ac2d 597 (r1 += (r0 + 57312)) ; 57312 == -32 + #xe000
aa15b3e5
KH		 598 (r0 = (((r1 & #xf000) >> 12) | #xe0))
599 (r2 = ((r1 & #x3f) | #x80))
600 (r1 &= #x0fc0)
601 (r1 >>= 6)
602 (r1 |= #x80)
603 (write r0 r1 r2))
604
605 (if (r0 == ,(charset-id 'eight-bit-control))
606 ;; r1 scalar utf-8
607 ;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx
608 ;; 80 0000 0000 1000 0000 1100 0010 1000 0000
609 ;; 9f 0000 0000 1001 1111 1100 0010 1001 1111
610 ((write #xc2)
611 (write r1))
612
613 (if (r0 == ,(charset-id 'eight-bit-graphic))
614 ;; r1 scalar utf-8
615 ;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx
616 ;; a0 0000 0000 1010 0000 1100 0010 1010 0000
617 ;; ff 0000 0000 1111 1111 1101 1111 1011 1111
618 ((write r1)
619 (r1 = -1)
620 (read-multibyte-character r0 r1)
621 (if (r0 != ,(charset-id 'eight-bit-graphic))
622 (if (r0 != ,(charset-id 'eight-bit-control))
623 ((r5 = r0)
624 (r6 = r1))))
625 (if (r5 < 0)
626 ((read-multibyte-character r0 r2)
627 (if (r0 != ,(charset-id 'eight-bit-graphic))
628 (if (r0 != ,(charset-id 'eight-bit-control))
629 ((r5 = r0)
630 (r6 = r2))))
631 (if (r5 < 0)
632 (write r1 r2)
633 (if (r1 < #xa0)
634 (write r1)
635 ((write #xc2)
636 (write r1)))))))
637
ad88f5c5 638 ((lookup-character utf-subst-table-for-encode r0 r1)
9ca2ac2d
DL		 639 (if r7 ; lookup succeeded
640 ((r1 = (((r0 & #xf000) >> 12) | #xe0))
641 (r2 = ((r0 & #x3f) | #x80))
642 (r0 &= #x0fc0)
643 (r0 >>= 6)
644 (r0 |= #x80)
645 (write r1 r0 r2))
646 ;; Unsupported character.
647 ;; Output U+FFFD, which is `ef bf bd' in UTF-8.
648 ((write #xef)
649 (write #xbf)
650 (write #xbd)))))))))))
aa15b3e5
KH		 651 (repeat)))
652 (if (r1 >= #xa0)
653 (write r1)
654 (if (r1 >= #x80)
655 ((write #xc2)
656 (write r1)))))
5ba7a870 657
9ca2ac2d 658 "CCL program to encode into UTF-8.")
5ba7a870 659
aa2e3f49 660
9ca2ac2d
DL		 661(define-ccl-program ccl-untranslated-to-ucs
662 `(0
663 (if (r0 < #xf0) ; 3-byte encoding, as above
664 ((r4 = 0)
665 (r3 = (r1 & #b11000000))
666 (r3 |= ((r2 >> 2) & #b00110000))
667 (if (r3 != #b10100000)
668 (r4 = 1)
669 ((r3 = ((r0 & #x0f) << 12))
670 (r3 += ((r1 & #x3f) << 6))
671 (r3 += (r2 & #x3f))
672 (if (r3 < #x0800)
673 (r4 = 1))))
674 (if (r4 != 0)
675 (r0 = 0)
676 (r0 = r3)))
677 (if (r0 < #xf8) ; 4-byte (Mule-UCS recipe)
678 ((r4 = (r1 >> 6))
679 (if (r4 != #b10)
680 (r0 = 0)
681 ((r4 = (r2 >> 6))
682 (if (r4 != #b10)
683 (r0 = 0)
684 ((r4 = (r3 >> 6))
685 (if (r4 != #b10)
686 (r0 = 0)
687 ((r1 = ((r1 & #x3F) << 12))
688 (r2 = ((r2 & #x3F) << 6))
689 (r3 &= #x3F)
690 (r0 = (((((r0 & #x07) << 18) | r1) | r2) | r3)))))))))
691 (r0 = 0))))
692 "Decode 3- or 4-byte sequences in r0, r1, r2 [,r3] to unicodes in r0.
693r0 == 0 for invalid sequence.")
694
695(defvar utf-8-ccl-regs (make-vector 8 0))
696
aa2e3f49 697(defsubst utf-8-untranslated-to-ucs ()
9ca2ac2d
DL		 698 "Return the UCS code for an untranslated sequence of raw bytes t point.
699Only for 3- or 4-byte sequences."
700 (aset utf-8-ccl-regs 0 (or (char-after) 0))
701 (aset utf-8-ccl-regs 1 (or (char-after (1+ (point))) 0))
702 (aset utf-8-ccl-regs 2 (or (char-after (+ 2 (point))) 0))
703 (aset utf-8-ccl-regs 3 (or (char-after (+ 3 (point))) 0))
704 (ccl-execute 'ccl-untranslated-to-ucs utf-8-ccl-regs)
705 (aref utf-8-ccl-regs 0))
aa2e3f49
DL		 706
707(defun utf-8-help-echo (window object position)
708 (format "Untranslated Unicode U+%04X"
709 (get-char-property position 'untranslated-utf-8 object)))
710
aa2e3f49
DL		 711;; We compose the untranslatable sequences into a single character.
712;; This is infelicitous for editing, because there's currently no
713;; mechanism for treating compositions as atomic, but is OK for
9ca2ac2d
DL		 714;; display. They are composed to U+FFFD with help-echo which
715;; indicates the unicodes they represent. This function GCs too much.
aa2e3f49
DL		 716(defsubst utf-8-compose ()
717 "Put a suitable composition on an untranslatable sequence.
718Return the sequence's length."
719 (let* ((u (utf-8-untranslated-to-ucs))
9ca2ac2d
DL		 720 (l (unless (zerop u)
721 (if (>= u #x10000)
aa2e3f49 722 4
9ca2ac2d
DL		 723 3))))
724 (when l
aa2e3f49
DL		 725 (put-text-property (point) (min (point-max) (+ l (point)))
726 'untranslated-utf-8 u)
9ca2ac2d
DL		 727 (put-text-property (point) (min (point-max) (+ l (point)))
728 'help-echo 'utf-8-help-echo)
729 (compose-region (point) (+ l (point)) ?\e$,3u=\e(B)
aa2e3f49
DL		 730 l)))
731
732(defcustom utf-8-compose-scripts nil
9ca2ac2d 733 "*Non-nil means compose various scripts on decoding utf-8 text."
aa2e3f49 734 :group 'mule
9ca2ac2d
DL		 735 :version "21.4"
736 :type 'boolean)
aa2e3f49
DL		 737
738(defun utf-8-post-read-conversion (length)
739 "Compose untranslated utf-8 sequences into single characters.
740Also compose particular scripts if `utf-8-compose-scripts' is non-nil."
741 (save-excursion
742 ;; Can't do eval-when-compile to insert a multibyte constant
743 ;; version of the string in the loop, since it's always loaded as
744 ;; unibyte from a byte-compiled file.
9ca2ac2d
DL		 745 (let ((range (string-as-multibyte "^\xe1-\xf7")))
746 (while (and (skip-chars-forward range)
aa2e3f49
DL		 747 (not (eobp)))
748 (forward-char (utf-8-compose)))))
9ca2ac2d
DL		 749 ;; Fixme: Takahashi-san implies it may not work this easily. I
750 ;; asked why but didn't get a reply. -- fx
aa2e3f49
DL		 751 (when (and utf-8-compose-scripts (> length 1))
752 ;; These currently have definitions which cover the relevant
9ca2ac2d 753 ;; unicodes. We could avoid loading thai-util &c by checking
aa2e3f49
DL		 754 ;; whether the region contains any characters with the appropriate
755 ;; categories. There aren't yet Unicode-based rules for Tibetan.
756 (save-excursion (setq length (diacritic-post-read-conversion length)))
757 (save-excursion (setq length (thai-post-read-conversion length)))
758 (save-excursion (setq length (lao-post-read-conversion length)))
9ca2ac2d
DL		 759 (save-excursion
760 (setq length (in-is13194-devanagari-post-read-conversion length))))
aa2e3f49
DL		 761 length)
762
9ca2ac2d
DL		 763;; ucs-tables is preloaded
764;; (defun utf-8-pre-write-conversion (beg end)
765;; "Semi-dummy pre-write function effectively to autoload ucs-tables."
ad88f5c5 766;; ;; Ensure translation-table is loaded.
9ca2ac2d
DL		 767;; (require 'ucs-tables)
768;; ;; Don't do this again.
769;; (coding-system-put 'mule-utf-8 'pre-write-conversion nil)
770;; nil)
aa2e3f49 771
5ba7a870
KH		 772(make-coding-system
773 'mule-utf-8 4 ?u
774 "UTF-8 encoding for Emacs-supported Unicode characters.
ad88f5c5
KH		 775It supports Unicode characters of these ranges:
776 U+0000..U+33FF, U+E000..U+FFFF.
777They correspond to these Emacs character sets:
778 ascii, latin-iso8859-1, mule-unicode-0100-24ff,
779 mule-unicode-2500-33ff, mule-unicode-e000-ffff
780
781On decoding (e.g. reading a file), Unicode characters not in the above
782ranges are decoded into sequences of eight-bit-control and
783eight-bit-graphic characters to preserve their byte sequences. The
784byte sequence is preserved on i/o for valid utf-8, but not necessarily
785for invalid utf-8.
786
787On encoding (e.g. writing a file), Emacs characters not belonging to
788any of the character sets listed above are encoded into the UTF-8 byte
789sequence representing U+FFFD (REPLACEMENT CHARACTER)."
5ba7a870
KH		 790
791 '(ccl-decode-mule-utf-8 . ccl-encode-mule-utf-8)
792 '((safe-charsets
793 ascii
794 eight-bit-control
795 eight-bit-graphic
796 latin-iso8859-1
797 mule-unicode-0100-24ff
798 mule-unicode-2500-33ff
799 mule-unicode-e000-ffff)
87ae7973 800 (mime-charset . utf-8)
75f6d723 801 (coding-category . coding-category-utf-8)
aa2e3f49 802 (valid-codes (0 . 255))
9ca2ac2d 803;; (pre-write-conversion . utf-8-pre-write-conversion)
ad88f5c5 804 (post-read-conversion . utf-8-post-read-conversion)
2bf07f07 805 (translation-table-for-encode . utf-translation-table-for-encode)
ad88f5c5
KH		 806 (dependency unify-8859-on-encoding-mode
807 unify-8859-on-decoding-mode
808 utf-fragment-on-decoding
809 utf-translate-cjk)))
5ba7a870
KH		 810
811(define-coding-system-alias 'utf-8 'mule-utf-8)
e8af40ee 812
aa2e3f49
DL		 813;; I think this needs special private charsets defined for the
814;; untranslated sequences, if it's going to work well.
815
816;;; (defun utf-8-compose-function (pos to pattern &optional string)
817;;; (let* ((prop (get-char-property pos 'composition string))
818;;; (l (and prop (- (cadr prop) (car prop)))))
819;;; (cond ((and l (> l (- to pos)))
820;;; (delete-region pos to))
821;;; ((and (> (char-after pos) 224)
822;;; (< (char-after pos) 256)
823;;; (save-restriction
824;;; (narrow-to-region pos to)
825;;; (utf-8-compose)))
826;;; t))))
827
828;;; (dotimes (i 96)
829;;; (aset composition-function-table
830;;; (+ 128 i)
831;;; `((,(string-as-multibyte "[\200-\237\240-\377]")
832;;; . utf-8-compose-function))))
833
e8af40ee 834;;; utf-8.el ends here
Unnamed repository; edit this file 'description' to name the repository.