190 |
:type 'boolean |
:type 'boolean |
191 |
:group 'mule) |
:group 'mule) |
192 |
|
|
193 |
|
|
194 |
|
(defconst utf-translate-cjk-charsets '(chinese-gb2312 |
195 |
|
chinese-big5-1 chinese-big5-2 |
196 |
|
japanese-jisx0208 japanese-jisx0212 |
197 |
|
korean-ksc5601) |
198 |
|
"List of charsets supported by `utf-translate-cjk-mode'.") |
199 |
|
|
200 |
|
(defconst utf-translate-cjk-unicode-range |
201 |
|
'((#x2e80 . #xd7a3) |
202 |
|
(#xff00 . #xffef)) |
203 |
|
"List of Unicode code ranges supported by `utf-translate-cjk-mode'.") |
204 |
|
|
205 |
|
;; Return non-nil if CODE-POINT is in `utf-translate-cjk-unicode-range'. |
206 |
|
(defsubst utf-translate-cjk-substitutable-p (code-point) |
207 |
|
(let ((tail utf-translate-cjk-unicode-range) |
208 |
|
elt) |
209 |
|
(while tail |
210 |
|
(setq elt (car tail) tail (cdr tail)) |
211 |
|
(if (and (>= code-point (car elt)) (<= code-point (cdr elt))) |
212 |
|
(setq tail nil) |
213 |
|
(setq elt nil))) |
214 |
|
elt)) |
215 |
|
|
216 |
|
(defvar utf-translate-cjk-lang-env nil |
217 |
|
"Language environment in which tables for `utf-translate-cjk-mode' is loaded. |
218 |
|
The value nil means that the tables are not yet loaded.") |
219 |
|
|
220 |
|
(defun utf-translate-cjk-load-tables () |
221 |
|
"Load tables for `utf-translate-cjk-mode'." |
222 |
|
;; Fixme: Allow the use of the CJK charsets to be |
223 |
|
;; customized by reordering and possible omission. |
224 |
|
(let ((redefined (< (hash-table-size ucs-mule-cjk-to-unicode) 43000))) |
225 |
|
(if redefined |
226 |
|
;; Redefine them with realistic initial sizes and a |
227 |
|
;; smallish rehash size to avoid wasting significant |
228 |
|
;; space after they're built. |
229 |
|
(setq ucs-mule-cjk-to-unicode |
230 |
|
(make-hash-table :test 'eq :size 43000 :rehash-size 1000) |
231 |
|
ucs-unicode-to-mule-cjk |
232 |
|
(make-hash-table :test 'eq :size 21500 :rehash-size 1000))) |
233 |
|
|
234 |
|
;; Load the files explicitly, to avoid having to keep |
235 |
|
;; around the large tables they contain (as well as the |
236 |
|
;; ones which get built). |
237 |
|
(cond ((string= "Korean" current-language-environment) |
238 |
|
(load "subst-jis") |
239 |
|
(load "subst-big5") |
240 |
|
(load "subst-gb2312") |
241 |
|
(load "subst-ksc")) |
242 |
|
((string= "Chinese-BIG5" current-language-environment) |
243 |
|
(load "subst-jis") |
244 |
|
(load "subst-ksc") |
245 |
|
(load "subst-gb2312") |
246 |
|
(load "subst-big5")) |
247 |
|
((string= "Chinese-GB" current-language-environment) |
248 |
|
(load "subst-jis") |
249 |
|
(load "subst-ksc") |
250 |
|
(load "subst-big5") |
251 |
|
(load "subst-gb2312")) |
252 |
|
(t |
253 |
|
(load "subst-ksc") |
254 |
|
(load "subst-gb2312") |
255 |
|
(load "subst-big5") |
256 |
|
(load "subst-jis"))) ; jis covers as much as big5, gb2312 |
257 |
|
|
258 |
|
(when redefined |
259 |
|
(define-translation-hash-table 'utf-subst-table-for-decode |
260 |
|
ucs-unicode-to-mule-cjk) |
261 |
|
(define-translation-hash-table 'utf-subst-table-for-encode |
262 |
|
ucs-mule-cjk-to-unicode) |
263 |
|
(set-char-table-extra-slot (get 'utf-translation-table-for-encode |
264 |
|
'translation-table) |
265 |
|
1 ucs-mule-cjk-to-unicode)) |
266 |
|
|
267 |
|
(setq utf-translate-cjk-lang-env current-language-environment))) |
268 |
|
|
269 |
|
(defun utf-lookup-subst-table-for-decode (code-point) |
270 |
|
(if (and utf-translate-cjk-mode |
271 |
|
(not utf-translate-cjk-lang-env) |
272 |
|
(utf-translate-cjk-substitutable-p code-point)) |
273 |
|
(utf-translate-cjk-load-tables)) |
274 |
|
(gethash code-point |
275 |
|
(get 'utf-subst-table-for-decode 'translation-hash-table))) |
276 |
|
|
277 |
|
|
278 |
|
(defun utf-lookup-subst-table-for-encode (char) |
279 |
|
(if (and utf-translate-cjk-mode |
280 |
|
(not utf-translate-cjk-lang-env) |
281 |
|
(memq (char-charset char) utf-translate-cjk-charsets)) |
282 |
|
(utf-translate-cjk-load-tables)) |
283 |
|
(gethash char |
284 |
|
(get 'utf-subst-table-for-encode 'translation-hash-table))) |
285 |
|
|
286 |
(define-minor-mode utf-translate-cjk-mode |
(define-minor-mode utf-translate-cjk-mode |
287 |
"Whether the UTF based coding systems should decode/encode CJK characters. |
"Whether the UTF based coding systems should decode/encode CJK characters. |
288 |
Enabling this loads tables which allow the coding systems mule-utf-8, |
Enabling this allows the coding systems mule-utf-8, |
289 |
mule-utf-16le and mule-utf-16be to encode characters in the charsets |
mule-utf-16le and mule-utf-16be to encode characters in the charsets |
290 |
`korean-ksc5601', `chinese-gb2312', `chinese-big5-1', |
`korean-ksc5601', `chinese-gb2312', `chinese-big5-1', |
291 |
`chinese-big5-2', `japanese-jisx0208' and `japanese-jisx0212', and to |
`chinese-big5-2', `japanese-jisx0208' and `japanese-jisx0212', and to |
296 |
turned on: ksc5601 for Korean, gb2312 for Chinese-GB, big5 for |
turned on: ksc5601 for Korean, gb2312 for Chinese-GB, big5 for |
297 |
Chinese-Big5 and jisx for other environments. |
Chinese-Big5 and jisx for other environments. |
298 |
|
|
299 |
The tables are large (over 40000 entries), so this option is not the |
This option is on by default. If you are not interested in CJK |
300 |
default. Also, installing them may be rather slow." |
characters and want to avoid some overhead on encoding/decoding |
301 |
:init-value nil |
by the above coding systems, you can customize this option to nil." |
302 |
|
:init-value t |
303 |
:version "21.4" |
:version "21.4" |
304 |
:type 'boolean |
:type 'boolean |
|
:set-after '(current-language-environment) |
|
305 |
:group 'mule |
:group 'mule |
306 |
:global t |
:global t |
307 |
(if utf-translate-cjk-mode |
(if utf-translate-cjk-mode |
|
;; Fixme: Allow the use of the CJK charsets to be |
|
|
;; customized by reordering and possible omission. |
|
308 |
(progn |
(progn |
|
;; Redefine them with realistic initial sizes and a |
|
|
;; smallish rehash size to avoid wasting significant |
|
|
;; space after they're built. |
|
|
(setq ucs-mule-cjk-to-unicode |
|
|
(make-hash-table :test 'eq :size 43000 :rehash-size 1000) |
|
|
ucs-unicode-to-mule-cjk |
|
|
(make-hash-table :test 'eq :size 21500 :rehash-size 1000)) |
|
|
;; Load the files explicitly, to avoid having to keep |
|
|
;; around the large tables they contain (as well as the |
|
|
;; ones which get built). |
|
|
(cond |
|
|
((string= "Korean" current-language-environment) |
|
|
(load "subst-jis") |
|
|
(load "subst-big5") |
|
|
(load "subst-gb2312") |
|
|
(load "subst-ksc")) |
|
|
((string= "Chinese-BIG5" current-language-environment) |
|
|
(load "subst-jis") |
|
|
(load "subst-ksc") |
|
|
(load "subst-gb2312") |
|
|
(load "subst-big5")) |
|
|
((string= "Chinese-GB" current-language-environment) |
|
|
(load "subst-jis") |
|
|
(load "subst-ksc") |
|
|
(load "subst-big5") |
|
|
(load "subst-gb2312")) |
|
|
(t |
|
|
(load "subst-ksc") |
|
|
(load "subst-gb2312") |
|
|
(load "subst-big5") |
|
|
(load "subst-jis"))) ; jis covers as much as big5, gb2312 |
|
309 |
(define-translation-hash-table 'utf-subst-table-for-decode |
(define-translation-hash-table 'utf-subst-table-for-decode |
310 |
ucs-unicode-to-mule-cjk) |
ucs-unicode-to-mule-cjk) |
311 |
(define-translation-hash-table 'utf-subst-table-for-encode |
(define-translation-hash-table 'utf-subst-table-for-encode |
319 |
(make-hash-table :test 'eq)) |
(make-hash-table :test 'eq)) |
320 |
(set-char-table-extra-slot (get 'utf-translation-table-for-encode |
(set-char-table-extra-slot (get 'utf-translation-table-for-encode |
321 |
'translation-table) |
'translation-table) |
322 |
1 nil))) |
1 nil)) |
323 |
|
|
324 |
|
;; Update safe-chars of mule-utf-* coding systems. |
325 |
|
(dolist (elt (coding-system-list t)) |
326 |
|
(if (string-match "^mule-utf" (symbol-name elt)) |
327 |
|
(let ((safe-charsets (coding-system-get elt 'safe-charsets)) |
328 |
|
(safe-chars (coding-system-get elt 'safe-chars)) |
329 |
|
(need-update nil)) |
330 |
|
(dolist (charset utf-translate-cjk-charsets) |
331 |
|
(unless (eq utf-translate-cjk-mode (memq charset safe-charsets)) |
332 |
|
(setq safe-charsets |
333 |
|
(if utf-translate-cjk-mode |
334 |
|
(cons charset safe-charsets) |
335 |
|
(delq charset safe-charsets)) |
336 |
|
need-update t) |
337 |
|
(aset safe-chars (make-char charset) utf-translate-cjk-mode))) |
338 |
|
(when need-update |
339 |
|
(coding-system-put elt 'safe-charsets safe-charsets) |
340 |
|
(define-coding-system-internal elt)))))) |
341 |
|
|
342 |
|
(define-ccl-program ccl-mule-utf-untrans |
343 |
|
;; R0 is an untranslatable Unicode code-point (U+3500..U+DFFF or |
344 |
|
;; U+10000..U+10FFFF) or an invaid byte (#x00..#xFF). Write |
345 |
|
;; eight-bit-control/graphic sequence (2 to 4 chars) representing |
346 |
|
;; UTF-8 sequence of r0. Registers r4, r5, r6 are modified. |
347 |
|
;; |
348 |
|
;; This is a subrountine because we assume that this is called very |
349 |
|
;; rarely (so we don't have to worry about the overhead of the |
350 |
|
;; call). |
351 |
|
`(0 |
352 |
|
((r5 = ,(charset-id 'eight-bit-control)) |
353 |
|
(r6 = ,(charset-id 'eight-bit-graphic)) |
354 |
|
(if (r0 < #x100) |
355 |
|
((r4 = ((r0 >> 6) | #xC0)) |
356 |
|
(write-multibyte-character r6 r4)) |
357 |
|
((if (r0 < #x10000) |
358 |
|
((r4 = ((r0 >> 12) | #xE0)) |
359 |
|
(write-multibyte-character r6 r4)) |
360 |
|
((r4 = ((r0 >> 18) | #xF0)) |
361 |
|
(write-multibyte-character r6 r4) |
362 |
|
(r4 = (((r0 >> 12) & #x3F) | #x80)) |
363 |
|
(if (r4 < #xA0) |
364 |
|
(write-multibyte-character r5 r4) |
365 |
|
(write-multibyte-character r6 r4)))) |
366 |
|
(r4 = (((r0 >> 6) & #x3F) | #x80)) |
367 |
|
(if (r4 < #xA0) |
368 |
|
(write-multibyte-character r5 r4) |
369 |
|
(write-multibyte-character r6 r4)))) |
370 |
|
(r4 = ((r0 & #x3F) | #x80)) |
371 |
|
(if (r4 < #xA0) |
372 |
|
(write-multibyte-character r5 r4) |
373 |
|
(write-multibyte-character r6 r4))))) |
374 |
|
|
375 |
(define-ccl-program ccl-decode-mule-utf-8 |
(define-ccl-program ccl-decode-mule-utf-8 |
376 |
;; |
;; |
389 |
;; (>= 8000) | | |
;; (>= 8000) | | |
390 |
;; mule-unicode-2500-33ff | 3 | 4 |
;; mule-unicode-2500-33ff | 3 | 4 |
391 |
;; mule-unicode-e000-ffff | 3 | 4 |
;; mule-unicode-e000-ffff | 3 | 4 |
392 |
|
;; -----------------------+----------------+--------------- |
393 |
|
;; invalid byte | 1 | 2 |
394 |
;; |
;; |
395 |
;; Thus magnification factor is two. |
;; Thus magnification factor is two. |
396 |
;; |
;; |
397 |
`(2 |
`(2 |
398 |
((r5 = ,(charset-id 'eight-bit-control)) |
((r6 = ,(charset-id 'latin-iso8859-1)) |
399 |
(r6 = ,(charset-id 'eight-bit-graphic)) |
(read r0) |
400 |
(loop |
(loop |
|
(r0 = -1) |
|
|
(read r0) |
|
|
|
|
|
;; 1byte encoding, i.e., ascii |
|
401 |
(if (r0 < #x80) |
(if (r0 < #x80) |
402 |
((write r0)) |
;; 1-byte encoding, i.e., ascii |
403 |
(if (r0 < #xc0) ; continuation byte (invalid here) |
(write-read-repeat r0)) |
404 |
((if (r0 < #xa0) |
(if (r0 < #xc2) |
405 |
(write-multibyte-character r5 r0) |
;; continuation byte (invalid here) or 1st byte of overlong |
406 |
(write-multibyte-character r6 r0))) |
;; 2-byte sequence. |
407 |
;; 2 byte encoding 00000yyyyyxxxxxx = 110yyyyy 10xxxxxx |
((call ccl-mule-utf-untrans) |
408 |
(if (r0 < #xe0) |
(r6 = ,(charset-id 'latin-iso8859-1)) |
409 |
((r1 = -1) |
(read r0) |
410 |
(read r1) |
(repeat))) |
411 |
|
|
412 |
(if ((r1 & #b11000000) != #b10000000) |
;; Read the 2nd byte. |
413 |
;; Invalid 2-byte sequence |
(read r1) |
414 |
((if (r0 < #xa0) |
(if ((r1 & #b11000000) != #b10000000) ; Invalid 2nd byte |
415 |
(write-multibyte-character r5 r0) |
((call ccl-mule-utf-untrans) |
416 |
(write-multibyte-character r6 r0)) |
(r6 = ,(charset-id 'latin-iso8859-1)) |
417 |
(if (r1 < #x80) |
;; Handle it in the next loop. |
418 |
(write r1) |
(r0 = r1) |
419 |
(if (r1 < #xa0) |
(repeat))) |
420 |
(write-multibyte-character r5 r1) |
|
421 |
(write-multibyte-character r6 r1)))) |
(if (r0 < #xe0) |
422 |
|
;; 2-byte encoding 00000yyyyyxxxxxx = 110yyyyy 10xxxxxx |
423 |
((r3 = r0) ; save in case of overlong sequence |
((r1 &= #x3F) |
424 |
(r2 = r1) |
(r1 |= ((r0 & #x1F) << 6)) |
425 |
(r0 &= #x1f) |
;; Now r2 holds scalar value. We don't have to check |
426 |
(r0 <<= 6) |
;; `overlong sequence' because r0 >= 0xC2. |
427 |
(r1 &= #x3f) |
|
428 |
(r1 += r0) |
(if (r1 >= 256) |
429 |
;; Now r1 holds scalar value |
;; mule-unicode-0100-24ff (< 0800) |
430 |
|
((r0 = ,(charset-id 'mule-unicode-0100-24ff)) |
431 |
(if (r1 < 128) ; `overlong sequence' |
(r1 -= #x0100) |
432 |
((if (r3 < #xa0) |
(r2 = (((r1 / 96) + 32) << 7)) |
433 |
(write-multibyte-character r5 r3) |
(r1 %= 96) |
434 |
(write-multibyte-character r6 r3)) |
(r1 += (r2 + 32)) |
435 |
(if (r2 < #x80) |
(translate-character |
436 |
(write r2) |
utf-translation-table-for-decode r0 r1) |
437 |
(if (r2 < #xa0) |
(write-multibyte-character r0 r1) |
438 |
(write-multibyte-character r5 r2) |
(read r0) |
439 |
(write-multibyte-character r6 r2)))) |
(repeat)) |
440 |
|
(if (r1 >= 160) |
441 |
;; eight-bit-control |
;; latin-iso8859-1 |
442 |
(if (r1 < 160) |
((r1 -= 128) |
443 |
((write-multibyte-character r5 r1)) |
(write-multibyte-character r6 r1) |
444 |
|
(read r0) |
445 |
;; latin-iso8859-1 |
(repeat)) |
446 |
(if (r1 < 256) |
;; eight-bit-control |
447 |
((r0 = ,(charset-id 'latin-iso8859-1)) |
((r0 = ,(charset-id 'eight-bit-control)) |
448 |
(r1 -= 128) |
(write-multibyte-character r0 r1) |
449 |
(write-multibyte-character r0 r1)) |
(read r0) |
450 |
|
(repeat)))))) |
451 |
;; mule-unicode-0100-24ff (< 0800) |
|
452 |
((r0 = ,(charset-id 'mule-unicode-0100-24ff)) |
;; Read the 3rd bytes. |
453 |
(r1 -= #x0100) |
(read r2) |
454 |
(r2 = (((r1 / 96) + 32) << 7)) |
(if ((r2 & #b11000000) != #b10000000) ; Invalid 3rd byte |
455 |
(r1 %= 96) |
((call ccl-mule-utf-untrans) |
456 |
(r1 += (r2 + 32)) |
(r0 = r1) |
457 |
(translate-character |
(call ccl-mule-utf-untrans) |
458 |
utf-translation-table-for-decode r0 r1) |
(r6 = ,(charset-id 'latin-iso8859-1)) |
459 |
(write-multibyte-character r0 r1)))))))) |
;; Handle it in the next loop. |
460 |
|
(r0 = r2) |
461 |
;; 3byte encoding |
(repeat))) |
462 |
;; zzzzyyyyyyxxxxxx = 1110zzzz 10yyyyyy 10xxxxxx |
|
463 |
(if (r0 < #xf0) |
(if (r0 < #xF0) |
464 |
((r1 = -1) |
;; 3byte encoding |
465 |
(r2 = -1) |
;; zzzzyyyyyyxxxxxx = 1110zzzz 10yyyyyy 10xxxxxx |
466 |
(read r1 r2) |
((r3 = ((r0 & #xF) << 12)) |
467 |
|
(r3 |= ((r1 & #x3F) << 6)) |
468 |
;; This is set to 1 if the encoding is invalid. |
(r3 |= (r2 & #x3F)) |
469 |
(r4 = 0) |
|
470 |
|
(if (r3 < #x800) ; `overlong sequence' |
471 |
(r3 = (r1 & #b11000000)) |
((call ccl-mule-utf-untrans) |
472 |
(r3 |= ((r2 >> 2) & #b00110000)) |
(r0 = r1) |
473 |
(if (r3 != #b10100000) |
(call ccl-mule-utf-untrans) |
474 |
(r4 = 1) |
(r0 = r2) |
475 |
((r3 = ((r0 & #x0f) << 12)) |
(call ccl-mule-utf-untrans) |
476 |
(r3 += ((r1 & #x3f) << 6)) |
(r6 = ,(charset-id 'latin-iso8859-1)) |
477 |
(r3 += (r2 & #x3f)) |
(read r0) |
478 |
(if (r3 < #x0800) |
(repeat))) |
479 |
(r4 = 1)))) |
|
480 |
|
(if (r3 < #x2500) |
481 |
(if (r4 != 0) |
;; mule-unicode-0100-24ff (>= 0800) |
482 |
;; Invalid 3-byte sequence |
((r0 = ,(charset-id 'mule-unicode-0100-24ff)) |
483 |
((if (r0 < #xa0) |
(r3 -= #x0100) |
484 |
(write-multibyte-character r5 r0) |
(r3 //= 96) |
485 |
(write-multibyte-character r6 r0)) |
(r1 = (r7 + 32)) |
486 |
(if (r1 < #x80) |
(r1 += ((r3 + 32) << 7)) |
487 |
(write r1) |
(translate-character |
488 |
(if (r1 < #xa0) |
utf-translation-table-for-decode r0 r1) |
489 |
(write-multibyte-character r5 r1) |
(write-multibyte-character r0 r1) |
490 |
(write-multibyte-character r6 r1))) |
(read r0) |
491 |
(if (r2 < #x80) |
(repeat))) |
492 |
(write r2) |
|
493 |
(if (r2 < #xa0) |
(if (r3 < #x3400) |
494 |
(write-multibyte-character r5 r2) |
;; mule-unicode-2500-33ff |
495 |
(write-multibyte-character r6 r2)))) |
((r0 = r3) ; don't zap r3 |
496 |
|
(lookup-integer utf-subst-table-for-decode r0 r1) |
497 |
;; mule-unicode-0100-24ff (>= 0800) |
(if (r7 == 0) |
498 |
((if (r3 < #x2500) |
((r0 = ,(charset-id 'mule-unicode-2500-33ff)) |
499 |
((r0 = ,(charset-id 'mule-unicode-0100-24ff)) |
(r3 -= #x2500) |
500 |
(r3 -= #x0100) |
(r3 //= 96) |
501 |
(r3 //= 96) |
(r1 = (r7 + 32)) |
502 |
(r1 = (r7 + 32)) |
(r1 += ((r3 + 32) << 7)))) |
503 |
(r1 += ((r3 + 32) << 7)) |
(write-multibyte-character r0 r1) |
504 |
(translate-character |
(read r0) |
505 |
utf-translation-table-for-decode r0 r1) |
(repeat))) |
506 |
(write-multibyte-character r0 r1)) |
|
507 |
|
(if (r3 < #xE000) |
508 |
;; mule-unicode-2500-33ff |
;; Try to convert to CJK chars, else |
509 |
(if (r3 < #x3400) |
;; keep them as eight-bit-{control|graphic}. |
510 |
((r4 = r3) ; don't zap r3 |
((r0 = r3) |
511 |
(lookup-integer utf-subst-table-for-decode r4 r5) |
(lookup-integer utf-subst-table-for-decode r3 r1) |
512 |
(if r7 |
(if r7 |
513 |
;; got a translation |
;; got a translation |
514 |
((write-multibyte-character r4 r5) |
((write-multibyte-character r3 r1) |
515 |
;; Zapped through register starvation. |
(read r0) |
516 |
(r5 = ,(charset-id 'eight-bit-control))) |
(repeat)) |
517 |
((r0 = ,(charset-id 'mule-unicode-2500-33ff)) |
((call ccl-mule-utf-untrans) |
518 |
(r3 -= #x2500) |
(r6 = ,(charset-id 'latin-iso8859-1)) |
519 |
(r3 //= 96) |
(read r0) |
520 |
(r1 = (r7 + 32)) |
(repeat))))) |
521 |
(r1 += ((r3 + 32) << 7)) |
|
522 |
(write-multibyte-character r0 r1)))) |
;; mule-unicode-e000-ffff |
523 |
|
;; Fixme: fffe and ffff are invalid. |
524 |
;; U+3400 .. U+D7FF |
(r0 = r3) ; don't zap r3 |
525 |
;; Try to convert to CJK chars, else keep |
(lookup-integer utf-subst-table-for-decode r0 r1) |
526 |
;; them as eight-bit-{control|graphic}. |
(if (r7 == 0) |
527 |
(if (r3 < #xd800) |
((r0 = ,(charset-id 'mule-unicode-e000-ffff)) |
528 |
((r4 = r3) ; don't zap r3 |
(r3 -= #xe000) |
529 |
(lookup-integer utf-subst-table-for-decode r4 r5) |
(r3 //= 96) |
530 |
(if r7 |
(r1 = (r7 + 32)) |
531 |
;; got a translation |
(r1 += ((r3 + 32) << 7)))) |
532 |
((write-multibyte-character r4 r5) |
(write-multibyte-character r0 r1) |
533 |
;; Zapped through register starvation. |
(read r0) |
534 |
(r5 = ,(charset-id 'eight-bit-control))) |
(repeat))) |
535 |
;; #xe0 <= r0 < #xf0, so r0 is eight-bit-graphic |
|
536 |
((r3 = r6) |
;; Read the 4th bytes. |
537 |
(write-multibyte-character r3 r0) |
(read r3) |
538 |
(if (r1 < #xa0) |
(if ((r3 & #b11000000) != #b10000000) ; Invalid 4th byte |
539 |
(r3 = r5)) |
((call ccl-mule-utf-untrans) |
540 |
(write-multibyte-character r3 r1) |
(r0 = r1) |
541 |
(if (r2 < #xa0) |
(call ccl-mule-utf-untrans) |
542 |
(r3 = r5) |
(r0 = r2) |
543 |
(r3 = r6)) |
(call ccl-mule-utf-untrans) |
544 |
(write-multibyte-character r3 r2)))) |
(r6 = ,(charset-id 'latin-iso8859-1)) |
545 |
|
;; Handle it in the next loop. |
546 |
;; Surrogates, U+D800 .. U+DFFF |
(r0 = r3) |
547 |
(if (r3 < #xe000) |
(repeat))) |
548 |
((r3 = r6) |
|
549 |
(write-multibyte-character r3 r0) ; eight-bit-graphic |
(if (r0 < #xF8) |
550 |
(if (r1 < #xa0) |
;; 4-byte encoding: |
551 |
(r3 = r5)) |
;; wwwzzzzzzyyyyyyxxxxxx = 11110www 10zzzzzz 10yyyyyy 10xxxxxx |
552 |
(write-multibyte-character r3 r1) |
;; keep those bytes as eight-bit-{control|graphic} |
553 |
(if (r2 < #xa0) |
;; Fixme: allow lookup in utf-subst-table-for-decode. |
554 |
(r3 = r5) |
((r4 = ((r0 & #x7) << 18)) |
555 |
(r3 = r6)) |
(r4 |= ((r1 & #x3F) << 12)) |
556 |
(write-multibyte-character r3 r2)) |
(r4 |= ((r2 & #x3F) << 6)) |
557 |
|
(r4 |= (r3 & #x3F)) |
558 |
;; mule-unicode-e000-ffff |
|
559 |
;; Fixme: fffe and ffff are invalid. |
(if (r4 < #x10000) ; `overlong sequence' |
560 |
((r4 = r3) ; don't zap r3 |
((call ccl-mule-utf-untrans) |
561 |
(lookup-integer utf-subst-table-for-decode r4 r5) |
(r0 = r1) |
562 |
(if r7 |
(call ccl-mule-utf-untrans) |
563 |
;; got a translation |
(r0 = r2) |
564 |
((write-multibyte-character r4 r5) |
(call ccl-mule-utf-untrans) |
565 |
;; Zapped through register starvation. |
(r0 = r3) |
566 |
(r5 = ,(charset-id 'eight-bit-control))) |
(call ccl-mule-utf-untrans)) |
567 |
((r0 = ,(charset-id 'mule-unicode-e000-ffff)) |
((r0 = r4) |
568 |
(r3 -= #xe000) |
(call ccl-mule-utf-untrans)))) |
569 |
(r3 //= 96) |
|
570 |
(r1 = (r7 + 32)) |
;; Unsupported sequence. |
571 |
(r1 += ((r3 + 32) << 7)) |
((call ccl-mule-utf-untrans) |
572 |
(write-multibyte-character r0 r1))))))))))) |
(r0 = r1) |
573 |
|
(call ccl-mule-utf-untrans) |
574 |
(if (r0 < #xfe) |
(r0 = r2) |
575 |
;; 4byte encoding |
(call ccl-mule-utf-untrans) |
576 |
;; keep those bytes as eight-bit-{control|graphic} |
(r0 = r3) |
577 |
;; Fixme: allow lookup in utf-subst-table-for-decode. |
(call ccl-mule-utf-untrans))) |
578 |
((r1 = -1) |
(r6 = ,(charset-id 'latin-iso8859-1)) |
579 |
(r2 = -1) |
(read r0) |
|
(r3 = -1) |
|
|
(read r1 r2 r3) |
|
|
;; r0 > #xf0, thus eight-bit-graphic |
|
|
(write-multibyte-character r6 r0) |
|
|
(if (r1 < #xa0) |
|
|
(if (r1 < #x80) ; invalid byte |
|
|
(write r1) |
|
|
(write-multibyte-character r5 r1)) |
|
|
(write-multibyte-character r6 r1)) |
|
|
(if (r2 < #xa0) |
|
|
(if (r2 < #x80) ; invalid byte |
|
|
(write r2) |
|
|
(write-multibyte-character r5 r2)) |
|
|
(write-multibyte-character r6 r2)) |
|
|
(if (r3 < #xa0) |
|
|
(if (r3 < #x80) ; invalid byte |
|
|
(write r3) |
|
|
(write-multibyte-character r5 r3)) |
|
|
(write-multibyte-character r6 r3)) |
|
|
(if (r0 >= #xf8) ; 5- or 6-byte encoding |
|
|
((r0 = -1) |
|
|
(read r0) |
|
|
(if (r0 < #xa0) |
|
|
(if (r0 < #x80) ; invalid byte |
|
|
(write r0) |
|
|
(write-multibyte-character r5 r0)) |
|
|
(write-multibyte-character r6 r0)) |
|
|
(if (r0 >= #xfc) ; 6-byte |
|
|
((r0 = -1) |
|
|
(read r0) |
|
|
(if (r0 < #xa0) |
|
|
(if (r0 < #x80) ; invalid byte |
|
|
(write r0) |
|
|
(write-multibyte-character r5 r0)) |
|
|
(write-multibyte-character r6 r0))))))) |
|
|
;; else invalid byte >= #xfe |
|
|
(write-multibyte-character r6 r0)))))) |
|
580 |
(repeat))) |
(repeat))) |
581 |
|
|
582 |
|
|
583 |
;; At EOF... |
;; At EOF... |
584 |
(if (r0 >= 0) |
(if (r0 >= 0) |
585 |
((if (r0 < #x80) |
;; r0 >= #x80 |
586 |
(write r0) |
((call ccl-mule-utf-untrans) |
|
(if (r0 < #xa0) |
|
|
(write-multibyte-character r5 r0) |
|
|
((write-multibyte-character r6 r0)))) |
|
587 |
(if (r1 >= 0) |
(if (r1 >= 0) |
588 |
((if (r1 < #x80) |
((r0 = r1) |
589 |
(write r1) |
(call ccl-mule-utf-untrans) |
|
(if (r1 < #xa0) |
|
|
(write-multibyte-character r5 r1) |
|
|
((write-multibyte-character r6 r1)))) |
|
590 |
(if (r2 >= 0) |
(if (r2 >= 0) |
591 |
((if (r2 < #x80) |
((r0 = r2) |
592 |
(write r2) |
(call ccl-mule-utf-untrans) |
|
(if (r2 < #xa0) |
|
|
(write-multibyte-character r5 r2) |
|
|
((write-multibyte-character r6 r2)))) |
|
593 |
(if (r3 >= 0) |
(if (r3 >= 0) |
594 |
(if (r3 < #x80) |
((r0 = r3) |
595 |
(write r3) |
(call ccl-mule-utf-untrans)))))))))) |
|
(if (r3 < #xa0) |
|
|
(write-multibyte-character r5 r3) |
|
|
((write-multibyte-character r6 r3)))))))))))) |
|
596 |
|
|
597 |
"CCL program to decode UTF-8. |
"CCL program to decode UTF-8. |
598 |
Basic decoding is done into the charsets ascii, latin-iso8859-1 and |
Basic decoding is done into the charsets ascii, latin-iso8859-1 and |
601 |
Encodings of un-representable Unicode characters are decoded asis into |
Encodings of un-representable Unicode characters are decoded asis into |
602 |
eight-bit-control and eight-bit-graphic characters.") |
eight-bit-control and eight-bit-graphic characters.") |
603 |
|
|
604 |
|
(define-ccl-program ccl-mule-utf-8-encode-untrans |
605 |
|
;; UTF-8 decoder generates an UTF-8 sequence represented by a |
606 |
|
;; sequence eight-bit-control/graphic chars for an untranslatable |
607 |
|
;; character and an invalid byte. |
608 |
|
;; |
609 |
|
;; This CCL parses that sequence (the first byte is already in r1), |
610 |
|
;; writes out the original bytes of that sequence, and sets r5 to |
611 |
|
;; -1. |
612 |
|
;; |
613 |
|
;; If the eight-bit-control/graphic sequence is shorter than what r1 |
614 |
|
;; suggests, it sets r5 and r6 to the last character read that |
615 |
|
;; should be handled by the next loop of a caller. |
616 |
|
;; |
617 |
|
;; Note: For UTF-8 validation, we only check if a character is |
618 |
|
;; eight-bit-control/graphic or not. It may result in incorrect |
619 |
|
;; handling of random binary data, but such a data can't be encoded |
620 |
|
;; by UTF-8 anyway. At least, UTF-8 decoders doesn't generate such |
621 |
|
;; a sequence even if a source contains invalid byte-sequence. |
622 |
|
`(0 |
623 |
|
(;; Read the 2nd byte. |
624 |
|
(read-multibyte-character r5 r6) |
625 |
|
(r0 = (r5 != ,(charset-id 'eight-bit-control))) |
626 |
|
(if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0) |
627 |
|
((write r1) ; invalid UTF-8 |
628 |
|
(r1 = -1) |
629 |
|
(end))) |
630 |
|
|
631 |
|
(if (r1 <= #xC3) |
632 |
|
;; 2-byte sequence for an originally invalid byte. |
633 |
|
((r6 &= #x3F) |
634 |
|
(r6 |= ((r1 & #x1F) << 6)) |
635 |
|
(write r6) |
636 |
|
(r5 = -1) |
637 |
|
(end))) |
638 |
|
|
639 |
|
(write r1 r6) |
640 |
|
(r2 = r1) |
641 |
|
(r1 = -1) |
642 |
|
;; Read the 3rd byte. |
643 |
|
(read-multibyte-character r5 r6) |
644 |
|
(r0 = (r5 != ,(charset-id 'eight-bit-control))) |
645 |
|
(if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0) |
646 |
|
(end)) ; invalid UTF-8 |
647 |
|
(write r6) |
648 |
|
(if (r2 < #xF0) |
649 |
|
;; 3-byte sequence for an untranslated character. |
650 |
|
((r5 = -1) |
651 |
|
(end))) |
652 |
|
;; Read the 4th byte. |
653 |
|
(read-multibyte-character r5 r6) |
654 |
|
(r0 = (r5 != ,(charset-id 'eight-bit-control))) |
655 |
|
(if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0) |
656 |
|
(end)) ; invalid UTF-8 |
657 |
|
;; 4-byte sequence for an untranslated character. |
658 |
|
(write r6) |
659 |
|
(r5 = -1) |
660 |
|
(end)) |
661 |
|
|
662 |
|
;; At EOF... |
663 |
|
((r5 = -1) |
664 |
|
(if (r1 >= 0) |
665 |
|
(write r1))))) |
666 |
|
|
667 |
(define-ccl-program ccl-encode-mule-utf-8 |
(define-ccl-program ccl-encode-mule-utf-8 |
668 |
`(1 |
`(1 |
669 |
((r5 = -1) |
((r5 = -1) |
670 |
(loop |
(loop |
671 |
(if (r5 < 0) |
(if (r5 < 0) |
672 |
((r1 = -1) |
(read-multibyte-character r0 r1) |
673 |
(read-multibyte-character r0 r1) |
;; Pre-read character is in r5 (charset-ID) and r6 (code-point). |
674 |
(translate-character utf-translation-table-for-encode r0 r1)) |
((r0 = r5) |
|
(;; We have already done read-multibyte-character. |
|
|
(r0 = r5) |
|
675 |
(r1 = r6) |
(r1 = r6) |
676 |
(r5 = -1))) |
(r5 = -1))) |
677 |
|
(translate-character utf-translation-table-for-encode r0 r1) |
678 |
|
|
679 |
(if (r0 == ,(charset-id 'ascii)) |
(if (r0 == ,(charset-id 'ascii)) |
680 |
(write r1) |
(write-repeat r1)) |
681 |
|
|
682 |
(if (r0 == ,(charset-id 'latin-iso8859-1)) |
(if (r0 == ,(charset-id 'latin-iso8859-1)) |
683 |
;; r1 scalar utf-8 |
;; r1 scalar utf-8 |
684 |
;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx |
;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx |
685 |
;; 20 0000 0000 1010 0000 1100 0010 1010 0000 |
;; 20 0000 0000 1010 0000 1100 0010 1010 0000 |
686 |
;; 7f 0000 0000 1111 1111 1100 0011 1011 1111 |
;; 7f 0000 0000 1111 1111 1100 0011 1011 1111 |
687 |
((r0 = (((r1 & #x40) >> 6) | #xc2)) |
((r0 = (((r1 & #x40) >> 6) | #xc2)) |
688 |
(r1 &= #x3f) |
(r1 &= #x3f) |
689 |
|
(r1 |= #x80) |
690 |
|
(write r0) |
691 |
|
(write-repeat r1))) |
692 |
|
|
693 |
|
(if (r0 == ,(charset-id 'mule-unicode-0100-24ff)) |
694 |
|
((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96)) |
695 |
|
;; #x3f80 == (0011 1111 1000 0000)b |
696 |
|
(r1 &= #x7f) |
697 |
|
(r1 += (r0 + 224)) ; 240 == -32 + #x0100 |
698 |
|
;; now r1 holds scalar value |
699 |
|
(if (r1 < #x0800) |
700 |
|
;; 2byte encoding |
701 |
|
((write ((r1 >> 6) | #xC0)) |
702 |
|
(r1 &= #x3F) |
703 |
|
(r1 |= #x80) |
704 |
|
(write-repeat r1)) |
705 |
|
;; 3byte encoding |
706 |
|
((write ((r1 >> 12) | #xE0)) |
707 |
|
(write (((r1 & #x0FC0) >> 6) | #x80)) |
708 |
|
(r1 &= #x3F) |
709 |
|
(r1 |= #x80) |
710 |
|
(write-repeat r1))))) |
711 |
|
|
712 |
|
(if (r0 == ,(charset-id 'mule-unicode-2500-33ff)) |
713 |
|
((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96)) |
714 |
|
(r1 &= #x7f) |
715 |
|
(r1 += (r0 + 9440)) ; 9440 == -32 + #x2500 |
716 |
|
;; now r1 holds scalar value |
717 |
|
(write ((r1 >> 12) | #xE0)) |
718 |
|
(write (((r1 & #x0FC0) >> 6) | #x80)) |
719 |
|
(r1 &= #x3F) |
720 |
|
(r1 |= #x80) |
721 |
|
(write-repeat r1))) |
722 |
|
|
723 |
|
(if (r0 == ,(charset-id 'mule-unicode-e000-ffff)) |
724 |
|
((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96)) |
725 |
|
(r1 &= #x7f) |
726 |
|
(r1 += (r0 + 57312)) ; 57312 == -32 + #xe000 |
727 |
|
;; now r1 holds scalar value |
728 |
|
(write ((r1 >> 12) | #xE0)) |
729 |
|
(write (((r1 & #x0FC0) >> 6) | #x80)) |
730 |
|
(r1 &= #x3F) |
731 |
|
(r1 |= #x80) |
732 |
|
(write-repeat r1))) |
733 |
|
|
734 |
|
(if (r0 == ,(charset-id 'eight-bit-control)) |
735 |
|
;; r1 scalar utf-8 |
736 |
|
;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx |
737 |
|
;; 80 0000 0000 1000 0000 1100 0010 1000 0000 |
738 |
|
;; 9f 0000 0000 1001 1111 1100 0010 1001 1111 |
739 |
|
((write #xC2) |
740 |
|
(write-repeat r1))) |
741 |
|
|
742 |
|
(if (r0 == ,(charset-id 'eight-bit-graphic)) |
743 |
|
;; r1 scalar utf-8 |
744 |
|
;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx |
745 |
|
;; a0 0000 0000 1010 0000 1100 0010 1010 0000 |
746 |
|
;; ff 0000 0000 1111 1111 1101 1111 1011 1111 |
747 |
|
((r0 = (r1 >= #xC0)) |
748 |
|
(r0 &= (r1 <= #xC3)) |
749 |
|
(r4 = (r1 >= #xE1)) |
750 |
|
(r4 &= (r1 <= #xF7)) |
751 |
|
(r0 |= r4) |
752 |
|
(if r0 |
753 |
|
((call ccl-mule-utf-8-encode-untrans) |
754 |
|
(repeat)) |
755 |
|
(write-repeat r1)))) |
756 |
|
|
757 |
|
(lookup-character utf-subst-table-for-encode r0 r1) |
758 |
|
(if r7 ; lookup succeeded |
759 |
|
(if (r0 < #x800) |
760 |
|
;; 2byte encoding |
761 |
|
((write ((r0 >> 6) | #xC0)) |
762 |
|
(r1 &= #x3F) |
763 |
|
(r1 |= #x80) |
764 |
|
(write-repeat r1)) |
765 |
|
;; 3byte encoding |
766 |
|
((write ((r0 >> 12) | #xE0)) |
767 |
|
(write (((r0 & #x0FC0) >> 6) | #x80)) |
768 |
|
(r1 &= #x3F) |
769 |
(r1 |= #x80) |
(r1 |= #x80) |
770 |
(write r0 r1)) |
(write-repeat r1)))) |
|
|
|
|
(if (r0 == ,(charset-id 'mule-unicode-0100-24ff)) |
|
|
((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96)) |
|
|
;; #x3f80 == (0011 1111 1000 0000)b |
|
|
(r1 &= #x7f) |
|
|
(r1 += (r0 + 224)) ; 240 == -32 + #x0100 |
|
|
;; now r1 holds scalar value |
|
|
(if (r1 < #x0800) |
|
|
;; 2byte encoding |
|
|
((r0 = (((r1 & #x07c0) >> 6) | #xc0)) |
|
|
;; #x07c0 == (0000 0111 1100 0000)b |
|
|
(r1 &= #x3f) |
|
|
(r1 |= #x80) |
|
|
(write r0 r1)) |
|
|
;; 3byte encoding |
|
|
((r0 = (((r1 & #xf000) >> 12) | #xe0)) |
|
|
(r2 = ((r1 & #x3f) | #x80)) |
|
|
(r1 &= #x0fc0) |
|
|
(r1 >>= 6) |
|
|
(r1 |= #x80) |
|
|
(write r0 r1 r2)))) |
|
|
|
|
|
(if (r0 == ,(charset-id 'mule-unicode-2500-33ff)) |
|
|
((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96)) |
|
|
(r1 &= #x7f) |
|
|
(r1 += (r0 + 9440)) ; 9440 == -32 + #x2500 |
|
|
(r0 = (((r1 & #xf000) >> 12) | #xe0)) |
|
|
(r2 = ((r1 & #x3f) | #x80)) |
|
|
(r1 &= #x0fc0) |
|
|
(r1 >>= 6) |
|
|
(r1 |= #x80) |
|
|
(write r0 r1 r2)) |
|
|
|
|
|
(if (r0 == ,(charset-id 'mule-unicode-e000-ffff)) |
|
|
((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96)) |
|
|
(r1 &= #x7f) |
|
|
(r1 += (r0 + 57312)) ; 57312 == -32 + #xe000 |
|
|
(r0 = (((r1 & #xf000) >> 12) | #xe0)) |
|
|
(r2 = ((r1 & #x3f) | #x80)) |
|
|
(r1 &= #x0fc0) |
|
|
(r1 >>= 6) |
|
|
(r1 |= #x80) |
|
|
(write r0 r1 r2)) |
|
|
|
|
|
(if (r0 == ,(charset-id 'eight-bit-control)) |
|
|
;; r1 scalar utf-8 |
|
|
;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx |
|
|
;; 80 0000 0000 1000 0000 1100 0010 1000 0000 |
|
|
;; 9f 0000 0000 1001 1111 1100 0010 1001 1111 |
|
|
((write #xc2) |
|
|
(write r1)) |
|
|
|
|
|
(if (r0 == ,(charset-id 'eight-bit-graphic)) |
|
|
;; r1 scalar utf-8 |
|
|
;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx |
|
|
;; a0 0000 0000 1010 0000 1100 0010 1010 0000 |
|
|
;; ff 0000 0000 1111 1111 1101 1111 1011 1111 |
|
|
((write r1) |
|
|
(r1 = -1) |
|
|
(read-multibyte-character r0 r1) |
|
|
(if (r0 != ,(charset-id 'eight-bit-graphic)) |
|
|
(if (r0 != ,(charset-id 'eight-bit-control)) |
|
|
((r5 = r0) |
|
|
(r6 = r1)))) |
|
|
(if (r5 < 0) |
|
|
((read-multibyte-character r0 r2) |
|
|
(if (r0 != ,(charset-id 'eight-bit-graphic)) |
|
|
(if (r0 != ,(charset-id 'eight-bit-control)) |
|
|
((r5 = r0) |
|
|
(r6 = r2)))) |
|
|
(if (r5 < 0) |
|
|
(write r1 r2) |
|
|
(if (r1 < #xa0) |
|
|
(write r1) |
|
|
((write #xc2) |
|
|
(write r1))))))) |
|
|
|
|
|
((lookup-character utf-subst-table-for-encode r0 r1) |
|
|
(if r7 ; lookup succeeded |
|
|
((r1 = (((r0 & #xf000) >> 12) | #xe0)) |
|
|
(r2 = ((r0 & #x3f) | #x80)) |
|
|
(r0 &= #x0fc0) |
|
|
(r0 >>= 6) |
|
|
(r0 |= #x80) |
|
|
(write r1 r0 r2)) |
|
|
;; Unsupported character. |
|
|
;; Output U+FFFD, which is `ef bf bd' in UTF-8. |
|
|
((write #xef) |
|
|
(write #xbf) |
|
|
(write #xbd))))))))))) |
|
|
(repeat))) |
|
|
(if (r1 >= #xa0) |
|
|
(write r1) |
|
|
(if (r1 >= #x80) |
|
|
((write #xc2) |
|
|
(write r1))))) |
|
771 |
|
|
772 |
|
;; Unsupported character. |
773 |
|
;; Output U+FFFD, which is `ef bf bd' in UTF-8. |
774 |
|
(write #xef) |
775 |
|
(write #xbf) |
776 |
|
(write-repeat #xbd)))) |
777 |
"CCL program to encode into UTF-8.") |
"CCL program to encode into UTF-8.") |
778 |
|
|
779 |
|
|
780 |
(define-ccl-program ccl-untranslated-to-ucs |
(define-ccl-program ccl-untranslated-to-ucs |
781 |
`(0 |
`(0 |
782 |
(if (r0 < #xf0) ; 3-byte encoding, as above |
(if (r1 == 0) |
783 |
((r4 = 0) |
nil |
784 |
(r3 = (r1 & #b11000000)) |
(if (r0 <= #xC3) ; 2-byte encoding |
785 |
(r3 |= ((r2 >> 2) & #b00110000)) |
((r0 = ((r0 & #x3) << 6)) |
786 |
(if (r3 != #b10100000) |
(r0 |= (r1 & #x3F)) |
787 |
(r4 = 1) |
(r1 = 2)) |
788 |
((r3 = ((r0 & #x0f) << 12)) |
(if (r2 == 0) |
789 |
(r3 += ((r1 & #x3f) << 6)) |
(r1 = 0) |
790 |
(r3 += (r2 & #x3f)) |
(if (r0 < #xF0) ; 3-byte encoding, as above |
791 |
(if (r3 < #x0800) |
((r0 = ((r0 & #xF) << 12)) |
792 |
(r4 = 1)))) |
(r0 |= ((r1 & #x3F) << 6)) |
793 |
(if (r4 != 0) |
(r0 |= (r2 & #x3F)) |
794 |
(r0 = 0) |
(r1 = 3)) |
795 |
(r0 = r3))) |
(if (r3 == 0) |
796 |
(if (r0 < #xf8) ; 4-byte (Mule-UCS recipe) |
(r1 = 0) |
797 |
((r4 = (r1 >> 6)) |
((r0 = ((r0 & #x7) << 18)) |
798 |
(if (r4 != #b10) |
(r0 |= ((r1 & #x3F) << 12)) |
799 |
(r0 = 0) |
(r0 |= ((r2 & #x3F) << 6)) |
800 |
((r4 = (r2 >> 6)) |
(r0 |= (r3 & #x3F)) |
801 |
(if (r4 != #b10) |
(r1 = 4)))))))) |
802 |
(r0 = 0) |
"Decode 2-, 3-, or 4-byte sequences in r0, r1, r2 [,r3] to unicodes in r0. |
803 |
((r4 = (r3 >> 6)) |
Set r1 to the byte length. r0 == 0 for invalid sequence.") |
|
(if (r4 != #b10) |
|
|
(r0 = 0) |
|
|
((r1 = ((r1 & #x3F) << 12)) |
|
|
(r2 = ((r2 & #x3F) << 6)) |
|
|
(r3 &= #x3F) |
|
|
(r0 = (((((r0 & #x07) << 18) | r1) | r2) | r3))))))))) |
|
|
(r0 = 0)))) |
|
|
"Decode 3- or 4-byte sequences in r0, r1, r2 [,r3] to unicodes in r0. |
|
|
r0 == 0 for invalid sequence.") |
|
804 |
|
|
805 |
(defvar utf-8-ccl-regs (make-vector 8 0)) |
(defvar utf-8-ccl-regs (make-vector 8 0)) |
806 |
|
|
811 |
(aset utf-8-ccl-regs 1 (or (char-after (1+ (point))) 0)) |
(aset utf-8-ccl-regs 1 (or (char-after (1+ (point))) 0)) |
812 |
(aset utf-8-ccl-regs 2 (or (char-after (+ 2 (point))) 0)) |
(aset utf-8-ccl-regs 2 (or (char-after (+ 2 (point))) 0)) |
813 |
(aset utf-8-ccl-regs 3 (or (char-after (+ 3 (point))) 0)) |
(aset utf-8-ccl-regs 3 (or (char-after (+ 3 (point))) 0)) |
814 |
(ccl-execute 'ccl-untranslated-to-ucs utf-8-ccl-regs) |
(ccl-execute 'ccl-untranslated-to-ucs utf-8-ccl-regs)) |
|
(aref utf-8-ccl-regs 0)) |
|
815 |
|
|
816 |
(defun utf-8-help-echo (window object position) |
(defun utf-8-help-echo (window object position) |
817 |
(format "Untranslated Unicode U+%04X" |
(format "Untranslated Unicode U+%04X" |
818 |
(get-char-property position 'untranslated-utf-8 object))) |
(get-char-property position 'untranslated-utf-8 object))) |
819 |
|
|
820 |
;; We compose the untranslatable sequences into a single character. |
;; We compose the untranslatable sequences into a single character, |
821 |
|
;; and move point to the next character. |
822 |
;; This is infelicitous for editing, because there's currently no |
;; This is infelicitous for editing, because there's currently no |
823 |
;; mechanism for treating compositions as atomic, but is OK for |
;; mechanism for treating compositions as atomic, but is OK for |
824 |
;; display. They are composed to U+FFFD with help-echo which |
;; display. They are composed to U+FFFD with help-echo which |
825 |
;; indicates the unicodes they represent. This function GCs too much. |
;; indicates the unicodes they represent. This function GCs too much. |
826 |
(defsubst utf-8-compose () |
|
827 |
"Put a suitable composition on an untranslatable sequence. |
;; If utf-translate-cjk-mode is non-nil, this function is called with |
828 |
Return the sequence's length." |
;; HASH-TABLE which translates CJK characters into some of CJK |
829 |
(let* ((u (utf-8-untranslated-to-ucs)) |
;; charsets. |
830 |
(l (unless (zerop u) |
|
831 |
(if (>= u #x10000) |
(defsubst utf-8-compose (hash-table) |
832 |
4 |
"Put a suitable composition on an untranslatable sequence at point. |
833 |
3)))) |
If HASH-TABLE is non-nil, try to translate CJK characters by it at first. |
834 |
(when l |
Move point to the end of the sequence." |
835 |
(put-text-property (point) (min (point-max) (+ l (point))) |
(utf-8-untranslated-to-ucs) |
836 |
'untranslated-utf-8 u) |
(let ((l (aref utf-8-ccl-regs 1)) |
837 |
(put-text-property (point) (min (point-max) (+ l (point))) |
ch) |
838 |
'help-echo 'utf-8-help-echo) |
(if (> l 0) |
839 |
(compose-region (point) (+ l (point)) ?$,3u=(B) |
(if (and hash-table |
840 |
l))) |
(setq ch (gethash (aref utf-8-ccl-regs 0) hash-table))) |
841 |
|
(progn |
842 |
|
(insert ch) |
843 |
|
(delete-region (point) (min (point-max) (+ l (point))))) |
844 |
|
(setq ch (aref utf-8-ccl-regs 0)) |
845 |
|
(put-text-property (point) (min (point-max) (+ l (point))) |
846 |
|
'untranslated-utf-8 ch) |
847 |
|
(put-text-property (point) (min (point-max) (+ l (point))) |
848 |
|
'help-echo 'utf-8-help-echo) |
849 |
|
(if (= l 2) |
850 |
|
(put-text-property (point) (min (point-max) (+ l (point))) |
851 |
|
'display (format "\\%03o" ch)) |
852 |
|
(compose-region (point) (+ l (point)) ?$,3u=(B)) |
853 |
|
(forward-char l)) |
854 |
|
(forward-char 1)))) |
855 |
|
|
856 |
(defcustom utf-8-compose-scripts nil |
(defcustom utf-8-compose-scripts nil |
857 |
"*Non-nil means compose various scripts on decoding utf-8 text." |
"*Non-nil means compose various scripts on decoding utf-8 text." |
861 |
|
|
862 |
(defun utf-8-post-read-conversion (length) |
(defun utf-8-post-read-conversion (length) |
863 |
"Compose untranslated utf-8 sequences into single characters. |
"Compose untranslated utf-8 sequences into single characters. |
864 |
|
If `utf-translate-cjk-mode' is non-nil, tries to translate CJK characters. |
865 |
Also compose particular scripts if `utf-8-compose-scripts' is non-nil." |
Also compose particular scripts if `utf-8-compose-scripts' is non-nil." |
866 |
(save-excursion |
(save-excursion |
867 |
;; Can't do eval-when-compile to insert a multibyte constant |
(save-restriction |
868 |
;; version of the string in the loop, since it's always loaded as |
(narrow-to-region (point) (+ (point) length)) |
869 |
;; unibyte from a byte-compiled file. |
;; Can't do eval-when-compile to insert a multibyte constant |
870 |
(let ((range (string-as-multibyte "^\xe1-\xf7"))) |
;; version of the string in the loop, since it's always loaded as |
871 |
(while (and (skip-chars-forward range) |
;; unibyte from a byte-compiled file. |
872 |
(not (eobp))) |
(let ((range (string-as-multibyte "^\xc0-\xc3\xe1-\xf7")) |
873 |
(forward-char (utf-8-compose))))) |
hash-table ch) |
874 |
;; Fixme: Takahashi-san implies it may not work this easily. I |
(when utf-translate-cjk-mode |
875 |
;; asked why but didn't get a reply. -- fx |
(if (not utf-translate-cjk-lang-env) |
876 |
(when (and utf-8-compose-scripts (> length 1)) |
;; Check these characters: |
877 |
;; These currently have definitions which cover the relevant |
;; "U+2e80-U+33ff", "U+ff00-U+ffef" |
878 |
;; unicodes. We could avoid loading thai-util &c by checking |
;; We may have to translate them to CJK charsets. |
879 |
;; whether the region contains any characters with the appropriate |
(let ((range2 "$,29@(B-$,2G$,3r`(B-$,3u/(B")) |
880 |
;; categories. There aren't yet Unicode-based rules for Tibetan. |
(skip-chars-forward (concat range range2)) |
881 |
(save-excursion (setq length (diacritic-post-read-conversion length))) |
(unless (eobp) |
882 |
(save-excursion (setq length (thai-post-read-conversion length))) |
(utf-translate-cjk-load-tables) |
883 |
(save-excursion (setq length (lao-post-read-conversion length))) |
(setq range (concat range range2))) |
884 |
(save-excursion (setq length (devanagari-post-read-conversion length))) |
(setq hash-table (get 'utf-subst-table-for-decode |
885 |
(save-excursion (setq length (malayalam-post-read-conversion length))) |
'translation-hash-table))))) |
886 |
(save-excursion (setq length (tamil-post-read-conversion length)))) |
(while (and (skip-chars-forward range) |
887 |
length) |
(not (eobp))) |
888 |
|
(setq ch (following-char)) |
889 |
;; ucs-tables is preloaded |
(if (< ch 256) |
890 |
;; (defun utf-8-pre-write-conversion (beg end) |
(utf-8-compose hash-table) |
891 |
;; "Semi-dummy pre-write function effectively to autoload ucs-tables." |
(if (and hash-table |
892 |
;; ;; Ensure translation-table is loaded. |
(setq ch (gethash (encode-char ch 'ucs) hash-table))) |
893 |
;; (require 'ucs-tables) |
(progn |
894 |
;; ;; Don't do this again. |
(insert ch) |
895 |
;; (coding-system-put 'mule-utf-8 'pre-write-conversion nil) |
(delete-char 1)) |
896 |
;; nil) |
(forward-char 1))))) |
897 |
|
|
898 |
|
(when (and utf-8-compose-scripts (> length 1)) |
899 |
|
;; These currently have definitions which cover the relevant |
900 |
|
;; unicodes. We could avoid loading thai-util &c by checking |
901 |
|
;; whether the region contains any characters with the appropriate |
902 |
|
;; categories. There aren't yet Unicode-based rules for Tibetan. |
903 |
|
(diacritic-compose-region (point-max) (point-min)) |
904 |
|
(thai-compose-region (point-max) (point-min)) |
905 |
|
(lao-compose-region (point-max) (point-min)) |
906 |
|
(devanagari-compose-region (point-max) (point-min)) |
907 |
|
(malayalam-compose-region (point-max) (point-min)) |
908 |
|
(tamil-compose-region (point-max) (point-min))) |
909 |
|
(- (point-max) (point-min))))) |
910 |
|
|
911 |
|
(defun utf-8-pre-write-conversion (beg end) |
912 |
|
"Prepare for `utf-translate-cjk-mode' to encode text between BEG and END. |
913 |
|
This is used as a post-read-conversion of utf-8 coding system." |
914 |
|
(if (and utf-translate-cjk-mode |
915 |
|
(not utf-translate-cjk-lang-env) |
916 |
|
(save-excursion |
917 |
|
(goto-char beg) |
918 |
|
(re-search-forward "\\cc\\|\\cj\\|\\ch" end t))) |
919 |
|
(utf-translate-cjk-load-tables)) |
920 |
|
nil) |
921 |
|
|
922 |
(make-coding-system |
(make-coding-system |
923 |
'mule-utf-8 4 ?u |
'mule-utf-8 4 ?u |
939 |
sequence representing U+FFFD (REPLACEMENT CHARACTER)." |
sequence representing U+FFFD (REPLACEMENT CHARACTER)." |
940 |
|
|
941 |
'(ccl-decode-mule-utf-8 . ccl-encode-mule-utf-8) |
'(ccl-decode-mule-utf-8 . ccl-encode-mule-utf-8) |
942 |
'((safe-charsets |
`((safe-charsets |
943 |
ascii |
ascii |
944 |
eight-bit-control |
eight-bit-control |
945 |
eight-bit-graphic |
eight-bit-graphic |
946 |
latin-iso8859-1 |
latin-iso8859-1 |
947 |
mule-unicode-0100-24ff |
mule-unicode-0100-24ff |
948 |
mule-unicode-2500-33ff |
mule-unicode-2500-33ff |
949 |
mule-unicode-e000-ffff) |
mule-unicode-e000-ffff |
950 |
|
,@(if utf-translate-cjk-mode |
951 |
|
utf-translate-cjk-charsets)) |
952 |
(mime-charset . utf-8) |
(mime-charset . utf-8) |
953 |
(coding-category . coding-category-utf-8) |
(coding-category . coding-category-utf-8) |
954 |
(valid-codes (0 . 255)) |
(valid-codes (0 . 255)) |
955 |
;; (pre-write-conversion . utf-8-pre-write-conversion) |
(pre-write-conversion . utf-8-pre-write-conversion) |
956 |
(post-read-conversion . utf-8-post-read-conversion) |
(post-read-conversion . utf-8-post-read-conversion) |
957 |
(translation-table-for-encode . utf-translation-table-for-encode) |
(translation-table-for-encode . utf-translation-table-for-encode) |
958 |
(dependency unify-8859-on-encoding-mode |
(dependency unify-8859-on-encoding-mode |