Revision: 6603
Author: ek.kato
Date: Tue Jul 27 22:09:43 2010
Log: * scm/plugin.scm (uim-plugin-scm-load-path) : Support multiple
paths by LIBUIM_SCM_FILES.
* scm/util.scm
- (make-scm-pathname) : Change to return list of paths.
- (try-load) : Follow the change.
- (try-require) : Ditto.
* test/uim-test-utils.scm : Fix for sourcedir != builddir.
* test/uim-test-utils-new.scm : Ditto.
* test/util/test-uim.scm : Follow the change in make-scm-pathname.
http://code.google.com/p/uim/source/detail?r=6603
Modified:
/trunk/scm/plugin.scm
/trunk/scm/util.scm
/trunk/test/uim-test-utils-new.scm
/trunk/test/uim-test-utils.scm
/trunk/test/util/test-uim.scm
=======================================
--- /trunk/scm/plugin.scm Wed Jun 2 04:06:13 2010
+++ /trunk/scm/plugin.scm Tue Jul 27 22:09:43 2010
@@ -38,13 +38,14 @@
(define uim-plugin-scm-load-path
(if (setugid?)
(list (sys-pkgdatadir))
- (let ((home-dir (or (home-directory (user-name)) "")))
+ (let ((home-dir (or (home-directory (user-name)) ""))
+ (scm-paths (string-split (load-path) ":")))
(filter string?
- (list (getenv "LIBUIM_SCM_FILES")
+ (append scm-paths
(if home-dir
- (string-append (get-config-path! #f) "/plugin")
+ (list (string-append (get-config-path! #f) "/plugin"))
'())
- (sys-pkgdatadir))))))
+ (list (sys-pkgdatadir)))))))
;; The name 'module' is adopted from a post from Hiroyuki. If you
;; feel bad about the meaning of 'module', post your opinion to
=======================================
--- /trunk/scm/util.scm Sun Apr 4 20:35:54 2010
+++ /trunk/scm/util.scm Tue Jul 27 22:09:43 2010
@@ -251,28 +251,39 @@
(define make-scm-pathname
(lambda (file)
(if (string-prefix? "/" file)
- file
- (string-append (load-path) "/" file))))
+ (list file)
+ (let ((paths (string-split (load-path) ":")))
+ (map (lambda (x) (string-append x "/" file)) paths)))))
;; TODO: write test
;; returns succeeded or not
(define try-load
(lambda (file)
(guard (err
- (else #f))
- ;; to suppress error message, check file existence first
- (and (file-readable? (make-scm-pathname file))
- (load file)))))
+ (else #f))
+ (let ((paths (make-scm-pathname file)))
+ (let loop ((path (car paths))
+ (rest (cdr paths)))
+ ;; to suppress error message, check file existence first
+ (if (file-readable? path)
+ (load path)
+ (if (not (null? rest))
+ (loop (car rest) (cdr rest)))))))))
;; TODO: write test
;; returns succeeded or not
(define try-require
(lambda (file)
(guard (err
- (else #f))
- ;; to suppress error message, check file existence first
- (and (file-readable? (make-scm-pathname file))
- (require file)))))
+ (else #f))
+ (let ((paths (make-scm-pathname file)))
+ (let loop ((path (car paths))
+ (rest (cdr paths)))
+ ;; to suppress error message, check file existence first
+ (if (file-readable? path)
+ (require path)
+ (if (not (null? rest))
+ (loop (car rest) (cdr rest)))))))))
;; used for dynamic environment substitution of closure
(define %%enclose-another-env
=======================================
--- /trunk/test/uim-test-utils-new.scm Wed Apr 7 15:38:33 2010
+++ /trunk/test/uim-test-utils-new.scm Tue Jul 27 22:09:43 2010
@@ -49,7 +49,7 @@
(error "GaUnit 0.1.6 is required"))
(sys-putenv "LIBUIM_SYSTEM_SCM_FILES"
(uim-test-source-path "sigscheme" "lib"))
-(sys-putenv "LIBUIM_SCM_FILES" (uim-test-source-path "scm"))
+(sys-putenv "LIBUIM_SCM_FILES" (string-append
(uim-test-source-path "scm") ":" (uim-test-build-path "scm")))
;; FIXME: '.libs' is hardcoded
(sys-putenv "LIBUIM_PLUGIN_LIB_DIR" (uim-test-build-path "uim" ".libs"))
(sys-putenv "LIBUIM_VERBOSE" "2") ;; must be 1 or 2 (2 enables backtrace)
=======================================
--- /trunk/test/uim-test-utils.scm Mon Apr 5 21:29:34 2010
+++ /trunk/test/uim-test-utils.scm Tue Jul 27 22:09:43 2010
@@ -42,7 +42,7 @@
(error "GaUnit 0.1.6 is required"))
(sys-putenv "LIBUIM_SYSTEM_SCM_FILES"
(uim-test-source-path "sigscheme" "lib"))
-(sys-putenv "LIBUIM_SCM_FILES" (uim-test-source-path "scm"))
+(sys-putenv "LIBUIM_SCM_FILES" (string-append
(uim-test-source-path "scm") ":" (uim-test-build-path "scm")))
;; FIXME: '.libs' is hardcoded
(sys-putenv "LIBUIM_PLUGIN_LIB_DIR" (uim-test-build-path "uim" ".libs"))
(sys-putenv "LIBUIM_VERBOSE" "2") ;; must be 1 or 2 (2 enables backtrace)
=======================================
--- /trunk/test/util/test-uim.scm Sun Apr 4 20:35:54 2010
+++ /trunk/test/util/test-uim.scm Tue Jul 27 22:09:43 2010
@@ -39,13 +39,15 @@
(uim-test-teardown))
(define (test-make-scm-pathname)
- (assert-uim-equal (uim '(string-append (load-path) "/"))
+ (assert-uim-equal (uim '(map (lambda (x) (string-append x "/"))
+ (string-split (load-path) ":")))
'(make-scm-pathname ""))
- (assert-uim-equal (uim '(string-append (load-path) "/file"))
+ (assert-uim-equal (uim '(map (lambda (x) (string-append x "/file"))
+ (string-split (load-path) ":")))
'(make-scm-pathname "file"))
- (assert-uim-equal "/absolute/path/file"
+ (assert-uim-equal '("/absolute/path/file")
'(make-scm-pathname "/absolute/path/file"))
- (assert-uim-equal "/"
+ (assert-uim-equal '("/")
'(make-scm-pathname "/"))
#f)
