Revision: 6808
Author: deton.kih
Date: Tue Nov 9 03:46:36 2010
Log: * scm/tutcode.scm
- (tutcode-check-stroke-help-window-begin):
Change to show guide mark on stroke-help after auto-help.
- (tutcode-guide-add-kanji): New function.
- (tutcode-check-auto-help-window-begin):
Add clear of guide before calling tutcode-guide-add-kanji.
- (tutcode-auto-help-update-stroke-alist):
Add pc argument to call tutcode-guide-add-kanji.
- (tutcode-auto-help-update-stroke-alist-normal): Ditto.
- (tutcode-auto-help-update-stroke-alist-with-kanji):
Add call of tutcode-guide-add-kanji for auto-help kanji.
- (tutcode-auto-help-update-stroke-alist-normal-with-kanji): Ditto.
http://code.google.com/p/uim/source/detail?r=6808
Modified:
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode.scm Tue Nov 9 03:09:49 2010
+++ /trunk/scm/tutcode.scm Tue Nov 9 03:46:36 2010
@@ -633,6 +633,14 @@
(tutcode-guide-update-alist () cand-stroke)))
(tutcode-context-set-guide! pc label-cands-alist)))
+;;; ½Ï¸ì¥¬¥¤¥É¤Îɽ¼¨¤Ë»È¤¦alist¤Ë´Á»ú¤òÄɲ乤롣
+;;; @param kanji-stroke Äɲ乤ë´Á»ú¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¡£
+;;; Îã: ("ÀÐ" ("," "r"))
+(define (tutcode-guide-add-kanji pc kanji-stroke)
+ (let ((alist (tutcode-context-guide pc)))
+ (tutcode-context-set-guide! pc
+ (tutcode-guide-update-alist alist (list kanji-stroke)))))
+
;;; ½Ï¸ì¥¬¥¤¥É¤Îɽ¼¨¤Ë»È¤¦alist¤ò¹¹¿·¤¹¤ë¡£
;;; alist¤Ï°Ê²¼¤Î¤è¤¦¤Ë¥é¥Ù¥ëʸ»ú¤È¡¢´Á»ú¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¡£
;;; Îã: (("," ("ÀÐ" ("," "r"))) ("u" ("²°" ("u" "c")) ("ÃÓ" ("u" "v"))))
@@ -1154,8 +1162,8 @@
(set! label-cand-alist
(cons (list label candstr) label-cand-alist))))))
ret)
- (if (and tutcode-use-kanji-combination-guide?
- (pair? seq)
+ ;; ½Ï¸ì¥¬¥¤¥É¤ä¼«Æ°¥Ø¥ë¥×¤«¤é¤Î³¤¤Ç¡¢ÆþÎϸõÊäʸ»ú¤Ë¥Þ¡¼¥¯¤òÉÕ¤±¤ë
+ (if (and (pair? seq)
(pair? (tutcode-context-guide pc)))
(let*
((prevkey (car seq))
@@ -1258,28 +1266,30 @@
(if (and (eq? (tutcode-context-candidate-window pc)
'tutcode-candidate-window-off)
tutcode-use-auto-help-window?)
- (let*
- ((helpstrlist (lset-difference string=? (reverse strlist) yomilist))
- (label-cands-alist
- (if (not tutcode-auto-help-with-real-keys?)
- ;; ɽ·Á¼°¤Î¾ì¹ç¤ÎÎã:(("y" "2" "1") ("t" "3"))
- (tutcode-auto-help-update-stroke-alist
- () tutcode-auto-help-cand-str-list helpstrlist)
- ;; Ä̾ï¤Î¾ì¹ç¤ÎÎã:(("°Å" "t" "y" "y"))
- (reverse
- (tutcode-auto-help-update-stroke-alist-normal ()
helpstrlist)))))
- (if (not (null? label-cands-alist))
- (let
- ((stroke-help
- (map
- (lambda (elem)
- (list (tutcode-make-string (cdr elem)) (car elem) ""))
- label-cands-alist)))
- (tutcode-context-set-stroke-help! pc stroke-help)
- (tutcode-context-set-candidate-window! pc
- 'tutcode-candidate-window-auto-help)
- (im-activate-candidate-selector pc
- (length stroke-help)
tutcode-nr-candidate-max-for-kigou-mode))))))
+ (begin
+ (tutcode-context-set-guide! pc ())
+ (let*
+ ((helpstrlist (lset-difference string=? (reverse strlist)
yomilist))
+ (label-cands-alist
+ (if (not tutcode-auto-help-with-real-keys?)
+ ;; ɽ·Á¼°¤Î¾ì¹ç¤ÎÎã:(("y" "2" "1") ("t" "3"))
+ (tutcode-auto-help-update-stroke-alist
+ pc () tutcode-auto-help-cand-str-list helpstrlist)
+ ;; Ä̾ï¤Î¾ì¹ç¤ÎÎã:(("°Å" "t" "y" "y"))
+ (reverse
+ (tutcode-auto-help-update-stroke-alist-normal pc ()
helpstrlist)))))
+ (if (not (null? label-cands-alist))
+ (let
+ ((stroke-help
+ (map
+ (lambda (elem)
+ (list (tutcode-make-string (cdr elem)) (car elem) ""))
+ label-cands-alist)))
+ (tutcode-context-set-stroke-help! pc stroke-help)
+ (tutcode-context-set-candidate-window! pc
+ 'tutcode-candidate-window-auto-help)
+ (im-activate-candidate-selector pc
+ (length stroke-help)
tutcode-nr-candidate-max-for-kigou-mode)))))))
;;; ¼«Æ°¥Ø¥ë¥×¤Îɽ·Á¼°É½¼¨¤Ë»È¤¦alist¤ò¹¹¿·¤¹¤ë¡£
;;;
alist¤Ï°Ê²¼¤Î¤è¤¦¤ËÂǸ°¤ò¼¨¤¹¥é¥Ù¥ëʸ»ú¤È¡¢³ºÅö¥»¥ë¤Ëɽ¼¨¤¹¤ëʸ»úÎó¤Î¥ê¥¹¥È
@@ -1292,13 +1302,14 @@
;;; @param kanji-list ¥Ø¥ë¥×ɽ¼¨ÂоݤǤ¢¤ë¡¢³ÎÄꤵ¤ì¤¿´Á»ú
;;; @param cand-list ¥Ø¥ë¥×ɽ¼¨¤Ë»È¤¦¡¢³ÆÂǸ°¤ò¼¨¤¹Ê¸»ú¤Î¥ê¥¹¥È
;;; @return ¹¹¿·¸å¤Î¼«Æ°¥Ø¥ë¥×ÍÑalist
-(define (tutcode-auto-help-update-stroke-alist label-cands-alist
+(define (tutcode-auto-help-update-stroke-alist pc label-cands-alist
cand-list kanji-list)
(if (or (null? cand-list) (null? kanji-list))
label-cands-alist
(tutcode-auto-help-update-stroke-alist
+ pc
(tutcode-auto-help-update-stroke-alist-with-kanji
- label-cands-alist (car cand-list) (car kanji-list))
+ pc label-cands-alist (car cand-list) (car kanji-list))
(cdr cand-list) (cdr kanji-list))))
;;; ¼«Æ°¥Ø¥ë¥×¤ÎÄ̾ï·Á¼°É½¼¨¤Ë»È¤¦alist¤ò¹¹¿·¤¹¤ë¡£
@@ -1307,13 +1318,14 @@
;;; @param label-cands-alist ¸µ¤Îalist
;;; @param kanji-list ¥Ø¥ë¥×ɽ¼¨ÂоݤǤ¢¤ë¡¢³ÎÄꤵ¤ì¤¿´Á»ú
;;; @return ¹¹¿·¸å¤Î¼«Æ°¥Ø¥ë¥×ÍÑalist
-(define (tutcode-auto-help-update-stroke-alist-normal label-cands-alist
+(define (tutcode-auto-help-update-stroke-alist-normal pc label-cands-alist
kanji-list)
(if (null? kanji-list)
label-cands-alist
(tutcode-auto-help-update-stroke-alist-normal
+ pc
(tutcode-auto-help-update-stroke-alist-normal-with-kanji
- label-cands-alist (car kanji-list))
+ pc label-cands-alist (car kanji-list))
(cdr kanji-list))))
;;; ¼«Æ°¥Ø¥ë¥×:ÂоݤÎ1ʸ»ú¤òÆþÎϤ¹¤ë¥¹¥È¥í¡¼¥¯¤ò¥Ø¥ë¥×ÍÑalist¤ËÄɲ乤롣
@@ -1321,54 +1333,74 @@
;;; @param cand-list ¥Ø¥ë¥×ɽ¼¨¤Ë»È¤¦¡¢³ÆÂǸ°¤ò¼¨¤¹Ê¸»ú¤Î¥ê¥¹¥È
;;; @param kanji ¥Ø¥ë¥×ɽ¼¨ÂоÝʸ»ú
;;; @return ¹¹¿·¸å¤Î¼«Æ°¥Ø¥ë¥×ÍÑalist
-(define (tutcode-auto-help-update-stroke-alist-with-kanji label-cands-alist
+(define (tutcode-auto-help-update-stroke-alist-with-kanji pc
label-cands-alist
cand-list kanji)
(let ((stroke (tutcode-reverse-find-seq kanji)))
(if stroke
- (tutcode-auto-help-update-stroke-alist-with-stroke
- label-cands-alist
- (cons (string-append (caar cand-list) "(" kanji ")") (cdar
cand-list))
- stroke)
+ (begin
+ (if tutcode-use-stroke-help-window?
+ (tutcode-guide-add-kanji pc (list kanji stroke)))
+ (tutcode-auto-help-update-stroke-alist-with-stroke
+ label-cands-alist
+ (cons (string-append (caar cand-list) "(" kanji ")") (cdar
cand-list))
+ stroke))
(let ((decomposed (tutcode-auto-help-bushu-decompose kanji)))
;; Îã: "·Ò" => (((("," "o"))("·â")) ((("f" "q"))("»å")))
(if (not decomposed)
label-cands-alist
- (tutcode-auto-help-update-stroke-alist-with-stroke
+ (begin
+ (if tutcode-use-stroke-help-window?
+ (begin
+ (tutcode-guide-add-kanji pc
+ (list (caar (cdar decomposed)) (caaar decomposed)))
+ (tutcode-guide-add-kanji pc
+ (list (caar (cdadr decomposed)) (caaadr decomposed)))))
(tutcode-auto-help-update-stroke-alist-with-stroke
- label-cands-alist
- (cons
- (string-append (caar cand-list) "(" kanji "¢¥"
- (caar (cdar decomposed)) (caar (cdadr decomposed)) ")")
- (cdar cand-list))
- (caaar decomposed)) ; Éô¼ó1
- (cadr cand-list) (caaadr decomposed))))))) ; Éô¼ó2
+ (tutcode-auto-help-update-stroke-alist-with-stroke
+ label-cands-alist
+ (cons
+ (string-append (caar cand-list) "(" kanji "¢¥"
+ (caar (cdar decomposed)) (caar (cdadr decomposed)) ")")
+ (cdar cand-list))
+ (caaar decomposed)) ; Éô¼ó1
+ (cadr cand-list) (caaadr decomposed)))))))) ; Éô¼ó2
;;; ¼«Æ°¥Ø¥ë¥×:ÂоݤÎ1ʸ»ú¤òÆþÎϤ¹¤ë¥¹¥È¥í¡¼¥¯¤ò¥Ø¥ë¥×ÍÑalist¤ËÄɲ乤롣
;;; @param label-cands-alist ¸µ¤Îalist
;;; @param kanji ¥Ø¥ë¥×ɽ¼¨ÂоÝʸ»ú
;;; @return ¹¹¿·¸å¤Î¼«Æ°¥Ø¥ë¥×ÍÑalist
(define (tutcode-auto-help-update-stroke-alist-normal-with-kanji
- label-cands-alist kanji)
+ pc label-cands-alist kanji)
(let ((stroke (tutcode-reverse-find-seq kanji)))
(if stroke
- (tutcode-auto-help-update-stroke-alist-normal-with-stroke
- label-cands-alist
- (cons (string-append kanji " ") stroke)
- kanji)
+ (begin
+ (if tutcode-use-stroke-help-window?
+ (tutcode-guide-add-kanji pc (list kanji stroke)))
+ (tutcode-auto-help-update-stroke-alist-normal-with-stroke
+ label-cands-alist
+ (cons (string-append kanji " ") stroke)
+ kanji))
(let ((decomposed (tutcode-auto-help-bushu-decompose kanji)))
;; Îã: "·Ò" => (((("," "o"))("·â")) ((("f" "q"))("»å")))
(if (not decomposed)
label-cands-alist
- (tutcode-auto-help-update-stroke-alist-normal-with-stroke
- label-cands-alist
- (cons
- (string-append kanji "¢¥"
- (caar (cdar decomposed)) (caar (cdadr decomposed)) " ")
- (append
- (caaar decomposed) ; Éô¼ó1
- (list " ")
- (caaadr decomposed))) ; Éô¼ó2
- kanji))))))
+ (begin
+ (if tutcode-use-stroke-help-window?
+ (begin
+ (tutcode-guide-add-kanji pc
+ (list (caar (cdar decomposed)) (caaar decomposed)))
+ (tutcode-guide-add-kanji pc
+ (list (caar (cdadr decomposed)) (caaadr decomposed)))))
+ (tutcode-auto-help-update-stroke-alist-normal-with-stroke
+ label-cands-alist
+ (cons
+ (string-append kanji "¢¥"
+ (caar (cdar decomposed)) (caar (cdadr decomposed)) " ")
+ (append
+ (caaar decomposed) ; Éô¼ó1
+ (list " ")
+ (caaadr decomposed))) ; Éô¼ó2
+ kanji)))))))
;;; ¼«Æ°¥Ø¥ë¥×:ÂоݤΥ¹¥È¥í¡¼¥¯(¥¡¼¤Î¥ê¥¹¥È)¤ò¥Ø¥ë¥×ÍÑalist¤ËÄɲ乤롣
;;; @param label-cands-alist ¸µ¤Îalist
