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           (t
 148            (car (cdr syl))))))
 149
 150 (defsubst its-eob-keyexpr (eob)
 151   (car (cdr eob)))
 152 (defsubst its-eob-back (eob)
 153   (cdr (cdr eob)))
 154
 155 (defsubst its-make-class+back (class back)
 156   (cons class back))
 157 (defsubst its-make-otherwise (output class+back)
 158   (cons output class+back))
 159 ;;
 160 ;;
 161
 162 (defvar its-mode-map
 163   (let ((map (make-sparse-keymap))
 164         (i 33))
 165     (define-key map "\C-a" 'its-beginning-of-input-buffer)
 166     (define-key map "\C-b" 'its-backward-SYL)
 167     (define-key map "\C-d" 'its-delete-SYL)
 168     (define-key map "\C-e" 'its-end-of-input-buffer)
 169     (define-key map "\C-f" 'its-forward-SYL)
 170     (define-key map "\C-]" 'its-cancel-input)
 171     (define-key map "\C-h" 'its-mode-help-command)
 172     (define-key map "\C-k" 'its-kill-line)
 173 ;;    (define-key map "\C-l" 'its-exit-mode)
 174     (define-key map "\C-m" 'its-exit-mode)      ; RET
 175     (define-key map [return] 'its-exit-mode)
 176     (define-key map "\C-t" 'its-transpose-chars)
 177     (define-key map [delete] 'its-delete-backward-SYL)
 178     (define-key map [right] 'its-forward-SYL)
 179     (define-key map [left] 'its-backward-SYL)
 180     (define-key map "\C-\\" 'its-exit-mode-off-input-method)
 181     (while (< i 127)
 182       (define-key map (vector i) 'its-self-insert-char)
 183       (setq i (1+ i)))
 184     (define-key map " "    'its-kick-convert-region)
 185     (define-key map "\177" 'its-delete-backward-SYL)
 186     ;;
 187     (define-key map "\C-p" 'its-previous-map)
 188     (define-key map "\C-n" 'its-next-map)
 189 ;   (define-key map "\M-h"    'its-hiragana) ; hiragana-region for input-buffer
 190 ;   (define-key map "\M-k"    'its-katakana)
 191 ;   (define-key map "\M-<"    'its-hankaku)
 192 ;   (define-key map "\M->"    'its-zenkaku)
 193 ;   (define-key map "\M-\C-h" 'its-select-hiragana)
 194 ;   (define-key map "\M-\C-k" 'its-select-katakana)
 195 ;;;    (define-key map "\M-q"    'its-select-downcase) ;
 196 ;   (define-key map "\M-Q"    'its-select-upcase)
 197 ;   (define-key map "\M-z"    'its-select-zenkaku-downcase)
 198 ;   (define-key map "\M-Z"    'its-select-zenkaku-upcase)
 199     map)
 200   "Keymap for ITS mode.")
 201
 202 (defvar its-fence-open   "|" "*\e$B%U%'%s%9$N;OE@$r<($9J8;zNs\e(B (1 \e$BJ8;z\e(B)")
 203 (defvar its-fence-close  "|" "*\e$B%U%'%s%9$N=*E@$r<($9J8;zNs\e(B (1 \e$BJ8;z\e(B)")
 204 (defvar its-fence-face nil  "*\e$B%U%'%s%9I=<($KMQ$$$k\e(B face \e$B$^$?$O\e(B nil")
 205
 206 (defconst its-setup-fence-before-insert-SYL nil)
 207
 208 (defun its-put-cursor (cursor)
 209   (let ((p (point)))
 210     (insert "!")
 211     (add-text-properties p (point) (list 'local-map its-mode-map
 212                                          'invisible t
 213                                          'intangible 'its-part-2
 214                                          'its-cursor cursor))
 215     (goto-char p)))
 216
 217 (defsubst its-set-cursor-status (cursor)
 218   (put-text-property (point) (1+ (point)) 'its-cursor cursor)
 219   cursor)
 220
 221 ;;
 222 ;;  +-- START property
 223 ;;  |          --- CURSOR Property
 224 ;;  |         /
 225 ;;  v        v    v-- END Property
 226 ;;  |SYL SYL ^ SYL|
 227 ;;   ^^^ ^^^   ^^^------ SYL Property
 228 ;;  <-------><---->
 229 ;; intangible intangible
 230 ;;     1       2
 231 ;;
 232 (defun its-setup-fence-mode ()
 233   (let ((open-props '(its-start t intangible its-part-1))
 234         (close-props '(its-end t intangible its-part-2))
 235         (p (point)) p1)
 236     (insert its-fence-open)
 237     (setq p1 (point))
 238     (add-text-properties p p1 open-props)
 239     (insert its-fence-close)
 240     (add-text-properties p1 (point) close-props)
 241     (if its-fence-face
 242         (put-text-property 'invisible t p (point)))
 243     (goto-char p1)
 244     (its-put-cursor t)))
 245
 246 (defun its-start (key)
 247   (let ((its-setup-fence-before-insert-SYL t))
 248     (its-input nil key)
 249     (force-mode-line-update)))
 250
 251 (defun its-restart (str)
 252   (let (p)
 253     (its-setup-fence-mode t)
 254     (setq p (point))
 255     (insert str)
 256     (its-beginning-of-input-buffer)))
 257
 258 (defun its-self-insert-char ()
 259   (interactive)
 260   (let ((key last-command-char)
 261         (syl nil))
 262     (if (null (get-text-property (point) 'its-cursor))
 263         (setq syl (get-text-property (1- (point)) 'its-syl)))
 264     (its-input syl key)))
 265
 266 (defvar its-current-map nil)
 267 (make-variable-buffer-local 'its-current-map)
 268 (put 'its-current-map 'permanent-local t)
 269
 270 (defun its-initial-ISYL ()
 271   (its-get-start-state its-current-map))
 272
 273 (defun its-make-VSYL (keyseq)
 274   (cons keyseq (length keyseq)))
 275
 276 ;; Return CURSOR
 277 (defun its-input (syl key)
 278   (if (null syl)
 279       (setq syl (its-initial-ISYL)))
 280   (let ((output (car syl))
 281         (k/kk/s (cdr syl)))
 282     (if (numberp k/kk/s)
 283         ;; k/kk/s is "point in keyseq"
 284         (its-input-to-vsyl syl key k/kk/s output)
 285       ;; It's ISYL
 286       (its-state-machine syl key 'its-buffer-ins/del-SYL))))
 287
 288 (defun its-input-to-vsyl (syl key point output)
 289   (if (< key 0)
 290       t
 291     (let ((len (length output)))
 292       (if (= len point)
 293           ;; point is at end of VSYL.  Don't need to call state machine.
 294           (its-buffer-ins/del-SYL
 295            (its-make-VSYL (concat output (vector key))) syl nil)
 296         ;; point is at middle of VSYL.
 297         (let ((new-keyseq (concat (substring output 0 point)
 298                                   (vector key)
 299                                   (substring output point))))
 300           (its-state-machine-keyseq new-keyseq 'its-buffer-ins/del-SYL))))))
 301
 302 (defvar its-barf-on-invalid-keyseq nil
 303   "T means don't allow invalid key sequence in input buffer.")
 304
 305 (defun its-input-error ()
 306   (error "Invalid Romaji Sequence"))
 307
 308 \f
 309 ;;;
 310 ;;; ITS State Machine
 311 ;;;
 312
 313 ;; Return CURSOR
 314 (defun its-state-machine (state key emit)
 315   (let ((next-state (its-get-next-state state key))
 316         expr-output-back kst/t output keyseq back)
 317     (cond
 318      ;; proceed to next status
 319      (next-state
 320       (setq kst/t (its-get-kst/t next-state)
 321             output (its-get-output next-state)
 322             keyseq (its-get-keyseq next-state))
 323       (cond
 324        ;; Still, it's a intermediate state.
 325        ((its-kst-p kst/t)
 326         (funcall emit next-state state nil))
 327
 328        ;; It's negative integer which specifies how many
 329        ;; characters we go backwards
 330        (kst/t
 331         (funcall emit next-state state 'its-cursor)
 332         (its-state-machine-keyseq (substring keyseq kst/t) emit (< key 0)))
 333
 334         ;; Here we arrive to a terminal state.
 335         ;; Emit a DSYL, and go ahead.
 336        (t
 337         (funcall emit next-state state 'its-cursor))))
 338
 339      ;; push back by otherwise status
 340      ((and (>= key 0)
 341            (setq expr-output-back (its-get-otherwise state key)))
 342       (setq keyseq (concat (its-get-keyseq state) (vector key)))
 343       (funcall emit expr-output-back state t)
 344       (its-state-machine-keyseq
 345        (substring keyseq (its-eob-back expr-output-back)) emit))
 346
 347      ;; No next state for KEY.  It's invalid sequence.
 348      (its-barf-on-invalid-keyseq
 349       (its-input-error))
 350
 351      ;; no next state for END of keystroke
 352      ((< key 0)
 353       ;; ISYL --> DSYL   XXX
 354       (funcall emit (cons (car state)
 355                           (list (its-get-keyseq state))) state t))
 356      (t
 357       ;; XXX Should make DSYL (instead of VSYL)?
 358       (setq keyseq (concat (its-get-keyseq state) (vector key)))
 359       (funcall emit (its-make-VSYL keyseq) state nil)))))
 360
 361 (defvar its-latest-SYL nil
 362   "The latest SYL inserted.")
 363 (defsubst its-update-latest-SYL (syl)
 364   (setq its-latest-SYL syl))
 365
 366 ;; Return CURSOR
 367 (defun its-state-machine-keyseq (keyseq emit &optional eol)
 368   (let ((i 0)
 369         (len (length keyseq))
 370         (syl (its-initial-ISYL))
 371         cursor)
 372     (while (< i len)
 373       (cond
 374        ((numberp (cdr syl))
 375         ;; VSYL - no need looping
 376         (funcall emit (its-make-VSYL (concat (car syl) keyseq)) syl nil)
 377         (setq cursor nil
 378               i len))
 379        (t
 380         (setq cursor (its-state-machine syl (aref keyseq i) emit))))
 381       (setq syl (if cursor (its-initial-ISYL) its-latest-SYL)
 382             i (1+ i)))
 383     (if eol
 384         (its-state-machine syl -1 emit)
 385       cursor)))
 386
 387 (defun its-buffer-ins/del-SYL (newsyl oldsyl cursor)
 388   (if its-setup-fence-before-insert-SYL
 389       (progn
 390         (setq its-setup-fence-before-insert-SYL nil)
 391         (its-setup-fence-mode)))
 392   (its-buffer-delete-SYL oldsyl)
 393   (its-update-latest-SYL newsyl)
 394   (let ((p (point)))
 395     (insert (its-get-output newsyl))
 396     (add-text-properties p (point)
 397                          (list 'its-syl newsyl
 398                                'its-map its-current-map
 399                                'its-lang its-current-language
 400                                'intangible 'its-part-1))
 401     (if its-fence-face
 402         (put-text-property p (point) 'face its-fence-face))
 403     (its-set-cursor-status cursor)))
 404
 405 (defun its-buffer-delete-SYL (syl)
 406   (let ((len (length (its-get-output syl))))
 407     (delete-region (- (point) len) (point))))
 408
 409 (defun its-get-next-state (state key)
 410   (let ((kst/t (its-get-kst/t state)))
 411     (cdr (assq key (car kst/t)))))
 412
 413 ;; XXX XXX XXX
 414 (defun its-otherwise-match (expr key)
 415   (or (null expr)                       ; <expr>::= NIL means "ANY"
 416       (let ((case-fold-search nil))
 417         (string-match expr (char-to-string key)))))
 418
 419 (defun its-get-otherwise (state key)
 420   (let* ((kst/t (its-get-kst/t state))
 421          (ebl (cdr kst/t))
 422          expr-output-back)
 423       (while ebl
 424         (setq expr-output-back (car ebl))
 425         (let ((expr (its-eob-keyexpr expr-output-back)))
 426           (if (its-otherwise-match expr key)
 427               (setq ebl nil)
 428             (setq ebl (cdr ebl)))))
 429       expr-output-back))
 430 \f
 431 ;;;
 432 ;;; Name --> map
 433 ;;;
 434 ;;; ITS name: string
 435
 436 (defvar its-map-alist nil)
 437
 438 (defun its-get-map (name)
 439   (assoc name its-map-alist))
 440
 441 (defun its-register-map (map)
 442   (let* ((name (car map))
 443          (place (assoc name its-map-alist)))
 444     (if place
 445         (setcdr place (cdr map))
 446       (setq its-map-alist (cons map its-map-alist)))
 447     map))
 448
 449 (defmacro define-its-state-machine (map name indicator lang doc &rest exprs)
 450   `(progn
 451      (eval-when (eval compile)
 452        (let ((its-current-map (its-new-map ,name ,indicator ,lang)))
 453          ,@exprs
 454          (setq ,map its-current-map)))
 455      (define-its-compiled-map ,map ,doc)))
 456
 457 (defmacro define-its-compiled-map (map doc)
 458   `(defconst ,map ',(symbol-value map) ,doc))
 459
 460 (defmacro define-its-state-machine-append (map &rest exprs)
 461   (append
 462    `(let ((its-current-map ,map)))
 463    exprs
 464    (list `(setq ,map its-current-map))))
 465
 466 ;;
 467 ;; Construct State Machine
 468 ;;
 469 (defun its-defrule (input output &optional back enable-overwrite)
 470   "\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
 471 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
 472 \e$BLa$C$FF0$/$b$N$H$9$k!#JQ495,B'$O$b$C$H$b:G6a$K\e(B its-define-state-machine
 473 \e$B$5$l$?JQ49I=$KEPO?$5$l$k!#\e(B
 474 Return last state."
 475   (let ((state (its-goto-state (substring input 0 -1) nil t))
 476         (key (aref input (1- (length input)))))
 477     (if (and (its-get-next-state state key) (not enable-overwrite))
 478         (error "Duplicated definition (%s)" input)
 479       (its-make-next-state state key input output back))))
 480
 481 (defun its-goto-state (input &optional initial-state build-if-none)
 482   (let ((len (length input))
 483         (i 0)
 484         (state (or initial-state (its-get-start-state its-current-map))))
 485     (while (< i len)
 486       (setq state
 487             (or (its-get-next-state state (aref input i))
 488                 (if build-if-none
 489                     (let ((keyseq (substring input 0 (1+ i))))
 490                       (its-make-next-state state (aref input i) keyseq keyseq))
 491                    (error "No such state (%s)" input)))
 492             i (1+ i)))
 493     state))
 494
 495 (defun its-defoutput (input display)
 496   (let ((state (its-goto-state input)))
 497     (its-set-output state display)))
 498
 499 (defun its-define-otherwise (state otherwise)
 500   (let ((kst (its-get-kst/t state)))
 501     (if kst
 502         (setcdr kst (cons otherwise (cdr kst)))
 503       (its-set-kst state (cons nil (cons otherwise nil))))))
 504
 505 (defconst its-otherwise-back-one
 506   (its-make-class+back nil -1))
 507
 508 (defun its-defrule-otherwise (state output &optional class back)
 509   (let (class+back)
 510     (if (null back)
 511         (setq class+back its-otherwise-back-one)
 512       (setq class+back (its-make-class+back class back)))
 513     (its-define-otherwise state
 514                           (its-make-otherwise output class+back))))
 515
 516 (defun its-defrule* (input output)
 517   (let ((state (its-defrule input output)))
 518     (its-defrule-otherwise state output)))
 519
 520 (defun its-make-next-state (state key keyseq output &optional back)
 521   (let ((next-state (its-new-state output keyseq back))
 522         (kst (its-get-kst/t state)))
 523     (if kst
 524         (setcar kst (cons (cons key next-state) (car kst)))
 525       (its-set-kst state (list (list (cons key next-state)))))
 526     next-state))
 527 \f
 528 ;;;
 529 (defun its-beginning-of-input-buffer ()
 530   (interactive)
 531   (its-input-end)
 532   (if (not (get-text-property (1- (point)) 'its-start))
 533       (let ((begpos (previous-single-property-change (point) 'its-start)))
 534         ;; Make SYLs have property of "part 2"
 535         (put-text-property begpos (point) 'intangible 'its-part-2)
 536         (goto-char begpos)))
 537   (its-put-cursor t))
 538
 539 (defun its-end-of-input-buffer ()
 540   (interactive)
 541   (its-input-end)
 542   (if (not (get-text-property (point) 'its-end))
 543       (let ((endpos (next-single-property-change (point) 'its-end)))
 544         ;; Make SYLs have property of "part 1"
 545         (put-text-property (point) endpos 'intangible 'its-part-1)
 546         (goto-char endpos)))
 547   (its-put-cursor t))
 548
 549 ;; TODO: move in VSYL
 550 (defun its-backward-SYL (n)
 551   (interactive "p")
 552   (its-input-end)
 553   (let ((syl (get-text-property (1- (point)) 'its-syl))
 554         (p (point))
 555         (old-point (point)))
 556     (while (and syl (> n 0))
 557       (setq p (- p (length (its-get-output syl))))
 558       (setq syl (get-text-property (1- p) 'its-syl))
 559       (setq n (1- n)))
 560     ;; Make SYLs have property of "part 2"
 561     (put-text-property p old-point 'intangible 'its-part-2)
 562     (goto-char p)
 563     (its-put-cursor t)
 564     (if (> n 0)
 565         (signal 'beginning-of-buffer nil))))
 566
 567 ;; TODO: move in VSYL
 568 (defun its-forward-SYL (n)
 569   (interactive "p")
 570   (its-input-end)
 571   (let ((syl (get-text-property (point) 'its-syl))
 572         (p (point))
 573         (old-point (point)))
 574     (while (and syl (> n 0))
 575       (setq p (+ p (length (its-get-output syl))))
 576       (setq syl (get-text-property p 'its-syl))
 577       (setq n (1- n)))
 578     ;; Make SYLs have property of "part 1"
 579     (put-text-property p old-point 'intangible 'its-part-1)
 580     (goto-char p)
 581     (its-put-cursor t)
 582     (if (> n 0)
 583         (signal 'end-of-buffer nil))))
 584
 585 ;; TODO: handle VSYL.  KILLFLAG
 586 (defun its-delete-SYL (n killflag)
 587   (interactive "p\nP")
 588   (its-input-end)
 589   (let ((syl (get-text-property (point) 'its-syl))
 590         (p (point)))
 591     (while (and syl (> n 0))
 592       (setq p (+ p (length (its-get-output syl))))
 593       (setq syl (get-text-property p 'its-syl))
 594       (setq n (1- n)))
 595     (if (> n 0)
 596         (progn
 597           (its-put-cursor t)
 598           (signal 'args-out-of-range (list p n)))
 599       (delete-region (point) p)
 600       ;; Check if empty
 601       (let ((s (get-text-property (1- (point)) 'its-start))
 602             (e (get-text-property (point) 'its-end)))
 603         (if (and s e)
 604             (its-exit-mode-internal)
 605           (its-put-cursor t))))))
 606
 607 ;; TODO: killflag
 608 (defun its-delete-backward-SYL (n killflag)
 609   (interactive "p\nP")
 610   (let ((syl (get-text-property (1- (point)) 'its-syl))
 611         (cursor (get-text-property (point) 'its-cursor)))
 612     (if (null syl)
 613         (signal 'beginning-of-buffer nil)
 614       (if (eq cursor t)
 615           (its-delete-backward-SYL-internal n killflag)
 616         (its-delete-backward-within-SYL syl n killflag)))))
 617
 618 ;; TODO: killflag
 619 (defun its-delete-backward-SYL-internal (n killflag)
 620   (let ((syl (get-text-property (1- (point)) 'its-syl))
 621         (p (point)))
 622     (while (and syl (> n 0))
 623       (setq p (- p (length (its-get-output syl))))
 624       (setq syl (get-text-property (1- p) 'its-syl))
 625       (setq n (1- n)))
 626     (if (> n 0)
 627         (signal 'args-out-of-range (list p n))
 628       (delete-region p (1+ (point)))    ; also delete cursor
 629       ;; Check if empty
 630       (let ((s (get-text-property (1- (point)) 'its-start))
 631             (e (get-text-property (point) 'its-end)))
 632         (if (and s e)
 633             (its-exit-mode-internal)
 634           (its-put-cursor t))))))
 635
 636 (defvar its-delete-by-keystroke nil)
 637
 638 ;; TODO: killflag
 639 (defun its-delete-backward-within-SYL (syl n killflag)
 640   (let* ((keyseq (its-get-keyseq-syl syl))
 641          (len (length keyseq))
 642          (p (point))
 643          (its-current-map (get-text-property (1- (point)) 'its-map)))
 644     (if (> n len)
 645         (signal 'args-out-of-range (list p n)))
 646     ;; Delete CURSOR
 647     (delete-region p (1+ p))
 648     (its-buffer-delete-SYL syl)
 649     (if (= n len)
 650         ;; Check if empty
 651         (let ((s (get-text-property (1- (point)) 'its-start))
 652               (e (get-text-property (point) 'its-end)))
 653           (if (and s e)
 654               (its-exit-mode-internal)
 655             (its-put-cursor (not its-delete-by-keystroke))))
 656       (setq keyseq (substring keyseq 0 (- len n)))
 657       (let ((r (its-state-machine-keyseq keyseq 'its-buffer-ins/del-SYL)))
 658         (its-put-cursor r)))))
 659
 660 ;; XXX: NIY
 661 (defun its-transpose-chars (n)
 662   (interactive)
 663   (let ((syl (get-text-property (1- (point)) 'its-syl))
 664         (cursor (get-text-property (point) 'its-cursor)))
 665     (if (null syl)
 666         (signal 'beginning-of-buffer nil)
 667       (if (eq cursor t)
 668           (its-delete-backward-SYL-internal n nil)
 669         (its-delete-backward-within-SYL syl 2 nil)))))
 670
 671 ;; Return VOID
 672 (defun its-input-end ()
 673   (let ((cursor (get-text-property (point) 'its-cursor)))
 674     ;; key "END"
 675     (if (null cursor)
 676         (its-input (get-text-property (1- (point)) 'its-syl) -1))
 677     (delete-region (point) (1+ (point)))))
 678
 679 (defun its-exit-mode ()
 680   "Exit ITS mode."
 681   (interactive)
 682   (its-input-end)
 683   (its-exit-mode-internal))
 684
 685 (defun its-exit-mode-off-input-method ()
 686   "Exit ITS mode."
 687   (interactive)
 688   (its-input-end)
 689   (its-exit-mode-internal)
 690   (inactivate-input-method))
 691
 692 ;; TODO: handle overwrite-mode, insertion-hook, fill...
 693 (defun its-exit-mode-internal (&optional proceed-to-conversion)
 694   (let (start end)
 695     ;; Delete open fence
 696     (if (get-text-property (1- (point)) 'its-start)
 697         (setq start (1- (point)))
 698       (setq start (1- (previous-single-property-change (point) 'its-start))))
 699     (delete-region start (1+ start))
 700     ;; Delete close fence
 701     (if (get-text-property (point) 'its-end)
 702         (setq end (point))
 703       (setq end (next-single-property-change (point) 'its-end)))
 704     (delete-region end (1+ end))
 705     ;; Remove all properties added by ITS
 706     (remove-text-properties start end '(its-map nil
 707                                         face nil
 708                                         intangible nil))
 709     (if proceed-to-conversion
 710         (egg-convert-region start end)
 711       (remove-text-properties start end '(its-lang nil its-syl nil))
 712       (egg-do-auto-fill)
 713       (run-hooks 'input-method-after-insert-chunk-hook))))
 714
 715 (defun its-kick-convert-region ()
 716   (interactive)
 717   (its-input-end)
 718   (its-exit-mode-internal t))
 719
 720 (defun its-in-fence-p ()
 721   (let ((prop (get-text-property (point) 'intangible)))
 722     (or (eq prop 'its-part-1) (eq prop 'its-part-2))))
 723 \f
 724 (defvar its-translation-result "" "")
 725
 726 (defun its-ins/del-SYL-batch (newsyl oldsyl cursor)
 727   (its-update-latest-SYL newsyl)
 728   (if (and newsyl
 729            (consp (cdr newsyl))
 730            (not (its-kst-p (its-get-kst/t newsyl))))
 731       ;; DSYL
 732       (let ((output (its-get-output newsyl))
 733             (oldlen (length its-translation-result)))
 734         (setq its-translation-result (concat its-translation-result output))
 735         (put-text-property oldlen (length its-translation-result)
 736                            'its-lang its-current-language
 737                            its-translation-result)))
 738   cursor)
 739
 740 (defun its-translate-region (start end)
 741   (interactive "r")
 742   (its-translate-region-internal start end)
 743   (remove-text-properties start (point) '(its-lang nil)))
 744
 745 (defun its-translate-region-internal (start end)
 746   (setq its-translation-result "")
 747   (goto-char start)
 748   (let ((i 0)
 749         (syl (its-initial-ISYL))
 750         ;; temporally enable DING
 751         (its-barf-on-invalid-keyseq t)
 752         cursor)
 753     (while (< (point) end)
 754       (let ((key (following-char)))
 755         (setq cursor (its-state-machine syl key 'its-ins/del-SYL-batch))
 756         (forward-char 1)
 757         (if cursor
 758             (setq syl (its-initial-ISYL))
 759           (setq syl its-latest-SYL))))
 760     (if (eq syl its-latest-SYL)
 761         (its-state-machine syl -1 'its-ins/del-SYL-batch))
 762     (delete-region start end)
 763     (insert its-translation-result)))
 764 \f
 765 (require 'its-keydef)
 766
 767 (provide 'its)
 768 ;;; its.el ends here.