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