Author: yamakenz
Date: Wed Jul 11 03:16:41 2007
New Revision: 4701
Modified:
trunk/scm/ichar.scm
trunk/scm/util.scm
Log:
* scm/util.scm
- Disable SRFI-60
* scm/ichar.scm
- Enable SRFI-60
- (ucs->utf8-string): New procedure
- (ucs-to-utf8-string): Replace with alias to ucs->utf8-string
Modified: trunk/scm/ichar.scm
==============================================================================
--- trunk/scm/ichar.scm (original)
+++ trunk/scm/ichar.scm Wed Jul 11 03:16:41 2007
@@ -28,6 +28,8 @@
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
;;; SUCH DAMAGE.
+(use srfi-60)
+
;; TODO: write test
(define string->char
@@ -152,17 +154,11 @@
0
(char->integer (car sl))))))
-;; FIXME: write test.
-(define ucs-to-utf8-string
+(define ucs->utf8-string
(lambda (ucs)
- (let ((utf-8
- (if (< ucs 128)
- (list ucs) ; ASCII
- (let enc ((to-be-split ucs)
- (threshold 64))
- (if (< to-be-split threshold)
- (list (bit-or to-be-split
- (bit-xor 255 (- (* 2 threshold) 1))))
- (cons (bit-or 128 (bit-and 63 to-be-split))
- (enc (/ to-be-split 64) (/ threshold 2))))))))
- (string-append-map charcode->string (reverse utf-8)))))
+ (with-char-codec "UTF-8"
+ (lambda ()
+ (list->string (list (integer->char ucs)))))))
+
+;; FIXME: write test.
+(define ucs-to-utf8-string ucs->utf8-string)
Modified: trunk/scm/util.scm
==============================================================================
--- trunk/scm/util.scm (original)
+++ trunk/scm/util.scm Wed Jul 11 03:16:41 2007
@@ -31,12 +31,10 @@
(use srfi-1)
(use srfi-6)
(use srfi-34)
-(use srfi-60)
(require "ichar.scm")
(require "deprecated-util.scm")
-;;;;
(define hyphen-sym (string->symbol "-"))
