its.el

   1 ;;; its.el --- Input Translation System AKA "ITS(uDekirunDa!)"
   2
   3 ;; Copyright (C) 1999,2000 PFU LIMITED
   4
   5 ;; Author: NIIBE Yutaka <gniibe@chroot.org>
   6 ;;         KATAYAMA Yoshio <kate@pfu.co.jp>
   7
   8 ;; Maintainer: TOMURA Satoru <tomura@etl.go.jp>
   9
  10 ;; Keywords: mule, multilingual, input method
  11
  12 ;; This file is part of EGG.
  13
  14 ;; EGG is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; EGG is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;;; Commentary:
  30
  31
  32 ;;; Code:
  33
  34 (require 'cl)
  35 (require 'egg-edep)
  36
  37 (defgroup its nil
  38   "Input Translation System of Tamago 4."
  39   :group 'egg)
  40
  41 (defcustom its-enable-fullwidth-alphabet t
  42   "*Enable fullwidth symbol input."
  43   :group 'its :type 'boolean)
  44
  45 (defcustom its-barf-on-invalid-keyseq nil
  46   "*Don't allow invalid key sequence in input buffer, if non-NIL."
  47   :group 'its :type 'boolean)
  48
  49 (defcustom its-delete-by-keystroke nil
  50   "*Delete characters as if cancel input keystroke, if nin-NIL."
  51   :group 'its :type 'boolean)
  52
  53 (defcustom its-fence-invisible nil
  54   "*Make fences invisible, if nin-NIL."
  55   :group 'its :type 'boolean)
  56
  57 (defcustom its-fence-open "|"
  58   "*String of fence start mark. (should not be null string)"
  59   :group 'its :type '(string :valid-regexp ".+"))
  60
  61 (defcustom its-fence-continue "+"
  62   "*String of fence start mark. (should not be null string)"
  63   :group 'its :type '(string :valid-regexp ".+"))
  64
  65 (defcustom its-fence-close "|"
  66   "*String of fence end mark. (should not be null string)"
  67   :group 'its :type '(string :valid-regexp ".+"))
  68
  69 (defcustom its-fence-face nil
  70   "*Face (or alist of languages and faces) of text in fences."
  71   :group 'its
  72   :type '(choice face
  73                  (repeat :tag "Language-Face alist"
  74                          (cons :tag "Language-Face"
  75                                (choice :tag "Language"
  76                                        (const Japanese)
  77                                        (const Chinese-GB)
  78                                        (const Chinese-CNS)
  79                                        (const Korean)
  80                                        (const :tag "Default" t)
  81                                        (symbol :tag "Other"))
  82                                face))))
  83
  84 (defvar its-current-map nil)
  85 (make-variable-buffer-local 'its-current-map)
  86 (put 'its-current-map 'permanent-local t)
  87
  88 (defvar its-current-select-func nil)
  89 (make-variable-buffer-local 'its-current-select-func)
  90 (put 'its-current-select-func 'permanent-local t)
  91
  92 (defvar its-previous-select-func nil)
  93 (make-variable-buffer-local 'its-previous-select-func)
  94 (put 'its-previous-select-func 'permanent-local t)
  95
  96 (defvar its-current-language)
  97 (make-variable-buffer-local 'its-current-language)
  98 (put 'its-current-language 'permanent-local t)
  99 \f
 100 ;; Data structure in ITS
 101 ;; (1) SYL and CURSOR
 102 ;;
 103 ;; "SYL" stands for something like a syllable.
 104 ;;
 105 ;; <SYL> ::= ( <output> . ( <keyseq> . <terminal> ))   ; Determined:   DSYL
 106 ;;        |  <state>                            ; Intermediate: ISYL
 107 ;;        |  ( <output> . <point> )             ; Verbatim:     VSYL
 108 ;;        |  nil                                ; None
 109 ;;
 110 ;; ;<state> ::=
 111 ;; ;          ( <output> . ( <keyseq> . <key-state-table/terminal> ))
 112 ;;
 113 ;; <keyseq> ::= "string" of key sequence
 114 ;; <output> ::= "string"
 115 ;;
 116 ;; <point> ::= integer which specifies point
 117 ;;
 118 ;; <cursor> ::= nil        ; Previous SYL is active (input will go that SYL)
 119 ;;           |  t          ; input makes new SYL.  DEL deletes previous SYL
 120 ;;           |  its-cursor ; DEL breaks previous SYL, input makes new SYL
 121
 122 ;; Data structures in ITS
 123 ;; (2) State machine which recognizes SYL
 124 ;;
 125 ;; <state> ::= ( <output> <keyseq> . <key-state-table/terminal> )
 126 ;;
 127 ;; <key-state-table/terminal> ::= <key-state-table> ; intermediate state
 128 ;;                             |  <terminal>        ; terminal state
 129 ;;
 130 ;; <key-state-table> ::= ( <key-state-alist> . <expr-output-back-list> )
 131 ;; <key-state-alist> ::= ( <key-state> ... )
 132 ;; <key-state> ::= ( <key> . <state> )
 133 ;; <key> ::= Positive INTEGER which specifies KEY STROKE
 134 ;;        |  -1 ; means END of key stroke
 135 ;;
 136 ;; Only applicable for last transition.
 137 ;; <expr-output-back-list> ::= ( (<output> . (<keyexpr> . <howmanyback>))... )
 138 ;; <keyexpr> ::= something like "[a-z]" which specifies class of key.
 139 ;;            |  NIL; means ANY of key (except END of the key stroke)
 140 ;;
 141 ;;
 142 ;; <keyseq> ::= "string"
 143 ;;
 144 ;; <terminal> ::= nil
 145 ;;             |  <howmanyback>
 146 ;;
 147 ;; <howmanyback> ::= integer which specifies how many key strokes we go back
 148 ;;
 149 ;; <output> ::= "string"
 150
 151 ;; Data structure in ITS (3) Map
 152 ;;
 153 ;; <map>         ::= ( <name> <indicator> <language> . <start-state> )
 154 ;; <name>        ::= "string"
 155 ;; <indicator>   ::= "string"
 156 ;; <language>    ::= "string"
 157 ;; <start-state> ::= <state>
 158 ;;
 159 \f
 160 (defsubst its-new-state (output keyseq back)
 161   (cons output (cons keyseq back)))
 162
 163 (defsubst its-new-map (name indicator language)
 164   (cons name (cons indicator (cons language (its-new-state "" "" nil)))))
 165
 166 (defsubst its-get-indicator (map)
 167   (nth 1 map))
 168
 169 (defsubst its-get-language (map)
 170   (nth 2 map))
 171
 172 (defsubst its-get-start-state (map)
 173   (nthcdr 3 map))
 174
 175 (defsubst its-get-kst/t (state)
 176   (cdr (cdr state)))
 177
 178 (defsubst its-set-kst (state kst)
 179   (setcdr (cdr state) kst))
 180
 181 (defsubst its-get-keyseq (state)
 182   (car (cdr state)))
 183
 184 (defsubst its-set-keyseq (state keyseq)
 185   (setcar (cdr state) keyseq))
 186
 187 (defun its-get-keyseq-cooked (state)
 188   (let ((keyseq (its-get-keyseq state))
 189         (back (its-get-kst/t state)))
 190     (if back
 191         (substring keyseq 0 back)
 192       keyseq)))
 193
 194 (defsubst its-kst-p (kst/t)
 195   (not (or (numberp kst/t) (null kst/t))))
 196
 197 (defun its-get-output (syl/state &optional no-eval)
 198   (setq syl/state (car syl/state))
 199   (cond ((null (consp syl/state))
 200          syl/state)
 201         ((and (null no-eval) (eq (car syl/state) 'eval))
 202          (eval (mapcar (lambda (s) (if (stringp s) (copy-sequence s) s))
 203                        (cdr syl/state))))
 204         (t
 205          (copy-sequence syl/state))))
 206
 207 (defsubst its-set-output (state output)
 208   (setcar state output))
 209
 210 (defsubst its-get-keyseq-syl (syl)
 211   (let ((l (cdr syl)))
 212     (cond ((stringp l)                  ; DSYL
 213            l)
 214           ((numberp l)                  ; VSYL
 215            (car syl))
 216           ((numberp (cdr l))
 217            (substring (car l) 0 (cdr l)))
 218           (t
 219            (car l)))))
 220
 221 (defsubst its-eob-keyexpr (eob)
 222   (car (cdr eob)))
 223 (defsubst its-eob-back (eob)
 224   (cdr (cdr eob)))
 225
 226 (defsubst its-make-class+back (class back)
 227   (cons class back))
 228 (defsubst its-make-otherwise (output class+back)
 229   (cons output class+back))
 230
 231 (defsubst its-DSYL-with-back-p (syl)
 232   (and (consp (cdr syl))
 233        (numberp (its-get-kst/t syl))))
 234
 235 (defsubst its-concrete-DSYL-p (syl)
 236   (stringp (cdr syl)))
 237
 238 (defsubst its-make-concrete-DSYL (syl)
 239   (if (consp (cdr syl))
 240       (cons (its-get-output syl) (its-get-keyseq-syl syl))
 241     syl))
 242
 243 ;;
 244 ;;
 245
 246 (require 'its-keydef)
 247
 248 (defvar its-mode-map
 249   (let ((map (make-sparse-keymap))
 250         (i 33))
 251     (define-key map "\C-a" 'its-beginning-of-input-buffer)
 252     (define-key map "\C-b" 'its-backward-SYL)
 253     (define-key map "\C-c" 'its-cancel-input)
 254     (define-key map "\C-d" 'its-delete-SYL)
 255     (define-key map "\C-e" 'its-end-of-input-buffer)
 256     (define-key map "\C-f" 'its-forward-SYL)
 257     (define-key map "\C-g" 'its-select-previous-mode)
 258     (define-key map "\C-]" 'its-cancel-input)
 259     (define-key map "\C-h" 'its-mode-help-command)
 260     (define-key map "\C-k" 'its-kill-line)
 261 ;;    (define-key map "\C-l" 'its-exit-mode)
 262     (define-key map "\C-m" 'its-exit-mode)      ; RET
 263     (define-key map [return] 'its-exit-mode)
 264     (define-key map "\C-t" 'its-transpose-chars)
 265     (define-key map "\C-w" 'its-kick-convert-region)
 266     (define-key map "\C-y" 'its-yank)
 267     (define-key map "\M-y" 'its-yank-pop)
 268     (define-key map [backspace] 'its-delete-backward-SYL)
 269     (define-key map [delete] 'its-delete-backward-SYL)
 270     (define-key map [M-backspace] 'its-delete-backward-SYL-by-keystroke)
 271     (define-key map [M-delete] 'its-delete-backward-SYL-by-keystroke)
 272     (define-key map [right] 'its-forward-SYL)
 273     (define-key map [left] 'its-backward-SYL)
 274     (while (< i 127)
 275       (define-key map (vector i) 'its-self-insert-char)
 276       (setq i (1+ i)))
 277     (define-key map " "    'its-kick-convert-region-or-self-insert)
 278     (define-key map "\177" 'its-delete-backward-SYL)
 279     ;;
 280     (define-key map "\M-p" 'its-previous-map)
 281     (define-key map "\M-n" 'its-next-map)
 282     (define-key map "\M-h" 'its-hiragana) ; hiragana-region for input-buffer
 283     (define-key map "\M-k" 'its-katakana)
 284     (define-key map "\M-<" 'its-half-width)
 285     (define-key map "\M->" 'its-full-width)
 286     map)
 287   "Keymap for ITS mode.")
 288 (fset 'its-mode-map its-mode-map)
 289
 290 (defvar its-fence-mode nil)
 291 (make-variable-buffer-local 'its-fence-mode)
 292 (put 'its-fence-mode 'permanent-local t)
 293
 294 (defvar egg-sub-mode-map-alist nil)
 295 (or (assq 'its-fence-mode egg-sub-mode-map-alist)
 296     (setq egg-sub-mode-map-alist (cons '(its-fence-mode . its-mode-map)
 297                                        egg-sub-mode-map-alist)))
 298
 299 (defun its-enter/leave-fence (&optional old new)
 300   (setq its-fence-mode (its-in-fence-p)))
 301
 302 (add-hook 'egg-enter/leave-fence-hook 'its-enter/leave-fence)
 303
 304 (defconst its-setup-fence-before-insert-SYL nil)
 305
 306 (defun its-get-fence-face (lang)
 307   (if (null (consp its-fence-face))
 308       its-fence-face
 309     (cdr (or (assq lang its-fence-face)
 310              (assq t its-fence-face)))))
 311
 312 (defun its-put-cursor (cursor)
 313   (unless (eq its-barf-on-invalid-keyseq 'its-keyseq-test)
 314     (let ((p (point))
 315           (str (copy-sequence "!")))
 316       (set-text-properties 0 1 (list 'read-only          t
 317                                      'invisible          t
 318                                      'intangible         'its-part-2
 319                                      'its-cursor         cursor
 320                                      'point-entered      'egg-enter/leave-fence
 321                                      'point-left         'egg-enter/leave-fence
 322                                      'modification-hooks '(egg-modify-fence))
 323                            str)
 324       (insert str)
 325       (goto-char p))))
 326
 327 (defun its-set-cursor-status (cursor)
 328   (delete-region (point) (1+ (point)))
 329   (its-put-cursor cursor)
 330   cursor)
 331
 332 (defvar its-context nil)
 333
 334 ;;
 335 ;;  +-- START property
 336 ;;  |          --- CURSOR Property
 337 ;;  |         /
 338 ;;  v        v    v-- END Property
 339 ;;  |SYL SYL ^ SYL|
 340 ;;   ^^^ ^^^   ^^^------ SYL Property
 341 ;;  <-------><---->
 342 ;; intangible intangible
 343 ;;     1       2
 344 ;;
 345 (defun its-setup-fence-mode ()
 346   (let ((open-props '(its-start t intangible its-part-1))
 347         (close-props '(rear-nonsticky t its-end t intangible its-part-2))
 348         (p (point)) p1)
 349     (if (or (null (stringp its-fence-open)) (zerop (length its-fence-open))
 350             (null (stringp its-fence-continue)) (zerop (length its-fence-continue))
 351             (null (stringp its-fence-close)) (zerop (length its-fence-close)))
 352         (error "invalid fence"))
 353     ;; Put open-fence before inhibit-read-only to detect read-only
 354     (insert (if its-context its-fence-continue its-fence-open))
 355     (let ((inhibit-read-only t))
 356       (setq p1 (point))
 357       (add-text-properties p p1 open-props)
 358       (if its-context
 359           (put-text-property p p1 'its-context its-context))
 360       (insert its-fence-close)
 361       (add-text-properties p1 (point) close-props)
 362       (if its-fence-invisible
 363           (put-text-property p (point) 'invisible t))
 364       (put-text-property p (point) 'read-only t)
 365       (goto-char p1)
 366       (its-define-select-keys its-mode-map t)
 367       (its-put-cursor t))))
 368
 369 (defun its-start (key context)
 370   (let ((its-setup-fence-before-insert-SYL t)
 371         (its-context context))
 372     (its-input nil key)))
 373
 374 (defun its-restart (str set-prop beginning context)
 375   (let ((its-context context)
 376         p)
 377     (its-setup-fence-mode)
 378     (setq p (point))
 379     (put-text-property 0 (length str) 'intangible 'its-part-1 str)
 380     (insert str)
 381     (if set-prop
 382         (progn
 383           (delete-region (point) (1+ (point)))
 384           (its-setup-yanked-portion p (point))))
 385     (if beginning
 386         (its-beginning-of-input-buffer))))
 387
 388 (defun its-self-insert-char ()
 389   (interactive)
 390   (let ((inhibit-read-only t)
 391         (key last-command-char)
 392         (cursor (get-text-property (point) 'its-cursor))
 393         (syl (get-text-property (1- (point)) 'its-syl)))
 394     (cond
 395      ((or (eq cursor t)
 396           (not (eq (get-text-property (1- (point)) 'its-map) its-current-map)))
 397       (put-text-property (- (point) (length (its-get-output syl))) (point)
 398                          'its-syl (its-make-concrete-DSYL syl))
 399       (setq syl nil))
 400     (cursor
 401      (setq syl nil)))
 402     (its-input syl key)))
 403
 404 (defun its-current-language-length ()
 405   (+ (if (eq (get-text-property (1- (point)) 'egg-lang) its-current-language)
 406          (- (point) (previous-single-property-change (point) 'egg-lang))
 407        0)
 408      (if (eq (get-text-property (1+ (point)) 'egg-lang) its-current-language)
 409          (- (next-single-property-change (1+ (point)) 'egg-lang) (point) 1)
 410        0)))
 411
 412 (defun its-initial-ISYL ()
 413   (its-get-start-state (symbol-value its-current-map)))
 414
 415 (defun its-make-VSYL (keyseq)
 416   (cons keyseq (length keyseq)))
 417
 418 (defun its-input-error ()
 419   (error "Invalid Romaji Sequence"))
 420
 421 (defvar its-stroke-input-alist nil)
 422
 423 (defun its-input (syl key)
 424   (let ((output (car syl))
 425         (k/kk/s (cdr syl))
 426         (stroke (assq its-current-language its-stroke-input-alist)))
 427     (or syl (setq syl (its-initial-ISYL)))
 428     (cond
 429      ((numberp k/kk/s)
 430         ;; k/kk/s is "point in keyseq"
 431         (its-input-to-vsyl syl key k/kk/s output))
 432      ((and (or its-barf-on-invalid-keyseq stroke)
 433            (null (its-keyseq-acceptable-p (vector key) syl)))
 434       ;; signal before altering
 435       (its-input-error))
 436      (t
 437       ;; It's ISYL
 438       (its-state-machine syl key 'its-buffer-ins/del-SYL)
 439       (if (and stroke (>= (its-current-language-length) (cdr stroke)))
 440           (its-kick-convert-region))))))
 441
 442 (defun its-input-to-vsyl (syl key point output)
 443   (if (< key 0)
 444       (its-set-cursor-status t)
 445     (let ((len (length output)))
 446       (if (= len point)
 447           ;; point is at end of VSYL.  Don't need to call state machine.
 448           (its-buffer-ins/del-SYL
 449            (its-make-VSYL (concat output (vector key))) syl nil)
 450         ;; point is at middle of VSYL.
 451         (let ((new-keyseq (concat (substring output 0 point)
 452                                   (vector key)
 453                                   (substring output point))))
 454           (its-state-machine-keyseq new-keyseq 'its-buffer-ins/del-SYL))))))
 455 \f
 456 ;;;
 457 ;;; ITS State Machine
 458 ;;;
 459
 460 (defvar its-disable-special-action nil)
 461
 462 ;; Return CURSOR
 463 (defun its-state-machine (state key emit)
 464   (let ((next-state (its-get-next-state state key))
 465         expr-output-back kst/t output keyseq back)
 466     (cond
 467      ;; proceed to next status
 468      ((and next-state
 469            (not (and its-disable-special-action
 470                      (eq (its-get-kst/t next-state) t))))
 471       (setq kst/t (its-get-kst/t next-state)
 472             output (its-get-output next-state)
 473             keyseq (its-get-keyseq next-state))
 474       (cond
 475        ;; Special actions.
 476        ((eq kst/t t)
 477         (if (stringp output)
 478             (let ((its-current-language t))
 479               (funcall emit (cons output keyseq) state 'its-cursor))
 480           (funcall emit (cons "" keyseq) state 'its-cursor)
 481           (apply (car output) (cdr output))))
 482
 483        ;; Still, it's a intermediate state.
 484        ((its-kst-p kst/t)
 485         (funcall emit next-state state nil))
 486
 487        ;; It's negative integer which specifies how many
 488        ;; characters we go backwards
 489        (kst/t
 490         (funcall emit next-state state 'its-cursor)
 491         (its-state-machine-keyseq (substring keyseq kst/t) emit (< key 0)))
 492
 493        ;; Here we arrive to a terminal state.
 494        ;; Emit a DSYL, and go ahead.
 495        (t
 496         (funcall emit next-state state 'its-cursor))))
 497
 498      ;; push back by otherwise status
 499      ((and (>= key 0)
 500            (setq expr-output-back (its-get-otherwise state key)))
 501       (setq keyseq (concat (its-get-keyseq state) (vector key))
 502             back (its-eob-back expr-output-back))
 503       (funcall emit
 504                (cons (or (its-get-output expr-output-back)
 505                          (its-get-output
 506                           (its-goto-state (substring keyseq 0 back))))
 507                      (cons keyseq back))
 508                state t)
 509       (its-state-machine-keyseq
 510        (substring keyseq back) emit))
 511
 512      ((eq its-barf-on-invalid-keyseq 'its-keyseq-test)
 513       'its-keyseq-test-failed)
 514
 515      ;; No next state for KEY.  It's invalid sequence.
 516      (its-barf-on-invalid-keyseq
 517       (its-input-error))
 518
 519      (t
 520       ;; XXX Should make DSYL (instead of VSYL)?
 521       (setq keyseq (concat (its-get-keyseq state) (if (> key 0) (vector key))))
 522       (funcall emit (its-make-VSYL keyseq) state nil)))))
 523
 524 (defvar its-latest-SYL nil "The latest SYL inserted.")
 525
 526 (defsubst its-update-latest-SYL (syl)
 527   (setq its-latest-SYL syl))
 528
 529 ;; Return CURSOR
 530 (defun its-state-machine-keyseq (keyseq emit &optional eol)
 531   (let ((i 0)
 532         (len (length keyseq))
 533         (syl (its-initial-ISYL))
 534         cursor)
 535     (while (< i len)
 536       (cond
 537        ((numberp (cdr syl))
 538         ;; VSYL - no need looping
 539         (funcall emit
 540                  (its-make-VSYL (concat (car syl) (substring keyseq i)))
 541                  syl nil)
 542         (setq cursor nil
 543               i len))
 544        (t
 545         (setq cursor (its-state-machine syl (aref keyseq i) emit))))
 546       (if (eq cursor 'its-keyseq-test-failed)
 547           (setq i len)
 548         (setq syl (if cursor (its-initial-ISYL) its-latest-SYL)
 549               i (1+ i))))
 550     (if (and eol (not (eq cursor 'its-keyseq-test-failed)))
 551         (its-state-machine syl -1 emit)
 552       cursor)))
 553
 554 (defun its-buffer-ins/del-SYL (newsyl oldsyl cursor)
 555   (if its-setup-fence-before-insert-SYL
 556       (progn
 557         (setq its-setup-fence-before-insert-SYL nil)
 558         (its-setup-fence-mode)))
 559   (let ((inhibit-read-only t)
 560         (output (copy-sequence (its-get-output newsyl)))
 561         (face (its-get-fence-face its-current-language)))
 562     (its-buffer-delete-SYL oldsyl)
 563     (its-update-latest-SYL newsyl)
 564     (add-text-properties 0 (length output)
 565                          (list 'its-map its-current-map
 566                                'its-syl newsyl
 567                                'egg-lang its-current-language
 568                                'read-only t
 569                                'intangible 'its-part-1)
 570                          output)
 571     (if face
 572         (egg-set-face 0 (length output) face output))
 573     (insert output)
 574     (its-set-cursor-status cursor)))
 575
 576 (defun its-buffer-delete-SYL (syl)
 577   (let ((len (length (its-get-output syl))))
 578     (delete-region (- (point) len) (point))))
 579
 580 (defun its-get-next-state (state key)
 581   (let ((kst/t (its-get-kst/t state)))
 582     (and (listp kst/t)
 583          (cdr (assq key (car kst/t))))))
 584
 585 ;; XXX XXX XXX
 586 (defun its-otherwise-match (expr key)
 587   (or (null expr)                       ; <expr>::= NIL means "ANY"
 588       (let ((case-fold-search nil))
 589         (string-match expr (char-to-string key)))))
 590
 591 (defun its-get-otherwise (state key)
 592   (let* ((kst/t (its-get-kst/t state))
 593          (ebl (cdr kst/t))
 594          expr-output-back)
 595       (while ebl
 596         (setq expr-output-back (car ebl))
 597         (let ((expr (its-eob-keyexpr expr-output-back)))
 598           (if (its-otherwise-match expr key)
 599               (setq ebl nil)
 600             (setq ebl (cdr ebl)))))
 601       expr-output-back))
 602
 603 (defun its-keyseq-acceptable-p (keyseq &optional syl eol)
 604   (let ((i 0)
 605         (len (length keyseq))
 606         (its-barf-on-invalid-keyseq 'its-keyseq-test)
 607         (its-latest-SYL nil)
 608         (emit (lambda (nsyl osyl cursor)
 609                 (its-update-latest-SYL nsyl)
 610                 cursor))
 611         (its-current-map its-current-map)
 612         (its-current-select-func its-current-select-func)
 613         (its-current-language its-current-language)
 614         (its-zhuyin its-zhuyin)
 615         (its-previous-select-func its-previous-select-func)
 616         cursor)
 617     (if (null syl)
 618         (setq syl (its-initial-ISYL)))
 619     (if (numberp (cdr syl))
 620         nil
 621       (while (and syl (< i len))
 622         (setq cursor (its-state-machine syl (aref keyseq i) emit))
 623         (cond
 624          ((eq cursor 'its-keyseq-test-failed)
 625           (setq syl nil))
 626          (cursor
 627           (setq syl (its-initial-ISYL)))
 628          (t
 629           its-latest-SYL))
 630         (setq i (1+ i)))
 631       (if (and syl eol)
 632           (setq cursor (its-state-machine syl -1 emit)))
 633       (not (eq cursor 'its-keyseq-test-failed)))))
 634 \f
 635 ;;;
 636 ;;; Name --> map
 637 ;;;
 638 ;;; ITS name: string
 639
 640 (defvar its-map-alist nil)
 641
 642 (defun its-get-map (name)
 643   (assoc name its-map-alist))
 644
 645 (defun its-register-map (map)
 646   (let* ((name (car map))
 647          (place (assoc name its-map-alist)))
 648     (if place
 649         (setcdr place (cdr map))
 650       (setq its-map-alist (cons map its-map-alist)))
 651     map))
 652
 653 (defmacro define-its-state-machine (map name indicator lang doc &rest exprs)
 654   (let ((its-current-map map))
 655     (set map (its-new-map name indicator
 656                           (if (eq (car-safe lang) 'quote) (nth 1 lang) lang)))
 657     (eval (cons 'progn exprs))
 658     (set map (its-map-compaction (symbol-value map))))
 659   `(defconst ,map (its-map-rebuild ',(symbol-value map)) ,doc))
 660
 661 (defmacro define-its-state-machine-append (map &rest exprs)
 662   `(let ((func (lambda () (let ((its-current-map ',map)) ,@exprs)))
 663          (hook ',(intern (concat (symbol-name map) "-hook"))))
 664      (if (null (boundp ',map))
 665          (add-hook hook func t)
 666        (funcall func)
 667        (run-hooks hook)
 668        (set hook nil))))
 669
 670 ;; Data structure for map compaction
 671 ;;  <node> ::= (<count> <node#> <original node>)   ; atom
 672 ;;          |  (<count> <node#> (<node> . <node>)) ; cons cell
 673 ;;
 674 ;;  <count> ::= integer  ; 0 or negative - usage count
 675 ;;                       ; positive      - generated common sub-tree
 676 ;;
 677 ;;  <node#> ::= integer  ; subject to compaction
 678 ;;           |  nil      ; not subject to compaction
 679
 680 (defvar its-compaction-enable nil)
 681 (defvar its-compaction-hash-table)
 682 (defvar its-compaction-integer-table)
 683 (defvar its-compaction-counter-1)
 684 (defvar its-compaction-counter-2)
 685 (defvar its-compaction-list)
 686
 687 (defun its-map-compaction (map)
 688   (if its-compaction-enable
 689       (let ((its-compaction-hash-table (make-vector 1000 nil))
 690             (its-compaction-integer-table (make-vector 138 nil))
 691             (its-compaction-counter-1 1)
 692             (its-compaction-counter-2 0)
 693             (its-compaction-list nil))
 694         (its-map-compaction-internal map nil nil)
 695         (cons (vconcat (nreverse its-compaction-list)) map))
 696     map))
 697
 698 (defmacro its-compaction-set-lr (node lr val)
 699   `(if (eq ,lr 'car) (setcar ,node ,val) (setcdr ,node ,val)))
 700
 701 (defmacro its-compaction-new-node ()
 702   '(1- (setq its-compaction-counter-1 (1+ its-compaction-counter-1))))
 703
 704 (defmacro its-compaction-new-cse (node)
 705   `(1- (setq its-compaction-list (cons ,node its-compaction-list)
 706              its-compaction-counter-2 (1+ its-compaction-counter-2))))
 707
 708 (defmacro its-concat (&rest args)
 709   `(concat ,@(mapcar (lambda (arg)
 710                        (if (stringp arg)
 711                            arg
 712                          `(if (numberp ,arg) (number-to-string ,arg) ,arg)))
 713                      args)))
 714
 715 (defmacro its-compaction-hash (name node parent lr type)
 716   (if (null type)
 717       `(let ((hash (intern (its-concat ,@name) its-compaction-hash-table)))
 718          (if (null (boundp hash))
 719              (car (set hash (list* (its-compaction-new-node) ,parent ,lr)))
 720            (setq hash (symbol-value hash))
 721            (if (consp (cdr hash))
 722                (setcdr hash (its-compaction-set-lr
 723                              (cadr hash) (cddr hash)
 724                              (its-compaction-new-cse ,node))))
 725            (its-compaction-set-lr ,parent ,lr (cdr hash))
 726            (car hash)))
 727     `(let ((hash ,(if (eq type 'integer)
 728                       `(intern (its-concat ,@name) its-compaction-hash-table)
 729                     `(aref its-compaction-integer-table (+ ,node 10)))))
 730        (if (null ,(if (eq type 'integer) '(boundp hash) 'hash))
 731            (setq hash (,@(if (eq type 'integer)
 732                              '(set hash)
 733                            `(aset its-compaction-integer-table (+ ,node 10)))
 734                          (cons (its-compaction-new-node)
 735                                (its-compaction-new-cse ,node))))
 736          ,(if (eq type 'integer) '(setq hash (symbol-value hash))))
 737        (its-compaction-set-lr ,parent ,lr (cdr hash))
 738        (car hash))))
 739
 740 (defun its-map-compaction-internal (map parent lr &optional force)
 741   (cond
 742    ((consp map)
 743     (let* ((candidate (or (null (stringp (car map))) (cdr map)))
 744            (sexp (or force (eq (car map) 'eval)))
 745            (l (its-map-compaction-internal (car map) map 'car sexp))
 746            (r (its-map-compaction-internal (cdr map) map 'cdr sexp)))
 747       (if (or sexp (and candidate l r))
 748           (its-compaction-hash (l " " r) map parent lr nil))))
 749    ((stringp map)
 750     (its-compaction-hash ("STR" map) map parent lr nil))
 751    ((integerp map)
 752     (if (and (>= map -10) (< map 128))
 753         (its-compaction-hash nil map parent lr small-int)
 754       (its-compaction-hash ("INT" map) map parent lr integer)))
 755    ((null map) 0)
 756    ((symbolp map)
 757     (its-compaction-hash ("SYM" (symbol-name map)) map parent lr nil))))
 758
 759 (defvar its-map-rebuild-subtrees)
 760
 761 (defun its-map-rebuild (map)
 762   (if (vectorp (car map))
 763       (let ((its-map-rebuild-subtrees (car map))
 764             (len (length (car map)))
 765             (i 0)
 766             node)
 767         (while (< i len)
 768           (setq node (aref its-map-rebuild-subtrees i))
 769           (if (consp node)
 770               (its-map-rebuild-1 node))
 771           (setq i (1+ i)))
 772         (its-map-rebuild-1 (cdr map))
 773         (cdr map))
 774     map))
 775
 776 (defun its-map-rebuild-1 (map)
 777   (let (lr)
 778     (while (consp map)
 779       (if (consp (setq lr (car map)))
 780           (its-map-rebuild-1 lr)
 781         (if (integerp lr)
 782             (setcar map (aref its-map-rebuild-subtrees lr))))
 783       (setq lr map
 784             map (cdr map)))
 785     (if (integerp map)
 786           (setcdr lr (aref its-map-rebuild-subtrees map)))))
 787 \f
 788 ;;
 789 ;; Construct State Machine
 790 ;;
 791 (defun its-defrule (input output &optional back enable-overwrite)
 792   "\e$BF~NO\e(B INPUT \e$B$rG'<1$7\e(B, OUTPUT \e$B$r=PNO$9$k$h$&$K%9%F!<%H%^%7%s$r9=@.$9$k!#\e(B
 793 BACK \e$B$,\e(B(\e$BIi$N\e(B)\e$B@0?t$N;~$O\e(B, OUTPUT \e$B$r=PNO$7$?8e\e(B, BACK \e$B$NJ,\e(B key stroke \e$B$r\e(B
 794 \e$BLa$C$FF0$/$b$N$H$9$k!#JQ495,B'$O$b$C$H$b:G6a$K\e(B its-define-state-machine
 795 \e$B$5$l$?JQ49I=$KEPO?$5$l$k!#\e(B
 796 Return last state."
 797   (let ((state (its-goto-state input (if enable-overwrite t 'dup-check))))
 798     (its-set-output state output)
 799     (its-set-kst state back)
 800     state))
 801
 802 (defun its-defrule* (input output &optional interim-output enable-overwrite)
 803   (let* ((state (its-goto-state input (if enable-overwrite t 'dup-check))))
 804     (its-set-kst state nil)
 805     (its-set-interim-terminal-state state output)
 806     (if interim-output
 807         (its-set-output state interim-output))
 808     state))
 809
 810 (defvar its-parent-states)
 811
 812 (defun its-goto-state (input &optional build-if-none)
 813   (let ((len (length input))
 814         (i 0)
 815         (state (its-initial-ISYL))
 816         brand-new next-state key)
 817     (setq its-parent-states nil)
 818     (while (< i len)
 819       (setq its-parent-states (cons state its-parent-states)
 820             key (aref input i)
 821             i (1+ i)
 822             next-state (its-get-next-state state key))
 823       (cond
 824        (next-state
 825         (setq state next-state))
 826        ((null build-if-none)
 827         (error "No such state (%s)" input))
 828        (t
 829         (if (not (or brand-new (= i 1) (its-get-kst/t state)))
 830             (its-set-interim-terminal-state state))
 831         (setq state (its-make-next-state state key
 832                                          (concat (its-get-output state)
 833                                                  (list key)))
 834               brand-new t))))
 835     (if (and (eq build-if-none 'dup-check) (null brand-new))
 836         (error "Duplicated definition (%s)" input))
 837     state))
 838
 839 (defun its-set-interim-terminal-state (state &optional output)
 840   (its-make-next-state state -1 (or output (its-get-output state t)))
 841   (its-defrule-otherwise state output))
 842
 843 (defun its-defoutput (input display)
 844   (let ((state (its-goto-state input)))
 845     (its-set-output state display)))
 846
 847 (defun its-define-otherwise (state otherwise)
 848   (let ((kst (its-get-kst/t state)))
 849     (if kst
 850         (setcdr kst (cons otherwise (cdr kst)))
 851       (its-set-kst state (cons nil (cons otherwise nil))))))
 852
 853 (defun its-defrule-otherwise (state output &optional class back)
 854   (its-define-otherwise
 855    state
 856    (its-make-otherwise output (its-make-class+back class (or back -1)))))
 857
 858 (defun its-make-next-state (state key output &optional back)
 859   (let ((next-state (its-new-state output
 860                                    (concat (its-get-keyseq state)
 861                                            (if (> key 0) (list key)))
 862                                    back))
 863         (kst (its-get-kst/t state)))
 864     (cond
 865      ((null kst)
 866       (its-set-kst state (list (list (cons key next-state)))))
 867      ((consp kst)
 868       (setcar kst (cons (cons key next-state) (car kst))))
 869      (t
 870       (error "Can't make new state after %S" (its-get-keyseq state))))
 871     next-state))
 872
 873 (defmacro its-defrule-select-mode-temporally (input select-func)
 874   `(its-defrule ,input '(its-select-mode-temporally
 875                          ,(intern (concat "its-select-"
 876                                           (symbol-name select-func))))
 877                 t))
 878 \f
 879 ;;;
 880 (defun its-set-part-1 (beg end)
 881   (let ((inhibit-point-motion-hooks t)
 882         (str (buffer-substring beg end)))
 883     (goto-char beg)
 884     (delete-region beg end)
 885     (put-text-property 0 (- end beg) 'intangible 'its-part-1 str)
 886     (insert str)))
 887
 888 (defun its-set-part-2 (beg end)
 889   (let ((inhibit-point-motion-hooks t)
 890         (str (buffer-substring beg end)))
 891     (goto-char beg)
 892     (delete-region beg end)
 893     (put-text-property 0 (- end beg) 'intangible 'its-part-2 str)
 894     (insert str)))
 895
 896 (defun its-search-beginning ()
 897   (if (get-text-property (1- (point)) 'its-start)
 898       (point)
 899     (previous-single-property-change (point) 'its-start)))
 900
 901 (defun its-search-end ()
 902   (if (get-text-property (point) 'its-end)
 903       (point)
 904     (next-single-property-change (point) 'its-end)))
 905
 906 (defun its-beginning-of-input-buffer ()
 907   (interactive)
 908   (let ((inhibit-read-only t))
 909     (its-input-end)
 910     (let ((begpos (its-search-beginning)))
 911       (its-set-part-2 begpos (point))
 912       (goto-char begpos))
 913     (its-put-cursor t)))
 914
 915 (defun its-end-of-input-buffer ()
 916   (interactive)
 917   (let ((inhibit-read-only t))
 918     (its-input-end)
 919     (let ((endpos (its-search-end)))
 920       (its-set-part-1 (point) endpos)
 921       (goto-char endpos))
 922     (its-put-cursor t)))
 923
 924 (defun its-kill-line (n)
 925   (interactive "p")
 926   (let ((inhibit-read-only t))
 927     (its-input-end)
 928     (if (> n 0)
 929         (if (= (its-search-beginning) (point))
 930             (its-cancel-input)
 931           (delete-region (its-search-end) (point))
 932           (its-put-cursor t))
 933       (if (= (its-search-end) (point))
 934           (its-cancel-input)
 935         (delete-region (its-search-beginning) (point))
 936         (its-put-cursor t)))))
 937
 938 (defun its-cancel-input ()
 939   (interactive)
 940   (let ((inhibit-read-only t))
 941     (delete-region (its-search-beginning) (its-search-end))
 942     (its-put-cursor t)
 943     (its-exit-mode-internal)))
 944
 945 ;; TODO: move in VSYL
 946 (defun its-backward-SYL (n)
 947   (interactive "p")
 948   (let ((inhibit-read-only t)
 949         syl p old-point)
 950     (its-input-end)
 951     (setq syl (get-text-property (1- (point)) 'its-syl)
 952           p (point)
 953           old-point (point))
 954     (while (and syl (> n 0))
 955       (setq p (- p (length (its-get-output syl))))
 956       (setq syl (get-text-property (1- p) 'its-syl))
 957       (setq n (1- n)))
 958     ;; Make SYLs have property of "part 2"
 959     (its-set-part-2 p old-point)
 960     (goto-char p)
 961     (its-put-cursor t)
 962     (if (> n 0)
 963         (signal 'beginning-of-buffer nil))))
 964
 965 ;; TODO: move in VSYL
 966 (defun its-forward-SYL (n)
 967   (interactive "p")
 968   (let ((inhibit-read-only t)
 969         syl p old-point)
 970     (its-input-end)
 971     (setq syl (get-text-property (point) 'its-syl)
 972           p (point)
 973           old-point (point))
 974     (while (and syl (> n 0))
 975       (setq p (+ p (length (its-get-output syl))))
 976       (setq syl (get-text-property p 'its-syl))
 977       (setq n (1- n)))
 978     ;; Make SYLs have property of "part 1"
 979     (its-set-part-1 old-point p)
 980     (goto-char p)
 981     (its-put-cursor t)
 982     (if (> n 0)
 983         (signal 'end-of-buffer nil))))
 984
 985 ;; TODO: handle VSYL.  KILLFLAG
 986 (defun its-delete-SYL (n killflag)
 987   (interactive "p\nP")
 988   (let ((inhibit-read-only t)
 989         syl p)
 990     (its-input-end)
 991     (setq syl (get-text-property (point) 'its-syl)
 992           p (point))
 993     (while (and syl (> n 0))
 994       (setq p (+ p (length (its-get-output syl))))
 995       (setq syl (get-text-property p 'its-syl))
 996       (setq n (1- n)))
 997     (if (> n 0)
 998         (progn
 999           (its-put-cursor t)
1000           (signal 'end-of-buffer nil))
1001       (delete-region (point) p)
1002       (its-put-cursor t)
1003       (its-exit-mode-if-empty))))
1004
1005 ;; TODO: killflag
1006 (defun its-delete-backward-SYL (n killflag)
1007   (interactive "p\nP")
1008   (let ((inhibit-read-only t)
1009         (syl (get-text-property (1- (point)) 'its-syl))
1010         (cursor (get-text-property (point) 'its-cursor)))
1011     (if (null syl)
1012         (signal 'beginning-of-buffer nil)
1013       (if (eq cursor t)
1014           (its-delete-backward-SYL-internal n killflag)
1015         (its-delete-backward-within-SYL syl n killflag)))))
1016
1017 ;; TODO: killflag
1018 (defun its-delete-backward-SYL-internal (n killflag)
1019   (let ((syl (get-text-property (1- (point)) 'its-syl))
1020         (p (point)))
1021     (while (and syl (> n 0))
1022       (setq p (- p (length (its-get-output syl))))
1023       (setq syl (get-text-property (1- p) 'its-syl))
1024       (setq n (1- n)))
1025     (if (> n 0)
1026         (signal 'beginning-of-buffer nil)
1027       (delete-region p (1+ (point)))    ; also delete cursor
1028       (its-put-cursor t)
1029       (its-exit-mode-if-empty))))
1030
1031 (defun its-delete-backward-SYL-by-keystroke (n killflag)
1032   (interactive "p\nP")
1033   (let ((inhibit-read-only t)
1034         (its-delete-by-keystroke t))
1035     (its-delete-backward-SYL n killflag)))
1036
1037 ;; TODO: killflag
1038 (defun its-delete-backward-within-SYL (syl n killflag)
1039   (let* ((keyseq (its-get-keyseq-syl syl))
1040          (len (length keyseq))
1041          (p (- (point) (length (its-get-output syl))))
1042          (its-current-map (get-text-property (1- (point)) 'its-map))
1043          (its-current-language (get-text-property (1- (point)) 'egg-lang))
1044          back pp)
1045     (if (< n 0)
1046         (signal 'args-out-of-range (list (- (point) n) (point))))
1047     (if its-delete-by-keystroke
1048         (while (null (or (eq p pp) (its-concrete-DSYL-p syl)))
1049           (setq pp p)
1050           (while (and (setq syl (get-text-property (1- p) 'its-syl))
1051                       (its-DSYL-with-back-p syl)
1052                       (<= (setq back (- (its-get-kst/t syl))) len)
1053                       (> back (- len n))
1054                       (equal (substring (its-get-keyseq syl) (- back))
1055                              (substring keyseq 0 back)))
1056             (setq keyseq (concat (its-get-keyseq-syl syl) keyseq)
1057                   len (length keyseq)
1058                   p (- p (length (its-get-output syl)))))
1059           (if (and (eq p pp) syl (> n len))
1060               (setq n (- n len)
1061                     keyseq (its-get-keyseq-syl syl)
1062                     len (length keyseq)
1063                     p (- p (length (its-get-output syl))))))
1064       (if (and (> n len) (its-concrete-DSYL-p syl))
1065           (setq len 1)))
1066     (if (> n len)
1067         (setq n (- n len)
1068               len 0))
1069     (while (and (> n len) (setq syl (get-text-property (1- p) 'its-syl)))
1070       (setq n (1- n)
1071             p (- p (length (its-get-output syl)))))
1072     (if (> n len)
1073         (signal 'beginning-of-buffer nil))
1074     (delete-region p (point))
1075     (if (> len n)
1076         (its-state-machine-keyseq (substring keyseq 0 (- len n))
1077                                   'its-buffer-ins/del-SYL)
1078       (its-set-cursor-status
1079        (if (or (null its-delete-by-keystroke)
1080                (its-concrete-DSYL-p (get-text-property (1- p) 'its-syl)))
1081            t
1082          'its-cursor))))
1083   ;; exit its mode after unbind variables
1084   (its-exit-mode-if-empty))
1085
1086 (defun its-transpose-chars (n)
1087   (interactive "p")
1088   (let ((inhibit-read-only t)
1089         (syl (get-text-property (1- (point)) 'its-syl))
1090         (cursor (get-text-property (point) 'its-cursor))
1091         keyseq len)
1092     (cond
1093      ((null syl)
1094       (signal 'beginning-of-buffer nil))
1095      ((eq cursor t)
1096       (if (and (= n 1) (get-text-property (1+ (point)) 'its-end))
1097           (progn
1098             (its-backward-SYL 1)
1099             (setq syl (get-text-property (1- (point)) 'its-syl))
1100             (if (null syl)
1101                 (signal 'beginning-of-buffer nil))))
1102       (its-buffer-delete-SYL syl)
1103       (while (> n 0)
1104         (if (get-text-property (1+ (point)) 'its-end)
1105             (progn
1106               (its-buffer-ins/del-SYL syl nil t)
1107               (signal 'end-of-buffer nil)))
1108         (its-forward-SYL 1)
1109         (setq n (1- n)))
1110       (while (< n 0)
1111         (if (get-text-property (1- (point)) 'its-start)
1112             (progn
1113               (its-buffer-ins/del-SYL syl nil t)
1114               (signal 'beginning-of-buffer nil)))
1115         (its-backward-SYL 1)
1116         (setq n (1+ n)))
1117       (its-buffer-ins/del-SYL syl nil t))
1118      (t
1119       (setq keyseq (its-get-keyseq-syl syl)
1120             len (length keyseq))
1121       (cond
1122        ((or (> n 1) (<= len 1))
1123         (signal 'end-of-buffer nil))
1124        ((>= (- n) len)
1125         (signal 'beginning-of-buffer nil))
1126        (t
1127         (setq n (if (> n 0) (- -1 n) (1- n)))
1128         (setq keyseq (concat (substring keyseq 0 n)
1129                              (substring keyseq -1)
1130                              (substring keyseq n -1)))
1131         (if (and its-barf-on-invalid-keyseq
1132                  (null (its-keyseq-acceptable-p keyseq)))
1133             (its-input-error))
1134         (delete-region (- (point) (length (its-get-output syl))) (point))
1135         (its-state-machine-keyseq keyseq 'its-buffer-ins/del-SYL)))))))
1136
1137 (defun its-yank (&optional arg)
1138   (interactive "*P")
1139   (let ((inhibit-read-only t))
1140     (its-input-end)
1141     (yank arg)
1142     (its-setup-yanked-portion (region-beginning) (region-end))))
1143
1144 (defun its-yank-pop (arg)
1145   (interactive "*p")
1146   (let ((inhibit-read-only t))
1147     (its-input-end)
1148     (yank-pop arg)
1149     (its-setup-yanked-portion (region-beginning) (region-end))))
1150
1151 (defun its-setup-yanked-portion (start end)
1152   (let ((yank-before (eq (point) end))
1153         syl face lang source no-prop-source len i j l)
1154     (setq source (buffer-substring start end)
1155           no-prop-source (buffer-substring-no-properties start end)
1156           len (length source))
1157     (remove-text-properties 0 len '(intangible nil) source)
1158     (egg-separate-languages source (get-text-property (1- start) 'egg-lang))
1159     (setq i 0)
1160     (while (< i len)
1161       (setq lang (get-text-property i 'egg-lang source))
1162       (if (or (and (or (eq lang 'Chinese-GB) (eq lang 'Chinese-CNS))
1163                    (setq l (egg-chinese-syllable source i)))
1164               (and (setq l (get-text-property i 'composition source))
1165                    (setq l (if (consp (car l)) (caar l) (cadr l)))
1166                    (eq (next-single-property-change i 'composition
1167                                                     source (length source))
1168                        l)))
1169              (setq j (+ i l))
1170         (setq j (+ i (egg-char-bytes (egg-string-to-char-at source i)))))
1171       (setq syl (substring no-prop-source i j))
1172       (put-text-property i j 'its-syl (cons syl syl) source)
1173       (setq i j))
1174     (if its-fence-face
1175         (progn
1176           (setq i 0)
1177           (while (< i len)
1178             (setq j (egg-next-single-property-change i 'egg-lang source len)
1179                   face (its-get-fence-face
1180                         (get-text-property i 'egg-lang source)))
1181             (if face
1182                 (egg-set-face i j face source))
1183             (setq i j))))
1184     (delete-region start end)
1185     (if yank-before
1186         (progn
1187           (add-text-properties 0 len '(read-only t intangible its-part-1) source)
1188           (insert source))
1189       (add-text-properties 0 len '(read-only t intangible its-part-2) source)
1190       (insert source)
1191       (set-marker (mark-marker) (point) (current-buffer))
1192       (goto-char start))
1193     (its-put-cursor t)))
1194
1195 ;; Return VOID
1196 (defun its-input-end ()
1197   (if (null (eq its-barf-on-invalid-keyseq 'its-keyseq-test))
1198       (let ((cursor (get-text-property (point) 'its-cursor)))
1199         ;; key "END"
1200         (if (null cursor)
1201             (let ((its-current-language (get-text-property (1- (point))
1202                                                            'egg-lang)))
1203               (its-input (get-text-property (1- (point)) 'its-syl) -1)))
1204         (delete-region (point) (1+ (point))))))
1205
1206 (defun its-exit-mode ()
1207   "Exit ITS mode."
1208   (interactive)
1209   (if (its-in-fence-p)
1210       (let ((inhibit-read-only t))
1211         (its-input-end)
1212         (its-put-cursor t)
1213         (its-exit-mode-internal))
1214     (its-select-previous-mode t)))
1215
1216 (defun its-exit-mode-if-empty ()
1217   (and (get-text-property (1- (point)) 'its-start)
1218        (get-text-property (1+ (point)) 'its-end)
1219        (its-exit-mode-internal)))
1220
1221 ;; TODO: handle overwrite-mode, insertion-hook, fill...
1222 (defun its-exit-mode-internal (&optional proceed-to-conversion n)
1223   (let (start end s context str)
1224     (its-select-previous-mode t)
1225     ;; Delete CURSOR
1226     (delete-region (point) (1+ (point)))
1227     ;; Delete open fence
1228     (setq s (its-search-beginning)
1229           start (previous-single-property-change s 'its-start nil (point-min))
1230           context (get-text-property start 'its-context))
1231     (delete-region start s)
1232     ;; Delete close fence
1233     (setq end (its-search-end))
1234     (delete-region end
1235                    (next-single-property-change end 'its-end nil (point-max)))
1236     (if proceed-to-conversion
1237         (egg-convert-region start end context n)
1238       ;; Remove all properties
1239       (goto-char start)
1240       (setq str (buffer-substring start end))
1241       (egg-remove-all-text-properties 0 (length str) str)
1242       (delete-region start end)
1243       (insert str)
1244       (egg-do-auto-fill)
1245       (run-hooks 'input-method-after-insert-chunk-hook))))
1246
1247 (defun its-kick-convert-region (&optional n)
1248   (interactive "P")
1249   (let ((inhibit-read-only t))
1250     (its-input-end)
1251     (its-put-cursor t)
1252     (its-exit-mode-internal t n)))
1253
1254 (defun its-kick-convert-region-or-self-insert (&optional n)
1255   (interactive "P")
1256   (let ((syl (and (null (get-text-property (point) 'its-cursor))
1257                   (get-text-property (1- (point)) 'its-syl))))
1258     (if (its-keyseq-acceptable-p (vector last-command-char) syl)
1259         (its-self-insert-char)
1260       (its-kick-convert-region n))))
1261
1262 (defun its-in-fence-p ()
1263   (and (eq (get-text-property (point) 'intangible) 'its-part-2)
1264        (get-text-property (point) 'read-only)))
1265 \f
1266 (defvar its-translation-result "" "")
1267
1268 (defun its-ins/del-SYL-batch (newsyl oldsyl cursor)
1269   (its-update-latest-SYL newsyl)
1270   (if (and newsyl
1271            (consp (cdr newsyl))
1272            (not (its-kst-p (its-get-kst/t newsyl))))
1273       ;; DSYL
1274       (let ((output (its-get-output newsyl))
1275             (oldlen (length its-translation-result)))
1276         (setq its-translation-result (concat its-translation-result output))
1277         (put-text-property oldlen (length its-translation-result)
1278                            'egg-lang its-current-language
1279                            its-translation-result)))
1280   cursor)
1281
1282 (defun its-translate-region (start end)
1283   (interactive "r")
1284   (its-translate-region-internal start end)
1285   (egg-remove-all-text-properties start (point)))
1286
1287 (defun its-translate-region-internal (start end)
1288   (setq its-translation-result "")
1289   (goto-char start)
1290   (let ((i 0)
1291         (syl (its-initial-ISYL))
1292         ;; temporally enable DING
1293         (its-barf-on-invalid-keyseq t)
1294         cursor)
1295     (while (< (point) end)
1296       (let ((key (following-char)))
1297         (setq cursor (its-state-machine syl key 'its-ins/del-SYL-batch))
1298         (forward-char 1)
1299         (if cursor
1300             (setq syl (its-initial-ISYL))
1301           (setq syl its-latest-SYL))))
1302     (if (eq syl its-latest-SYL)
1303         (its-state-machine syl -1 'its-ins/del-SYL-batch))
1304     (delete-region start end)
1305     (insert its-translation-result)))
1306 \f
1307 (defun its-set-mode-line-title ()
1308   (let ((title (its-get-indicator (symbol-value its-current-map))))
1309     (setq current-input-method-title (if its-previous-select-func
1310                                          (concat "<" title ">")
1311                                        title))
1312     (force-mode-line-update)))
1313
1314 (defun its-select-mode-temporally (func)
1315   (let ((select-func its-current-select-func))
1316     (let ((its-previous-select-func t))
1317       (funcall func))
1318     (if (null its-previous-select-func)
1319         (setq its-previous-select-func select-func))
1320     (its-set-mode-line-title)))
1321
1322 (defun its-select-previous-mode (&optional quiet)
1323   (interactive)
1324   (if (null its-previous-select-func)
1325       (if (null quiet)
1326           (beep))
1327     (funcall its-previous-select-func)
1328     (setq its-previous-select-func nil)
1329     (its-set-mode-line-title)))
1330
1331 (defun its-set-stroke-input (alist)
1332   (let ((a alist))
1333     (while a
1334       (setq its-stroke-input-alist
1335             (delq (assq (caar a) its-stroke-input-alist)
1336                   its-stroke-input-alist))
1337       (setq a (cdr a)))
1338     (setq its-stroke-input-alist
1339           (append alist its-stroke-input-alist))))
1340
1341 ;;; its-hiragana : hiragana-region for input-buffer
1342 (defun its-hiragana ()
1343   (interactive)
1344   (its-convert (lambda (str lang) (japanese-hiragana str))))
1345
1346 ;;; its-katakana : katanaka-region for input-buffer
1347 (defun its-katakana ()
1348   (interactive)
1349   (its-convert (lambda (str lang) (japanese-katakana str))))
1350
1351 (defconst its-full-half-table (make-vector 100 nil))
1352 (defconst its-half-full-table (make-vector 100 nil))
1353
1354 (let ((table '((Japanese
1355                 (?\e$B!!\e(B . ?\ ) (?\e$B!$\e(B . ?,)  (?\e$B!%\e(B . ?.)  (?\e$B!"\e(B . ?,)  (?\e$B!#\e(B . ?.)
1356                 (?\e$B!'\e(B . ?:)  (?\e$B!(\e(B . ?\;) (?\e$B!)\e(B . ??)  (?\e$B!*\e(B . ?!)
1357                 (?\e$B!-\e(B . ?')  (?\e$B!.\e(B . ?`)  (?\e$B!0\e(B . ?^)  (?\e$B!2\e(B . ?_)  (?\e$B!1\e(B . ?~)
1358                 (?\e$B!<\e(B . ?-)  (?\e$B!=\e(B . ?-)  (?\e$B!>\e(B . ?-)
1359                 (?\e$B!?\e(B . ?/)  (?\e$B!@\e(B . ?\\) (?\e$B!A\e(B . ?~)  (?\e$B!C\e(B . ?|)
1360                 (?\e$B!F\e(B . ?`)  (?\e$B!G\e(B . ?')  (?\e$B!H\e(B . ?\") (?\e$B!I\e(B . ?\")
1361                 (?\e$B!J\e(B . ?\() (?\e$B!K\e(B . ?\)) (?\e$B!N\e(B . ?[)  (?\e$B!O\e(B . ?])
1362                 (?\e$B!P\e(B . ?{)  (?\e$B!Q\e(B . ?})  (?\e$B!R\e(B . ?<)  (?\e$B!S\e(B . ?>)
1363                 (?\e$B!\\e(B . ?+)  (?\e$B!]\e(B . ?-)  (?\e$B!a\e(B . ?=)  (?\e$B!c\e(B . ?<)  (?\e$B!d\e(B . ?>)
1364                 (?\e$B!l\e(B . ?')  (?\e$B!m\e(B . ?\") (?\e$B!o\e(B . ?\\) (?\e$B!p\e(B . ?$)  (?\e$B!s\e(B . ?%)
1365                 (?\e$B!t\e(B . ?#)  (?\e$B!u\e(B . ?&)  (?\e$B!v\e(B . ?*)  (?\e$B!w\e(B . ?@)
1366                 (?\e$B#0\e(B . ?0)  (?\e$B#1\e(B . ?1)  (?\e$B#2\e(B . ?2)  (?\e$B#3\e(B . ?3)  (?\e$B#4\e(B . ?4)
1367                 (?\e$B#5\e(B . ?5)  (?\e$B#6\e(B . ?6)  (?\e$B#7\e(B . ?7)  (?\e$B#8\e(B . ?8)  (?\e$B#9\e(B . ?9)
1368                 (?\e$B#A\e(B . ?A)  (?\e$B#B\e(B . ?B)  (?\e$B#C\e(B . ?C)  (?\e$B#D\e(B . ?D)  (?\e$B#E\e(B . ?E)
1369                 (?\e$B#F\e(B . ?F)  (?\e$B#G\e(B . ?G)  (?\e$B#H\e(B . ?H)  (?\e$B#I\e(B . ?I)  (?\e$B#J\e(B . ?J)
1370                 (?\e$B#K\e(B . ?K)  (?\e$B#L\e(B . ?L)  (?\e$B#M\e(B . ?M)  (?\e$B#N\e(B . ?N)  (?\e$B#O\e(B . ?O)
1371                 (?\e$B#P\e(B . ?P)  (?\e$B#Q\e(B . ?Q)  (?\e$B#R\e(B . ?R)  (?\e$B#S\e(B . ?S)  (?\e$B#T\e(B . ?T)
1372                 (?\e$B#U\e(B . ?U)  (?\e$B#V\e(B . ?V)  (?\e$B#W\e(B . ?W)  (?\e$B#X\e(B . ?X)  (?\e$B#Y\e(B . ?Y)
1373                 (?\e$B#Z\e(B . ?Z)
1374                 (?\e$B#a\e(B . ?a)  (?\e$B#b\e(B . ?b)  (?\e$B#c\e(B . ?c)  (?\e$B#d\e(B . ?d)  (?\e$B#e\e(B . ?e)
1375                 (?\e$B#f\e(B . ?f)  (?\e$B#g\e(B . ?g)  (?\e$B#h\e(B . ?h)  (?\e$B#i\e(B . ?i)  (?\e$B#j\e(B . ?j)
1376                 (?\e$B#k\e(B . ?k)  (?\e$B#l\e(B . ?l)  (?\e$B#m\e(B . ?m)  (?\e$B#n\e(B . ?n)  (?\e$B#o\e(B . ?o)
1377                 (?\e$B#p\e(B . ?p)  (?\e$B#q\e(B . ?q)  (?\e$B#r\e(B . ?r)  (?\e$B#s\e(B . ?s)  (?\e$B#t\e(B . ?t)
1378                 (?\e$B#u\e(B . ?u)  (?\e$B#v\e(B . ?v)  (?\e$B#w\e(B . ?w)  (?\e$B#x\e(B . ?x)  (?\e$B#y\e(B . ?y)
1379                 (?\e$B#z\e(B . ?z))
1380                (Chinese-GB
1381                 (?\e$A!!\e(B . ?\ ) (?\e$A#,\e(B . ?,)  (?\e$A#.\e(B . ?.)  (?\e$A!"\e(B . ?,)  (?\e$A!#\e(B . ?.)
1382                 (?\e$A#:\e(B . ?:)  (?\e$A#;\e(B . ?\;) (?\e$A#?\e(B . ??)  (?\e$A#!\e(B . ?!)
1383                 (?\e$A#`\e(B . ?`)  (?\e$A#^\e(B . ?^)  (?\e$A#_\e(B . ?_)  (?\e$A#~\e(B . ?~)
1384                 (?\e$A!*\e(B . ?-)
1385                 (?\e$A#/\e(B . ?/)  (?\e$A#\\e(B . ?\\) (?\e$A!+\e(B . ?~)  (?\e$A#|\e(B . ?|)
1386                 (?\e$A!.\e(B . ?`)  (?\e$A!/\e(B . ?')  (?\e$A!0\e(B . ?\") (?\e$A!1\e(B . ?\")
1387                 (?\e$A#(\e(B . ?\() (?\e$A#)\e(B . ?\)) (?\e$A#[\e(B . ?[)  ( ?\e$A#]\e(B . ?])
1388                 (?\e$A#{\e(B . ?{)  (?\e$A#}\e(B . ?})
1389                 (?\e$A#+\e(B . ?+)  (?\e$A#-\e(B . ?-)  (?\e$A#=\e(B . ?=)  (?\e$A#<\e(B . ?<)  (?\e$A#>\e(B . ?>)
1390                 (?\e$A#'\e(B . ?')  (?\e$A#"\e(B . ?\") (?\e$A#$\e(B . ?$)  (?\e$A#%\e(B . ?%)
1391                 (?\e$A##\e(B . ?#)  (?\e$A#&\e(B . ?&)  (?\e$A#*\e(B . ?*)  (?\e$A#@\e(B . ?@)
1392                 (?\e$A#0\e(B . ?0)  (?\e$A#1\e(B . ?1)  (?\e$A#2\e(B . ?2)  (?\e$A#3\e(B . ?3)  (?\e$A#4\e(B . ?4)
1393                 (?\e$A#5\e(B . ?5)  (?\e$A#6\e(B . ?6)  (?\e$A#7\e(B . ?7)  (?\e$A#8\e(B . ?8)  (?\e$A#9\e(B . ?9)
1394                 (?\e$A#A\e(B . ?A)  (?\e$A#B\e(B . ?B)  (?\e$A#C\e(B . ?C)  (?\e$A#D\e(B . ?D)  (?\e$A#E\e(B . ?E)
1395                 (?\e$A#F\e(B . ?F)  (?\e$A#G\e(B . ?G)  (?\e$A#H\e(B . ?H)  (?\e$A#I\e(B . ?I)  (?\e$A#J\e(B . ?J)
1396                 (?\e$A#K\e(B . ?K)  (?\e$A#L\e(B . ?L)  (?\e$A#M\e(B . ?M)  (?\e$A#N\e(B . ?N)  (?\e$A#O\e(B . ?O)
1397                 (?\e$A#P\e(B . ?P)  (?\e$A#Q\e(B . ?Q)  (?\e$A#R\e(B . ?R)  (?\e$A#S\e(B . ?S)  (?\e$A#T\e(B . ?T)
1398                 (?\e$A#U\e(B . ?U)  (?\e$A#V\e(B . ?V)  (?\e$A#W\e(B . ?W)  (?\e$A#X\e(B . ?X)  (?\e$A#Y\e(B . ?Y)
1399                 (?\e$A#Z\e(B . ?Z)
1400                 (?\e$A#a\e(B . ?a)  (?\e$A#b\e(B . ?b)  (?\e$A#c\e(B . ?c)  (?\e$A#d\e(B . ?d)  (?\e$A#e\e(B . ?e)
1401                 (?\e$A#f\e(B . ?f)  (?\e$A#g\e(B . ?g)  (?\e$A#h\e(B . ?h)  (?\e$A#i\e(B . ?i)  (?\e$A#j\e(B . ?j)
1402                 (?\e$A#k\e(B . ?k)  (?\e$A#l\e(B . ?l)  (?\e$A#m\e(B . ?m)  (?\e$A#n\e(B . ?n)  (?\e$A#o\e(B . ?o)
1403                 (?\e$A#p\e(B . ?p)  (?\e$A#q\e(B . ?q)  (?\e$A#r\e(B . ?r)  (?\e$A#s\e(B . ?s)  (?\e$A#t\e(B . ?t)
1404                 (?\e$A#u\e(B . ?u)  (?\e$A#v\e(B . ?v)  (?\e$A#w\e(B . ?w)  (?\e$A#x\e(B . ?x)  (?\e$A#y\e(B . ?y)
1405                 (?\e$A#z\e(B . ?z))
1406                (Chinese-CNS
1407                 (?\e$(G!!\e(B . ?\ ) (?\e$(G!"\e(B . ?,)  (?\e$(G!%\e(B . ?.)  (?\e$(G!#\e(B . ?,)  (?\e$(G!$\e(B . ?.)
1408                 (?\e$(G!(\e(B . ?:)  (?\e$(G!'\e(B . ?\;) (?\e$(G!)\e(B . ??)  (?\e$(G!*\e(B . ?!)
1409                 (?\e$(G!k\e(B . ?')  (?\e$(G!j\e(B . ?`)  (?\e$(G!T\e(B . ?^)  (?\e$(G"%\e(B . ?_)  (?\e$(G"#\e(B . ?~)
1410                 (?\e$(G"@\e(B . ?-)
1411                 (?\e$(G"_\e(B . ?/)  (?\e$(G"`\e(B . ?\\) (?\e$(G"a\e(B . ?/)  (?\e$(G"b\e(B . ?\\)
1412                 (?\e$(G"D\e(B . ?~)  (?\e$(G"^\e(B . ?|)
1413                 (?\e$(G!d\e(B . ?`)  (?\e$(G!e\e(B . ?')
1414                 (?\e$(G!h\e(B . ?\") (?\e$(G!i\e(B . ?\") (?\e$(G!f\e(B . ?\") (?\e$(G!g\e(B . ?\")
1415                 (?\e$(G!>\e(B . ?\() (?\e$(G!?\e(B . ?\))
1416                 (?\e$(G!F\e(B . ?[)  (?\e$(G!G\e(B . ?])  (?\e$(G!b\e(B . ?[)  (?\e$(G!c\e(B . ?])
1417                 (?\e$(G!B\e(B . ?{)  (?\e$(G!C\e(B . ?})  (?\e$(G!`\e(B . ?{)  (?\e$(G!a\e(B . ?})
1418                 (?\e$(G!R\e(B . ?<)  (?\e$(G!S\e(B . ?>)
1419                 (?\e$(G"0\e(B . ?+)  (?\e$(G"1\e(B . ?-)  (?\e$(G"8\e(B . ?=)  (?\e$(G"6\e(B . ?<)  (?\e$(G"7\e(B . ?>)
1420                 (?\e$(G"c\e(B . ?$)  (?\e$(G"h\e(B . ?%)
1421                 (?\e$(G!l\e(B . ?#)  (?\e$(G!m\e(B . ?&)  (?\e$(G!n\e(B . ?*)  (?\e$(G"i\e(B . ?@)
1422                 (?\e$(G$!\e(B . ?0)  (?\e$(G$"\e(B . ?1)  (?\e$(G$#\e(B . ?2)  (?\e$(G$$\e(B . ?3)  (?\e$(G$%\e(B . ?4)
1423                 (?\e$(G$&\e(B . ?5)  (?\e$(G$'\e(B . ?6)  (?\e$(G$(\e(B . ?7)  (?\e$(G$)\e(B . ?8)  (?\e$(G$*\e(B . ?9)
1424                 (?\e$(G$A\e(B . ?A)  (?\e$(G$B\e(B . ?B)  (?\e$(G$C\e(B . ?C)  (?\e$(G$D\e(B . ?D)  (?\e$(G$E\e(B . ?E)
1425                 (?\e$(G$F\e(B . ?F)  (?\e$(G$G\e(B . ?G)  (?\e$(G$H\e(B . ?H)  (?\e$(G$I\e(B . ?I)  (?\e$(G$J\e(B . ?J)
1426                 (?\e$(G$K\e(B . ?K)  (?\e$(G$L\e(B . ?L)  (?\e$(G$M\e(B . ?M)  (?\e$(G$N\e(B . ?N)  (?\e$(G$O\e(B . ?O)
1427                 (?\e$(G$P\e(B . ?P)  (?\e$(G$Q\e(B . ?Q)  (?\e$(G$R\e(B . ?R)  (?\e$(G$S\e(B . ?S)  (?\e$(G$T\e(B . ?T)
1428                 (?\e$(G$U\e(B . ?U)  (?\e$(G$V\e(B . ?V)  (?\e$(G$W\e(B . ?W)  (?\e$(G$X\e(B . ?X)  (?\e$(G$Y\e(B . ?Y)
1429                 (?\e$(G$Z\e(B . ?Z)
1430                 (?\e$(G$[\e(B . ?a)  (?\e$(G$\\e(B . ?b)  (?\e$(G$]\e(B . ?c)  (?\e$(G$^\e(B . ?d)  (?\e$(G$_\e(B . ?e)
1431                 (?\e$(G$`\e(B . ?f)  (?\e$(G$a\e(B . ?g)  (?\e$(G$b\e(B . ?h)  (?\e$(G$c\e(B . ?i)  (?\e$(G$d\e(B . ?j)
1432                 (?\e$(G$e\e(B . ?k)  (?\e$(G$f\e(B . ?l)  (?\e$(G$g\e(B . ?m)  (?\e$(G$h\e(B . ?n)  (?\e$(G$i\e(B . ?o)
1433                 (?\e$(G$j\e(B . ?p)  (?\e$(G$k\e(B . ?q)  (?\e$(G$l\e(B . ?r)  (?\e$(G$m\e(B . ?s)  (?\e$(G$n\e(B . ?t)
1434                 (?\e$(G$o\e(B . ?u)  (?\e$(G$p\e(B . ?v)  (?\e$(G$q\e(B . ?w)  (?\e$(G$r\e(B . ?x)  (?\e$(G$s\e(B . ?y)
1435                 (?\e$(G$t\e(B . ?z))
1436                (Korean
1437                 (?\e$(C!!\e(B . ?\ ) (?\e$(C#,\e(B . ?,)  (?\e$(C#.\e(B . ?.)
1438                 (?\e$(C#:\e(B . ?:)  (?\e$(C#;\e(B . ?\;) (?\e$(C#?\e(B . ??)  (?\e$(C#!\e(B . ?!)
1439                 (?\e$(C!/\e(B . ?')  (?\e$(C!.\e(B . ?`)  (?\e$(C#^\e(B . ?^)  (?\e$(C#_\e(B . ?_)  (?\e$(C#~\e(B . ?~)
1440                 (?\e$(C!*\e(B . ?-)  (?\e$(C!)\e(B . ?-)
1441                 (?\e$(C#/\e(B . ?/)  (?\e$(C!,\e(B . ?\\) (?\e$(C!-\e(B . ?~)  (?\e$(C#|\e(B . ?|)
1442                 (?\e$(C!.\e(B . ?`)  (?\e$(C!/\e(B . ?')  (?\e$(C!0\e(B . ?\") (?\e$(C!1\e(B . ?\")
1443                 (?\e$(C#(\e(B . ?\() (?\e$(C#)\e(B . ?\)) (?\e$(C#[\e(B . ?[)  (?\e$(C#]\e(B . ?])
1444                 (?\e$(C#{\e(B . ?{)  (?\e$(C#}\e(B . ?})  (?\e$(C!4\e(B . ?<)  (?\e$(C!5\e(B . ?>)
1445                 (?\e$(C#+\e(B . ?+)  (?\e$(C#-\e(B . ?-)  (?\e$(C#=\e(B . ?=)  (?\e$(C#<\e(B . ?<)  (?\e$(C#>\e(B . ?>)
1446                 (?\e$(C#'\e(B . ?')  (?\e$(C#"\e(B . ?\") (?\e$(C#\\e(B . ?\\) (?\e$(C#$\e(B . ?$)  (?\e$(C#%\e(B . ?%)
1447                 (?\e$(C##\e(B . ?#)  (?\e$(C#&\e(B . ?&)  (?\e$(C#*\e(B . ?*)  (?\e$(C#@\e(B . ?@)
1448                 (?\e$(C#0\e(B . ?0)  (?\e$(C#1\e(B . ?1)  (?\e$(C#2\e(B . ?2)  (?\e$(C#3\e(B . ?3)  (?\e$(C#4\e(B . ?4)
1449                 (?\e$(C#5\e(B . ?5)  (?\e$(C#6\e(B . ?6)  (?\e$(C#7\e(B . ?7)  (?\e$(C#8\e(B . ?8)  (?\e$(C#9\e(B . ?9)
1450                 (?\e$(C#A\e(B . ?A)  (?\e$(C#B\e(B . ?B)  (?\e$(C#C\e(B . ?C)  (?\e$(C#D\e(B . ?D)  (?\e$(C#E\e(B . ?E)
1451                 (?\e$(C#F\e(B . ?F)  (?\e$(C#G\e(B . ?G)  (?\e$(C#H\e(B . ?H)  (?\e$(C#I\e(B . ?I)  (?\e$(C#J\e(B . ?J)
1452                 (?\e$(C#K\e(B . ?K)  (?\e$(C#L\e(B . ?L)  (?\e$(C#M\e(B . ?M)  (?\e$(C#N\e(B . ?N)  (?\e$(C#O\e(B . ?O)
1453                 (?\e$(C#P\e(B . ?P)  (?\e$(C#Q\e(B . ?Q)  (?\e$(C#R\e(B . ?R)  (?\e$(C#S\e(B . ?S)  (?\e$(C#T\e(B . ?T)
1454                 (?\e$(C#U\e(B . ?U)  (?\e$(C#V\e(B . ?V)  (?\e$(C#W\e(B . ?W)  (?\e$(C#X\e(B . ?X)  (?\e$(C#Y\e(B . ?Y)
1455                 (?\e$(C#Z\e(B . ?Z)
1456                 (?\e$(C#a\e(B . ?a)  (?\e$(C#b\e(B . ?b)  (?\e$(C#c\e(B . ?c)  (?\e$(C#d\e(B . ?d)  (?\e$(C#e\e(B . ?e)
1457                 (?\e$(C#f\e(B . ?f)  (?\e$(C#g\e(B . ?g)  (?\e$(C#h\e(B . ?h)  (?\e$(C#i\e(B . ?i)  (?\e$(C#j\e(B . ?j)
1458                 (?\e$(C#k\e(B . ?k)  (?\e$(C#l\e(B . ?l)  (?\e$(C#m\e(B . ?m)  (?\e$(C#n\e(B . ?n)  (?\e$(C#o\e(B . ?o)
1459                 (?\e$(C#p\e(B . ?p)  (?\e$(C#q\e(B . ?q)  (?\e$(C#r\e(B . ?r)  (?\e$(C#s\e(B . ?s)  (?\e$(C#t\e(B . ?t)
1460                 (?\e$(C#u\e(B . ?u)  (?\e$(C#v\e(B . ?v)  (?\e$(C#w\e(B . ?w)  (?\e$(C#x\e(B . ?x)  (?\e$(C#y\e(B . ?y)
1461                 (?\e$(C#z\e(B . ?z))))
1462       (hash (make-vector 100 nil))
1463       lang pair)
1464   (while table
1465     (setq lang (caar table)
1466           pair (cdar table)
1467           table (cdr table))
1468     (while pair
1469       (set (intern (char-to-string (caar pair)) its-full-half-table)
1470            (cdar pair))
1471       (set (intern (concat (symbol-name lang) (char-to-string (cdar pair)))
1472                    its-half-full-table)
1473            (caar pair))
1474       (setq pair (cdr pair)))
1475     hash))
1476
1477 ;;; its-half-width : half-width-region for input-buffer
1478 (defun its-half-width ()
1479   (interactive)
1480   (its-convert
1481    (lambda (str lang)
1482      (concat (mapcar (lambda (c)
1483                        (or (symbol-value (intern-soft (char-to-string c)
1484                                                       its-full-half-table))
1485                            c))
1486                      (string-to-sequence str 'list))))))
1487
1488 ;;; its-full-width : full-width-region for input-buffer
1489 (defun its-full-width ()
1490   (interactive)
1491   (its-convert
1492    (lambda (str lang)
1493      (if (egg-chinese-syllable str 0)
1494          (copy-sequence str)
1495        (concat (mapcar (lambda (c)
1496                          (or (symbol-value
1497                               (intern-soft (concat (symbol-name lang)
1498                                                    (char-to-string c))
1499                                            its-half-full-table))
1500                              c))
1501                        (string-to-sequence str 'list)))))))
1502
1503 (defun its-convert (func)
1504   (let ((inhibit-read-only t))
1505     (unwind-protect
1506         (progn
1507           (its-input-end)
1508           (let* ((start (its-search-beginning))
1509                  (end (its-search-end))
1510                  (old-str (buffer-substring start end))
1511                  (len (length old-str))
1512                  (p 0)
1513                  (new-str ""))
1514             (put-text-property 0 len 'intangible 'its-part-1 old-str)
1515             (while (< p len)
1516               (let* ((prop (text-properties-at p old-str))
1517                      (cmp (memq 'composition prop))
1518                      (old (its-get-output (plist-get prop 'its-syl)))
1519                      (new (funcall func old (plist-get prop 'egg-lang)))
1520                      (new-len (length new))
1521                      syl)
1522                 (unless (equal new old)
1523                   (when cmp
1524                     (if (eq prop cmp)
1525                         (setq prop (cddr prop))
1526                       (setcdr (nthcdr (- (length prop) (length cmp) 1) prop)
1527                               (cddr cmp))))
1528                   (setq syl (copy-sequence new))
1529                   (plist-put prop 'its-syl (cons syl syl)))
1530                 (add-text-properties 0 new-len prop new)
1531                 (setq new-str (concat new-str new)
1532                       p (+ p (length old)))))
1533             (delete-region start end)
1534             (insert new-str)))
1535       (its-put-cursor t))))
1536
1537 (defun its-mode ()
1538   "\\{its-mode-map}"
1539   ;; dummy function to get docstring
1540   )
1541
1542 (defun its-mode-help-command ()
1543   "Display documentation for ITS mode."
1544   (interactive)
1545   (with-output-to-temp-buffer "*Help*"
1546     (princ "ITS mode:\n")
1547     (princ (documentation 'its-mode))
1548     (help-setup-xref (cons #'help-xref-mode (current-buffer)) (interactive-p))))
1549
1550 (provide 'its)
1551 ;;; its.el ends here.