From: kate <kate>
Date: Wed, 25 Feb 1998 04:37:31 +0000 (+0000)
Subject: Avoid fence destruction on input error.
X-Git-Tag: egg-980304~2^2~6
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=050d3888c6f1c173ba3be512dcaf7c66f4da7eca;p=elisp%2Fegg.git

Avoid fence destruction on input error.
Change its-barf-on-invalid-keyseq to it's doc-string.
Don't use egg-mode-line-title for avoiding wrong-type-argument at isearch.
Bind its-select-XXX to key only when modefull is select.
---

diff --git a/ChangeLog b/ChangeLog
index d7507a4..9d3f3f6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,27 @@
+1998-02-25  KATAYAMA Yoshio <kate@pfu.co.jp>
+
+	* its.el (its-set-cursor-status): New function.
+	(its-setup-fence-mode): New function.
+	(its-insert-fence-open its-insert-fence-close): Deleted.
+	(its-start, its-restart, its-self-insert-char): Avoid fence
+	destruction on its-barf.
+	(its-input-to-vsyl, its-state-machine, its-state-machine-keyseq,
+	its-buffer-ins/del-SYL, its-ins/del-SYL-batch): Update cursor
+	status on updating syllables.
+	(its-input-error): New function to realize doc-string of
+	its-barf-on-invalid-keyseq.
+
+	* egg.el (egg-mode): Don't use egg-mode-line-title which cause
+	wrong-type-argument at isearch.  Bind its-select-XXX to key only
+	when modefull is select.
+
+	* egg-mlh.el (mlh-hangul, mlh-zhongwen, mlh-zhongwen-tw): Same
+	as above.
+
+	* its-keydef.el (its-make-select-func): Same as above.
+
+	* leim-list-egg.el: Same as above.
+
 1998-02-24  KATAYAMA Yoshio <kate@pfu.co.jp>
 
 	* its.el (its-state-machine-keyseq): Remove binding
diff --git a/egg-mlh.el b/egg-mlh.el
index 1a0afe6..ee7ffca 100644
--- a/egg-mlh.el
+++ b/egg-mlh.el
@@ -515,8 +515,8 @@ CHAR.  MNEMONIC             CONVERSION SCHEME
   (setq inhibit-henkan nil)
   (goto-char end-marker)
   (forward-char -2)
-  (let (its-current-map its-current-language egg-mode-line-title)
-    (its-select-hangul)
+  (let (its-current-map its-current-language)
+    (its-select-hangul t)
     (its-translate-region-internal beg (point)))
   (delete-region (point) end-marker)
   (if (null henkan-begin)
@@ -530,8 +530,8 @@ CHAR.  MNEMONIC             CONVERSION SCHEME
   (setq inhibit-henkan nil)
   (goto-char end-marker)
   (forward-char -2)
-  (let (its-current-map its-current-language egg-mode-line-title)
-    (its-select-pinyin-cn)
+  (let (its-current-map its-current-language)
+    (its-select-pinyin-cn t)
     (its-translate-region-internal beg (point)))
   (delete-region (point) end-marker)
   (if (null henkan-begin)
@@ -545,8 +545,8 @@ CHAR.  MNEMONIC             CONVERSION SCHEME
   (setq inhibit-henkan nil)
   (goto-char end-marker)
   (forward-char -2)
-  (let (its-current-map its-current-language egg-mode-line-title)
-    (its-select-pinyin-tw)
+  (let (its-current-map its-current-language)
+    (its-select-pinyin-tw t)
     (its-translate-region-internal beg (point)))
   (delete-region (point) end-marker)
   (if (null henkan-begin)
diff --git a/egg.el b/egg.el
index c8403a0..9dd3b40 100644
--- a/egg.el
+++ b/egg.el
@@ -35,8 +35,6 @@
 (defvar egg-default-language "Japanese")
 (defvar egg-last-method-name)
 (make-variable-buffer-local 'egg-last-method-name)
-(defvar egg-mode-line-title)
-(make-variable-buffer-local 'egg-mode-line-title)
 
 ;;;###autoload
 (defun egg-mode (&rest arg)
@@ -54,25 +52,23 @@
 	  (egg-exit-conversion)))
 	(setq describe-current-input-method-function nil)
 	(setq current-input-method nil)
-	(let ((orig-local-map (keymap-parent (current-local-map))))
-	  (use-local-map orig-local-map))
-	(run-hooks 'input-method-inactivate-hook))
+	(use-local-map (keymap-parent (current-local-map)))
+	(force-mode-line-update))
     ;; Turn on
     (if (null (string= (car arg) egg-last-method-name))
 	(progn
 	  (funcall (nth 1 arg))
-	 (setq egg-default-language its-current-language)))
+	  (setq egg-default-language its-current-language)))
     (setq egg-last-method-name (car arg))
     (use-local-map (if egg-mode-preference
 		       (egg-modefull-map)
 		     (egg-modeless-map)))
     (setq inactivate-current-input-method-function 'egg-mode)
     (setq describe-current-input-method-function 'egg-help)
-    (run-hooks 'input-method-activate-hook))
-  (force-mode-line-update))
+    (add-hook 'input-method-activate-hook 'egg-set-mode-line-title)))
 
-(defun egg-set-mode-line-title (title)
-  (setq egg-mode-line-title title)
+(defun egg-set-mode-line-title ()
+  (setq current-input-method-title (its-get-indicator its-current-map))
   (force-mode-line-update))
 
 (defun egg-check-language (lang)
@@ -87,6 +83,7 @@
     (while (< i 127)
       (define-key map (vector i) 'egg-self-insert-char)
       (setq i (1+ i)))
+    (its-define-select-keys map)
     (set-keymap-parent map (current-local-map))
     map))
 
diff --git a/its-keydef.el b/its-keydef.el
index d295424..8c617f7 100644
--- a/its-keydef.el
+++ b/its-keydef.el
@@ -6,38 +6,43 @@
 (defvar its-zhuyin nil)
 (make-variable-buffer-local 'its-zhuyin)
 
-(defmacro its-make-slect-func (key name file map &optional lang zhuyin)
+(defun its-make-select-func (key name file map &optional lang zhuyin)
   (setq name (intern (concat "its-select-" (symbol-name name)))
 	file (intern (concat "its/" (symbol-name file)))
 	map (intern (concat "its-" (symbol-name map) "-map"))
 	lang (symbol-name lang))
-  `(progn
-     (defun ,name ()
-       (interactive)
-       (cond
-	((its-in-fence-p)
-	 (its-input-end)
-	 (its-put-cursor t))
-	((egg-get-bunsetsu-info (point))
-	 (egg-exit-conversion)))
-       ,(if lang `(egg-check-language ,lang))
-       (require ',file)
-       (setq its-current-map ,map)
-       ,(if lang `(setq its-current-language ,lang))
-       ,(if zhuyin `(setq its-zhuyin ,(eq zhuyin 'T)))
-       (egg-set-mode-line-title (its-get-indicator its-current-map)))
-     (define-key mule-keymap ,key ',name)))
+  (cons
+   `(defun ,name (&optional mode-line-unchange)
+      (interactive)
+      (cond
+       ((its-in-fence-p)
+	(its-input-end)
+	(its-put-cursor t))
+       ((egg-get-bunsetsu-info (point))
+	(egg-exit-conversion)))
+      ,(if lang `(egg-check-language ,lang))
+      (require ',file)
+      (setq its-current-map ,map)
+      ,(if lang `(setq its-current-language ,lang))
+      ,(if zhuyin `(setq its-zhuyin ,(eq zhuyin 'T)))
+      (if (null mode-line-unchange)
+	  (egg-set-mode-line-title)))
+   `(define-key map ,(concat "\C-x\C-m" key) ',name)))
 
-(defmacro its-do-list-make-slect-func (list)
+(defmacro its-do-list-make-select-func (list)
   (eval-when (eval compile)
-    (let (e l)
+    (let (funcs keydefs pair)
       (while list
-	(setq e (car list))
-	(setq l (cons `(its-make-slect-func ,@(car list)) l))
+	(setq pair (apply 'its-make-select-func (car list)))
+	(setq funcs (cons (car pair) funcs)
+	      keydefs (cons (cdr pair) keydefs))
 	(setq list (cdr list)))
-      (cons 'progn l))))
+      `(progn
+	 ,@funcs
+	 (defun its-define-select-keys (map)
+	   ,@keydefs)))))
 
-(its-do-list-make-slect-func
+(its-do-list-make-select-func
  (("Q"    upcase               ascii    up)
   ("q"    downcase             ascii    down)
   ("h"    hiragana             hira     hira             Japanese)
@@ -54,7 +59,7 @@
   ("P"    pinyin-tw            pinyin   pinyin-tw        Chinese-CNS NIL)
   ("Z"    zhuyin-tw            zhuyin   zhuyin-tw        Chinese-CNS T)
   ("U"    quanjiao-upcase-tw   quanjiao quanjiao-up-tw   Chinese-CNS)
-  ("D"    quanjiao-downcase-tw quanjiao quanjiao-down-tw Chinese-CNS)
+  ("C"    quanjiao-downcase-tw quanjiao quanjiao-down-tw Chinese-CNS)
   ("H"    hangul               hangul   hangul           Korean)
   ("J"    jeonkak-upcase       jeonkak  jeonkak-up       Korean)
   ("j"    jeonkak-downcase     jeonkak  jeonkak-down     Korean)))
diff --git a/its.el b/its.el
index 9abea6d..b66e1f4 100644
--- a/its.el
+++ b/its.el
@@ -203,6 +203,8 @@
 (defvar its-fence-close  "|" "*フェンスの終点を示す文字列 (1 文字)")
 (defvar its-fence-face nil  "*フェンス表示に用いる face または nil")
 
+(defconst its-setup-fence-before-insert-SYL nil)
+
 (defun its-put-cursor (cursor)
   (let ((p (point)))
     (insert "!")
@@ -211,6 +213,11 @@
 					 '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
@@ -222,50 +229,39 @@
 ;; intangible intangible
 ;;     1       2
 ;;
-(defun its-insert-fence-open ()
-  (let ((p (point)))
+(defun its-setup-fence-mode ()
+  (let ((open-props '(its-start t intangible its-part-1))
+	(close-props '(its-end t intangible its-part-2))
+	(p (point)) p1)
     (insert its-fence-open)
-    (add-text-properties p (point)
-			 (if its-fence-face
-			     '(invisible t its-start t intangible its-part-1)
-			   '(its-start t intangible its-part-1)))))
-
-(defun its-insert-fence-close ()
-  (let ((p (point)))
+    (setq p1 (point))
+    (add-text-properties p p1 open-props)
     (insert its-fence-close)
-    (add-text-properties p (point) 
-			 (if its-fence-face
-			     '(invisible t its-end t intangible its-part-2)
-			   '(its-end t intangible its-part-2)))
-    (goto-char p)))
+    (add-text-properties p1 (point) close-props)
+    (if its-fence-face
+	(put-text-property 'invisible t p (point)))
+    (goto-char p1)
+    (its-put-cursor t)))
 
 (defun its-start (key)
-  (its-insert-fence-open)
-  (its-insert-fence-close)
-  (its-put-cursor (its-input nil key))
-  (force-mode-line-update))
+  (let ((its-setup-fence-before-insert-SYL t))
+    (its-input nil key)
+    (force-mode-line-update)))
 
 (defun its-restart (str)
   (let (p)
-    (its-insert-fence-open)
-    (its-insert-fence-close)
+    (its-setup-fence-mode t)
     (setq p (point))
     (insert str)
-    (put-text-property p (point) 'intangible 'its-part-2)
-    (goto-char p)
-    (its-put-cursor t)))
+    (its-beginning-of-input-buffer)))
 
 (defun its-self-insert-char ()
   (interactive)
   (let ((key last-command-char)
-	(cursor (get-text-property (point) 'its-cursor))
 	(syl nil))
-    (if (null cursor)
+    (if (null (get-text-property (point) 'its-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)))
+    (its-input syl key)))
 
 (defvar its-current-map nil)
 (make-variable-buffer-local 'its-current-map)
@@ -295,10 +291,8 @@
     (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)
@@ -307,6 +301,10 @@
 
 (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"))
+
 
 ;;;
 ;;; ITS State Machine
@@ -315,44 +313,50 @@
 ;; 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
+     (next-state
+      (setq kst/t (its-get-kst/t next-state)
+	    output (its-get-output next-state)
+	    keyseq (its-get-keyseq next-state))
+      (cond
+       ;; 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 expr-output-back state t)
+      (its-state-machine-keyseq
+       (substring keyseq (its-eob-back expr-output-back)) emit))
+
+     ;; No next state for KEY.  It's invalid sequence.
+     (its-barf-on-invalid-keyseq
+      (its-input-error))
+
+     ;; no next state for END of keystroke
+     ((< key 0)
+      ;; ISYL --> DSYL   XXX
+      (funcall emit (cons (car state)
+			  (list (its-get-keyseq state))) state t))
+     (t
+      ;; XXX Should make DSYL (instead of VSYL)?
+      (setq keyseq (concat (its-get-keyseq state) (vector key)))
+      (funcall emit (its-make-VSYL keyseq) state nil)))))
 
 (defvar its-latest-SYL nil
   "The latest SYL inserted.")
@@ -366,24 +370,25 @@
 	(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))))
+      (cond
+       ((numberp (cdr syl))
+	;; VSYL - no need looping
+	(funcall emit (its-make-VSYL (concat (car syl) keyseq)) syl nil)
+	(setq cursor nil
+	      i len))
+       (t
+	(setq cursor (its-state-machine syl (aref keyseq i) emit))))
+      (setq syl (if cursor (its-initial-ISYL) its-latest-SYL)
+	    i (1+ i)))
     (if eol
 	(its-state-machine syl -1 emit)
       cursor)))
 
-(defun its-buffer-ins/del-SYL (newsyl oldsyl)
+(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)))
   (its-buffer-delete-SYL oldsyl)
   (its-update-latest-SYL newsyl)
   (let ((p (point)))
@@ -394,7 +399,8 @@
 			       'its-lang its-current-language
 			       'intangible 'its-part-1))
     (if its-fence-face
-	(put-text-property p (point) 'face its-fence-face))))
+	(put-text-property p (point) 'face its-fence-face))
+    (its-set-cursor-status cursor)))
 
 (defun its-buffer-delete-SYL (syl)
   (let ((len (length (its-get-output syl))))
@@ -717,7 +723,7 @@ Return last state."
 
 (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))
@@ -728,7 +734,8 @@ Return last state."
 	(setq its-translation-result (concat its-translation-result output))
 	(put-text-property oldlen (length its-translation-result)
 			   'its-lang its-current-language
-			   its-translation-result))))
+			   its-translation-result)))
+  cursor)
 
 (defun its-translate-region (start end)
   (interactive "r")
@@ -741,7 +748,7 @@ Return last state."
   (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)))
diff --git a/leim-list-egg.el b/leim-list-egg.el
index 8eae19b..00d80fa 100644
--- a/leim-list-egg.el
+++ b/leim-list-egg.el
@@ -5,37 +5,37 @@
 
 (register-input-method
  "japanese-egg-wnn" "Japanese" 'egg-activate-wnn
- 'egg-mode-line-title  "Romaji -> Hiragana -> Kanji&Kana"
+ ""  "Romaji -> Hiragana -> Kanji&Kana"
  'its-select-hiragana "Japanese")
 
 (register-input-method
  "japanese-egg-sj3" "Japanese" 'egg-activate-sj3
- 'egg-mode-line-title  "Romaji -> Hiragana -> Kanji&Kana"
+ ""  "Romaji -> Hiragana -> Kanji&Kana"
  'its-select-hiragana "Japanese")
 
 (register-input-method
  "chinese-gb-egg-wnn-py" "Chinese-GB" 'egg-activate-wnn
- 'egg-mode-line-title  "Pinyin -> Simplified Hanzi"
+ ""  "Pinyin -> Simplified Hanzi"
  'its-select-pinyin-cn "Chinese-GB")
 
 (register-input-method
  "chinese-gb-egg-wnn-zy" "Chinese-GB" 'egg-activate-wnn
- 'egg-mode-line-title  "Zhunyin -> Simplified Hanzi"
+ ""  "Zhunyin -> Simplified Hanzi"
  'its-select-zhuyin-cn "Chinese-GB")
 
 (register-input-method
  "chinese-cns-egg-wnn-py" "Chinese-CNS" 'egg-activate-wnn
- 'egg-mode-line-title  "Pinyin -> Traditional Hanzi"
+ ""  "Pinyin -> Traditional Hanzi"
  'its-select-pinyin-tw "Chinese-CNS")
 
 (register-input-method
  "chinese-cns-egg-wnn-zy" "Chinese-CNS" 'egg-activate-wnn
- 'egg-mode-line-title  "Zhunyin -> Traditional Hanzi"
+ ""  "Zhunyin -> Traditional Hanzi"
  'its-select-zhuyin-tw "Chinese-CNS")
 
 (register-input-method
  "korean-egg-wnn" "Korean" 'egg-activate-wnn
- 'egg-mode-line-title  "Hangul -> Hanja"
+ ""  "Hangul -> Hanja"
  'its-select-hangul "Korean")
 
 (autoload 'egg-mode "egg" "Toggle EGG  mode." t)