Revision: 6476
Author: deton.kih
Date: Fri Jun 25 21:13:30 2010
Log: * Add auto help for tutcode
* scm/tutcode-custom.scm
- (tutcode-use-auto-help-window?): New
* scm/tutcode.scm
- (tutcode-auto-help-cand-str-list): New variable
- (tutcode-commit-with-auto-help): New function
- (tutcode-check-auto-help-window-begin): New function
- (tutcode-commit-by-label-key): Change to use
tutcode-commit-with-auto-help
- (tutcode-proc-state-converting): Ditto
- (tutcode-set-candidate-index-handler): Ditto
- (tutcode-begin-conversion): Change to use tutcode-commit-with-auto-help.
Follow the value type change of candidate-window
- (tutcode-proc-state-bushu):
Add call of tutcode-check-auto-help-window-begin.
Follow the value type change of candidate-window
- (tutcode-get-candidate-handler): Add check of
tutcode-use-auto-help-window?
- (tutcode-bushu-decompose): Change to call tutcode-reverse-find-seq
- (tutcode-reverse-find-seq): New function
- (candidate-window): Change value type from boolean to symbol
- (tutcode-begin-kigou-mode):
Follow the value type change of candidate-window
- (tutcode-check-candidate-window-begin): Ditto
- (tutcode-check-stroke-help-window-begin): Ditto
- (tutcode-proc-state-kigou): Ditto
- (tutcode-change-candidate-index): Ditto
- (tutcode-reset-candidate-window): Ditto
http://code.google.com/p/uim/source/detail?r=6476
Modified:
/trunk/scm/tutcode-custom.scm
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode-custom.scm Sat Jun 19 01:57:01 2010
+++ /trunk/scm/tutcode-custom.scm Fri Jun 25 21:13:30 2010
@@ -126,6 +126,12 @@
(N_ "Use stroke help window")
(N_ "long description will be here."))
+(define-custom 'tutcode-use-auto-help-window? #f
+ '(tutcode candwin)
+ '(boolean)
+ (N_ "Use auto help window")
+ (N_ "long description will be here."))
+
;; activity dependency
(custom-add-hook 'tutcode-candidate-op-count
'custom-activity-hooks
=======================================
--- /trunk/scm/tutcode.scm Sun Jun 20 02:56:21 2010
+++ /trunk/scm/tutcode.scm Fri Jun 25 21:13:30 2010
@@ -155,6 +155,17 @@
"a" "s" "d" "f" "g" "h" "j" "k" "l" ";"
"z" "x" "c" "v" "b" "n" "m" "," "." "/"))
+;;; ¼«Æ°¥Ø¥ë¥×¤Ç¤Îʸ»ú¤ÎÂǤÁÊýɽ¼¨¤ÎºÝ¤Ë¸õÊäʸ»úÎó¤È¤·¤Æ»È¤¦Ê¸»ú¤Î¥ê¥¹¥È
+(define tutcode-auto-help-cand-str-list
+ ; Âè1,2,3,4ÂǸ°¤ò¼¨¤¹Ê¸»ú
+ '(("1" "2" "3" "4") ; 1ʸ»úÌÜÍÑ
+ ("a" "b" "c" "d") ; 2ʸ»úÌÜÍÑ
+ ("A" "B" "C" "D")
+ ("°ì" "Æó" "»°" "»Í")
+ ("¤¢" "¤¤" "¤¦" "¤¨")
+ ("¥¢" "¥¤" "¥¦" "¥¨")
+ ("¦Á" "¦Â" "¦Ã" "¦Ä")))
+
;;; implementations
;;; ¸ò¤¼½ñ¤ÊÑ´¹¼½ñ¤Î½é´ü²½¤¬½ª¤ï¤Ã¤Æ¤¤¤ë¤«¤É¤¦¤«
@@ -272,8 +283,13 @@
(nth 0)
;;; ¸ò¤¼½ñ¤ÊÑ´¹¤Î¸õÊä¿ô
(nr-candidates 0)
- ;;; ¸õÊ䥦¥£¥ó¥É¥¦¤òɽ¼¨Ã椫¤É¤¦¤«
- (candidate-window #f)
+ ;;; ¸õÊ䥦¥£¥ó¥É¥¦¤Î¾õÂÖ
+ ;;; 'tutcode-candidate-window-off Èóɽ¼¨
+ ;;; 'tutcode-candidate-window-converting ¸ò¤¼½ñ¤ÊÑ´¹¸õÊäɽ¼¨Ãæ
+ ;;; 'tutcode-candidate-window-kigou µ¹æɽ¼¨Ãæ
+ ;;; 'tutcode-candidate-window-stroke-help ²¾ÁÛ¸°È×ɽ¼¨Ãæ
+ ;;; 'tutcode-candidate-window-auto-help ¼«Æ°¥Ø¥ë¥×ɽ¼¨Ãæ
+ (candidate-window 'tutcode-candidate-window-off)
;;; ¥¹¥È¥í¡¼¥¯É½
;;;
¼¡¤ËÆþÎϤ¹¤ë¥¡¼¤Èʸ»ú¤ÎÂбþ¤Î¡¢get-candidate-handlerÍÑ·Á¼°¤Ç¤Î¥ê¥¹¥È
(stroke-help ()))))
@@ -402,6 +418,13 @@
(define (tutcode-prepare-commit-string-for-kigou-mode pc)
(tutcode-get-current-candidate-for-kigou-mode pc))
+;;; im-commit¤ò¸Æ¤Ó½Ð¤¹¤È¤È¤â¤Ë¡¢¼«Æ°¥Ø¥ë¥×ɽ¼¨¤Î¥Á¥§¥Ã¥¯¤ò¹Ô¤¦
+(define (tutcode-commit-with-auto-help pc)
+ (let* ((head (tutcode-context-head pc))
+ (res (tutcode-prepare-commit-string pc)))
+ (im-commit pc res)
+ (tutcode-check-auto-help-window-begin pc (string-to-list res) head)))
+
;;;
¸ò¤¼½ñ¤ÊÑ´¹¤Î¸õÊäÁªÂò»þ¤Ë¡¢»ØÄꤵ¤ì¤¿¥é¥Ù¥ëʸ»ú¤ËÂбþ¤¹¤ë¸õÊä¤ò³ÎÄꤹ¤ë
(define (tutcode-commit-by-label-key pc ch)
;; ¸½ºß¸õÊ䥦¥£¥ó¥É¥¦¤Ëɽ¼¨¤µ¤ì¤Æ¤¤¤Ê¤¤¥é¥Ù¥ëʸ»ú¤òÆþÎϤ·¤¿¾ì¹ç¡¢
@@ -433,7 +456,7 @@
(< idx nr))
(begin
(tutcode-context-set-nth! pc idx)
- (im-commit pc (tutcode-prepare-commit-string pc))))))
+ (tutcode-commit-with-auto-help pc)))))
;;; µ¹æÆþÎϥ⡼¥É»þ¤Ë¡¢»ØÄꤵ¤ì¤¿¥é¥Ù¥ëʸ»ú¤ËÂбþ¤¹¤ë¸õÊä¤ò³ÎÄꤹ¤ë
(define (tutcode-commit-by-label-key-for-kigou-mode pc ch)
@@ -482,10 +505,11 @@
(tutcode-context-set-state! pc 'tutcode-state-converting)
(if (= (tutcode-context-nr-candidates pc) 1)
;; ¸õÊ䤬1¸Ä¤·¤«¤Ê¤¤¾ì¹ç¤Ï¼«Æ°Åª¤Ë³ÎÄꤹ¤ë
- (im-commit pc (tutcode-prepare-commit-string pc))
+ (tutcode-commit-with-auto-help pc)
(begin
(tutcode-check-candidate-window-begin pc)
- (if (tutcode-context-candidate-window pc)
+ (if (eq? (tutcode-context-candidate-window pc)
+ 'tutcode-candidate-window-converting)
(im-select-candidate pc 0)))))
;(tutcode-flush pc) ;
¸õÊä̵¤·»þflush¤¹¤ë¤ÈÆþÎϤ·¤¿Ê¸»úÎ󤬾䨤Ƥ¬¤Ã¤«¤ê
)))
@@ -497,16 +521,21 @@
(tutcode-context-set-nr-candidates! pc (length tutcode-kigoudic))
(tutcode-context-set-state! pc 'tutcode-state-kigou)
(tutcode-check-candidate-window-begin pc)
- (if (tutcode-context-candidate-window pc)
+ (if (eq? (tutcode-context-candidate-window pc)
+ 'tutcode-candidate-window-kigou)
(im-select-candidate pc 0)))
;;; ¸õÊ䥦¥£¥ó¥É¥¦¤Îɽ¼¨¤ò³«»Ï¤¹¤ë
(define (tutcode-check-candidate-window-begin pc)
- (if (and (not (tutcode-context-candidate-window pc))
+ (if (and (eq? (tutcode-context-candidate-window pc)
+ 'tutcode-candidate-window-off)
tutcode-use-candidate-window?
(>= (tutcode-context-nth pc) (- tutcode-candidate-op-count 1)))
(begin
- (tutcode-context-set-candidate-window! pc #t)
+ (tutcode-context-set-candidate-window! pc
+ (if (eq? (tutcode-context-state pc) 'tutcode-state-kigou)
+ 'tutcode-candidate-window-kigou
+ 'tutcode-candidate-window-converting))
(im-activate-candidate-selector
pc
(tutcode-context-nr-candidates pc)
@@ -516,7 +545,8 @@
;;; ²¾ÁÛ¸°ÈפÎɽ¼¨¤ò³«»Ï¤¹¤ë
(define (tutcode-check-stroke-help-window-begin pc)
- (if (and (not (tutcode-context-candidate-window pc))
+ (if (and (eq? (tutcode-context-candidate-window pc)
+ 'tutcode-candidate-window-off)
tutcode-use-stroke-help-window?)
(let* ((rkc (tutcode-context-rk-context pc))
(seq (rk-context-seq rkc)))
@@ -551,11 +581,66 @@
(delete-duplicates (rk-expect rkc)))))
(if (not (null? (tutcode-context-stroke-help pc)))
(begin
- (tutcode-context-set-candidate-window! pc #t)
+ (tutcode-context-set-candidate-window! pc
+ 'tutcode-candidate-window-stroke-help)
(im-activate-candidate-selector pc
(length (tutcode-context-stroke-help pc))
(length tutcode-heading-label-char-list-for-stroke-help)))))))
+;;; Éô¼ó¹çÀ®ÊÑ´¹¡¦¸ò¤¼½ñ¤ÊÑ´¹¤Ç³ÎÄꤷ¤¿Ê¸»ú¤ÎÂǤÁÊý¤òɽ¼¨¤¹¤ë¡£
+;;; ɽ·Á¼°¤Î¸õÊ䥦¥£¥ó¥É¥¦¤òÁÛÄꤷ¤Æ¡¢°Ê²¼¤Î¤è¤¦¤Ëɽ¼¨¤¹¤ë¡£
+;;; 1¤¬Âè1ÂǸ°¡¢2¤¬Âè2ÂǸ°¡£¡Ö·È¡×
+;;; ¡¦¡¦¡¦¡¦ ¡¦¡¦¡¦¡¦
+;;; ¡¦¡¦¡¦¡¦ ¡¦¡¦3 ¡¦
+;;; ¡¦¡¦¡¦¡¦1 ¡¦¡¦¡¦¡¦
+;;; ¡¦¡¦¡¦2 ¡¦¡¦¡¦¡¦
+;;;
¸ò¤¼½ñ¤ÊÑ´¹¤ÇÊ£¿ô¤Îʸ»ú¡Ö·ÈÂӡפòÊÑ´¹¤·¤¿¾ì¹ç¤Ï¡¢°Ê²¼¤Î¤è¤¦¤Ëɽ¼¨¤¹¤ë¡£
+;;; ¡¦¡¦¡¦¡¦ ¡¦¡¦¡¦¡¦
+;;; ¡¦¡¦a ¡¦ ¡¦¡¦3 ¡¦
+;;; ¡¦¡¦¡¦¡¦1b ¡¦¡¦c ¡¦
+;;; ¡¦¡¦¡¦2 ¡¦¡¦¡¦¡¦
+;;; @param strlist ³ÎÄꤷ¤¿Ê¸»úÎó¤Î¥ê¥¹¥È(µÕ½ç)
+;;; @param yomilist ÊÑ´¹Á°¤ÎÆɤߤÎʸ»úÎó¤Î¥ê¥¹¥È(µÕ½ç)
+(define (tutcode-check-auto-help-window-begin pc strlist yomilist)
+ (if (and (eq? (tutcode-context-candidate-window pc)
+ 'tutcode-candidate-window-off)
+ tutcode-use-auto-help-window?)
+ (let* ((label-cands-alist ()) ; Îã:(("y" "2" "1") ("t" "3"))
+ (cand-str-list tutcode-auto-help-cand-str-list)
+ (help-one
+ (lambda (str cand-list)
+ (let ((stroke (tutcode-reverse-find-seq tutcode-rule str)))
+ (if stroke
+ (for-each
+ (lambda (label)
+ (let ((label-cand (assoc label label-cands-alist))
+ (cand (if (pair? cand-list) (car
cand-list) "")))
+ (if label-cand
+ (set-cdr! label-cand (cons cand (cdr
label-cand)))
+ (set! label-cands-alist
+ (cons (list label cand) label-cands-alist)))
+ (set! cand-list (cdr cand-list))))
+ stroke))))))
+ (for-each
+ (lambda (kanji)
+ (if (pair? cand-str-list)
+ (begin
+ (help-one kanji (car cand-str-list))
+ (set! cand-str-list (cdr cand-str-list)))))
+ (lset-difference string=? (reverse strlist) yomilist))
+ (tutcode-context-set-stroke-help! pc
+ (map
+ (lambda (elem)
+ (list (tutcode-make-string (cdr elem)) (car elem) ""))
+ label-cands-alist))
+ (if (not (null? (tutcode-context-stroke-help pc)))
+ (begin
+ (tutcode-context-set-candidate-window! pc
+ 'tutcode-candidate-window-auto-help)
+ (im-activate-candidate-selector pc
+ (length (tutcode-context-stroke-help pc))
+ (length tutcode-heading-label-char-list-for-stroke-help)))))))
+
;;; preeditɽ¼¨¤ò¹¹¿·¤¹¤ë¡£
;;; @param pc ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
(define (tutcode-update-preedit pc)
@@ -672,7 +757,8 @@
(not (shift-key-mask key-state))))
(tutcode-heading-label-char-for-kigou-mode? key))
(tutcode-commit-by-label-key-for-kigou-mode pc (charcode->string
key))
- (if (tutcode-context-candidate-window pc)
+ (if (eq? (tutcode-context-candidate-window pc)
+ 'tutcode-candidate-window-kigou)
(im-select-candidate pc (tutcode-context-nth pc))))
((tutcode-next-candidate-key? key key-state)
(tutcode-change-candidate-index pc 1))
@@ -799,6 +885,7 @@
(if res
(im-commit pc res))
(tutcode-flush pc)
+ (if res (tutcode-check-auto-help-window-begin pc (list res)
()))
(set! res #f))))
((tutcode-cancel-key? key key-state)
;; ºÆµ¢ÅªÉô¼ó¹çÀ®ÊÑ´¹¤ò(¥¥ã¥ó¥»¥ë¤·¤Æ)°ìÃÊÌ᤹
@@ -849,7 +936,8 @@
;; ÊÑ´¹ÂÔ¤Á¤ÎÉô¼ó¤¬»Ä¤Ã¤Æ¤Ê¤±¤ì¤Ð¡¢³ÎÄꤷ¤Æ½ªÎ»
(begin
(im-commit pc char)
- (tutcode-flush pc))
+ (tutcode-flush pc)
+ (tutcode-check-auto-help-window-begin pc (list char)
()))
;; Éô¼ó¤¬¤Þ¤À»Ä¤Ã¤Æ¤ì¤Ð¡¢ºÆ³Îǧ¡£
;; (¹çÀ®¤·¤¿Ê¸»ú¤¬2ʸ»úÌܤʤé¤Ð¡¢Ï¢Â³¤·¤ÆÉô¼ó¹çÀ®ÊÑ´¹)
(loop
@@ -872,15 +960,18 @@
(set! new-nth (- nr 1))))
(tutcode-context-set-nth! pc new-nth))
(tutcode-check-candidate-window-begin pc)
- (if (tutcode-context-candidate-window pc)
+ (if (not (eq? (tutcode-context-candidate-window pc)
+ 'tutcode-candidate-window-off))
(im-select-candidate pc (tutcode-context-nth pc))))
;;; ¸õÊ䥦¥£¥ó¥É¥¦¤òÊĤ¸¤ë
(define (tutcode-reset-candidate-window pc)
- (if (tutcode-context-candidate-window pc)
+ (if (not (eq? (tutcode-context-candidate-window pc)
+ 'tutcode-candidate-window-off))
(begin
(im-deactivate-candidate-selector pc)
- (tutcode-context-set-candidate-window! pc #f))))
+ (tutcode-context-set-candidate-window! pc
+ 'tutcode-candidate-window-off))))
;;; ¸ò¤¼½ñ¤ÊÑ´¹¤Î¸õÊäÁªÂò¾õÂÖ¤«¤é¡¢ÆɤßÆþÎϾõÂÖ¤ËÌ᤹¡£
;;; @param pc ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
@@ -918,7 +1009,7 @@
((or
(tutcode-commit-key? key key-state)
(tutcode-return-key? key key-state))
- (im-commit pc (tutcode-prepare-commit-string pc)))
+ (tutcode-commit-with-auto-help pc))
((and tutcode-commit-candidate-by-label-key?
(tutcode-heading-label-char? key))
(tutcode-commit-by-label-key pc (charcode->string key)))
@@ -1033,11 +1124,20 @@
;;; @param c ʬ²òÂоݤÎʸ»ú
;;; @return ʬ²ò¤·¤Æ¤Ç¤¤¿2¤Ä¤ÎÉô¼ó¤Î¥ê¥¹¥È¡£Ê¬²ò¤Ç¤¤Ê¤«¤Ã¤¿¤È¤¤Ï#f
(define (tutcode-bushu-decompose c)
+ (tutcode-reverse-find-seq tutcode-bushudic c))
+
+;;; rule¤òµÕ°ú¤¤·¤Æ¡¢ÊÑ´¹¸å¤Îʸ»ú¤«¤é¡¢ÆþÎÏ¥¡¼Îó¤ò¼èÆÀ¤¹¤ë¡£
+;;; Îã: (tutcode-reverse-find-seq tutcode-rule "¤¢") => ("r" "k")
+;;; @param rule rk¤Ç»È¤¦·Á¼°¤Îrule
+;;; @param c ÊÑ´¹¸å¤Îʸ»ú
+;;; @return ÆþÎÏ¥¡¼¤Î¥ê¥¹¥È¡£ruleÃæ¤Ëc¤¬¸«¤Ä¤«¤é¤Ê¤«¤Ã¤¿¾ì¹ç¤Ï#f
+(define (tutcode-reverse-find-seq rule c)
(let ((lst
(filter
(lambda (elem)
- (string=? c (car (cadr elem))))
- tutcode-bushudic)))
+ ;; string=?¤À¤È'tutcode-mazegaki-start¤Ç¥¨¥é¡¼
+ (equal? c (car (cadr elem))))
+ rule)))
(and
(not (null? lst))
(car (caar lst)))))
@@ -1128,7 +1228,7 @@
;; XXX:annotationɽ¼¨¤Ï¸½¾õ̵¸ú²½¤µ¤ì¤Æ¤¤¤ë¤Î¤Ç¡¢¾ï¤Ë""¤òÊÖ¤·¤Æ¤ª¤¯
(list cand label "")))
((and (not (eq? (tutcode-context-state tc) 'tutcode-state-converting))
- tutcode-use-stroke-help-window?)
+ (or tutcode-use-stroke-help-window?
tutcode-use-auto-help-window?))
(nth idx (tutcode-context-stroke-help tc)))
(else
(let* ((cand (tutcode-get-nth-candidate tc idx))
@@ -1140,15 +1240,17 @@
;;; ÁªÂò¤µ¤ì¤¿¸õÊä¤ò³ÎÄꤹ¤ë¡£
(define (tutcode-set-candidate-index-handler pc idx)
(if (and
- (tutcode-context-candidate-window pc)
+ (or (eq? (tutcode-context-candidate-window pc)
+ 'tutcode-candidate-window-converting)
+ (eq? (tutcode-context-candidate-window pc)
+ 'tutcode-candidate-window-kigou))
(>= idx 0)
(< idx (tutcode-context-nr-candidates pc)))
(begin
(tutcode-context-set-nth! pc idx)
- (im-commit pc
- (if (eq? (tutcode-context-state pc) 'tutcode-state-kigou)
- (tutcode-prepare-commit-string-for-kigou-mode pc)
- (tutcode-prepare-commit-string pc)))
+ (if (eq? (tutcode-context-state pc) 'tutcode-state-kigou)
+ (im-commit pc (tutcode-prepare-commit-string-for-kigou-mode pc))
+ (tutcode-commit-with-auto-help pc))
(tutcode-update-preedit pc))))
(tutcode-configure-widgets)
