Revision: 6978
Author: deton.kih
Date: Thu Feb 24 03:17:36 2011
Log: * Add fallback of surrounding text API
which gets former text from internal commit string buffer
and deletes former text by commiting "\b".
* scm/tutcode-custom.scm
- (tutcode-enable-fallback-surrounding-text?): New custom.
* scm/tutcode.scm
- (tutcode-fallback-backspace-string): New variable.
- (tutcode-commit-raw):
Add check of tutcode-enable-fallback-surrounding-text?.
- (tutcode-commit): Ditto.
Add optional argument whether to skip appending to commit-strs.
- (tutcode-proc-state-on):
Change for tutcode-enable-fallback-surrounding-text?.
- (tutcode-postfix-acquire-text):
Change to get commit string from tutcode-context-commit-strs
when im-acquire-text returns #f.
- (tutcode-postfix-delete-text):
Change to commit "\b" and update commit-strs
when im-delete-text returns #f.
http://code.google.com/p/uim/source/detail?r=6978
Modified:
/trunk/scm/tutcode-custom.scm
/trunk/scm/tutcode.scm
=======================================
--- /trunk/scm/tutcode-custom.scm Wed Feb 23 02:48:52 2011
+++ /trunk/scm/tutcode-custom.scm Thu Feb 24 03:17:36 2011
@@ -110,6 +110,12 @@
(N_ "Enable two stroke kigou mode")
(N_ "long description will be here."))
+(define-custom 'tutcode-enable-fallback-surrounding-text? #f
+ '(tutcode)
+ '(boolean)
+ (N_ "Enable fallback of surrounding text API")
+ (N_ "long description will be here."))
+
(define-custom 'tutcode-mazegaki-yomi-max 10
'(tutcode tutcode-mazegaki)
'(integer 1 99)
=======================================
--- /trunk/scm/tutcode.scm Wed Feb 23 02:52:07 2011
+++ /trunk/scm/tutcode.scm Thu Feb 24 03:17:36 2011
@@ -89,6 +89,15 @@
;;; ¤½¤Î¤¿¤á¡¢uim¤Îsurrounding text API¤ò¥µ¥Ý¡¼¥È¤·¤Æ¤¤¤ë¥Ö¥ê¥Ã¥¸
;;; (uim-gtk, uim-qt, uim-qt4(lineedit¤Î¤ß?))¤Ç¤Î¤ß¸åÃÖ·¿ÊÑ´¹¤¬²Äǽ¤Ç¤¹¡£
;;;
+;;; ¤³¤ì¤é°Ê³°¤Î¥Ö¥ê¥Ã¥¸¤Ç¤â¸åÃÖ·¿ÊÑ´¹¤ò»È¤¤¤¿¤¤¾ì¹ç¡¢
+;;; tutcode-enable-fallback-surrounding-text?¤ò#t¤ËÀßÄꤹ¤ë¤È¡¢
+;;; surrounding text API¤¬»ÈÍѤǤ¤Ê¤¤¾ì¹ç¤Ë¡¢
+;;; ʸ»úÎó¤Î¼èÆÀ¤ÏÆâÉô¤Î³ÎÄêºÑʸ»úÎó¥Ð¥Ã¥Õ¥¡¤«¤é¹Ô¤¤¡¢
+;;; ʸ»úÎó¤Îºï½ü¤Ï"\b"(tutcode-fallback-backspace-string)¤òÁ÷½Ð¤·¤Þ¤¹¡£
+;;; - \b(BS,0x08)ʸ»ú¤ò¼õ¤±¤¿»þ¤Ëºï½ü¤ò¹Ô¤¦¥¢¥×¥ê¤Ç¤Î¤ßÆ°ºî¡£
+;;; - ÆâÉô¤Î³ÎÄêºÑʸ»úÎó¥Ð¥Ã¥Õ¥¡¤ÏÊä´°¤È·óÍѤǡ¢
+;;; Ťµ¤Ïtutcode-completion-chars-max¤ÎÃÍ¡£
+;;;
;;; *
¸åÃÖ·¿Éô¼ó¹çÀ®ÊÑ´¹¤Ï¡¢³«»Ï¥¡¼¤òtutcode-postfix-bushu-start-sequence¤Ë
;;; ÀßÄꤹ¤ë¤È»ÈÍѲÄǽ¤Ë¤Ê¤ê¤Þ¤¹¡£
;;; * ¸åÃÖ·¿¸ò¤¼½ñ¤ÊÑ´¹¤Ï¡¢°Ê²¼¤Î³«»Ï¥¡¼¤òÀßÄꤹ¤ë¤È»ÈÍѲÄǽ¤Ë¤Ê¤ê¤Þ¤¹¡£
@@ -453,6 +462,9 @@
(define tutcode-postfix-mazegaki-terminate-char-list
'("\n" "\t" " " "¡¢" "¡£" "¡¤" "¡¥" "¡¦" "¡Ö" "¡×" "¡Ê" "¡Ë"))
+;;; surrounding text API¤¬»È¤¨¤Ê¤¤»þ¤Ë¡¢Ê¸»úºï½ü¤Î¤¿¤á¤Ëcommit¤¹¤ëʸ»úÎó
+(define tutcode-fallback-backspace-string "\b")
+
;;; implementations
;;; ¸ò¤¼½ñ¤ÊÑ´¹¼½ñ¤Î½é´ü²½¤¬½ª¤ï¤Ã¤Æ¤¤¤ë¤«¤É¤¦¤«
@@ -1160,7 +1172,7 @@
;;; im-commit-raw¤ò¸Æ¤Ó½Ð¤¹¡£
;;; ¤¿¤À¤·¡¢»Ò¥³¥ó¥Æ¥¥¹¥È¤Î¾ì¹ç¤Ï¡¢editor¤«dialog¤ËÆþÎÏ¥¡¼¤òÅϤ¹¡£
(define (tutcode-commit-raw pc key key-state)
- (if tutcode-use-completion?
+ (if (or tutcode-use-completion?
tutcode-enable-fallback-surrounding-text?)
(tutcode-append-commit-string pc (im-get-raw-key-str key key-state)))
(let ((ppc (tutcode-context-parent-context pc)))
(if (not (null? ppc))
@@ -1172,8 +1184,12 @@
;;; im-commit¤ò¸Æ¤Ó½Ð¤¹¡£
;;; ¤¿¤À¤·¡¢»Ò¥³¥ó¥Æ¥¥¹¥È¤Î¾ì¹ç¤Ï¡¢editor¤«dialog¤ËÆþÎÏ¥¡¼¤òÅϤ¹¡£
;;; @param str ¥³¥ß¥Ã¥È¤¹¤ëʸ»úÎó
-(define (tutcode-commit pc str)
- (if tutcode-use-completion?
+;;; @param opt-skip-append-commit-strs? commit-strs¤Ø¤ÎÄɲäò
+;;; ¥¹¥¥Ã¥×¤¹¤ë¤«¤É¤¦¤«¡£Ì¤»ØÄê»þ¤Ï#f
+(define (tutcode-commit pc str . opt-skip-append-commit-strs?)
+ (if
+ (and (or tutcode-use-completion?
tutcode-enable-fallback-surrounding-text?)
+ (not (:optional opt-skip-append-commit-strs? #f)))
(tutcode-append-commit-string pc str))
(let ((ppc (tutcode-context-parent-context pc)))
(if (not (null? ppc))
@@ -2264,13 +2280,15 @@
(rk-flush rkc)
(begin
(tutcode-commit-raw pc key key-state)
- (if tutcode-use-completion?
- (begin
- (if (> (length (tutcode-context-commit-strs pc)) 0)
- (tutcode-context-set-commit-strs! pc
- (cdr (tutcode-context-commit-strs pc))))
- (if (and completing? (> tutcode-completion-chars-min 0))
- (tutcode-check-completion pc #f 0)))))))
+ (if (and (or tutcode-use-completion?
+ tutcode-enable-fallback-surrounding-text?)
+ (pair? (tutcode-context-commit-strs pc)))
+ (tutcode-context-set-commit-strs! pc
+ (cdr (tutcode-context-commit-strs pc))))
+ (if (and tutcode-use-completion?
+ completing?
+ (> tutcode-completion-chars-min 0))
+ (tutcode-check-completion pc #f 0)))))
((tutcode-stroke-help-toggle-key? key key-state)
(tutcode-toggle-stroke-help pc))
((and tutcode-use-completion?
@@ -2695,7 +2713,15 @@
((ustr (im-acquire-text pc 'primary 'cursor len 0))
(former (and ustr (ustr-former-seq ustr)))
(former-seq (and (pair? former) (string-to-list (car former)))))
- (or former-seq ())))))
+ (if ustr
+ (or former-seq ())
+ ;;
im-acquire-text̤Âбþ´Ä¶¤Î¾ì¹ç¡¢ÆâÉô¤Î³ÎÄêºÑʸ»úÎó¥Ð¥Ã¥Õ¥¡¤ò»ÈÍÑ
+ (if tutcode-enable-fallback-surrounding-text?
+ (let ((commit-strs (tutcode-context-commit-strs pc)))
+ (if (> (length commit-strs) len)
+ (take commit-strs len)
+ commit-strs))
+ ()))))))
;;; ³ÎÄêºÑʸ»úÎó¤òºï½ü¤¹¤ë
;;; @param len ºï½ü¤¹¤ëʸ»ú¿ô
@@ -2710,7 +2736,25 @@
(if (> (length left-string) len)
(drop left-string len)
()))))
- (im-delete-text pc 'primary 'cursor len 0))))
+ (or
+ (im-delete-text pc 'primary 'cursor len 0)
+ ;; im-delete-text̤Âбþ´Ä¶¤Î¾ì¹ç¡¢"\b"¤òÁ÷¤ë¡£
+ ;; XXX:"\b"¤òǧ¼±¤·¤Æʸ»ú¤òºï½ü¤¹¤ë¥¢¥×¥ê¤Ç¤Ê¤¤¤ÈÆ°ºî¤·¤Ê¤¤
+ ;;
(tutcode-commit-raw¤ÏÆþÎϺѥ¡¼¤ò¤½¤Î¤Þ¤Þ¥¢¥×¥ê¤ËÅϤ¹¤³¤È¤ò»ØÄꤹ¤ë
+ ;; ¤â¤Î¤Ê¤Î¤Ç¡¢°Ê²¼¤Î¤è¤¦¤Ëbackspace¥¡¼ÂǸ°¤ÎÀ¸À®¤Ë¤Ï»È¤¨¤Ê¤¤
+ ;; (tutcode-commit-raw pc 'backspace 0))
+ (and tutcode-enable-fallback-surrounding-text?
+ (begin
+ (let ((commit-strs (tutcode-context-commit-strs pc)))
+ (tutcode-context-set-commit-strs! pc
+ (if (> (length commit-strs) len)
+ (drop commit-strs len)
+ ())))
+ (if (> (string-length tutcode-fallback-backspace-string) 0)
+ (tutcode-commit pc
+ (tutcode-make-string
+ (make-list len tutcode-fallback-backspace-string))
+ #t))))))))
;;; ľÀÜÆþÎϾõÂ֤ΤȤ¤Î¥¡¼ÆþÎϤò½èÍý¤¹¤ë¡£
;;; @param c ¥³¥ó¥Æ¥¥¹¥È¥ê¥¹¥È
