X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Fegg.git;a=blobdiff_plain;f=its.el;h=89c5bd20671971044af2a411dd877ffc092bc270;hp=6a194304f0ed3df6387bc4c220f25a2d451786f7;hb=d0114d80c7a6a1a573bb3adc0fd4a3b25fa1e27e;hpb=ed251433bb11d5790aa07002880de16b8fedf59c

diff --git a/its.el b/its.el
index 6a19430..89c5bd2 100644
--- a/its.el
+++ b/its.el
@@ -1,21 +1,22 @@
 ;;; its.el --- Input Translation Systam AKA "ITS(uDekirunDa!)"
 
-;; Copyright (C) 1997 Mule Project, Powered by Electrotechnical
+;; Copyright (C) 1997, 1998 Mule Project, Powered by Electrotechnical
 ;; Laboratory, JAPAN.
 ;; Project Leader: Satoru Tomura <tomura@etl.go.jp>
 
 ;; Author: NIIBE Yutaka <gniibe@mri.co.jp>
+;;         KATAYAMA Yoshio <kate@pfu.co.jp>
 ;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>
 ;; Keywords: mule, multilingual, input method
 
 ;; This file will be part of GNU Emacs (in future).
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; EGG is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; any later version.
 
-;; GNU Emacs is distributed in the hope that it will be useful,
+;; EGG is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
@@ -29,6 +30,24 @@
 
 ;;; Code:
 
+(require 'cl)
+
+(defvar its-current-map nil)
+(make-variable-buffer-local 'its-current-map)
+(put 'its-current-map 'permanent-local t)
+
+(defvar its-current-select-func nil)
+(make-variable-buffer-local 'its-current-select-func)
+(put 'its-current-select-func 'permanent-local t)
+
+(defvar its-previous-select-func nil)
+(make-variable-buffer-local 'its-previous-select-func)
+(put 'its-previous-select-func 'permanent-local t)
+
+(defvar its-current-language)
+(make-variable-buffer-local 'its-current-language)
+(put 'its-current-language 'permanent-local t)
+
 ;; Data structure in ITS
 ;; (1) SYL and CURSOR
 ;;
@@ -82,30 +101,27 @@
 
 ;; Data structure in ITS (3) Map
 ;;
-;; <map>         ::= ( <name> . ( <indicator> . <start-state> ) )
-;; <start-state> ::= <state>
+;; <map>         ::= ( <name> <indicator> <language> . <start-state> )
 ;; <name>        ::= "string"
 ;; <indicator>   ::= "string"
+;; <language>    ::= "string"
+;; <start-state> ::= <state>
 ;;
 
 (defsubst its-new-state (output keyseq back)
   (cons output (cons keyseq back)))
 
-(defsubst its-new-map (name indicator)
-  (cons name (cons indicator (its-new-state "" "" nil))))
+(defsubst its-new-map (name indicator language)
+  (cons name (cons indicator (cons language (its-new-state "" "" nil)))))
 
 (defsubst its-get-indicator (map)
-  (car (cdr map)))
+  (nth 1 map))
 
-(defsubst its-set-indicator (map indicator)
-  (setcar (cdr map) indicator))
+(defsubst its-get-language (map)
+  (nth 2 map))
 
 (defsubst its-get-start-state (map)
-  (cdr (cdr map)))
-
-(defsubst its-reset-start-state (map)
-  (setcdr (cdr map) (its-new-state "" "" nil))
-  map)
+  (nthcdr 3 map))
 
 (defsubst its-get-kst/t (state)
   (cdr (cdr state)))
@@ -118,6 +134,7 @@
 
 (defsubst its-set-keyseq (state keyseq)
   (setcar (cdr state) keyseq))
+
 (defun its-get-keyseq-cooked (state)
   (let ((keyseq (its-get-keyseq state))
 	(back (its-get-kst/t state)))
@@ -140,8 +157,10 @@
 	   l)
 	  ((numberp l)			; VSYL
 	   (car syl))
+	  ((numberp (cdr l))
+	   (substring (car l) 0 (cdr l)))
 	  (t
-	   (car (cdr syl))))))
+	   (car l)))))
 
 (defsubst its-eob-keyexpr (eob)
   (car (cdr eob)))
@@ -152,17 +171,35 @@
   (cons class back))
 (defsubst its-make-otherwise (output class+back)
   (cons output class+back))
+
+(defsubst its-DSYL-with-back-p (syl)
+  (and (consp (cdr syl))
+       (numberp (its-get-kst/t syl))))
+
+(defsubst its-concrete-DSYL-p (syl)
+  (stringp (cdr syl)))
+
+(defsubst its-make-concrete-DSYL (syl)
+  (if (consp (cdr syl))
+      (cons (its-get-output syl) (its-get-keyseq-syl syl))
+    syl))
+    
 ;;
 ;;
 
+(eval-when (eval load compile)
+  (require 'its-keydef))
+
 (defvar its-mode-map
   (let ((map (make-sparse-keymap))
 	(i 33))
     (define-key map "\C-a" 'its-beginning-of-input-buffer)
     (define-key map "\C-b" 'its-backward-SYL)
+    (define-key map "\C-c" 'its-cancel-input)
     (define-key map "\C-d" 'its-delete-SYL)
     (define-key map "\C-e" 'its-end-of-input-buffer)
     (define-key map "\C-f" 'its-forward-SYL)
+    (define-key map "\C-g" 'its-select-previous-mode)
     (define-key map "\C-]" 'its-cancel-input)
     (define-key map "\C-h" 'its-mode-help-command)
     (define-key map "\C-k" 'its-kill-line)
@@ -170,43 +207,59 @@
     (define-key map "\C-m" 'its-exit-mode)	; RET
     (define-key map [return] 'its-exit-mode)
     (define-key map "\C-t" 'its-transpose-chars)
+    (define-key map "\C-w" 'its-kick-convert-region)
+    (define-key map "\C-y" 'its-yank)
+    (define-key map "\M-y" 'its-yank-pop)
+    (define-key map [backspace] 'its-delete-backward-SYL)
     (define-key map [delete] 'its-delete-backward-SYL)
+    (define-key map [M-backspace] 'its-delete-backward-SYL-by-keystroke)
+    (define-key map [M-delete] 'its-delete-backward-SYL-by-keystroke)
     (define-key map [right] 'its-forward-SYL)
     (define-key map [left] 'its-backward-SYL)
-    (define-key map "\C-\\" 'its-exit-mode-off-input-method)
     (while (< i 127)
       (define-key map (vector i) 'its-self-insert-char)
       (setq i (1+ i)))
-    (define-key map " "    'its-kick-convert-region)
+    (define-key map " "    'its-kick-convert-region-or-self-insert)
     (define-key map "\177" 'its-delete-backward-SYL)
     ;;
-    (define-key map "\C-p" 'its-previous-map)
-    (define-key map "\C-n" 'its-next-map)
-;   (define-key map "\M-h"    'its-hiragana) ; hiragana-region for input-buffer
-;   (define-key map "\M-k"    'its-katakana)
-;   (define-key map "\M-<"    'its-hankaku)
-;   (define-key map "\M->"    'its-zenkaku)
-;   (define-key map "\M-\C-h" 'its-select-hiragana)
-;   (define-key map "\M-\C-k" 'its-select-katakana)
-;;;    (define-key map "\M-q"    'its-select-downcase) ; 
-;   (define-key map "\M-Q"    'its-select-upcase)
-;   (define-key map "\M-z"    'its-select-zenkaku-downcase)
-;   (define-key map "\M-Z"    'its-select-zenkaku-upcase)
+    (define-key map "\M-p" 'its-previous-map)
+    (define-key map "\M-n" 'its-next-map)
+    (define-key map "\M-h" 'its-hiragana) ; hiragana-region for input-buffer
+    (define-key map "\M-k" 'its-katakana)
+    (define-key map "\M-<" 'its-hankaku)
+    (define-key map "\M->" 'its-zenkaku)
+    (its-define-select-keys map t)
     map)
   "Keymap for ITS mode.")
 
-(defvar its-fence-open   "|" "*フェンスの始点を示す文字列 (1 文字)")
-(defvar its-fence-close  "|" "*フェンスの終点を示す文字列 (1 文字)")
-(defvar its-fence-face nil  "*フェンス表示に用いる face または nil")
+(defvar its-fence-open  "|" "*フェンスの始点を示す文字列 (1 文字以上)")
+(defvar its-fence-close "|" "*フェンスの終点を示す文字列 (1 文字以上)")
+(defvar its-fence-face  nil "*フェンス表示に用いる face または nil")
+
+(defconst its-setup-fence-before-insert-SYL nil)
+
+(defun its-get-fence-face ()
+  (let ((face (and (consp its-fence-face)
+		   (or (assoc its-current-language its-fence-face)
+		       (assoc t its-fence-face)))))
+    (if face (cdr face) its-fence-face)))
 
 (defun its-put-cursor (cursor)
-  (let ((p (point)))
+  (let ((p (point))
+	(map (copy-keymap its-mode-map)))
+    (its-define-select-keys map)
     (insert "!")
-    (add-text-properties p (point) (list 'local-map its-mode-map
+    (add-text-properties p (point) (list 'local-map map
+					 'read-only t
 					 'invisible t
 					 'intangible 'its-part-2
 					 'its-cursor cursor))
     (goto-char p)))
+
+(defsubst its-set-cursor-status (cursor)
+  (put-text-property (point) (1+ (point)) 'its-cursor cursor)
+  cursor)
+
 ;;
 ;;  +-- START property
 ;;  |          --- CURSOR Property
@@ -218,44 +271,51 @@
 ;; intangible intangible
 ;;     1       2
 ;;
-(defun its-start (key)
-  (let (p cursor)
-    (setq p (point))
+(defun its-setup-fence-mode ()
+  (let ((open-props '(its-start t intangible its-part-1))
+	(close-props '(rear-nonsticky t its-end t intangible its-part-2))
+	(p (point)) p1)
+    ;; Put open-fence before inhibit-read-only to detect read-nly
     (insert its-fence-open)
-    (add-text-properties p (point) 
-			 (let ((props '(its-start t intangible its-part-1)))
-			   (if its-fence-face
-			       (append '(invisible t) props)
-			     props)))
-    (setq p (point))
-    (setq cursor (its-input nil key))
-    (its-put-cursor cursor)
-    (forward-char 1)
+    (let ((inhibit-read-only t))
+      (setq p1 (point))
+      (add-text-properties p p1 open-props)
+      (insert its-fence-close)
+      (add-text-properties p1 (point) close-props)
+      (if its-fence-face
+	  (put-text-property p (point) 'invisible t))
+      (put-text-property p (point) 'read-only t)
+      (goto-char p1)
+      (its-put-cursor t))))
+
+(defun its-start (key)
+  (let ((its-setup-fence-before-insert-SYL t))
+    (its-input nil key)))
+
+(defun its-restart (str &optional set-prop)
+  (let (p)
+    (its-setup-fence-mode)
     (setq p (point))
-    (insert its-fence-close)
-    (add-text-properties p (point) 
-			 (let ((props '(its-end t intangible its-part-2)))
-			   (if its-fence-face
-			       (append '(invisible t) props)
-			     props)))
-    (forward-char -2)
-    (force-mode-line-update)))
+    (insert str)
+    (if set-prop
+	(its-setup-yanked-portion p (point)))
+    (its-beginning-of-input-buffer)))
 
 (defun its-self-insert-char ()
   (interactive)
-  (let ((key last-command-char)
+  (let ((inhibit-read-only t)
+	(key last-command-char)
 	(cursor (get-text-property (point) 'its-cursor))
-	(syl nil))
-    (if (null cursor)
-	(setq syl (get-text-property (1- (point)) 'its-syl)))
-    ;; delete cursor
-    (delete-region (point) (1+ (point)))
-    (setq cursor (its-input syl key))
-    (its-put-cursor cursor)))
-
-(defvar its-current-map nil)
-(make-variable-buffer-local 'its-current-map)
-(put 'its-current-map 'permanent-local t)
+	(syl (get-text-property (1- (point)) 'its-syl)))
+    (cond
+     ((or (eq cursor t)
+	  (not (eq (get-text-property (1- (point)) 'its-map) its-current-map)))
+      (put-text-property (- (point) (length (its-get-output syl))) (point)
+			 'its-syl (its-make-concrete-DSYL syl))
+      (setq syl nil))
+    (cursor
+     (setq syl nil)))
+    (its-input syl key)))
 
 (defun its-initial-ISYL ()
   (its-get-start-state its-current-map))
@@ -263,82 +323,105 @@
 (defun its-make-VSYL (keyseq)
   (cons keyseq (length keyseq)))
 
+(defvar its-barf-on-invalid-keyseq nil
+  "T means don't allow invalid key sequence in input buffer.")
+
+(defun its-input-error ()
+  (error "Invalid Romaji Sequence"))
+
 ;; Return CURSOR
 (defun its-input (syl key)
   (if (null syl)
       (setq syl (its-initial-ISYL)))
   (let ((output (car syl))
 	(k/kk/s (cdr syl)))
-    (if (numberp k/kk/s)
+    (cond
+     ((numberp k/kk/s)
 	;; k/kk/s is "point in keyseq"
-	(its-input-to-vsyl syl key k/kk/s output)
+	(its-input-to-vsyl syl key k/kk/s output))
+     ((and its-barf-on-invalid-keyseq
+	   (null (its-keyseq-acceptable-p (vector key) syl)))
+      ;; signal before altering
+      (its-input-error))
+     (t
       ;; It's ISYL
-      (its-state-machine syl key 'its-buffer-ins/del-SYL))))
+      (its-state-machine syl key 'its-buffer-ins/del-SYL)))))
 
 (defun its-input-to-vsyl (syl key point output)
   (if (< key 0)
-      t
+      (its-set-cursor-status t)
     (let ((len (length output)))
       (if (= len point)
 	  ;; point is at end of VSYL.  Don't need to call state machine.
-	  (progn
-	    (its-buffer-ins/del-SYL
-	     (its-make-VSYL (concat output (vector key))) syl)
-	    nil)
+	  (its-buffer-ins/del-SYL
+	   (its-make-VSYL (concat output (vector key))) syl nil)
 	;; point is at middle of VSYL.
 	(let ((new-keyseq (concat (substring output 0 point)
 				  (vector key)
 				  (substring output point))))
 	  (its-state-machine-keyseq new-keyseq 'its-buffer-ins/del-SYL))))))
-
-(defvar its-barf-on-invalid-keyseq nil
-  "T means don't allow invalid key sequence in input buffer.")
 
 ;;;
 ;;; ITS State Machine
 ;;;
 
+(defvar its-disable-special-action nil)
+
 ;; Return CURSOR
 (defun its-state-machine (state key emit)
   (let ((next-state (its-get-next-state state key))
-	expr-output-back)
-    (if next-state
-	(let ((kst/t (its-get-kst/t next-state)))
-	  (funcall emit next-state state)
-	  (if (not (its-kst-p kst/t))
-	      ;; Here we arrive to a terminal state.
-	      ;; Emit a DSYL, and go ahead.
-	      (let ((output (its-get-output next-state))
-		    (keyseq (its-get-keyseq next-state))
-		    (back kst/t))
-		(if back
-		    ;; It's negative integer which specifies how many
-		    ;; characters we go backwards
-		    (its-state-machine-keyseq (substring keyseq back)
-					      emit (< key 0))
-		  'its-cursor))
-	    ;; Still, it's a intermediate state.
-	    nil))
-      (if (and (>= key 0)
-	       (setq expr-output-back (its-get-otherwise state key)))
-	  (let ((keyseq (concat (its-get-keyseq state) (char-to-string key))))
-	    (funcall emit expr-output-back state)
-	    (its-state-machine-keyseq
-	     (substring keyseq (its-eob-back expr-output-back)) emit))
-	;; No next state for KEY.  It's invalid sequence.
-	(if (< key 0)		; no next state for END of keystroke
-	    ;; ISYL --> DSYL   XXX
-	    (if its-barf-on-invalid-keyseq
-		(error its-barf-on-invalid-keyseq)
-	      (funcall emit (cons (car state)
-				  (list (its-get-keyseq state))) state)
-	      t)
-	  (if its-barf-on-invalid-keyseq
-	      (error its-barf-on-invalid-keyseq)
-	    ;; XXX Should make DSYL (instead of VSYL)?
-	    (let ((keyseq (concat (its-get-keyseq state) (vector key))))
-	      (funcall emit (its-make-VSYL keyseq) state)
-	      nil)))))))
+	expr-output-back kst/t output keyseq back)
+    (cond
+     ;; proceed to next status
+     ((and next-state
+           (not (and its-disable-special-action
+                     (eq (its-get-kst/t next-state) t))))
+      (setq kst/t (its-get-kst/t next-state)
+	    output (its-get-output next-state)
+	    keyseq (its-get-keyseq next-state))
+      (cond
+       ;; Special actions.
+       ((eq kst/t t)
+	(funcall emit (cons "" keyseq) state 'its-cursor)
+	(apply (car output) (cdr output)))
+
+       ;; Still, it's a intermediate state.
+       ((its-kst-p kst/t)
+	(funcall emit next-state state nil))
+
+       ;; It's negative integer which specifies how many
+       ;; characters we go backwards
+       (kst/t
+	(funcall emit next-state state 'its-cursor)
+	(its-state-machine-keyseq (substring keyseq kst/t) emit (< key 0)))
+
+       ;; Here we arrive to a terminal state.
+       ;; Emit a DSYL, and go ahead.
+       (t
+	(funcall emit next-state state 'its-cursor))))
+
+     ;; push back by otherwise status
+     ((and (>= key 0)
+	   (setq expr-output-back (its-get-otherwise state key)))
+      (setq keyseq (concat (its-get-keyseq state) (vector key)))
+      (funcall emit
+	       (cons (its-get-output expr-output-back)
+		     (cons keyseq (its-eob-back expr-output-back)))
+	       state t)
+      (its-state-machine-keyseq
+       (substring keyseq (its-eob-back expr-output-back)) emit))
+
+     ((eq its-barf-on-invalid-keyseq 'its-keyseq-test)
+      'its-keyseq-test-failed)
+
+     ;; No next state for KEY.  It's invalid sequence.
+     (its-barf-on-invalid-keyseq
+      (its-input-error))
+
+     (t
+      ;; XXX Should make DSYL (instead of VSYL)?
+      (setq keyseq (concat (its-get-keyseq state) (if (> key 0) (vector key))))
+      (funcall emit (its-make-VSYL keyseq) state nil)))))
 
 (defvar its-latest-SYL nil
   "The latest SYL inserted.")
@@ -349,37 +432,46 @@
 (defun its-state-machine-keyseq (keyseq emit &optional eol)
   (let ((i 0)
 	(len (length keyseq))
-	(its-barf-on-invalid-keyseq nil) ; temporally disable DING
 	(syl (its-initial-ISYL))
 	cursor)
     (while (< i len)
-      (let ((key (aref keyseq i)))
-	(setq cursor 
-	      (if (numberp (cdr syl))		; VSYL
-		  (progn
-		    (funcall emit
-			     (its-make-VSYL (concat (car syl) (vector key)))
-			     syl)
-		    nil)
-		(its-state-machine syl key emit)))
-	(setq i (1+ i))
-	(if cursor
-	    (setq syl (its-initial-ISYL))
-	  (setq syl its-latest-SYL))))
-    (if eol
+      (cond
+       ((numberp (cdr syl))
+	;; VSYL - no need looping
+	(funcall emit
+		 (its-make-VSYL (concat (car syl) (substring keyseq i)))
+		 syl nil)
+	(setq cursor nil
+	      i len))
+       (t
+	(setq cursor (its-state-machine syl (aref keyseq i) emit))))
+      (if (eq cursor 'its-keyseq-test-failed)
+	  (setq i len)
+	(setq syl (if cursor (its-initial-ISYL) its-latest-SYL)
+	      i (1+ i))))
+    (if (and eol (not (eq cursor 'its-keyseq-test-failed)))
 	(its-state-machine syl -1 emit)
       cursor)))
 
-(defun its-buffer-ins/del-SYL (newsyl oldsyl)
-  (its-buffer-delete-SYL oldsyl)
-  (its-update-latest-SYL newsyl)
-  (let ((p (point)))
-    (insert (its-get-output newsyl))
-    (add-text-properties p (point)
-			 (list 'its-syl newsyl
-			       'intangible 'its-part-1))
-    (if its-fence-face
-	(put-text-property p (point) 'face its-fence-face))))
+(defun its-buffer-ins/del-SYL (newsyl oldsyl cursor)
+  (if its-setup-fence-before-insert-SYL
+      (progn
+	(setq its-setup-fence-before-insert-SYL nil)
+	(its-setup-fence-mode)))
+  (let ((inhibit-read-only t))
+    (its-buffer-delete-SYL oldsyl)
+    (its-update-latest-SYL newsyl)
+    (let ((p (point)))
+      (insert (its-get-output newsyl))
+      (add-text-properties p (point)
+			   (list 'its-map its-current-map
+				 'its-syl newsyl
+				 'egg-lang its-current-language
+				 'read-only t
+				 'intangible 'its-part-1))
+      (if its-fence-face
+	  (put-text-property p (point) 'face (its-get-fence-face)))
+      (its-set-cursor-status cursor))))
 
 (defun its-buffer-delete-SYL (syl)
   (let ((len (length (its-get-output syl))))
@@ -387,7 +479,8 @@
 
 (defun its-get-next-state (state key)
   (let ((kst/t (its-get-kst/t state)))
-    (cdr (assq key (car kst/t)))))
+    (and (listp kst/t)
+	 (cdr (assq key (car kst/t))))))
 
 ;; XXX XXX XXX
 (defun its-otherwise-match (expr key)
@@ -406,6 +499,36 @@
 	      (setq ebl nil)
 	    (setq ebl (cdr ebl)))))
       expr-output-back))
+
+(defun its-keyseq-acceptable-p (keyseq &optional syl eol)
+  (let ((i 0)
+	(len (length keyseq))
+	(its-barf-on-invalid-keyseq 'its-keyseq-test)
+	(its-latest-SYL nil)
+	(emit (lambda (nsyl osyl cursor)
+		(its-update-latest-SYL nsyl)
+		cursor))
+	(its-current-map its-current-map)
+	(its-current-select-func its-current-select-func)
+	(its-current-language its-current-language)
+	(its-zhuyin its-zhuyin)
+	(its-previous-select-func its-previous-select-func)
+	cursor)
+    (if (null syl)
+	(setq syl (its-initial-ISYL)))
+    (while (and syl (< i len))
+      (setq cursor (its-state-machine syl (aref keyseq i) emit))
+      (cond
+       ((eq cursor 'its-keyseq-test-failed)
+	(setq syl nil))
+       (cursor
+	(setq syl (its-initial-ISYL)))
+       (t
+	its-latest-SYL))
+      (setq i (1+ i)))
+    (if (and syl eol)
+	(setq cursor (its-state-machine syl -1 emit)))
+    (not (eq cursor 'its-keyseq-test-failed))))
 
 ;;;
 ;;; Name --> map
@@ -425,29 +548,16 @@
       (setq its-map-alist (cons map its-map-alist)))
     map))
 
-(defun its-define-state-machine (name indicator &optional continue)
-  "NAME で指定された State Machine の定義を開始する。
-INDICATOR は mode line に表示する indicator を指定する。
-CONTINUE が nil の時には State Machine の定義を空にする。its-defrule 
-を参照。"
-  (setq its-current-map
-	(if (null (its-get-map name))
-	    (its-register-map (its-new-map name indicator))
-	  (let ((map (its-get-map name)))
-	    (its-set-indicator map indicator)
-	    (if continue
-		map
-	      (its-reset-start-state map))))))
-
-(defmacro define-its-state-machine (map name indicator doc &rest exprs)
-  `(let ((its-current-map (its-new-map ,name ,indicator)))
-     ,(cons 'progn exprs)
-     (defconst ,map its-current-map ,doc)))
-
-;;(defmacro define-its-state-machine (map name indicator doc &rest exprs)
-;;  (let ((its-current-map (its-new-map name indicator)))
-;;    (eval (cons 'progn exprs))
-;;    `(defconst ,map ',its-current-map ,doc)))
+(defmacro define-its-state-machine (map name indicator lang doc &rest exprs)
+  `(progn
+     (eval-when (eval compile)
+       (let ((its-current-map (its-new-map ,name ,indicator ,lang)))
+	 ,@exprs
+	 (setq ,map its-current-map)))
+     (define-its-compiled-map ,map ,doc)))
+
+(defmacro define-its-compiled-map (map doc)
+  `(defconst ,map ',(symbol-value map) ,doc))
 
 (defmacro define-its-state-machine-append (map &rest exprs)
   (append
@@ -512,39 +622,90 @@ Return last state."
 (defun its-make-next-state (state key keyseq output &optional back)
   (let ((next-state (its-new-state output keyseq back))
 	(kst (its-get-kst/t state)))
-    (if kst
-	(setcar kst (cons (cons key next-state) (car kst)))
+    (cond
+     ((null kst)
       (its-set-kst state (list (list (cons key next-state)))))
+     ((consp kst)
+      (setcar kst (cons (cons key next-state) (car kst))))
+     (t
+      (error "Can't make new state after %S" (its-get-keyseq state))))
     next-state))
+
+(defmacro its-defrule-select-mode-temporally (input select-func)
+  `(its-defrule ,input '(its-select-mode-temporally
+			 ,(intern (concat "its-select-"
+					  (symbol-name select-func))))
+		t))
 
 ;;;
 (defun its-beginning-of-input-buffer ()
   (interactive)
-  (its-input-end)
-  (if (not (get-text-property (1- (point)) 'its-start))
-      (let ((begpos (previous-single-property-change (point) 'its-start)))
-	;; Make SYLs have property of "part 2"
-	(put-text-property begpos (point) 'intangible 'its-part-2)
-	(goto-char begpos)
-	(its-put-cursor t))))
+  (let ((inhibit-read-only t))
+    (its-input-end)
+    (if (not (get-text-property (1- (point)) 'its-start))
+	(let ((begpos (previous-single-property-change (point) 'its-start)))
+	  ;; Make SYLs have property of "part 2"
+	  (put-text-property begpos (point) 'intangible 'its-part-2)
+	  (goto-char begpos)))
+    (its-put-cursor t)))
 
 (defun its-end-of-input-buffer ()
   (interactive)
-  (its-input-end)
-  (if (not (get-text-property (point) 'its-end))
-      (let ((endpos (next-single-property-change (point) 'its-end)))
-	;; Make SYLs have property of "part 1"
-	(put-text-property (point) endpos 'intangible 'its-part-1)
-	(goto-char endpos)
-	(its-put-cursor t))))
+  (let ((inhibit-read-only t))
+    (its-input-end)
+    (if (not (get-text-property (point) 'its-end))
+	(let ((endpos (next-single-property-change (point) 'its-end)))
+	  ;; Make SYLs have property of "part 1"
+	  (put-text-property (point) endpos 'intangible 'its-part-1)
+	  (goto-char endpos)))
+    (its-put-cursor t)))
+
+(defun its-kill-line (n)
+  (interactive "p")
+  (let ((inhibit-read-only t)
+	(p (point)))
+    (its-input-end)
+    (if (> n 0)
+	(cond
+	 ((get-text-property (1- (point)) 'its-start)
+	  (its-cancel-input))
+	 ((get-text-property (point) 'its-end)
+	  (its-put-cursor t))
+	 (t
+	  (delete-region (next-single-property-change (point) 'its-end)
+			 (point))
+	  (its-put-cursor t)))
+      (cond
+       ((get-text-property (point) 'its-end)
+	(its-cancel-input))
+       ((get-text-property (1- (point)) 'its-start)
+	(its-put-cursor t))
+       (t
+	(delete-region (point)
+		       (previous-single-property-change (point) 'its-start))
+	(its-put-cursor t))))))
+
+(defun its-cancel-input ()
+  (interactive)
+  (let ((inhibit-read-only t))
+    (delete-region (if (get-text-property (1- (point)) 'its-start)
+		       (point)
+		     (previous-single-property-change (1- (point)) 'its-start))
+		   (if (get-text-property (point) 'its-end)
+		       (point)
+		     (next-single-property-change (point) 'its-end)))
+    (its-put-cursor t)
+    (its-exit-mode-internal)))
 
 ;; TODO: move in VSYL
 (defun its-backward-SYL (n)
   (interactive "p")
-  (its-input-end)
-  (let ((syl (get-text-property (1- (point)) 'its-syl))
-	(p (point))
-	(old-point (point)))
+  (let ((inhibit-read-only t)
+	syl p old-point)
+    (its-input-end)
+    (setq syl (get-text-property (1- (point)) 'its-syl)
+	  p (point)
+	  old-point (point))
     (while (and syl (> n 0))
       (setq p (- p (length (its-get-output syl))))
       (setq syl (get-text-property (1- p) 'its-syl))
@@ -559,16 +720,18 @@ Return last state."
 ;; TODO: move in VSYL
 (defun its-forward-SYL (n)
   (interactive "p")
-  (its-input-end)
-  (let ((syl (get-text-property (point) 'its-syl))
-	(p (point))
-	(old-point (point)))
+  (let ((inhibit-read-only t)
+	syl p old-point)
+    (its-input-end)
+    (setq syl (get-text-property (point) 'its-syl)
+	  p (point)
+	  old-point (point))
     (while (and syl (> n 0))
       (setq p (+ p (length (its-get-output syl))))
       (setq syl (get-text-property p 'its-syl))
       (setq n (1- n)))
     ;; Make SYLs have property of "part 1"
-    (put-text-property p old-point'intangible 'its-part-1)
+    (put-text-property old-point p 'intangible 'its-part-1)
     (goto-char p)
     (its-put-cursor t)
     (if (> n 0)
@@ -577,9 +740,11 @@ Return last state."
 ;; TODO: handle VSYL.  KILLFLAG
 (defun its-delete-SYL (n killflag)
   (interactive "p\nP")
-  (its-input-end)
-  (let ((syl (get-text-property (point) 'its-syl))
-	(p (point)))
+  (let ((inhibit-read-only t)
+	syl p)
+    (its-input-end)
+    (setq syl (get-text-property (point) 'its-syl)
+	  p (point))
     (while (and syl (> n 0))
       (setq p (+ p (length (its-get-output syl))))
       (setq syl (get-text-property p 'its-syl))
@@ -587,19 +752,19 @@ Return last state."
     (if (> n 0)
 	(progn
 	  (its-put-cursor t)
-	  (signal 'args-out-of-range (list p n)))
+	  (signal 'end-of-buffer nil))
       (delete-region (point) p)
+      (its-put-cursor t)
       ;; Check if empty
-      (let ((s (get-text-property (1- (point)) 'its-start))
-	    (e (get-text-property (point) 'its-end)))
-	(if (and s e)
-	    (its-exit-mode-internal)
-	  (its-put-cursor t))))))
+      (if (and (get-text-property (1- (point)) 'its-start)
+	       (get-text-property (1+ (point)) 'its-end))
+	  (its-exit-mode-internal)))))
 
 ;; TODO: killflag
 (defun its-delete-backward-SYL (n killflag)
   (interactive "p\nP")
-  (let ((syl (get-text-property (1- (point)) 'its-syl))
+  (let ((inhibit-read-only t)
+	(syl (get-text-property (1- (point)) 'its-syl))
 	(cursor (get-text-property (point) 'its-cursor)))
     (if (null syl)
 	(signal 'beginning-of-buffer nil)
@@ -616,48 +781,168 @@ Return last state."
       (setq syl (get-text-property (1- p) 'its-syl))
       (setq n (1- n)))
     (if (> n 0)
-	(signal 'args-out-of-range (list p n))
+	(signal 'beginning-of-buffer nil)
       (delete-region p (1+ (point)))	; also delete cursor
+      (its-put-cursor t)
       ;; Check if empty
-      (let ((s (get-text-property (1- (point)) 'its-start))
-	    (e (get-text-property (point) 'its-end)))
-	(if (and s e)
-	    (its-exit-mode-internal)
-	  (its-put-cursor t))))))
+      (if (and (get-text-property (1- (point)) 'its-start)
+	       (get-text-property (1+ (point)) 'its-end))
+	  (its-exit-mode-internal)))))
 
 (defvar its-delete-by-keystroke nil)
 
+(defun its-delete-backward-SYL-by-keystroke (n killflag)
+  (interactive "p\nP")
+  (let ((inhibit-read-only t)
+	(its-delete-by-keystroke t))
+    (its-delete-backward-SYL n killflag)))
+
 ;; TODO: killflag
 (defun its-delete-backward-within-SYL (syl n killflag)
   (let* ((keyseq (its-get-keyseq-syl syl))
 	 (len (length keyseq))
-	 (p (point)))
+	 (p (- (point) (length (its-get-output syl))))
+	 (its-current-map (get-text-property (1- (point)) 'its-map))
+	 (its-current-language (get-text-property (1- (point)) 'egg-lang))
+	 back pp)
+    (if (< n 0)
+	(signal 'args-out-of-range (list (- (point) n) (point))))
+    (if its-delete-by-keystroke
+      (while (null (or (eq p pp) (its-concrete-DSYL-p syl)))
+	  (setq pp p)
+	  (while (and (setq syl (get-text-property (1- p) 'its-syl))
+		      (its-DSYL-with-back-p syl)
+		      (<= (setq back (- (its-get-kst/t syl))) len)
+		      (> back (- len n))
+		      (equal (substring (its-get-keyseq syl) (- back))
+			     (substring keyseq 0 back)))
+	    (setq keyseq (concat (its-get-keyseq-syl syl) keyseq)
+		  len (length keyseq)
+		  p (- p (length (its-get-output syl)))))
+	  (if (and (eq p pp) syl (> n len))
+	      (setq n (- n len)
+		    keyseq (its-get-keyseq-syl syl)
+		    len (length keyseq)
+		    p (- p (length (its-get-output syl))))))
+      (if (and (> n len) (its-concrete-DSYL-p syl))
+	  (setq len 1)))
     (if (> n len)
-	(signal 'args-out-of-range (list p n)))
-    ;; Delete CURSOR
-    (delete-region p (1+ p))
-    (its-buffer-delete-SYL syl)
-    (if (= n len)
-	;; Check if empty
-	(let ((s (get-text-property (1- (point)) 'its-start))
-	      (e (get-text-property (point) 'its-end)))
-	  (if (and s e)
-	      (its-exit-mode-internal)
-	    (its-put-cursor (not its-delete-by-keystroke))))
-      (setq keyseq (substring keyseq 0 (- len n)))
-      (let ((r (its-state-machine-keyseq keyseq 'its-buffer-ins/del-SYL)))
-	(its-put-cursor r)))))
-
-;; XXX: NIY
+	(setq n (- n len)
+	      len 0))
+    (while (and (> n len) (setq syl (get-text-property (1- p) 'its-syl)))
+      (setq n (1- n)
+	    p (- p (length (its-get-output syl)))))
+    (if (> n len)
+	(signal 'beginning-of-buffer nil))
+    (delete-region p (point))
+    (cond
+     ((> len n)
+      (its-state-machine-keyseq (substring keyseq 0 (- len n)) 
+				'its-buffer-ins/del-SYL))
+     ;; Check if empty
+     ((and (get-text-property (1- (point)) 'its-start)
+	   (get-text-property (1+ (point)) 'its-end))
+      (its-exit-mode-internal))
+     ((and its-delete-by-keystroke
+	   (null (its-concrete-DSYL-p (get-text-property (1- p) 'its-syl))))
+      (its-set-cursor-status 'its-cursor))
+     (t
+      (its-set-cursor-status t)))))
+
 (defun its-transpose-chars (n)
-  (interactive)
-  (let ((syl (get-text-property (1- (point)) 'its-syl))
-	(cursor (get-text-property (point) 'its-cursor)))
-    (if (null syl)
-	(signal 'beginning-of-buffer nil)
-      (if (eq cursor t)
-	  (its-delete-backward-SYL-internal n nil)
-	(its-delete-backward-within-SYL syl 2 nil)))))
+  (interactive "p")
+  (let ((inhibit-read-only t)
+	(syl (get-text-property (1- (point)) 'its-syl))
+	(cursor (get-text-property (point) 'its-cursor))
+	keyseq len)
+    (cond
+     ((null syl)
+      (signal 'beginning-of-buffer nil))
+     ((eq cursor t)
+      (if (and (= n 1) (get-text-property (1+ (point)) 'its-end))
+	  (progn
+	    (its-backward-SYL 1)
+	    (setq syl (get-text-property (1- (point)) 'its-syl))
+	    (if (null syl)
+		(signal 'beginning-of-buffer nil))))
+      (its-buffer-delete-SYL syl)
+      (while (> n 0)
+	(if (get-text-property (1+ (point)) 'its-end)
+	    (progn
+	      (its-buffer-ins/del-SYL syl nil t)
+	      (signal 'end-of-buffer nil)))
+	(its-forward-SYL 1)
+	(setq n (1- n)))
+      (while (< n 0)
+	(if (get-text-property (1- (point)) 'its-start)
+	    (progn
+	      (its-buffer-ins/del-SYL syl nil t)
+	      (signal 'beginning-of-buffer nil)))
+	(its-backward-SYL 1)
+	(setq n (1+ n)))
+      (its-buffer-ins/del-SYL syl nil t))
+     (t
+      (setq keyseq (its-get-keyseq-syl syl)
+	    len (length keyseq))
+      (cond
+       ((or (> n 1) (<= len 1))
+	(signal 'end-of-buffer nil))
+       ((>= (- n) len)
+	(signal 'beginning-of-buffer nil))
+       (t
+	(setq n (if (> n 0) (- -1 n) (1- n)))
+	(setq keyseq (concat (substring keyseq 0 n)
+			     (substring keyseq -1)
+			     (substring keyseq n -1)))
+	(if (and its-barf-on-invalid-keyseq
+		 (null (its-keyseq-acceptable-p keyseq)))
+	    (its-input-error))
+	(delete-region (- (point) (length (its-get-output syl))) (point))
+	(its-state-machine-keyseq keyseq 'its-buffer-ins/del-SYL)))))))
+
+(defun its-yank (&optional arg)
+  (interactive "*P")
+  (let ((inhibit-read-only t))
+    (its-input-end)
+    (its-put-cursor t)
+    (yank arg)
+    (its-setup-yanked-portion (region-beginning) (region-end))))
+
+(defun its-yank-pop (arg)
+  (interactive "*p")
+  (let ((inhibit-read-only t))
+    (its-input-end)
+    (its-put-cursor t)
+    (yank-pop arg)
+    (its-setup-yanked-portion (region-beginning) (region-end))))
+
+(defun its-setup-yanked-portion (start end)
+  (let ((yank-before (eq (point) end))
+	(max-sisheng (make-char 'chinese-sisheng 127))
+	p syl lang)
+    (remove-text-properties start end '(intangible nil))
+    (egg-separate-languages start end t)
+    (goto-char start)
+    (while (< (point) end)
+      (setq p (point)
+	    lang (get-text-property p 'egg-lang))
+      (if (and
+	   (or (equal lang "Chinese-GB") (equal lang "Chinese-CNS"))
+	   (<= (following-char) max-sisheng)
+	   (setq len (egg-chinese-syllable (buffer-substring (point) end))))
+	  (goto-char (+ (point) len))
+	(forward-char))
+      (setq syl (buffer-substring-no-properties p (point)))
+      (put-text-property p (point) 'its-syl (cons syl syl))
+      (if its-fence-face
+	  (let ((its-current-language (get-text-property p 'egg-lang)))
+	    (put-text-property p (point) 'face (its-get-fence-face)))))
+    (if yank-before
+	(add-text-properties start end '(read-only t intangible its-part-1))
+      (add-text-properties start end '(read-only t intangible its-part-2))
+      (delete-region (point) (1+ (point)))
+      (goto-char start)
+      (its-put-cursor t))))
 
 ;; Return VOID
 (defun its-input-end ()
@@ -670,62 +955,82 @@ Return last state."
 (defun its-exit-mode ()
   "Exit ITS mode."
   (interactive)
-  (its-input-end)
-  (its-exit-mode-internal))
-
-(defun its-exit-mode-off-input-method ()
-  "Exit ITS mode."
-  (interactive)
-  (its-input-end)
-  (its-exit-mode-internal)
-  (inactivate-input-method))
+  (let ((inhibit-read-only t))
+    (its-input-end)
+    (its-put-cursor t)
+    (its-exit-mode-internal)))
 
 ;; TODO: handle overwrite-mode, insertion-hook, fill...
 (defun its-exit-mode-internal (&optional proceed-to-conversion)
-  (let (start end)
+  (let (start end s e)
+    (its-select-previous-mode t)
+    ;; Delete CURSOR
+    (delete-region (point) (1+ (point)))
     ;; Delete open fence
-    (if (get-text-property (1- (point)) 'its-start)
-	(setq start (1- (point)))
-      (setq start (1- (previous-single-property-change (point) 'its-start))))
-    (delete-region start (1+ start))
+    (setq s (if (get-text-property (1- (point)) 'its-start)
+		(point)
+	      (previous-single-property-change (point) 'its-start))
+	 start (- s (length its-fence-open)))
+    (delete-region start s)
     ;; Delete close fence
-    (if (get-text-property (point) 'its-end)
-	(setq end (point))
-      (setq end (next-single-property-change (point) 'its-end)))
-    (delete-region end (1+ end))
-    ;; Remove all properties added by ITS
-    (remove-text-properties start end '(its-syl nil
-					face nil
-					intangible nil))
+    (setq end (if (get-text-property (point) 'its-end)
+		  (point)
+		(next-single-property-change (point) 'its-end))
+	  e (+ end (length its-fence-close)))
+    (delete-region end e)
     (if proceed-to-conversion
 	(egg-convert-region start end)
+      ;; Remove all properties
+      (set-text-properties start end nil)
       (egg-do-auto-fill)
       (run-hooks 'input-method-after-insert-chunk-hook))))
 
 (defun its-kick-convert-region ()
   (interactive)
-  (its-input-end)
-  (its-exit-mode-internal t))
+  (let ((inhibit-read-only t))
+    (its-input-end)
+    (its-put-cursor t)
+    (its-exit-mode-internal t)))
+
+(defun its-kick-convert-region-or-self-insert ()
+  (interactive)
+  (let ((syl (and (null (get-text-property (point) 'its-cursor))
+		  (get-text-property (1- (point)) 'its-syl))))
+    (if (its-keyseq-acceptable-p (vector last-command-char) syl)
+	(its-self-insert-char)
+      (its-kick-convert-region))))
+
+(defun its-in-fence-p ()
+  (eq (get-text-property (point) 'intangible) 'its-part-2))
 
-(defvar its-translation-result nil "")
+(defvar its-translation-result "" "")
 
-(defun its-ins/del-SYL-batch (newsyl oldsyl)
+(defun its-ins/del-SYL-batch (newsyl oldsyl cursor)
   (its-update-latest-SYL newsyl)
   (if (and newsyl
 	   (consp (cdr newsyl))
 	   (not (its-kst-p (its-get-kst/t newsyl))))
       ;; DSYL
-      (setq its-translation-result
-	    (cons (its-get-output newsyl) its-translation-result))))
-
-(defun its-translate-region (start end &optional map)
+      (let ((output (its-get-output newsyl))
+	    (oldlen (length its-translation-result)))
+	(setq its-translation-result (concat its-translation-result output))
+	(put-text-property oldlen (length its-translation-result)
+			   'egg-lang its-current-language
+			   its-translation-result)))
+  cursor)
+
+(defun its-translate-region (start end)
   (interactive "r")
-  (setq its-translation-result nil)
+  (its-translate-region-internal start end)
+  (set-text-properties start (point) nil))
+
+(defun its-translate-region-internal (start end)
+  (setq its-translation-result "")
   (goto-char start)
   (let ((i 0)
 	(syl (its-initial-ISYL))
 	;; temporally enable DING
-	(its-barf-on-invalid-keyseq "Invalid Romaji Sequence")
+	(its-barf-on-invalid-keyseq t)
 	cursor)
     (while (< (point) end)
       (let ((key (following-char)))
@@ -737,53 +1042,30 @@ Return last state."
     (if (eq syl its-latest-SYL)
 	(its-state-machine syl -1 'its-ins/del-SYL-batch))
     (delete-region start end)
-    (apply 'insert (reverse its-translation-result))))
+    (insert its-translation-result)))
 
-(defvar its-select-map-menu '(menu "Map:" nil))
-
-(defun its-select-map-from-menu ()
-  (interactive)
-  (setcar (nthcdr 2 its-select-map-menu) its-map-alist)
-  (setq its-current-map (menudiag-select its-select-map-menu))
-  (force-mode-line-update))
-
-(defun its-select-hiragana ()
-  (interactive)
-  (its-select-map "roma-kana"))
-
-(defun its-select-katakana ()
-  (interactive)
-  (its-select-map "roma-kata"))
-
-(defun its-select-downcase ()
-  (interactive)
-  (its-select-map "downcase"))
-
-(defun its-select-upcase ()
-  (interactive)
-  (its-select-map "upcase"))
+(defun its-set-mode-line-title ()
+  (let ((title (its-get-indicator its-current-map)))
+    (setq current-input-method-title (if its-previous-select-func
+					 (concat "<" title ">")
+				       title))
+    (force-mode-line-update)))
 
-(defun its-select-zenkaku-downcase ()
-  (interactive)
-  (its-select-map "zenkaku-downcase"))
+(defun its-select-mode-temporally (func)
+  (let ((select-func its-current-select-func))
+    (funcall func)
+    (if (null its-previous-select-func)
+	(setq its-previous-select-func select-func))
+    (its-set-mode-line-title)))
 
-(defun its-select-zenkaku-upcase ()
+(defun its-select-previous-mode (&optional quiet)
   (interactive)
-  (its-select-map "zenkaku-upcase"))
-
-(defun its-select-map (name)
-  (interactive (list (completing-read "ITS map: " its-map-alist)))
-  (if (its-get-map name)
-      (progn
-	(setq its-current-map (its-get-map name))
-	(force-mode-line-update))
-    (ding)))
-
-;; Escape character to Zenkaku inputs
-(defconst its-zenkaku-escape "Z")
-
-;; Escape character to Hankaku inputs
-(defconst its-hankaku-escape "~")
+  (if (null its-previous-select-func)
+      (if (null quiet)
+	  (beep))
+    (funcall its-previous-select-func)
+    (setq its-previous-select-func nil)
+    (its-set-mode-line-title)))
 
 (provide 'its)
 ;;; its.el ends here.