Revision: 6840
Author: deton.kih
Date: Mon Dec 27 02:38:39 2010
Log: * scm/tutcode.scm
- Cosmetic change: move context related functions
just after tutcode-context-rec-spec.
http://code.google.com/p/uim/source/detail?r=6840
Modified:
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode.scm Fri Dec 3 16:30:21 2010
+++ /trunk/scm/tutcode.scm Mon Dec 27 02:38:39 2010
@@ -547,6 +547,104 @@
;;; Îã: (((("," "r"))("ÀÐ")) ((("u" "c"))("²°")) ((("u" "v"))("ÃÓ")))
(guide-chars ())
)))
+(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)
+(define (tutcode-context-on? pc)
+ (not (eq? (tutcode-context-state pc) 'tutcode-state-off)))
+
+;;; TUT-Code¤Î¥³¥ó¥Æ¥¥¹¥È¤ò¿·¤·¤¯À¸À®¤¹¤ë¡£
+;;; @return À¸À®¤·¤¿¥³¥ó¥Æ¥¥¹¥È
+(define (tutcode-context-new id im)
+ (if (not tutcode-dic)
+ (if (not (symbol-bound? 'skk-lib-dic-open))
+ (begin
+ (if (symbol-bound? 'uim-notify-info)
+ (uim-notify-info
+ (N_ "libuim-skk.so is not available. Mazegaki conversion is
disabled")))
+ (set! tutcode-use-recursive-learning? #f)
+ (set! tutcode-enable-mazegaki-learning? #f))
+ (begin
+ (set! tutcode-dic (skk-lib-dic-open tutcode-dic-filename
#f "localhost" 0 'unspecified))
+ (if tutcode-use-recursive-learning?
+ (require "tutcode-editor.scm"))
+ (tutcode-read-personal-dictionary))))
+ (let ((tc (tutcode-context-new-internal id im)))
+ (tutcode-context-set-widgets! tc tutcode-widgets)
+ (if (null? tutcode-rule)
+ (begin
+ (tutcode-custom-load-rule! tutcode-rule-filename)
+ (if tutcode-use-dvorak?
+ (begin
+ (set! tutcode-rule (tutcode-rule-qwerty-to-dvorak
tutcode-rule))
+ (set! tutcode-heading-label-char-list-for-prediction
+ tutcode-heading-label-char-list-for-prediction-dvorak)))
+ ;; tutcode-mazegaki/bushu-start-sequence¤Ï¡¢
+ ;;
tutcode-use-dvorak?¤¬¥ª¥ó¤Î¤È¤¤ÏDvorak¤Î¥·¡¼¥±¥ó¥¹¤È¤ß¤Ê¤·¤ÆÈ¿±Ç¡£
+ ;; ¤Ä¤Þ¤ê¡¢rule¤Îqwerty-to-dvorakÊÑ´¹¸å¤ËÈ¿±Ç¤¹¤ë¡£
+ (tutcode-custom-set-mazegaki/bushu-start-sequence!)
+ (tutcode-rule-commit-sequences! tutcode-rule-userconfig)))
+ ;; ɽ·Á¼°¸õÊ䥦¥£¥ó¥É¥¦ÍÑÀßÄê
+ (if (null? tutcode-heading-label-char-list)
+ (if tutcode-use-table-style-candidate-window?
+ (set! tutcode-heading-label-char-list
+ (case tutcode-candidate-window-table-layout
+ ((qwerty-jis) tutcode-table-heading-label-char-list-qwerty-jis)
+ ((qwerty-us) tutcode-table-heading-label-char-list-qwerty-us)
+ ((dvorak) tutcode-table-heading-label-char-list-dvorak)
+ (else tutcode-table-heading-label-char-list)))
+ (set! tutcode-heading-label-char-list
+ tutcode-uim-heading-label-char-list)))
+ (if (null? tutcode-heading-label-char-list-for-kigou-mode)
+ (if tutcode-use-table-style-candidate-window?
+ (begin
+ (set! tutcode-heading-label-char-list-for-kigou-mode
+ tutcode-table-heading-label-char-list-for-kigou-mode)
+ ;; µ¹æÆþÎϥ⡼¥É¤òÁ´³Ñ±Ñ¿ô¥â¡¼¥É¤È¤·¤Æ»È¤¦¤¿¤á¡¢
+ ;; tutcode-heading-label-char-list-for-kigou-mode¤òÁ´³Ñ¤Ë¤·¤Æ
+ ;; tutcode-kigoudic¤ÎÀèƬ¤ËÆþ¤ì¤ë
+ (require "japanese.scm") ; for ja-wide
+ (set! tutcode-kigoudic
+ (append
+ (map (lambda (lst) (list (ja-wide lst)))
+ tutcode-heading-label-char-list-for-kigou-mode)
+ (list-tail tutcode-kigoudic
+ (length tutcode-heading-label-char-list-for-kigou-mode)))))
+ (set! tutcode-heading-label-char-list-for-kigou-mode
+ tutcode-uim-heading-label-char-list-for-kigou-mode)))
+ (tutcode-context-set-rk-context! tc (rk-context-new tutcode-rule #t
#f))
+ (if tutcode-use-recursive-learning?
+ (tutcode-context-set-editor! tc (tutcode-editor-new tc)))
+ (tutcode-context-set-dialog! tc (tutcode-dialog-new tc))
+ (if (or tutcode-use-completion? tutcode-use-prediction?)
+ (begin
+ (tutcode-context-set-prediction-ctx! tc (predict-make-meta-search))
+ (predict-meta-open (tutcode-context-prediction-ctx tc) "tutcode")
+ (predict-meta-set-external-charset!
(tutcode-context-prediction-ctx tc) "EUC-JP")))
+ tc))
+
+;;; ¤Ò¤é¤¬¤Ê/¥«¥¿¥«¥Ê¥â¡¼¥É¤ÎÀÚ¤êÂؤ¨¤ò¹Ô¤¦¡£
+;;; ¸½¾õ¤Î¾õÂÖ¤¬¤Ò¤é¤¬¤Ê¥â¡¼¥É¤Î¾ì¹ç¤Ï¥«¥¿¥«¥Ê¥â¡¼¥É¤ËÀÚ¤êÂؤ¨¤ë¡£
+;;; ¸½¾õ¤Î¾õÂÖ¤¬¥«¥¿¥«¥Ê¥â¡¼¥É¤Î¾ì¹ç¤Ï¤Ò¤é¤¬¤Ê¥â¡¼¥É¤ËÀÚ¤êÂؤ¨¤ë¡£
+;;; @param pc ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
+(define (tutcode-context-kana-toggle pc)
+ (let ((s (tutcode-context-katakana-mode? pc)))
+ (tutcode-context-set-katakana-mode! pc (not s))))
+
+;;; º¬¤Ã¤³¤Î¥³¥ó¥Æ¥¥¹¥È¤ò¼èÆÀ¤¹¤ë¡£
+(define (tutcode-find-root-context pc)
+ (let ((ppc (tutcode-context-parent-context pc)))
+ (if (null? ppc)
+ pc
+ (tutcode-find-root-context ppc))))
+
+;;; »ÞÀè¤Î¥³¥ó¥Æ¥¥¹¥È(¸ò¤¼½ñ¤ÊÑ´¹¤ÎºÆµ¢ÅªÅÐÏ¿¤Î°ìÈÖ¿¼¤¤¤È¤³¤í
+;;; =¸½ºßÊÔ½¸Ãæ¤Î¥³¥ó¥Æ¥¥¹¥È)¤ò¼èÆÀ¤¹¤ë¡£
+(define (tutcode-find-descendant-context pc)
+ (let ((cpc (tutcode-context-child-context pc)))
+ (if (null? cpc)
+ pc
+ (tutcode-find-descendant-context cpc))))
(define (tutcode-predict pc str)
(predict-meta-search
@@ -767,105 +865,6 @@
kanji (car stroke))
(cdr kanji-list)))))
-(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)
-(define (tutcode-context-on? pc)
- (not (eq? (tutcode-context-state pc) 'tutcode-state-off)))
-
-;;; TUT-Code¤Î¥³¥ó¥Æ¥¥¹¥È¤ò¿·¤·¤¯À¸À®¤¹¤ë¡£
-;;; @return À¸À®¤·¤¿¥³¥ó¥Æ¥¥¹¥È
-(define (tutcode-context-new id im)
- (if (not tutcode-dic)
- (if (not (symbol-bound? 'skk-lib-dic-open))
- (begin
- (if (symbol-bound? 'uim-notify-info)
- (uim-notify-info
- (N_ "libuim-skk.so is not available. Mazegaki conversion is
disabled")))
- (set! tutcode-use-recursive-learning? #f)
- (set! tutcode-enable-mazegaki-learning? #f))
- (begin
- (set! tutcode-dic (skk-lib-dic-open tutcode-dic-filename
#f "localhost" 0 'unspecified))
- (if tutcode-use-recursive-learning?
- (require "tutcode-editor.scm"))
- (tutcode-read-personal-dictionary))))
- (let ((tc (tutcode-context-new-internal id im)))
- (tutcode-context-set-widgets! tc tutcode-widgets)
- (if (null? tutcode-rule)
- (begin
- (tutcode-custom-load-rule! tutcode-rule-filename)
- (if tutcode-use-dvorak?
- (begin
- (set! tutcode-rule (tutcode-rule-qwerty-to-dvorak
tutcode-rule))
- (set! tutcode-heading-label-char-list-for-prediction
- tutcode-heading-label-char-list-for-prediction-dvorak)))
- ;; tutcode-mazegaki/bushu-start-sequence¤Ï¡¢
- ;;
tutcode-use-dvorak?¤¬¥ª¥ó¤Î¤È¤¤ÏDvorak¤Î¥·¡¼¥±¥ó¥¹¤È¤ß¤Ê¤·¤ÆÈ¿±Ç¡£
- ;; ¤Ä¤Þ¤ê¡¢rule¤Îqwerty-to-dvorakÊÑ´¹¸å¤ËÈ¿±Ç¤¹¤ë¡£
- (tutcode-custom-set-mazegaki/bushu-start-sequence!)
- (tutcode-rule-commit-sequences! tutcode-rule-userconfig)))
- ;; ɽ·Á¼°¸õÊ䥦¥£¥ó¥É¥¦ÍÑÀßÄê
- (if (null? tutcode-heading-label-char-list)
- (if tutcode-use-table-style-candidate-window?
- (set! tutcode-heading-label-char-list
- (case tutcode-candidate-window-table-layout
- ((qwerty-jis) tutcode-table-heading-label-char-list-qwerty-jis)
- ((qwerty-us) tutcode-table-heading-label-char-list-qwerty-us)
- ((dvorak) tutcode-table-heading-label-char-list-dvorak)
- (else tutcode-table-heading-label-char-list)))
- (set! tutcode-heading-label-char-list
- tutcode-uim-heading-label-char-list)))
- (if (null? tutcode-heading-label-char-list-for-kigou-mode)
- (if tutcode-use-table-style-candidate-window?
- (begin
- (set! tutcode-heading-label-char-list-for-kigou-mode
- tutcode-table-heading-label-char-list-for-kigou-mode)
- ;; µ¹æÆþÎϥ⡼¥É¤òÁ´³Ñ±Ñ¿ô¥â¡¼¥É¤È¤·¤Æ»È¤¦¤¿¤á¡¢
- ;; tutcode-heading-label-char-list-for-kigou-mode¤òÁ´³Ñ¤Ë¤·¤Æ
- ;; tutcode-kigoudic¤ÎÀèƬ¤ËÆþ¤ì¤ë
- (require "japanese.scm") ; for ja-wide
- (set! tutcode-kigoudic
- (append
- (map (lambda (lst) (list (ja-wide lst)))
- tutcode-heading-label-char-list-for-kigou-mode)
- (list-tail tutcode-kigoudic
- (length tutcode-heading-label-char-list-for-kigou-mode)))))
- (set! tutcode-heading-label-char-list-for-kigou-mode
- tutcode-uim-heading-label-char-list-for-kigou-mode)))
- (tutcode-context-set-rk-context! tc (rk-context-new tutcode-rule #t
#f))
- (if tutcode-use-recursive-learning?
- (tutcode-context-set-editor! tc (tutcode-editor-new tc)))
- (tutcode-context-set-dialog! tc (tutcode-dialog-new tc))
- (if (or tutcode-use-completion? tutcode-use-prediction?)
- (begin
- (tutcode-context-set-prediction-ctx! tc (predict-make-meta-search))
- (predict-meta-open (tutcode-context-prediction-ctx tc) "tutcode")
- (predict-meta-set-external-charset!
(tutcode-context-prediction-ctx tc) "EUC-JP")))
- tc))
-
-;;; ¤Ò¤é¤¬¤Ê/¥«¥¿¥«¥Ê¥â¡¼¥É¤ÎÀÚ¤êÂؤ¨¤ò¹Ô¤¦¡£
-;;; ¸½¾õ¤Î¾õÂÖ¤¬¤Ò¤é¤¬¤Ê¥â¡¼¥É¤Î¾ì¹ç¤Ï¥«¥¿¥«¥Ê¥â¡¼¥É¤ËÀÚ¤êÂؤ¨¤ë¡£
-;;; ¸½¾õ¤Î¾õÂÖ¤¬¥«¥¿¥«¥Ê¥â¡¼¥É¤Î¾ì¹ç¤Ï¤Ò¤é¤¬¤Ê¥â¡¼¥É¤ËÀÚ¤êÂؤ¨¤ë¡£
-;;; @param pc ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
-(define (tutcode-context-kana-toggle pc)
- (let ((s (tutcode-context-katakana-mode? pc)))
- (tutcode-context-set-katakana-mode! pc (not s))))
-
-;;; º¬¤Ã¤³¤Î¥³¥ó¥Æ¥¥¹¥È¤ò¼èÆÀ¤¹¤ë¡£
-(define (tutcode-find-root-context pc)
- (let ((ppc (tutcode-context-parent-context pc)))
- (if (null? ppc)
- pc
- (tutcode-find-root-context ppc))))
-
-;;; »ÞÀè¤Î¥³¥ó¥Æ¥¥¹¥È(¸ò¤¼½ñ¤ÊÑ´¹¤ÎºÆµ¢ÅªÅÐÏ¿¤Î°ìÈÖ¿¼¤¤¤È¤³¤í
-;;; =¸½ºßÊÔ½¸Ãæ¤Î¥³¥ó¥Æ¥¥¹¥È)¤ò¼èÆÀ¤¹¤ë¡£
-(define (tutcode-find-descendant-context pc)
- (let ((cpc (tutcode-context-child-context pc)))
- (if (null? cpc)
- pc
- (tutcode-find-descendant-context cpc))))
-
;;; ¸ò¤¼½ñ¤ÊÑ´¹ÍѸĿͼ½ñ¤òÆɤ߹þ¤à¡£
(define (tutcode-read-personal-dictionary)
(if (not (setugid?))
