Revision: 6486
Author: deton.kih
Date: Sun Jul 4 02:52:35 2010
Log: * scm/tutcode.scm
- (tutcode-auto-help-cand-str-list): Add list for bushu
- (tutcode-check-auto-help-window-begin):
Extract help-one to tutcode-auto-help-update-stroke-alist
- (tutcode-auto-help-update-stroke-alist):
New function extracted from tutcode-check-auto-help-window-begin.
Change to show bushu conversion candidates
- (tutcode-auto-help-bushu-decompose,
tutcode-auto-help-get-stroke
tutcode-auto-help-bushu-decompose-by-subtraction,
tutcode-auto-help-get-stroke-list-by-subtraction):
New function to show bushu conversion candidates on auto help
http://code.google.com/p/uim/source/detail?r=6486
Modified:
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode.scm Sat Jul 3 00:39:57 2010
+++ /trunk/scm/tutcode.scm Sun Jul 4 02:52:35 2010
@@ -89,7 +89,7 @@
;;; * ²¾ÁÛ¸°È×ɽ¼¨µ¡Ç½¤òÄɲá£
;;; * ¼«Æ°¥Ø¥ë¥×ɽ¼¨µ¡Ç½¤òÄɲá£
-(require-extension (srfi 1))
+(require-extension (srfi 1 2))
(require "generic.scm")
(require-custom "tutcode-custom.scm")
(require-custom "generic-key-custom.scm")
@@ -152,14 +152,13 @@
;;; ¼«Æ°¥Ø¥ë¥×¤Ç¤Îʸ»ú¤ÎÂǤÁÊýɽ¼¨¤ÎºÝ¤Ë¸õÊäʸ»úÎó¤È¤·¤Æ»È¤¦Ê¸»ú¤Î¥ê¥¹¥È
(define tutcode-auto-help-cand-str-list
- ;; Âè1,2,3,4ÂǸ°¤ò¼¨¤¹Ê¸»ú
- '(("1" "2" "3" "4") ; 1ʸ»úÌÜÍÑ
- ("a" "b" "c" "d") ; 2ʸ»úÌÜÍÑ
- ("A" "B" "C" "D")
- ("°ì" "Æó" "»°" "»Í")
- ("¤¢" "¤¤" "¤¦" "¤¨")
- ("¥¢" "¥¤" "¥¦" "¥¨")
- ("¦Á" "¦Â" "¦Ã" "¦Ä")))
+ ;; Âè1,2,3,4ÂǸ°¤ò¼¨¤¹Ê¸»ú(Éô¼ó1ÍÑ, Éô¼ó2ÍÑ)
+ '((("1" "2" "3" "4") ("5" "6" "7" "8")) ; 1ʸ»úÌÜÍÑ
+ (("a" "b" "c" "d") ("e" "f" "g" "h")) ; 2ʸ»úÌÜÍÑ
+ (("A" "B" "C" "D") ("E" "F" "G" "H"))
+ (("°ì" "Æó" "»°" "»Í") ("¸Þ" "Ï»" "¼·" "Ȭ"))
+ (("¤¢" "¤¤" "¤¦" "¤¨") ("¤«" "¤" "¤¯" "¤±"))
+ (("¥¢" "¥¤" "¥¦" "¥¨") ("¥«" "¥" "¥¯" "¥±"))))
;;; implementations
@@ -600,33 +599,32 @@
;;; ¡¦¡¦a ¡¦ ¡¦¡¦3 ¡¦
;;; ¡¦¡¦¡¦¡¦1b ¡¦¡¦c ¡¦
;;; ¡¦¡¦¡¦2 ¡¦¡¦¡¦¡¦
+;;; ³ÎÄꤷ¤¿Ê¸»ú¤¬Ä¾ÀÜÆþÎϤǤ¤Ê¤¤¾ì¹ç¡¢Ã±½ã¤ÊÉô¼ó¹çÀ®ÊÑ´¹¤ÇÆþÎϤǤ¤ì¤Ð¡¢
+;;; °Ê²¼¤Î¤è¤¦¤ËÉô¼ó¹çÀ®ÊÑ´¹ÊýË¡¤òɽ¼¨¤¹¤ë¡£¡Öͫݵ¡×
+;;; ¨£¨¡¨¨¨¡¨¨¨¡¨¨¨¡¨¨¨¡¨¨¨¡¨¨¨¡¨¡¨¡¨¡¨¡¨¨¨¡¨¨¨¡¨¨¨¡¨¨¨¡¨¤
+;;; ¨¢ ¨¢ ¨¢ ¨¢ ¨¢ ¨¢ ¨¢ ¨¢ ¨¢ ¨¢ ¨¢ ¨¢
+;;; ¨§¨¡¨«¨¡¨«¨¡¨«¨¡¨«¨¡¨© ¨§¨¡¨¡¨¡¨¡¨¡¨«¨¡¨«¨¡¨«¨¡¨«¨¡¨©
+;;; ¨¢ ¨¢ ¨¢ ¨¢ ¨¢b ¨¢ ¨¢ ¨¢ ¨¢ ¨¢g ¨¢ ¨¢
+;;; ¨§¨¡¨«¨¡¨«¨¡¨«¨¡¨«¨¡¨© ¨§¨¡¨¡¨¡¨¡¨¡¨«¨¡¨«¨¡¨«¨¡¨«¨¡¨©
+;;; ¨¢ ¨¢3 ¨¢ ¨¢ ¨¢ ¨¢ ¨¢ ¨¢ ¨¢ ¨¢1 ¨¢ ¨¢
+;;; ¨§¨¡¨«¨¡¨«¨¡¨«¨¡¨«¨¡¨© ¨§¨¡¨¡¨¡¨¡¨¡¨«¨¡¨«¨¡¨«¨¡¨«¨¡¨©
+;;; ¨¢ ¨¢ ¨¢e ¨¢ ¨¢f ¨¢ ¨¢2a(¢¥ÎÓ´Ì)¨¢ ¨¢ ¨¢ ¨¢ ¨¢
+;;; ¨¦¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨¡¨¡¨¡¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨¥
;;; @param strlist ³ÎÄꤷ¤¿Ê¸»úÎó¤Î¥ê¥¹¥È(µÕ½ç)
;;; @param yomilist ÊÑ´¹Á°¤ÎÆɤߤÎʸ»úÎó¤Î¥ê¥¹¥È(µÕ½ç)
(define (tutcode-check-auto-help-window-begin pc strlist yomilist)
(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)
- (help-one
- (lambda (str cand-list)
- (let ((stroke (tutcode-reverse-find-seq tutcode-rule str)))
- (if 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))))))
+ (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
- (help-one kanji (car cand-str-list))
+ (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))
(if (not (null? label-cands-alist))
@@ -642,6 +640,46 @@
(im-activate-candidate-selector pc
(length stroke-help)
tutcode-nr-candidate-max-for-kigou-mode))))))
+;;; ¼«Æ°¥Ø¥ë¥×ÍÑalist¤ò¹¹¿·¤¹¤ë
+;;; @param str ¥Ø¥ë¥×ɽ¼¨ÂоݤǤ¢¤ë¡¢³ÎÄꤵ¤ì¤¿´Á»ú
+;;; @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)))
+ (if stroke
+ (update-alist (car cand-list) stroke)
+ (let ((decomposed
+ (or
+ (tutcode-auto-help-bushu-decompose str)
+ ;; ñ½ã¤Ê°ú¤»»¤Ë¤è¤ë¹çÀ®¤Þ¤ÇÂбþ¡£
+ ;; XXX:3ʸ»ú°Ê¾å¤Ç¤Î¹çÀ®¤ä¡¢ÉôÉʤˤè¤ë¹çÀ®¤Ï̤Âбþ
+ (tutcode-auto-help-bushu-decompose-by-subtraction
+ str tutcode-bushudic))))
+ ;; Îã: "·Ò" => (((("," "o"))("·â")) ((("f" "q"))("»å")))
+ (if decomposed
+ (begin
+ (update-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))
+
;;; preeditɽ¼¨¤ò¹¹¿·¤¹¤ë¡£
;;; @param pc ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
(define (tutcode-update-preedit pc)
@@ -1127,6 +1165,69 @@
(define (tutcode-bushu-decompose c)
(tutcode-reverse-find-seq tutcode-bushudic c))
+;;; ¼«Æ°¥Ø¥ë¥×:ÂоÝʸ»ú¤òÉô¼ó¹çÀ®¤¹¤ë¤Î¤ËɬÍפȤʤ롢
+;;; ³°»ú¤Ç¤Ê¤¤2¤Ä¤ÎÉô¼ó¤Ëʬ²ò¤¹¤ë¡£
+;;; Îã: "·Ò" => (((("," "o"))("·â")) ((("f" "q"))("»å")))
+;;; @param c ʬ²òÂоݤÎʸ»ú
+;;; @return ʬ²ò¤·¤Æ¤Ç¤¤¿2¤Ä¤ÎÉô¼ó¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¡£
+;;; ʬ²ò¤Ç¤¤Ê¤«¤Ã¤¿¤È¤¤Ï#f
+(define (tutcode-auto-help-bushu-decompose c)
+ (and-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)))))
+
+;;; ¼«Æ°¥Ø¥ë¥×:ÂоÝʸ»ú¤òÆþÎϤ¹¤ëºÝ¤ÎÂǸ°¤Î¥ê¥¹¥È¤ò¼èÆÀ¤¹¤ë¡£
+;;; Îã: "·â" => ("," "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))))
+
+;;; ¼«Æ°¥Ø¥ë¥×:ÂоÝʸ»ú¤ò°ú¤»»¤Ë¤è¤êÉô¼ó¹çÀ®¤¹¤ë¤Î¤ËɬÍפȤʤ롢
+;;; ³°»ú¤Ç¤Ê¤¤Ê¸»ú¤Î¥ê¥¹¥È¤òÊÖ¤¹¡£
+;;; Îã: "ÝÆ" => (((("g" "t" "h")) ("Îó")) ((("G" "I")) ("¥ê")))
+;;; (tutcode-bushudicÆâ¤ÎÍ×ÁǤÏ((("ÝÆ" "¥ê")) ("Îó")))
+;;; @param c ÂоÝʸ»ú
+;;; @return ÂоÝʸ»ú¤ÎÉô¼ó¹çÀ®¤ËɬÍפÊ2¤Ä¤Îʸ»ú¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¡£
+;;; ¸«¤Ä¤«¤é¤Ê¤«¤Ã¤¿¾ì¹ç¤Ï#f
+(define (tutcode-auto-help-bushu-decompose-by-subtraction c bushudic)
+ ;; bushudic¤ÎÍ×ÁǤò½ç¤Ë¸«¤ÆºÇ½é¤Ë¸«¤Ä¤«¤Ã¤¿¤â¤Î¤òÊÖ¤¹¡£
+ ;; filter¤ämap¤ò»È¤Ã¤Æ¡¢ºÇ¾®¤Î¥¹¥È¥í¡¼¥¯¤Î¤â¤Î¤òõ¤¹¤È»þ´Ö¤¬¤«¤«¤ë¤Î¤Ç¡£
+ (and
+ (not (null? bushudic))
+ (or
+ (tutcode-auto-help-get-stroke-list-by-subtraction c (car bushudic))
+ (tutcode-auto-help-bushu-decompose-by-subtraction c (cdr
bushudic)))))
+
+;;; ¼«Æ°¥Ø¥ë¥×:ÂоÝʸ»ú¤ò°ú¤»»¤Ë¤è¤êÉô¼ó¹çÀ®¤Ç¤¤ë¾ì¹ç¤Ï¡¢
+;;; ¹çÀ®¤Ë»È¤¦³Æʸ»ú¤È¡¢¤½¤Î¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¤òÊÖ¤¹¡£
+;;; @param c ÂоÝʸ»ú
+;;; @param bushu-list bushudicÆâ¤ÎÍ×ÁÇ¡£Îã: ((("ÝÆ" "¥ê")) ("Îó"))
+;;; @return ÂоÝʸ»ú¤ÎÉô¼ó¹çÀ®¤ËɬÍפÊ2¤Ä¤Îʸ»ú¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¡£
+;;; bushu-list¤ò»È¤Ã¤Æ¹çÀ®¤Ç¤¤Ê¤¤¾ì¹ç¤Ï#f¡£
+;;; Îã: (((("g" "t" "h")) ("Îó")) ((("G" "I")) ("¥ê")))
+(define (tutcode-auto-help-get-stroke-list-by-subtraction c bushu-list)
+ (and-let*
+ ((mem (member c (caar bushu-list)))
+ (b1 (caadr bushu-list))
+ ;; 2¤Ä¤ÎÉô¼ó¤Î¤¦¤Á¡¢c°Ê³°¤ÎÉô¼ó¤ò¼èÆÀ
+ (b2 (if (= 2 (length mem)) (cadr mem) (car (caar bushu-list))))
+ ;; ¼ÂºÝ¤ËÉô¼ó¹çÀ®¤·¤Æ¡¢ÂоÝʸ»ú¤¬¹çÀ®¤µ¤ì¤Ê¤¤¤â¤Î¤ÏÂÌÌÜ
+ (composed (tutcode-bushu-convert b1 b2))
+ (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)))))
+
;;; rule¤òµÕ°ú¤¤·¤Æ¡¢ÊÑ´¹¸å¤Îʸ»ú¤«¤é¡¢ÆþÎÏ¥¡¼Îó¤ò¼èÆÀ¤¹¤ë¡£
;;; Îã: (tutcode-reverse-find-seq tutcode-rule "¤¢") => ("r" "k")
;;; @param rule rk¤Ç»È¤¦·Á¼°¤Îrule
