[uim] r6921 committed - * scm/tutcode.scm...

[codesite-noreply]

Revision: 6921
Author: deton.kih
Date: Sun Jan 16 01:11:10 2011
Log: * scm/tutcode.scm
  - (tutcode-begin-postfix-bushu-conversion): Fix to work in tutcode-editor.
  - (tutcode-postfix-acquire-text, tutcode-postfix-delete-text): New.
http://code.google.com/p/uim/source/detail?r=6921

Modified:
 /trunk/scm/tutcode.scm

=======================================
--- /trunk/scm/tutcode.scm      Fri Jan 14 15:57:01 2011
+++ /trunk/scm/tutcode.scm      Sun Jan 16 01:11:10 2011
@@ -2178,15 +2178,48 @@
 ;;; ¸åÃÖ·¿Éô¼ó¹çÀ®ÊÑ´¹¤ò¹Ô¤¦
 (define (tutcode-begin-postfix-bushu-conversion pc)
   (and-let*
-    ((ustr (im-acquire-text pc 'primary 'cursor 2 0))
-     (former (ustr-former-seq ustr))
-     (former-seq (and (pair? former) (string-to-list (car former))))
+    ((former-seq (tutcode-postfix-acquire-text pc 2))
      (res (and (>= (length former-seq) 2)
                (tutcode-bushu-convert (cadr former-seq) (car  
former-seq)))))
-    (im-delete-text pc 'primary 'cursor 2 0)
+    (tutcode-postfix-delete-text pc 2)
     (tutcode-commit pc res)
     (tutcode-check-auto-help-window-begin pc (list res) ())))

+;;; ³ÎÄêºÑʸ»úÎó¤ò¼èÆÀ¤¹¤ë
+;;; @param len ¼èÆÀ¤¹¤ëʸ»ú¿ô
+;;; @return ¼èÆÀ¤·¤¿Ê¸»úÎó¤Î¥ê¥¹¥È(µÕ½ç)
+(define (tutcode-postfix-acquire-text pc len)
+  (let ((ppc (tutcode-context-parent-context pc)))
+    (if (not (null? ppc))
+      (if (eq? (tutcode-context-child-type ppc) 'tutcode-child-type-dialog)
+        ()
+        (let*
+          ((ec (tutcode-context-editor ppc))
+           (left-string (tutcode-editor-left-string ec)))
+          (if (> (length left-string) len)
+            (take left-string len)
+            left-string)))
+      (let*
+        ((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 ())))))
+
+;;; ³ÎÄêºÑʸ»úÎó¤òºï½ü¤¹¤ë
+;;; @param len ºï½ü¤¹¤ëʸ»ú¿ô
+(define (tutcode-postfix-delete-text pc len)
+  (let ((ppc (tutcode-context-parent-context pc)))
+    (if (not (null? ppc))
+      (if (eq? (tutcode-context-child-type ppc) 'tutcode-child-type-editor)
+        (let*
+          ((ec (tutcode-context-editor ppc))
+           (left-string (tutcode-editor-left-string ec)))
+          (tutcode-editor-set-left-string! ec
+            (if (> (length left-string) len)
+              (drop left-string len)
+              ()))))
+      (im-delete-text pc 'primary 'cursor len 0))))
+
 ;;; ľÀÜÆþÎϾõÂ֤ΤȤ­¤Î¥­¡¼ÆþÎϤò½èÍý¤¹¤ë¡£
 ;;; @param c ¥³¥ó¥Æ¥­¥¹¥È¥ê¥¹¥È
 ;;; @param key ÆþÎϤµ¤ì¤¿¥­¡¼