diff --git a/scheme/install-lib/install-lib-module.scm b/scheme/install-lib/install-lib-module.scm index b760f0f..d9781de 100644 --- a/scheme/install-lib/install-lib-module.scm +++ b/scheme/install-lib/install-lib-module.scm @@ -1,5 +1,5 @@ ;;; Installation library for scsh modules. -;;; $Id: install-lib-module.scm,v 1.7 2004/02/19 07:29:16 michel-schinz Exp $ +;;; $Id: install-lib-module.scm,v 1.8 2004/02/20 08:22:07 michel-schinz Exp $ ;;; Interfaces @@ -14,6 +14,7 @@ version=? (define-package :syntax) + load-package-in install-file install-files diff --git a/scheme/install-lib/install-lib.scm b/scheme/install-lib/install-lib.scm index c10515b..84c67d8 100755 --- a/scheme/install-lib/install-lib.scm +++ b/scheme/install-lib/install-lib.scm @@ -1,5 +1,5 @@ ;;; Installation library for scsh modules. -;;; $Id: install-lib.scm,v 1.10 2004/02/19 07:29:16 michel-schinz Exp $ +;;; $Id: install-lib.scm,v 1.11 2004/02/20 08:22:07 michel-schinz Exp $ ;; TODO ;; - add a "--debug" option @@ -313,11 +313,12 @@ ;; (define-record-type package - (make-package name version extensions install-thunk) + (make-package name version extensions directory install-thunk) package? (name package-name) (version package-version) (extensions package-extensions) + (directory package-directory) (install-thunk package-install-thunk)) ;; Return the full name of PKG. @@ -344,16 +345,20 @@ (add-package (make-package name (quasiquote version) (quasiquote extensions) + (cwd) (lambda () body ...)))))) -;; Load (and evaluate the contents of) the FILE and return the list of -;; packages it defines. -(define (load-packages file) +;; Load (and evaluate the contents of) the file "pkg-def.scm" in the +;; current directory and return the packages it defines. +(define (load-packages) (let-fluid *packages* (make-cell '()) (lambda () - (load-quietly file) + (load-quietly package-definition-file) (cell-ref (fluid *packages*))))) +(define (load-package-in dir) + (with-cwd dir (load-quietly package-definition-file))) + ;; ;; Package options ;; @@ -560,9 +565,10 @@ ;; move the installed files so that they are laid out according to ;; LAYOUT. (define (install-package layout install-layout pkg) - (let-fluids *layout* layout - *install-layout* install-layout - (package-install-thunk pkg))) + (with-cwd (package-directory pkg) + (let-fluids *layout* layout + *install-layout* install-layout + (package-install-thunk pkg)))) ;; Install all PACKAGES with the given OPTIONS-VALUES. (define (install-packages packages options-values) @@ -595,7 +601,7 @@ (let-optionals rest ((options-diff '())) (with-cwd dir (install-packages - (load-packages package-definition-file) + (load-packages) (fold (lambda (diff options) (cond ((pair? diff) (cons diff (alist-delete (car diff) options))) @@ -760,7 +766,7 @@ END (if (not (file-exists? package-definition-file)) (display-error-and-exit "cannot find package definition file (~a)" package-definition-file)) - (let* ((packages (load-packages package-definition-file)) + (let* ((packages (load-packages)) (all-pkg-opts (all-package-options packages))) (if (not (null? all-pkg-opts)) (complete-usage! all-pkg-opts))