Revision: 6498
Author: deton.kih
Date: Mon Jul 12 05:44:22 2010
Log: * scm/tutcode.scm
- (tutcode-auto-help-update-stroke-alist-with-kanji):
Move call of tutcode-auto-help-bushu-decompose-by-subtraction
to tutcode-auto-help-bushu-decompose
- (tutcode-auto-help-bushu-decompose):
Add decomposition of bushu1 and kanji which has bushu2
- (tutcode-auto-help-get-stroke):
Change return list structure
- (tutcode-auto-help-get-stroke-list-by-subtraction):
Follow change of tutcode-auto-help-get-stroke
- (tutcode-auto-help-bushu-decompose-with-part,
tutcode-auto-help-get-stroke-list-with-part): New
- (tutcode-reverse-find-seq): Add comment
http://code.google.com/p/uim/source/detail?r=6498
Modified:
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode.scm Sun Jul 11 02:47:57 2010
+++ /trunk/scm/tutcode.scm Mon Jul 12 05:44:22 2010
@@ -679,13 +679,7 @@
(if stroke
(tutcode-auto-help-update-stroke-alist-with-stroke
label-cands-alist (car cand-list) stroke)
- (let ((decomposed
- (or
- (tutcode-auto-help-bushu-decompose kanji)
- ;; ñ½ã¤Ê°ú¤»»¤Ë¤è¤ë¹çÀ®¤Þ¤ÇÂбþ¡£
- ;; XXX:ÉôÉʤˤè¤ë¹çÀ®¤ä¡¢3ʸ»ú°Ê¾å¤Ç¤Î¹çÀ®¤Ï̤Âбþ
- (tutcode-auto-help-bushu-decompose-by-subtraction
- kanji tutcode-bushudic))))
+ (let ((decomposed (tutcode-auto-help-bushu-decompose kanji)))
;; Îã: "·Ò" => (((("," "o"))("·â")) ((("f" "q"))("»å")))
(if (not decomposed)
label-cands-alist
@@ -1222,36 +1216,58 @@
(tutcode-reverse-find-seq tutcode-bushudic c))
;;; ¼«Æ°¥Ø¥ë¥×:ÂоÝʸ»ú¤òÉô¼ó¹çÀ®¤¹¤ë¤Î¤ËɬÍפȤʤ롢
-;;; ³°»ú¤Ç¤Ê¤¤2¤Ä¤ÎÉô¼ó¤Ëʬ²ò¤¹¤ë¡£
+;;; ³°»ú¤Ç¤Ê¤¤2¤Ä¤Îʸ»ú¤Î¥ê¥¹¥È¤òÊÖ¤¹
;;; Îã: "·Ò" => (((("," "o"))("·â")) ((("f" "q"))("»å")))
-;;; @param c ʬ²òÂоݤÎʸ»ú
-;;; @return ʬ²ò¤·¤Æ¤Ç¤¤¿2¤Ä¤ÎÉô¼ó¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¡£
-;;; ʬ²ò¤Ç¤¤Ê¤«¤Ã¤¿¤È¤¤Ï#f
+;;; @param c ÂоÝʸ»ú
+;;; @return ÂоÝʸ»ú¤ÎÉô¼ó¹çÀ®¤ËɬÍפÊ2¤Ä¤Îʸ»ú¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¡£
+;;; ¸«¤Ä¤«¤é¤Ê¤«¤Ã¤¿¾ì¹ç¤Ï#f
(define (tutcode-auto-help-bushu-decompose c)
- (and-let*
+ (let*
((bushu (tutcode-reverse-find-seq tutcode-bushudic c))
- (b1 (car bushu))
- (b2 (cadr bushu))
- (seq1 (tutcode-auto-help-get-stroke b1))
- (seq2 (tutcode-auto-help-get-stroke b2)))
- (list (list (list seq1) (list b1)) (list (list seq2) (list b2)))))
+ (b1 (and bushu (car bushu)))
+ (b2 (and bushu (cadr bushu)))
+ (seq1 (and b1 (tutcode-auto-help-get-stroke b1)))
+ (seq2 (and b2 (tutcode-auto-help-get-stroke b2))))
+ (or
+ (and seq1 seq2
+ (list seq1 seq2))
+ ;; ñ½ã¤Ê°ú¤»»¤Ë¤è¤ë¹çÀ®
+ (tutcode-auto-help-bushu-decompose-by-subtraction c tutcode-bushudic)
+ ;; ÉôÉʤˤè¤ë¹çÀ®
+ (or
+ ;; Éô¼ó1¤¬Ä¾ÀÜÆþÎϲÄǽ
+ ;; ¢ª(Éô¼ó1)¤È(Éô¼ó2¤òÉôÉʤȤ·¤Æ»ý¤Ä´Á»ú)¤Ë¤è¤ë¹çÀ®¤¬²Äǽ¤«?
+ (and seq1 b2
+ (tutcode-auto-help-bushu-decompose-with-part
+ c seq1 b1 b2 tutcode-bushudic))
+ ;; Éô¼ó2¤¬Ä¾ÀÜÆþÎϲÄǽ
+ ;; ¢ª(Éô¼ó2)¤È(Éô¼ó1¤òÉôÉʤȤ·¤Æ»ý¤Ä´Á»ú)¤Ë¤è¤ë¹çÀ®¤¬²Äǽ¤«?
+ (and seq2 b1
+ (tutcode-auto-help-bushu-decompose-with-part
+ c seq2 b1 b2 tutcode-bushudic))
+ ;; XXX: ÉôÉʤɤ¦¤·¤Î¹çÀ®¤ä¡¢3ʸ»ú°Ê¾å¤Ç¤Î¹çÀ®¤Ï̤Âбþ
+ ))))
;;; ¼«Æ°¥Ø¥ë¥×:ÂоÝʸ»ú¤òÆþÎϤ¹¤ëºÝ¤ÎÂǸ°¤Î¥ê¥¹¥È¤ò¼èÆÀ¤¹¤ë¡£
-;;; Îã: "·â" => ("," "o")
+;;; Îã: "·â" => ((("," "o")) ("·â"))
;;; @param b ÂоÝʸ»ú
;;; @return ÂǸ°¥ê¥¹¥È¡£ÆþÎÏÉÔ²Äǽ¤Ê¾ì¹ç¤Ï#f
(define (tutcode-auto-help-get-stroke b)
- (or (tutcode-reverse-find-seq tutcode-rule b)
- ;;
Éô¼ó¹çÀ®¤Ç»È¤ï¤ì¤ë"5"¤ä"3"¤Î¤è¤¦¤ÊľÀÜÆþÎϲÄǽ¤ÊÉô¼ó¤ËÂбþ¤¹¤ë¤¿¤á¡¢
- ;; ¥é¥Ù¥ëʸ»ú¤Ë´Þ¤Þ¤ì¤Æ¤¤¤ì¤Ð¡¢Ä¾ÀÜÆþÎϲÄǽ¤È¤ß¤Ê¤¹
- (and
- (member b tutcode-heading-label-char-list-for-kigou-mode)
- (list b))))
+ (let
+ ((seq
+ (or (tutcode-reverse-find-seq tutcode-rule b)
+ ;;
Éô¼ó¹çÀ®¤Ç»È¤ï¤ì¤ë"3"¤Î¤è¤¦¤ÊľÀÜÆþÎϲÄǽ¤ÊÉô¼ó¤ËÂбþ¤¹¤ë¤¿¤á¡¢
+ ;; ¥é¥Ù¥ëʸ»ú¤Ë´Þ¤Þ¤ì¤Æ¤¤¤ì¤Ð¡¢Ä¾ÀÜÆþÎϲÄǽ¤È¤ß¤Ê¤¹
+ (and
+ (member b tutcode-heading-label-char-list-for-kigou-mode)
+ (list b)))))
+ (and seq
+ (list (list seq) (list b)))))
;;; ¼«Æ°¥Ø¥ë¥×:ÂоÝʸ»ú¤ò°ú¤»»¤Ë¤è¤êÉô¼ó¹çÀ®¤¹¤ë¤Î¤ËɬÍפȤʤ롢
;;; ³°»ú¤Ç¤Ê¤¤Ê¸»ú¤Î¥ê¥¹¥È¤òÊÖ¤¹¡£
;;; Îã: "ÝÆ" => (((("g" "t" "h")) ("Îó")) ((("G" "I")) ("¥ê")))
-;;; (tutcode-bushudicÆâ¤ÎÍ×ÁǤÏ((("ÝÆ" "¥ê")) ("Îó")))
+;;; (¸µ¤È¤Ê¤ëtutcode-bushudicÆâ¤ÎÍ×ÁǤÏ((("ÝÆ" "¥ê")) ("Îó")))
;;; @param c ÂоÝʸ»ú
;;; @return ÂоÝʸ»ú¤ÎÉô¼ó¹çÀ®¤ËɬÍפÊ2¤Ä¤Îʸ»ú¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¡£
;;; ¸«¤Ä¤«¤é¤Ê¤«¤Ã¤¿¾ì¹ç¤Ï#f
@@ -1282,7 +1298,63 @@
(c-composed? (string=? composed c))
(seq1 (tutcode-auto-help-get-stroke b1))
(seq2 (tutcode-auto-help-get-stroke b2)))
- (list (list (list seq1) (list b1)) (list (list seq2) (list b2)))))
+ (list seq1 seq2)))
+
+;;; ¼«Æ°¥Ø¥ë¥×:ÂоÝʸ»ú¤ò¹çÀ®²Äǽ¤Ê¡¢¶¦¤Ë³°»ú¤Ç¤Ê¤¤¡ÖÉô¼ó1¡×¤È
+;;; ¡ÖÉô¼ó2¤òÉôÉʤȤ·¤Æ»ý¤Ä´Á»ú¡×¤Î¥ê¥¹¥È¤òÊÖ¤¹¡£
+;;; @param c ÂоÝʸ»ú (Îã: "½²")
+;;; @param seq ³°»ú¤Ç¤Ê¤¤Éô¼ó(b1 or b2)¤ÎÆþÎÏ¥¡¼¥·¡¼¥±¥ó¥¹¤ÈÉô¼ó¤Î¥ê¥¹¥È¡£
+;;; Îã: ((("b" ",")) ("¸À"))
+;;; @param b1 Éô¼ó1 (Îã: "ð²")
+;;; @param b2 Éô¼ó2 (Îã: "¸À")
+;;; @param bushudic Éô¼ó¹çÀ®ÊÑ´¹¼½ñ
+;;; @return ÂоÝʸ»ú¤ÎÉô¼ó¹çÀ®¤ËɬÍפÊ2¤Ä¤Îʸ»ú¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¡£
+;;; ¸«¤Ä¤«¤é¤Ê¤«¤Ã¤¿¾ì¹ç¤Ï#f¡£
+;;; Îã: (((("e" "v" ".")) ("°Ô")) ((("b" ",")) ("¸À")))
+(define (tutcode-auto-help-bushu-decompose-with-part c seq b1 b2 bushudic)
+ ;; bushudic¤ÎÍ×ÁǤò½ç¤Ë¸«¤ÆºÇ½é¤Ë¸«¤Ä¤«¤Ã¤¿¤â¤Î¤òÊÖ¤¹¡£
+ ;; filter¤ämap¤ò»È¤Ã¤Æ¡¢ºÇ¾®¤Î¥¹¥È¥í¡¼¥¯¤Î¤â¤Î¤òõ¤¹¤È»þ´Ö¤¬¤«¤«¤ë¤Î¤Ç¡£
+ ;; XXX: µÕ°ú¤ÍÑbushudic¤òºî¤Ã¤Æ»È¤¦?
+ (and
+ (not (null? bushudic))
+ (or
+ (tutcode-auto-help-get-stroke-list-with-part c seq b1 b2 (car
bushudic))
+ (tutcode-auto-help-bushu-decompose-with-part
+ c seq b1 b2 (cdr bushudic)))))
+
+;;; ¼«Æ°¥Ø¥ë¥×:ÂоÝʸ»ú¤ò¡ÖÉô¼ó1¡×¤È¡ÖÉô¼ó2¤òÉôÉʤȤ·¤Æ»ý¤Ä´Á»ú¡×¤Ë¤è¤ê
+;;; Éô¼ó¹çÀ®¤Ç¤¤ë¾ì¹ç¤Ï¡¢
+;;; ¹çÀ®¤Ë»È¤¦³Æʸ»ú¤È¡¢¤½¤Î¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¤òÊÖ¤¹¡£
+;;; @param c ÂоÝʸ»ú (Îã: "½²")
+;;; @param seq ³°»ú¤Ç¤Ê¤¤Éô¼ó(b1 or b2)¤ÎÆþÎÏ¥¡¼¥·¡¼¥±¥ó¥¹¤ÈÉô¼ó¤Î¥ê¥¹¥È¡£
+;;; Îã: ((("b" ",")) ("¸À"))
+;;; @param b1 Éô¼ó1 (Îã: "ð²")
+;;; @param b2 Éô¼ó2 (Îã: "¸À")
+;;; @param bushu-list bushudicÆâ¤ÎÍ×ÁÇ¡£Îã: ((("À" "ð²"))("°Ô"))
+;;; @return ÂоÝʸ»ú¤ÎÉô¼ó¹çÀ®¤ËɬÍפÊ2¤Ä¤Îʸ»ú¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¡£
+;;; bushu-list¤ò»È¤Ã¤Æ¹çÀ®¤Ç¤¤Ê¤¤¾ì¹ç¤Ï#f¡£
+;;; Îã: (((("e" "v" ".")) ("°Ô")) ((("b" ",")) ("¸À")))
+(define (tutcode-auto-help-get-stroke-list-with-part
+ c seq b1 b2 bushu-list)
+ (if (string=? b1 (caadr seq))
+ ;; Éô¼ó1¤Ï³°»ú¤Ç¤Ê¤¤(ľÀÜÆþÎϲÄǽ)
+ (and-let*
+ ((mem (member b2 (caar bushu-list)))
+ (kanji (caadr bushu-list)) ; Éô¼ó2¤òÉôÉʤȤ·¤Æ»ý¤Ä´Á»ú
+ ;; ¼ÂºÝ¤ËÉô¼ó¹çÀ®¤·¤Æ¡¢ÂоÝʸ»ú¤¬¹çÀ®¤µ¤ì¤Ê¤¤¤â¤Î¤ÏÂÌÌÜ
+ (composed (tutcode-bushu-convert b1 kanji))
+ (c-composed? (string=? composed c))
+ (seq2 (tutcode-auto-help-get-stroke kanji)))
+ (list seq seq2))
+ ;; Éô¼ó2¤Ï³°»ú¤Ç¤Ê¤¤(ľÀÜÆþÎϲÄǽ)
+ (and-let*
+ ((mem (member b1 (caar bushu-list)))
+ (kanji (caadr bushu-list)) ; Éô¼ó1¤òÉôÉʤȤ·¤Æ»ý¤Ä´Á»ú
+ ;; ¼ÂºÝ¤ËÉô¼ó¹çÀ®¤·¤Æ¡¢ÂоÝʸ»ú¤¬¹çÀ®¤µ¤ì¤Ê¤¤¤â¤Î¤ÏÂÌÌÜ
+ (composed (tutcode-bushu-convert kanji b2))
+ (c-composed? (string=? composed c))
+ (seq1 (tutcode-auto-help-get-stroke kanji)))
+ (list seq1 seq))))
;;; rule¤òµÕ°ú¤¤·¤Æ¡¢ÊÑ´¹¸å¤Îʸ»ú¤«¤é¡¢ÆþÎÏ¥¡¼Îó¤ò¼èÆÀ¤¹¤ë¡£
;;; Îã: (tutcode-reverse-find-seq tutcode-rule "¤¢") => ("r" "k")
@@ -1290,6 +1362,7 @@
;;; @param c ÊÑ´¹¸å¤Îʸ»ú
;;; @return ÆþÎÏ¥¡¼¤Î¥ê¥¹¥È¡£ruleÃæ¤Ëc¤¬¸«¤Ä¤«¤é¤Ê¤«¤Ã¤¿¾ì¹ç¤Ï#f
(define (tutcode-reverse-find-seq rule c)
+ ;; XXX: µÕ°ú¤ÍÑalist¤òºî¤Ã¤Æ»È¤¦?
(let ((lst
(filter
(lambda (elem)
