lisp/international/utf-8.el

   1 ;;; utf-8.el --- UTF-8 decoding/encoding support -*- coding: iso-2022-7bit -*-
   2
   3 ;; Copyright (C) 2001 Electrotechnical Laboratory, JAPAN.
   4 ;; Licensed to the Free Software Foundation.
   5 ;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
   6
   7 ;; Author: TAKAHASHI Naoto  <ntakahas@m17n.org>
   8 ;; Maintainer: FSF
   9 ;; Keywords: multilingual, Unicode, UTF-8, i18n
  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
  30 ;; The coding-system `mule-utf-8' basically supports encoding/decoding
  31 ;; of the following character sets to and from UTF-8:
  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 ;;
  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
  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.
  48 ;;
  49 ;; Characters from other character sets can be encoded with mule-utf-8
  50 ;; by populating the translation table
  51 ;; `utf-translation-table-for-encode'.  Hash tables
  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.
  55
  56 ;; UTF-8 is defined in RFC 2279.  A sketch of the encoding is:
  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
  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-*.
  69
  70 If `unify-8859-on-encoding-mode' is non-nil, this table populates the
  71 translation-table named `utf-translation-table-for-encode'.")
  72
  73 (define-translation-table 'utf-translation-table-for-encode)
  74
  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.
  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
  84 If `utf-fragment-on-decoding' is non-nil, this table populates the
  85 translation-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
  90 If `utf-fragment-on-decoding' is non-nil and
  91 `unify-8859-on-encoding-mode' is nil, this table populates the
  92 translation-table named `utf-translation-table-for-encode'")
  93
  94 (define-translation-table 'utf-translation-table-for-decode)
  95
  96
  97 (defvar ucs-mule-cjk-to-unicode (make-hash-table :test 'eq)
  98   "Hash table mapping Emacs CJK character sets to Unicode code points.
  99
 100 If `utf-translate-cjk' is non-nil, this table populates the
 101 translation-hash-table named `utf-subst-table-for-encode'.")
 102
 103 (define-translation-hash-table 'utf-subst-table-for-encode
 104   ucs-mule-cjk-to-unicode)
 105
 106 (defvar ucs-unicode-to-mule-cjk (make-hash-table :test 'eq)
 107   "Hash table mapping Unicode code points to Emacs CJK character sets.
 108
 109 If `utf-translate-cjk' is non-nil, this table populates the
 110 translation-hash-table named `utf-subst-table-for-decode'.")
 111
 112 (define-translation-hash-table 'utf-subst-table-for-decode
 113   ucs-unicode-to-mule-cjk)
 114
 115 (mapc
 116  (lambda (pair)
 117    (aset utf-fragmentation-table (car pair) (cdr pair))
 118    (aset utf-defragmentation-table (cdr pair) (car pair)))
 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&\x7f\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(\x7f\e(B . ?\e,L\x7f\e(B)))
 154
 155
 156 (defcustom utf-fragment-on-decoding nil
 157   "Whether or not to decode some chars in UTF-8/16 text into iso8859 charsets.
 158 Setting this means that the relevant Cyrillic and Greek characters are
 159 decoded into the iso8859 charsets rather than into
 160 mule-unicode-0100-24ff.  The iso8859 charsets take half as much space
 161 in the buffer, but using them may affect how the buffer can be re-encoded
 162 and may require a different input method to search for them, for instance.
 163 See `unify-8859-on-decoding-mode' and `unify-8859-on-encoding-mode'
 164 for mechanisms to make this largely transparent.
 165
 166 Setting this variable outside customize has no effect."
 167   :set (lambda (s v)
 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
 179                    utf-defragmentation-table)))
 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)
 187              (define-translation-table 'utf-translation-table-for-encode)))
 188          (set-default s v))
 189   :version "21.4"
 190   :type 'boolean
 191   :group 'mule)
 192
 193 (define-minor-mode utf-translate-cjk-mode
 194   "Whether the UTF based coding systems should decode/encode CJK characters.
 195 Enabling this loads tables which allow the coding systems mule-utf-8,
 196 mule-utf-16le and mule-utf-16be to encode characters in the charsets
 197 `korean-ksc5601', `chinese-gb2312', `chinese-big5-1',
 198 `chinese-big5-2', `japanese-jisx0208' and `japanese-jisx0212', and to
 199 decode the corresponding unicodes into such characters.
 200
 201 Where the charsets overlap, the one preferred for decoding is chosen
 202 according to the language environment in effect when this option is
 203 turned on: ksc5601 for Korean, gb2312 for Chinese-GB, big5 for
 204 Chinese-Big5 and jisx for other environments.
 205
 206 The tables are large (over 40000 entries), so this option is not the
 207 default.  Also, installing them may be rather slow."
 208   :init-value nil
 209   :version "21.4"
 210   :type 'boolean
 211   :set-after '(current-language-environment)
 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
 224               (make-hash-table :test 'eq :size 43000 :rehash-size 1000))
 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
 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))
 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
 259       (make-hash-table :test 'eq))
 260     (set-char-table-extra-slot (get 'utf-translation-table-for-encode
 261                                     'translation-table)
 262                                1 nil)))
 263
 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
 271   ;;    eight-bit-graphic   |       2        |       1
 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
 285     ((r5 = ,(charset-id 'eight-bit-control))
 286      (r6 = ,(charset-id 'eight-bit-graphic))
 287      (loop
 288       (r0 = -1)
 289       (read r0)
 290
 291       ;; 1byte encoding, i.e., ascii
 292       (if (r0 < #x80)
 293           ((write r0))
 294         (if (r0 < #xc0)             ; continuation byte (invalid here)
 295             ((if (r0 < #xa0)
 296                  (write-multibyte-character r5 r0)
 297                (write-multibyte-character r6 r0)))
 298           ;; 2 byte encoding 00000yyyyyxxxxxx = 110yyyyy 10xxxxxx
 299           (if (r0 < #xe0)
 300               ((r1 = -1)
 301                (read r1)
 302
 303                (if ((r1 & #b11000000) != #b10000000)
 304                    ;; Invalid 2-byte sequence
 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)
 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)
 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
 349                           utf-translation-table-for-decode r0 r1)
 350                          (write-multibyte-character r0 r1))))))))
 351
 352             ;; 3byte encoding
 353             ;; zzzzyyyyyyxxxxxx = 1110zzzz 10yyyyyy 10xxxxxx
 354             (if (r0 < #xf0)
 355                 ((r1 = -1)
 356                  (r2 = -1)
 357                  (read r1 r2)
 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))))
 387
 388                    ;; mule-unicode-0100-24ff (>= 0800)
 389                    ((if (r3 < #x2500)
 390                         ((r0 = ,(charset-id 'mule-unicode-0100-24ff))
 391                          (r3 -= #x0100)
 392                          (r3 //= 96)
 393                          (r1 = (r7 + 32))
 394                          (r1 += ((r3 + 32) << 7))
 395                          (translate-character
 396                           utf-translation-table-for-decode r0 r1)
 397                          (write-multibyte-character r0 r1))
 398
 399                       ;; mule-unicode-2500-33ff
 400                       (if (r3 < #x3400)
 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))))
 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
 420                              (lookup-integer utf-subst-table-for-decode r4 r5)
 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
 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))
 448
 449                             ;; mule-unicode-e000-ffff
 450                             ;; Fixme: fffe and ffff are invalid.
 451                             ((r0 = ,(charset-id 'mule-unicode-e000-ffff))
 452                              (r3 -= #xe000)
 453                              (r3 //= 96)
 454                              (r1 = (r7 + 32))
 455                              (r1 += ((r3 + 32) << 7))
 456                              (write-multibyte-character r0 r1)))))))))
 457
 458               (if (r0 < #xfe)
 459                   ;; 4byte encoding
 460                   ;; keep those bytes as eight-bit-{control|graphic}
 461                   ;; Fixme: allow lookup in utf-subst-table-for-decode.
 462                   ((r1 = -1)
 463                    (r2 = -1)
 464                    (r3 = -1)
 465                    (read r1 r2 r3)
 466                    ;; r0 > #xf0, thus eight-bit-graphic
 467                    (write-multibyte-character r6 r0)
 468                    (if (r1 < #xa0)
 469                        (if (r1 < #x80)  ; invalid byte
 470                            (write r1)
 471                          (write-multibyte-character r5 r1))
 472                      (write-multibyte-character r6 r1))
 473                    (if (r2 < #xa0)
 474                        (if (r2 < #x80)  ; invalid byte
 475                            (write r2)
 476                          (write-multibyte-character r5 r2))
 477                      (write-multibyte-character r6 r2))
 478                    (if (r3 < #xa0)
 479                        (if (r3 < #x80)  ; invalid byte
 480                            (write r3)
 481                          (write-multibyte-character r5 r3))
 482                      (write-multibyte-character r6 r3))
 483                    (if (r0 >= #xf8)     ; 5- or 6-byte encoding
 484                        ((r0 = -1)
 485                         (read r0)
 486                         (if (r0 < #xa0)
 487                             (if (r0 < #x80) ; invalid byte
 488                                 (write r0)
 489                               (write-multibyte-character r5 r0))
 490                           (write-multibyte-character r6 r0))
 491                         (if (r0 >= #xfc) ; 6-byte
 492                             ((r0 = -1)
 493                              (read r0)
 494                              (if (r0 < #xa0)
 495                                  (if (r0 < #x80) ; invalid byte
 496                                      (write r0)
 497                                    (write-multibyte-character r5 r0))
 498                                (write-multibyte-character r6 r0)))))))
 499                 ;; else invalid byte >= #xfe
 500                 (write-multibyte-character r6 r0))))))
 501       (repeat)))
 502
 503     ;; At EOF...
 504     (if (r0 >= 0)
 505         ((if (r0 < #x80)
 506              (write r0)
 507            (if (r0 < #xa0)
 508                (write-multibyte-character r5 r0)
 509              ((write-multibyte-character r6 r0))))
 510          (if (r1 >= 0)
 511              ((if (r1 < #x80)
 512                   (write r1)
 513                 (if (r1 < #xa0)
 514                     (write-multibyte-character r5 r1)
 515                   ((write-multibyte-character r6 r1))))
 516               (if (r2 >= 0)
 517                   ((if (r2 < #x80)
 518                        (write r2)
 519                      (if (r2 < #xa0)
 520                          (write-multibyte-character r5 r2)
 521                        ((write-multibyte-character r6 r2))))
 522                    (if (r3 >= 0)
 523                        (if (r3 < #x80)
 524                            (write r3)
 525                          (if (r3 < #xa0)
 526                              (write-multibyte-character r5 r3)
 527                            ((write-multibyte-character r6 r3))))))))))))
 528
 529   "CCL program to decode UTF-8.
 530 Basic decoding is done into the charsets ascii, latin-iso8859-1 and
 531 mule-unicode-*, but see also `utf-fragmentation-table' and
 532 `ucs-mule-cjk-to-unicode'.
 533 Encodings of un-representable Unicode characters are decoded asis into
 534 eight-bit-control and eight-bit-graphic characters.")
 535
 536 (define-ccl-program ccl-encode-mule-utf-8
 537   `(1
 538     ((r5 = -1)
 539      (loop
 540       (if (r5 < 0)
 541           ((r1 = -1)
 542            (read-multibyte-character r0 r1)
 543            (translate-character utf-translation-table-for-encode r0 r1))
 544         (;; We have already done read-multibyte-character.
 545          (r0 = r5)
 546          (r1 = r6)
 547          (r5 = -1)))
 548
 549       (if (r0 == ,(charset-id 'ascii))
 550           (write r1)
 551
 552         (if (r0 == ,(charset-id 'latin-iso8859-1))
 553             ;; r1          scalar                  utf-8
 554             ;;       0000 0yyy yyxx xxxx    110y yyyy 10xx xxxx
 555             ;; 20    0000 0000 1010 0000    1100 0010 1010 0000
 556             ;; 7f    0000 0000 1111 1111    1100 0011 1011 1111
 557             ((r0 = (((r1 & #x40) >> 6) | #xc2))
 558              (r1 &= #x3f)
 559              (r1 |= #x80)
 560              (write r0 r1))
 561
 562           (if (r0 == ,(charset-id 'mule-unicode-0100-24ff))
 563               ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
 564                ;; #x3f80 == (0011 1111 1000 0000)b
 565                (r1 &= #x7f)
 566                (r1 += (r0 + 224))       ; 240 == -32 + #x0100
 567                ;; now r1 holds scalar value
 568                (if (r1 < #x0800)
 569                    ;; 2byte encoding
 570                    ((r0 = (((r1 & #x07c0) >> 6) | #xc0))
 571                     ;; #x07c0 == (0000 0111 1100 0000)b
 572                     (r1 &= #x3f)
 573                     (r1 |= #x80)
 574                     (write r0 r1))
 575                  ;; 3byte encoding
 576                  ((r0 = (((r1 & #xf000) >> 12) | #xe0))
 577                   (r2 = ((r1 & #x3f) | #x80))
 578                   (r1 &= #x0fc0)
 579                   (r1 >>= 6)
 580                   (r1 |= #x80)
 581                   (write r0 r1 r2))))
 582
 583             (if (r0 == ,(charset-id 'mule-unicode-2500-33ff))
 584                 ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
 585                  (r1 &= #x7f)
 586                  (r1 += (r0 + 9440))    ; 9440 == -32 + #x2500
 587                  (r0 = (((r1 & #xf000) >> 12) | #xe0))
 588                  (r2 = ((r1 & #x3f) | #x80))
 589                  (r1 &= #x0fc0)
 590                  (r1 >>= 6)
 591                  (r1 |= #x80)
 592                  (write r0 r1 r2))
 593
 594               (if (r0 == ,(charset-id 'mule-unicode-e000-ffff))
 595                   ((r0 = ((((r1 & #x3f80) >> 7) - 32) * 96))
 596                    (r1 &= #x7f)
 597                    (r1 += (r0 + 57312)) ; 57312 == -32 + #xe000
 598                    (r0 = (((r1 & #xf000) >> 12) | #xe0))
 599                    (r2 = ((r1 & #x3f) | #x80))
 600                    (r1 &= #x0fc0)
 601                    (r1 >>= 6)
 602                    (r1 |= #x80)
 603                    (write r0 r1 r2))
 604
 605                 (if (r0 == ,(charset-id 'eight-bit-control))
 606                     ;; r1          scalar                  utf-8
 607                     ;;       0000 0yyy yyxx xxxx    110y yyyy 10xx xxxx
 608                     ;; 80    0000 0000 1000 0000    1100 0010 1000 0000
 609                     ;; 9f    0000 0000 1001 1111    1100 0010 1001 1111
 610                     ((write #xc2)
 611                      (write r1))
 612
 613                   (if (r0 == ,(charset-id 'eight-bit-graphic))
 614                       ;; r1          scalar                  utf-8
 615                       ;;       0000 0yyy yyxx xxxx    110y yyyy 10xx xxxx
 616                       ;; a0    0000 0000 1010 0000    1100 0010 1010 0000
 617                       ;; ff    0000 0000 1111 1111    1101 1111 1011 1111
 618                       ((write r1)
 619                        (r1 = -1)
 620                        (read-multibyte-character r0 r1)
 621                        (if (r0 != ,(charset-id 'eight-bit-graphic))
 622                            (if (r0 != ,(charset-id 'eight-bit-control))
 623                                ((r5 = r0)
 624                                 (r6 = r1))))
 625                        (if (r5 < 0)
 626                            ((read-multibyte-character r0 r2)
 627                             (if (r0 != ,(charset-id 'eight-bit-graphic))
 628                                 (if (r0 != ,(charset-id 'eight-bit-control))
 629                                     ((r5 = r0)
 630                                      (r6 = r2))))
 631                             (if (r5 < 0)
 632                                 (write r1 r2)
 633                               (if (r1 < #xa0)
 634                                   (write r1)
 635                                 ((write #xc2)
 636                                  (write r1)))))))
 637
 638                     ((lookup-character utf-subst-table-for-encode r0 r1)
 639                      (if r7             ; lookup succeeded
 640                          ((r1 = (((r0 & #xf000) >> 12) | #xe0))
 641                           (r2 = ((r0 & #x3f) | #x80))
 642                           (r0 &= #x0fc0)
 643                           (r0 >>= 6)
 644                           (r0 |= #x80)
 645                           (write r1 r0 r2))
 646                        ;; Unsupported character.
 647                        ;; Output U+FFFD, which is `ef bf bd' in UTF-8.
 648                        ((write #xef)
 649                         (write #xbf)
 650                         (write #xbd)))))))))))
 651       (repeat)))
 652     (if (r1 >= #xa0)
 653         (write r1)
 654       (if (r1 >= #x80)
 655           ((write #xc2)
 656            (write r1)))))
 657
 658   "CCL program to encode into UTF-8.")
 659
 660
 661 (define-ccl-program ccl-untranslated-to-ucs
 662   `(0
 663     (if (r0 < #xf0)                     ; 3-byte encoding, as above
 664         ((r4 = 0)
 665          (r3 = (r1 & #b11000000))
 666          (r3 |= ((r2 >> 2) & #b00110000))
 667          (if (r3 != #b10100000)
 668              (r4 = 1)
 669            ((r3 = ((r0 & #x0f) << 12))
 670             (r3 += ((r1 & #x3f) << 6))
 671             (r3 += (r2 & #x3f))
 672             (if (r3 < #x0800)
 673                 (r4 = 1))))
 674          (if (r4 != 0)
 675              (r0 = 0)
 676            (r0 = r3)))
 677       (if (r0 < #xf8)                   ; 4-byte (Mule-UCS recipe)
 678           ((r4 = (r1 >> 6))
 679            (if (r4 != #b10)
 680                (r0 = 0)
 681              ((r4 = (r2 >> 6))
 682               (if (r4 != #b10)
 683                   (r0 = 0)
 684                 ((r4 = (r3 >> 6))
 685                  (if (r4 != #b10)
 686                      (r0 = 0)
 687                    ((r1 = ((r1  & #x3F) << 12))
 688                     (r2 = ((r2  & #x3F) << 6))
 689                     (r3 &= #x3F)
 690                     (r0 = (((((r0 & #x07) << 18) | r1) | r2) | r3)))))))))
 691         (r0 = 0))))
 692   "Decode 3- or 4-byte sequences in r0, r1, r2 [,r3] to unicodes in r0.
 693 r0 == 0 for invalid sequence.")
 694
 695 (defvar utf-8-ccl-regs (make-vector 8 0))
 696
 697 (defsubst utf-8-untranslated-to-ucs ()
 698   "Return the UCS code for an untranslated sequence of raw bytes t point.
 699 Only for 3- or 4-byte sequences."
 700   (aset utf-8-ccl-regs 0 (or (char-after) 0))
 701   (aset utf-8-ccl-regs 1 (or (char-after (1+ (point))) 0))
 702   (aset utf-8-ccl-regs 2 (or (char-after (+ 2 (point))) 0))
 703   (aset utf-8-ccl-regs 3 (or (char-after (+ 3 (point))) 0))
 704   (ccl-execute 'ccl-untranslated-to-ucs utf-8-ccl-regs)
 705   (aref utf-8-ccl-regs 0))
 706
 707 (defun utf-8-help-echo (window object position)
 708   (format "Untranslated Unicode U+%04X"
 709           (get-char-property position 'untranslated-utf-8 object)))
 710
 711 ;; We compose the untranslatable sequences into a single character.
 712 ;; This is infelicitous for editing, because there's currently no
 713 ;; mechanism for treating compositions as atomic, but is OK for
 714 ;; display.  They are composed to U+FFFD with help-echo which
 715 ;; indicates the unicodes they represent.  This function GCs too much.
 716 (defsubst utf-8-compose ()
 717   "Put a suitable composition on an untranslatable sequence.
 718 Return the sequence's length."
 719   (let* ((u (utf-8-untranslated-to-ucs))
 720          (l (unless (zerop u)
 721               (if (>= u #x10000)
 722                        4
 723                      3))))
 724     (when l
 725       (put-text-property (point) (min (point-max) (+ l (point)))
 726                          'untranslated-utf-8 u)
 727       (put-text-property (point) (min (point-max) (+ l (point)))
 728                          'help-echo 'utf-8-help-echo)
 729       (compose-region (point) (+ l (point)) ?\e$,3u=\e(B)
 730       l)))
 731
 732 (defcustom utf-8-compose-scripts nil
 733   "*Non-nil means compose various scripts on decoding utf-8 text."
 734   :group 'mule
 735   :version "21.4"
 736   :type 'boolean)
 737
 738 (defun utf-8-post-read-conversion (length)
 739   "Compose untranslated utf-8 sequences into single characters.
 740 Also compose particular scripts if `utf-8-compose-scripts' is non-nil."
 741   (save-excursion
 742     ;; Can't do eval-when-compile to insert a multibyte constant
 743     ;; version of the string in the loop, since it's always loaded as
 744     ;; unibyte from a byte-compiled file.
 745     (let ((range (string-as-multibyte "^\xe1-\xf7")))
 746       (while (and (skip-chars-forward range)
 747                   (not (eobp)))
 748         (forward-char (utf-8-compose)))))
 749   ;; Fixme: Takahashi-san implies it may not work this easily.  I
 750   ;; asked why but didn't get a reply. -- fx
 751   (when (and utf-8-compose-scripts (> length 1))
 752     ;; These currently have definitions which cover the relevant
 753     ;; unicodes.  We could avoid loading thai-util &c by checking
 754     ;; whether the region contains any characters with the appropriate
 755     ;; categories.  There aren't yet Unicode-based rules for Tibetan.
 756     (save-excursion (setq length (diacritic-post-read-conversion length)))
 757     (save-excursion (setq length (thai-post-read-conversion length)))
 758     (save-excursion (setq length (lao-post-read-conversion length)))
 759     (save-excursion
 760       (setq length (in-is13194-devanagari-post-read-conversion length))))
 761   length)
 762
 763 ;; ucs-tables is preloaded
 764 ;; (defun utf-8-pre-write-conversion (beg end)
 765 ;;   "Semi-dummy pre-write function effectively to autoload ucs-tables."
 766 ;;   ;; Ensure translation-table is loaded.
 767 ;;   (require 'ucs-tables)
 768 ;;   ;; Don't do this again.
 769 ;;   (coding-system-put 'mule-utf-8 'pre-write-conversion nil)
 770 ;;   nil)
 771
 772 (make-coding-system
 773  'mule-utf-8 4 ?u
 774  "UTF-8 encoding for Emacs-supported Unicode characters.
 775 It supports Unicode characters of these ranges:
 776     U+0000..U+33FF, U+E000..U+FFFF.
 777 They correspond to these Emacs character sets:
 778     ascii, latin-iso8859-1, mule-unicode-0100-24ff,
 779     mule-unicode-2500-33ff, mule-unicode-e000-ffff
 780
 781 On decoding (e.g. reading a file), Unicode characters not in the above
 782 ranges are decoded into sequences of eight-bit-control and
 783 eight-bit-graphic characters to preserve their byte sequences.  The
 784 byte sequence is preserved on i/o for valid utf-8, but not necessarily
 785 for invalid utf-8.
 786
 787 On encoding (e.g. writing a file), Emacs characters not belonging to
 788 any of the character sets listed above are encoded into the UTF-8 byte
 789 sequence representing U+FFFD (REPLACEMENT CHARACTER)."
 790
 791  '(ccl-decode-mule-utf-8 . ccl-encode-mule-utf-8)
 792  '((safe-charsets
 793     ascii
 794     eight-bit-control
 795     eight-bit-graphic
 796     latin-iso8859-1
 797     mule-unicode-0100-24ff
 798     mule-unicode-2500-33ff
 799     mule-unicode-e000-ffff)
 800    (mime-charset . utf-8)
 801    (coding-category . coding-category-utf-8)
 802    (valid-codes (0 . 255))
 803 ;;    (pre-write-conversion . utf-8-pre-write-conversion)
 804    (post-read-conversion . utf-8-post-read-conversion)
 805    (translation-table-for-encode . utf-translation-table-for-encode)
 806    (dependency unify-8859-on-encoding-mode
 807                unify-8859-on-decoding-mode
 808                utf-fragment-on-decoding
 809                utf-translate-cjk)))
 810
 811 (define-coding-system-alias 'utf-8 'mule-utf-8)
 812
 813 ;; I think this needs special private charsets defined for the
 814 ;; untranslated sequences, if it's going to work well.
 815
 816 ;;; (defun utf-8-compose-function (pos to pattern &optional string)
 817 ;;;   (let* ((prop (get-char-property pos 'composition string))
 818 ;;;      (l (and prop (- (cadr prop) (car prop)))))
 819 ;;;     (cond ((and l (> l (- to pos)))
 820 ;;;        (delete-region pos to))
 821 ;;;       ((and (> (char-after pos) 224)
 822 ;;;             (< (char-after pos) 256)
 823 ;;;             (save-restriction
 824 ;;;               (narrow-to-region pos to)
 825 ;;;               (utf-8-compose)))
 826 ;;;        t))))
 827
 828 ;;; (dotimes (i 96)
 829 ;;;   (aset composition-function-table
 830 ;;;     (+ 128 i)
 831 ;;;     `((,(string-as-multibyte "[\200-\237\240-\377]")
 832 ;;;        . utf-8-compose-function))))
 833
 834 ;;; utf-8.el ends here