[uim-commit] r1214 - branches/r5rs/scm

[kzk at freedesktop.org]

Author: kzk
Date: 2005-08-18 00:43:45 -0700 (Thu, 18 Aug 2005)
New Revision: 1214

Modified:
   branches/r5rs/scm/i18n.scm
   branches/r5rs/scm/im.scm
   branches/r5rs/scm/util.scm
Log:
* scm/im.scm
  - (default-im-for-debug): use provided? instead of feature?
* scm/util.scm
  - (char-control?): use number? instead of integer?
  - (char-upper-case, char-lower-case,
     char-alphabetic?): restored, because these function actually
     handles integer value, but in R5RS these function handles
     character type object.
  - (nth): added for compatibility
  - (copy-list): added for compatibility
* scm/i18n.scm
  - (ugettext): use provided? instead of feature?


Modified: branches/r5rs/scm/i18n.scm
===================================================================
--- branches/r5rs/scm/i18n.scm	2005-08-18 07:19:43 UTC (rev 1213)
+++ branches/r5rs/scm/i18n.scm	2005-08-18 07:43:45 UTC (rev 1214)
@@ -37,7 +37,7 @@
 
 ;; convenience shorthand of runtime translation
 (define ugettext
-  (if (feature? 'nls)
+  (if (provided? "nls")
       (lambda (str)
 	(dgettext (gettext-package) str))
       (lambda (str)

Modified: branches/r5rs/scm/im.scm
===================================================================
--- branches/r5rs/scm/im.scm	2005-08-18 07:19:43 UTC (rev 1213)
+++ branches/r5rs/scm/im.scm	2005-08-18 07:43:45 UTC (rev 1214)
@@ -138,7 +138,7 @@
 
 (define default-im-for-debug
   (lambda ()
-    (and (feature? 'debug)
+    (and (provided? "debug")
 	 (let* ((str (getenv "UIM_IM_ENGINE"))
 		(sym (and str
 			  (string->symbol str))))

Modified: branches/r5rs/scm/util.scm
===================================================================
--- branches/r5rs/scm/util.scm	2005-08-18 07:19:43 UTC (rev 1213)
+++ branches/r5rs/scm/util.scm	2005-08-18 07:43:45 UTC (rev 1214)
@@ -209,13 +209,36 @@
 
 (define char-control?
   (lambda (c)
-    (and (integer? c)
+    (and (number? c)
 	 (or (<= c 31)
 	     (= c 127)))))
 
+(define char-upper-case?
+  (lambda (c)
+    (and (number? c)
+	 (>= c 65)
+	 (<= c 90))))
+
+(define char-lower-case?
+  (lambda (c)
+    (and (number? c)
+	 (>= c 97)
+	 (<= c 122))))
+
+(define char-alphabetic?
+  (lambda (c)
+    (or (char-upper-case? c)
+	(char-lower-case? c))))
+
+(define char-numeric?
+  (lambda (c)
+    (and (number? c)
+	 (>= c 48)
+	 (<= c 57))))
+
 (define char-printable?
   (lambda (c)
-    (and (integer? c)
+    (and (number? c)
 	 (<= c 127)
 	 (not (char-control? c)))))
 
@@ -251,6 +274,9 @@
 (define numeral-char? char-numeric?)
 (define usual-char? char-graphic?)
 (define to-lower-char char-downcase)
+(define nth
+  (lambda (k lst)
+    (list-ref lst k)))
 
 ;;
 ;; SRFI procedures (don't expect 100% compatibility)
@@ -262,6 +288,8 @@
 ;;(define drop-right)
 ;;(define split-at)
 
+(define (copy-list lst) (append lst '()))
+
 (define list-tabulate
   (lambda (n init-proc)
     (if (< n 0)
@@ -492,17 +520,21 @@
 ;; returns succeeded or not
 (define try-load
   (lambda (file)
-    (and (file-readable? (make-scm-pathname file))
-	 (not (*catch 'errobj (begin (load file)
-				     #f))))))
+    (load file)))
+;  (lambda (file)
+;    (and (file-readable? (make-scm-pathname file))
+;	 (not (*catch 'errobj (begin (load file)
+;				     #f))))))
 
 ;; TODO: write test
 ;; returns succeeded or not
 (define try-require
   (lambda (file)
-    (and (file-readable? (make-scm-pathname file))
-	 (eq? (symbolconc '* (string->symbol file) '-loaded*)
-	      (*catch 'errobj (require file))))))
+    (require file)))
+;  (lambda (file)
+;    (and (file-readable? (make-scm-pathname file))
+;	 (eq? (symbolconc '* (string->symbol file) '-loaded*)
+;	      (*catch 'errobj (require file))))))
 
 ;; for eval
 (define toplevel-env ())
@@ -712,3 +744,4 @@
 		     (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)))))
+