Revision: 7365
Author: deton.kih
Date: Tue Nov 8 14:10:16 2011
Log: * Add postfix katakana conversion.
* scm/tutcode-key-custom.scm
- (tutcode-postfix-katakana-start-sequence,
tutcode-postfix-katakana-1-start-sequence,
tutcode-postfix-katakana-2-start-sequence,
tutcode-postfix-katakana-3-start-sequence,
tutcode-postfix-katakana-4-start-sequence,
tutcode-postfix-katakana-5-start-sequence,
tutcode-postfix-katakana-6-start-sequence,
tutcode-postfix-katakana-7-start-sequence,
tutcode-postfix-katakana-8-start-sequence,
tutcode-postfix-katakana-9-start-sequence): New custom.
* scm/tutcode.scm
- (tutcode-stroke-help-update-alist-with-rule):
Add label for postfix katakana key.
- (tutcode-do-update-preedit): Add postfix katakana mode.
- (tutcode-proc-state-on): Add check of postfix katakana start.
- (tutcode-postfix-katakana-commit,
tutcode-begin-postfix-katakana-conversion,
tutcode-proc-state-postfix-katakana): New function.
- (tutcode-katakana-convert):
New function extracted from tutcode-proc-state-yomi and modified.
- (tutcode-proc-state-yomi):
Change to use tutcode-katakana-convert.
Add check of postfix katakana start key.
- (tutcode-state-has-preedit?): Add postfix katakana state.
- (tutcode-key-press-handler): Add postfix katakana state.
- (tutcode-custom-set-mazegaki/bushu-start-sequence!):
Add postfix katakana start key sequences.
http://code.google.com/p/uim/source/detail?r=7365
Modified:
/trunk/scm/tutcode-key-custom.scm
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode-key-custom.scm Thu Nov 3 04:07:18 2011
+++ /trunk/scm/tutcode-key-custom.scm Tue Nov 8 14:10:16 2011
@@ -215,6 +215,66 @@
(N_ "[TUT-Code] postfix mazegaki conversion with inflection of 9
characters")
(N_ "long description will be here"))
+(define-custom 'tutcode-postfix-katakana-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix katakana conversion")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-katakana-1-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix katakana conversion of 1 character")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-katakana-2-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix katakana conversion of 2 characters")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-katakana-3-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix katakana conversion of 3 characters")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-katakana-4-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix katakana conversion of 4 characters")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-katakana-5-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix katakana conversion of 5 characters")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-katakana-6-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix katakana conversion of 6 characters")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-katakana-7-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix katakana conversion of 7 characters")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-katakana-8-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix katakana conversion of 8 characters")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-katakana-9-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix katakana conversion of 9 characters")
+ (N_ "long description will be here"))
+
(define-custom 'tutcode-latin-conv-start-sequence "al/"
'(tutcode-keys1 mode-transition)
'(string ".*")
=======================================
--- /trunk/scm/tutcode.scm Sat Nov 5 20:35:04 2011
+++ /trunk/scm/tutcode.scm Tue Nov 8 14:10:16 2011
@@ -126,6 +126,11 @@
;;; ** ÆɤߤÎʸ»ú¿ô¤ò»ØÄꤷ¤ÆÊÑ´¹³«»Ï¤·¤¿¾ì¹ç
;;; ³èÍѤ¹¤ë¸ì¤Ë´Ø¤·¤Æ¤Ï¡¢ÆɤߤϻØÄꤵ¤ì¤¿Ê¸»ú¿ô¤Ç¸ÇÄꤷ¤Æ¸ì´´¤Î¤ß¿½Ì¡£
;;; Îã(¡Ö¤¢¤ª¤¤¡×¤ËÂФ·¤Æ3ʸ»ú»ØÄê):¡Ö¤¢¤ª¤¤¡½¡×>¡Ö¤¢¤ª¡½¡×>¡Ö¤¢¡½¡×
+;;; * ¸åÃÖ·¿¥«¥¿¥«¥ÊÊÑ´¹¤Ï¡¢°Ê²¼¤Î³«»Ï¥¡¼¤òÀßÄꤹ¤ë¤È»ÈÍѲÄǽ¤Ë¤Ê¤ê¤Þ¤¹¡£
+;;; tutcode-postfix-katakana-start-sequence
+;;; Æɤß1ʸ»ú tutcode-postfix-katakana-1-start-sequence
+;;; ...
+;;; Æɤß9ʸ»ú tutcode-postfix-katakana-9-start-sequence
;;;
;;; ¡Ú¥Ø¥ë¥×µ¡Ç½¡Û
;;; * ²¾ÁÛ¸°È×ɽ¼¨(ɽ·Á¼°¤Î¸õÊ䥦¥£¥ó¥É¥¦¤òήÍÑ)
@@ -713,6 +718,7 @@
;;; 'tutcode-state-interactive-bushu ÂÐÏÃŪÉô¼ó¹çÀ®ÊÑ´¹Ãæ
;;; 'tutcode-state-kigou µ¹æÆþÎϥ⡼¥É
;;; 'tutcode-state-history ¥Ò¥¹¥È¥êÆþÎϥ⡼¥É
+ ;;; 'tutcode-state-postfix-katakana ¸åÃÖ·¿¥«¥¿¥«¥ÊÊÑ´¹Ãæ
(list 'state 'tutcode-state-off)
;;; ¥«¥¿¥«¥Ê¥â¡¼¥É¤«¤É¤¦¤«
;;; #t: ¥«¥¿¥«¥Ê¥â¡¼¥É¡£#f: ¤Ò¤é¤¬¤Ê¥â¡¼¥É¡£
@@ -1900,6 +1906,16 @@
((tutcode-postfix-mazegaki-inflection-7-start) "¡½7")
((tutcode-postfix-mazegaki-inflection-8-start) "¡½8")
((tutcode-postfix-mazegaki-inflection-9-start) "¡½9")
+ ((tutcode-postfix-katakana-start) "¥«")
+ ((tutcode-postfix-katakana-1-start) "¥«1")
+ ((tutcode-postfix-katakana-2-start) "¥«2")
+ ((tutcode-postfix-katakana-3-start) "¥«3")
+ ((tutcode-postfix-katakana-4-start) "¥«4")
+ ((tutcode-postfix-katakana-5-start) "¥«5")
+ ((tutcode-postfix-katakana-6-start) "¥«6")
+ ((tutcode-postfix-katakana-7-start) "¥«7")
+ ((tutcode-postfix-katakana-8-start) "¥«8")
+ ((tutcode-postfix-katakana-9-start) "¥«9")
((tutcode-auto-help-redisplay) "¢ã")
((tutcode-help) "¡©")
((tutcode-help-clipboard) "?c")
@@ -2370,7 +2386,12 @@
((tutcode-state-history)
(im-pushback-preedit pc preedit-none "¡ý")
(im-pushback-preedit pc preedit-none
- (tutcode-get-current-candidate-for-history pc))))
+ (tutcode-get-current-candidate-for-history pc)))
+ ((tutcode-state-postfix-katakana)
+ (im-pushback-preedit pc preedit-none "¡ù")
+ (let ((h (string-list-concat (tutcode-context-head pc))))
+ (if (string? h)
+ (im-pushback-preedit pc preedit-none h)))))
(if (not cursor-shown?)
(im-pushback-preedit pc preedit-cursor ""))))
@@ -2890,6 +2911,26 @@
(tutcode-begin-postfix-mazegaki-inflection-conversion pc
8))
((eq? res 'tutcode-postfix-mazegaki-inflection-9-start)
(tutcode-begin-postfix-mazegaki-inflection-conversion pc
9))
+ ((eq? res 'tutcode-postfix-katakana-start)
+ (tutcode-begin-postfix-katakana-conversion pc #f))
+ ((eq? res 'tutcode-postfix-katakana-1-start)
+ (tutcode-begin-postfix-katakana-conversion pc 1))
+ ((eq? res 'tutcode-postfix-katakana-2-start)
+ (tutcode-begin-postfix-katakana-conversion pc 2))
+ ((eq? res 'tutcode-postfix-katakana-3-start)
+ (tutcode-begin-postfix-katakana-conversion pc 3))
+ ((eq? res 'tutcode-postfix-katakana-4-start)
+ (tutcode-begin-postfix-katakana-conversion pc 4))
+ ((eq? res 'tutcode-postfix-katakana-5-start)
+ (tutcode-begin-postfix-katakana-conversion pc 5))
+ ((eq? res 'tutcode-postfix-katakana-6-start)
+ (tutcode-begin-postfix-katakana-conversion pc 6))
+ ((eq? res 'tutcode-postfix-katakana-7-start)
+ (tutcode-begin-postfix-katakana-conversion pc 7))
+ ((eq? res 'tutcode-postfix-katakana-8-start)
+ (tutcode-begin-postfix-katakana-conversion pc 8))
+ ((eq? res 'tutcode-postfix-katakana-9-start)
+ (tutcode-begin-postfix-katakana-conversion pc 9))
((eq? res 'tutcode-history-start)
(tutcode-begin-history pc))
((eq? res 'tutcode-undo)
@@ -3298,6 +3339,88 @@
(make-list len tutcode-fallback-backspace-string))
#t #t))))))))
+;;; ¸åÃÖ·¿¥«¥¿¥«¥ÊÊÑ´¹¤ò³ÎÄꤹ¤ë
+;;; @param yomi Æɤß
+;;; @param katakana Æɤߤò¥«¥¿¥«¥Ê¤ËÊÑ´¹¤·¤¿Ê¸»úÎó¥ê¥¹¥È
+;;; @param show-help? katakana¤¬1ʸ»ú¤Î¾ì¹ç¤Ë¼«Æ°¥Ø¥ë¥×¤òɽ¼¨¤¹¤ë¤«¤É¤¦¤«
+(define (tutcode-postfix-katakana-commit pc yomi katakana show-help?)
+ (let ((str (string-list-concat katakana)))
+ (tutcode-postfix-delete-text pc (length yomi))
+ (tutcode-commit pc str)
+ (tutcode-undo-prepare-postfix pc str yomi)
+ (tutcode-flush pc)
+ (if (and show-help?
+ (= (length katakana) 1)) ;
1ʸ»ú¤Î¾ì¹ç¡¢¼«Æ°¥Ø¥ë¥×ɽ¼¨(tc2¤ÈƱÍÍ)
+ (tutcode-check-auto-help-window-begin pc katakana ()))))
+
+;;; ¸åÃÖ·¿¥«¥¿¥«¥ÊÊÑ´¹¤ò³«»Ï¤¹¤ë
+;;; @param yomi-len »ØÄꤵ¤ì¤¿ÆɤߤÎʸ»ú¿ô¡£»ØÄꤵ¤ì¤Æ¤Ê¤¤¾ì¹ç¤Ï#f¡£
+(define (tutcode-begin-postfix-katakana-conversion pc yomi-len)
+ (let*
+ ;; »ØÄꤷ¤¿1ʸ»ú¤¬´Á»ú(¤Ò¤é¤¬¤Ê¡¢¥«¥¿¥«¥Ê¡¢µ¹æ°Ê³°)¤«¤É¤¦¤«¤òÊÖ¤¹
+ ((kanji?
+ (lambda (str)
+ (let ((ch (tutcode-euc-jp-string->ichar str)))
+ (and ch (>= ch #xaea1))))) ; EUC-JIS-2004
+ (former-all (tutcode-postfix-mazegaki-acquire-yomi pc yomi-len))
+ (former-seq
+ (if yomi-len
+ former-all
+ (take-while
+ (lambda (elem)
+ (not (kanji? elem))) ; ´Á»ú¤¬¤¢¤Ã¤¿¤é¡¢¤½¤³¤ÇÃæÃÇ
+ former-all)))
+ (former-len (length former-seq)))
+ (if yomi-len
+ (let*
+ ((yomi (if (> former-len yomi-len)
+ (take former-seq yomi-len)
+ former-seq))
+ (katakana
+ (tutcode-katakana-convert yomi
+ (not (tutcode-context-katakana-mode? pc)))))
+ (tutcode-postfix-katakana-commit pc yomi katakana #t))
+ ;; ÆɤߤÎʸ»ú¿ô¤¬»ØÄꤵ¤ì¤Æ¤¤¤Ê¤¤
+ (if (> former-len 0)
+ (begin
+ (tutcode-context-set-mazegaki-yomi-all! pc former-all)
+ (tutcode-context-set-head! pc
+ (tutcode-katakana-convert former-seq
+ (not (tutcode-context-katakana-mode? pc))))
+ (tutcode-context-set-state!
pc 'tutcode-state-postfix-katakana))))))
+
+;;; ¸åÃÖ·¿¥«¥¿¥«¥ÊÊÑ´¹¥â¡¼¥É»þ¤Î¥¡¼ÆþÎϤò½èÍý¤¹¤ë¡£
+;;; @param key ÆþÎϤµ¤ì¤¿¥¡¼
+;;; @param key-state ¥³¥ó¥È¥í¡¼¥ë¥¡¼Åù¤Î¾õÂÖ
+(define (tutcode-proc-state-postfix-katakana c key key-state)
+ (let*
+ ((pc (tutcode-find-descendant-context c))
+ (head (tutcode-context-head pc)))
+ (cond
+ ((tutcode-cancel-key? key key-state)
+ (tutcode-flush pc))
+ ((or (tutcode-commit-key? key key-state)
+ (tutcode-return-key? key key-state))
+ (tutcode-postfix-katakana-commit pc
+ (take (tutcode-context-mazegaki-yomi-all pc) (length head))
+ head #t))
+ ((tutcode-mazegaki-relimit-right-key? key key-state)
+ (if (> (length head) 1)
+ (tutcode-context-set-head! pc (drop-right head 1))))
+ ((tutcode-mazegaki-relimit-left-key? key key-state)
+ (let ((yomi-all (tutcode-context-mazegaki-yomi-all pc))
+ (cur-len (length head)))
+ (if (> (length yomi-all) cur-len)
+ (tutcode-context-set-head! pc
+ (tutcode-katakana-convert
+ (take yomi-all (+ cur-len 1))
+ (not (tutcode-context-katakana-mode? pc)))))))
+ (else
+ (tutcode-postfix-katakana-commit pc
+ (take (tutcode-context-mazegaki-yomi-all pc) (length head))
+ head #f)
+ (tutcode-proc-state-on pc key key-state)))))
+
;;; ľÀÜÆþÎϾõÂ֤ΤȤ¤Î¥¡¼ÆþÎϤò½èÍý¤¹¤ë¡£
;;; @param c ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
;;; @param key ÆþÎϤµ¤ì¤¿¥¡¼
@@ -3402,6 +3525,18 @@
(tutcode-flush pc)
(tutcode-proc-state-on pc key key-state)))))
+;;; ʸ»úÎó¥ê¥¹¥È¤ò¥«¥¿¥«¥Ê¤ËÊÑ´¹¤¹¤ë
+;;; @param strlist ʸ»úÎó¤Î¥ê¥¹¥È
+;;; @param to-katakana?
¥«¥¿¥«¥Ê¤ËÊÑ´¹¤¹¤ë¾ì¹ç¤Ï#t¡£¤Ò¤é¤¬¤Ê¤ËÊÑ´¹¤¹¤ë¾ì¹ç¤Ï#f
+;;; @return ÊÑ´¹¸å¤Îʸ»úÎó¥ê¥¹¥È
+(define (tutcode-katakana-convert strlist to-katakana?)
+ ;;XXX:¤«¤Ê¥«¥Êº®ºß»þ¤Îȿž(¢ª¥«¥Ê¤«¤Ê)¤Ï̤Âбþ
+ (let ((idx (if to-katakana? 1 0)))
+ (map
+ (lambda (e)
+ (list-ref (ja-find-kana-list-from-rule ja-rk-rule e) idx))
+ strlist)))
+
;;; ¸ò¤¼½ñ¤ÊÑ´¹¤ÎÆɤßÆþÎϾõÂ֤ΤȤ¤Î¥¡¼ÆþÎϤò½èÍý¤¹¤ë¡£
;;; @param c ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
;;; @param key ÆþÎϤµ¤ì¤¿¥¡¼
@@ -3413,6 +3548,13 @@
(head (tutcode-context-head pc))
(kigou2-mode? (tutcode-kigou2-mode? pc))
(res #f)
+ (katakana-commit
+ (lambda ()
+ (tutcode-commit pc
+ (string-list-concat
+ (tutcode-katakana-convert head
+ (not (tutcode-context-katakana-mode? pc)))))
+ (tutcode-flush pc)))
;; reset-candidate-window¤Ç¥ê¥»¥Ã¥È¤µ¤ì¤ë¤Î¤ÇÊݸ¤·¤Æ¤ª¤¯
(predicting?
(eq? (tutcode-context-predicting pc) 'tutcode-predicting-prediction))
@@ -3481,13 +3623,7 @@
(tutcode-context-set-state! pc 'tutcode-state-converting)
(tutcode-setup-child-context pc 'tutcode-child-type-editor))
((tutcode-katakana-commit-key? key key-state)
- (tutcode-commit pc
- ;;XXX:¤«¤Ê¥«¥Êº®ºß»þ¤Îȿž(¢ª¥«¥Ê¤«¤Ê)¤ä¡¢¡Ö¤ñ¤ð¡×¤Ï̤Âбþ
- (ja-make-kana-str (ja-make-kana-str-list head)
- (if (tutcode-context-katakana-mode? pc)
- ja-type-hiragana
- ja-type-katakana)))
- (tutcode-flush pc))
+ (katakana-commit))
((tutcode-paste-key? key key-state)
(let ((latter-seq (tutcode-clipboard-acquire-text pc 'full)))
(if (pair? latter-seq)
@@ -3559,6 +3695,13 @@
(begin
(tutcode-flush pc)
(tutcode-begin-postfix-mazegaki-inflection-conversion pc
#f))))
+ ((eq? res 'tutcode-postfix-katakana-start)
+ (set! res #f)
+ (if (not (null? head))
+ (katakana-commit)
+ (begin
+ (tutcode-flush pc)
+ (tutcode-begin-postfix-katakana-conversion pc #f))))
((symbol? res)
(set! res #f)))))
(if res
@@ -4730,7 +4873,8 @@
(memq (tutcode-context-state pc)
'(tutcode-state-yomi tutcode-state-bushu tutcode-state-converting
tutcode-state-interactive-bushu tutcode-state-kigou
- tutcode-state-code tutcode-state-history))))
+ tutcode-state-code tutcode-state-history
+ tutcode-state-postfix-katakana))))
;;; ¥¡¼¤¬²¡¤µ¤ì¤¿¤È¤¤Î½èÍý¤Î¿¶¤êʬ¤±¤ò¹Ô¤¦¡£
;;; @param c ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
@@ -4770,6 +4914,9 @@
((tutcode-state-history)
(tutcode-proc-state-history pc key key-state)
(tutcode-update-preedit pc))
+ ((tutcode-state-postfix-katakana)
+ (tutcode-proc-state-postfix-katakana pc key key-state)
+ (tutcode-update-preedit pc))
(else
(tutcode-proc-state-off pc key key-state)
(if (tutcode-state-has-preedit? c) ; ºÆµ¢³Ø½¬»þ
@@ -5407,6 +5554,26 @@
'(tutcode-postfix-mazegaki-inflection-8-start))
(make-subrule
tutcode-postfix-mazegaki-inflection-9-start-sequence
'(tutcode-postfix-mazegaki-inflection-9-start))
+ (make-subrule tutcode-postfix-katakana-start-sequence
+ '(tutcode-postfix-katakana-start))
+ (make-subrule tutcode-postfix-katakana-1-start-sequence
+ '(tutcode-postfix-katakana-1-start))
+ (make-subrule tutcode-postfix-katakana-2-start-sequence
+ '(tutcode-postfix-katakana-2-start))
+ (make-subrule tutcode-postfix-katakana-3-start-sequence
+ '(tutcode-postfix-katakana-3-start))
+ (make-subrule tutcode-postfix-katakana-4-start-sequence
+ '(tutcode-postfix-katakana-4-start))
+ (make-subrule tutcode-postfix-katakana-5-start-sequence
+ '(tutcode-postfix-katakana-5-start))
+ (make-subrule tutcode-postfix-katakana-6-start-sequence
+ '(tutcode-postfix-katakana-6-start))
+ (make-subrule tutcode-postfix-katakana-7-start-sequence
+ '(tutcode-postfix-katakana-7-start))
+ (make-subrule tutcode-postfix-katakana-8-start-sequence
+ '(tutcode-postfix-katakana-8-start))
+ (make-subrule tutcode-postfix-katakana-9-start-sequence
+ '(tutcode-postfix-katakana-9-start))
(make-subrule tutcode-auto-help-redisplay-sequence
'(tutcode-auto-help-redisplay))
(make-subrule tutcode-help-sequence
