Revision: 7208
Author: deton.kih
Date: Mon Jul 11 04:09:30 2011
Log: * Merge r7207 from trunk.
http://code.google.com/p/uim/source/detail?r=7208
Modified:
/branches/1.7/scm/tutcode.scm
=======================================
--- /branches/1.7/scm/tutcode.scm Fri Jul 8 16:50:46 2011
+++ /branches/1.7/scm/tutcode.scm Mon Jul 11 04:09:30 2011
@@ -470,12 +470,15 @@
;;; ¼«Æ°¥Ø¥ë¥×¤Ç¤Îʸ»ú¤ÎÂǤÁÊýɽ¼¨¤ÎºÝ¤Ë¸õÊäʸ»úÎó¤È¤·¤Æ»È¤¦Ê¸»ú¤Î¥ê¥¹¥È
(define tutcode-auto-help-cand-str-list
;; Âè1,2,3ÂǸ°¤ò¼¨¤¹Ê¸»ú(Éô¼ó1ÍÑ, Éô¼ó2ÍÑ)
- '((("1" "2" "3") ("4" "5" "6")) ; 1ʸ»úÌÜÍÑ
- (("a" "b" "c") ("d" "e" "f")) ; 2ʸ»úÌÜÍÑ
- (("A" "B" "C") ("D" "E" "F"))
- (("°ì" "Æó" "»°") ("»Í" "¸Þ" "Ï»"))
- (("¤¢" "¤¤" "¤¦") ("¤«" "¤" "¤¯"))
- (("¥¢" "¥¤" "¥¦") ("¥«" "¥" "¥¯"))))
+ '((("1" "2" "3") ("4" "5" "6") ("7" "8" "9")) ; 1ʸ»úÌÜÍÑ
+ (("a" "b" "c") ("d" "e" "f") ("g" "h" "i")) ; 2ʸ»úÌÜÍÑ
+ (("A" "B" "C") ("D" "E" "F") ("G" "H" "I"))
+ (("°ì" "Æó" "»°") ("»Í" "¸Þ" "Ï»") ("¼·" "Ȭ" "¶å"))
+ (("¤¢" "¤¤" "¤¦") ("¤«" "¤" "¤¯") ("¤µ" "¤·" "¤¹"))
+ (("¥¢" "¥¤" "¥¦") ("¥«" "¥" "¥¯") ("¥µ" "¥·" "¥¹"))))
+
+;;; ¼«Æ°¥Ø¥ë¥×ºîÀ®»þ´Ö¾å¸Â[s]
+(define tutcode-auto-help-time-limit 3)
;;; ½Ï¸ì¥¬¥¤¥ÉÍÑ¥Þ¡¼¥¯
(define tutcode-guide-mark "+")
@@ -1943,7 +1946,8 @@
;;; ¨¢ ¨¢ ¨¢d ¨¢ ¨¢e ¨¢ ¨¢2a(ݵ¢¥ÎÓ´Ì)¨¢ ¨¢ ¨¢ ¨¢ ¨¢
;;; ¨¦¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨¡¨¡¨¡¨¡¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨¡¨¡¨ª¨¡¨¥
;;;
-;;; Ä̾ï¤Î¸õÊ䥦¥£¥ó¥É¥¦¤Î¾ì¹ç¤Ï¡¢°Ê²¼¤Î¤è¤¦¤Ëɽ¼¨¤¹¤ë¡£
+;;; tutcode-auto-help-with-real-keys?¤¬#t¤Î¾ì¹ç(Ä̾ï¤Î¸õÊ䥦¥£¥ó¥É¥¦ÍÑ)¤Ï¡¢
+;;; °Ê²¼¤Î¤è¤¦¤Ëɽ¼¨¤¹¤ë¡£
;;; Í« lns
;;; ݵ ¢¥ÎÓ´Ì nt cbo
;;;
@@ -2023,7 +2027,8 @@
(define (tutcode-auto-help-update-stroke-alist-with-kanji pc
label-cands-alist
cand-list kanji)
(let*
- ((rule (rk-context-rule (tutcode-context-rk-context pc)))
+ ((stime (time))
+ (rule (rk-context-rule (tutcode-context-rk-context pc)))
(stroke (tutcode-reverse-find-seq kanji rule)))
(if stroke
(begin
@@ -2033,22 +2038,90 @@
label-cands-alist
(cons (string-append (caar cand-list) "(" kanji ")") (cdar
cand-list))
stroke))
- (let ((decomposed (tutcode-auto-help-bushu-decompose kanji rule)))
+ (let ((decomposed (tutcode-auto-help-bushu-decompose kanji rule
stime)))
;; Îã: "·Ò" => (((("," "o"))("·â")) ((("f" "q"))("»å")))
(if (not decomposed)
label-cands-alist
- (begin
- (tutcode-stroke-help-guide-add-kanji pc (car decomposed))
- (tutcode-stroke-help-guide-add-kanji pc (cadr decomposed))
- (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) "(" kanji "¢¥"
- (caar (cdar decomposed)) (caar (cdadr decomposed)) ")")
- (cdar cand-list))
- (caaar decomposed)) ; Éô¼ó1
- (cadr cand-list) (caaadr decomposed)))))))) ; Éô¼ó2
+ (let*
+ ((bushu-strs (tutcode-auto-help-bushu-combination-strs
decomposed))
+ (helpstrlist (append (list "(" kanji "¢¥") bushu-strs '(")")))
+ (helpstr (apply string-append helpstrlist))
+ (alist
+ (letrec
+ ((update-stroke
+ (lambda (lst alist cand-list)
+ (if (or (null? lst) (null? cand-list))
+ (list alist cand-list)
+ (let
+ ((res
+ (if (tutcode-rule-element? (car lst))
+ (list
+
(tutcode-auto-help-update-stroke-alist-with-stroke
+ alist (car cand-list) (caar (car lst)))
+ (cdr cand-list))
+ (update-stroke (car lst) alist cand-list))))
+ (update-stroke (cdr lst) (car res) (cadr res)))))))
+ (update-stroke decomposed label-cands-alist
+ (cons
+ (cons
+ (string-append (caar cand-list) helpstr)
+ (cdar cand-list))
+ (cdr cand-list))))))
+ (tutcode-auto-help-bushu-combination-add-guide pc decomposed)
+ (car alist)))))))
+
+;;; tutcode-rule¤ÎÍ×ÁǤηÁ¼°((("," "o"))("·â"))¤«¤É¤¦¤«¤òÊÖ¤¹
+(define (tutcode-rule-element? x)
+ (and
+ (pair? x)
+ (pair? (car x))
+ (pair? (caar x))
+ (pair? (cdr x))
+ (pair? (cadr x))
+ (every string? (caar x))
+ (every string? (cadr x))))
+
+;;; ¼«Æ°¥Ø¥ë¥×:tutcode-auto-help-bushu-decompose¤Ç¸¡º÷¤·¤¿¡¢
+;;; Éô¼ó¹çÀ®ÊýË¡¤Ç»È¤¦Éô¼ó¤ò¡¢¥¬¥¤¥ÉÂоÝʸ»ú¤ËÄɲ乤롣
+;;; @param decomposed tutcode-auto-help-bushu-decompose·ë²Ì
+(define (tutcode-auto-help-bushu-combination-add-guide pc decomposed)
+ (if (not (null? decomposed))
+ (begin
+ (if (tutcode-rule-element? (car decomposed))
+ (tutcode-stroke-help-guide-add-kanji pc (car decomposed))
+ (tutcode-auto-help-bushu-combination-add-guide pc (car
decomposed)))
+ (tutcode-auto-help-bushu-combination-add-guide pc (cdr
decomposed)))))
+
+;;; ¼«Æ°¥Ø¥ë¥×:tutcode-auto-help-bushu-decompose¤Ç¸¡º÷¤·¤¿¡¢
+;;; ¥¹¥È¥í¡¼¥¯¤ò´Þ¤àÉô¼ó¹çÀ®ÊýË¡¤«¤é¡¢
+;;; Éô¼óʸ»úÎó¤Î¤ß¤òÈ´¤½Ð¤·¤¿Éô¼ó¹çÀ®ÊýË¡¤òºî¤ë
+;;; @param decomposed tutcode-auto-help-bushu-decompose·ë²Ì
+;;; @return ºîÀ®¸å¤ÎÉô¼ó¹çÀ®Êýˡʸ»úÎó¥ê¥¹¥È
+(define (tutcode-auto-help-bushu-combination-strs decomposed)
+ (tutcode-auto-help-bushu-combination-traverse decomposed ()
+ (lambda (ele) (list (caadr ele))) "¢¥" ""))
+
+;;;
¼«Æ°¥Ø¥ë¥×:tutcode-auto-help-bushu-decompose¤Î¸¡º÷·ë²Ì¤Î¥Ä¥ê¡¼¹½Â¤¤«¤é¡¢
+;;; °ìÉô¤òÈ´¤½Ð¤·¤¿¥Õ¥é¥Ã¥È¤Ê¥ê¥¹¥È¤òºî¤ë
+;;; @param decomposed tutcode-auto-help-bushu-decompose·ë²Ì
+;;; @param lst ºîÀ®Ãæ¤Î¥ê¥¹¥È
+;;; @param picker decomposed¤ÎÍ×ÁÇ(tutcode-rule-element)¤«¤é
+;;; ÂоÝÍ×ÁǤòÈ´¤½Ð¤¹¤¿¤á¤Î´Ø¿ô
+;;; @param branch-str »Þ¤ï¤«¤ì¤ò¼¨¤¹¤¿¤á¤Ë·ë²Ì¥ê¥¹¥È¤ËÄɲ乤ëʸ»úÎó
+;;; @param delim-str ³ÆÉô¼ó¤Î¶èÀÚ¤ê¤ò¼¨¤¹¤¿¤á¤Ë·ë²Ì¥ê¥¹¥È¤ËÄɲ乤ëʸ»úÎó
+;;; @return ºîÀ®¸å¤Î¥ê¥¹¥È
+(define (tutcode-auto-help-bushu-combination-traverse decomposed lst picker
+ branch-str delim-str)
+ (if (null? decomposed)
+ lst
+ (let
+ ((add
+ (if (tutcode-rule-element? (car decomposed))
+ (cons delim-str (picker (car decomposed)))
+ (tutcode-auto-help-bushu-combination-traverse (car decomposed)
+ (list branch-str) picker branch-str delim-str))))
+ (tutcode-auto-help-bushu-combination-traverse (cdr decomposed)
+ (append lst add) picker branch-str delim-str))))
;;; ¼«Æ°¥Ø¥ë¥×:ÂоݤÎ1ʸ»ú¤òÆþÎϤ¹¤ë¥¹¥È¥í¡¼¥¯¤ò¥Ø¥ë¥×ÍÑalist¤ËÄɲ乤롣
;;; @param label-cands-alist ¸µ¤Îalist
@@ -2057,7 +2130,8 @@
(define (tutcode-auto-help-update-stroke-alist-normal-with-kanji
pc label-cands-alist kanji)
(let*
- ((rule (rk-context-rule (tutcode-context-rk-context pc)))
+ ((stime (time))
+ (rule (rk-context-rule (tutcode-context-rk-context pc)))
(stroke (tutcode-reverse-find-seq kanji rule)))
(if stroke
(begin
@@ -2067,22 +2141,21 @@
label-cands-alist
(cons (string-append kanji " ") stroke)
kanji))
- (let ((decomposed (tutcode-auto-help-bushu-decompose kanji rule)))
+ (let ((decomposed (tutcode-auto-help-bushu-decompose kanji rule
stime)))
;; Îã: "·Ò" => (((("," "o"))("·â")) ((("f" "q"))("»å")))
(if (not decomposed)
label-cands-alist
- (begin
- (tutcode-stroke-help-guide-add-kanji pc (car decomposed))
- (tutcode-stroke-help-guide-add-kanji pc (cadr decomposed))
+ (let*
+ ((bushu-strs (tutcode-auto-help-bushu-combination-strs
decomposed))
+ (helpstrlist (append (list kanji "¢¥") bushu-strs))
+ (helpstr (apply string-append helpstrlist))
+ (bushu-stroke
+ (tutcode-auto-help-bushu-combination-traverse decomposed ()
+ caar "" " ")))
+ (tutcode-auto-help-bushu-combination-add-guide pc 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
+ (cons helpstr bushu-stroke)
kanji)))))))
;;; ¼«Æ°¥Ø¥ë¥×:ÂоݤΥ¹¥È¥í¡¼¥¯(¥¡¼¤Î¥ê¥¹¥È)¤ò¥Ø¥ë¥×ÍÑalist¤ËÄɲ乤롣
@@ -3857,42 +3930,65 @@
;;; Îã: "·Ò" => (((("," "o"))("·â")) ((("f" "q"))("»å")))
;;; @param c ÂоÝʸ»ú
;;; @param rule tutcode-rule
+;;; @param stime ³«»ÏÆü»þ
;;; @return ÂоÝʸ»ú¤ÎÉô¼ó¹çÀ®¤ËɬÍפÊ2¤Ä¤Îʸ»ú¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¡£
;;; ¸«¤Ä¤«¤é¤Ê¤«¤Ã¤¿¾ì¹ç¤Ï#f
-(define (tutcode-auto-help-bushu-decompose c rule)
- (let*
- ((bushu (or (tutcode-bushu-help-lookup c)
- (tutcode-bushu-decompose c)))
- (b1 (and bushu (car bushu)))
- (b2 (and bushu (cadr bushu)))
- (seq1 (and b1 (tutcode-auto-help-get-stroke b1 rule)))
- (seq2 (and b2 (tutcode-auto-help-get-stroke b2 rule))))
- (or
- ;; ¤·»»¤Ë¤è¤ë¹çÀ®
- (and seq1 seq2
- (list seq1 seq2))
- ;; ñ½ã¤Ê°ú¤»»¤Ë¤è¤ë¹çÀ®
- (tutcode-auto-help-bushu-decompose-by-subtraction c rule)
- ;; ÉôÉʤˤè¤ë¹çÀ®
+(define (tutcode-auto-help-bushu-decompose c rule stime)
+ (if (> (string->number (difftime (time) stime))
tutcode-auto-help-time-limit)
+ #f
+ (let*
+ ((bushu (or (tutcode-bushu-help-lookup c)
+ (tutcode-bushu-decompose c)))
+ (b1 (and bushu (car bushu)))
+ (b2 (and bushu (cadr bushu)))
+ (seq1 (and b1 (tutcode-auto-help-get-stroke b1 rule)))
+ (seq2 (and b2 (tutcode-auto-help-get-stroke b2 rule))))
(or
- ;; Éô¼ó1¤¬Ä¾ÀÜÆþÎϲÄǽ
- ;; ¢ª(Éô¼ó1)¤È(Éô¼ó2¤òÉôÉʤȤ·¤Æ»ý¤Ä´Á»ú)¤Ë¤è¤ë¹çÀ®¤¬²Äǽ¤«?
- (and seq1 b2
- (tutcode-auto-help-bushu-decompose-looking-bushudic
tutcode-bushudic
- () 99
- (lambda (elem)
- (tutcode-auto-help-get-stroke-list-with-right-part
- c b1 b2 seq1 rule elem))))
- ;; Éô¼ó2¤¬Ä¾ÀÜÆþÎϲÄǽ
- ;; ¢ª(Éô¼ó2)¤È(Éô¼ó1¤òÉôÉʤȤ·¤Æ»ý¤Ä´Á»ú)¤Ë¤è¤ë¹çÀ®¤¬²Äǽ¤«?
- (and seq2 b1
- (tutcode-auto-help-bushu-decompose-looking-bushudic
tutcode-bushudic
- () 99
- (lambda (elem)
- (tutcode-auto-help-get-stroke-list-with-left-part
- c b1 b2 seq2 rule elem))))
- ;; XXX: ÉôÉʤɤ¦¤·¤Î¹çÀ®¤ä¡¢3ʸ»ú°Ê¾å¤Ç¤Î¹çÀ®¤Ï̤Âбþ
- ))))
+ ;; ¤·»»¤Ë¤è¤ë¹çÀ®
+ (and seq1 seq2
+ (list seq1 seq2))
+ ;; ñ½ã¤Ê°ú¤»»¤Ë¤è¤ë¹çÀ®
+ (tutcode-auto-help-bushu-decompose-by-subtraction c rule)
+ ;; ÉôÉʤˤè¤ë¹çÀ®
+ (or
+ ;; Éô¼ó1¤¬Ä¾ÀÜÆþÎϲÄǽ
+ ;; ¢ª(Éô¼ó1)¤È(Éô¼ó2¤òÉôÉʤȤ·¤Æ»ý¤Ä´Á»ú)¤Ë¤è¤ë¹çÀ®¤¬²Äǽ¤«?
+ (and seq1 b2
+ (or
+ (tutcode-auto-help-bushu-decompose-looking-bushudic
+ tutcode-bushudic () 99
+ (lambda (elem)
+ (tutcode-auto-help-get-stroke-list-with-right-part
+ c b1 b2 seq1 rule elem)))
+ ;; Éô¼ó2¤Ç¤Ï¹çÀ®ÉÔǽ¢ªÉô¼ó2¤ò¤µ¤é¤Ëʬ²ò
+ (let ((b2dec (tutcode-auto-help-bushu-decompose b2 rule
stime)))
+ (if b2dec
+ (list seq1 b2dec)
+ #f))))
+ ;; Éô¼ó2¤¬Ä¾ÀÜÆþÎϲÄǽ
+ ;; ¢ª(Éô¼ó2)¤È(Éô¼ó1¤òÉôÉʤȤ·¤Æ»ý¤Ä´Á»ú)¤Ë¤è¤ë¹çÀ®¤¬²Äǽ¤«?
+ (and seq2 b1
+ (or
+ (tutcode-auto-help-bushu-decompose-looking-bushudic
+ tutcode-bushudic () 99
+ (lambda (elem)
+ (tutcode-auto-help-get-stroke-list-with-left-part
+ c b1 b2 seq2 rule elem)))
+ ;; Éô¼ó1¤Ç¤Ï¹çÀ®ÉÔǽ¢ªÉô¼ó1¤ò¤µ¤é¤Ëʬ²ò
+ (let ((b1dec (tutcode-auto-help-bushu-decompose b1 rule
stime)))
+ (if b1dec
+ (list b1dec seq2)
+ #f))))
+ ;; Éô¼ó1¤âÉô¼ó2¤âľÀÜÆþÎÏÉԲĢª¤µ¤é¤Ëʬ²ò
+ (and b1 b2
+ (let
+ ((b1dec (tutcode-auto-help-bushu-decompose b1 rule stime))
+ (b2dec (tutcode-auto-help-bushu-decompose b2 rule stime)))
+ (if (and b1dec b2dec)
+ (list b1dec b2dec)
+ #f)))
+ ;; XXX: ÉôÉʤɤ¦¤·¤Î¹çÀ®¤Ï̤Âбþ
+ )))))
;;; ¼«Æ°¥Ø¥ë¥×:ÂоÝʸ»ú¤òÆþÎϤ¹¤ëºÝ¤ÎÂǸ°¤Î¥ê¥¹¥È¤ò¼èÆÀ¤¹¤ë¡£
;;; Îã: "·â" => ((("," "o")) ("·â"))
