Revision: 6817
Author: deton.kih
Date: Sun Nov 14 02:09:39 2010
Log: * Change usage of guide variable not to mix
for completion/prediction and stroke help.
* scm/tutcode.scm
- (tutcode-context-rec-spec): Add guide-chars variable
for guide on stroke-help (split from guide variable).
- (tutcode-guide-set-candidates):
Follow the change of tutcode-guide-update-alist.
- (tutcode-guide-update-alist):
Change content of argument.
Change to use tutcode-auto-help-update-stroke-alist-with-key
instead of tutcode-guide-update-alist-with-stroke.
- (tutcode-guide-update-alist-with-stroke): Remove.
- (tutcode-check-stroke-help-window-begin): Rewrite to use guide-chars.
- (tutcode-stroke-help-guide-add-kanji): Rewrite to use guide-chars.
- (tutcode-stroke-help-guide-update-alist,
tutcode-stroke-help-guide-update-alist-with-rule): New function.
- (tutcode-check-auto-help-window-begin): Change to use guide-chars.
- (tutcode-auto-help-update-stroke-alist-with-kanji):
Change to update guide-chars if tutcode-use-stroke-help-window? is #f
to show guide when stroke help is enabled after some keys typed.
- (tutcode-auto-help-update-stroke-alist-normal-with-kanji): Ditto.
- (tutcode-get-candidate-handler):
Follow the structure change of guide variable.
http://code.google.com/p/uim/source/detail?r=6817
Modified:
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode.scm Sat Nov 13 16:01:52 2010
+++ /trunk/scm/tutcode.scm Sun Nov 14 02:09:39 2010
@@ -531,11 +531,14 @@
(prediction-page-limit
(+ tutcode-nr-candidate-max-for-prediction
tutcode-nr-candidate-max-for-guide))
- ;;; ½Ï¸ì¥¬¥¤¥É¡£
- ;;; ͽ¬¤µ¤ì¤ë¼¡¤ÎÆþÎÏ´Á»ú¤ÎÂè1ÂǸ°¤ÈÆþÎÏ´Á»ú¤ÎÂбþ¤Î¥ê¥¹¥È
- ;;; ((<Âè1ÂǸ°1> (<ÆþÎÏ´Á»ú11>
(<ÆþÎÏ´Á»ú1¤Î¥¹¥È¥í¡¼¥¯¥ê¥¹¥È>)) ...) ...)
- ;;; Îã: (("," ("ÀÐ" ("," "r"))) ("u" ("²°" ("u" "c")) ("ÃÓ"
("u" "v"))))
+ ;;; ½Ï¸ì¥¬¥¤¥É¡£Êä´°/ͽ¬ÆþÎÏ»þ¤Îɽ¼¨ÍÑ¡£
+ ;;; ͽ¬¤µ¤ì¤ë¼¡¤ÎÆþÎÏ´Á»ú¤ÎÂè1ÂǸ°¤ÈÆþÎÏ´Á»ú¤ÎÂбþ¤Î¥ê¥¹¥È¡£
+ ;;; Îã: (("," "ÀÐ") ("u" "²°" "ÃÓ"))
(guide ())
+ ;;; ½Ï¸ì¥¬¥¤¥ÉºîÀ®¸µ¥Ç¡¼¥¿¡£²¾ÁÛ¸°È×(stroke-help)¤Ø¤Î¥¬¥¤¥Éɽ¼¨ÍÑ¡£
+ ;;; ʸ»ú¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È(rk-lib-find-partial-seqsÍÑ·Á¼°)¡£
+ ;;; Îã: (((("," "r"))("ÀÐ")) ((("u" "c"))("²°")) ((("u" "v"))("ÃÓ")))
+ (guide-chars ())
)))
(define (tutcode-predict pc str)
@@ -670,54 +673,37 @@
(cand-stroke
(map
(lambda (elem)
- (list elem (tutcode-reverse-find-seq elem)))
+ (list (list (tutcode-reverse-find-seq elem)) (list elem)))
candchars))
+ (filtered-cand-stroke
+ (filter
+ (lambda (elem)
+ (pair? (caar elem))) ; ¥³¡¼¥Éɽ¤Ë̵¤¤³°»ú¤Ï½ü¤¯
+ cand-stroke))
(label-cands-alist
- (tutcode-guide-update-alist () cand-stroke)))
- (tutcode-context-set-guide! pc label-cands-alist)))
-
-;;; ½Ï¸ì¥¬¥¤¥É¤Îɽ¼¨¤Ë»È¤¦alist¤Ë´Á»ú¤òÄɲ乤롣
-;;; @param kanji-stroke Äɲ乤ë´Á»ú¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¡£
-;;; Îã: ("ÀÐ" ("," "r"))
-(define (tutcode-guide-add-kanji pc kanji-stroke)
- (let ((alist (tutcode-context-guide pc)))
- (tutcode-context-set-guide! pc
- (tutcode-guide-update-alist alist (list kanji-stroke)))))
+ (tutcode-guide-update-alist () filtered-cand-stroke)))
+ (tutcode-context-set-guide! pc label-cands-alist)
+ (tutcode-context-set-guide-chars! pc filtered-cand-stroke)))
;;; ½Ï¸ì¥¬¥¤¥É¤Îɽ¼¨¤Ë»È¤¦alist¤ò¹¹¿·¤¹¤ë¡£
-;;; alist¤Ï°Ê²¼¤Î¤è¤¦¤Ë¥é¥Ù¥ëʸ»ú¤È¡¢´Á»ú¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¡£
-;;; Îã: (("," ("ÀÐ" ("," "r"))) ("u" ("²°" ("u" "c")) ("ÃÓ" ("u" "v"))))
+;;; alist¤Ï°Ê²¼¤Î¤è¤¦¤Ë¥é¥Ù¥ëʸ»ú¤È´Á»ú¤Î¥ê¥¹¥È¡£
+;;; Îã: (("," "ÀÐ") ("u" "²°" "ÃÓ"))
;;; @param label-cands-alist ¸µ¤Îalist
;;; @param kanji-list ´Á»ú¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È
-;;; Îã: (("ÀÐ" ("," "r")) ("²°" ("u" "c")) ("ÃÓ" ("u" "v")))
+;;; Îã: (((("," "r"))("ÀÐ")) ((("u" "c"))("²°")) ((("u" "v"))("ÃÓ")))
;;; @return ¹¹¿·¸å¤Î½Ï¸ì¥¬¥¤¥ÉÍÑalist
(define (tutcode-guide-update-alist label-cands-alist kanji-list)
(if (null? kanji-list)
label-cands-alist
(let*
((kanji-stroke (car kanji-list))
- (stroke (cadr kanji-stroke)))
+ (kanji (caadr kanji-stroke))
+ (stroke (caar kanji-stroke)))
(tutcode-guide-update-alist
- (if (or (not stroke) (null? stroke))
- label-cands-alist
- (tutcode-guide-update-alist-with-stroke
- label-cands-alist kanji-stroke))
+ (tutcode-auto-help-update-stroke-alist-with-key label-cands-alist
+ kanji (car stroke))
(cdr kanji-list)))))
-;;; ½Ï¸ì¥¬¥¤¥É:ÂоݤÎ1ʸ»ú¤ò¡¢½Ï¸ì¥¬¥¤¥ÉÍÑalist¤ËÄɲ乤롣
-;;; @param label-cands-alist ¸µ¤Îalist
-;;; @param cand-stroke ÂоÝʸ»ú¤È¥¹¥È¥í¡¼¥¯
-;;; @return ¹¹¿·¸å¤Î½Ï¸ì¥¬¥¤¥Éalist
-(define (tutcode-guide-update-alist-with-stroke label-cands-alist
cand-stroke)
- (let*
- ((label (car (cadr cand-stroke)))
- (label-cand (assoc label label-cands-alist)))
- (if label-cand
- (begin
- (set-cdr! label-cand (cons cand-stroke (cdr label-cand)))
- label-cands-alist)
- (cons (list label cand-stroke) label-cands-alist))))
-
(define-record 'tutcode-context tutcode-context-rec-spec)
(define tutcode-context-new-internal tutcode-context-new)
(define tutcode-context-katakana-mode? tutcode-context-katakana-mode)
@@ -1197,39 +1183,17 @@
(tutcode-stroke-help-update-alist () seqlen katakana? ret))))
;; ½Ï¸ì¥¬¥¤¥É¤ä¼«Æ°¥Ø¥ë¥×¤«¤é¤Î³¤¤Ç¡¢ÆþÎϸõÊäʸ»ú¤Ë¥Þ¡¼¥¯¤òÉÕ¤±¤ë
(if (and (pair? seq)
- (pair? (tutcode-context-guide pc)))
+ (pair? (tutcode-context-guide-chars pc)))
(let*
- ((prevkey (car seq))
- (guide (assoc prevkey (tutcode-context-guide pc)))
- (nextguide
- (if (not guide)
- ()
- (tutcode-guide-update-alist ()
- (map
- (lambda (elem)
- ;; elem¤Îstroke¤«¤éºÇ½é¤Î¥¡¼¤òºï½ü
- ;; Îã: ("²°" ("u" "c")) -> ("²°" ("c"))
- (list (car elem) (cdr (cadr elem))))
- (cdr guide)))))
- (nextguide-candcombined
- ;; Îã:(("u" ("²°" ("u" "c")) ("ÃÓ" ("u" "v")))) ->
(("u" "+ÃÓ²°"))
+ ((guide-rule (tutcode-context-guide-chars pc))
+ (ret (rk-lib-find-partial-seqs (reverse seq) guide-rule))
+ (guide-alist (tutcode-stroke-help-guide-update-alist () seqlen
ret))
+ ;; Îã:(("," "ÀÐ") ("u" "+ÃÓ²°"))
+ (guide-candcombined
(map
(lambda (elem)
- (let*
- ((cands
- (map
- (lambda (e)
- (car e))
- (cdr elem)))
- (last? (= 1 (length (cadr (cadr elem)))))
- (candlist
- (if last?
- (cons tutcode-guide-end-mark cands)
- (append cands (list tutcode-guide-mark))))
- (combined (tutcode-make-string candlist)))
- (list (car elem) combined)))
- nextguide)))
- (tutcode-context-set-guide! pc nextguide)
+ (list (car elem) (tutcode-make-string (cdr elem))))
+ guide-alist)))
;; ɽ¼¨¤¹¤ë¸õÊäʸ»úÎó¤ò¡¢½Ï¸ì¥¬¥¤¥É(+)Éդʸ»úÎó¤ËÃÖ¤´¹¤¨¤ë
(for-each
(lambda (elem)
@@ -1238,7 +1202,7 @@
(label-cand (assoc label label-cand-alist)))
(if label-cand
(set-cdr! label-cand (cdr elem)))))
- nextguide-candcombined)))
+ guide-candcombined)))
(if (not (null? label-cand-alist))
(let
((stroke-help
@@ -1317,6 +1281,52 @@
candstr)))
(cons (list label cand-hint) label-cand-alist)))))
+;;; ²¾ÁÛ¸°È×¾å¤Î½Ï¸ì¥¬¥¤¥É¤Îɽ¼¨¤Ë»È¤¦alist¤Ë´Á»ú¤òÄɲ乤롣
+;;; @param kanji-stroke Äɲ乤ë´Á»ú¤È¥¹¥È¥í¡¼¥¯¤Î¥ê¥¹¥È¡£
+;;; Îã: ((("," "r"))("ÀÐ"))
+(define (tutcode-stroke-help-guide-add-kanji pc kanji-stroke)
+ (let ((chars (tutcode-context-guide-chars pc)))
+ (if (not (member kanji-stroke chars))
+ (tutcode-context-set-guide-chars! pc (cons kanji-stroke chars)))))
+
+;;; ²¾ÁÛ¸°È×¾å¤Î½Ï¸ì¥¬¥¤¥É¤Îɽ¼¨¤Ë»È¤¦alist¤ò¹¹¿·¤¹¤ë¡£
+;;; alist¤Ï°Ê²¼¤Î¤è¤¦¤Ë¥é¥Ù¥ëʸ»ú¤Èɽ¼¨ÍÑʸ»úÎó¤Î¥ê¥¹¥È¡£
+;;; Îã: (("," "ÀÐ") ("u" "+ÃÓ²°"))
+;;; @param label-cands-alist ¸µ¤Îalist
+;;; @param seqlen ²¿ÈÖÌܤΥ¹¥È¥í¡¼¥¯¤òÂоݤȤ¹¤ë¤«¡£
+;;; @param rule-list rk-rule¡£
+;;; @return ¹¹¿·¸å¤Î½Ï¸ì¥¬¥¤¥ÉÍÑalist
+(define (tutcode-stroke-help-guide-update-alist
+ label-cands-alist seqlen rule-list)
+ (if (null? rule-list)
+ label-cands-alist
+ (tutcode-stroke-help-guide-update-alist
+ (tutcode-stroke-help-guide-update-alist-with-rule
+ label-cands-alist seqlen (car rule-list))
+ seqlen (cdr rule-list))))
+
+;;; ²¾ÁÛ¸°È×¾å¤Î½Ï¸ì¥¬¥¤¥É:ÂоݤÎ1ʸ»ú¤ò¡¢½Ï¸ì¥¬¥¤¥ÉÍÑalist¤ËÄɲ乤롣
+;;; @param label-cands-alist ¸µ¤Îalist
+;;; @param seqlen ²¿ÈÖÌܤΥ¹¥È¥í¡¼¥¯¤òÂоݤȤ¹¤ë¤«¡£
+;;; @param rule rk-ruleÆâ¤Î°ì¤Ä¤Îrule¡£
+;;; @return ¹¹¿·¸å¤Î½Ï¸ì¥¬¥¤¥Éalist
+(define (tutcode-stroke-help-guide-update-alist-with-rule
+ label-cands-alist seqlen rule)
+ (let* ((label (list-ref (caar rule) seqlen))
+ (label-cand (assoc label label-cands-alist))
+ (has-next? (> (length (caar rule)) (+ seqlen 1))) ;
¥·¡¼¥±¥ó¥¹ÅÓÃæ?
+ (cand (car (cadr rule))))
+ (if label-cand
+ (begin
+ ;; ´û¤Ë³äÅö¤Æ¤é¤ì¤Æ¤¿¤é·ë¹ç
+ (set-cdr! label-cand (cons cand (cdr label-cand)))
+ label-cands-alist)
+ (cons
+ (if has-next?
+ (list label cand tutcode-guide-mark)
+ (list label tutcode-guide-end-mark cand))
+ label-cands-alist))))
+
;;; Éô¼ó¹çÀ®ÊÑ´¹¡¦¸ò¤¼½ñ¤ÊÑ´¹¤Ç³ÎÄꤷ¤¿Ê¸»ú¤ÎÂǤÁÊý¤òɽ¼¨¤¹¤ë¡£
;;; ɽ·Á¼°¤Î¸õÊ䥦¥£¥ó¥É¥¦¤Î¾ì¹ç¤Ï¡¢°Ê²¼¤Î¤è¤¦¤Ëɽ¼¨¤¹¤ë¡£
;;; 1¤¬Âè1ÂǸ°¡¢2¤¬Âè2ÂǸ°¡£¡Ö·È¡×
@@ -1352,7 +1362,7 @@
'tutcode-candidate-window-off)
tutcode-use-auto-help-window?)
(begin
- (tutcode-context-set-guide! pc ())
+ (tutcode-context-set-guide-chars! pc ())
(let*
((helpstrlist (lset-difference string=? (reverse strlist)
yomilist))
(label-cands-alist
@@ -1378,7 +1388,7 @@
;;; ¼«Æ°¥Ø¥ë¥×¤Îɽ·Á¼°É½¼¨¤Ë»È¤¦alist¤ò¹¹¿·¤¹¤ë¡£
;;;
alist¤Ï°Ê²¼¤Î¤è¤¦¤ËÂǸ°¤ò¼¨¤¹¥é¥Ù¥ëʸ»ú¤È¡¢³ºÅö¥»¥ë¤Ëɽ¼¨¤¹¤ëʸ»úÎó¤Î¥ê¥¹¥È
-;;; Îã:(("y" "2" "1") ("t" "3")) ; ("y" "y" "t")¤È¤¤¤¦¥¹¥È¥í¡¼¥¯¤ò¸½¤¹¡£
+;;; Îã:(("y" "2" "1") ("t" "3")) ; ("y" "y" "t")¤È¤¤¤¦¥¹¥È¥í¡¼¥¯¤òɽ¤¹¡£
;;; ¡¦¡¦¡¦¡¦ ¡¦¡¦¡¦¡¦
;;; ¡¦¡¦¡¦¡¦3 12¡¦¡¦¡¦¡¦
;;; ¡¦¡¦¡¦¡¦ ¡¦¡¦¡¦¡¦
@@ -1423,8 +1433,8 @@
(let ((stroke (tutcode-reverse-find-seq kanji)))
(if stroke
(begin
- (if tutcode-use-stroke-help-window?
- (tutcode-guide-add-kanji pc (list kanji stroke)))
+ (tutcode-stroke-help-guide-add-kanji
+ pc (list (list stroke) (list kanji)))
(tutcode-auto-help-update-stroke-alist-with-stroke
label-cands-alist
(cons (string-append (caar cand-list) "(" kanji ")") (cdar
cand-list))
@@ -1434,12 +1444,8 @@
(if (not decomposed)
label-cands-alist
(begin
- (if tutcode-use-stroke-help-window?
- (begin
- (tutcode-guide-add-kanji pc
- (list (caar (cdar decomposed)) (caaar decomposed)))
- (tutcode-guide-add-kanji pc
- (list (caar (cdadr decomposed)) (caaadr decomposed)))))
+ (tutcode-stroke-help-guide-add-kanji pc (car decomposed))
+ (tutcode-stroke-help-guide-add-kanji pc (cadr decomposed))
(tutcode-auto-help-update-stroke-alist-with-stroke
(tutcode-auto-help-update-stroke-alist-with-stroke
label-cands-alist
@@ -1459,8 +1465,8 @@
(let ((stroke (tutcode-reverse-find-seq kanji)))
(if stroke
(begin
- (if tutcode-use-stroke-help-window?
- (tutcode-guide-add-kanji pc (list kanji stroke)))
+ (tutcode-stroke-help-guide-add-kanji
+ pc (list (list stroke) (list kanji)))
(tutcode-auto-help-update-stroke-alist-normal-with-stroke
label-cands-alist
(cons (string-append kanji " ") stroke)
@@ -1470,12 +1476,8 @@
(if (not decomposed)
label-cands-alist
(begin
- (if tutcode-use-stroke-help-window?
- (begin
- (tutcode-guide-add-kanji pc
- (list (caar (cdar decomposed)) (caaar decomposed)))
- (tutcode-guide-add-kanji pc
- (list (caar (cdadr decomposed)) (caaadr decomposed)))))
+ (tutcode-stroke-help-guide-add-kanji pc (car decomposed))
+ (tutcode-stroke-help-guide-add-kanji pc (cadr decomposed))
(tutcode-auto-help-update-stroke-alist-normal-with-stroke
label-cands-alist
(cons
@@ -2757,11 +2759,7 @@
(n (remainder guide-idx guide-len))
(label-cands-alist (nth n guide))
(label (car label-cands-alist))
- (cands
- (map
- (lambda (elem)
- (car elem))
- (cdr label-cands-alist)))
+ (cands (cdr label-cands-alist))
(cand
(tutcode-make-string
(append cands (list tutcode-guide-mark)))))
