From: morioka Date: Sun, 30 Aug 1998 09:51:49 +0000 (+0000) Subject: egg-980304. X-Git-Tag: egg-980304~1 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=0881feb37158595ce70c8e2b788136f4ff9e428c;p=elisp%2Fegg.git egg-980304. --- diff --git a/ChangeLog b/ChangeLog index 9989248..c6e6280 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,93 @@ +1998-03-04 NIIBE Yutaka + + * its.el (its-define-select-keys of its-mode-map): Comment it out. + * its-keydef.el (its-make-select-func): Add eval-when to compile this. + + * egg-cnv.el (egg-decide-bunsetsu): Deleted. + * its.el (its-restart): Call its-setup-fence-mode with no argument. + + * its.el (its-keyseq-acceptable-p): Bug fix. + +1998-03-03 KATAYAMA Yoshio + + *its.el (its-get-keyseq-syl): Compensate when DSYL has back. + (its-DSYL-with-back-p): New function. Return t when DSYL has back. + (its-concrete-DSYL-p): New function. Return t when DSYL is cons + form which means input is not continued after DSYL was created. + (its-make-concrete-DSYL): New function. + (its-self-insert-char): Make DSYL to ``concrete-DSYL'' if cursor + is t which means input is not continued. + (its-input): Test input key is whether acceptable or not when + its-barf-on-invalid-keyseq is non-nil. + (its-input-to-vsyl): Set cursor status, not just returning it. + (its-state-machine its-state-machine-keyseq): Make sure to issue + ``DSYL-with-back'' when syllable is decided by the rule with back. + ``test mode'' is added. + (its-keyseq-acceptable-p): New function. + (its-forward-SYL): The args order of put-text-property was wrong. + (its-delete-backward-SYL-by-keystroke): New function. + (its-delete-backward-within-SYL): ``delete-by-keystroke'' mode + did not work when syllable is decided by the rule with back. + Deletion limit is extended to outside of SYL (meaning of + ``within-SYL'' is changed to ``deletion starts within SYL). + (its-transpose-chars): Fixed up. + (its-in-fence-p): Confuse at openning fence. + +1998-02-25 KATAYAMA Yoshio + + * its.el (its-put-cursor): Enable its-map change in fence mode. + + * its-keydef.el (its-make-select-func): Same as above. + +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 + its-barf-on-invalid-keyseq to nil. + (its-ins/del-SYL-batch): Avoide altering its-XXX-map. + (its-translate-region-internal): its-translation-result's data + type is changed to string. + + * egg-cnv.el (egg-convert-region): Gather contiguous same + language part. + +1998-02-21 KATAYAMA Yoshio + + * its.el (its-ins/del-SYL-batch): Set its-lang property. + (its-translate-region): Remove its-lang property from translated + text. + (its-translate-region-internal): New function. Retain its-lang + property on translated text. + + * egg-mlh.el (mlh-space-bar-backward-henkan): Force base language + to Japanese. + + (mlh-hangul mlh-zhongwen-tw mlh-zhongwen): New functions for + conversion functions. + 1998-02-20 KATAYAMA Yoshio * its.el (its-restart): New function. diff --git a/egg-cnv.el b/egg-cnv.el index 8c499b3..267213b 100644 --- a/egg-cnv.el +++ b/egg-cnv.el @@ -128,9 +128,12 @@ (egg-separate-languages start (point-max)) (goto-char start) (while (< (point) (point-max)) - (setq lang (get-text-property (point) 'egg-lang)) - (setq s (point) - e (next-single-property-change s 'egg-lang nil (point-max))) + (setq lang (get-text-property (point) 'egg-lang) + s (point) + e (point)) + (while (and (< e (point-max)) + (equal lang (get-text-property e 'egg-lang))) + (setq e (next-single-property-change e 'egg-lang nil (point-max)))) (setq bunsetsu-info-list (egg-start-conversion (buffer-substring s e) lang)) (setq contin (< e (point-max))) @@ -146,6 +149,7 @@ (defun egg-separate-languages (start end) (let (lang last-lang last-chinese p l c cset) + ;; 1st pass -- mark undefined Chinese part (goto-char start) (while (< (point) end) (setq p (next-single-property-change (point) 'its-lang nil end)) @@ -169,6 +173,7 @@ (setq p (point)) (forward-char) (put-text-property p (point) 'its-lang (egg-char-to-language c))))) + ;; 2nd pass -- set language property (goto-char start) (while (< (point) end) (setq lang (get-text-property (point) 'its-lang)) @@ -396,29 +401,6 @@ (interactive "p") (egg-next-candidate (- n))) -;; Bogus function 980220 -(defun egg-decide-bunsetsu (&optional end-marker) - (let ((in-loop t) - p bunsetsu-info-list bl) - (setq p (point)) - (while in-loop - (let ((bl1 (cons (egg-get-bunsetsu-info p) nil))) - (if bl - (setq bl (setcdr bl bl1)) - (setq bunsetsu-info-list (setq bl bl1)))) - (forward-char) - (remove-text-properties p (point) '(face nil - intangible nil - local-map nil - egg-bunsetsu-last nil)) - (setq p (point)) - (if (or (and end-marker (= p end-marker)) - (get-text-property p 'egg-end)) - (setq in-loop nil) - (setq p (1- p)) - (delete-region p (1+ p)))) ; Delete bunsetsu separator - bunsetsu-info-list)) - (defun egg-decide-before-point () (interactive) (let (bunsetsu-list bl (p (point)) source (dlen 0) l s) diff --git a/egg-mlh.el b/egg-mlh.el index 588e9db..9331575 100644 --- a/egg-mlh.el +++ b/egg-mlh.el @@ -6,6 +6,7 @@ ;; Project Leader: Satoru Tomura ;; Author: NIIBE Yutaka +;; KATAYAMA Yoshio ; Multilingual Enhancement ;; Maintainer: NIIBE Yutaka ;; Keywords: mule, multilingual, input method @@ -39,6 +40,7 @@ Or else, execute command that space-bar invokes usually." (interactive) (let ((henkan-begin nil) (inhibit-henkan t)) + (its-select-hiragana) ;; force to Japanese (mlh-backward-henkan) (if henkan-begin (if (or inhibit-henkan (= henkan-begin (point))) @@ -46,7 +48,6 @@ Or else, execute command that space-bar invokes usually." (progn (message "Converting...") (sit-for 0) - (put-text-property henkan-begin (point) 'its-lang "Japanese") (egg-convert-region henkan-begin (point)) (message "") )) (setq this-command 'self-insert-command) @@ -91,7 +92,7 @@ Or else, execute command that space-bar invokes usually." (?q . mlh-quit) ; (?r . mlh-) (?s . mlh-small-letter) -; (?t . mlh-) + (?t . mlh-zhongwen-tw) (?u . mlh-kanji) ; (?v . mlh-) (?w . mlh-white-space) @@ -444,7 +445,7 @@ CHAR. MNEMONIC CONVERSION SCHEME (setq beg (point)) (goto-char end-marker) (forward-char -1) - (its-translate-region beg (point)) + (its-translate-region-internal beg (point)) (delete-region (point) end-marker) (if (null henkan-begin) (setq henkan-begin beg))) @@ -456,7 +457,7 @@ CHAR. MNEMONIC CONVERSION SCHEME (setq beg (point)) (goto-char end-marker) (forward-char -2) - (its-translate-region beg (point)) + (its-translate-region-internal beg (point)) (delete-region (point) end-marker) (setq henkan-begin (point))) @@ -478,7 +479,7 @@ CHAR. MNEMONIC CONVERSION SCHEME (setq beg (point)) (goto-char end-marker) (forward-char -2) - (its-translate-region beg (point)) + (its-translate-region-internal beg (point)) (insert (mlh-hira-to-kata (prog1 (buffer-substring beg (point)) @@ -507,5 +508,50 @@ CHAR. MNEMONIC CONVERSION SCHEME (setq i (+ i 3))) result)) +(defun mlh-hangul () + (forward-char -1) + (skip-chars-backward "a-zEO-RTW,.[]") + (mlh-backward-henkan) + (setq beg (point)) + (setq inhibit-henkan nil) + (goto-char end-marker) + (forward-char -2) + (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) + (setq henkan-begin beg))) + +(defun mlh-zhongwen () + (forward-char -1) + (skip-chars-backward "a-z0-4 ,.[]") + (mlh-backward-henkan) + (setq beg (point)) + (setq inhibit-henkan nil) + (goto-char end-marker) + (forward-char -2) + (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) + (setq henkan-begin beg))) + +(defun mlh-zhongwen-tw () + (forward-char -1) + (skip-chars-backward "a-z0-4,.[]") + (mlh-backward-henkan) + (setq beg (point)) + (setq inhibit-henkan nil) + (goto-char end-marker) + (forward-char -2) + (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) + (setq henkan-begin beg))) + (provide 'egg-mlh) ;;; egg-mlh.el ends here. 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..e85ee3f 100644 --- a/its-keydef.el +++ b/its-keydef.el @@ -6,57 +6,68 @@ (defvar its-zhuyin nil) (make-variable-buffer-local 'its-zhuyin) -(defmacro its-make-slect-func (key name file map &optional lang zhuyin) +(eval-when (eval compile) +(defun its-make-select-func (key1 key2 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 + (if fence + ,(concat "\e" (vector key2)) + ,(concat "\C-x\C-m" (vector key1))) + ',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 &optional fence) + ,@keydefs))))) -(its-do-list-make-slect-func - (("Q" upcase ascii up) - ("q" downcase ascii down) - ("h" hiragana hira hira Japanese) - ("K" katakana kata kata Japanese) - ("x" hankaku-katakana hankata han-kata Japanese) - ("Z" zenkaku-upcase zenkaku zenkaku-up Japanese) - ("z" zenkaku-downcase zenkaku zenkaku-down Japanese) - ("\C-e" erpin-cn erpin erpin-cn Chinese-GB NIL) - ("\C-p" pinyin-cn pinyin pinyin-cn Chinese-GB NIL) - ("\C-z" zhuyin-cn zhuyin zhuyin-cn Chinese-GB T) - ("\C-u" quanjiao-upcase-cn quanjiao quanjiao-up-cn Chinese-GB) - ("\C-d" quanjiao-downcase-cn quanjiao quanjiao-down-cn Chinese-GB) - ("E" erpin-tw erpin erpin-tw Chinese-CNS NIL) - ("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) - ("H" hangul hangul hangul Korean) - ("J" jeonkak-upcase jeonkak jeonkak-up Korean) - ("j" jeonkak-downcase jeonkak jeonkak-down Korean))) +(its-do-list-make-select-func + ((?Q ?Q upcase ascii up) + (?q ?q downcase ascii down) + (?h ?\C-h hiragana hira hira Japanese) + (?k ?\C-k katakana kata kata Japanese) + (?x ?\C-x hankaku-katakana hankata han-kata Japanese) + (?Z ?Z zenkaku-upcase zenkaku zenkaku-up Japanese) + (?z ?z zenkaku-downcase zenkaku zenkaku-down Japanese) + (?\C-e ?\C-e erpin-cn erpin erpin-cn Chinese-GB NIL) + (?\C-p ?\C-p pinyin-cn pinyin pinyin-cn Chinese-GB NIL) + (?\C-z ?\C-z zhuyin-cn zhuyin zhuyin-cn Chinese-GB T) + (?\C-u ?\C-u quanjiao-upcase-cn quanjiao quanjiao-up-cn Chinese-GB) + (?\C-d ?\C-d quanjiao-downcase-cn quanjiao quanjiao-down-cn Chinese-GB) + (?E ?E erpin-tw erpin erpin-tw Chinese-CNS NIL) + (?P ?P pinyin-tw pinyin pinyin-tw Chinese-CNS NIL) + (?Z ?Z zhuyin-tw zhuyin zhuyin-tw Chinese-CNS T) + (?U ?U quanjiao-upcase-tw quanjiao quanjiao-up-tw Chinese-CNS) + (?C ?C quanjiao-downcase-tw quanjiao quanjiao-down-tw Chinese-CNS) + (?H ?H hangul hangul hangul Korean) + (?J ?J jeonkak-upcase jeonkak jeonkak-up Korean) + (?j ?j jeonkak-downcase jeonkak jeonkak-down Korean))) (provide 'its-keydef) diff --git a/its.el b/its.el index 56bab98..9d54162 100644 --- a/its.el +++ b/its.el @@ -144,8 +144,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))) @@ -156,9 +158,24 @@ (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)) + ;; ;; +(require 'its-keydef) + (defvar its-mode-map (let ((map (make-sparse-keymap)) (i 33)) @@ -174,7 +191,10 @@ (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 [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) @@ -184,18 +204,13 @@ (define-key map " " 'its-kick-convert-region) (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.") @@ -203,14 +218,23 @@ (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))) + (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 '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 @@ -222,50 +246,46 @@ ;; 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) (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) - (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))) + (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))) (defvar its-current-map nil) (make-variable-buffer-local 'its-current-map) @@ -277,36 +297,43 @@ (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 @@ -315,44 +342,51 @@ ;; 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 + (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.") @@ -363,28 +397,32 @@ (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) +(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))) @@ -395,7 +433,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)))) @@ -422,6 +461,31 @@ (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)) + 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 eol + (setq cursor (its-state-machine syl -1 emit))) + (not (eq cursor 'its-keyseq-test-failed)))) ;;; ;;; Name --> map @@ -571,7 +635,7 @@ Return last state." (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) @@ -630,38 +694,113 @@ Return last state." (defvar its-delete-by-keystroke nil) +(defun its-delete-backward-SYL-by-keystroke (n killflag) + (interactive "p\nP") + (let ((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)) - (its-current-map (get-text-property (1- (point)) 'its-map))) + (p (- (point) (length (its-get-output syl)))) + (its-current-map (get-text-property (1- (point)) 'its-map)) + 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)) + ;; Delete CURSOR + (delete-region (point) (1+ (point))) + (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) + (interactive "p") (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))))) + (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))))))) ;; Return VOID (defun its-input-end () @@ -713,28 +852,36 @@ Return last state." (its-exit-mode-internal t)) (defun its-in-fence-p () - (let ((prop (get-text-property (point) 'intangible))) - (or (eq prop 'its-part-1) (eq prop 'its-part-2)))) + (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) + 'its-lang its-current-language + its-translation-result))) + cursor) + +(defun its-translate-region (start end) + (its-translate-region-internal start end) + (remove-text-properties start (point) '(its-lang nil))) + +(defun its-translate-region-internal (start end) (interactive "r") - (setq its-translation-result nil) + (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))) @@ -746,9 +893,7 @@ 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))) -(require 'its-keydef) - (provide 'its) ;;; its.el ends here. 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)