Revision: 6458
Author: deton.kih
Date: Sat Jun 19 01:57:01 2010
Log: * Add feature to show candidate table on next key for tutcode
* scm/tutcode-custom.scm
- (tutcode-use-stroke-help-window?): New custom variable
* scm/tutcode.scm
- (tutcode-heading-label-char-list-for-stroke-help): New variable
- (tutcode-context-rec-spec): Add stroke-help
- (tutcode-check-stroke-help-window-begin): New function
- (tutcode-proc-state-on): Add call of
tutcode-check-stroke-help-window-begin
- (tutcode-proc-state-yomi): Ditto
- (tutcode-proc-state-bushu): Ditto
- (tutcode-get-candidate-handler): Add return of stroke-help
http://code.google.com/p/uim/source/detail?r=6458
Modified:
/trunk/scm/tutcode-custom.scm
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode-custom.scm Sat May 29 19:45:09 2010
+++ /trunk/scm/tutcode-custom.scm Sat Jun 19 01:57:01 2010
@@ -120,6 +120,12 @@
(N_ "Number of candidates in candidate window at a time for kigou mode")
(N_ "long description will be here."))
+(define-custom 'tutcode-use-stroke-help-window? #f
+ '(tutcode candwin)
+ '(boolean)
+ (N_ "Use stroke 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 13 01:28:24 2010
+++ /trunk/scm/tutcode.scm Sat Jun 19 01:57:01 2010
@@ -87,6 +87,7 @@
;;; * Éô¼ó¹çÀ®ÊÑ´¹µ¡Ç½¤òÄɲá£
;;; * µ¹æÆþÎϥ⡼¥É¤òÄɲá£
+(require-extension (srfi 1))
(require "generic.scm")
(require-custom "tutcode-custom.scm")
(require-custom "generic-key-custom.scm")
@@ -147,6 +148,13 @@
"U" "V" "W" "X" "Y" "Z"
"=" "~" "|" "`" "{" "+" "*" "}" "<" ">" "?" "_"))
+;;; ¥¹¥È¥í¡¼¥¯É½¤Î¥¡¼¥ê¥¹¥È
+(define tutcode-heading-label-char-list-for-stroke-help
+ '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0"
+ "q" "w" "e" "r" "t" "y" "u" "i" "o" "p"
+ "a" "s" "d" "f" "g" "h" "j" "k" "l" ";"
+ "z" "x" "c" "v" "b" "n" "m" "," "." "/"))
+
;;; implementations
;;; ¸ò¤¼½ñ¤ÊÑ´¹¼½ñ¤Î½é´ü²½¤¬½ª¤ï¤Ã¤Æ¤¤¤ë¤«¤É¤¦¤«
@@ -265,7 +273,10 @@
;;; ¸ò¤¼½ñ¤ÊÑ´¹¤Î¸õÊä¿ô
(nr-candidates 0)
;;; ¸õÊ䥦¥£¥ó¥É¥¦¤òɽ¼¨Ã椫¤É¤¦¤«
- (candidate-window #f))))
+ (candidate-window #f)
+ ;;; ¥¹¥È¥í¡¼¥¯É½
+ ;;;
¼¡¤ËÆþÎϤ¹¤ë¥¡¼¤Èʸ»ú¤ÎÂбþ¤Î¡¢get-candidate-handlerÍÑ·Á¼°¤Ç¤Î¥ê¥¹¥È
+ (stroke-help ()))))
(define-record 'tutcode-context tutcode-context-rec-spec)
(define tutcode-context-new-internal tutcode-context-new)
(define tutcode-context-katakana-mode? tutcode-context-katakana-mode)
@@ -503,6 +514,47 @@
tutcode-nr-candidate-max-for-kigou-mode
tutcode-nr-candidate-max)))))
+;;; ²¾ÁÛ¸°ÈפÎɽ¼¨¤ò³«»Ï¤¹¤ë
+(define (tutcode-check-stroke-help-window-begin pc)
+ (if (and (not (tutcode-context-candidate-window pc))
+ tutcode-use-stroke-help-window?)
+ (let* ((rkc (tutcode-context-rk-context pc))
+ (seq (rk-context-seq rkc)))
+ (tutcode-context-set-stroke-help! pc
+ ; rk-expect¤Î³Æ¥á¥ó¥Ð¤Ë¤Ä¤¤¤Æ¡¢
+ ; rk-lib-find-seq¤·¤Æ¡¢labelʸ»ú¤È¸õÊä¤Î¥ê¥¹¥È¤òºîÀ®¡£
+ ; #f¤Î¾ì¹ç¤Ï¥¹¥È¥í¡¼¥¯ÅÓÃæ¤Ê¤Î¤Ç¸õÊä¤È¤·¤Æ¢¢¤ò»ÈÍÑ¡£
+ (map
+ (lambda (elem)
+ (let* ((res
+ (rk-lib-find-seq (reverse (cons elem seq))
tutcode-rule))
+ (candlist (and res (cadr res)))
+ (cand
+ (if res
+ (or
+ (and (tutcode-context-katakana-mode? pc)
+ (not (null? (cdr candlist)))
+ (cadr candlist))
+ (car candlist))
+ "¢¢"))
+ (candstr
+ (case cand
+ ((tutcode-mazegaki-start) "¡þ")
+ ((tutcode-bushu-start) "¢¡")
+ (else cand)))
+ (labeledcand
+ (list candstr elem "")))
+ labeledcand))
+ (filter
+ (lambda (elem)
+ (member elem
tutcode-heading-label-char-list-for-stroke-help))
+ (delete-duplicates (rk-expect rkc)))))
+ (tutcode-context-set-candidate-window! pc #t)
+ (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)
@@ -536,6 +588,7 @@
;;; @param key-state ¥³¥ó¥È¥í¡¼¥ë¥¡¼Åù¤Î¾õÂÖ
(define (tutcode-proc-state-on pc key key-state)
(let ((rkc (tutcode-context-rk-context pc)))
+ (tutcode-reset-candidate-window pc)
(cond
((and
(tutcode-vi-escape-key? key key-state)
@@ -580,7 +633,8 @@
(tutcode-context-set-state! pc 'tutcode-state-bushu)
(tutcode-append-string pc "¢¥"))
(else
- (im-commit pc res)))))))))
+ (im-commit pc res)))
+ (tutcode-check-stroke-help-window-begin pc)))))))
;;; ľÀÜÆþÎϾõÂ֤ΤȤ¤Î¥¡¼ÆþÎϤò½èÍý¤¹¤ë¡£
;;; @param pc ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
@@ -652,6 +706,7 @@
(define (tutcode-proc-state-yomi pc key key-state)
(let* ((rkc (tutcode-context-rk-context pc))
(res #f))
+ (tutcode-reset-candidate-window pc)
(cond
((tutcode-off-key? key key-state)
(tutcode-flush pc)
@@ -699,7 +754,9 @@
(tutcode-flush pc))
(set! res (charcode->string key)))))
(else
- (set! res (tutcode-push-key! pc (charcode->string key)))))
+ (set! res (tutcode-push-key! pc (charcode->string key)))
+ (if (not res)
+ (tutcode-check-stroke-help-window-begin pc))))
(if res
(tutcode-append-string pc res))))
@@ -710,6 +767,7 @@
(define (tutcode-proc-state-bushu pc key key-state)
(let* ((rkc (tutcode-context-rk-context pc))
(res #f))
+ (tutcode-reset-candidate-window pc)
(cond
((tutcode-off-key? key key-state)
(tutcode-flush pc)
@@ -769,7 +827,9 @@
(set! res #f))
((tutcode-bushu-start) ; ºÆµ¢Åª¤ÊÉô¼ó¹çÀ®ÊÑ´¹
(tutcode-append-string pc "¢¥")
- (set! res #f)))))
+ (set! res #f))
+ ((#f)
+ (tutcode-check-stroke-help-window-begin pc)))))
(if res
(let loop ((prevchar (car (tutcode-context-head pc)))
(char res))
@@ -1066,6 +1126,9 @@
(label (nth n
tutcode-heading-label-char-list-for-kigou-mode)))
;; XXX:annotationɽ¼¨¤Ï¸½¾õ̵¸ú²½¤µ¤ì¤Æ¤¤¤ë¤Î¤Ç¡¢¾ï¤Ë""¤òÊÖ¤·¤Æ¤ª¤¯
(list cand label "")))
+ ((and (not (eq? (tutcode-context-state tc) 'tutcode-state-converting))
+ tutcode-use-stroke-help-window?)
+ (nth idx (tutcode-context-stroke-help tc)))
(else
(let* ((cand (tutcode-get-nth-candidate tc idx))
(n (remainder idx (length tutcode-heading-label-char-list)))
