Revision: 7225
Author: deton.kih
Date: Tue Jul 19 03:56:15 2011
Log: * Merge r7224 from trunk.
http://code.google.com/p/uim/source/detail?r=7225
Modified:
/branches/1.7/scm/tutcode-bushu.scm
/branches/1.7/scm/tutcode-custom.scm
/branches/1.7/scm/tutcode.scm
=======================================
--- /branches/1.7/scm/tutcode-bushu.scm Fri Jan 14 15:53:11 2011
+++ /branches/1.7/scm/tutcode-bushu.scm Tue Jul 19 03:56:15 2011
@@ -30,12 +30,16 @@
;;; tutcode-bushu.scm: ÂÐÏÃŪ¤ÊÉô¼ó¹çÀ®ÊÑ´¹
;;;
-;;; tc-2.3.1¤Îtc-bushu.el¤ò°Ü¿¢(bushu.help¥Õ¥¡¥¤¥ë¤äsort¤Ë¤Ï̤Âбþ)¡£
+;;; tc-2.3.1¤Îtc-bushu.el¤ò°Ü¿¢(sort¤Ë¤Ï̤Âбþ)¡£
;;; (»²¹Í:Éô¼ó¹çÀ®¥¢¥ë¥´¥ê¥º¥à¤Ï[tcode-ml:1942]¤¢¤¿¤ê)
(require-extension (srfi 1 8))
+(require "fileio.scm")
(require-dynlib "look")
+;;; bushu.help¥Õ¥¡¥¤¥ë¤òÆɤó¤ÇÀ¸À®¤·¤¿tutcode-bushudic·Á¼°¤Î¥ê¥¹¥È
+(define tutcode-bushu-help ())
+
;;; ʸ»ú¤Î¥ê¥¹¥È¤È¤·¤ÆÊÖ¤¹¡£
(define (tutcode-bushu-parse-entry str)
(reverse! (string-to-list str)))
@@ -428,13 +432,72 @@
(append! true-diff-set rest-diff-set))))
(delete-duplicates! res)))
+;;; bushu.help¥Õ¥¡¥¤¥ë¤òÆɤó¤Çtutcode-bushudic·Á¼°¤Î¥ê¥¹¥È¤òÀ¸À®¤¹¤ë
+;;; @return tutcode-bushudic·Á¼°¤Î¥ê¥¹¥È¡£Æɤ߹þ¤á¤Ê¤«¤Ã¤¿¾ì¹ç¤Ï#f
+(define (tutcode-bushu-help-load)
+ (let*
+ ((fd (file-open tutcode-bushu-help-filename
+ (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)))))))
+ (res
+ (call-with-open-file-port fd
+ (lambda (port)
+ (let loop ((line (file-read-line port))
+ (rules ()))
+ (if (or (not line)
+ (eof-object? line))
+ rules
+ (loop (file-read-line port)
+ (append! rules (parse line)))))))))
+ res))
+
+;;; bushu.help¥Õ¥¡¥¤¥ë¤Ë´ð¤Å¤¯Éô¼ó¹çÀ®¤ò¹Ô¤¦
+(define (tutcode-bushu-compose-explicitly char-list)
+ (if (or (null? char-list)
+ (null? (cdr char-list)) ; 1ʸ»ú
+ (pair? (cddr char-list))) ; 3ʸ»ú°Ê¾å
+ ()
+ ;; 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)
+ ())))))
+
;;; ÂÐÏÃŪ¤ÊÉô¼ó¹çÀ®ÊÑ´¹ÍѤˡ¢»ØÄꤵ¤ì¤¿Éô¼ó¤Î¥ê¥¹¥È¤«¤éÉô¼ó¹çÀ®²Äǽ¤Ê
;;; ´Á»ú¤Î¥ê¥¹¥È¤òÊÖ¤¹¡£
;;; @param char-list ÆþÎϤµ¤ì¤¿Éô¼ó¤Î¥ê¥¹¥È
;;; @return ¹çÀ®²Äǽ¤Ê´Á»ú¤Î¥ê¥¹¥È
(define (tutcode-bushu-compose-interactively char-list)
(let*
- ((complete-compose-set (tutcode-bushu-complete-compose-set char-list))
+ ((explicit (tutcode-bushu-compose-explicitly char-list))
+ (complete-compose-set (tutcode-bushu-complete-compose-set char-list))
(complete-diff-set (tutcode-bushu-complete-diff-set char-list))
(strong-compose-set (tutcode-bushu-strong-compose-set char-list))
(strong-diff-set (tutcode-bushu-strong-diff-set char-list))
@@ -443,6 +506,7 @@
strong-compose-set)))
(delete-duplicates!
(append!
+ explicit
complete-compose-set
complete-diff-set
strong-compose-set
=======================================
--- /branches/1.7/scm/tutcode-custom.scm Fri Jul 8 16:50:46 2011
+++ /branches/1.7/scm/tutcode-custom.scm Tue Jul 19 03:56:15 2011
@@ -160,6 +160,12 @@
(N_ "bushu.expand file")
(N_ "long description will be here."))
+(define-custom 'tutcode-bushu-help-filename ""
+ '(tutcode tutcode-bushu)
+ '(pathname regular-file)
+ (N_ "bushu.help file")
+ (N_ "long description will be here."))
+
;;
;; candidate window
;;
@@ -245,12 +251,6 @@
(N_ "Show real keys on auto help window")
(N_ "long description will be here."))
-(define-custom 'tutcode-bushu-help-filename ""
- '(tutcode candwin)
- '(pathname regular-file)
- (N_ "bushu.help file for auto help")
- (N_ "long description will be here."))
-
;; prediction/completion
(define-custom 'tutcode-use-completion? #f
'(tutcode tutcode-prediction)
=======================================
--- /branches/1.7/scm/tutcode.scm Tue Jul 19 03:45:31 2011
+++ /branches/1.7/scm/tutcode.scm Tue Jul 19 03:56:15 2011
@@ -3801,9 +3801,12 @@
;;; @param c2 2ÈÖÌܤÎÉô¼ó
;;; @return ¹çÀ®¸å¤Îʸ»ú¡£¹çÀ®¤Ç¤¤Ê¤«¤Ã¤¿¤È¤¤Ï#f
(define (tutcode-bushu-convert c1 c2)
+ (if (null? tutcode-bushu-help)
+ (set! tutcode-bushu-help (tutcode-bushu-help-load)))
;; tc-2.1+[tcode-ml:1925]¤ÎÉô¼ó¹çÀ®¥¢¥ë¥´¥ê¥º¥à¤ò»ÈÍÑ
(and c1 c2
(or
+ (and tutcode-bushu-help (tutcode-bushu-compose c1 c2
tutcode-bushu-help))
(tutcode-bushu-compose-sub c1 c2)
(let ((a1 (tutcode-bushu-alternative c1))
(a2 (tutcode-bushu-alternative c2)))
@@ -3878,15 +3881,15 @@
(define (tutcode-bushu-compose-sub c1 c2)
(and c1 c2
(or
- (tutcode-bushu-compose c1 c2)
- (tutcode-bushu-compose c2 c1))))
+ (tutcode-bushu-compose c1 c2 tutcode-bushudic)
+ (tutcode-bushu-compose c2 c1 tutcode-bushudic))))
;;; Éô¼ó¹çÀ®ÊÑ´¹:c1¤Èc2¤ò¹çÀ®¤·¤Æ¤Ç¤¤ëʸ»ú¤òõ¤·¤ÆÊÖ¤¹¡£
;;; @param c1 1ÈÖÌܤÎÉô¼ó
;;; @param c2 2ÈÖÌܤÎÉô¼ó
;;; @return ¹çÀ®¸å¤Îʸ»ú¡£¹çÀ®¤Ç¤¤Ê¤«¤Ã¤¿¤È¤¤Ï#f
-(define (tutcode-bushu-compose c1 c2)
- (let ((seq (rk-lib-find-seq (list c1 c2) tutcode-bushudic)))
+(define (tutcode-bushu-compose c1 c2 bushudic)
+ (let ((seq (rk-lib-find-seq (list c1 c2) bushudic)))
(and seq
(car (cadr seq)))))
