Revision: 6988
Author: deton.kih
Date: Wed Apr 6 04:21:34 2011
Log: * Add kanji code input mode for tutcode.
* scm/tutcode-key-custom.scm
- (tutcode-kanji-code-input-start-sequence): New custom.
* scm/tutcode.scm
- Add comment about kanji code input mode.
- (tutcode-begin-kanji-code-input,
tutcode-kanji-code-input-ucs,
tutcode-kanji-code-input-kuten,
tutcode-kanji-code-input-jis,
tutcode-jis-code->euc-jp-string,
tutcode-euc-jp-code->euc-jp-string): New.
- (tutcode-stroke-help-update-alist-with-rule):
Add label for kanji code input start sequence.
- (tutcode-do-update-preedit):
Add preedit update for kanji code input mode.
- (tutcode-proc-state-on): Add check of kanji code input start sequence.
- (tutcode-proc-state-code): New.
- (tutcode-state-has-preedit?): Add kanji code input mode.
- (tutcode-key-press-handler): Add kanji code input mode.
- (tutcode-custom-set-mazegaki/bushu-start-sequence!):
Add kanji code input start sequence.
http://code.google.com/p/uim/source/detail?r=6988
Modified:
/trunk/scm/tutcode-key-custom.scm
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode-key-custom.scm Wed Feb 23 02:46:56 2011
+++ /trunk/scm/tutcode-key-custom.scm Wed Apr 6 04:21:34 2011
@@ -221,6 +221,12 @@
(N_ "[TUT-Code] latin conversion mode")
(N_ "long description will be here"))
+(define-custom 'tutcode-kanji-code-input-start-sequence ""
+ '(tutcode-keys1 mode-transition)
+ '(string ".*")
+ (N_ "[TUT-Code] kanji code input mode")
+ (N_ "long description will be here"))
+
(define-custom 'tutcode-auto-help-redisplay-sequence ""
'(tutcode-keys1)
'(string ".*")
=======================================
--- /trunk/scm/tutcode.scm Sat Mar 19 21:05:41 2011
+++ /trunk/scm/tutcode.scm Wed Apr 6 04:21:34 2011
@@ -211,6 +211,15 @@
;;; (Ä̾ï¤Îµ¹æÆþÎϥ⡼¥É¤Ç¤Ï¡¢ÌÜŪ¤Îʸ»ú¤Þ¤Ç¤¿¤É¤ê¤Ä¤¯¤¿¤á¤Ë
;;; next-page¥¡¼¤ò²¿²ó¤â²¡¤¹É¬Íפ¬¤¢¤Ã¤ÆÌÌÅݤʤΤÇ)
;;;
+;;; ¡Ú´Á»ú¥³¡¼¥ÉÆþÎϥ⡼¥É¡Û
+;;;
´Á»ú¥³¡¼¥É¤ò»ØÄꤷ¤Æʸ»ú¤òÆþÎϤ¹¤ë¥â¡¼¥É¡£´Á»ú¥³¡¼¥ÉÆþÎϸ她¥Ú¡¼¥¹¥¡¼
+;;; (tutcode-begin-conv-key)¤ò²¡¤¹¤È¡¢Âбþ¤¹¤ëʸ»ú¤¬³ÎÄꤵ¤ì¤Þ¤¹¡£
+;;; °Ê²¼¤Î3¼ïÎà¤Î·Á¼°¤Ç¤ÎÆþÎϤ¬²Äǽ(DDSKK 14.2¤ÈƱÍÍ)¡£
+;;; + Unicode(UCS):
U+¤Î¸å¤Ë16¿Ê¿ô¡£U+¤Î¤«¤ï¤ê¤Ëu¤Ç¤âOK¡£(Îã:U+4E85¤Þ¤¿¤Ïu4e85)
+;;; + ¶èÅÀÈÖ¹æ(JIS X 0213):
-¤Ç¶èÀڤä¿¡¢ÌÌ-¶è-ÅÀÈÖ¹æ(Ì̶èÅÀ¤½¤ì¤¾¤ì10¿Ê¿ô)¡£
+;;;
1Ì̤ξì¹ç¡¢ÌÌ-¤Ï¾Êά²Äǽ¡£(Îã:1-48-13¤Þ¤¿¤Ï48-13)
+;;; + JIS¥³¡¼¥É(ISO-2022-JP): 4·å¤Î16¿Ê¿ô¡£(Îã:502d)
+;;;
;;; ¡ÚÀßÄêÎã¡Û
;;; *
¥³¡¼¥Éɽ¤Î°ìÉô¤òÊѹ¹¤·¤¿¤¤¾ì¹ç¤Ï¡¢Î㤨¤Ð~/.uim¤Ç°Ê²¼¤Î¤è¤¦¤Ëµ½Ò¤¹¤ë¡£
;;; (require "tutcode.scm")
@@ -620,6 +629,7 @@
;;; 'tutcode-state-off TUT-Code¥ª¥Õ
;;; 'tutcode-state-on TUT-Code¥ª¥ó
;;; 'tutcode-state-yomi ¸ò¤¼½ñ¤ÊÑ´¹¤ÎÆɤßÆþÎÏÃæ
+ ;;; 'tutcode-state-code ´Á»ú¥³¡¼¥ÉÆþÎÏÃæ
;;; 'tutcode-state-converting ¸ò¤¼½ñ¤ÊÑ´¹¤Î¸õÊäÁªÂòÃæ
;;; 'tutcode-state-bushu Éô¼óÆþÎÏ¡¦ÊÑ´¹Ãæ
;;; 'tutcode-state-interactive-bushu ÂÐÏÃŪÉô¼ó¹çÀ®ÊÑ´¹Ãæ
@@ -1459,6 +1469,104 @@
(tutcode-begin-conversion pc yomi () #t
tutcode-use-recursive-learning?)
(tutcode-mazegaki-inflection-relimit-right pc yomi-len yomi-len
#f))))
+;;; ÆþÎϤµ¤ì¤¿´Á»ú¥³¡¼¥É¤ËÂбþ¤¹¤ë´Á»ú¤ò³ÎÄꤹ¤ë
+;;; @param str-list ´Á»ú¥³¡¼¥É¡£ÆþÎϤµ¤ì¤¿Ê¸»úÎó¤Î¥ê¥¹¥È(µÕ½ç)
+(define (tutcode-begin-kanji-code-input pc str-list)
+ (let
+ ((kanji
+ (cond
+ ((string-ci=? (last str-list) "u")
+ (tutcode-kanji-code-input-ucs str-list))
+ ((member "-" str-list)
+ (tutcode-kanji-code-input-kuten str-list))
+ (else
+ (tutcode-kanji-code-input-jis str-list)))))
+ (if (and kanji (> (string-length kanji) 0))
+ (begin
+ (tutcode-commit pc kanji)
+ (tutcode-flush pc)
+ (tutcode-check-auto-help-window-begin pc (list kanji) ())))))
+
+;;; ÆþÎϤµ¤ì¤¿UCS¤ËÂбþ¤¹¤ë´Á»ú¤ò³ÎÄꤹ¤ë
+;;; @param str-list UCS(16¿Ê¿ô)¡£ÆþÎϤµ¤ì¤¿Ê¸»úÎó¤Î¥ê¥¹¥È(µÕ½ç)
+;;; @return EUC-JPʸ»úÎó¡£Àµ¤·¤¯¤Ê¤¤¥³¡¼¥É¤Î¾ì¹ç¤Ï#f
+(define (tutcode-kanji-code-input-ucs str-list)
+ (and-let*
+ ((str-list-1 (drop-right str-list 1)) ; drop last "U"
+ (not-only-u? (not (null? str-list-1)))
+ (ucs-str (if (string=? (last str-list-1) "+")
+ (drop-right str-list-1 1)
+ str-list-1))
+ (ucs (string->number (string-list-concat ucs-str) 16))
+ ;; ¥¨¥é¡¼²óÈò¤Î¤¿¤áÈÏ°Ï¥Á¥§¥Ã¥¯
+ (valid? ; sigscheme/src/sigschemeinternal.h:ICHAR_VALID_UNICODEP()
+ (or
+ (<= 0 ucs #xd7ff)
+ (<= #xe000 ucs #x10ffff)))
+ (utf8-str (ucs->utf8-string ucs))
+ (ic (iconv-open "EUC-JP" "UTF-8")))
+ (let ((eucj-str (iconv-code-conv ic utf8-str)))
+ (iconv-release ic)
+ eucj-str)))
+
+;;; ÆþÎϤµ¤ì¤¿JIS X 0213¤Î(ÌÌ)¶èÅÀÈÖ¹æ¤ËÂбþ¤¹¤ë´Á»ú¤ò³ÎÄꤹ¤ë
+;;; @param str-list (ÌÌ)¶èÅÀÈֹ档ÆþÎϤµ¤ì¤¿Ê¸»úÎó¤Î¥ê¥¹¥È(µÕ½ç)
+;;; @return EUC-JPʸ»úÎó¡£Àµ¤·¤¯¤Ê¤¤ÈÖ¹æ¤Î¾ì¹ç¤Ï#f
+(define (tutcode-kanji-code-input-kuten str-list)
+ (and-let*
+ ((numlist (string-split (string-list-concat str-list) "-"))
+ (len (length numlist))
+ (valid-format? (<= 2 len 3))
+ (men (if (= len 3) (string->number (list-ref numlist 0)) 1))
+ (valid-men? (<= 1 men 2))
+ (ku (string->number (list-ref numlist (if (= len 3) 1 0))))
+ (ten (string->number (list-ref numlist (if (= len 3) 2 1)))))
+ (tutcode-jis-code->euc-jp-string
+ (if (= men 2) 'jisx0213-plane2 'jisx0213-plane1)
+ (+ ku #x20) (+ ten #x20))))
+
+;;; ÆþÎϤµ¤ì¤¿JIS¥³¡¼¥É(ISO-2022-JP)¤ËÂбþ¤¹¤ë´Á»ú¤ò³ÎÄꤹ¤ë
+;;; @param str-list JIS¥³¡¼¥É¡£ÆþÎϤµ¤ì¤¿Ê¸»úÎó¤Î¥ê¥¹¥È(µÕ½ç)
+;;; @return EUC-JPʸ»úÎó¡£Àµ¤·¤¯¤Ê¤¤¥³¡¼¥É¤Î¾ì¹ç¤Ï#f
+(define (tutcode-kanji-code-input-jis str-list)
+ (and-let*
+ ((length=4? (= (length str-list) 4))
+ (str1 (string-list-concat (take-right str-list 2)))
+ (str2 (string-list-concat (take str-list 2)))
+ (jis1 (string->number str1 16))
+ (jis2 (string->number str2 16)))
+ (tutcode-jis-code->euc-jp-string 'jisx0213-plane1 jis1 jis2)))
+
+;;; JIS¥³¡¼¥É(ISO-2022-JP)¤òEUC-JPʸ»úÎó¤ËÊÑ´¹¤¹¤ë
+;;; @param state 'jisx0213-plane1¤«'jisx0213-plane2
+;;; @param jis1 JIS¥³¡¼¥É¤Î1¥Ð¥¤¥ÈÌÜ
+;;; @param jis2 JIS¥³¡¼¥É¤Î2¥Ð¥¤¥ÈÌÜ
+;;; @return EUC-JPʸ»úÎó¡£Àµ¤·¤¯¤Ê¤¤¥³¡¼¥É¤Î¾ì¹ç¤Ï#f
+(define (tutcode-jis-code->euc-jp-string state jis1 jis2)
+ (let
+ ((ej0 (if (eq? state 'jisx0213-plane2) #x8f 0))
+ (ej1 (+ jis1 #x80))
+ (ej2 (+ jis2 #x80)))
+ (and
+ ;; sigscheme/src/encoding.c:eucjp_int2str()
+ (<= #xa1 ej1 #xfe) ; IN_GR94()
+ (if (= ej0 #x8f) ; SS3?
+ (<= #xa1 ej2 #xfe) ; IN_GR94()
+ (<= #xa0 ej2 #xff)) ; IN_GR96()
+ (tutcode-euc-jp-code->euc-jp-string
+ (+ (* ej0 #x10000) (* ej1 #x100) ej2)))))
+
+;;; EUC-JP¥³¡¼¥É¤òEUC-JPʸ»úÎó¤ËÊÑ´¹¤¹¤ë (cf. ucs->utf8-string in
ichar.scm)
+;;; @param code EUC-JP¥³¡¼¥É
+;;; @return EUC-JPʸ»úÎó
+(define (tutcode-euc-jp-code->euc-jp-string code)
+ (with-char-codec "EUC-JP"
+ (lambda ()
+ (let ((str (list->string (list (integer->char code)))))
+ (with-char-codec "ISO-8859-1"
+ (lambda ()
+ (%%string-reconstruct! str)))))))
+
;;; »Ò¥³¥ó¥Æ¥¥¹¥È¤òºîÀ®¤¹¤ë¡£
;;; @param type 'tutcode-child-type-editor¤«'tutcode-child-type-dialog
(define (tutcode-setup-child-context pc type)
@@ -1631,6 +1739,7 @@
(case cand
((tutcode-mazegaki-start) "¡þ")
((tutcode-latin-conv-start) "/")
+ ((tutcode-kanji-code-input-start) "¢¢")
((tutcode-bushu-start) "¢¡")
((tutcode-interactive-bushu-start) "¢§")
((tutcode-postfix-bushu-start) "¢¥")
@@ -1939,6 +2048,11 @@
(im-pushback-preedit pc preedit-none "¢¤")
(let ((h (tutcode-make-string (tutcode-context-head pc))))
(if (string? h)
+ (im-pushback-preedit pc preedit-none h))))
+ ((tutcode-state-code)
+ (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-converting)
(im-pushback-preedit pc preedit-none "¢¤")
@@ -2337,6 +2451,8 @@
(tutcode-context-set-latin-conv! pc #t)
(tutcode-context-set-postfix-yomi-len! pc 0)
(tutcode-context-set-state! pc 'tutcode-state-yomi))
+ ((eq? res 'tutcode-kanji-code-input-start)
+ (tutcode-context-set-state! pc 'tutcode-state-code))
((eq? res 'tutcode-bushu-start)
(tutcode-context-set-state! pc 'tutcode-state-bushu)
(tutcode-append-string pc "¢¥"))
@@ -2988,6 +3104,58 @@
'tutcode-candidate-window-off))
(tutcode-check-prediction pc #f))))))))
+;;; ´Á»ú¥³¡¼¥ÉÆþÎϾõÂ֤ΤȤ¤Î¥¡¼ÆþÎϤò½èÍý¤¹¤ë¡£
+;;; @param key ÆþÎϤµ¤ì¤¿¥¡¼
+;;; @param key-state ¥³¥ó¥È¥í¡¼¥ë¥¡¼Åù¤Î¾õÂÖ
+(define (tutcode-proc-state-code c key key-state)
+ (let*
+ ((pc (tutcode-find-descendant-context c))
+ (head (tutcode-context-head pc))
+ (res #f))
+ (cond
+ ((and tutcode-use-with-vi?
+ (tutcode-vi-escape-key? key key-state))
+ (tutcode-flush pc)
+ (tutcode-context-set-state! pc 'tutcode-state-off)
+ (tutcode-commit-raw pc key key-state)) ; ESC¥¡¼¤ò¥¢¥×¥ê¤Ë¤âÅϤ¹
+ ((tutcode-off-key? key key-state)
+ (tutcode-flush pc)
+ (tutcode-context-set-state! pc 'tutcode-state-off))
+ ((tutcode-kigou-toggle-key? key key-state)
+ (tutcode-flush pc)
+ (tutcode-begin-kigou-mode pc))
+ ((tutcode-kigou2-toggle-key? key key-state)
+ (tutcode-flush pc)
+ (if (not (tutcode-kigou2-mode? pc))
+ (tutcode-toggle-kigou2-mode pc)))
+ ((tutcode-backspace-key? key key-state)
+ (if (pair? head)
+ (tutcode-context-set-head! pc (cdr head))))
+ ((tutcode-cancel-key? key key-state)
+ (tutcode-flush pc))
+ ((or (tutcode-commit-key? key key-state)
+ (tutcode-return-key? key key-state))
+ (tutcode-commit pc (string-list-concat head))
+ (tutcode-flush pc))
+ ((symbol? key)
+ (tutcode-flush pc)
+ (tutcode-proc-state-on pc key key-state))
+ ((and (modifier-key-mask key-state)
+ (not (shift-key-mask key-state)))
+ (if (tutcode-begin-conv-key? key key-state) ;
<Control>nÅù¤Ç¤ÎÊÑ´¹³«»Ï?
+ (if (pair? head)
+ (tutcode-begin-kanji-code-input pc head)
+ (tutcode-flush pc))
+ (begin
+ (tutcode-flush pc)
+ (tutcode-proc-state-on pc key key-state))))
+ ((tutcode-begin-conv-key? key key-state) ; space¥¡¼¤Ç¤ÎÊÑ´¹³«»Ï?
+ (if (pair? head)
+ (tutcode-begin-kanji-code-input pc head)
+ (tutcode-flush pc)))
+ (else
+ (tutcode-append-string pc (charcode->string key))))))
+
;;; Éô¼ó¹çÀ®ÊÑ´¹¤ÎÉô¼óÆþÎϾõÂ֤ΤȤ¤Î¥¡¼ÆþÎϤò½èÍý¤¹¤ë¡£
;;; @param c ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
;;; @param key ÆþÎϤµ¤ì¤¿¥¡¼
@@ -3789,7 +3957,8 @@
(not (null? (tutcode-context-child-context pc)))
(memq (tutcode-context-state pc)
'(tutcode-state-yomi tutcode-state-bushu tutcode-state-converting
- tutcode-state-interactive-bushu tutcode-state-kigou))))
+ tutcode-state-interactive-bushu tutcode-state-kigou
+ tutcode-state-code))))
;;; ¥¡¼¤¬²¡¤µ¤ì¤¿¤È¤¤Î½èÍý¤Î¿¶¤êʬ¤±¤ò¹Ô¤¦¡£
;;; @param c ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
@@ -3823,6 +3992,9 @@
((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))
(else
(tutcode-proc-state-off pc key key-state)
(if (tutcode-state-has-preedit? c) ; ºÆµ¢³Ø½¬»þ
@@ -4288,6 +4460,8 @@
'(tutcode-mazegaki-start))
(make-subrule tutcode-latin-conv-start-sequence
'(tutcode-latin-conv-start))
+ (make-subrule tutcode-kanji-code-input-start-sequence
+ '(tutcode-kanji-code-input-start))
(make-subrule tutcode-bushu-start-sequence
'(tutcode-bushu-start))
(and
