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