From: 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/cgi-bin/gitweb.cgi?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 + + * 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 * 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)