Revision: 7136
Author: deton.kih
Date: Sat Jun 11 21:08:57 2011
Log: * Show stroke help temporarily by keys in kanji combination guide.
* scm/tutcode-custom.scm
- (tutcode-stroke-help-with-kanji-combination-guide): New custom.
* scm/tutcode.scm
- Update comment.
- (tutcode-push-key!): Reset guide-chars on end of stroke.
- (tutcode-flush): Reset guide-chars.
- (tutcode-check-stroke-help-window-begin):
Change stroke help according to
tutcode-stroke-help-with-kanji-combination-guide.
- (tutcode-stroke-help-guide-add-kanji): Fix comment.
- (tutcode-key-press-handler):
Add check of tutcode-stroke-help-with-kanji-combination-guide.
http://code.google.com/p/uim/source/detail?r=7136
Modified:
/trunk/scm/tutcode-custom.scm
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode-custom.scm Wed Apr 6 04:54:23 2011
+++ /trunk/scm/tutcode-custom.scm Sat Jun 11 21:08:57 2011
@@ -282,6 +282,15 @@
(N_ "Enable Kanji combination guide")
(N_ "long description will be here."))
+(define-custom 'tutcode-stroke-help-with-kanji-combination-guide 'disable
+ '(tutcode tutcode-prediction)
+ (list 'choice
+ (list 'full (N_ "Full stroke help") (N_ "Full stroke help"))
+ (list 'guide-only (N_ "Guide only") (N_ "Guide only"))
+ (list 'disable (N_ "Disable") (N_ "Disable")))
+ (N_ "Show stroke help temporarily by keys in kanji combination guide")
+ (N_ "long description will be here."))
+
(define-custom 'tutcode-use-bushu-prediction? #f
'(tutcode tutcode-prediction)
'(boolean)
=======================================
--- /trunk/scm/tutcode.scm Thu May 26 02:58:15 2011
+++ /trunk/scm/tutcode.scm Sat Jun 11 21:08:57 2011
@@ -185,10 +185,17 @@
;;; <Control>.ÂǸ°»þ¤Ë¤Î¤ßÊä´°/ͽ¬ÆþÎϸõÊä¤òɽ¼¨¤·¤Þ¤¹¡£
;;; * ½Ï¸ì¥¬¥¤¥É(¼¡¤ËÆþÎϤ¬Í½Â¬¤µ¤ì¤ëʸ»ú¤ÎÂǸ°¥¬¥¤¥É)¤Ï
;;; Êä´°/ͽ¬ÆþÎϸõÊ䤫¤éºî¤Ã¤Æ¤¤¤Þ¤¹¡£
-;;; * ½Ï¸ì¥¬¥¤¥É¤Çɽ¼¨¤µ¤ì¤Æ¤¤¤ë+Éդʸ»ú¤ËÂбþ¤¹¤ë¥¡¼¤òÆþÎϤ·¤¿¾ì¹ç¡¢
+;;; * ²¾ÁÛ¸°È×¾å¤Ç¤Î½Ï¸ì¥¬¥¤¥Éɽ¼¨
+;;; ½Ï¸ì¥¬¥¤¥É¤Çɽ¼¨¤µ¤ì¤Æ¤¤¤ë+Éդʸ»ú¤ËÂбþ¤¹¤ë¥¡¼¤òÆþÎϤ·¤¿¾ì¹ç¡¢
;;; 2ÂǸ°ÌܰʹߤⲾÁÛ¸°È×¾å¤Ë+ÉÕ¤¤Çɽ¼¨¤¹¤ë¤Î¤Ç¡¢
;;; ¥¬¥¤¥É¤Ë½¾¤Ã¤Æ´Á»ú¤ÎÆþÎϤ¬²Äǽ¤Ç¤¹¡£
-;;;
(Ä̾ï¤Ï²¾ÁÛ¸°È×Èóɽ¼¨¤Î¾ì¹ç¤Ç¤â¡¢°ì»þŪ¤Ë<Control>/¤Çɽ¼¨¤¹¤ì¤Ð³Îǧ²Äǽ)
+;;;
Ä̾ï¤Ï²¾ÁÛ¸°È×Èóɽ¼¨¤Î¾ì¹ç¤Ç¤â¡¢+Éդʸ»ú¤ËÂбþ¤¹¤ë¥¡¼¤òÆþÎϤ·¤¿¾ì¹ç¡¢
+;;; °ì»þŪ¤Ë²¾ÁÛ¸°Èפòɽ¼¨¤¹¤ë¤Ë¤Ï¡¢
+;;; tutcode-stroke-help-with-kanji-combination-guide¤ò'full(+ÉÕ¤°Ê³°¤Î
+;;; ʸ»ú¤âɽ¼¨)¤«'guide-only(+ÉÕ¤¤Îʸ»ú¤Î¤ßɽ¼¨)¤ËÀßÄꤷ¤Æ¤¯¤À¤µ¤¤¡£
+;;; Îã:¡Ö²Ð³¸¡×¤òÆþÎϤ·¤è¤¦¤È¤·¤Æ¡Ö²Ð¡×¤ÎÆþÎϸå¡Ö³¸¡×¤ÎÂǤÁÊý¤ò
+;;;
¤É˺¤ì¤·¤¿¾ì¹ç¡¢<Control>.¥¡¼¤ÇÊä´°¡£½Ï¸ì¥¬¥¤¥É¤Ç+ÉÕ¤¤Î¡Ö³¸¡×¤Î
+;;; ɽ¼¨¤Ë½¾¤Ã¤Æ1,2,3ÂǸ°¤òÆþÎÏ¡£
;;;
;;; -
(ÍýÁÛŪ¤Ë¤Ï¡¢¼¡¤ÎÂǸ°¤¬¤·¤Ð¤é¤¯Ìµ¤¤¾ì¹ç¤ËÊä´°/ͽ¬ÆþÎϸõÊä¤òɽ¼¨¤·¤¿¤¤¤Î
;;; ¤Ç¤¹¤¬¡¢¸½¾õ¤Îuim¤Ë¤Ï¥¿¥¤¥Þ¤¬Ìµ¤¤¤Î¤Ç¡¢ÂǸ°Ä¾¸å¤Ëɽ¼¨¤µ¤ì¤Þ¤¹¡£
@@ -1102,12 +1109,14 @@
(define (tutcode-push-key! pc key)
(let ((res (rk-push-key! (tutcode-context-rk-context pc) key)))
(and res
- (if
- (and
- (not (null? (cdr res)))
- (tutcode-context-katakana-mode? pc))
- (cadr res)
- (car res)))))
+ (begin
+ (tutcode-context-set-guide-chars! pc ())
+ (if
+ (and
+ (not (null? (cdr res)))
+ (tutcode-context-katakana-mode? pc))
+ (cadr res)
+ (car res))))))
;;; ÊÑ´¹Ãæ¾õÂÖ¤ò¥¯¥ê¥¢¤¹¤ë¡£
;;; @param pc ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
@@ -1127,6 +1136,7 @@
(tutcode-context-set-mazegaki-suffix! pc ())
(tutcode-reset-candidate-window pc)
(tutcode-context-set-latin-conv! pc #f)
+ (tutcode-context-set-guide-chars! pc ())
(tutcode-context-set-child-context! pc ())
(tutcode-context-set-child-type! pc ())
(if (not (null? cpc))
@@ -1702,53 +1712,65 @@
;;; ²¾ÁÛ¸°ÈפÎɽ¼¨¤ò³«»Ï¤¹¤ë
(define (tutcode-check-stroke-help-window-begin pc)
(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))
- (rule (rk-context-rule rkc))
- (ret (rk-lib-find-partial-seqs (reverse seq) rule))
- (katakana? (tutcode-context-katakana-mode? pc))
- ;; Îã:(("k" "¤¢") ("i" "¤¤") ("g" "*£"))
- (label-cand-alist
- (if (null? seq) ;
tutcode-ruleÁ´Éô¤Ê¤á¤ÆºîÀ®¢ªÃÙ¤¤¤Î¤Ç¥¥ã¥Ã¥·¥å
- (cond
- ((tutcode-kigou2-mode? pc)
- tutcode-kigou-rule-stroke-help-top-page-alist)
- (katakana?
- (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)
- (else
- (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-chars pc)))
- (let*
- ((guide-rule (tutcode-context-guide-chars pc))
- (ret (rk-lib-find-partial-seqs (reverse seq) guide-rule))
- (guide-alist (tutcode-stroke-help-guide-update-alist () seqlen
ret))
- ;; Îã:(("," "ÀÐ") ("u" "+ÃÓ²°"))
- (guide-candcombined
- (map
+ (let*
+ ((rkc (tutcode-context-rk-context pc))
+ (seq (rk-context-seq rkc))
+ (seqlen (length seq))
+ (seq-rev (reverse seq))
+ (guide-seqs
+ (and
+ (pair? seq)
+ (pair? (tutcode-context-guide-chars pc))
+ (rk-lib-find-partial-seqs seq-rev (tutcode-context-guide-chars
pc))))
+ (guide-alist (tutcode-stroke-help-guide-update-alist () seqlen
+ (if (pair? guide-seqs) guide-seqs ())))
+ ;; Îã:(("v" "¶Ì+") ("a" "ÁÒ+") ("r" "ÀÐ+"))
+ (guide-candcombined
+ (map
+ (lambda (elem)
+ (list (car elem) (string-list-concat (cdr elem))))
+ guide-alist))
+ ;; stroke-help. Îã:(("k" "¤¢") ("i" "¤¤") ("g" "*£"))
+ (label-cand-alist
+ (if (or tutcode-use-stroke-help-window?
+ (and
+ (pair? guide-seqs)
+ (eq?
tutcode-stroke-help-with-kanji-combination-guide 'full)))
+ (let*
+ ((rule (rk-context-rule rkc))
+ (ret (rk-lib-find-partial-seqs seq-rev rule))
+ (katakana? (tutcode-context-katakana-mode? pc))
+ (label-cand-alist
+ (if (null? seq) ;
tutcode-ruleÁ´Éô¤Ê¤á¤ÆºîÀ®¢ªÃÙ¤¤¤Î¤Ç¥¥ã¥Ã¥·¥å
+ (cond
+ ((tutcode-kigou2-mode? pc)
+ tutcode-kigou-rule-stroke-help-top-page-alist)
+ (katakana?
+ (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)
+ (else
+ (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))))
+ ;; ɽ¼¨¤¹¤ë¸õÊäʸ»úÎó¤ò¡¢½Ï¸ì¥¬¥¤¥É(+)Éդʸ»úÎó¤ËÃÖ¤´¹¤¨¤ë
+ (for-each
(lambda (elem)
- (list (car elem) (string-list-concat (cdr elem))))
- guide-alist)))
- ;; ɽ¼¨¤¹¤ë¸õÊäʸ»úÎó¤ò¡¢½Ï¸ì¥¬¥¤¥É(+)Éդʸ»úÎó¤ËÃÖ¤´¹¤¨¤ë
- (for-each
- (lambda (elem)
- (let*
- ((label (car elem))
- (label-cand (assoc label label-cand-alist)))
- (if label-cand
- (set-cdr! label-cand (cdr elem)))))
- guide-candcombined)))
+ (let*
+ ((label (car elem))
+ (label-cand (assoc label label-cand-alist)))
+ (if label-cand
+ (set-cdr! label-cand (cdr elem)))))
+ guide-candcombined)
+ label-cand-alist)
+ (if (eq?
tutcode-stroke-help-with-kanji-combination-guide 'guide-only)
+ guide-candcombined
+ ()))))
(if (not (null? label-cand-alist))
(let
((stroke-help
@@ -1859,8 +1881,8 @@
(tutcode-context-set-guide-chars! pc (cons kanji-stroke chars)))))
;;; ²¾ÁÛ¸°È×¾å¤Î½Ï¸ì¥¬¥¤¥É¤Îɽ¼¨¤Ë»È¤¦alist¤ò¹¹¿·¤¹¤ë¡£
-;;; alist¤Ï°Ê²¼¤Î¤è¤¦¤Ë¥é¥Ù¥ëʸ»ú¤Èɽ¼¨ÍÑʸ»úÎó¤Î¥ê¥¹¥È¡£
-;;; Îã: (("," "ÀÐ") ("u" "+ÃÓ²°"))
+;;; alist¤Ï°Ê²¼¤Î¤è¤¦¤Ë¥é¥Ù¥ëʸ»ú¤Èɽ¼¨ÍÑʸ»úÎó¤Î¥ê¥¹¥È(µÕ½ç)¡£
+;;; Îã: (("v" "+" "¶Ì") ("a" "+" "ÁÒ") ("r" "+" "ÀÐ"))
;;; @param label-cands-alist ¸µ¤Îalist
;;; @param seqlen ²¿ÈÖÌܤΥ¹¥È¥í¡¼¥¯¤òÂоݤȤ¹¤ë¤«¡£
;;; @param rule-list rk-rule¡£
@@ -4129,7 +4151,9 @@
(tutcode-proc-state-off pc key key-state)
(if (tutcode-state-has-preedit? c) ; ºÆµ¢³Ø½¬»þ
(tutcode-update-preedit pc))))
- (if tutcode-use-stroke-help-window?
+ (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
