Revision: 7243
Author: deton.kih
Date: Mon Jul 25 15:16:32 2011
Log: * Merge r7241,r7242 from trunk.
http://code.google.com/p/uim/source/detail?r=7243
Modified:
/branches/1.7/scm/tutcode-bushu.scm
=======================================
--- /branches/1.7/scm/tutcode-bushu.scm Fri Jul 22 18:33:56 2011
+++ /branches/1.7/scm/tutcode-bushu.scm Mon Jul 25 15:16:32 2011
@@ -440,24 +440,34 @@
(file-open-flags-number '($O_RDONLY)) 0))
(parse
(lambda (line)
- ;; Îã: "ëÚ¸ÀÁè*"¢ª(((("¸À" "Áè"))("ëÚ"))((("Áè" "¸À"))("ëÚ")))
+ ;; Îã: "Ñ£¥¤Àì* ÅÁ¡¦"
+ ;; ¢ª(((("¥¤" "Àì"))("Ñ£"))((("Àì" "¥¤"))("Ñ£"))((("ÅÁ" "¡¦"))("Ñ£")))
(let*
- ((lst (tutcode-bushu-parse-entry line))
- (len (length lst)))
- (if (< len 3)
- ()
- (let*
- ((kanji (list-ref lst 0))
- (bushu1 (list-ref lst 1))
- (bushu2 (list-ref lst 2))
- (rule (list (list (list bushu1 bushu2)) (list kanji)))
- (rev
- (and
- (and (> len 3) (string=? (list-ref lst 3) "*"))
- (list (list (list bushu2 bushu1)) (list kanji)))))
- (if rev
- (list rule rev)
- (list rule)))))))
+ ((comps (string-split line " "))
+ (kanji-lcomps (map tutcode-bushu-parse-entry comps))
+ (kanji (and (pair? (car kanji-lcomps)) (caar kanji-lcomps)))
+ ;;
¹ÔƬ¤Î¹çÀ®¸å¤Î´Á»ú¤ò½ü¤¤¤¿¥ê¥¹¥È¡£Îã:(("¥¤" "Àì" "*")("ÅÁ" "¡¦"))
+ (lcomps
+ (if kanji
+ (cons (cdar kanji-lcomps) (cdr kanji-lcomps))
+ ())))
+ (append-map!
+ (lambda (elem)
+ (let ((len (length elem)))
+ (if (< len 2)
+ ()
+ (let*
+ ((bushu1 (list-ref elem 0))
+ (bushu2 (list-ref elem 1))
+ (rule (list (list (list bushu1 bushu2)) (list kanji)))
+ (rev
+ (and
+ (and (>= len 3) (string=? (list-ref elem 2) "*"))
+ (list (list (list bushu2 bushu1)) (list kanji)))))
+ (if rev
+ (list rule rev)
+ (list rule))))))
+ lcomps))))
(res
(call-with-open-file-port fd
(lambda (port)
@@ -472,23 +482,23 @@
;;; bushu.help¥Õ¥¡¥¤¥ë¤Ë´ð¤Å¤¯Éô¼ó¹çÀ®¤ò¹Ô¤¦
(define (tutcode-bushu-compose-explicitly char-list)
- (if (or (null? char-list)
- (null? (cdr char-list)) ; 1ʸ»ú
- (pair? (cddr char-list))) ; 3ʸ»ú°Ê¾å
+ (if (null? tutcode-bushu-help)
+ (set! tutcode-bushu-help (tutcode-bushu-help-load)))
+ (if (not tutcode-bushu-help)
()
- ;; 2ʸ»ú¤Î¹çÀ®¤Î¤ßÂбþ
- (let*
- ((c1 (car char-list))
- (c2 (cadr char-list)))
- (if (null? tutcode-bushu-help)
- (set! tutcode-bushu-help (tutcode-bushu-help-load)))
- (let
- ((kanji
- (and tutcode-bushu-help
- (tutcode-bushu-compose c1 c2 tutcode-bushu-help))))
- (if kanji
- (list kanji)
- ())))))
+ (cond
+ ((null? char-list)
+ ())
+ ((null? (cdr char-list)) ; 1ʸ»ú
+ (map (lambda (elem) (caadr elem))
+ (rk-lib-find-partial-seqs char-list tutcode-bushu-help)))
+ ((pair? (cddr char-list)) ; 3ʸ»ú°Ê¾å
+ ())
+ (else ; 2ʸ»ú
+ (let ((seq (rk-lib-find-seq char-list tutcode-bushu-help)))
+ (if seq
+ (cadr seq)
+ ()))))))
;;; ÂÐÏÃŪ¤ÊÉô¼ó¹çÀ®ÊÑ´¹ÍѤˡ¢»ØÄꤵ¤ì¤¿Éô¼ó¤Î¥ê¥¹¥È¤«¤éÉô¼ó¹çÀ®²Äǽ¤Ê
;;; ´Á»ú¤Î¥ê¥¹¥È¤òÊÖ¤¹¡£
