Revision: 6534
Author: deton.kih
Date: Mon Jul 19 00:07:47 2010
Log: * scm/tutcode-custom.scm
- (tutcode-auto-help-with-real-keys?): New variable and hook.
* scm/tutcode.scm
- (tutcode-check-auto-help-window-begin):
Add support for normal candidate window.
- (tutcode-auto-help-update-stroke-alist-normal,
tutcode-auto-help-update-stroke-alist-normal-with-kanji,
tutcode-auto-help-update-stroke-alist-normal-with-stroke): New.
http://code.google.com/p/uim/source/detail?r=6534
Modified:
/trunk/scm/tutcode-custom.scm
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode-custom.scm Sun Jul 18 13:34:09 2010
+++ /trunk/scm/tutcode-custom.scm Mon Jul 19 00:07:47 2010
@@ -138,6 +138,12 @@
(N_ "Use auto help window")
(N_ "long description will be here."))
+(define-custom 'tutcode-auto-help-with-real-keys? #f
+ '(tutcode candwin)
+ '(boolean)
+ (N_ "Show real keys on auto help window")
+ (N_ "long description will be here."))
+
;; activity dependency
(custom-add-hook 'tutcode-candidate-op-count
'custom-activity-hooks
@@ -153,3 +159,8 @@
'custom-activity-hooks
(lambda ()
tutcode-use-candidate-window?))
+
+(custom-add-hook 'tutcode-auto-help-with-real-keys?
+ 'custom-activity-hooks
+ (lambda ()
+ tutcode-use-auto-help-window?))
=======================================
--- /trunk/scm/tutcode.scm Sun Jul 18 17:46:13 2010
+++ /trunk/scm/tutcode.scm Mon Jul 19 00:07:47 2010
@@ -717,7 +717,7 @@
(tutcode-check-stroke-help-window-begin pc))))
;;; Éô¼ó¹çÀ®ÊÑ´¹¡¦¸ò¤¼½ñ¤ÊÑ´¹¤Ç³ÎÄꤷ¤¿Ê¸»ú¤ÎÂǤÁÊý¤òɽ¼¨¤¹¤ë¡£
-;;; ɽ·Á¼°¤Î¸õÊ䥦¥£¥ó¥É¥¦¤òÁÛÄꤷ¤Æ¡¢°Ê²¼¤Î¤è¤¦¤Ëɽ¼¨¤¹¤ë¡£
+;;; ɽ·Á¼°¤Î¸õÊ䥦¥£¥ó¥É¥¦¤Î¾ì¹ç¤Ï¡¢°Ê²¼¤Î¤è¤¦¤Ëɽ¼¨¤¹¤ë¡£
;;; 1¤¬Âè1ÂǸ°¡¢2¤¬Âè2ÂǸ°¡£¡Ö·È¡×
;;; ¡¦¡¦¡¦¡¦ ¡¦¡¦¡¦¡¦
;;; ¡¦¡¦¡¦¡¦ ¡¦¡¦3 ¡¦
@@ -739,18 +739,27 @@
;;; ¨§¨¡¨«¨¡¨«¨¡¨«¨¡¨«¨¡¨© ¨§¨¡¨¡¨¡¨¡¨¡¨«¨¡¨«¨¡¨«¨¡¨«¨¡¨©
;;; ¨¢ ¨¢ ¨¢e ¨¢ ¨¢f ¨¢ ¨¢2a(¢¥ÎÓ´Ì)¨¢ ¨¢ ¨¢ ¨¢ ¨¢
;;; ¨¦¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨¡¨¡¨¡¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨ª¨¡¨¥
+;;;
+;;; Ä̾ï¤Î¸õÊ䥦¥£¥ó¥É¥¦¤Î¾ì¹ç¤Ï¡¢°Ê²¼¤Î¤è¤¦¤Ëɽ¼¨¤¹¤ë¡£
+;;; Í« lns
+;;; ݵ ¢¥ÎÓ´Ì nt cbo
+;;;
;;; @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
- ;; Îã:(("y" "2" "1") ("t" "3"))
- ((label-cands-alist
- (tutcode-auto-help-update-stroke-alist
- () tutcode-auto-help-cand-str-list
- (lset-difference string=? (reverse strlist) yomilist))))
+ (let*
+ ((helpstrlist (lset-difference string=? (reverse strlist) yomilist))
+ (label-cands-alist
+ (if (not tutcode-auto-help-with-real-keys?)
+ ;; ɽ·Á¼°¤Î¾ì¹ç¤ÎÎã:(("y" "2" "1") ("t" "3"))
+ (tutcode-auto-help-update-stroke-alist
+ () tutcode-auto-help-cand-str-list helpstrlist)
+ ;; Ä̾ï¤Î¾ì¹ç¤ÎÎã:(("°Å" "t" "y" "y"))
+ (reverse
+ (tutcode-auto-help-update-stroke-alist-normal ()
helpstrlist)))))
(if (not (null? label-cands-alist))
(let
((stroke-help
@@ -784,6 +793,21 @@
label-cands-alist (car cand-list) (car kanji-list))
(cdr cand-list) (cdr kanji-list))))
+;;; ¼«Æ°¥Ø¥ë¥×¤ÎÄ̾ï·Á¼°É½¼¨¤Ë»È¤¦alist¤ò¹¹¿·¤¹¤ë¡£
+;;; alist¤Ï°Ê²¼¤Î¤è¤¦¤Ëʸ»ú¤È¡¢Ê¸»ú¤òÆþÎϤ¹¤ë¤¿¤á¤Î¥¡¼¤Î¥ê¥¹¥È(µÕ½ç)
+;;; Îã:(("°Å" "t" "y" "y"))
+;;; @param label-cands-alist ¸µ¤Îalist
+;;; @param kanji-list ¥Ø¥ë¥×ɽ¼¨ÂоݤǤ¢¤ë¡¢³ÎÄꤵ¤ì¤¿´Á»ú
+;;; @return ¹¹¿·¸å¤Î¼«Æ°¥Ø¥ë¥×ÍÑalist
+(define (tutcode-auto-help-update-stroke-alist-normal label-cands-alist
+ kanji-list)
+ (if (null? kanji-list)
+ label-cands-alist
+ (tutcode-auto-help-update-stroke-alist-normal
+ (tutcode-auto-help-update-stroke-alist-normal-with-kanji
+ label-cands-alist (car kanji-list))
+ (cdr kanji-list))))
+
;;; ¼«Æ°¥Ø¥ë¥×:ÂоݤÎ1ʸ»ú¤òÆþÎϤ¹¤ë¥¹¥È¥í¡¼¥¯¤ò¥Ø¥ë¥×ÍÑalist¤ËÄɲ乤롣
;;; @param label-cands-alist ¸µ¤Îalist
;;; @param cand-list ¥Ø¥ë¥×ɽ¼¨¤Ë»È¤¦¡¢³ÆÂǸ°¤ò¼¨¤¹Ê¸»ú¤Î¥ê¥¹¥È
@@ -809,6 +833,31 @@
(caaar decomposed)) ; Éô¼ó1
(cadr cand-list) (caaadr decomposed))))))) ; Éô¼ó2
+;;; ¼«Æ°¥Ø¥ë¥×:ÂоݤÎ1ʸ»ú¤òÆþÎϤ¹¤ë¥¹¥È¥í¡¼¥¯¤ò¥Ø¥ë¥×ÍÑalist¤ËÄɲ乤롣
+;;; @param label-cands-alist ¸µ¤Îalist
+;;; @param kanji ¥Ø¥ë¥×ɽ¼¨ÂоÝʸ»ú
+;;; @return ¹¹¿·¸å¤Î¼«Æ°¥Ø¥ë¥×ÍÑalist
+(define (tutcode-auto-help-update-stroke-alist-normal-with-kanji
+ label-cands-alist kanji)
+ (let ((stroke (tutcode-reverse-find-seq kanji)))
+ (if stroke
+ (tutcode-auto-help-update-stroke-alist-normal-with-stroke
+ label-cands-alist stroke kanji)
+ (let ((decomposed (tutcode-auto-help-bushu-decompose kanji)))
+ ;; Îã: "·Ò" => (((("," "o"))("·â")) ((("f" "q"))("»å")))
+ (if (not decomposed)
+ label-cands-alist
+ (tutcode-auto-help-update-stroke-alist-normal-with-stroke
+ label-cands-alist
+ (cons
+ (string-append "¢¥"
+ (caar (cdar decomposed)) (caar (cdadr decomposed)) " ")
+ (append
+ (caaar decomposed) ; Éô¼ó1
+ (list " ")
+ (caaadr decomposed))) ; Éô¼ó2
+ kanji))))))
+
;;; ¼«Æ°¥Ø¥ë¥×:ÂоݤΥ¹¥È¥í¡¼¥¯(¥¡¼¤Î¥ê¥¹¥È)¤ò¥Ø¥ë¥×ÍÑalist¤ËÄɲ乤롣
;;; @param label-cands-alist ¸µ¤Îalist
;;; @param cand-list ¥Ø¥ë¥×ɽ¼¨¤Ë»È¤¦¡¢³ÆÂǸ°¤ò¼¨¤¹Ê¸»ú¤Î¥ê¥¹¥È
@@ -823,6 +872,17 @@
label-cands-alist cand-list (car stroke))
(cdr cand-list) (cdr stroke))))
+;;; ¼«Æ°¥Ø¥ë¥×:ÂоݤΥ¹¥È¥í¡¼¥¯(¥¡¼¤Î¥ê¥¹¥È)¤ò¥Ø¥ë¥×ÍÑalist¤ËÄɲ乤롣
+;;; @param label-cands-alist ¸µ¤Îalist
+;;; @param stroke Âоݥ¹¥È¥í¡¼¥¯
+;;; @param label ³ÎÄꤵ¤ì¤¿´Á»ú
+;;; @return ¹¹¿·¸å¤Î¼«Æ°¥Ø¥ë¥×ÍÑalist
+(define (tutcode-auto-help-update-stroke-alist-normal-with-stroke
+ label-cands-alist stroke label)
+ (let ((label-cand (assoc label label-cands-alist)))
+ (if (not label-cand)
+ (cons (cons label (reverse stroke)) label-cands-alist))))
+
;;; ¼«Æ°¥Ø¥ë¥×:ÂоݤΥ¡¼¤ò¥Ø¥ë¥×ÍÑalist¤ËÄɲ乤롣
;;; @param label-cands-alist ¸µ¤Îalist
;;; @param cand-list ¥Ø¥ë¥×ɽ¼¨¤Ë»È¤¦¡¢³ÆÂǸ°¤ò¼¨¤¹Ê¸»ú¤Î¥ê¥¹¥È
