its.el

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