Revision: 6852
Author: ek.kato
Date: Mon Dec 27 21:41:25 2010
Log: * Merge r6837 from trunk.

http://code.google.com/p/uim/source/detail?r=6852

Modified:
 /branches/1.6
 /branches/1.6/scm/input-parse.scm

=======================================
--- /branches/1.6/scm/input-parse.scm   Tue Feb  3 04:43:03 2009
+++ /branches/1.6/scm/input-parse.scm   Mon Dec 27 21:41:25 2010
@@ -47,6 +47,24 @@
                          (write-to-string s display))
                        specialising-msg)))))

+(define (string-concatenate-reverse strs final end)
+  (define (string-xcopy! target tstart s sfrom sto)
+    (do ((i sfrom (inc i)) (j tstart (inc j)))
+        ((>= i sto))
+      (string-set! target j (string-ref s i))))
+  (if (null? strs) (substring final 0 end)
+    (let*
+      ((total-len
+        (let loop ((len end) (lst strs))
+          (if (null? lst) len
+            (loop (+ len (string-length (car lst))) (cdr lst)))))
+       (result (make-string total-len)))
+      (let loop ((len end) (j total-len) (str final) (lst strs))
+       (string-xcopy! result (- j len) str 0 len)
+       (if (null? lst) result
+         (loop (string-length (car lst)) (- j len)
+           (car lst) (cdr lst)))))))
+
 (define char-return #\return)
 (define char-newline #\newline)

Reply via email to