Revision: 7377
Author: deton.kih
Date: Thu Dec 1 03:00:28 2011
Log: * Add sequence to kanji conversion on clipboard.
* scm/tutcode-key-custom.scm
- (tutcode-clipboard-seq2kanji-start-sequence): New custom.
* scm/tutcode.scm
- (tutcode-stroke-help-update-alist-with-rule):
Add label for sequence to kanji conversion on clipboard.
- (tutcode-help-clipboard):
Follow the change of tutcode-clipboard-acquire-text.
- (tutcode-begin-clipboard-seq2kanji-conversion): New.
- (tutcode-clipboard-acquire-text-wo-nl):
New function extracted from tutcode-clipboard-acquire-text.
- (tutcode-clipboard-acquire-text):
Extract deletion of "\n" to tutcode-clipboard-acquire-text-wo-nl.
- (tutcode-proc-state-on):
Follow the change of tutcode-clipboard-acquire-text.
Add check of sequence to kanji conversion on clipboard.
- (tutcode-proc-state-yomi):
Follow the change of tutcode-clipboard-acquire-text.
- (tutcode-proc-state-code): Ditto.
- (tutcode-proc-state-bushu): Ditto.
- (tutcode-proc-state-interactive-bushu): Ditto.
- (tutcode-custom-set-mazegaki/bushu-start-sequence!):
Add start sequence of sequence to kanji conversion on clipboard.
http://code.google.com/p/uim/source/detail?r=7377
Modified:
/trunk/scm/tutcode-key-custom.scm
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode-key-custom.scm Tue Nov 22 13:59:29 2011
+++ /trunk/scm/tutcode-key-custom.scm Thu Dec 1 03:00:28 2011
@@ -189,6 +189,12 @@
(N_ "[TUT-Code] paste from clipboard")
(N_ "long description will be here"))
+(define-custom 'tutcode-clipboard-seq2kanji-start-sequence ""
+ '(tutcode-keys1)
+ '(string ".*")
+ (N_ "[TUT-Code] sequence to kanji conversion on clipboard")
+ (N_ "long description will be here"))
+
(define-custom 'tutcode-selection-mazegaki-start-sequence ""
'(tutcode-keys1)
'(string ".*")
=======================================
--- /trunk/scm/tutcode.scm Thu Nov 24 20:02:36 2011
+++ /trunk/scm/tutcode.scm Thu Dec 1 03:00:28 2011
@@ -2015,6 +2015,7 @@
((tutcode-postfix-kanji2seq-8-start) "/8")
((tutcode-postfix-kanji2seq-9-start) "/9")
((tutcode-selection-seq2kanji-start) "´Ás")
+ ((tutcode-clipboard-seq2kanji-start) "´Ác")
((tutcode-postfix-seq2kanji-start) "´Á@")
((tutcode-postfix-seq2kanji-1-start) "´Á1")
((tutcode-postfix-seq2kanji-2-start) "´Á2")
@@ -2174,10 +2175,26 @@
(define (tutcode-help-clipboard pc)
(let*
((len (length tutcode-auto-help-cand-str-list))
- (latter-seq (tutcode-clipboard-acquire-text pc len)))
+ (latter-seq (tutcode-clipboard-acquire-text-wo-nl pc len)))
(if (pair? latter-seq)
(tutcode-check-auto-help-window-begin pc latter-seq () #t))))
+;;; clipboard¤ËÂФ·¤ÆÆþÎÏ¥·¡¼¥±¥ó¥¹¢ª´Á»úÊÑ´¹¤ò³«»Ï¤¹¤ë
+(define (tutcode-begin-clipboard-seq2kanji-conversion pc)
+ (let ((lst (tutcode-clipboard-acquire-text pc 'full)))
+ (if (pair? lst)
+ (let ((str (string-list-concat (tutcode-sequence->kanji-list pc
lst))))
+ (tutcode-commit pc str)
+ (tutcode-undo-prepare pc 'tutcode-state-off str ())))))
+
+;;; ¥¯¥ê¥Ã¥×¥Ü¡¼¥É¤«¤éʸ»úÎó¤ò²þ¹Ô¤ò½ü¤¤¤Æ¼èÆÀ¤¹¤ë
+;;; @param len ¼èÆÀ¤¹¤ëʸ»ú¿ô
+;;; @return ¼èÆÀ¤·¤¿Ê¸»úÎó¤Î¥ê¥¹¥È(µÕ½ç)
+(define (tutcode-clipboard-acquire-text-wo-nl pc len)
+ (let ((latter-seq (tutcode-clipboard-acquire-text pc len)))
+ (and (pair? latter-seq)
+ (delete "\n" latter-seq))))
+
;;; surrounding text API¤ò»È¤Ã¤Æ¥¯¥ê¥Ã¥×¥Ü¡¼¥É¤«¤éʸ»ú¤ò¼èÆÀ
;;; @param len ¼èÆÀ¤¹¤ëʸ»ú¿ô
;;; @return ¼èÆÀ¤·¤¿Ê¸»úÎó¤Î¥ê¥¹¥È(µÕ½ç)¡£¼èÆÀ¤Ç¤¤Ê¤¤¾ì¹ç¤Ï#f
@@ -2185,10 +2202,9 @@
(and-let*
((ustr (im-acquire-text pc 'clipboard 'beginning 0 len))
(latter (ustr-latter-seq ustr))
- (latter-seq (and (pair? latter) (string-to-list (car latter))))
- (latter-seq-wo-nl (delete "\n" latter-seq)))
- (and (not (null? latter-seq-wo-nl))
- latter-seq-wo-nl)))
+ (latter-seq (and (pair? latter) (string-to-list (car latter)))))
+ (and (not (null? latter-seq))
+ latter-seq)))
;;; ¼«Æ°¥Ø¥ë¥×¤Îɽ·Á¼°É½¼¨¤Ë»È¤¦alist¤ò¹¹¿·¤¹¤ë¡£
;;;
alist¤Ï°Ê²¼¤Î¤è¤¦¤ËÂǸ°¤ò¼¨¤¹¥é¥Ù¥ëʸ»ú¤È¡¢³ºÅö¥»¥ë¤Ëɽ¼¨¤¹¤ëʸ»úÎó¤Î¥ê¥¹¥È
@@ -2942,7 +2958,7 @@
(tutcode-check-completion pc #t 0)))
((and (tutcode-paste-key? key key-state)
(pair? (tutcode-context-parent-context pc)))
- (let ((latter-seq (tutcode-clipboard-acquire-text pc 'full)))
+ (let ((latter-seq (tutcode-clipboard-acquire-text-wo-nl
pc 'full)))
(if (pair? latter-seq)
(tutcode-commit pc (string-list-concat latter-seq)))))
((or
@@ -3119,6 +3135,8 @@
(tutcode-begin-selection-kanji2seq-conversion pc))
((eq? res 'tutcode-selection-seq2kanji-start)
(tutcode-begin-selection-seq2kanji-conversion pc))
+ ((eq? res 'tutcode-clipboard-seq2kanji-start)
+ (tutcode-begin-clipboard-seq2kanji-conversion pc))
((eq? res 'tutcode-history-start)
(tutcode-begin-history pc))
((eq? res 'tutcode-undo)
@@ -4184,7 +4202,7 @@
((tutcode-katakana-commit-key? key key-state)
(katakana-commit))
((tutcode-paste-key? key key-state)
- (let ((latter-seq (tutcode-clipboard-acquire-text pc 'full)))
+ (let ((latter-seq (tutcode-clipboard-acquire-text-wo-nl
pc 'full)))
(if (pair? latter-seq)
(tutcode-context-set-head! pc (append latter-seq head)))))
((symbol? key)
@@ -4317,7 +4335,7 @@
(tutcode-commit pc (string-list-concat head))
(tutcode-flush pc))
((tutcode-paste-key? key key-state)
- (let ((latter-seq (tutcode-clipboard-acquire-text pc 'full)))
+ (let ((latter-seq (tutcode-clipboard-acquire-text-wo-nl pc 'full)))
(if (pair? latter-seq)
(tutcode-context-set-head! pc (append latter-seq head)))))
((symbol? key)
@@ -4413,7 +4431,7 @@
((and predicting? (tutcode-prev-page-key? key key-state))
(tutcode-change-bushu-prediction-page pc #f))
((tutcode-paste-key? key key-state)
- (let ((latter-seq (tutcode-clipboard-acquire-text pc 'full)))
+ (let ((latter-seq (tutcode-clipboard-acquire-text-wo-nl pc 'full)))
(if (pair? latter-seq)
(let* ((head (tutcode-context-head pc))
(paste-res
@@ -4607,7 +4625,7 @@
((tutcode-stroke-help-toggle-key? key key-state)
(tutcode-toggle-stroke-help pc))
((tutcode-paste-key? key key-state)
- (let ((latter-seq (tutcode-clipboard-acquire-text pc 'full)))
+ (let ((latter-seq (tutcode-clipboard-acquire-text-wo-nl
pc 'full)))
(if (pair? latter-seq)
(begin
(tutcode-context-set-head! pc (append latter-seq head))
@@ -6169,6 +6187,8 @@
'(tutcode-selection-kanji2seq-start))
(make-subrule tutcode-selection-seq2kanji-start-sequence
'(tutcode-selection-seq2kanji-start))
+ (make-subrule tutcode-clipboard-seq2kanji-start-sequence
+ '(tutcode-clipboard-seq2kanji-start))
(make-subrule tutcode-postfix-mazegaki-start-sequence
'(tutcode-postfix-mazegaki-start))
(make-subrule tutcode-postfix-mazegaki-1-start-sequence
