its.el

   1 ;;; its.el --- Input Translation Systam AKA "ITS(uDekirunDa!)"
   2
   3 ;; Copyright (C) 1997, 1998 Mule Project, Powered by Electrotechnical
   4 ;; Laboratory, JAPAN.
   5 ;; Project Leader: Satoru Tomura <tomura@etl.go.jp>
   6
   7 ;; Author: NIIBE Yutaka <gniibe@mri.co.jp>
   8 ;;         KATAYAMA Yoshio <kate@pfu.co.jp>
   9 ;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
  10 ;; Keywords: mule, multilingual, input method
  11
  12 ;; This file will be part of GNU Emacs (in future).
  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 ;;; Code:
  32
  33 (require 'cl)
  34
  35 (defvar its-current-language)
  36 (make-variable-buffer-local 'its-current-language)
  37 \f
  38 ;; Data structure in ITS
  39 ;; (1) SYL and CURSOR
  40 ;;
  41 ;; "SYL" stands for something like a syllable.
  42 ;;
  43 ;; <SYL> ::= ( <output> . ( <keyseq> . <terminal> ))   ; Determined:   DSYL
  44 ;;        |  <state>                            ; Intermediate: ISYL
  45 ;;        |  ( <output> . <point> )             ; Verbatim:     VSYL
  46 ;;        |  nil                                ; None
  47 ;;
  48 ;; ;<state> ::=
  49 ;; ;          ( <output> . ( <keyseq> . <key-state-table/terminal> ))
  50 ;;
  51 ;; <keyseq> ::= "string" of key sequence
  52 ;; <output> ::= "string"
  53 ;;
  54 ;; <point> ::= integer which specifies point
  55 ;;
  56 ;; <cursor> ::= nil        ; Previous SYL is active (input will go that SYL)
  57 ;;           |  t          ; input makes new SYL.  DEL deletes previous SYL
  58 ;;           |  its-cursor ; DEL breaks previous SYL, input makes new SYL
  59
  60 ;; Data structures in ITS
  61 ;; (2) State machine which recognizes SYL
  62 ;;
  63 ;; <state> ::= ( <output> <keyseq> . <key-state-table/terminal> )
  64 ;;
  65 ;; <key-state-table/terminal> ::= <key-state-table> ; intermediate state
  66 ;;                             |  <terminal>        ; terminal state
  67 ;;
  68 ;; <key-state-table> ::= ( <key-state-alist> . <expr-output-back-list> )
  69 ;; <key-state-alist> ::= ( <key-state> ... )
  70 ;; <key-state> ::= ( <key> . <state> )
  71 ;; <key> ::= Positive INTEGER which specifies KEY STROKE
  72 ;;        |  -1 ; means END of key stroke
  73 ;;
  74 ;; Only applicable for last transition.
  75 ;; <expr-output-back-list> ::= ( (<output> . (<keyexpr> . <howmanyback>))... )
  76 ;; <keyexpr> ::= something like "[a-z]" which specifies class of key.
  77 ;;            |  NIL; means ANY of key (except END of the key stroke)
  78 ;;
  79 ;;
  80 ;; <keyseq> ::= "string"
  81 ;;
  82 ;; <terminal> ::= nil
  83 ;;             |  <howmanyback>
  84 ;;
  85 ;; <howmanyback> ::= integer which specifies how many key strokes we go back
  86 ;;
  87 ;; <output> ::= "string"
  88
  89 ;; Data structure in ITS (3) Map
  90 ;;
  91 ;; <map>         ::= ( <name> <indicator> <language> . <start-state> )
  92 ;; <name>        ::= "string"
  93 ;; <indicator>   ::= "string"
  94 ;; <language>    ::= "string"
  95 ;; <start-state> ::= <state>
  96 ;;
  97 \f
  98 (defsubst its-new-state (output keyseq back)
  99   (cons output (cons keyseq back)))
 100
 101 (defsubst its-new-map (name indicator language)
 102   (cons name (cons indicator (cons language (its-new-state "" "" nil)))))
 103
 104 (defsubst its-get-indicator (map)
 105   (nth 1 map))
 106
 107 (defsubst its-get-language (map)
 108   (nth 2 map))
 109
 110 (defsubst its-get-start-state (map)
 111   (nthcdr 3 map))
 112
 113 (defsubst its-get-kst/t (state)
 114   (cdr (cdr state)))
 115
 116 (defsubst its-set-kst (state kst)
 117   (setcdr (cdr state) kst))
 118
 119 (defsubst its-get-keyseq (state)
 120   (car (cdr state)))
 121
 122 (defsubst its-set-keyseq (state keyseq)
 123   (setcar (cdr state) keyseq))
 124
 125 (defun its-get-keyseq-cooked (state)
 126   (let ((keyseq (its-get-keyseq state))
 127         (back (its-get-kst/t state)))
 128     (if back
 129         (substring keyseq 0 back)
 130       keyseq)))
 131
 132 (defsubst its-kst-p (kst/t)
 133   (not (or (numberp kst/t) (null kst/t))))
 134
 135 (defsubst its-get-output (syl/state)
 136   (car syl/state))
 137
 138 (defsubst its-set-output (state output)
 139   (setcar state output))
 140
 141 (defsubst its-get-keyseq-syl (syl)
 142   (let ((l (cdr syl)))
 143     (cond ((stringp l)                  ; DSYL
 144            l)
 145           ((numberp l)                  ; VSYL
 146            (car syl))
 147           ((numberp (cdr l))
 148            (substring (car l) 0 (cdr l)))
 149           (t
 150            (car l)))))
 151
 152 (defsubst its-eob-keyexpr (eob)
 153   (car (cdr eob)))
 154 (defsubst its-eob-back (eob)
 155   (cdr (cdr eob)))
 156
 157 (defsubst its-make-class+back (class back)
 158   (cons class back))
 159 (defsubst its-make-otherwise (output class+back)
 160   (cons output class+back))
 161
 162 (defsubst its-DSYL-with-back-p (syl)
 163   (and (consp (cdr syl))
 164        (numberp (its-get-kst/t syl))))
 165
 166 (defsubst its-concrete-DSYL-p (syl)
 167   (stringp (cdr syl)))
 168
 169 (defsubst its-make-concrete-DSYL (syl)
 170   (if (consp (cdr syl))
 171       (cons (its-get-output syl) (its-get-keyseq-syl syl))
 172     syl))
 173
 174 ;;
 175 ;;
 176
 177 (require 'its-keydef)
 178
 179 (defvar its-mode-map
 180   (let ((map (make-sparse-keymap))
 181         (i 33))
 182     (define-key map "\C-a" 'its-beginning-of-input-buffer)
 183     (define-key map "\C-b" 'its-backward-SYL)
 184     (define-key map "\C-d" 'its-delete-SYL)
 185     (define-key map "\C-e" 'its-end-of-input-buffer)
 186     (define-key map "\C-f" 'its-forward-SYL)
 187     (define-key map "\C-]" 'its-cancel-input)
 188     (define-key map "\C-h" 'its-mode-help-command)
 189     (define-key map "\C-k" 'its-kill-line)
 190 ;;    (define-key map "\C-l" 'its-exit-mode)
 191     (define-key map "\C-m" 'its-exit-mode)      ; RET
 192     (define-key map [return] 'its-exit-mode)
 193     (define-key map "\C-t" 'its-transpose-chars)
 194     (define-key map [backspace] 'its-delete-backward-SYL)
 195     (define-key map [delete] 'its-delete-backward-SYL)
 196     (define-key map [M-backspace] 'its-delete-backward-SYL-by-keystroke)
 197     (define-key map [M-delete] 'its-delete-backward-SYL-by-keystroke)
 198     (define-key map [right] 'its-forward-SYL)
 199     (define-key map [left] 'its-backward-SYL)
 200     (define-key map "\C-\\" 'its-exit-mode-off-input-method)
 201     (while (< i 127)
 202       (define-key map (vector i) 'its-self-insert-char)
 203       (setq i (1+ i)))
 204     (define-key map " "    'its-kick-convert-region)
 205     (define-key map "\177" 'its-delete-backward-SYL)
 206     ;;
 207     (define-key map "\M-p" 'its-previous-map)
 208     (define-key map "\M-n" 'its-next-map)
 209     (define-key map "\M-h" 'its-hiragana) ; hiragana-region for input-buffer
 210     (define-key map "\M-k" 'its-katakana)
 211     (define-key map "\M-<" 'its-hankaku)
 212     (define-key map "\M->" 'its-zenkaku)
 213     (its-define-select-keys map t)
 214     map)
 215   "Keymap for ITS mode.")
 216
 217 (defvar its-fence-open   "|" "*\e$B%U%'%s%9$N;OE@$r<($9J8;zNs\e(B (1 \e$BJ8;z\e(B)")
 218 (defvar its-fence-close  "|" "*\e$B%U%'%s%9$N=*E@$r<($9J8;zNs\e(B (1 \e$BJ8;z\e(B)")
 219 (defvar its-fence-face nil  "*\e$B%U%'%s%9I=<($KMQ$$$k\e(B face \e$B$^$?$O\e(B nil")
 220
 221 (defconst its-setup-fence-before-insert-SYL nil)
 222
 223 (defun its-put-cursor (cursor)
 224   (let ((p (point))
 225         (map (copy-keymap its-mode-map)))
 226     (its-define-select-keys map)
 227     (insert "!")
 228     (add-text-properties p (point) (list 'local-map map
 229                                          'invisible t
 230                                          'intangible 'its-part-2
 231                                          'its-cursor cursor))
 232     (goto-char p)))
 233
 234 (defsubst its-set-cursor-status (cursor)
 235   (put-text-property (point) (1+ (point)) 'its-cursor cursor)
 236   cursor)
 237
 238 ;;
 239 ;;  +-- START property
 240 ;;  |          --- CURSOR Property
 241 ;;  |         /
 242 ;;  v        v    v-- END Property
 243 ;;  |SYL SYL ^ SYL|
 244 ;;   ^^^ ^^^   ^^^------ SYL Property
 245 ;;  <-------><---->
 246 ;; intangible intangible
 247 ;;     1       2
 248 ;;
 249 (defun its-setup-fence-mode ()
 250   (let ((open-props '(its-start t intangible its-part-1))
 251         (close-props '(its-end t intangible its-part-2))
 252         (p (point)) p1)
 253     (insert its-fence-open)
 254     (setq p1 (point))
 255     (add-text-properties p p1 open-props)
 256     (insert its-fence-close)
 257     (add-text-properties p1 (point) close-props)
 258     (if its-fence-face
 259         (put-text-property 'invisible t p (point)))
 260     (goto-char p1)
 261     (its-put-cursor t)))
 262
 263 (defun its-start (key)
 264   (let ((its-setup-fence-before-insert-SYL t))
 265     (its-input nil key)
 266     (force-mode-line-update)))
 267
 268 (defun its-restart (str)
 269   (let (p)
 270     (its-setup-fence-mode)
 271     (setq p (point))
 272     (insert str)
 273     (its-beginning-of-input-buffer)))
 274
 275 (defun its-self-insert-char ()
 276   (interactive)
 277   (let ((key last-command-char)
 278         (cursor (get-text-property (point) 'its-cursor))
 279         (syl (get-text-property (1- (point)) 'its-syl)))
 280     (cond
 281      ((or (eq cursor t)
 282           (not (eq (get-text-property (1- (point)) 'its-map) its-current-map)))
 283       (put-text-property (- (point) (length (its-get-output syl))) (point)
 284                          'its-syl (its-make-concrete-DSYL syl))
 285       (setq syl nil))
 286     (cursor
 287      (setq syl nil)))
 288     (its-input syl key)))
 289
 290 (defvar its-current-map nil)
 291 (make-variable-buffer-local 'its-current-map)
 292 (put 'its-current-map 'permanent-local t)
 293
 294 (defun its-initial-ISYL ()
 295   (its-get-start-state its-current-map))
 296
 297 (defun its-make-VSYL (keyseq)
 298   (cons keyseq (length keyseq)))
 299
 300 (defvar its-barf-on-invalid-keyseq nil
 301   "T means don't allow invalid key sequence in input buffer.")
 302
 303 (defun its-input-error ()
 304   (error "Invalid Romaji Sequence"))
 305
 306 ;; Return CURSOR
 307 (defun its-input (syl key)
 308   (if (null syl)
 309       (setq syl (its-initial-ISYL)))
 310   (let ((output (car syl))
 311         (k/kk/s (cdr syl)))
 312     (cond
 313      ((numberp k/kk/s)
 314         ;; k/kk/s is "point in keyseq"
 315         (its-input-to-vsyl syl key k/kk/s output))
 316      ((and its-barf-on-invalid-keyseq
 317            (null (its-keyseq-acceptable-p (vector key) syl)))
 318       ;; signal before altering
 319       (its-input-error))
 320      (t
 321       ;; It's ISYL
 322       (its-state-machine syl key 'its-buffer-ins/del-SYL)))))
 323
 324 (defun its-input-to-vsyl (syl key point output)
 325   (if (< key 0)
 326       (its-set-cursor-status t)
 327     (let ((len (length output)))
 328       (if (= len point)
 329           ;; point is at end of VSYL.  Don't need to call state machine.
 330           (its-buffer-ins/del-SYL
 331            (its-make-VSYL (concat output (vector key))) syl nil)
 332         ;; point is at middle of VSYL.
 333         (let ((new-keyseq (concat (substring output 0 point)
 334                                   (vector key)
 335                                   (substring output point))))
 336           (its-state-machine-keyseq new-keyseq 'its-buffer-ins/del-SYL))))))
 337 \f
 338 ;;;
 339 ;;; ITS State Machine
 340 ;;;
 341
 342 ;; Return CURSOR
 343 (defun its-state-machine (state key emit)
 344   (let ((next-state (its-get-next-state state key))
 345         expr-output-back kst/t output keyseq back)
 346     (cond
 347      ;; proceed to next status
 348      (next-state
 349       (setq kst/t (its-get-kst/t next-state)
 350             output (its-get-output next-state)
 351             keyseq (its-get-keyseq next-state))
 352       (cond
 353        ;; Still, it's a intermediate state.
 354        ((its-kst-p kst/t)
 355         (funcall emit next-state state nil))
 356
 357        ;; It's negative integer which specifies how many
 358        ;; characters we go backwards
 359        (kst/t
 360         (funcall emit next-state state 'its-cursor)
 361         (its-state-machine-keyseq (substring keyseq kst/t) emit (< key 0)))
 362
 363         ;; Here we arrive to a terminal state.
 364         ;; Emit a DSYL, and go ahead.
 365        (t
 366         (funcall emit next-state state 'its-cursor))))
 367
 368      ;; push back by otherwise status
 369      ((and (>= key 0)
 370            (setq expr-output-back (its-get-otherwise state key)))
 371       (setq keyseq (concat (its-get-keyseq state) (vector key)))
 372       (funcall emit
 373                (cons (its-get-output expr-output-back)
 374                      (cons keyseq (its-eob-back expr-output-back)))
 375                state t)
 376       (its-state-machine-keyseq
 377        (substring keyseq (its-eob-back expr-output-back)) emit))
 378
 379      ((eq its-barf-on-invalid-keyseq 'its-keyseq-test)
 380       'its-keyseq-test-failed)
 381
 382      ;; No next state for KEY.  It's invalid sequence.
 383      (its-barf-on-invalid-keyseq
 384       (its-input-error))
 385
 386      (t
 387       ;; XXX Should make DSYL (instead of VSYL)?
 388       (setq keyseq (concat (its-get-keyseq state) (if (> key 0) (vector key))))
 389       (funcall emit (its-make-VSYL keyseq) state nil)))))
 390
 391 (defvar its-latest-SYL nil
 392   "The latest SYL inserted.")
 393 (defsubst its-update-latest-SYL (syl)
 394   (setq its-latest-SYL syl))
 395
 396 ;; Return CURSOR
 397 (defun its-state-machine-keyseq (keyseq emit &optional eol)
 398   (let ((i 0)
 399         (len (length keyseq))
 400         (syl (its-initial-ISYL))
 401         cursor)
 402     (while (< i len)
 403       (cond
 404        ((numberp (cdr syl))
 405         ;; VSYL - no need looping
 406         (funcall emit
 407                  (its-make-VSYL (concat (car syl) (substring keyseq i)))
 408                  syl nil)
 409         (setq cursor nil
 410               i len))
 411        (t
 412         (setq cursor (its-state-machine syl (aref keyseq i) emit))))
 413       (if (eq cursor 'its-keyseq-test-failed)
 414           (setq i len)
 415         (setq syl (if cursor (its-initial-ISYL) its-latest-SYL)
 416               i (1+ i))))
 417     (if (and eol (not (eq cursor 'its-keyseq-test-failed)))
 418         (its-state-machine syl -1 emit)
 419       cursor)))
 420
 421 (defun its-buffer-ins/del-SYL (newsyl oldsyl cursor)
 422   (if its-setup-fence-before-insert-SYL
 423       (progn
 424         (setq its-setup-fence-before-insert-SYL nil)
 425         (its-setup-fence-mode)))
 426   (its-buffer-delete-SYL oldsyl)
 427   (its-update-latest-SYL newsyl)
 428   (let ((p (point)))
 429     (insert (its-get-output newsyl))
 430     (add-text-properties p (point)
 431                          (list 'its-syl newsyl
 432                                'its-map its-current-map
 433                                'its-lang its-current-language
 434                                'intangible 'its-part-1))
 435     (if its-fence-face
 436         (put-text-property p (point) 'face its-fence-face))
 437     (its-set-cursor-status cursor)))
 438
 439 (defun its-buffer-delete-SYL (syl)
 440   (let ((len (length (its-get-output syl))))
 441     (delete-region (- (point) len) (point))))
 442
 443 (defun its-get-next-state (state key)
 444   (let ((kst/t (its-get-kst/t state)))
 445     (cdr (assq key (car kst/t)))))
 446
 447 ;; XXX XXX XXX
 448 (defun its-otherwise-match (expr key)
 449   (or (null expr)                       ; <expr>::= NIL means "ANY"
 450       (let ((case-fold-search nil))
 451         (string-match expr (char-to-string key)))))
 452
 453 (defun its-get-otherwise (state key)
 454   (let* ((kst/t (its-get-kst/t state))
 455          (ebl (cdr kst/t))
 456          expr-output-back)
 457       (while ebl
 458         (setq expr-output-back (car ebl))
 459         (let ((expr (its-eob-keyexpr expr-output-back)))
 460           (if (its-otherwise-match expr key)
 461               (setq ebl nil)
 462             (setq ebl (cdr ebl)))))
 463       expr-output-back))
 464
 465 (defun its-keyseq-acceptable-p (keyseq &optional syl eol)
 466   (let ((i 0)
 467         (len (length keyseq))
 468         (its-barf-on-invalid-keyseq 'its-keyseq-test)
 469         (its-latest-SYL nil)
 470         (emit (lambda (nsyl osyl cursor)
 471                 (its-update-latest-SYL nsyl)
 472                 cursor))
 473         cursor)
 474     (if (null syl)
 475         (setq syl (its-initial-ISYL)))
 476     (while (and syl (< i len))
 477       (setq cursor (its-state-machine syl (aref keyseq i) emit))
 478       (cond
 479        ((eq cursor 'its-keyseq-test-failed)
 480         (setq syl nil))
 481        (cursor
 482         (setq syl (its-initial-ISYL)))
 483        (t
 484         its-latest-SYL))
 485       (setq i (1+ i)))
 486     (if eol
 487         (setq cursor (its-state-machine syl -1 emit)))
 488     (not (eq cursor 'its-keyseq-test-failed))))
 489 \f
 490 ;;;
 491 ;;; Name --> map
 492 ;;;
 493 ;;; ITS name: string
 494
 495 (defvar its-map-alist nil)
 496
 497 (defun its-get-map (name)
 498   (assoc name its-map-alist))
 499
 500 (defun its-register-map (map)
 501   (let* ((name (car map))
 502          (place (assoc name its-map-alist)))
 503     (if place
 504         (setcdr place (cdr map))
 505       (setq its-map-alist (cons map its-map-alist)))
 506     map))
 507
 508 (defmacro define-its-state-machine (map name indicator lang doc &rest exprs)
 509   `(progn
 510      (eval-when (eval compile)
 511        (let ((its-current-map (its-new-map ,name ,indicator ,lang)))
 512          ,@exprs
 513          (setq ,map its-current-map)))
 514      (define-its-compiled-map ,map ,doc)))
 515
 516 (defmacro define-its-compiled-map (map doc)
 517   `(defconst ,map ',(symbol-value map) ,doc))
 518
 519 (defmacro define-its-state-machine-append (map &rest exprs)
 520   (append
 521    `(let ((its-current-map ,map)))
 522    exprs
 523    (list `(setq ,map its-current-map))))
 524
 525 ;;
 526 ;; Construct State Machine
 527 ;;
 528 (defun its-defrule (input output &optional back enable-overwrite)
 529   "\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
 530 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
 531 \e$BLa$C$FF0$/$b$N$H$9$k!#JQ495,B'$O$b$C$H$b:G6a$K\e(B its-define-state-machine
 532 \e$B$5$l$?JQ49I=$KEPO?$5$l$k!#\e(B
 533 Return last state."
 534   (let ((state (its-goto-state (substring input 0 -1) nil t))
 535         (key (aref input (1- (length input)))))
 536     (if (and (its-get-next-state state key) (not enable-overwrite))
 537         (error "Duplicated definition (%s)" input)
 538       (its-make-next-state state key input output back))))
 539
 540 (defun its-goto-state (input &optional initial-state build-if-none)
 541   (let ((len (length input))
 542         (i 0)
 543         (state (or initial-state (its-get-start-state its-current-map))))
 544     (while (< i len)
 545       (setq state
 546             (or (its-get-next-state state (aref input i))
 547                 (if build-if-none
 548                     (let ((keyseq (substring input 0 (1+ i))))
 549                       (its-make-next-state state (aref input i) keyseq keyseq))
 550                    (error "No such state (%s)" input)))
 551             i (1+ i)))
 552     state))
 553
 554 (defun its-defoutput (input display)
 555   (let ((state (its-goto-state input)))
 556     (its-set-output state display)))
 557
 558 (defun its-define-otherwise (state otherwise)
 559   (let ((kst (its-get-kst/t state)))
 560     (if kst
 561         (setcdr kst (cons otherwise (cdr kst)))
 562       (its-set-kst state (cons nil (cons otherwise nil))))))
 563
 564 (defconst its-otherwise-back-one
 565   (its-make-class+back nil -1))
 566
 567 (defun its-defrule-otherwise (state output &optional class back)
 568   (let (class+back)
 569     (if (null back)
 570         (setq class+back its-otherwise-back-one)
 571       (setq class+back (its-make-class+back class back)))
 572     (its-define-otherwise state
 573                           (its-make-otherwise output class+back))))
 574
 575 (defun its-defrule* (input output)
 576   (let ((state (its-defrule input output)))
 577     (its-defrule-otherwise state output)))
 578
 579 (defun its-make-next-state (state key keyseq output &optional back)
 580   (let ((next-state (its-new-state output keyseq back))
 581         (kst (its-get-kst/t state)))
 582     (if kst
 583         (setcar kst (cons (cons key next-state) (car kst)))
 584       (its-set-kst state (list (list (cons key next-state)))))
 585     next-state))
 586 \f
 587 ;;;
 588 (defun its-beginning-of-input-buffer ()
 589   (interactive)
 590   (its-input-end)
 591   (if (not (get-text-property (1- (point)) 'its-start))
 592       (let ((begpos (previous-single-property-change (point) 'its-start)))
 593         ;; Make SYLs have property of "part 2"
 594         (put-text-property begpos (point) 'intangible 'its-part-2)
 595         (goto-char begpos)))
 596   (its-put-cursor t))
 597
 598 (defun its-end-of-input-buffer ()
 599   (interactive)
 600   (its-input-end)
 601   (if (not (get-text-property (point) 'its-end))
 602       (let ((endpos (next-single-property-change (point) 'its-end)))
 603         ;; Make SYLs have property of "part 1"
 604         (put-text-property (point) endpos 'intangible 'its-part-1)
 605         (goto-char endpos)))
 606   (its-put-cursor t))
 607
 608 ;; TODO: move in VSYL
 609 (defun its-backward-SYL (n)
 610   (interactive "p")
 611   (its-input-end)
 612   (let ((syl (get-text-property (1- (point)) 'its-syl))
 613         (p (point))
 614         (old-point (point)))
 615     (while (and syl (> n 0))
 616       (setq p (- p (length (its-get-output syl))))
 617       (setq syl (get-text-property (1- p) 'its-syl))
 618       (setq n (1- n)))
 619     ;; Make SYLs have property of "part 2"
 620     (put-text-property p old-point 'intangible 'its-part-2)
 621     (goto-char p)
 622     (its-put-cursor t)
 623     (if (> n 0)
 624         (signal 'beginning-of-buffer nil))))
 625
 626 ;; TODO: move in VSYL
 627 (defun its-forward-SYL (n)
 628   (interactive "p")
 629   (its-input-end)
 630   (let ((syl (get-text-property (point) 'its-syl))
 631         (p (point))
 632         (old-point (point)))
 633     (while (and syl (> n 0))
 634       (setq p (+ p (length (its-get-output syl))))
 635       (setq syl (get-text-property p 'its-syl))
 636       (setq n (1- n)))
 637     ;; Make SYLs have property of "part 1"
 638     (put-text-property old-point p 'intangible 'its-part-1)
 639     (goto-char p)
 640     (its-put-cursor t)
 641     (if (> n 0)
 642         (signal 'end-of-buffer nil))))
 643
 644 ;; TODO: handle VSYL.  KILLFLAG
 645 (defun its-delete-SYL (n killflag)
 646   (interactive "p\nP")
 647   (its-input-end)
 648   (let ((syl (get-text-property (point) 'its-syl))
 649         (p (point)))
 650     (while (and syl (> n 0))
 651       (setq p (+ p (length (its-get-output syl))))
 652       (setq syl (get-text-property p 'its-syl))
 653       (setq n (1- n)))
 654     (if (> n 0)
 655         (progn
 656           (its-put-cursor t)
 657           (signal 'args-out-of-range (list p n)))
 658       (delete-region (point) p)
 659       ;; Check if empty
 660       (let ((s (get-text-property (1- (point)) 'its-start))
 661             (e (get-text-property (point) 'its-end)))
 662         (if (and s e)
 663             (its-exit-mode-internal)
 664           (its-put-cursor t))))))
 665
 666 ;; TODO: killflag
 667 (defun its-delete-backward-SYL (n killflag)
 668   (interactive "p\nP")
 669   (let ((syl (get-text-property (1- (point)) 'its-syl))
 670         (cursor (get-text-property (point) 'its-cursor)))
 671     (if (null syl)
 672         (signal 'beginning-of-buffer nil)
 673       (if (eq cursor t)
 674           (its-delete-backward-SYL-internal n killflag)
 675         (its-delete-backward-within-SYL syl n killflag)))))
 676
 677 ;; TODO: killflag
 678 (defun its-delete-backward-SYL-internal (n killflag)
 679   (let ((syl (get-text-property (1- (point)) 'its-syl))
 680         (p (point)))
 681     (while (and syl (> n 0))
 682       (setq p (- p (length (its-get-output syl))))
 683       (setq syl (get-text-property (1- p) 'its-syl))
 684       (setq n (1- n)))
 685     (if (> n 0)
 686         (signal 'args-out-of-range (list p n))
 687       (delete-region p (1+ (point)))    ; also delete cursor
 688       ;; Check if empty
 689       (let ((s (get-text-property (1- (point)) 'its-start))
 690             (e (get-text-property (point) 'its-end)))
 691         (if (and s e)
 692             (its-exit-mode-internal)
 693           (its-put-cursor t))))))
 694
 695 (defvar its-delete-by-keystroke nil)
 696
 697 (defun its-delete-backward-SYL-by-keystroke (n killflag)
 698   (interactive "p\nP")
 699   (let ((its-delete-by-keystroke t))
 700     (its-delete-backward-SYL n killflag)))
 701
 702 ;; TODO: killflag
 703 (defun its-delete-backward-within-SYL (syl n killflag)
 704   (let* ((keyseq (its-get-keyseq-syl syl))
 705          (len (length keyseq))
 706          (p (- (point) (length (its-get-output syl))))
 707          (its-current-map (get-text-property (1- (point)) 'its-map))
 708          back pp)
 709     (if (< n 0)
 710         (signal 'args-out-of-range (list (- (point) n) (point))))
 711     (if its-delete-by-keystroke
 712       (while (null (or (eq p pp) (its-concrete-DSYL-p syl)))
 713           (setq pp p)
 714           (while (and (setq syl (get-text-property (1- p) 'its-syl))
 715                       (its-DSYL-with-back-p syl)
 716                       (<= (setq back (- (its-get-kst/t syl))) len)
 717                       (> back (- len n))
 718                       (equal (substring (its-get-keyseq syl) (- back))
 719                              (substring keyseq 0 back)))
 720             (setq keyseq (concat (its-get-keyseq-syl syl) keyseq)
 721                   len (length keyseq)
 722                   p (- p (length (its-get-output syl)))))
 723           (if (and (eq p pp) syl (> n len))
 724               (setq n (- n len)
 725                     keyseq (its-get-keyseq-syl syl)
 726                     len (length keyseq)
 727                     p (- p (length (its-get-output syl))))))
 728       (if (and (> n len) (its-concrete-DSYL-p syl))
 729           (setq len 1)))
 730     (if (> n len)
 731         (setq n (- n len)
 732               len 0))
 733     (while (and (> n len) (setq syl (get-text-property (1- p) 'its-syl)))
 734       (setq n (1- n)
 735             p (- p (length (its-get-output syl)))))
 736     (if (> n len)
 737         (signal 'beginning-of-buffer nil))
 738     (delete-region p (point))
 739     (cond
 740      ((> len n)
 741       (its-state-machine-keyseq (substring keyseq 0 (- len n))
 742                                 'its-buffer-ins/del-SYL))
 743      ;; Check if empty
 744      ((and (get-text-property (1- (point)) 'its-start)
 745            (get-text-property (1+ (point)) 'its-end))
 746       ;; Delete CURSOR
 747       (delete-region (point) (1+ (point)))
 748       (its-exit-mode-internal))
 749      ((and its-delete-by-keystroke
 750            (null (its-concrete-DSYL-p (get-text-property (1- p) 'its-syl))))
 751       (its-set-cursor-status 'its-cursor))
 752      (t
 753       (its-set-cursor-status t)))))
 754
 755 (defun its-transpose-chars (n)
 756   (interactive "p")
 757   (let ((syl (get-text-property (1- (point)) 'its-syl))
 758         (cursor (get-text-property (point) 'its-cursor))
 759         keyseq len)
 760     (cond
 761      ((null syl)
 762       (signal 'beginning-of-buffer nil))
 763      ((eq cursor t)
 764       (if (and (= n 1) (get-text-property (1+ (point)) 'its-end))
 765           (progn
 766             (its-backward-SYL 1)
 767             (setq syl (get-text-property (1- (point)) 'its-syl))
 768             (if (null syl)
 769                 (signal 'beginning-of-buffer nil))))
 770       (its-buffer-delete-SYL syl)
 771       (while (> n 0)
 772         (if (get-text-property (1+ (point)) 'its-end)
 773             (progn
 774               (its-buffer-ins/del-SYL syl nil t)
 775               (signal 'end-of-buffer nil)))
 776         (its-forward-SYL 1)
 777         (setq n (1- n)))
 778       (while (< n 0)
 779         (if (get-text-property (1- (point)) 'its-start)
 780             (progn
 781               (its-buffer-ins/del-SYL syl nil t)
 782               (signal 'beginning-of-buffer nil)))
 783         (its-backward-SYL 1)
 784         (setq n (1+ n)))
 785       (its-buffer-ins/del-SYL syl nil t))
 786      (t
 787       (setq keyseq (its-get-keyseq-syl syl)
 788             len (length keyseq))
 789       (cond
 790        ((or (> n 1) (<= len 1))
 791         (signal 'end-of-buffer nil))
 792        ((>= (- n) len)
 793         (signal 'beginning-of-buffer nil))
 794        (t
 795         (setq n (if (> n 0) (- -1 n) (1- n)))
 796         (setq keyseq (concat (substring keyseq 0 n)
 797                              (substring keyseq -1)
 798                              (substring keyseq n -1)))
 799         (if (and its-barf-on-invalid-keyseq
 800                  (null (its-keyseq-acceptable-p keyseq)))
 801             (its-input-error))
 802         (delete-region (- (point) (length (its-get-output syl))) (point))
 803         (its-state-machine-keyseq keyseq 'its-buffer-ins/del-SYL)))))))
 804
 805 ;; Return VOID
 806 (defun its-input-end ()
 807   (let ((cursor (get-text-property (point) 'its-cursor)))
 808     ;; key "END"
 809     (if (null cursor)
 810         (its-input (get-text-property (1- (point)) 'its-syl) -1))
 811     (delete-region (point) (1+ (point)))))
 812
 813 (defun its-exit-mode ()
 814   "Exit ITS mode."
 815   (interactive)
 816   (its-input-end)
 817   (its-exit-mode-internal))
 818
 819 (defun its-exit-mode-off-input-method ()
 820   "Exit ITS mode."
 821   (interactive)
 822   (its-input-end)
 823   (its-exit-mode-internal)
 824   (inactivate-input-method))
 825
 826 ;; TODO: handle overwrite-mode, insertion-hook, fill...
 827 (defun its-exit-mode-internal (&optional proceed-to-conversion)
 828   (let (start end)
 829     ;; Delete open fence
 830     (if (get-text-property (1- (point)) 'its-start)
 831         (setq start (1- (point)))
 832       (setq start (1- (previous-single-property-change (point) 'its-start))))
 833     (delete-region start (1+ start))
 834     ;; Delete close fence
 835     (if (get-text-property (point) 'its-end)
 836         (setq end (point))
 837       (setq end (next-single-property-change (point) 'its-end)))
 838     (delete-region end (1+ end))
 839     ;; Remove all properties added by ITS
 840     (remove-text-properties start end '(its-map nil
 841                                         face nil
 842                                         intangible nil))
 843     (if proceed-to-conversion
 844         (egg-convert-region start end)
 845       (remove-text-properties start end '(its-lang nil its-syl nil))
 846       (egg-do-auto-fill)
 847       (run-hooks 'input-method-after-insert-chunk-hook))))
 848
 849 (defun its-kick-convert-region ()
 850   (interactive)
 851   (its-input-end)
 852   (its-exit-mode-internal t))
 853
 854 (defun its-in-fence-p ()
 855   (eq (get-text-property (point) 'intangible) 'its-part-2))
 856 \f
 857 (defvar its-translation-result "" "")
 858
 859 (defun its-ins/del-SYL-batch (newsyl oldsyl cursor)
 860   (its-update-latest-SYL newsyl)
 861   (if (and newsyl
 862            (consp (cdr newsyl))
 863            (not (its-kst-p (its-get-kst/t newsyl))))
 864       ;; DSYL
 865       (let ((output (its-get-output newsyl))
 866             (oldlen (length its-translation-result)))
 867         (setq its-translation-result (concat its-translation-result output))
 868         (put-text-property oldlen (length its-translation-result)
 869                            'its-lang its-current-language
 870                            its-translation-result)))
 871   cursor)
 872
 873 (defun its-translate-region (start end)
 874   (interactive "r")
 875   (its-translate-region-internal start end)
 876   (remove-text-properties start (point) '(its-lang nil)))
 877
 878 (defun its-translate-region-internal (start end)
 879   (setq its-translation-result "")
 880   (goto-char start)
 881   (let ((i 0)
 882         (syl (its-initial-ISYL))
 883         ;; temporally enable DING
 884         (its-barf-on-invalid-keyseq t)
 885         cursor)
 886     (while (< (point) end)
 887       (let ((key (following-char)))
 888         (setq cursor (its-state-machine syl key 'its-ins/del-SYL-batch))
 889         (forward-char 1)
 890         (if cursor
 891             (setq syl (its-initial-ISYL))
 892           (setq syl its-latest-SYL))))
 893     (if (eq syl its-latest-SYL)
 894         (its-state-machine syl -1 'its-ins/del-SYL-batch))
 895     (delete-region start end)
 896     (insert its-translation-result)))
 897 \f
 898 (provide 'its)
 899 ;;; its.el ends here.