[uim-commit] r270 - in trunk: scm test

[yamaken@freedesktop.org]

Author: yamaken
Date: 2005-01-12 10:16:44 -0800 (Wed, 12 Jan 2005)
New Revision: 270

Modified:
   trunk/scm/anthy.scm
   trunk/scm/custom.scm
   trunk/test/test-custom.scm
Log:
* scm/custom.scm
  - All changes are validated by test-custom.scm
  -(custom-expand-key-references, custom-list-as-literal,
    custom-definition-as-literal): Simplify
* test/test-custom.scm
  - (test custom-definition-as-literal): Follow the specification
    change

* scm/anthy.scm
  - (anthy-converting-state-preedit, anthy-get-commit-string):
    Simplify


Modified: trunk/scm/anthy.scm
===================================================================
--- trunk/scm/anthy.scm	2005-01-12 18:08:56 UTC (rev 269)
+++ trunk/scm/anthy.scm	2005-01-12 18:16:44 UTC (rev 270)
@@ -699,22 +699,20 @@
 	   (segments (anthy-context-segments ac))
 	   (cur-seg (ustr-cursor-pos segments))
 	   (separator (anthy-separator ac)))
-      (apply
-       append
-       (map (lambda (seg-idx cand-idx)
-	      (let* ((attr (if (= seg-idx cur-seg)
-			       (bit-or preedit-reverse
-				       preedit-cursor)
-			       preedit-underline))
-		     (cand (anthy-lib-get-nth-candidate ac-id
-							seg-idx cand-idx))
-		     (seg (list (cons attr cand))))
-		(if (and separator
-			 (< 0 seg-idx))
-		    (cons separator seg)
-		    seg)))
-	    (iota (ustr-length segments))
-	    (ustr-whole-seq segments))))))
+      (append-map
+       (lambda (seg-idx cand-idx)
+	 (let* ((attr (if (= seg-idx cur-seg)
+			  (bit-or preedit-reverse
+				  preedit-cursor)
+			  preedit-underline))
+		(cand (anthy-lib-get-nth-candidate ac-id seg-idx cand-idx))
+		(seg (list (cons attr cand))))
+	   (if (and separator
+		    (< 0 seg-idx))
+	       (cons separator seg)
+	       seg)))
+       (iota (ustr-length segments))
+       (ustr-whole-seq segments)))))
 
 (define anthy-input-state-preedit
   (lambda (ac)
@@ -744,11 +742,10 @@
   (lambda (ac)
     (let ((ac-id (anthy-context-ac-id ac))
 	  (segments (anthy-context-segments ac)))
-      (apply string-append
-	     (map (lambda (seg-idx cand-idx)
-		    (anthy-lib-get-nth-candidate ac-id seg-idx cand-idx))
-		  (iota (ustr-length segments))
-		  (ustr-whole-seq segments))))))
+      (string-append-map (lambda (seg-idx cand-idx)
+			   (anthy-lib-get-nth-candidate ac-id seg-idx cand-idx))
+			 (iota (ustr-length segments))
+			 (ustr-whole-seq segments)))))
 
 (define anthy-commit-string
   (lambda (ac)

Modified: trunk/scm/custom.scm
===================================================================
--- trunk/scm/custom.scm	2005-01-12 18:08:56 UTC (rev 269)
+++ trunk/scm/custom.scm	2005-01-12 18:16:44 UTC (rev 270)
@@ -112,7 +112,7 @@
      ((string? key)
       (list key))
      ((list? key)
-      (apply append (map custom-expand-key-references key)))
+      (append-map custom-expand-key-references key))
      ((and (symbol? key)
 	   (custom-exist? key 'key))
       (custom-expand-key-references (custom-value key)))
@@ -388,21 +388,16 @@
 
 (define custom-list-as-literal
   (lambda (lst)
-    (let* ((padded-list (map (lambda (elem)
-			       (list " "
-				     (cond
-				      ((symbol? elem)
-				       (symbol->string elem))
-				      ((string? elem)
-				       (string-append "\"" elem "\""))
-				      (else
-				       ""))))
-			     lst))
-	   (literalized (if (null? padded-list)
-			    ""
-			    (apply string-append
-				   (cdr (apply append padded-list))))))
-      (string-append "'(" literalized ")"))))
+    (let ((canonicalized (map (lambda (elem)
+				(cond
+				 ((symbol? elem)
+				  (symbol->string elem))
+				 ((string? elem)
+				  (string-append "\"" elem "\""))
+				 (else
+				  "")))
+			      lst)))
+      (string-append "'(" (string-join " " canonicalized) ")"))))
 
 ;; API
 (define custom-value-as-literal
@@ -436,7 +431,7 @@
 	  (val (custom-value-as-literal sym))
 	  (hooked (custom-call-hook-procs sym custom-literalize-hooks)))
       (if (not (null? hooked))
-	  (apply string-append hooked)
+	  (string-join "\n" hooked)
 	  (apply string-append
 		 (append
 		  (list "(define " var " " val ")")

Modified: trunk/test/test-custom.scm
===================================================================
--- trunk/test/test-custom.scm	2005-01-12 18:08:56 UTC (rev 269)
+++ trunk/test/test-custom.scm	2005-01-12 18:16:44 UTC (rev 270)
@@ -1949,7 +1949,7 @@
 		 (uim '(custom-definition-as-literal 'test-style)))
    (uim '(custom-add-hook 'test-style 'custom-literalize-hooks
 			  (lambda () "(define test-style 'hooked2)")))
-   (assert-equal "(define test-style 'hooked2)(define test-style 'hooked)"
+   (assert-equal "(define test-style 'hooked2)\n(define test-style 'hooked)"
 		 (uim '(custom-definition-as-literal 'test-style)))))
 
 (define-uim-test-case "testcase custom interfaces"