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