-;;; utf-8.el --- Limited UTF-8 decoding/encoding support
+;;; utf-8.el --- UTF-8 decoding/encoding support -*- coding: iso-2022-7bit -*-
-;; Copyright (C) 2001 Electrotechnical Laboratory, JAPAN.
+;; Copyright (C) 2001, 2004 Electrotechnical Laboratory, JAPAN.
;; Licensed to the Free Software Foundation.
+;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+;; Author: TAKAHASHI Naoto <ntakahas@m17n.org>
+;; Maintainer: FSF
;; Keywords: multilingual, Unicode, UTF-8, i18n
;; This file is part of GNU Emacs.
;;; Commentary:
-;; The coding-system `mule-utf-8' supports encoding/decoding of the
-;; following character sets to and from UTF-8:
+;; The coding-system `mule-utf-8' basically supports encoding/decoding
+;; of the following character sets to and from UTF-8:
;;
;; ascii
;; eight-bit-control
;; mule-unicode-2500-33ff
;; mule-unicode-e000-ffff
;;
-;; Characters of other character sets cannot be encoded with
-;; mule-utf-8. Note that the mule-unicode charsets currently lack
-;; case and syntax information, so things like `downcase' will only
-;; work for characters from ASCII and Latin-1.
-;;
;; On decoding, Unicode characters that do not fit into the above
;; character sets are handled as `eight-bit-control' or
;; `eight-bit-graphic' characters to retain the information about the
-;; original byte sequence.
+;; original byte sequence and text properties record the corresponding
+;; unicode.
+;;
+;; Fixme: note that reading and writing invalid utf-8 may not be
+;; idempotent -- to represent the bytes to fix that needs a new charset.
+;;
+;; Characters from other character sets can be encoded with mule-utf-8
+;; by populating the translation table
+;; `utf-translation-table-for-encode'. Hash tables
+;; `utf-subst-table-for-decode' and `utf-subst-table-for-encode' are
+;; used to support encoding and decoding of about a quarter of the CJK
+;; space between U+3400 and U+DFFF.
-;; UTF-8 is defined in RFC 2279. A sketch of the encoding is:
+;; UTF-8 is defined in RFC 3629. A sketch of the encoding is:
;; scalar | utf-8
;; value | 1st byte | 2nd byte | 3rd byte
;;; Code:
+(defvar ucs-mule-to-mule-unicode (make-char-table 'translation-table nil)
+ "Char table mapping characters to latin-iso8859-1 or mule-unicode-*.
+
+If `unify-8859-on-encoding-mode' is non-nil, this table populates the
+translation-table named `utf-translation-table-for-encode'.")
+
+(define-translation-table 'utf-translation-table-for-encode)
+
+
+;; Map Cyrillic and Greek to iso-8859 charsets, which take half the
+;; space of mule-unicode. For Latin scripts this isn't very
+;; important. Hebrew and Arabic might go here too when there's proper
+;; support for them.
+
+(defvar utf-fragmentation-table (make-char-table 'translation-table nil)
+ "Char-table normally mapping non-Latin mule-unicode-* chars to iso-8859-*.
+
+If `utf-fragment-on-decoding' is non-nil, this table populates the
+translation-table named `utf-translation-table-for-decode'")
+
+(defvar utf-defragmentation-table (make-char-table 'translation-table nil)
+ "Char-table for reverse mapping of `utf-fragmentation-table'.
+
+If `utf-fragment-on-decoding' is non-nil and
+`unify-8859-on-encoding-mode' is nil, this table populates the
+translation-table named `utf-translation-table-for-encode'")
+
+(define-translation-table 'utf-translation-table-for-decode)
+
+
+(defvar ucs-mule-cjk-to-unicode (make-hash-table :test 'eq)
+ "Hash table mapping Emacs CJK character sets to Unicode code points.
+
+If `utf-translate-cjk-mode' is non-nil, this table populates the
+translation-hash-table named `utf-subst-table-for-encode'.")
+
+(define-translation-hash-table 'utf-subst-table-for-encode
+ ucs-mule-cjk-to-unicode)
+
+(defvar ucs-unicode-to-mule-cjk (make-hash-table :test 'eq)
+ "Hash table mapping Unicode code points to Emacs CJK character sets.
+
+If `utf-translate-cjk-mode' is non-nil, this table populates the
+translation-hash-table named `utf-subst-table-for-decode'.")
+
+(define-translation-hash-table 'utf-subst-table-for-decode
+ ucs-unicode-to-mule-cjk)
+
+(mapc
+ (lambda (pair)
+ (aset utf-fragmentation-table (car pair) (cdr pair))
+ (aset utf-defragmentation-table (cdr pair) (car pair)))
+ '((?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\e$,1'N\e(B . ?\e,F~\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)
+ (?\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)))
+
+
+(defcustom utf-fragment-on-decoding nil
+ "Whether or not to decode some chars in UTF-8/16 text into iso8859 charsets.
+Setting this means that the relevant Cyrillic and Greek characters are
+decoded into the iso8859 charsets rather than into
+mule-unicode-0100-24ff. The iso8859 charsets take half as much space
+in the buffer, but using them may affect how the buffer can be re-encoded
+and may require a different input method to search for them, for instance.
+See `unify-8859-on-decoding-mode' and `unify-8859-on-encoding-mode'
+for mechanisms to make this largely transparent.
+
+Setting this variable outside customize has no effect."
+ :set (lambda (s v)
+ (if v
+ (progn
+ (define-translation-table 'utf-translation-table-for-decode
+ utf-fragmentation-table)
+ ;; Even if unify-8859-on-encoding-mode is off, make
+ ;; mule-utf-* encode characters in
+ ;; utf-fragmentation-table.
+ (unless (eq (get 'utf-translation-table-for-encode
+ 'translation-table)
+ ucs-mule-to-mule-unicode)
+ (define-translation-table 'utf-translation-table-for-encode
+ utf-defragmentation-table)))
+ (define-translation-table 'utf-translation-table-for-decode)
+ ;; When unify-8859-on-encoding-mode is off, be sure to make
+ ;; mule-utf-* disabled for characters in
+ ;; utf-fragmentation-table.
+ (unless (eq (get 'utf-translation-table-for-encode
+ 'translation-table)
+ ucs-mule-to-mule-unicode)
+ (define-translation-table 'utf-translation-table-for-encode)))
+ (set-default s v))
+ :version "22.1"
+ :type 'boolean
+ :group 'mule)
+
+
+(defconst utf-translate-cjk-charsets '(chinese-gb2312
+ chinese-big5-1 chinese-big5-2
+ japanese-jisx0208 japanese-jisx0212
+ katakana-jisx0201
+ korean-ksc5601)
+ "List of charsets supported by `utf-translate-cjk-mode'.")
+
+(defvar utf-translate-cjk-lang-env nil
+ "Language environment in which tables for `utf-translate-cjk-mode' is loaded.
+The value nil means that the tables are not yet loaded.")
+
+(defvar utf-translate-cjk-unicode-range)
+
+;; String generated from utf-translate-cjk-unicode-range. It is
+;; suitable for an argument to skip-chars-forward.
+(defvar utf-translate-cjk-unicode-range-string nil)
+
+(defun utf-translate-cjk-set-unicode-range (range)
+ (setq utf-translate-cjk-unicode-range range)
+ (setq utf-translate-cjk-unicode-range-string
+ (let ((decode-char-no-trans
+ #'(lambda (x)
+ (cond ((< x #x100) (make-char 'latin-iso8859-1 x))
+ ((< x #x2500)
+ (setq x (- x #x100))
+ (make-char 'mule-unicode-0100-24ff
+ (+ (/ x 96) 32) (+ (% x 96) 32)))
+ ((< x #x3400)
+ (setq x (- x #x2500))
+ (make-char 'mule-unicode-2500-33ff
+ (+ (/ x 96) 32) (+ (% x 96) 32)))
+ (t
+ (setq x (- x #xe000))
+ (make-char 'mule-unicode-e000-ffff
+ (+ (/ x 96) 32) (+ (% x 96) 32))))))
+ ranges from to)
+ (dolist (elt range)
+ (setq from (max #xA0 (car elt)) to (min #xffff (cdr elt)))
+ (if (and (>= to #x3400) (< to #xE000))
+ (setq to #x33FF))
+ (cond ((< from #x100)
+ (if (>= to #xE000)
+ (setq ranges (cons (cons #xE000 to) ranges)
+ to #x33FF))
+ (if (>= to #x2500)
+ (setq ranges (cons (cons #x2500 to) ranges)
+ to #x24FF))
+ (if (>= to #x100)
+ (setq ranges (cons (cons #x100 to) ranges)
+ to #xFF)))
+ ((< from #x2500)
+ (if (>= to #xE000)
+ (setq ranges (cons (cons #xE000 to) ranges)
+ to #x33FF))
+ (if (>= to #x2500)
+ (setq ranges (cons (cons #x2500 to) ranges)
+ to #x24FF)))
+ ((< from #x3400)
+ (if (>= to #xE000)
+ (setq ranges (cons (cons #xE000 to) ranges)
+ to #x33FF))))
+ (if (<= from to)
+ (setq ranges (cons (cons from to) ranges))))
+ (mapconcat #'(lambda (x)
+ (format "%c-%c"
+ (funcall decode-char-no-trans (car x))
+ (funcall decode-char-no-trans (cdr x))))
+ ranges "")))
+ ;; These forces loading and settting tables for
+ ;; utf-translate-cjk-mode.
+ (setq utf-translate-cjk-lang-env nil
+ ucs-mule-cjk-to-unicode (make-hash-table :test 'eq)
+ ucs-unicode-to-mule-cjk (make-hash-table :test 'eq)))
+
+(defcustom utf-translate-cjk-unicode-range '((#x2e80 . #xd7a3)
+ (#xff00 . #xffef))
+ "List of Unicode code ranges supported by `utf-translate-cjk-mode'.
+Setting this variable directly does not take effect;
+use either \\[customize] or the function
+`utf-translate-cjk-set-unicode-range'."
+ :version "22.1"
+ :type '(repeat (cons integer integer))
+ :set (lambda (symbol value)
+ (utf-translate-cjk-set-unicode-range value))
+ :group 'mule)
+
+;; Return non-nil if CODE-POINT is in `utf-translate-cjk-unicode-range'.
+(defsubst utf-translate-cjk-substitutable-p (code-point)
+ (let ((tail utf-translate-cjk-unicode-range)
+ elt)
+ (while tail
+ (setq elt (car tail) tail (cdr tail))
+ (if (and (>= code-point (car elt)) (<= code-point (cdr elt)))
+ (setq tail nil)
+ (setq elt nil)))
+ elt))
+
+(defun utf-translate-cjk-load-tables ()
+ "Load tables for `utf-translate-cjk-mode'."
+ ;; Fixme: Allow the use of the CJK charsets to be
+ ;; customized by reordering and possible omission.
+ (let ((redefined (< (hash-table-size ucs-mule-cjk-to-unicode) 43000)))
+ (if redefined
+ ;; 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).
+ ;; Here we bind coding-system-for-read to nil so that coding tags
+ ;; in the files are respected even if the files are not yet
+ ;; byte-compiled
+ (let ((coding-system-for-read nil))
+ (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
+
+ (when redefined
+ (define-translation-hash-table 'utf-subst-table-for-decode
+ ucs-unicode-to-mule-cjk)
+ (define-translation-hash-table 'utf-subst-table-for-encode
+ ucs-mule-cjk-to-unicode)
+ (set-char-table-extra-slot (get 'utf-translation-table-for-encode
+ 'translation-table)
+ 1 ucs-mule-cjk-to-unicode))
+
+ (setq utf-translate-cjk-lang-env current-language-environment)))
+
+(defun utf-lookup-subst-table-for-decode (code-point)
+ (if (and utf-translate-cjk-mode
+ (not utf-translate-cjk-lang-env)
+ (utf-translate-cjk-substitutable-p code-point))
+ (utf-translate-cjk-load-tables))
+ (gethash code-point
+ (get 'utf-subst-table-for-decode 'translation-hash-table)))
+
+
+(defun utf-lookup-subst-table-for-encode (char)
+ (if (and utf-translate-cjk-mode
+ (not utf-translate-cjk-lang-env)
+ (memq (char-charset char) utf-translate-cjk-charsets))
+ (utf-translate-cjk-load-tables))
+ (gethash char
+ (get 'utf-subst-table-for-encode 'translation-hash-table)))
+
+(define-minor-mode utf-translate-cjk-mode
+ "Toggle whether UTF based coding systems de/encode CJK characters.
+If ARG is an integer, enable if ARG is positive and disable if
+zero or negative. This is a minor mode.
+Enabling this allows the coding systems mule-utf-8,
+mule-utf-16le and mule-utf-16be to encode characters in the charsets
+`korean-ksc5601', `chinese-gb2312', `chinese-big5-1',
+`chinese-big5-2', `japanese-jisx0208' and `japanese-jisx0212', and to
+decode the corresponding unicodes into such characters.
+
+Where the charsets overlap, the one preferred for decoding is chosen
+according to the language environment in effect when this option is
+turned on: ksc5601 for Korean, gb2312 for Chinese-GB, big5 for
+Chinese-Big5 and jisx for other environments.
+
+This mode is on by default. If you are not interested in CJK
+characters and want to avoid some overhead on encoding/decoding
+by the above coding systems, you can customize the user option
+`utf-translate-cjk-mode' to nil."
+ :init-value t
+ :version "22.1"
+ :type 'boolean
+ :group 'mule
+ :global t
+ (if utf-translate-cjk-mode
+ (progn
+ (define-translation-hash-table 'utf-subst-table-for-decode
+ ucs-unicode-to-mule-cjk)
+ (define-translation-hash-table 'utf-subst-table-for-encode
+ ucs-mule-cjk-to-unicode)
+ (set-char-table-extra-slot (get 'utf-translation-table-for-encode
+ 'translation-table)
+ 1 ucs-mule-cjk-to-unicode))
+ (define-translation-hash-table 'utf-subst-table-for-decode
+ (make-hash-table :test 'eq))
+ (define-translation-hash-table 'utf-subst-table-for-encode
+ (make-hash-table :test 'eq))
+ (set-char-table-extra-slot (get 'utf-translation-table-for-encode
+ 'translation-table)
+ 1 nil))
+
+ ;; Update safe-chars of mule-utf-* coding systems.
+ (dolist (elt (coding-system-list t))
+ (if (string-match "^mule-utf" (symbol-name elt))
+ (let ((safe-charsets (coding-system-get elt 'safe-charsets))
+ (safe-chars (coding-system-get elt 'safe-chars))
+ (need-update nil))
+ (dolist (charset utf-translate-cjk-charsets)
+ (unless (eq utf-translate-cjk-mode (memq charset safe-charsets))
+ (setq safe-charsets
+ (if utf-translate-cjk-mode
+ (cons charset safe-charsets)
+ (delq charset safe-charsets))
+ need-update t)
+ (aset safe-chars (make-char charset) utf-translate-cjk-mode)))
+ (when need-update
+ (coding-system-put elt 'safe-charsets safe-charsets)
+ (define-coding-system-internal elt))))))
+
+(define-ccl-program ccl-mule-utf-untrans
+ ;; R0 is an untranslatable Unicode code-point (U+3500..U+DFFF or
+ ;; U+10000..U+10FFFF) or an invaid byte (#x00..#xFF). Write
+ ;; eight-bit-control/graphic sequence (2 to 4 chars) representing
+ ;; UTF-8 sequence of r0. Registers r4, r5, r6 are modified.
+ ;;
+ ;; This is a subrountine because we assume that this is called very
+ ;; rarely (so we don't have to worry about the overhead of the
+ ;; call).
+ `(0
+ ((r5 = ,(charset-id 'eight-bit-control))
+ (r6 = ,(charset-id 'eight-bit-graphic))
+ (if (r0 < #x100)
+ ((r4 = ((r0 >> 6) | #xC0))
+ (write-multibyte-character r6 r4))
+ ((if (r0 < #x10000)
+ ((r4 = ((r0 >> 12) | #xE0))
+ (write-multibyte-character r6 r4))
+ ((r4 = ((r0 >> 18) | #xF0))
+ (write-multibyte-character r6 r4)
+ (r4 = (((r0 >> 12) & #x3F) | #x80))
+ (if (r4 < #xA0)
+ (write-multibyte-character r5 r4)
+ (write-multibyte-character r6 r4))))
+ (r4 = (((r0 >> 6) & #x3F) | #x80))
+ (if (r4 < #xA0)
+ (write-multibyte-character r5 r4)
+ (write-multibyte-character r6 r4))))
+ (r4 = ((r0 & #x3F) | #x80))
+ (if (r4 < #xA0)
+ (write-multibyte-character r5 r4)
+ (write-multibyte-character r6 r4)))))
+
(define-ccl-program ccl-decode-mule-utf-8
;;
;; charset | bytes in utf-8 | bytes in emacs
;; ascii | 1 | 1
;; -----------------------+----------------+---------------
;; eight-bit-control | 2 | 2
+ ;; eight-bit-graphic | 2 | 1
;; latin-iso8859-1 | 2 | 2
;; -----------------------+----------------+---------------
;; mule-unicode-0100-24ff | 2 | 4
;; (>= 8000) | |
;; mule-unicode-2500-33ff | 3 | 4
;; mule-unicode-e000-ffff | 3 | 4
+ ;; -----------------------+----------------+---------------
+ ;; invalid byte | 1 | 2
;;
;; Thus magnification factor is two.
;;
`(2
- ((loop
- (read r0)
-
- ;; 1byte encoding, i.e., ascii
+ ((r6 = ,(charset-id 'latin-iso8859-1))
+ (read r0)
+ (loop
(if (r0 < #x80)
- (write r0)
-
- ;; 2byte encoding
- (if (r0 < #xe0)
- ((read r1)
- (r0 &= #x1f)
- (r0 <<= 6)
- (r1 &= #x3f)
- (r1 += r0)
- ;; now r1 holds scalar value
-
- ;; eight-bit-control
- (if (r1 < 160)
- ((r0 = ,(charset-id 'eight-bit-control))
- (write-multibyte-character r0 r1))
-
- ;; latin-iso8859-1
- (if (r1 < 256)
- ((r0 = ,(charset-id 'latin-iso8859-1))
- (r1 -= 128)
- (write-multibyte-character r0 r1))
-
- ;; mule-unicode-0100-24ff (< 0800)
- ((r0 = ,(charset-id 'mule-unicode-0100-24ff))
- (r1 -= #x0100)
- (r2 = (((r1 / 96) + 32) << 7))
- (r1 %= 96)
- (r1 += (r2 + 32))
- (write-multibyte-character r0 r1)))))
+ ;; 1-byte encoding, i.e., ascii
+ (write-read-repeat r0))
+ (if (r0 < #xc2)
+ ;; continuation byte (invalid here) or 1st byte of overlong
+ ;; 2-byte sequence.
+ ((call ccl-mule-utf-untrans)
+ (r6 = ,(charset-id 'latin-iso8859-1))
+ (read r0)
+ (repeat)))
+ ;; Read the 2nd byte.
+ (read r1)
+ (if ((r1 & #b11000000) != #b10000000) ; Invalid 2nd byte
+ ((call ccl-mule-utf-untrans)
+ (r6 = ,(charset-id 'latin-iso8859-1))
+ ;; Handle it in the next loop.
+ (r0 = r1)
+ (repeat)))
+
+ (if (r0 < #xe0)
+ ;; 2-byte encoding 00000yyyyyxxxxxx = 110yyyyy 10xxxxxx
+ ((r1 &= #x3F)
+ (r1 |= ((r0 & #x1F) << 6))
+ ;; Now r1 holds scalar value. We don't have to check
+ ;; `overlong sequence' because r0 >= 0xC2.
+
+ (if (r1 >= 256)
+ ;; mule-unicode-0100-24ff (< 0800)
+ ((r0 = r1)
+ (lookup-integer utf-subst-table-for-decode r0 r1)
+ (if (r7 == 0)
+ ((r0 = ,(charset-id 'mule-unicode-0100-24ff))
+ (r1 -= #x0100)
+ (r2 = (((r1 / 96) + 32) << 7))
+ (r1 %= 96)
+ (r1 += (r2 + 32))
+ (translate-character
+ utf-translation-table-for-decode r0 r1)))
+ (write-multibyte-character r0 r1)
+ (read r0)
+ (repeat))
+ (if (r1 >= 160)
+ ;; latin-iso8859-1
+ ((r0 = r1)
+ (lookup-integer utf-subst-table-for-decode r0 r1)
+ (if (r7 == 0)
+ ((r1 -= 128)
+ (write-multibyte-character r6 r1))
+ ((write-multibyte-character r0 r1)))
+ (read r0)
+ (repeat))
+ ;; eight-bit-control
+ ((r0 = ,(charset-id 'eight-bit-control))
+ (write-multibyte-character r0 r1)
+ (read r0)
+ (repeat))))))
+
+ ;; Read the 3rd bytes.
+ (read r2)
+ (if ((r2 & #b11000000) != #b10000000) ; Invalid 3rd byte
+ ((call ccl-mule-utf-untrans)
+ (r0 = r1)
+ (call ccl-mule-utf-untrans)
+ (r6 = ,(charset-id 'latin-iso8859-1))
+ ;; Handle it in the next loop.
+ (r0 = r2)
+ (repeat)))
+
+ (if (r0 < #xF0)
;; 3byte encoding
- (if (r0 < #xf0)
- ((read r1 r2)
- (r3 = ((r0 & #x0f) << 12))
- (r3 += ((r1 & #x3f) << 6))
- (r3 += (r2 & #x3f))
- ;; now r3 holds scalar value
+ ;; zzzzyyyyyyxxxxxx = 1110zzzz 10yyyyyy 10xxxxxx
+ ((r3 = ((r0 & #xF) << 12))
+ (r3 |= ((r1 & #x3F) << 6))
+ (r3 |= (r2 & #x3F))
+ (if (r3 < #x800) ; `overlong sequence'
+ ((call ccl-mule-utf-untrans)
+ (r0 = r1)
+ (call ccl-mule-utf-untrans)
+ (r0 = r2)
+ (call ccl-mule-utf-untrans)
+ (r6 = ,(charset-id 'latin-iso8859-1))
+ (read r0)
+ (repeat)))
+
+ (if (r3 < #x2500)
;; mule-unicode-0100-24ff (>= 0800)
- (if (r3 < #x2500)
- ((r0 = ,(charset-id 'mule-unicode-0100-24ff))
- (r3 -= #x0100)
- (r3 //= 96)
- (r1 = (r7 + 32))
- (r1 += ((r3 + 32) << 7))
- (write-multibyte-character r0 r1))
-
- ;; mule-unicode-2500-33ff
- (if (r3 < #x3400)
- ((r0 = ,(charset-id 'mule-unicode-2500-33ff))
- (r3 -= #x2500)
- (r3 //= 96)
- (r1 = (r7 + 32))
- (r1 += ((r3 + 32) << 7))
- (write-multibyte-character r0 r1))
-
- ;; U+3400 .. U+DFFF
- ;; keep those bytes as eight-bit-{control|graphic}
- (if (r3 < #xe000)
- (;; #xe0 < r0 < #xf0, so r0 is eight-bit-graphic
- (r3 = ,(charset-id 'eight-bit-graphic))
- (write-multibyte-character r3 r0)
- (if (r1 < #xa0)
- (r3 = ,(charset-id 'eight-bit-control)))
- (write-multibyte-character r3 r1)
- (if (r2 < #xa0)
- (r3 = ,(charset-id 'eight-bit-control))
- (r3 = ,(charset-id 'eight-bit-graphic)))
- (write-multibyte-character r3 r2))
-
- ;; mule-unicode-e000-ffff
- ((r0 = ,(charset-id 'mule-unicode-e000-ffff))
- (r3 -= #xe000)
- (r3 //= 96)
- (r1 = (r7 + 32))
- (r1 += ((r3 + 32) << 7))
- (write-multibyte-character r0 r1))))))
-
- ;; 4byte encoding
- ;; keep those bytes as eight-bit-{control|graphic}
- ((read r1 r2 r3)
- ;; r0 > #xf0, thus eight-bit-graphic
- (r4 = ,(charset-id 'eight-bit-graphic))
- (write-multibyte-character r4 r0)
- (if (r1 < #xa0)
- (r4 = ,(charset-id 'eight-bit-control)))
- (write-multibyte-character r4 r1)
- (if (r2 < #xa0)
- (r4 = ,(charset-id 'eight-bit-control))
- (r4 = ,(charset-id 'eight-bit-graphic)))
- (write-multibyte-character r4 r2)
- (if (r3 < #xa0)
- (r4 = ,(charset-id 'eight-bit-control))
- (r4 = ,(charset-id 'eight-bit-graphic)))
- (write-multibyte-character r4 r3)))))
-
- (repeat))))
+ ((r0 = r3)
+ (lookup-integer utf-subst-table-for-decode r0 r1)
+ (if (r7 == 0)
+ ((r0 = ,(charset-id 'mule-unicode-0100-24ff))
+ (r3 -= #x0100)
+ (r3 //= 96)
+ (r1 = (r7 + 32))
+ (r1 += ((r3 + 32) << 7))
+ (translate-character
+ utf-translation-table-for-decode r0 r1)))
+ (write-multibyte-character r0 r1)
+ (read r0)
+ (repeat)))
+
+ (if (r3 < #x3400)
+ ;; mule-unicode-2500-33ff
+ ((r0 = r3) ; don't zap r3
+ (lookup-integer utf-subst-table-for-decode r0 r1)
+ (if (r7 == 0)
+ ((r0 = ,(charset-id 'mule-unicode-2500-33ff))
+ (r3 -= #x2500)
+ (r3 //= 96)
+ (r1 = (r7 + 32))
+ (r1 += ((r3 + 32) << 7))))
+ (write-multibyte-character r0 r1)
+ (read r0)
+ (repeat)))
+
+ (if (r3 < #xE000)
+ ;; Try to convert to CJK chars, else
+ ;; keep them as eight-bit-{control|graphic}.
+ ((r0 = r3)
+ (lookup-integer utf-subst-table-for-decode r3 r1)
+ (if r7
+ ;; got a translation
+ ((write-multibyte-character r3 r1)
+ (read r0)
+ (repeat))
+ ((call ccl-mule-utf-untrans)
+ (r6 = ,(charset-id 'latin-iso8859-1))
+ (read r0)
+ (repeat)))))
+
+ ;; mule-unicode-e000-ffff
+ ;; Fixme: fffe and ffff are invalid.
+ (r0 = r3) ; don't zap r3
+ (lookup-integer utf-subst-table-for-decode r0 r1)
+ (if (r7 == 0)
+ ((r0 = ,(charset-id 'mule-unicode-e000-ffff))
+ (r3 -= #xe000)
+ (r3 //= 96)
+ (r1 = (r7 + 32))
+ (r1 += ((r3 + 32) << 7))))
+ (write-multibyte-character r0 r1)
+ (read r0)
+ (repeat)))
+
+ ;; Read the 4th bytes.
+ (read r3)
+ (if ((r3 & #b11000000) != #b10000000) ; Invalid 4th byte
+ ((call ccl-mule-utf-untrans)
+ (r0 = r1)
+ (call ccl-mule-utf-untrans)
+ (r0 = r2)
+ (call ccl-mule-utf-untrans)
+ (r6 = ,(charset-id 'latin-iso8859-1))
+ ;; Handle it in the next loop.
+ (r0 = r3)
+ (repeat)))
+
+ (if (r0 < #xF8)
+ ;; 4-byte encoding:
+ ;; wwwzzzzzzyyyyyyxxxxxx = 11110www 10zzzzzz 10yyyyyy 10xxxxxx
+ ;; keep those bytes as eight-bit-{control|graphic}
+ ;; Fixme: allow lookup in utf-subst-table-for-decode.
+ ((r4 = ((r0 & #x7) << 18))
+ (r4 |= ((r1 & #x3F) << 12))
+ (r4 |= ((r2 & #x3F) << 6))
+ (r4 |= (r3 & #x3F))
+
+ (if (r4 < #x10000) ; `overlong sequence'
+ ((call ccl-mule-utf-untrans)
+ (r0 = r1)
+ (call ccl-mule-utf-untrans)
+ (r0 = r2)
+ (call ccl-mule-utf-untrans)
+ (r0 = r3)
+ (call ccl-mule-utf-untrans))
+ ((r0 = r4)
+ (call ccl-mule-utf-untrans))))
+
+ ;; Unsupported sequence.
+ ((call ccl-mule-utf-untrans)
+ (r0 = r1)
+ (call ccl-mule-utf-untrans)
+ (r0 = r2)
+ (call ccl-mule-utf-untrans)
+ (r0 = r3)
+ (call ccl-mule-utf-untrans)))
+ (r6 = ,(charset-id 'latin-iso8859-1))
+ (read r0)
+ (repeat)))
+
+
+ ;; At EOF...
+ (if (r0 >= 0)
+ ;; r0 >= #x80
+ ((call ccl-mule-utf-untrans)
+ (if (r1 >= 0)
+ ((r0 = r1)
+ (call ccl-mule-utf-untrans)
+ (if (r2 >= 0)
+ ((r0 = r2)
+ (call ccl-mule-utf-untrans)
+ (if (r3 >= 0)
+ ((r0 = r3)
+ (call ccl-mule-utf-untrans))))))))))
"CCL program to decode UTF-8.
-Decoding is done into the charsets ascii, eight-bit-control,
-latin-iso8859-1 and mule-unicode-* only.")
+Basic decoding is done into the charsets ascii, latin-iso8859-1 and
+mule-unicode-*, but see also `utf-fragmentation-table' and
+`ucs-mule-cjk-to-unicode'.
+Encodings of un-representable Unicode characters are decoded asis into
+eight-bit-control and eight-bit-graphic characters.")
+
+(define-ccl-program ccl-mule-utf-8-encode-untrans
+ ;; UTF-8 decoder generates an UTF-8 sequence represented by a
+ ;; sequence eight-bit-control/graphic chars for an untranslatable
+ ;; character and an invalid byte.
+ ;;
+ ;; This CCL parses that sequence (the first byte is already in r1),
+ ;; writes out the original bytes of that sequence, and sets r5 to
+ ;; -1.
+ ;;
+ ;; If the eight-bit-control/graphic sequence is shorter than what r1
+ ;; suggests, it sets r5 and r6 to the last character read that
+ ;; should be handled by the next loop of a caller.
+ ;;
+ ;; Note: For UTF-8 validation, we only check if a character is
+ ;; eight-bit-control/graphic or not. It may result in incorrect
+ ;; handling of random binary data, but such a data can't be encoded
+ ;; by UTF-8 anyway. At least, UTF-8 decoders doesn't generate such
+ ;; a sequence even if a source contains invalid byte-sequence.
+ `(0
+ (;; Read the 2nd byte.
+ (read-multibyte-character r5 r6)
+ (r0 = (r5 != ,(charset-id 'eight-bit-control)))
+ (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
+ ((write r1) ; invalid UTF-8
+ (r1 = -1)
+ (end)))
+
+ (if (r1 <= #xC3)
+ ;; 2-byte sequence for an originally invalid byte.
+ ((r6 &= #x3F)
+ (r6 |= ((r1 & #x1F) << 6))
+ (write r6)
+ (r5 = -1)
+ (end)))
+
+ (write r1 r6)
+ (r2 = r1)
+ (r1 = -1)
+ ;; Read the 3rd byte.
+ (read-multibyte-character r5 r6)
+ (r0 = (r5 != ,(charset-id 'eight-bit-control)))
+ (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
+ (end)) ; invalid UTF-8
+ (write r6)
+ (if (r2 < #xF0)
+ ;; 3-byte sequence for an untranslated character.
+ ((r5 = -1)
+ (end)))
+ ;; Read the 4th byte.
+ (read-multibyte-character r5 r6)
+ (r0 = (r5 != ,(charset-id 'eight-bit-control)))
+ (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0)
+ (end)) ; invalid UTF-8
+ ;; 4-byte sequence for an untranslated character.
+ (write r6)
+ (r5 = -1)
+ (end))
+
+ ;; At EOF...
+ ((r5 = -1)
+ (if (r1 >= 0)
+ (write r1)))))
(define-ccl-program ccl-encode-mule-utf-8
`(1
- (loop
- (read-multibyte-character r0 r1)
-
- (if (r0 == ,(charset-id 'ascii))
- (write r1)
-
- (if (r0 == ,(charset-id 'latin-iso8859-1))
- ;; r1 scalar utf-8
- ;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx
- ;; 20 0000 0000 1010 0000 1100 0010 1010 0000
- ;; 7f 0000 0000 1111 1111 1100 0011 1011 1111
- ((r0 = (((r1 & #x40) >> 6) | #xc2))
- (r1 &= #x3f)
- (r1 |= #x80)
- (write r0 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)
+ ((r5 = -1)
+ (loop
+ (if (r5 < 0)
+ (read-multibyte-character r0 r1)
+ ;; Pre-read character is in r5 (charset-ID) and r6 (code-point).
+ ((r0 = r5)
+ (r1 = r6)
+ (r5 = -1)))
+ (translate-character utf-translation-table-for-encode r0 r1)
+
+ (if (r0 == ,(charset-id 'ascii))
+ (write-repeat r1))
+
+ (if (r0 == ,(charset-id 'latin-iso8859-1))
+ ;; r1 scalar utf-8
+ ;; 0000 0yyy yyxx xxxx 110y yyyy 10xx xxxx
+ ;; 20 0000 0000 1010 0000 1100 0010 1010 0000
+ ;; 7f 0000 0000 1111 1111 1100 0011 1011 1111
+ ((write ((r1 >> 6) | #xc2))
+ (r1 &= #x3f)
+ (r1 |= #x80)
+ (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
+ ((write ((r1 >> 6) | #xC0))
+ (r1 &= #x3F)
(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 == -160 + #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 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)
-
- ;; Unsupported character.
- ;; Output U+FFFD, which is `ef bf bd' in UTF-8.
- ((write #xef)
- (write #xbf)
- (write #xbd)))))))))
- (repeat)))
-
- "CCL program to encode into UTF-8.
-Only characters from the charsets ascii, eight-bit-control,
-latin-iso8859-1 and mule-unicode-* are recognized. Others are encoded
-as U+FFFD.")
+ (write-repeat r1))
+ ;; 3byte encoding
+ ((write ((r1 >> 12) | #xE0))
+ (write (((r1 & #x0FC0) >> 6) | #x80))
+ (r1 &= #x3F)
+ (r1 |= #x80)
+ (write-repeat r1)))))
+
+ (if (r0 == ,(charset-id 'mule-unicode-2500-33ff))
+ ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
+ (r1 &= #x7f)
+ (r1 += (r0 + 9440)) ; 9440 == -32 + #x2500
+ ;; now r1 holds scalar value
+ (write ((r1 >> 12) | #xE0))
+ (write (((r1 & #x0FC0) >> 6) | #x80))
+ (r1 &= #x3F)
+ (r1 |= #x80)
+ (write-repeat r1)))
+
+ (if (r0 == ,(charset-id 'mule-unicode-e000-ffff))
+ ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
+ (r1 &= #x7f)
+ (r1 += (r0 + 57312)) ; 57312 == -32 + #xe000
+ ;; now r1 holds scalar value
+ (write ((r1 >> 12) | #xE0))
+ (write (((r1 & #x0FC0) >> 6) | #x80))
+ (r1 &= #x3F)
+ (r1 |= #x80)
+ (write-repeat r1)))
+
+ (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-repeat 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
+ ((r0 = (r1 >= #xC0))
+ (r0 &= (r1 <= #xC3))
+ (r4 = (r1 >= #xE1))
+ (r4 &= (r1 <= #xF7))
+ (r0 |= r4)
+ (if r0
+ ((call ccl-mule-utf-8-encode-untrans)
+ (repeat))
+ (write-repeat r1))))
+
+ (lookup-character utf-subst-table-for-encode r0 r1)
+ (if r7 ; lookup succeeded
+ (if (r0 < #x800)
+ ;; 2byte encoding
+ ((write ((r0 >> 6) | #xC0))
+ (r0 = ((r0 & #x3F) | #x80))
+ (write-repeat r0))
+ ;; 3byte encoding
+ ((write ((r0 >> 12) | #xE0))
+ (write (((r0 & #x0FC0) >> 6) | #x80))
+ (r0 = ((r0 & #x3F) | #x80))
+ (write-repeat r0))))
+
+ ;; Unsupported character.
+ ;; Output U+FFFD, which is `ef bf bd' in UTF-8.
+ (write #xef)
+ (write #xbf)
+ (write-repeat #xbd))))
+ "CCL program to encode into UTF-8.")
+
+
+(define-ccl-program ccl-untranslated-to-ucs
+ `(0
+ (if (r1 == 0)
+ nil
+ (if (r0 <= #xC3) ; 2-byte encoding
+ ((r0 = ((r0 & #x3) << 6))
+ (r0 |= (r1 & #x3F))
+ (r1 = 2))
+ (if (r2 == 0)
+ (r1 = 0)
+ (if (r0 < #xF0) ; 3-byte encoding, as above
+ ((r0 = ((r0 & #xF) << 12))
+ (r0 |= ((r1 & #x3F) << 6))
+ (r0 |= (r2 & #x3F))
+ (r1 = 3))
+ (if (r3 == 0)
+ (r1 = 0)
+ ((r0 = ((r0 & #x7) << 18))
+ (r0 |= ((r1 & #x3F) << 12))
+ (r0 |= ((r2 & #x3F) << 6))
+ (r0 |= (r3 & #x3F))
+ (r1 = 4))))))))
+ "Decode 2-, 3-, or 4-byte sequences in r0, r1, r2 [,r3] to unicodes in r0.
+Set r1 to the byte length. r0 == 0 for invalid sequence.")
+
+(defvar utf-8-ccl-regs (make-vector 8 0))
+
+(defsubst utf-8-untranslated-to-ucs ()
+ "Return the UCS code for an untranslated sequence of raw bytes t point.
+Only for 3- or 4-byte sequences."
+ (aset utf-8-ccl-regs 0 (or (char-after) 0))
+ (aset utf-8-ccl-regs 1 (or (char-after (1+ (point))) 0))
+ (aset utf-8-ccl-regs 2 (or (char-after (+ 2 (point))) 0))
+ (aset utf-8-ccl-regs 3 (or (char-after (+ 3 (point))) 0))
+ (ccl-execute 'ccl-untranslated-to-ucs utf-8-ccl-regs))
+
+(defun utf-8-help-echo (window object position)
+ (format "Untranslated Unicode U+%04X"
+ (get-char-property position 'untranslated-utf-8 object)))
+
+;; We compose the untranslatable sequences into a single character,
+;; and move point to the next character.
+;; This is infelicitous for editing, because there's currently no
+;; mechanism for treating compositions as atomic, but is OK for
+;; display. They are composed to U+FFFD with help-echo which
+;; indicates the unicodes they represent. This function GCs too much.
+
+;; If utf-translate-cjk-mode is non-nil, this function is called with
+;; HASH-TABLE which translates CJK characters into some of CJK
+;; charsets.
+
+(defsubst utf-8-compose (hash-table)
+ "Put a suitable composition on an untranslatable sequence at point.
+If HASH-TABLE is non-nil, try to translate CJK characters by it at first.
+Move point to the end of the sequence."
+ (utf-8-untranslated-to-ucs)
+ (let ((l (aref utf-8-ccl-regs 1))
+ ch)
+ (if (> l 0)
+ (if (and hash-table
+ (setq ch (gethash (aref utf-8-ccl-regs 0) hash-table)))
+ (progn
+ (insert ch)
+ (delete-region (point) (min (point-max) (+ l (point)))))
+ (setq ch (aref utf-8-ccl-regs 0))
+ (put-text-property (point) (min (point-max) (+ l (point)))
+ 'untranslated-utf-8 ch)
+ (put-text-property (point) (min (point-max) (+ l (point)))
+ 'help-echo 'utf-8-help-echo)
+ (if (= l 2)
+ (put-text-property (point) (min (point-max) (+ l (point)))
+ 'display (format "\\%03o" ch))
+ (compose-region (point) (+ l (point)) ?\e$,3u=\e(B))
+ (forward-char l))
+ (forward-char 1))))
+
+(defcustom utf-8-compose-scripts nil
+ "*Non-nil means compose various scripts on decoding utf-8 text."
+ :group 'mule
+ :version "22.1"
+ :type 'boolean)
+
+(defun utf-8-post-read-conversion (length)
+ "Compose untranslated utf-8 sequences into single characters.
+If `utf-translate-cjk-mode' is non-nil, tries to translate CJK characters.
+Also compose particular scripts if `utf-8-compose-scripts' is non-nil."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region (point) (+ (point) length))
+ ;; Can't do eval-when-compile to insert a multibyte constant
+ ;; version of the string in the loop, since it's always loaded as
+ ;; unibyte from a byte-compiled file.
+ (let ((range (string-as-multibyte "^\xc0-\xc3\xe1-\xf7"))
+ (buffer-multibyte enable-multibyte-characters)
+ hash-table ch)
+ (set-buffer-multibyte t)
+ (when utf-translate-cjk-mode
+ (unless utf-translate-cjk-lang-env
+ ;; Check these characters in utf-translate-cjk-range.
+ ;; We may have to translate them to CJK charsets.
+ (skip-chars-forward
+ (concat range utf-translate-cjk-unicode-range-string))
+ (unless (eobp)
+ (utf-translate-cjk-load-tables)
+ (setq range
+ (concat range utf-translate-cjk-unicode-range-string)))
+ (setq hash-table (get 'utf-subst-table-for-decode
+ 'translation-hash-table))))
+ (while (and (skip-chars-forward range)
+ (not (eobp)))
+ (setq ch (following-char))
+ (if (< ch 256)
+ (utf-8-compose hash-table)
+ (if (and hash-table
+ (setq ch (gethash (encode-char ch 'ucs) hash-table)))
+ (progn
+ (insert ch)
+ (delete-char 1))
+ (forward-char 1))))
+ (or buffer-multibyte
+ (set-buffer-multibyte nil)))
+
+ (when (and utf-8-compose-scripts (> length 1))
+ ;; These currently have definitions which cover the relevant
+ ;; unicodes. We could avoid loading thai-util &c by checking
+ ;; whether the region contains any characters with the appropriate
+ ;; categories. There aren't yet Unicode-based rules for Tibetan.
+ (diacritic-compose-region (point-max) (point-min))
+ (thai-compose-region (point-max) (point-min))
+ (lao-compose-region (point-max) (point-min))
+ (devanagari-compose-region (point-max) (point-min))
+ (malayalam-compose-region (point-max) (point-min))
+ (tamil-compose-region (point-max) (point-min)))
+ (- (point-max) (point-min)))))
+
+(defun utf-8-pre-write-conversion (beg end)
+ "Prepare for `utf-translate-cjk-mode' to encode text between BEG and END.
+This is used as a post-read-conversion of utf-8 coding system."
+ (if (and utf-translate-cjk-mode
+ (not utf-translate-cjk-lang-env)
+ (save-excursion
+ (goto-char beg)
+ (re-search-forward "\\cc\\|\\cj\\|\\ch" end t)))
+ (utf-translate-cjk-load-tables))
+ nil)
(make-coding-system
'mule-utf-8 4 ?u
"UTF-8 encoding for Emacs-supported Unicode characters.
-The supported Emacs character sets are:
- ascii
- eight-bit-control
- eight-bit-graphic
- latin-iso8859-1
- mule-unicode-0100-24ff
- mule-unicode-2500-33ff
- mule-unicode-e000-ffff
-
-Unicode characters out of the ranges U+0000-U+33FF and U+E200-U+FFFF
-are decoded into sequences of eight-bit-control and eight-bit-graphic
-characters to preserve their byte sequences. Emacs characters out of
-these ranges are encoded into U+FFFD.
-
-Note that, currently, characters in the mule-unicode charsets have no
-syntax and case information. Thus, for instance, upper- and
-lower-casing commands won't work with them."
+It supports Unicode characters of these ranges:
+ U+0000..U+33FF, U+E000..U+FFFF.
+They correspond to these Emacs character sets:
+ ascii, latin-iso8859-1, mule-unicode-0100-24ff,
+ mule-unicode-2500-33ff, mule-unicode-e000-ffff
+
+On decoding (e.g. reading a file), Unicode characters not in the above
+ranges are decoded into sequences of eight-bit-control and
+eight-bit-graphic characters to preserve their byte sequences. The
+byte sequence is preserved on i/o for valid utf-8, but not necessarily
+for invalid utf-8.
+
+On encoding (e.g. writing a file), Emacs characters not belonging to
+any of the character sets listed above are encoded into the UTF-8 byte
+sequence representing U+FFFD (REPLACEMENT CHARACTER)."
'(ccl-decode-mule-utf-8 . ccl-encode-mule-utf-8)
- '((safe-charsets
+ `((safe-charsets
ascii
eight-bit-control
eight-bit-graphic
latin-iso8859-1
mule-unicode-0100-24ff
mule-unicode-2500-33ff
- mule-unicode-e000-ffff)
- (mime-charset . utf-8)))
+ mule-unicode-e000-ffff
+ ,@(if utf-translate-cjk-mode
+ utf-translate-cjk-charsets))
+ (mime-charset . utf-8)
+ (coding-category . coding-category-utf-8)
+ (valid-codes (0 . 255))
+ (pre-write-conversion . utf-8-pre-write-conversion)
+ (post-read-conversion . utf-8-post-read-conversion)
+ (translation-table-for-encode . utf-translation-table-for-encode)
+ (dependency unify-8859-on-encoding-mode
+ unify-8859-on-decoding-mode
+ utf-fragment-on-decoding
+ utf-translate-cjk-mode)))
(define-coding-system-alias 'utf-8 'mule-utf-8)
+
+;; I think this needs special private charsets defined for the
+;; untranslated sequences, if it's going to work well.
+
+;;; (defun utf-8-compose-function (pos to pattern &optional string)
+;;; (let* ((prop (get-char-property pos 'composition string))
+;;; (l (and prop (- (cadr prop) (car prop)))))
+;;; (cond ((and l (> l (- to pos)))
+;;; (delete-region pos to))
+;;; ((and (> (char-after pos) 224)
+;;; (< (char-after pos) 256)
+;;; (save-restriction
+;;; (narrow-to-region pos to)
+;;; (utf-8-compose)))
+;;; t))))
+
+;;; (dotimes (i 96)
+;;; (aset composition-function-table
+;;; (+ 128 i)
+;;; `((,(string-as-multibyte "[\200-\237\240-\377]")
+;;; . utf-8-compose-function))))
+
+;;; arch-tag: b08735b7-753b-4ae6-b754-0f3efe4515c5
+;;; utf-8.el ends here