Revision: 6815
Author: deton.kih
Date: Fri Nov 12 23:29:29 2010
Log: * Change to show virtual keyboard (stroke help window)
when no key is typed or no other candidate window is displayed
(completion/prediction or auto help has no candidate).
* scm/tutcode.scm
- (tutcode-stroke-help-top-page-alist,
tutcode-stroke-help-top-page-katakana-alist): New variable.
- (tutcode-check-stroke-help-window-begin):
Move check of tutcode-use-stroke-help-window?
to tutcode-key-press-handler.
Change to use cache for top page of stroke help.
- (tutcode-stroke-help-update-alist):
New function extracted from tutcode-check-stroke-help-window-begin
and rewrite using recursion.
- (tutcode-stroke-help-update-alist-with-rule):
New function extracted from tutcode-check-stroke-help-window-begin.
- (tutcode-toggle-stroke-help):
Remove call of tutcode-check-stroke-help-window-begin.
- (tutcode-proc-state-on): Ditto.
- (tutcode-proc-state-yomi): Ditto.
- (tutcode-proc-state-bushu): Ditto.
- (tutcode-key-press-handler):
Add call of tutcode-check-stroke-help-window-begin.
http://code.google.com/p/uim/source/detail?r=6815
Modified:
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode.scm Fri Nov 12 15:35:56 2010
+++ /trunk/scm/tutcode.scm Fri Nov 12 23:29:29 2010
@@ -183,6 +183,13 @@
;;; µÕ°ú¤¸¡º÷(¹çÀ®¸å¤Îʸ»ú¤«¤é¹çÀ®ÍѤÎ2ʸ»ú¤ò¼èÆÀ)ÍÑalist¡£
;;; (¼«Æ°¥Ø¥ë¥×ÍѤÎÉô¼ó¹çÀ®ÊÑ´¹¸õÊ両º÷»þ¤Î¹â®²½¤Î¤¿¤á)
(define tutcode-reverse-bushudic-alist ())
+;;; stroke-help¤Ç¡¢²¿¤â¥¡¼ÆþÎϤ¬Ìµ¤¤¾ì¹ç¤Ëɽ¼¨¤¹¤ëÆâÍƤÎalist¡£
+;;; (Ëè²ótutcode-rule¤òÁ´¤Æ¤Ê¤á¤ÆºîÀ®¤¹¤ë¤ÈÃÙ¤¤¤·¡¢
+;;; ºÇ½é¤Î¥Ú¡¼¥¸¤Ï¸ÇÄêÆâÍƤʤΤǡ¢°ìÅÙºîÀ®¤·¤¿¤â¤Î¤ò»È¤¤²ó¤¹)
+(define tutcode-stroke-help-top-page-alist ())
+;;; stroke-help¤Ç¡¢²¿¤â¥¡¼ÆþÎϤ¬Ìµ¤¤¾ì¹ç¤Ëɽ¼¨¤¹¤ëÆâÍƤÎalist¡£
+;;; ¥«¥¿¥«¥Ê¥â¡¼¥ÉÍÑ¡£
+(define tutcode-stroke-help-top-page-katakana-alist ())
;;; ¥³¡¼¥Éɽ¤ò¾å½ñ¤Êѹ¹/Äɲ乤뤿¤á¤Î¥³¡¼¥Éɽ¡£
;;; ~/.uim¤Çtutcode-rule-set-sequences!¤ÇÅÐÏ¿¤·¤Æ¡¢
@@ -1144,44 +1151,29 @@
;;; ²¾ÁÛ¸°ÈפÎɽ¼¨¤ò³«»Ï¤¹¤ë
(define (tutcode-check-stroke-help-window-begin pc)
- (if (and (eq? (tutcode-context-candidate-window pc)
- 'tutcode-candidate-window-off)
- tutcode-use-stroke-help-window?)
+ (if (eq? (tutcode-context-candidate-window
pc) 'tutcode-candidate-window-off)
(let* ((rkc (tutcode-context-rk-context pc))
(seq (rk-context-seq rkc))
(seqlen (length seq))
(ret (rk-lib-find-partial-seqs (reverse seq) tutcode-rule))
- (label-cand-alist ())) ; Îã:(("k" "¤¢") ("i" "¤¤") ("g" "*£"))
- (for-each
- (lambda (elem) ; Îã: ((("r" "v" "y")) ("±î"))
- (let* ((label (nth seqlen (caar elem)))
- (label-cand (assoc label label-cand-alist)))
- (if (not label-cand)
- (let*
- ((candlist (cadr elem))
- ;; ¥·¡¼¥±¥ó¥¹ÅÓÃæ?
- (has-next? (> (length (caar elem)) (+ seqlen 1)))
- (cand
- (or
- (and (not (null? (cdr candlist)))
- (tutcode-context-katakana-mode? pc)
- (cadr candlist))
- (car candlist)))
- (candstr
- (case cand
- ((tutcode-mazegaki-start) "¡þ")
- ((tutcode-latin-conv-start) "/")
- ((tutcode-bushu-start) "¢¡")
- ((tutcode-auto-help-redisplay) "¢ã")
- (else cand)))
- (cand-hint
- (or
- ;; ¥·¡¼¥±¥ó¥¹ÅÓÃæ¤Î¾ì¹ç¤Ïhint-mark(*)ÉÕ¤
- (and has-next? (string-append tutcode-hint-mark
candstr))
- candstr)))
- (set! label-cand-alist
- (cons (list label cand-hint) label-cand-alist))))))
- ret)
+ (katakana? (tutcode-context-katakana-mode? pc))
+ ;; Îã:(("k" "¤¢") ("i" "¤¤") ("g" "*£"))
+ (label-cand-alist
+ (if (null? seq) ;
tutcode-ruleÁ´Éô¤Ê¤á¤ÆºîÀ®¢ªÃÙ¤¤¤Î¤Ç¥¥ã¥Ã¥·¥å
+ (if katakana?
+ (begin
+ (if (null? tutcode-stroke-help-top-page-katakana-alist)
+ (set! tutcode-stroke-help-top-page-katakana-alist
+ (tutcode-stroke-help-update-alist
+ () seqlen katakana? ret)))
+ tutcode-stroke-help-top-page-katakana-alist)
+ (begin
+ (if (null? tutcode-stroke-help-top-page-alist)
+ (set! tutcode-stroke-help-top-page-alist
+ (tutcode-stroke-help-update-alist
+ () seqlen katakana? ret)))
+ tutcode-stroke-help-top-page-alist))
+ (tutcode-stroke-help-update-alist () seqlen katakana? ret))))
;; ½Ï¸ì¥¬¥¤¥É¤ä¼«Æ°¥Ø¥ë¥×¤«¤é¤Î³¤¤Ç¡¢ÆþÎϸõÊäʸ»ú¤Ë¥Þ¡¼¥¯¤òÉÕ¤±¤ë
(if (and (pair? seq)
(pair? (tutcode-context-guide pc)))
@@ -1249,8 +1241,60 @@
(set! tutcode-use-stroke-help-window? #f)
(tutcode-reset-candidate-window pc))
(begin
- (set! tutcode-use-stroke-help-window? #t)
- (tutcode-check-stroke-help-window-begin pc))))
+ (set! tutcode-use-stroke-help-window? #t))))
+
+;;; ²¾ÁÛ¸°È×ɽ¼¨Íѥǡ¼¥¿ºîÀ®
+;;; @param label-cand-alist ɽ¼¨Íѥǡ¼¥¿¡£
+;;; Îã:(("k" "¤¢") ("i" "¤¤") ("g" "*£"))
+;;; @param seqlen ²¿ÈÖÌܤΥ¹¥È¥í¡¼¥¯¤òÂоݤȤ¹¤ë¤«¡£
+;;; @param katakana? ¥«¥¿¥«¥Ê¥â¡¼¥É¤«¤É¤¦¤«¡£
+;;; @param rule-list rk-rule¡£
+;;; @return ¹¹¿·¤·¤¿label-cand-alist
+(define (tutcode-stroke-help-update-alist
+ label-cand-alist seqlen katakana? rule-list)
+ (if (null? rule-list)
+ label-cand-alist
+ (tutcode-stroke-help-update-alist
+ (tutcode-stroke-help-update-alist-with-rule
+ label-cand-alist seqlen katakana? (car rule-list))
+ seqlen katakana? (cdr rule-list))))
+
+;;; ²¾ÁÛ¸°È×ɽ¼¨Íѥǡ¼¥¿ºîÀ®:°ì¤Ä¤Îrule¤òÈ¿±Ç¡£
+;;; @param label-cand-alist ɽ¼¨Íѥǡ¼¥¿¡£
+;;; @param seqlen ²¿ÈÖÌܤΥ¹¥È¥í¡¼¥¯¤òÂоݤȤ¹¤ë¤«¡£
+;;; @param katakana? ¥«¥¿¥«¥Ê¥â¡¼¥É¤«¤É¤¦¤«¡£
+;;; @param rule rk-ruleÆâ¤Î°ì¤Ä¤Îrule¡£
+;;; @return ¹¹¿·¤·¤¿label-cand-alist
+(define (tutcode-stroke-help-update-alist-with-rule
+ label-cand-alist seqlen katakana? rule)
+ (let* ((label (list-ref (caar rule) seqlen))
+ (label-cand (assoc label label-cand-alist)))
+ ;; ´û¤Ë³äÅö¤Æ¤é¤ì¤Æ¤¿¤é²¿¤â¤·¤Ê¤¤¢ªruleÃæ¤ÇºÇ½é¤Ë½Ð¸½¤¹¤ëʸ»ú¤ò»ÈÍÑ
+ (if label-cand
+ label-cand-alist
+ (let*
+ ((candlist (cadr rule))
+ ;; ¥·¡¼¥±¥ó¥¹ÅÓÃæ?
+ (has-next? (> (length (caar rule)) (+ seqlen 1)))
+ (cand
+ (or
+ (and (not (null? (cdr candlist)))
+ katakana?
+ (cadr candlist))
+ (car candlist)))
+ (candstr
+ (case cand
+ ((tutcode-mazegaki-start) "¡þ")
+ ((tutcode-latin-conv-start) "/")
+ ((tutcode-bushu-start) "¢¡")
+ ((tutcode-auto-help-redisplay) "¢ã")
+ (else cand)))
+ (cand-hint
+ (or
+ ;; ¥·¡¼¥±¥ó¥¹ÅÓÃæ¤Î¾ì¹ç¤Ïhint-mark(*)ÉÕ¤
+ (and has-next? (string-append tutcode-hint-mark candstr))
+ candstr)))
+ (cons (list label cand-hint) label-cand-alist)))))
;;; Éô¼ó¹çÀ®ÊÑ´¹¡¦¸ò¤¼½ñ¤ÊÑ´¹¤Ç³ÎÄꤷ¤¿Ê¸»ú¤ÎÂǤÁÊý¤òɽ¼¨¤¹¤ë¡£
;;; ɽ·Á¼°¤Î¸õÊ䥦¥£¥ó¥É¥¦¤Î¾ì¹ç¤Ï¡¢°Ê²¼¤Î¤è¤¦¤Ëɽ¼¨¤¹¤ë¡£
@@ -1811,8 +1855,7 @@
(else
(tutcode-commit pc res)
(if tutcode-use-completion?
- (tutcode-check-completion pc #f 0))))
- (tutcode-check-stroke-help-window-begin pc)))))))))
+ (tutcode-check-completion pc #f 0))))))))))))
;;; ľÀÜÆþÎϾõÂ֤ΤȤ¤Î¥¡¼ÆþÎϤò½èÍý¤¹¤ë¡£
;;; @param c ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
@@ -1996,9 +2039,7 @@
(tutcode-auto-help-redisplay pc)
(set! res #f))
((tutcode-bushu-start)
- (set! res #f))
- ((#f)
- (tutcode-check-stroke-help-window-begin pc)))))
+ (set! res #f)))))
(if res
(begin
(tutcode-append-string pc res)
@@ -2081,9 +2122,7 @@
(set! res #f))
((tutcode-bushu-start) ; ºÆµ¢Åª¤ÊÉô¼ó¹çÀ®ÊÑ´¹
(tutcode-append-string pc "¢¥")
- (set! res #f))
- ((#f)
- (tutcode-check-stroke-help-window-begin pc)))))
+ (set! res #f)))))
(if res
(let loop ((prevchar (car (tutcode-context-head pc)))
(char res))
@@ -2585,7 +2624,16 @@
(else
(tutcode-proc-state-off pc key key-state)
(if (tutcode-state-has-preedit? c) ; ºÆµ¢³Ø½¬»þ
- (tutcode-update-preedit pc)))))))
+ (tutcode-update-preedit pc))))
+ (if tutcode-use-stroke-help-window?
+ ;;
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))
+ (not (tutcode-context-latin-conv newpc)))
+ (tutcode-check-stroke-help-window-begin newpc)))))))
;;; ¥¡¼¤¬Î¥¤µ¤ì¤¿¤È¤¤Î½èÍý¤ò¹Ô¤¦¡£
;;; @param pc ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
