Revision: 6487
Author: deton.kih
Date: Sun Jul 4 02:58:30 2010
Log: * scm/tutcode.scm
- (tutcode-check-auto-help-window-begin,
tutcode-auto-help-update-stroke-alist): Rewrite using recursive call
- (tutcode-auto-help-update-stroke-alist-with-kanji,
tutcode-auto-help-update-stroke-alist-with-stroke,
tutcode-auto-help-update-stroke-alist-with-key): New function
http://code.google.com/p/uim/source/detail?r=6487
Modified:
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode.scm Sun Jul 4 02:52:35 2010
+++ /trunk/scm/tutcode.scm Sun Jul 4 02:58:30 2010
@@ -616,17 +616,12 @@
(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))
- (for-each
- (lambda (kanji)
- (if (pair? cand-str-list)
- (begin
- (set! label-cands-alist
- (tutcode-auto-help-update-stroke-alist label-cands-alist
kanji
- (car cand-str-list)))
- (set! cand-str-list (cdr cand-str-list)))))
- (lset-difference string=? (reverse strlist) yomilist))
+ (let
+ ;; Îã:(("y" "2" "1") ("t" "3"))
+ ((label-cands-alist
+ (tutcode-auto-help-update-stroke-alist
+ () tutcode-auto-help-cand-str-list
+ (lset-difference string=? (reverse strlist) yomilist))))
(if (not (null? label-cands-alist))
(let
((stroke-help
@@ -640,45 +635,87 @@
(im-activate-candidate-selector pc
(length stroke-help)
tutcode-nr-candidate-max-for-kigou-mode))))))
-;;; ¼«Æ°¥Ø¥ë¥×ÍÑalist¤ò¹¹¿·¤¹¤ë
-;;; @param str ¥Ø¥ë¥×ɽ¼¨ÂоݤǤ¢¤ë¡¢³ÎÄꤵ¤ì¤¿´Á»ú
+;;; ¼«Æ°¥Ø¥ë¥×¤Îɽ·Á¼°É½¼¨¤Ë»È¤¦alist¤ò¹¹¿·¤¹¤ë¡£
+;;;
alist¤Ï°Ê²¼¤Î¤è¤¦¤ËÂǸ°¤ò¼¨¤¹¥é¥Ù¥ëʸ»ú¤È¡¢³ºÅö¥»¥ë¤Ëɽ¼¨¤¹¤ëʸ»úÎó¤Î¥ê¥¹¥È
+;;; Îã:(("y" "2" "1") ("t" "3")) ; ("y" "y" "t")¤È¤¤¤¦¥¹¥È¥í¡¼¥¯¤ò¸½¤¹¡£
+;;; ¡¦¡¦¡¦¡¦ ¡¦¡¦¡¦¡¦
+;;; ¡¦¡¦¡¦¡¦3 12¡¦¡¦¡¦¡¦
+;;; ¡¦¡¦¡¦¡¦ ¡¦¡¦¡¦¡¦
+;;; ¡¦¡¦¡¦¡¦ ¡¦¡¦¡¦¡¦
+;;; @param label-cands-alist ¸µ¤Îalist
+;;; @param kanji-list ¥Ø¥ë¥×ɽ¼¨ÂоݤǤ¢¤ë¡¢³ÎÄꤵ¤ì¤¿´Á»ú
;;; @param cand-list ¥Ø¥ë¥×ɽ¼¨¤Ë»È¤¦¡¢³ÆÂǸ°¤ò¼¨¤¹Ê¸»ú¤Î¥ê¥¹¥È
-;;; @return ¹¹¿·»þ¤Î¼«Æ°¥Ø¥ë¥×ÍÑalist
-(define (tutcode-auto-help-update-stroke-alist label-cands-alist str
cand-list)
- (let ((stroke (tutcode-reverse-find-seq tutcode-rule str))
- (update-alist
- (lambda (cand-list 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)
- cand-list)))
+;;; @return ¹¹¿·¸å¤Î¼«Æ°¥Ø¥ë¥×ÍÑalist
+(define (tutcode-auto-help-update-stroke-alist label-cands-alist
+ cand-list kanji-list)
+ (if (or (null? cand-list) (null? kanji-list))
+ label-cands-alist
+ (tutcode-auto-help-update-stroke-alist
+ (tutcode-auto-help-update-stroke-alist-with-kanji
+ label-cands-alist (car cand-list) (car kanji-list))
+ (cdr cand-list) (cdr kanji-list))))
+
+;;; ¼«Æ°¥Ø¥ë¥×:ÂоݤÎ1ʸ»ú¤òÆþÎϤ¹¤ë¥¹¥È¥í¡¼¥¯¤ò¥Ø¥ë¥×ÍÑalist¤ËÄɲ乤롣
+;;; @param label-cands-alist ¸µ¤Îalist
+;;; @param cand-list ¥Ø¥ë¥×ɽ¼¨¤Ë»È¤¦¡¢³ÆÂǸ°¤ò¼¨¤¹Ê¸»ú¤Î¥ê¥¹¥È
+;;; @param kanji ¥Ø¥ë¥×ɽ¼¨ÂоÝʸ»ú
+;;; @return ¹¹¿·¸å¤Î¼«Æ°¥Ø¥ë¥×ÍÑalist
+(define (tutcode-auto-help-update-stroke-alist-with-kanji label-cands-alist
+ cand-list kanji)
+ (let ((stroke (tutcode-reverse-find-seq tutcode-rule kanji)))
(if stroke
- (update-alist (car cand-list) stroke)
+ (tutcode-auto-help-update-stroke-alist-with-stroke
+ label-cands-alist (car cand-list) stroke)
(let ((decomposed
(or
- (tutcode-auto-help-bushu-decompose str)
+ (tutcode-auto-help-bushu-decompose kanji)
;; ñ½ã¤Ê°ú¤»»¤Ë¤è¤ë¹çÀ®¤Þ¤ÇÂбþ¡£
- ;; XXX:3ʸ»ú°Ê¾å¤Ç¤Î¹çÀ®¤ä¡¢ÉôÉʤˤè¤ë¹çÀ®¤Ï̤Âбþ
+ ;; XXX:ÉôÉʤˤè¤ë¹çÀ®¤ä¡¢3ʸ»ú°Ê¾å¤Ç¤Î¹çÀ®¤Ï̤Âбþ
(tutcode-auto-help-bushu-decompose-by-subtraction
- str tutcode-bushudic))))
+ kanji tutcode-bushudic))))
;; Îã: "·Ò" => (((("," "o"))("·â")) ((("f" "q"))("»å")))
- (if decomposed
- (begin
- (update-alist
+ (if (not decomposed)
+ label-cands-alist
+ (tutcode-auto-help-update-stroke-alist-with-stroke
+ (tutcode-auto-help-update-stroke-alist-with-stroke
+ label-cands-alist
(cons
(string-append (caar cand-list) "(¢¥"
(caar (cdar decomposed)) (caar (cdadr decomposed)) ")")
(cdar cand-list))
(caaar decomposed)) ; Éô¼ó1
- (update-alist (cadr cand-list) (caaadr decomposed)))))) ; Éô¼ó2
- label-cands-alist))
+ (cadr cand-list) (caaadr decomposed))))))) ; Éô¼ó2
+
+;;; ¼«Æ°¥Ø¥ë¥×:ÂоݤΥ¹¥È¥í¡¼¥¯(¥¡¼¤Î¥ê¥¹¥È)¤ò¥Ø¥ë¥×ÍÑalist¤ËÄɲ乤롣
+;;; @param label-cands-alist ¸µ¤Îalist
+;;; @param cand-list ¥Ø¥ë¥×ɽ¼¨¤Ë»È¤¦¡¢³ÆÂǸ°¤ò¼¨¤¹Ê¸»ú¤Î¥ê¥¹¥È
+;;; @param stroke Âоݥ¹¥È¥í¡¼¥¯
+;;; @return ¹¹¿·¸å¤Î¼«Æ°¥Ø¥ë¥×ÍÑalist
+(define (tutcode-auto-help-update-stroke-alist-with-stroke
label-cands-alist
+ cand-list stroke)
+ (if (null? stroke)
+ label-cands-alist
+ (tutcode-auto-help-update-stroke-alist-with-stroke
+ (tutcode-auto-help-update-stroke-alist-with-key
+ label-cands-alist cand-list (car stroke))
+ (cdr cand-list) (cdr stroke))))
+
+;;; ¼«Æ°¥Ø¥ë¥×:ÂоݤΥ¡¼¤ò¥Ø¥ë¥×ÍÑalist¤ËÄɲ乤롣
+;;; @param label-cands-alist ¸µ¤Îalist
+;;; @param cand-list ¥Ø¥ë¥×ɽ¼¨¤Ë»È¤¦¡¢³ÆÂǸ°¤ò¼¨¤¹Ê¸»ú¤Î¥ê¥¹¥È
+;;; @param key Âоݥ¡¼
+;;; @return ¹¹¿·¸å¤Î¼«Æ°¥Ø¥ë¥×ÍÑalist
+(define (tutcode-auto-help-update-stroke-alist-with-key label-cands-alist
+ cand-list key)
+ (let*
+ ((label key)
+ (label-cand (assoc label label-cands-alist))
+ (cand (if (pair? cand-list) (car cand-list) "")))
+ (if label-cand
+ (begin
+ (set-cdr! label-cand (cons cand (cdr label-cand)))
+ label-cands-alist)
+ (cons (list label cand) label-cands-alist))))
;;; preeditɽ¼¨¤ò¹¹¿·¤¹¤ë¡£
;;; @param pc ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
