HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
(latin1-display-setup): Check each character is displayable or not
[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 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
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
e7d063be 224 (make-hash-table :test 'eq :size 21500 :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.
98fe1969
KH		 451 ((r4 = r3) ; don't zap r3
452 (lookup-integer utf-subst-table-for-decode r4 r5)
453 (if r7
454 ;; got a translation
455 ((write-multibyte-character r4 r5)
456 ;; Zapped through register starvation.
457 (r5 = ,(charset-id 'eight-bit-control)))
458 ((r0 = ,(charset-id 'mule-unicode-e000-ffff))
459 (r3 -= #xe000)
460 (r3 //= 96)
461 (r1 = (r7 + 32))
462 (r1 += ((r3 + 32) << 7))
463 (write-multibyte-character r0 r1)))))))))))
9ca2ac2d
DL		 464
465 (if (r0 < #xfe)
466 ;; 4byte encoding
467 ;; keep those bytes as eight-bit-{control|graphic}
ad88f5c5 468 ;; Fixme: allow lookup in utf-subst-table-for-decode.
67ff2216
KH		 469 ((r1 = -1)
470 (r2 = -1)
471 (r3 = -1)
472 (read r1 r2 r3)
9ca2ac2d
DL		 473 ;; r0 > #xf0, thus eight-bit-graphic
474 (write-multibyte-character r6 r0)
475 (if (r1 < #xa0)
476 (if (r1 < #x80) ; invalid byte
477 (write r1)
478 (write-multibyte-character r5 r1))
479 (write-multibyte-character r6 r1))
480 (if (r2 < #xa0)
481 (if (r2 < #x80) ; invalid byte
482 (write r2)
483 (write-multibyte-character r5 r2))
484 (write-multibyte-character r6 r2))
485 (if (r3 < #xa0)
486 (if (r3 < #x80) ; invalid byte
487 (write r3)
488 (write-multibyte-character r5 r3))
489 (write-multibyte-character r6 r3))
490 (if (r0 >= #xf8) ; 5- or 6-byte encoding
76b7fded
KH		 491 ((r0 = -1)
492 (read r0)
493 (if (r0 < #xa0)
494 (if (r0 < #x80) ; invalid byte
495 (write r0)
496 (write-multibyte-character r5 r0))
497 (write-multibyte-character r6 r0))
9ca2ac2d 498 (if (r0 >= #xfc) ; 6-byte
76b7fded
KH		 499 ((r0 = -1)
500 (read r0)
501 (if (r0 < #xa0)
502 (if (r0 < #x80) ; invalid byte
503 (write r0)
504 (write-multibyte-character r5 r0))
505 (write-multibyte-character r6 r0)))))))
9ca2ac2d
DL		 506 ;; else invalid byte >= #xfe
507 (write-multibyte-character r6 r0))))))
67ff2216
KH		 508 (repeat)))
509
510 ;; At EOF...
511 (if (r0 >= 0)
512 ((if (r0 < #x80)
513 (write r0)
514 (if (r0 < #xa0)
515 (write-multibyte-character r5 r0)
516 ((write-multibyte-character r6 r0))))
517 (if (r1 >= 0)
518 ((if (r1 < #x80)
519 (write r1)
520 (if (r1 < #xa0)
521 (write-multibyte-character r5 r1)
522 ((write-multibyte-character r6 r1))))
523 (if (r2 >= 0)
524 ((if (r2 < #x80)
525 (write r2)
526 (if (r2 < #xa0)
527 (write-multibyte-character r5 r2)
528 ((write-multibyte-character r6 r2))))
529 (if (r3 >= 0)
530 (if (r3 < #x80)
531 (write r3)
532 (if (r3 < #xa0)
533 (write-multibyte-character r5 r3)
534 ((write-multibyte-character r6 r3))))))))))))
5ba7a870 535
c49b8288 536 "CCL program to decode UTF-8.
74ace46a 537Basic decoding is done into the charsets ascii, latin-iso8859-1 and
ad88f5c5
KH		 538mule-unicode-*, but see also `utf-fragmentation-table' and
539`ucs-mule-cjk-to-unicode'.
9ca2ac2d
DL		 540Encodings of un-representable Unicode characters are decoded asis into
541eight-bit-control and eight-bit-graphic characters.")
5ba7a870
KH		 542
543(define-ccl-program ccl-encode-mule-utf-8
544 `(1
aa15b3e5
KH		 545 ((r5 = -1)
546 (loop
547 (if (r5 < 0)
548 ((r1 = -1)
aa2e3f49 549 (read-multibyte-character r0 r1)
ad88f5c5 550 (translate-character utf-translation-table-for-encode r0 r1))
aa15b3e5
KH		 551 (;; We have already done read-multibyte-character.
552 (r0 = r5)
553 (r1 = r6)
554 (r5 = -1)))
555
556 (if (r0 == ,(charset-id 'ascii))
557 (write r1)
558
559 (if (r0 == ,(charset-id 'latin-iso8859-1))
560 ;; r1 scalar utf-8
561 ;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx
562 ;; 20 0000 0000 1010 0000 1100 0010 1010 0000
563 ;; 7f 0000 0000 1111 1111 1100 0011 1011 1111
564 ((r0 = (((r1 & #x40) >> 6) | #xc2))
565 (r1 &= #x3f)
566 (r1 |= #x80)
567 (write r0 r1))
568
569 (if (r0 == ,(charset-id 'mule-unicode-0100-24ff))
570 ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
571 ;; #x3f80 == (0011 1111 1000 0000)b
572 (r1 &= #x7f)
573 (r1 += (r0 + 224)) ; 240 == -32 + #x0100
574 ;; now r1 holds scalar value
575 (if (r1 < #x0800)
576 ;; 2byte encoding
577 ((r0 = (((r1 & #x07c0) >> 6) | #xc0))
578 ;; #x07c0 == (0000 0111 1100 0000)b
579 (r1 &= #x3f)
580 (r1 |= #x80)
581 (write r0 r1))
582 ;; 3byte encoding
583 ((r0 = (((r1 & #xf000) >> 12) | #xe0))
5ba7a870
KH		 584 (r2 = ((r1 & #x3f) | #x80))
585 (r1 &= #x0fc0)
586 (r1 >>= 6)
587 (r1 |= #x80)
aa15b3e5
KH		 588 (write r0 r1 r2))))
589
590 (if (r0 == ,(charset-id 'mule-unicode-2500-33ff))
591 ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
592 (r1 &= #x7f)
593 (r1 += (r0 + 9440)) ; 9440 == -32 + #x2500
594 (r0 = (((r1 & #xf000) >> 12) | #xe0))
595 (r2 = ((r1 & #x3f) | #x80))
596 (r1 &= #x0fc0)
597 (r1 >>= 6)
598 (r1 |= #x80)
599 (write r0 r1 r2))
600
601 (if (r0 == ,(charset-id 'mule-unicode-e000-ffff))
602 ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
603 (r1 &= #x7f)
9ca2ac2d 604 (r1 += (r0 + 57312)) ; 57312 == -32 + #xe000
aa15b3e5
KH		 605 (r0 = (((r1 & #xf000) >> 12) | #xe0))
606 (r2 = ((r1 & #x3f) | #x80))
607 (r1 &= #x0fc0)
608 (r1 >>= 6)
609 (r1 |= #x80)
610 (write r0 r1 r2))
611
612 (if (r0 == ,(charset-id 'eight-bit-control))
613 ;; r1 scalar utf-8
614 ;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx
615 ;; 80 0000 0000 1000 0000 1100 0010 1000 0000
616 ;; 9f 0000 0000 1001 1111 1100 0010 1001 1111
617 ((write #xc2)
618 (write r1))
619
620 (if (r0 == ,(charset-id 'eight-bit-graphic))
621 ;; r1 scalar utf-8
622 ;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx
623 ;; a0 0000 0000 1010 0000 1100 0010 1010 0000
624 ;; ff 0000 0000 1111 1111 1101 1111 1011 1111
625 ((write r1)
626 (r1 = -1)
627 (read-multibyte-character r0 r1)
628 (if (r0 != ,(charset-id 'eight-bit-graphic))
629 (if (r0 != ,(charset-id 'eight-bit-control))
630 ((r5 = r0)
631 (r6 = r1))))
632 (if (r5 < 0)
633 ((read-multibyte-character r0 r2)
634 (if (r0 != ,(charset-id 'eight-bit-graphic))
635 (if (r0 != ,(charset-id 'eight-bit-control))
636 ((r5 = r0)
637 (r6 = r2))))
638 (if (r5 < 0)
639 (write r1 r2)
640 (if (r1 < #xa0)
641 (write r1)
642 ((write #xc2)
643 (write r1)))))))
644
ad88f5c5 645 ((lookup-character utf-subst-table-for-encode r0 r1)
9ca2ac2d
DL		 646 (if r7 ; lookup succeeded
647 ((r1 = (((r0 & #xf000) >> 12) | #xe0))
648 (r2 = ((r0 & #x3f) | #x80))
649 (r0 &= #x0fc0)
650 (r0 >>= 6)
651 (r0 |= #x80)
652 (write r1 r0 r2))
653 ;; Unsupported character.
654 ;; Output U+FFFD, which is `ef bf bd' in UTF-8.
655 ((write #xef)
656 (write #xbf)
657 (write #xbd)))))))))))
aa15b3e5
KH		 658 (repeat)))
659 (if (r1 >= #xa0)
660 (write r1)
661 (if (r1 >= #x80)
662 ((write #xc2)
663 (write r1)))))
5ba7a870 664
9ca2ac2d 665 "CCL program to encode into UTF-8.")
5ba7a870 666
aa2e3f49 667
9ca2ac2d
DL		 668(define-ccl-program ccl-untranslated-to-ucs
669 `(0
670 (if (r0 < #xf0) ; 3-byte encoding, as above
671 ((r4 = 0)
672 (r3 = (r1 & #b11000000))
673 (r3 |= ((r2 >> 2) & #b00110000))
674 (if (r3 != #b10100000)
675 (r4 = 1)
676 ((r3 = ((r0 & #x0f) << 12))
677 (r3 += ((r1 & #x3f) << 6))
678 (r3 += (r2 & #x3f))
679 (if (r3 < #x0800)
680 (r4 = 1))))
681 (if (r4 != 0)
682 (r0 = 0)
683 (r0 = r3)))
684 (if (r0 < #xf8) ; 4-byte (Mule-UCS recipe)
685 ((r4 = (r1 >> 6))
686 (if (r4 != #b10)
687 (r0 = 0)
688 ((r4 = (r2 >> 6))
689 (if (r4 != #b10)
690 (r0 = 0)
691 ((r4 = (r3 >> 6))
692 (if (r4 != #b10)
693 (r0 = 0)
694 ((r1 = ((r1 & #x3F) << 12))
695 (r2 = ((r2 & #x3F) << 6))
696 (r3 &= #x3F)
697 (r0 = (((((r0 & #x07) << 18) | r1) | r2) | r3)))))))))
698 (r0 = 0))))
699 "Decode 3- or 4-byte sequences in r0, r1, r2 [,r3] to unicodes in r0.
700r0 == 0 for invalid sequence.")
701
702(defvar utf-8-ccl-regs (make-vector 8 0))
703
aa2e3f49 704(defsubst utf-8-untranslated-to-ucs ()
9ca2ac2d
DL		 705 "Return the UCS code for an untranslated sequence of raw bytes t point.
706Only for 3- or 4-byte sequences."
707 (aset utf-8-ccl-regs 0 (or (char-after) 0))
708 (aset utf-8-ccl-regs 1 (or (char-after (1+ (point))) 0))
709 (aset utf-8-ccl-regs 2 (or (char-after (+ 2 (point))) 0))
710 (aset utf-8-ccl-regs 3 (or (char-after (+ 3 (point))) 0))
711 (ccl-execute 'ccl-untranslated-to-ucs utf-8-ccl-regs)
712 (aref utf-8-ccl-regs 0))
aa2e3f49
DL		 713
714(defun utf-8-help-echo (window object position)
715 (format "Untranslated Unicode U+%04X"
716 (get-char-property position 'untranslated-utf-8 object)))
717
aa2e3f49
DL		 718;; We compose the untranslatable sequences into a single character.
719;; This is infelicitous for editing, because there's currently no
720;; mechanism for treating compositions as atomic, but is OK for
9ca2ac2d
DL		 721;; display. They are composed to U+FFFD with help-echo which
722;; indicates the unicodes they represent. This function GCs too much.
aa2e3f49
DL		 723(defsubst utf-8-compose ()
724 "Put a suitable composition on an untranslatable sequence.
725Return the sequence's length."
726 (let* ((u (utf-8-untranslated-to-ucs))
9ca2ac2d
DL		 727 (l (unless (zerop u)
728 (if (>= u #x10000)
aa2e3f49 729 4
9ca2ac2d
DL		 730 3))))
731 (when l
aa2e3f49
DL		 732 (put-text-property (point) (min (point-max) (+ l (point)))
733 'untranslated-utf-8 u)
9ca2ac2d
DL		 734 (put-text-property (point) (min (point-max) (+ l (point)))
735 'help-echo 'utf-8-help-echo)
736 (compose-region (point) (+ l (point)) ?\e$,3u=\e(B)
aa2e3f49
DL		 737 l)))
738
739(defcustom utf-8-compose-scripts nil
9ca2ac2d 740 "*Non-nil means compose various scripts on decoding utf-8 text."
aa2e3f49 741 :group 'mule
9ca2ac2d
DL		 742 :version "21.4"
743 :type 'boolean)
aa2e3f49
DL		 744
745(defun utf-8-post-read-conversion (length)
746 "Compose untranslated utf-8 sequences into single characters.
747Also compose particular scripts if `utf-8-compose-scripts' is non-nil."
748 (save-excursion
749 ;; Can't do eval-when-compile to insert a multibyte constant
750 ;; version of the string in the loop, since it's always loaded as
751 ;; unibyte from a byte-compiled file.
9ca2ac2d
DL		 752 (let ((range (string-as-multibyte "^\xe1-\xf7")))
753 (while (and (skip-chars-forward range)
aa2e3f49
DL		 754 (not (eobp)))
755 (forward-char (utf-8-compose)))))
9ca2ac2d
DL		 756 ;; Fixme: Takahashi-san implies it may not work this easily. I
757 ;; asked why but didn't get a reply. -- fx
aa2e3f49
DL		 758 (when (and utf-8-compose-scripts (> length 1))
759 ;; These currently have definitions which cover the relevant
9ca2ac2d 760 ;; unicodes. We could avoid loading thai-util &c by checking
aa2e3f49
DL		 761 ;; whether the region contains any characters with the appropriate
762 ;; categories. There aren't yet Unicode-based rules for Tibetan.
763 (save-excursion (setq length (diacritic-post-read-conversion length)))
764 (save-excursion (setq length (thai-post-read-conversion length)))
765 (save-excursion (setq length (lao-post-read-conversion length)))
dedc16d4
KH		 766 (save-excursion (setq length (devanagari-post-read-conversion length)))
767 (save-excursion (setq length (malayalam-post-read-conversion length)))
768 (save-excursion (setq length (tamil-post-read-conversion length))))
aa2e3f49
DL		 769 length)
770
9ca2ac2d
DL		 771;; ucs-tables is preloaded
772;; (defun utf-8-pre-write-conversion (beg end)
773;; "Semi-dummy pre-write function effectively to autoload ucs-tables."
ad88f5c5 774;; ;; Ensure translation-table is loaded.
9ca2ac2d
DL		 775;; (require 'ucs-tables)
776;; ;; Don't do this again.
777;; (coding-system-put 'mule-utf-8 'pre-write-conversion nil)
778;; nil)
aa2e3f49 779
5ba7a870
KH		 780(make-coding-system
781 'mule-utf-8 4 ?u
782 "UTF-8 encoding for Emacs-supported Unicode characters.
ad88f5c5
KH		 783It supports Unicode characters of these ranges:
784 U+0000..U+33FF, U+E000..U+FFFF.
785They correspond to these Emacs character sets:
786 ascii, latin-iso8859-1, mule-unicode-0100-24ff,
787 mule-unicode-2500-33ff, mule-unicode-e000-ffff
788
789On decoding (e.g. reading a file), Unicode characters not in the above
790ranges are decoded into sequences of eight-bit-control and
791eight-bit-graphic characters to preserve their byte sequences. The
792byte sequence is preserved on i/o for valid utf-8, but not necessarily
793for invalid utf-8.
794
795On encoding (e.g. writing a file), Emacs characters not belonging to
796any of the character sets listed above are encoded into the UTF-8 byte
797sequence representing U+FFFD (REPLACEMENT CHARACTER)."
5ba7a870
KH		 798
799 '(ccl-decode-mule-utf-8 . ccl-encode-mule-utf-8)
800 '((safe-charsets
801 ascii
802 eight-bit-control
803 eight-bit-graphic
804 latin-iso8859-1
805 mule-unicode-0100-24ff
806 mule-unicode-2500-33ff
807 mule-unicode-e000-ffff)
87ae7973 808 (mime-charset . utf-8)
75f6d723 809 (coding-category . coding-category-utf-8)
aa2e3f49 810 (valid-codes (0 . 255))
9ca2ac2d 811;; (pre-write-conversion . utf-8-pre-write-conversion)
ad88f5c5 812 (post-read-conversion . utf-8-post-read-conversion)
2bf07f07 813 (translation-table-for-encode . utf-translation-table-for-encode)
ad88f5c5
KH		 814 (dependency unify-8859-on-encoding-mode
815 unify-8859-on-decoding-mode
816 utf-fragment-on-decoding
817 utf-translate-cjk)))
5ba7a870
KH		 818
819(define-coding-system-alias 'utf-8 'mule-utf-8)
e8af40ee 820
aa2e3f49
DL		 821;; I think this needs special private charsets defined for the
822;; untranslated sequences, if it's going to work well.
823
824;;; (defun utf-8-compose-function (pos to pattern &optional string)
825;;; (let* ((prop (get-char-property pos 'composition string))
826;;; (l (and prop (- (cadr prop) (car prop)))))
827;;; (cond ((and l (> l (- to pos)))
828;;; (delete-region pos to))
829;;; ((and (> (char-after pos) 224)
830;;; (< (char-after pos) 256)
831;;; (save-restriction
832;;; (narrow-to-region pos to)
833;;; (utf-8-compose)))
834;;; t))))
835
836;;; (dotimes (i 96)
837;;; (aset composition-function-table
838;;; (+ 128 i)
839;;; `((,(string-as-multibyte "[\200-\237\240-\377]")
840;;; . utf-8-compose-function))))
841
ab5796a9 842;;; arch-tag: b08735b7-753b-4ae6-b754-0f3efe4515c5
e8af40ee 843;;; utf-8.el ends here
Unnamed repository; edit this file 'description' to name the repository.