[uim-commit] r2039 - in branches/r5rs: . doc scm test

yamaken at freedesktop.org yamaken at freedesktop.org
Sun Nov 6 23:41:50 PST 2005


Author: yamaken
Date: 2005-11-06 23:41:26 -0800 (Sun, 06 Nov 2005)
New Revision: 2039

Modified:
   branches/r5rs/
   branches/r5rs/doc/UNIT-TEST
   branches/r5rs/scm/skk.scm
   branches/r5rs/test/test-util.scm
Log:
 r535 at deepblue (orig r2033):  ekato | 2005-11-07 01:28:41 +0900
 * scm/skk.scm (skk-proc-state-direct) : Enable ddskk compatible
   behavior about mistypes in starting kanji-state, e.g. "kAnnji"
   for "Kannji".
 (skk-rk-push-key-match-without-new-seq) : New function.  Check
   whether current key press matches with the rk rule without any
   additional rk sequence.
 (skk-proc-state-kanji) :  Enable ddskk compatible behavior about
   mistypes in okuri-gana, e.g. "ArukU" for "AruKu".
 
 r538 at deepblue (orig r2036):  yamaken | 2005-11-07 15:31:37 +0900
 * doc/UNIT-TEST
   - Update
 
 r539 at deepblue (orig r2037):  yamaken | 2005-11-07 16:15:41 +0900
 * test/test-util.scm
   - (test R6RS(SRFI-75) and C89 compliant escape sequences of Gauche):
     New test
   - (test string-escape): Add some tests for additional escape
     sequences
 
 r540 at deepblue (orig r2038):  yamaken | 2005-11-07 16:38:05 +0900
 * uim/slib.c
   - (lreadstring, string_prin1): Support R6RS(SRFI-75) and C89
     compliant escape sequences \a, \b, \v, \f
 



Property changes on: branches/r5rs
___________________________________________________________________
Name: svk:merge
   - 2f05256a-0800-0410-85e3-84fe06922419:/local/uim/trunk:1514
74100eb5-a104-0410-9326-fdab01523867:/branches/r5rs:6
fb73e508-85ea-0310-95c3-a85c473e0941:/trunk:2023
   + 2f05256a-0800-0410-85e3-84fe06922419:/local/uim/trunk:1514
74100eb5-a104-0410-9326-fdab01523867:/branches/r5rs:6
fb73e508-85ea-0310-95c3-a85c473e0941:/trunk:2038

Modified: branches/r5rs/doc/UNIT-TEST
===================================================================
--- branches/r5rs/doc/UNIT-TEST	2005-11-07 07:38:05 UTC (rev 2038)
+++ branches/r5rs/doc/UNIT-TEST	2005-11-07 07:41:26 UTC (rev 2039)
@@ -69,7 +69,9 @@
 
   4) Write tests as described in test/test-example.scm
 
+  5) Add test-foo.scm into EXTRA_DIST of test/Makefile.am
 
+
 * Guidelines for uim project
 
   FIXME: describe this

Modified: branches/r5rs/scm/skk.scm
===================================================================
--- branches/r5rs/scm/skk.scm	2005-11-07 07:38:05 UTC (rev 2038)
+++ branches/r5rs/scm/skk.scm	2005-11-07 07:41:26 UTC (rev 2039)
@@ -1077,14 +1077,24 @@
 	     #f)
 	   #t)
        (if (char-upper-case? key)
-	   (let* ((residual-kana (rk-push-key-last! rkc)))
-	     ;; handle preceding "n"
-	     (if residual-kana
-		 (skk-commit sc (skk-get-string sc residual-kana kana)))
-	     (skk-context-set-state! sc 'skk-state-kanji)
-	     (set! key (to-lower-char key))
-	     (set! key-str (charcode->string key))
-	     #t)
+	   (if (and 
+		(not (null? (rk-context-seq rkc)))
+		(not (rk-current-seq rkc)))
+	       ;; ddskk compatible behavior but not in SKK speciation
+	       (begin
+		 (skk-context-set-state! sc 'skk-state-kanji)
+		 (skk-append-string sc (rk-push-key!
+					rkc
+					(charcode->string
+					 (to-lower-char key))))
+		 #f)
+	       (let* ((residual-kana (rk-push-key-last! rkc)))
+		 ;; handle preceding "n"
+		 (if residual-kana
+		     (skk-commit sc (skk-get-string sc residual-kana kana)))
+		 (skk-context-set-state! sc 'skk-state-kanji)
+		 (set! key (to-lower-char key))
+		 #t))
 	   #t)
        ;; Hack to handle "n1" sequence as "¤ó1".
        ;; This should be handled in rk.scm. -- ekato
@@ -1135,6 +1145,16 @@
 	  (not (= c 111))	;; o
 	  (not (= c 110))))))	;; n
 
+(define skk-rk-push-key-match-without-new-seq
+  (lambda (rkc key)
+    (let* ((s (rk-context-seq rkc))
+	   (s (cons key s))
+	   (rule (rk-context-rule rkc))
+	   (seq (rk-lib-find-seq (reverse s) rule)))
+	 (if (null? (cdar seq))
+	     (cadr seq)
+	     #f))))
+
 (define skk-proc-state-kanji
   (lambda (c key key-state)
     (let* ((sc (skk-find-descendant-context c))
@@ -1231,22 +1251,36 @@
 	   #t)
        (if (and (char-upper-case? key)
 		(not (null? (skk-context-head sc))))
-	   (begin
-	     (skk-context-set-state! sc 'skk-state-okuri)
-	     (set! key (to-lower-char key))
-	     (skk-context-set-okuri-head! sc
-					  (charcode->string key))
-	     (if (skk-sokuon-shiin-char? key)
+	   (let ((key-str (charcode->string (to-lower-char key))))
+	     (set! res (skk-rk-push-key-match-without-new-seq rkc key-str))
+	     (if (and
+		  (not (null? (rk-context-seq rkc)))
+		  (not (rk-current-seq rkc))
+		  res)
+		 ;; ddskk compatible behavior but not in SKK speciation
+		 (begin	
+		   (skk-context-set-state! sc 'skk-state-okuri)
+		   (skk-context-set-okuri-head!
+		    sc
+		    (car (reverse (rk-context-seq rkc))))
+		   (rk-context-set-seq! rkc '())
+		   (skk-append-okuri-string sc res)
+		   (skk-begin-conversion sc)
+		   #f)
 		 (begin
-		   (set! res
-			 (rk-push-key! rkc (charcode->string key)))
-		   (if res
-		       (skk-context-set-head! sc
-					      (cons
-					       res
-					       (skk-context-head sc))))))
-	     (skk-append-residual-kana sc)
-	     #t)
+		   (skk-context-set-state! sc 'skk-state-okuri)
+		   (set! key (to-lower-char key))
+		   (skk-context-set-okuri-head! sc key-str)
+		   (if (skk-sokuon-shiin-char? key)
+		       (begin
+			 (set! res (rk-push-key! rkc key-str))
+			 (if res
+			     (skk-context-set-head! sc
+						    (cons
+						     res
+						     (skk-context-head sc))))))
+		   (skk-append-residual-kana sc)
+		   #t)))
 	   #t)
        (if (skk-kana-toggle-key? key key-state)
 	   (begin
@@ -1587,7 +1621,7 @@
 	  (skk-append-list-to-context-head
 	   sc
 	   (if (or
-	        (skk-context-latin-conv sc)
+		(skk-context-latin-conv sc)
 		;; handle Setsubi-ji
 		(and
 		 (null? (cdr sl))

Modified: branches/r5rs/test/test-util.scm
===================================================================
--- branches/r5rs/test/test-util.scm	2005-11-07 07:38:05 UTC (rev 2038)
+++ branches/r5rs/test/test-util.scm	2005-11-07 07:41:26 UTC (rev 2039)
@@ -542,17 +542,51 @@
 		 (uim '(string-append-map car '(("c" "C") ("a" "A") ("r" "R")))))))
 
 (define-uim-test-case "testcase util misc"
+  ("test R6RS(SRFI-75) and C89 compliant escape sequences of Gauche"
+   (assert-false (string=? "t" "\t"))  ;; #\tab
+   (assert-false (string=? "n" "\n"))  ;; #\linefeed
+   (assert-false (string=? "f" "\f"))  ;; #\page
+   (assert-false (string=? "r" "\r"))  ;; #\return
+
+   ;; not supported by Gauche 0.8.6
+   ;; FIXME: enable when Gauche support it
+;;   (assert-false (string=? "a" "\a"))  ;; #\alarm
+;;   (assert-false (string=? "b" "\b"))  ;; #\backspace
+;;   (assert-false (string=? "v" "\v"))  ;; #\vtab
+   )
+
   ("test string-escape"
    ;; empty string
    (assert-equal "\"\""
 		 (uim '(string-escape "")))
    ;; single character
+   ;; R5RS
    (assert-equal "\"\\\"\""
 		 (uim '(string-escape "\"")))
    (assert-equal "\"\\\\\""
 		 (uim '(string-escape "\\")))
+
+   ;; R6RS(SRFI-75) and C89 (uim-sh)
+   (assert-equal "\"\\t\""
+		 (uim '(string-escape "\t")))  ;; #\tab
    (assert-equal "\"\\n\""
-		 (uim '(string-escape "\n")))
+		 (uim '(string-escape "\n")))  ;; #\linefeed
+   (assert-equal "\"\\f\""
+		 (uim '(string-escape "\f")))  ;; #\page
+   (assert-equal "\"\\r\""
+		 (uim '(string-escape "\r")))  ;; #\return
+
+   ;; R6RS(SRFI-75) and C89 (uim-sh), but cannot test since Gauche
+   ;; does not support the escape sequences.
+   ;; FIXME: enable when Gauche support it
+;;   (assert-equal "\"\\a\""
+;;		 (uim '(string-escape "\a")))  ;; #\alarm
+;;   (assert-equal "\"\\b\""
+;;		 (uim '(string-escape "\b")))  ;; #\backspace
+;;   (assert-equal "\"\\v\""
+;;		 (uim '(string-escape "\v")))  ;; #\vtab
+
+   ;; R5RS
    (assert-equal "\"a\""
 		 (uim '(string-escape "a")))
    (assert-equal "\"b\""



More information about the uim-commit mailing list