its.el

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