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

This commit is contained in:
michel-schinz 2004-02-20 08:22:07 +00:00
parent 01e77fb69f
commit 47391a548d
2 changed files with 19 additions and 12 deletions

View File

@ -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

View File

@ -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))