Revision: 6477
Author: deton.kih
Date: Sat Jun 26 20:34:41 2010
Log: * scm/tutcode.scm
- (tutcode-heading-label-char-list-for-stroke-help): Remove
- (tutcode-check-stroke-help-window-begin):
Rewrite to use rk-lib-find-partial-seqs
- (tutcode-check-auto-help-window-begin):
Add null check of label-cands-alist before map
http://code.google.com/p/uim/source/detail?r=6477
Modified:
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode.scm Fri Jun 25 21:13:30 2010
+++ /trunk/scm/tutcode.scm Sat Jun 26 20:34:41 2010
@@ -148,13 +148,6 @@
"U" "V" "W" "X" "Y" "Z"
"=" "~" "|" "`" "{" "+" "*" "}" "<" ">" "?" "_"))
-;;; ¥¹¥È¥í¡¼¥¯É½¤Î¥¡¼¥ê¥¹¥È
-(define tutcode-heading-label-char-list-for-stroke-help
- '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0"
- "q" "w" "e" "r" "t" "y" "u" "i" "o" "p"
- "a" "s" "d" "f" "g" "h" "j" "k" "l" ";"
- "z" "x" "c" "v" "b" "n" "m" "," "." "/"))
-
;;; ¼«Æ°¥Ø¥ë¥×¤Ç¤Îʸ»ú¤ÎÂǤÁÊýɽ¼¨¤ÎºÝ¤Ë¸õÊäʸ»úÎó¤È¤·¤Æ»È¤¦Ê¸»ú¤Î¥ê¥¹¥È
(define tutcode-auto-help-cand-str-list
; Âè1,2,3,4ÂǸ°¤ò¼¨¤¹Ê¸»ú
@@ -549,43 +542,43 @@
'tutcode-candidate-window-off)
tutcode-use-stroke-help-window?)
(let* ((rkc (tutcode-context-rk-context pc))
- (seq (rk-context-seq rkc)))
- (tutcode-context-set-stroke-help! pc
- ; rk-expect¤Î³Æ¥á¥ó¥Ð¤Ë¤Ä¤¤¤Æ¡¢
- ; rk-lib-find-seq¤·¤Æ¡¢labelʸ»ú¤È¸õÊä¤Î¥ê¥¹¥È¤òºîÀ®¡£
- ; #f¤Î¾ì¹ç¤Ï¥¹¥È¥í¡¼¥¯ÅÓÃæ¤Ê¤Î¤Ç¸õÊä¤È¤·¤Æ¢¢¤ò»ÈÍÑ¡£
- (map
- (lambda (elem)
- (let* ((res
- (rk-lib-find-seq (reverse (cons elem seq))
tutcode-rule))
- (candlist (and res (cadr res)))
- (cand
- (if res
- (or
- (and (tutcode-context-katakana-mode? pc)
- (not (null? (cdr candlist)))
- (cadr candlist))
- (car candlist))
- "¢¢"))
- (candstr
- (case cand
- ((tutcode-mazegaki-start) "¡þ")
- ((tutcode-bushu-start) "¢¡")
- (else cand)))
- (labeledcand
- (list candstr elem "")))
- labeledcand))
- (filter
- (lambda (elem)
- (member elem
tutcode-heading-label-char-list-for-stroke-help))
- (delete-duplicates (rk-expect rkc)))))
- (if (not (null? (tutcode-context-stroke-help pc)))
- (begin
+ (seq (rk-context-seq rkc))
+ (seqlen (length seq))
+ (ret (rk-lib-find-partial-seqs (reverse seq) tutcode-rule))
+ (label-cand-alist ())) ; Îã:(("k" "¤¢") ("i" "¤¤") ("v" "¢¢"))
+ (for-each
+ (lambda (elem) ; Îã: ((("r" "v" "y")) ("±î"))
+ (let* ((label (nth seqlen (caar elem)))
+ (candlist (cadr elem))
+ (cand
+ (or
+ (and (not (null? (cdr candlist)))
+ (tutcode-context-katakana-mode? pc)
+ (cadr candlist))
+ (car candlist)))
+ (candstr
+ (case cand
+ ((tutcode-mazegaki-start) "¡þ")
+ ((tutcode-bushu-start) "¢¡")
+ (else cand)))
+ (label-cand (assoc label label-cand-alist)))
+ (if label-cand
+ (set-cdr! label-cand
(list "¢¢")) ;Ʊ°ìÂǸ°¤Î¾¤Î¸õÊäÍ¢ªÂǸ°ÅÓÃæ
+ (set! label-cand-alist
+ (cons (list label candstr) label-cand-alist)))))
+ ret)
+ (if (not (null? label-cand-alist))
+ (let
+ ((stroke-help
+ (map
+ (lambda (elem)
+ (list (cadr elem) (car elem) ""))
+ label-cand-alist)))
+ (tutcode-context-set-stroke-help! pc stroke-help)
(tutcode-context-set-candidate-window! pc
'tutcode-candidate-window-stroke-help)
(im-activate-candidate-selector pc
- (length (tutcode-context-stroke-help pc))
- (length tutcode-heading-label-char-list-for-stroke-help)))))))
+ (length stroke-help) (length stroke-help)))))))
;;; Éô¼ó¹çÀ®ÊÑ´¹¡¦¸ò¤¼½ñ¤ÊÑ´¹¤Ç³ÎÄꤷ¤¿Ê¸»ú¤ÎÂǤÁÊý¤òɽ¼¨¤¹¤ë¡£
;;; ɽ·Á¼°¤Î¸õÊ䥦¥£¥ó¥É¥¦¤òÁÛÄꤷ¤Æ¡¢°Ê²¼¤Î¤è¤¦¤Ëɽ¼¨¤¹¤ë¡£
@@ -628,18 +621,18 @@
(help-one kanji (car cand-str-list))
(set! cand-str-list (cdr cand-str-list)))))
(lset-difference string=? (reverse strlist) yomilist))
- (tutcode-context-set-stroke-help! pc
- (map
- (lambda (elem)
- (list (tutcode-make-string (cdr elem)) (car elem) ""))
- label-cands-alist))
- (if (not (null? (tutcode-context-stroke-help pc)))
- (begin
+ (if (not (null? label-cands-alist))
+ (let
+ ((stroke-help
+ (map
+ (lambda (elem)
+ (list (tutcode-make-string (cdr elem)) (car elem) ""))
+ label-cands-alist)))
+ (tutcode-context-set-stroke-help! pc stroke-help)
(tutcode-context-set-candidate-window! pc
'tutcode-candidate-window-auto-help)
(im-activate-candidate-selector pc
- (length (tutcode-context-stroke-help pc))
- (length tutcode-heading-label-char-list-for-stroke-help)))))))
+ (length stroke-help) (length stroke-help)))))))
;;; preeditɽ¼¨¤ò¹¹¿·¤¹¤ë¡£
;;; @param pc ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
