- added "load-package-in" function, to load sub-packages

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

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)
+  (with-cwd (package-directory pkg)
     (let-fluids *layout* layout
                 *install-layout* install-layout
-              (package-install-thunk pkg)))
+                (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))