Revision: 7371
Author: deton.kih
Date: Mon Nov 21 14:10:12 2011
Log: * Add postfix sequence to kanji conversion.
* scm/tutcode-key-custom.scm
- (tutcode-postfix-seq2kanji-start-sequence,
tutcode-postfix-seq2kanji-1-start-sequence,
tutcode-postfix-seq2kanji-2-start-sequence,
tutcode-postfix-seq2kanji-3-start-sequence,
tutcode-postfix-seq2kanji-4-start-sequence,
tutcode-postfix-seq2kanji-5-start-sequence,
tutcode-postfix-seq2kanji-6-start-sequence,
tutcode-postfix-seq2kanji-7-start-sequence,
tutcode-postfix-seq2kanji-8-start-sequence,
tutcode-postfix-seq2kanji-9-start-sequence): New custom.
* scm/tutcode.scm
- (tutcode-commit-raw,
tutcode-commit):
Change for new tutcode-child-type-seq2kanji.
- (tutcode-setup-child-context):
Change for new tutcode-child-type-seq2kanji.
Change to return created child context.
- (tutcode-stroke-help-update-alist-with-rule):
Add label for postfix sequence to kanji conversion key.
- (tutcode-do-update-preedit):
Change for new tutcode-child-type-seq2kanji.
Add postfix sequence to kanji mode.
- (tutcode-proc-state-on):
Add check of postfix sequence to kanji conversion start.
- (tutcode-ascii?):
New function extracted from tutcode-postfix-mazegaki-acquire-yomi.
- (tutcode-postfix-mazegaki-acquire-yomi):
Change to call tutcode-ascii?
- (tutcode-postfix-acquire-text,
tutcode-postfix-delete-text):
Add support for new tutcode-child-type-seq2kanji.
- (tutcode-sequence->kanji-list,
tutcode-seq2kanji-commit-from-child,
tutcode-seq2kanji-commit-raw-from-child,
tutcode-begin-postfix-seq2kanji-conversion,
tutcode-proc-state-postfix-seq2kanji): New function.
- (tutcode-state-has-preedit?):
Add postfix sequence to kanji state.
- (tutcode-key-press-handler):
Change to call tutcode-key-press-handler-internal.
- (tutcode-key-press-handler-internal):
Extract from tutcode-key-press-handler.
Add postfix sequence to kanji state.
- (tutcode-custom-set-mazegaki/bushu-start-sequence!):
Add postfix sequence to kanji start key sequences.
http://code.google.com/p/uim/source/detail?r=7371
Modified:
/trunk/scm/tutcode-key-custom.scm
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode-key-custom.scm Fri Nov 11 15:35:20 2011
+++ /trunk/scm/tutcode-key-custom.scm Mon Nov 21 14:10:12 2011
@@ -335,6 +335,66 @@
(N_ "[TUT-Code] postfix kanji to sequence conversion of 9
characters")
(N_ "long description will be here"))
+(define-custom 'tutcode-postfix-seq2kanji-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix sequence to kanji conversion")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-seq2kanji-1-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix sequence to kanji conversion of 1
character")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-seq2kanji-2-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix sequence to kanji conversion of 2
characters")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-seq2kanji-3-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix sequence to kanji conversion of 3
characters")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-seq2kanji-4-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix sequence to kanji conversion of 4
characters")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-seq2kanji-5-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix sequence to kanji conversion of 5
characters")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-seq2kanji-6-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix sequence to kanji conversion of 6
characters")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-seq2kanji-7-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix sequence to kanji conversion of 7
characters")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-seq2kanji-8-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix sequence to kanji conversion of 8
characters")
+ (N_ "long description will be here"))
+
+(define-custom 'tutcode-postfix-seq2kanji-9-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] postfix sequence to kanji 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 Mon Nov 21 14:06:45 2011
+++ /trunk/scm/tutcode.scm Mon Nov 21 14:10:12 2011
@@ -156,6 +156,16 @@
;;; ±Ññ¸ìÃæ¤Ç¤Ï½Ð¸½¤·¤Ê¤¤¥·¡¼¥±¥ó¥¹¤ËÊѹ¹¤¹¤ë¤³¤È¤Ç²óÈò¤·¤Æ¤¯¤À¤µ¤¤¡£
;;;
Îã:"/local/"¤ÈÂǤĤÈ"¼øºå"¤Î¸å¤Ë"al/"¤Ë¤è¤êÁ°ÃÖ·¿±Ñ»úÊÑ´¹¥â¡¼¥É¤¬³«»Ï
;;; (¤Ê¤ª¡¢"local/"¤Î¾ì¹ç¤Ï"Ìô»ùŬ"¤Ê¤Î¤ÇÌäÂê¤Ê¤·)
+;;; * ¸åÃÖ·¿ÆþÎÏ¥·¡¼¥±¥ó¥¹¢ª´Á»úÊÑ´¹
+;;;
TUT-Code¥ª¥ó¤Ë¤·Ëº¤ì¤ÆTUT-Code¤òÆþÎϤ·¤¿¾ì¹ç¤Ë¸å¤«¤é´Á»ú¤ËÊÑ´¹¤¹¤ë¤¿¤á¤Î
+;;; µ¡Ç½¤Ç¤¹¡£
+;;; tutcode-postfix-seq2kanji-start-sequence
+;;; 1ʸ»ú tutcode-postfix-seq2kanji-1-start-sequence
+;;; ...
+;;; 9ʸ»ú tutcode-postfix-seq2kanji-9-start-sequence
+;;; Á°ÃÖ·¿¸ò¤¼½ñ¤ÊÑ´¹¤ÎÆɤßÆþÎϤʤɡ¢³ÎÄꤵ¤ì¤Æ¤¤¤Ê¤¤ÆþÎϤϾ䨤ޤ¹¡£
+;;; Îã:"aljekri"¤òÊÑ´¹¢ª""¡£"ekri"¤À¤±ÊÑ´¹¢ª"¤«¤¤"¡£
+;;; "aljekri \n"¤Î¤è¤¦¤Ë³ÎÄꤵ¤ì¤Æ¤¤¤ë¾ì¹ç¢ª"²¼°Ì"
;;;
;;; ¡Ú¥Ø¥ë¥×µ¡Ç½¡Û
;;; * ²¾ÁÛ¸°È×ɽ¼¨(ɽ·Á¼°¤Î¸õÊ䥦¥£¥ó¥É¥¦¤òήÍÑ)
@@ -751,6 +761,7 @@
;;; 'tutcode-state-history ¥Ò¥¹¥È¥êÆþÎϥ⡼¥É
;;; 'tutcode-state-postfix-katakana ¸åÃÖ·¿¥«¥¿¥«¥ÊÊÑ´¹Ãæ
;;; 'tutcode-state-postfix-kanji2seq ¸åÃÖ·¿´Á»ú¢ªÆþÎÏ¥·¡¼¥±¥ó¥¹ÊÑ´¹Ãæ
+ ;;; 'tutcode-state-postfix-seq2kanji ¸åÃÖ·¿ÆþÎÏ¥·¡¼¥±¥ó¥¹¢ª´Á»úÊÑ´¹Ãæ
(list 'state 'tutcode-state-off)
;;; ¥«¥¿¥«¥Ê¥â¡¼¥É¤«¤É¤¦¤«
;;; #t: ¥«¥¿¥«¥Ê¥â¡¼¥É¡£#f: ¤Ò¤é¤¬¤Ê¥â¡¼¥É¡£
@@ -798,6 +809,7 @@
;;; »Ò¥³¥ó¥Æ¥¥¹¥È¤Î¼ïÎà
;;; 'tutcode-child-type-editor ÅÐÏ¿ÍѤÎÊÑ´¹¸åʸ»úÎóÊÔ½¸¥¨¥Ç¥£¥¿
;;; 'tutcode-child-type-dialog ¼½ñ¤«¤é¤Îºï½ü³Îǧ¥À¥¤¥¢¥í¥°
+ ;;; 'tutcode-child-type-seq2kanji ¥·¡¼¥±¥ó¥¹¢ª´Á»úÊÑ´¹ÍÑ
(list 'child-type ())
;;; ¿Æ¥³¥ó¥Æ¥¥¹¥È
(list 'parent-context ())
@@ -1326,9 +1338,13 @@
(tutcode-append-commit-string pc (im-get-raw-key-str key key-state)))
(let ((ppc (tutcode-context-parent-context pc)))
(if (not (null? ppc))
- (if (eq? (tutcode-context-child-type ppc) 'tutcode-child-type-editor)
- (tutcode-editor-commit-raw (tutcode-context-editor ppc) key
key-state)
- (tutcode-dialog-commit-raw (tutcode-context-dialog ppc) key
key-state))
+ (case (tutcode-context-child-type ppc)
+ ((tutcode-child-type-editor)
+ (tutcode-editor-commit-raw (tutcode-context-editor ppc) key
key-state))
+ ((tutcode-child-type-dialog)
+ (tutcode-dialog-commit-raw (tutcode-context-dialog ppc) key
key-state))
+ ((tutcode-child-type-seq2kanji)
+ (tutcode-seq2kanji-commit-raw-from-child ppc key key-state)))
(im-commit-raw pc))))
;;; im-commit¤ò¸Æ¤Ó½Ð¤¹¡£
@@ -1352,9 +1368,13 @@
(tutcode-append-history pc str)))
(let ((ppc (tutcode-context-parent-context pc)))
(if (not (null? ppc))
- (if (eq? (tutcode-context-child-type ppc) 'tutcode-child-type-editor)
- (tutcode-editor-commit (tutcode-context-editor ppc) str)
- (tutcode-dialog-commit (tutcode-context-dialog ppc) str))
+ (case (tutcode-context-child-type ppc)
+ ((tutcode-child-type-editor)
+ (tutcode-editor-commit (tutcode-context-editor ppc) str))
+ ((tutcode-child-type-dialog)
+ (tutcode-dialog-commit (tutcode-context-dialog ppc) str))
+ ((tutcode-child-type-seq2kanji)
+ (tutcode-seq2kanji-commit-from-child ppc str)))
(im-commit pc str))))
;;; im-commit¤ò¸Æ¤Ó½Ð¤¹¤È¤È¤â¤Ë¡¢¼«Æ°¥Ø¥ë¥×ɽ¼¨¤Î¥Á¥§¥Ã¥¯¤ò¹Ô¤¦
@@ -1671,9 +1691,10 @@
(tutcode-context-set-child-context! pc cpc)
(tutcode-context-set-child-type! pc type)
(tutcode-context-set-parent-context! cpc pc)
- (if (eq? type 'tutcode-child-type-editor)
- (tutcode-context-set-state! cpc 'tutcode-state-on)
- (tutcode-context-set-state! cpc 'tutcode-state-off))))
+ (if (eq? type 'tutcode-child-type-dialog)
+ (tutcode-context-set-state! cpc 'tutcode-state-off)
+ (tutcode-context-set-state! cpc 'tutcode-state-on))
+ cpc))
;;; µ¹æÆþÎϥ⡼¥É¤ò³«»Ï¤¹¤ë¡£
;;; @param pc ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
@@ -1955,6 +1976,16 @@
((tutcode-postfix-kanji2seq-7-start) "/7")
((tutcode-postfix-kanji2seq-8-start) "/8")
((tutcode-postfix-kanji2seq-9-start) "/9")
+ ((tutcode-postfix-seq2kanji-start) "´Á@")
+ ((tutcode-postfix-seq2kanji-1-start) "´Á1")
+ ((tutcode-postfix-seq2kanji-2-start) "´Á2")
+ ((tutcode-postfix-seq2kanji-3-start) "´Á3")
+ ((tutcode-postfix-seq2kanji-4-start) "´Á4")
+ ((tutcode-postfix-seq2kanji-5-start) "´Á5")
+ ((tutcode-postfix-seq2kanji-6-start) "´Á6")
+ ((tutcode-postfix-seq2kanji-7-start) "´Á7")
+ ((tutcode-postfix-seq2kanji-8-start) "´Á8")
+ ((tutcode-postfix-seq2kanji-9-start) "´Á9")
((tutcode-auto-help-redisplay) "¢ã")
((tutcode-help) "¡©")
((tutcode-help-clipboard) "?c")
@@ -2388,17 +2419,19 @@
(im-pushback-preedit pc preedit-none h))
(im-pushback-preedit pc preedit-none "¡Ú")
(im-pushback-preedit pc preedit-none
- (if (eq? (tutcode-context-child-type pc)
- 'tutcode-child-type-editor)
- (tutcode-editor-get-left-string editor)
- (tutcode-dialog-get-left-string dialog)))
+ (case (tutcode-context-child-type pc)
+ ((tutcode-child-type-editor)
+ (tutcode-editor-get-left-string editor))
+ ((tutcode-child-type-dialog)
+ (tutcode-dialog-get-left-string dialog))))
(tutcode-do-update-preedit cpc)
(set! cursor-shown? #t)
(im-pushback-preedit pc preedit-none
- (if (eq? (tutcode-context-child-type pc)
- 'tutcode-child-type-editor)
- (tutcode-editor-get-right-string editor)
- (tutcode-dialog-get-right-string dialog)))
+ (case (tutcode-context-child-type pc)
+ ((tutcode-child-type-editor)
+ (tutcode-editor-get-right-string editor))
+ ((tutcode-child-type-dialog)
+ (tutcode-dialog-get-right-string dialog))))
(im-pushback-preedit pc preedit-none "¡Û"))))
;;
Éô¼ó¹çÀ®ÊÑ´¹¤Î¥Þ¡¼¥«¢¥¤Ïʸ»úÎó¤È¤·¤ÆheadÆâ¤Ç´ÉÍý(ºÆµ¢ÅªÉô¼ó¹çÀ®¤Î¤¿¤á)
((tutcode-state-bushu)
@@ -2435,6 +2468,11 @@
(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))))
+ ((tutcode-state-postfix-seq2kanji)
+ (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 ""))))
@@ -3006,6 +3044,26 @@
(tutcode-begin-postfix-kanji2seq-conversion pc 8))
((eq? res 'tutcode-postfix-kanji2seq-9-start)
(tutcode-begin-postfix-kanji2seq-conversion pc 9))
+ ((eq? res 'tutcode-postfix-seq2kanji-start)
+ (tutcode-begin-postfix-seq2kanji-conversion pc #f))
+ ((eq? res 'tutcode-postfix-seq2kanji-1-start)
+ (tutcode-begin-postfix-seq2kanji-conversion pc 1))
+ ((eq? res 'tutcode-postfix-seq2kanji-2-start)
+ (tutcode-begin-postfix-seq2kanji-conversion pc 2))
+ ((eq? res 'tutcode-postfix-seq2kanji-3-start)
+ (tutcode-begin-postfix-seq2kanji-conversion pc 3))
+ ((eq? res 'tutcode-postfix-seq2kanji-4-start)
+ (tutcode-begin-postfix-seq2kanji-conversion pc 4))
+ ((eq? res 'tutcode-postfix-seq2kanji-5-start)
+ (tutcode-begin-postfix-seq2kanji-conversion pc 5))
+ ((eq? res 'tutcode-postfix-seq2kanji-6-start)
+ (tutcode-begin-postfix-seq2kanji-conversion pc 6))
+ ((eq? res 'tutcode-postfix-seq2kanji-7-start)
+ (tutcode-begin-postfix-seq2kanji-conversion pc 7))
+ ((eq? res 'tutcode-postfix-seq2kanji-8-start)
+ (tutcode-begin-postfix-seq2kanji-conversion pc 8))
+ ((eq? res 'tutcode-postfix-seq2kanji-9-start)
+ (tutcode-begin-postfix-seq2kanji-conversion pc 9))
((eq? res 'tutcode-history-start)
(tutcode-begin-history pc))
((eq? res 'tutcode-undo)
@@ -3330,6 +3388,12 @@
(if (not found?) ; ¸õÊä̵¤·¢ªÆɤß/¸ì´´¤ò¿¤Ð¤¹¤Î¤ÏÃæ»ß
(tutcode-context-set-postfix-yomi-len! pc postfix-yomi-len))))
+;;; ASCIIʸ»ú¤«¤É¤¦¤«¤òÊÖ¤¹
+;;; @param str ʸ»úÎó
+(define (tutcode-ascii? str)
+ (let ((ch (string->ichar str)))
+ (and ch (<= ch 127))))
+
;;; ¸åÃÖ·¿¸ò¤¼½ñ¤ÊÑ´¹ÍѤÎÆɤߤò¼èÆÀ¤¹¤ë
;;; @param yomi-len »ØÄꤵ¤ì¤¿ÆɤߤÎʸ»ú¿ô¡£»ØÄꤵ¤ì¤Æ¤Ê¤¤¾ì¹ç¤Ï#f¡£
;;; @return ¼èÆÀ¤·¤¿Æɤß(ʸ»úÎó¤ÎµÕ½ç¥ê¥¹¥È)
@@ -3341,17 +3405,13 @@
;;
·Ðͳ¤Î¾ì¹ç¤â¥æ¡¼¥¶¤¬ÌÀ¼¨Åª¤Ë»ØÄꤷ¤¿¤â¤Î¤È¤ß¤Ê¤·¤ÆƱÍͤ˴ޤá¤ë¡£
former-seq
;;
ÆɤߤÎʸ»ú¿ô¤¬»ØÄꤵ¤ì¤Æ¤¤¤Ê¤¤¢ª¼èÆÀ¤Ç¤¤¿Ê¸»ú¤ò»ÈÍÑ(¾å¸Âyomi-max)¡£
- (let*
- ;; ÆüËܸìʸ»ú¤ÈASCIIʸ»ú¤Î¶Ìܤ¬¤¢¤ì¤Ð¡¢¤½¤³¤Þ¤Ç¤ò¼èÆÀ¤¹¤ë
- ((ascii?
- (lambda (str)
- (let ((ch (string->ichar str)))
- (and ch (<= ch 127)))))
- (last-ascii? (and (pair? former-seq) (ascii? (car former-seq)))))
+ (let ((last-ascii? (and (pair? former-seq)
+ (tutcode-ascii? (car former-seq)))))
(take-while
(lambda (elem)
(and
- (eq? (ascii? elem) last-ascii?)
+ ;; ÆüËܸìʸ»ú¤ÈASCIIʸ»ú¤Î¶Ìܤ¬¤¢¤ì¤Ð¡¢¤½¤³¤Þ¤Ç¤ò¼èÆÀ¤¹¤ë
+ (eq? (tutcode-ascii? elem) last-ascii?)
;; "¡¢"¤ä"¡£"°ÊÁ°¤Îʸ»ú¤ÏÆɤߤ˴ޤá¤Ê¤¤¡£
(not (member elem
tutcode-postfix-mazegaki-terminate-char-list))))
former-seq)))))
@@ -3362,14 +3422,21 @@
(define (tutcode-postfix-acquire-text pc len)
(let ((ppc (tutcode-context-parent-context pc)))
(if (not (null? ppc))
- (if (eq? (tutcode-context-child-type ppc) 'tutcode-child-type-dialog)
- ()
- (let*
- ((ec (tutcode-context-editor ppc))
- (left-string (tutcode-editor-left-string ec)))
- (if (> (length left-string) len)
- (take left-string len)
- left-string)))
+ (case (tutcode-context-child-type ppc)
+ ((tutcode-child-type-dialog)
+ ())
+ ((tutcode-child-type-editor)
+ (let*
+ ((ec (tutcode-context-editor ppc))
+ (left-string (tutcode-editor-left-string ec)))
+ (if (> (length left-string) len)
+ (take left-string len)
+ left-string)))
+ ((tutcode-child-type-seq2kanji)
+ (let ((head (tutcode-context-head ppc)))
+ (if (> (length head) len)
+ (take head len)
+ head))))
(let*
((ustr (im-acquire-text pc 'primary 'cursor len 0))
(former (and ustr (ustr-former-seq ustr)))
@@ -3389,14 +3456,21 @@
(define (tutcode-postfix-delete-text pc len)
(let ((ppc (tutcode-context-parent-context pc)))
(if (not (null? ppc))
- (if (eq? (tutcode-context-child-type ppc) 'tutcode-child-type-editor)
- (let*
- ((ec (tutcode-context-editor ppc))
- (left-string (tutcode-editor-left-string ec)))
- (tutcode-editor-set-left-string! ec
- (if (> (length left-string) len)
- (drop left-string len)
- ()))))
+ (case (tutcode-context-child-type ppc)
+ ((tutcode-child-type-editor)
+ (let*
+ ((ec (tutcode-context-editor ppc))
+ (left-string (tutcode-editor-left-string ec)))
+ (tutcode-editor-set-left-string! ec
+ (if (> (length left-string) len)
+ (drop left-string len)
+ ()))))
+ ((tutcode-child-type-seq2kanji)
+ (let ((head (tutcode-context-head ppc)))
+ (tutcode-context-set-head! ppc
+ (if (> (length head) len)
+ (drop head len)
+ ())))))
(or
(im-delete-text pc 'primary 'cursor len 0)
;; im-delete-text̤Âбþ´Ä¶¤Î¾ì¹ç¡¢"\b"¤òÁ÷¤ë¡£
@@ -3599,6 +3673,181 @@
(commit)
(tutcode-proc-state-on pc key key-state)))))
+;;; ÆþÎÏ¥¡¼¥·¡¼¥±¥ó¥¹¤ò´Á»ú¤ËÊÑ´¹¤¹¤ë
+;;; @param sequence ÆþÎÏ¥¡¼¥·¡¼¥±¥ó¥¹¡£Ê¸»úÎó¤Î¥ê¥¹¥È(µÕ½ç)
+;;; @return ÊÑ´¹¸å¤Î´Á»úʸ»úÎó¤Î¥ê¥¹¥È(µÕ½ç)
+(define (tutcode-sequence->kanji-list pc sequence)
+ (if (null? sequence)
+ ()
+ (let ((string->key-and-status
+ (lambda (s)
+ (let ((ch (string->ichar s)))
+ (cond
+ ;; key-press-handler¤ËÅϤ¹¤¿¤á¡¢symbol¤ËÊÑ´¹(uim-key.c)
+ ;; (tutcode-return-key?Åù¤Ç¥Þ¥Ã¥Á¤¹¤ë¤è¤¦¤Ë¤¹¤ë¤¿¤á)
+ ((not (integer? ch)) (cons ch 0)) ; s¤¬´Á»ú¤Î¾ì¹çch¤Ï#f
+ ((= ch 8) '(backspace . 0))
+ ((= ch 9) '(tab . 0))
+ ((= ch 10) '(return . 0))
+ ((= ch 27) '(escape . 0))
+ ((= ch 127) '(delete . 0))
+ ((ichar-control? ch)
+ (cons (ichar-downcase (+ ch 64)) 2)) ; ex. "<Control>j"
+ ((ichar-upper-case? ch)
+ ;; key-predicateÍѤËshift-key-mask¤òset¡£
+ ;; downcase¤¹¤ë¤Èrule¤È°ìÃפ·¤Ê¤¯¤Ê¤ë¤Î¤Ç¤½¤Î¤Þ¤Þ¡£
+ (cons ch 1))
+ (else (cons ch 0))))))
+ (key? (lambda (k) (or (integer? k) (key-symbol? k))))
+ (commit-pending-rk
+ (lambda (c)
+ (let ((rkc (tutcode-context-rk-context c)))
+ (if (pair? (rk-context-seq rkc))
+ (tutcode-commit c (rk-pending rkc) #f #t)))))
+ (head-save (tutcode-context-head pc))
+ ;; ÂÐÏÃŪ¤ÊÁàºî»þ¤Î¤ß°ÕÌ£¤Î¤¢¤ë¥Ø¥ë¥×ɽ¼¨Åù¤Ï°ì»þŪ¤Ë¥ª¥Õ¤Ë¤¹¤ë
+ ;; (Êä´°/ͽ¬ÆþÎϤϤҤç¤Ã¤È¤·¤Æ»È¤¦¤«¤â¤·¤ì¤Ê¤¤¤Î¤Ç¤½¤Î¤Þ¤Þ)
+ (use-candwin-save tutcode-use-candidate-window?)
+ (use-stroke-help-win-save tutcode-use-stroke-help-window?)
+ (use-auto-help-win-save tutcode-use-auto-help-window?)
+ (use-kanji-combination-guide-save
tutcode-use-kanji-combination-guide?)
+ (stroke-help-with-guide-save
+ tutcode-stroke-help-with-kanji-combination-guide)
+ ;; child context¤òºî¤Ã¤Æ¤½¤³¤Ëkey-press¤ò¿©¤ï¤»¤ë
+ (cpc (tutcode-setup-child-context
pc 'tutcode-child-type-seq2kanji)))
+ (tutcode-context-set-head! pc ()) ; »Òcontext¤Ç¤Îcommit¤òhead¤Ë¤¿¤á¤ë
+ (set! tutcode-use-candidate-window? #f)
+ (set! tutcode-use-stroke-help-window? #f)
+ (set! tutcode-use-auto-help-window? #f)
+ (set! tutcode-use-kanji-combination-guide? #f)
+ (set! tutcode-stroke-help-with-kanji-combination-guide 'disable)
+ (for-each
+ (lambda (s)
+ (let ((k-s (string->key-and-status s)))
+ (if (key? (car k-s))
+ (tutcode-key-press-handler-internal cpc (car k-s) (cdr k-s))
+ (begin ; ´Á»ú¤Ï¤½¤Î¤Þ¤Þ
+ (commit-pending-rk cpc)
+ (tutcode-flush cpc)
+ (tutcode-commit cpc s)))))
+ (reverse sequence))
+ (commit-pending-rk cpc) ;
ºÇ¾å°Ì¤Îpending¤Î¤ß³ÎÄê¡£¾Ã¤¨¤ë¤È¤¦¤ì¤·¤¯¤Ê¤¤
+ ;; XXX:¸½¾õ¤Ï³ÎÄêºÑʸ»úÎó¤Î¤ß¼èÆÀ¡£Ì¤³ÎÄêʸ»úÎó¤Ï¾Ã¤¨¤ë
+ (let ((kanji-list (tutcode-context-head pc)))
+ (tutcode-flush cpc)
+ (tutcode-context-set-child-context! pc ())
+ (tutcode-context-set-child-type! pc ())
+ (tutcode-context-set-head! pc head-save)
+ (set! tutcode-use-candidate-window? use-candwin-save)
+ (set! tutcode-use-stroke-help-window? use-stroke-help-win-save)
+ (set! tutcode-use-auto-help-window? use-auto-help-win-save)
+ (set! tutcode-use-kanji-combination-guide?
+ use-kanji-combination-guide-save)
+ (set! tutcode-stroke-help-with-kanji-combination-guide
+ stroke-help-with-guide-save)
+ kanji-list))))
+
+;;; »Ò¥³¥ó¥Æ¥¥¹¥È¤Ç¤Îcommit
+;;; @param str commit¤µ¤ì¤¿Ê¸»úÎó
+(define (tutcode-seq2kanji-commit-from-child pc str)
+ (tutcode-context-set-head! pc
+ (append (string-to-list str) (tutcode-context-head pc))))
+
+;;; »Ò¥³¥ó¥Æ¥¥¹¥È¤Ç¤Îcommit-raw
+(define (tutcode-seq2kanji-commit-raw-from-child pc key key-state)
+ (let ((raw-str
+ (im-get-raw-key-str
+ (cond
+ ;;
tutcode-sequence->kanji-list¤ÇÊÑ´¹¤·¤¿symbol¤«¤écharcode¤ËÌ᤹
+ ((eq? key 'backspace) 8)
+ ((eq? key 'tab) 9)
+ ((eq? key 'return) 10)
+ ((eq? key 'escape) 27)
+ ((eq? key 'delete) 127)
+ ((control-key-mask key-state)
+ (- (ichar-upcase key) 64))
+ ((shift-key-mask key-state)
+ (ichar-upcase key))
+ (else key))
+ 0)))
+ (if raw-str
+ (tutcode-seq2kanji-commit-from-child pc raw-str))))
+
+;;; ¸åÃÖ·¿¤ÎÆþÎÏ¥·¡¼¥±¥ó¥¹¢ª´Á»úÊÑ´¹¤ò³«»Ï¤¹¤ë
+;;; @param yomi-len »ØÄꤵ¤ì¤¿ÆɤߤÎʸ»ú¿ô¡£»ØÄꤵ¤ì¤Æ¤Ê¤¤¾ì¹ç¤Ï#f¡£
+(define (tutcode-begin-postfix-seq2kanji-conversion pc yomi-len)
+ (let*
+ ((former-all (tutcode-postfix-acquire-text pc
+ (or yomi-len tutcode-mazegaki-yomi-max)))
+ (former-seq
+ (if yomi-len
+ former-all
+ ;; ¹ÔƬ¤Î¾ì¹ç¡¢¸ò¤¼½ñ¤ÊÑ´¹¤Î³ÎÄê¸å¤Î²ÄǽÀ¤¬¤¢¤ë¤Î¤Ç¡¢²þ¹Ô¤ò´Þ¤á¤ë
+ (receive
+ (newlines rest)
+ (span
+ (lambda (x)
+ (string=? x "\n"))
+ former-all)
+ (append newlines
+ (take-while
+ (lambda (elem)
+ (and (tutcode-ascii? elem)
+ (not (string=? elem "\n"))))
+ rest))))))
+ (if (pair? former-seq)
+ (let ((kanji-list (tutcode-sequence->kanji-list pc former-seq)))
+ (if yomi-len
+ (begin
+ (tutcode-postfix-commit pc
+ (string-list-concat kanji-list) former-seq)
+ (tutcode-flush pc))
+ ;; ÆɤߤÎʸ»ú¿ô¤¬»ØÄꤵ¤ì¤Æ¤¤¤Ê¤¤
+ (begin
+ (tutcode-context-set-mazegaki-yomi-all! pc former-all)
+ (tutcode-context-set-postfix-yomi-len! pc (length former-seq))
+ (tutcode-context-set-head! pc kanji-list)
+ (tutcode-context-set-state! pc
+ 'tutcode-state-postfix-seq2kanji)))))))
+
+;;; ¸åÃÖ·¿¤ÎÆþÎÏ¥·¡¼¥±¥ó¥¹¢ª´Á»úÊÑ´¹¥â¡¼¥É»þ¤Î¥¡¼ÆþÎϤò½èÍý¤¹¤ë¡£
+;;; @param key ÆþÎϤµ¤ì¤¿¥¡¼
+;;; @param key-state ¥³¥ó¥È¥í¡¼¥ë¥¡¼Åù¤Î¾õÂÖ
+(define (tutcode-proc-state-postfix-seq2kanji c key key-state)
+ (let*
+ ((pc (tutcode-find-descendant-context c))
+ (yomi-len (tutcode-context-postfix-yomi-len pc))
+ (yomi-all (tutcode-context-mazegaki-yomi-all pc))
+ (update-context!
+ (lambda (new-yomi-len)
+ (tutcode-context-set-postfix-yomi-len! pc new-yomi-len)
+ (tutcode-context-set-head! pc
+ (tutcode-sequence->kanji-list pc (take yomi-all new-yomi-len)))))
+ (commit
+ (lambda ()
+ (tutcode-postfix-commit pc
+ (string-list-concat (tutcode-context-head pc))
+ (take yomi-all yomi-len))
+ (tutcode-flush pc))))
+ (cond
+ ((tutcode-cancel-key? key key-state)
+ (tutcode-flush pc))
+ ((or (tutcode-commit-key? key key-state)
+ (tutcode-return-key? key key-state))
+ (commit))
+ ((tutcode-mazegaki-relimit-right-key? key key-state)
+ (if (> yomi-len 1)
+ ;; Á°ÃÖ·¿¸ò¤¼½ñ¤¤Ç³ÎÄꤵ¤ì¤Æ¤¤¤Ê¤¤Ê¸»ú¤¬¤¢¤ë¾ì¹ç¤Ê¤É¡¢
+ ;; relimit-right¤¹¤ë¤ÈÊÑ´¹¸åʸ»úÎ󤬿¤Ó¤ë¾ì¹ç¤¢¤ê¡£
+ ;; Îã:"aljrk"¢ª"" > "ljrk"¢ª"Àߤ¢"
+ (update-context! (- yomi-len 1))))
+ ((tutcode-mazegaki-relimit-left-key? key key-state)
+ (if (> (length yomi-all) yomi-len)
+ (update-context! (+ yomi-len 1))))
+ (else
+ (commit)
+ (tutcode-proc-state-on pc key key-state)))))
+
;;; ľÀÜÆþÎϾõÂ֤ΤȤ¤Î¥¡¼ÆþÎϤò½èÍý¤¹¤ë¡£
;;; @param c ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
;;; @param key ÆþÎϤµ¤ì¤¿¥¡¼
@@ -5063,7 +5312,8 @@
'(tutcode-state-yomi tutcode-state-bushu tutcode-state-converting
tutcode-state-interactive-bushu tutcode-state-kigou
tutcode-state-code tutcode-state-history
- tutcode-state-postfix-katakana tutcode-state-postfix-kanji2seq))))
+ tutcode-state-postfix-katakana tutcode-state-postfix-kanji2seq
+ tutcode-state-postfix-seq2kanji))))
;;; ¥¡¼¤¬²¡¤µ¤ì¤¿¤È¤¤Î½èÍý¤Î¿¶¤êʬ¤±¤ò¹Ô¤¦¡£
;;; @param c ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
@@ -5072,59 +5322,67 @@
(define (tutcode-key-press-handler c key key-state)
(if (ichar-control? key)
(im-commit-raw c)
- (let ((pc (tutcode-find-descendant-context c)))
- (case (tutcode-context-state pc)
- ((tutcode-state-on)
- (tutcode-proc-state-on pc key key-state)
- (if (or
- ;; ¸ò¤¼½ñ¤ÊÑ´¹¤äÉô¼ó¹çÀ®ÊÑ´¹³«»Ï¡£¢¤¤ä¢¥¤òɽ¼¨¤¹¤ë
- (tutcode-state-has-preedit? c)
- ;; ʸ»ú¿ô»ØÄê¸åÃÖ·¿¸ò¤¼½ñ¤ÊÑ´¹¤ÎºÆµ¢³Ø½¬¥¥ã¥ó¥»¥ë
- (not (eq? (tutcode-find-descendant-context c) pc)))
- (tutcode-update-preedit pc)))
- ((tutcode-state-kigou)
- (tutcode-proc-state-kigou pc key key-state)
- (tutcode-update-preedit pc))
- ((tutcode-state-yomi)
- (tutcode-proc-state-yomi pc key key-state)
- (tutcode-update-preedit pc))
- ((tutcode-state-converting)
- (tutcode-proc-state-converting pc key key-state)
- (tutcode-update-preedit pc))
- ((tutcode-state-bushu)
- (tutcode-proc-state-bushu pc key key-state)
- (tutcode-update-preedit pc))
- ((tutcode-state-interactive-bushu)
- (tutcode-proc-state-interactive-bushu pc key key-state)
- (tutcode-update-preedit pc))
- ((tutcode-state-code)
- (tutcode-proc-state-code pc key key-state)
- (tutcode-update-preedit pc))
- ((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))
- ((tutcode-state-postfix-kanji2seq)
- (tutcode-proc-state-postfix-kanji2seq pc key key-state)
- (tutcode-update-preedit pc))
- (else
- (tutcode-proc-state-off pc key key-state)
- (if (tutcode-state-has-preedit? c) ; ºÆµ¢³Ø½¬»þ
- (tutcode-update-preedit pc))))
- (if (or tutcode-use-stroke-help-window?
- (not (eq? tutcode-stroke-help-with-kanji-combination-guide
- 'disable)))
- ;;
editor¤ÎºîÀ®¡¦ºï½ü¤Î²ÄǽÀ¤¬¤¢¤ë¤Î¤Çdescendant-context¼èÆÀ¤·Ä¾¤·
- (let ((newpc (tutcode-find-descendant-context c)))
- (if
- (and
- (memq (tutcode-context-state newpc)
- '(tutcode-state-on tutcode-state-yomi tutcode-state-bushu
- tutcode-state-interactive-bushu))
- (not (tutcode-context-latin-conv newpc)))
- (tutcode-check-stroke-help-window-begin newpc)))))))
+ (tutcode-key-press-handler-internal c key key-state)))
+
+;;; ¥¡¼¤¬²¡¤µ¤ì¤¿¤È¤¤Î½èÍý¤Î¿¶¤êʬ¤±¤ò¹Ô¤¦¡£
+;;;
(seq2kanji¤«¤é¤Î¸Æ½ÐÍÑ¡£ichar-control?ʸ»ú¤¬seq2kanji¤òÄ̤·¤Æ¤â»Ä¤ë¤è¤¦¤Ë)
+(define (tutcode-key-press-handler-internal c key key-state)
+ (let ((pc (tutcode-find-descendant-context c)))
+ (case (tutcode-context-state pc)
+ ((tutcode-state-on)
+ (tutcode-proc-state-on pc key key-state)
+ (if (or
+ ;; ¸ò¤¼½ñ¤ÊÑ´¹¤äÉô¼ó¹çÀ®ÊÑ´¹³«»Ï¡£¢¤¤ä¢¥¤òɽ¼¨¤¹¤ë
+ (tutcode-state-has-preedit? c)
+ ;; ʸ»ú¿ô»ØÄê¸åÃÖ·¿¸ò¤¼½ñ¤ÊÑ´¹¤ÎºÆµ¢³Ø½¬¥¥ã¥ó¥»¥ë
+ (not (eq? (tutcode-find-descendant-context c) pc)))
+ (tutcode-update-preedit pc)))
+ ((tutcode-state-kigou)
+ (tutcode-proc-state-kigou pc key key-state)
+ (tutcode-update-preedit pc))
+ ((tutcode-state-yomi)
+ (tutcode-proc-state-yomi pc key key-state)
+ (tutcode-update-preedit pc))
+ ((tutcode-state-converting)
+ (tutcode-proc-state-converting pc key key-state)
+ (tutcode-update-preedit pc))
+ ((tutcode-state-bushu)
+ (tutcode-proc-state-bushu pc key key-state)
+ (tutcode-update-preedit pc))
+ ((tutcode-state-interactive-bushu)
+ (tutcode-proc-state-interactive-bushu pc key key-state)
+ (tutcode-update-preedit pc))
+ ((tutcode-state-code)
+ (tutcode-proc-state-code pc key key-state)
+ (tutcode-update-preedit pc))
+ ((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))
+ ((tutcode-state-postfix-kanji2seq)
+ (tutcode-proc-state-postfix-kanji2seq pc key key-state)
+ (tutcode-update-preedit pc))
+ ((tutcode-state-postfix-seq2kanji)
+ (tutcode-proc-state-postfix-seq2kanji pc key key-state)
+ (tutcode-update-preedit pc))
+ (else
+ (tutcode-proc-state-off pc key key-state)
+ (if (tutcode-state-has-preedit? c) ; ºÆµ¢³Ø½¬»þ
+ (tutcode-update-preedit pc))))
+ (if (or tutcode-use-stroke-help-window?
+ (not (eq? tutcode-stroke-help-with-kanji-combination-guide
+ 'disable)))
+ ;; editor¤ÎºîÀ®¡¦ºï½ü¤Î²ÄǽÀ¤¬¤¢¤ë¤Î¤Çdescendant-context¼èÆÀ¤·Ä¾¤·
+ (let ((newpc (tutcode-find-descendant-context c)))
+ (if
+ (and
+ (memq (tutcode-context-state newpc)
+ '(tutcode-state-on tutcode-state-yomi tutcode-state-bushu
+ tutcode-state-interactive-bushu))
+ (not (tutcode-context-latin-conv newpc)))
+ (tutcode-check-stroke-help-window-begin newpc))))))
;;; ¥¡¼¤¬Î¥¤µ¤ì¤¿¤È¤¤Î½èÍý¤ò¹Ô¤¦¡£
;;; @param pc ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
@@ -5787,6 +6045,26 @@
'(tutcode-postfix-kanji2seq-8-start))
(make-subrule tutcode-postfix-kanji2seq-9-start-sequence
'(tutcode-postfix-kanji2seq-9-start))
+ (make-subrule tutcode-postfix-seq2kanji-start-sequence
+ '(tutcode-postfix-seq2kanji-start))
+ (make-subrule tutcode-postfix-seq2kanji-1-start-sequence
+ '(tutcode-postfix-seq2kanji-1-start))
+ (make-subrule tutcode-postfix-seq2kanji-2-start-sequence
+ '(tutcode-postfix-seq2kanji-2-start))
+ (make-subrule tutcode-postfix-seq2kanji-3-start-sequence
+ '(tutcode-postfix-seq2kanji-3-start))
+ (make-subrule tutcode-postfix-seq2kanji-4-start-sequence
+ '(tutcode-postfix-seq2kanji-4-start))
+ (make-subrule tutcode-postfix-seq2kanji-5-start-sequence
+ '(tutcode-postfix-seq2kanji-5-start))
+ (make-subrule tutcode-postfix-seq2kanji-6-start-sequence
+ '(tutcode-postfix-seq2kanji-6-start))
+ (make-subrule tutcode-postfix-seq2kanji-7-start-sequence
+ '(tutcode-postfix-seq2kanji-7-start))
+ (make-subrule tutcode-postfix-seq2kanji-8-start-sequence
+ '(tutcode-postfix-seq2kanji-8-start))
+ (make-subrule tutcode-postfix-seq2kanji-9-start-sequence
+ '(tutcode-postfix-seq2kanji-9-start))
(make-subrule tutcode-auto-help-redisplay-sequence
'(tutcode-auto-help-redisplay))
(make-subrule tutcode-help-sequence
