[uim-commit] r2168 - trunk/scm

[ekato at freedesktop.org]

Author: ekato
Date: 2005-11-19 03:27:26 -0800 (Sat, 19 Nov 2005)
New Revision: 2168

Modified:
   trunk/scm/skk-key-custom.scm
   trunk/scm/skk.scm
Log:
* scm/skk-key-custom.scm (skk-commit-alt-case-key) : New custom
  key definition.
* scm/skk.scm (skk-conv-alt-case) : New function.
(skk-proc-state-kanji) : Handle skk-commit-alt-case-key in latin
  conversion state.


Modified: trunk/scm/skk-key-custom.scm
===================================================================
--- trunk/scm/skk-key-custom.scm	2005-11-19 05:49:27 UTC (rev 2167)
+++ trunk/scm/skk-key-custom.scm	2005-11-19 11:27:26 UTC (rev 2168)
@@ -148,6 +148,12 @@
 	       (_ "[SKK] commit as fullwidth alphanumeric")
 	       (_ "long description will be here"))
 
+(define-custom 'skk-commit-alt-case-key '("<IgnoreCase><Control>u")
+               '(skk-keys2)
+	       '(key)
+	       (_ "[SKK] commit as alternative case in latin conversion")
+	       (_ "long description will be here"))
+
 (define-custom 'skk-latin-conv-key '("/")
                '(skk-keys2)
 	       '(key)

Modified: trunk/scm/skk.scm
===================================================================
--- trunk/scm/skk.scm	2005-11-19 05:49:27 UTC (rev 2167)
+++ trunk/scm/skk.scm	2005-11-19 11:27:26 UTC (rev 2168)
@@ -425,6 +425,23 @@
 		       (get-wide-latin-str sl))
 	""))))
 
+(define skk-conv-alt-case
+  (lambda (sl)
+    (let ((get-alt-case-str
+	   (lambda (l)
+	     (let ((c (string->charcode (caar l))))
+	       (cond
+		((char-upper-case? c)
+		 (charcode->string (+ c 32)))
+		((char-lower-case? c)
+		 (charcode->string (- c 32)))
+		(else
+		 (caar l)))))))
+      (if (not (null? sl))
+	  (string-append (skk-conv-alt-case (cdr sl))
+			 (get-alt-case-str sl))
+	  ""))))
+
 (define skk-opposite-kana
   (lambda (kana)
     (cond
@@ -1326,28 +1343,36 @@
        ;; Then check latin-conv status before key handling of hiragana/katakana
        (if (skk-context-latin-conv sc)
 	   (begin
-	     (if (skk-conv-wide-latin-key? key key-state) 
-		 ;; wide latin conversion
-		 (begin
-		   (if (not (null? (skk-context-head sc)))
-		       (begin
-			 (skk-commit sc (skk-conv-wide-latin
-					 (skk-context-head sc)))
-			 (skk-flush sc))))
-		 ;; append latin string
-		 (begin
-		   (if (usual-char? key)
-		       (let* ((s (charcode->string key))
-			      (p (cons s (cons s (cons s s)))))
-			 (skk-append-string sc p)))
-		   ;; dcomp
-		   (if skk-dcomp-activate?
-		       (skk-context-set-dcomp-word!
-			sc
-			(skk-lib-get-dcomp-word
-			 (skk-make-string
-			  (skk-context-head sc) (skk-context-kana-mode sc))
-			 skk-use-numeric-conversion?)))))
+	     (cond
+	      ((skk-conv-wide-latin-key? key key-state) 
+	       ;; wide latin conversion
+	       (if (not (null? (skk-context-head sc)))
+		   (begin
+		     (skk-commit sc (skk-conv-wide-latin
+				     (skk-context-head sc)))
+		     (skk-flush sc))))
+	      ((skk-commit-alt-case-key? key key-state) 
+	       ;; alternative case conversion
+	       (if (not (null? (skk-context-head sc)))
+		   (begin
+		     (skk-commit sc (skk-conv-alt-case
+				     (skk-context-head sc)))
+		     (skk-flush sc))))
+	      (else
+	       ;; append latin string
+	       (begin
+		 (if (usual-char? key)
+		     (let* ((s (charcode->string key))
+			    (p (cons s (cons s (cons s s)))))
+		       (skk-append-string sc p)))
+		 ;; dcomp
+		 (if skk-dcomp-activate?
+		     (skk-context-set-dcomp-word!
+		      sc
+		      (skk-lib-get-dcomp-word
+		       (skk-make-string
+			(skk-context-head sc) (skk-context-kana-mode sc))
+		       skk-use-numeric-conversion?))))))
 	     #f)
 	   #t)
        (if (skk-kanji-mode-key? key key-state)