scsh-conservatory
/
scsh-install-lib
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

- fixed usage string, 

- improved the "use hint" displayed at the end, and moved the code
  producing it to a separate function,
- made "--help" work even when no "pkg-def.scm" file is found.
This commit is contained in:
michel-schinz 2004-03-31 19:44:54 +00:00
parent f110632621
commit 9fdff3a77c
1 changed files with 61 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
scheme/install-lib/install-lib.scm
View File

@ -1,5 +1,5 @@
;;; Installation library for scsh modules.
;;; $Id: install-lib.scm,v 1.13 2004/03/14 14:10:25 michel-schinz Exp $
;;; $Id: install-lib.scm,v 1.14 2004/03/31 19:44:54 michel-schinz Exp $
;; TODO
;; - think about --host: does it make sense?
@ -428,7 +428,8 @@
(define (load-packages)
(let-fluid *packages* (make-cell '())
(lambda ()
(load-quietly package-definition-file)
(if (file-exists? package-definition-file)
(load-quietly package-definition-file))
(cell-ref (fluid *packages*)))))
;; Like load-package but check additionally that none of the loaded
@ -529,12 +530,14 @@
;; Load script handling
;;
(define load-script-name "load.scm")
;; Evaluate THUNK with CURRENT-OUTPUT-PORT opened on the current
;; package's loading script (in the install directory). During a dry
;; run, or when only non-shared data has to be installed, do nothing.
(define (with-output-to-load-script* thunk)
(let* ((dir (get-directory 'base #t))
(file (absolute-file-name "load.scm" dir)))
(file (absolute-file-name load-script-name dir)))
(create-directory&parents dir)
(if (not (or (get-option-value 'dry-run)
(get-option-value 'non-shared-only)))
@ -747,11 +750,11 @@ options:
--no-user-defaults don't read user default from ~~/.scsh-pkg-defaults.scm
advanced options:
--build <name> name of platform for which to build
--layout-from <file> load layout of installation directory from file
--layout-to <file> output layout to given file
--install-prefix <dir> specify prefix to used during installation
(to be used only during staged installations)
--build <name> name of platform for which to build
--layout-from <file> load layout of installation directory from file
--layout-to <file> output layout to given file
--dest-dir <dir> specify prefix to used during installation
(to be used only during staged installations)
END
)
@ -789,6 +792,47 @@ END
(newline)
(exit 1))
;; Display a hint about how to use the just-installed PACKAGES,
;; assuming they were laid out according to LAYOUT and PREFIX.
(define (display-use-hint prefix layout packages)
(let* ((active-locations (delete-duplicates
(map (lambda (pkg)
(string-append "\""
(layout-dir (absolute-layout
(layout pkg)
prefix)
'active)
"\""))
packages)
string=?))
(load-scripts (map (lambda (pkg)
(absolute-file-name load-script-name
(package-name pkg)))
packages))
(scsh-options (map (lambda (load-script)
(string-append "-lel " load-script))
load-scripts)))
(display
(as-string
"The following scsh package" (if (many? packages) "s were" " was")
" installed successfully:\n"
" "(string-join (map package-full-name packages) ", ")"\n"))
(if (not (find-library-file (first load-scripts) (lib-dirs) ""))
(display
(as-string
"To make sure scsh finds "(if (many? packages) "them" "it")", "
"please add the following value"
(if (many? active-locations) "s" "")"\n"
"to the environment variable SCSH_LIB_DIRS (quotes included):\n"
" " (string-join active-locations " ") "\n")))
(display
(as-string
"To use "
(if (many? packages) "these packages" "this package")
" in a script, invoke scsh with the following option"
(if (many? scsh-options) "s" "")":\n"
" "(string-join scsh-options " ")"\n"))))
;;
;; Command line parsing
;;
@ -885,9 +929,6 @@ END
(exclude . ,(lambda args #f))))
(define (install-main cmd-line)
(if (not (file-exists? package-definition-file))
(display-error-and-exit "cannot find package definition file"
"("package-definition-file")"))
(let* ((packages (load&check-packages))
(all-pkg-opts (all-package-options packages)))
(if (not (null? all-pkg-opts))
@ -905,6 +946,14 @@ END
all-dfts))
(prefix (alist-get 'prefix options-values))
(layout (alist-get 'layout options-values)))
(if (null? packages)
(display-error-and-exit
"no package to install"
(if (not (file-exists? package-definition-file))
(as-string "\n(cannot find file called \""
package-definition-file
"\" in current directory)")
"")))
(if (not prefix)
(display-error-and-exit "no prefix specified (use --prefix option)"))
(if (not (file-name-absolute? prefix))
@ -913,25 +962,4 @@ END
(if (not resolved-layout)
(display-error-and-exit "invalid layout "layout))
(install-packages packages options-values)
(let ((active-locations
(delete-duplicates
(map (lambda (pkg)
(string-append "\""
(layout-dir (absolute-layout
(resolved-layout pkg)
prefix)
'active)
"\""))
packages)
string=?)))
(display
(as-string
"The following scsh package" (if (many? packages) "s were" " was")
" installed successfully:\n"
" "(string-join (map package-full-name packages) ", ")"\n"
"In order to use "(if (many? packages) "them" "it")", "
"make sure to add the following value"
(if (many? active-locations) "s" "")"\n"
"to the environment variable SCSH_LIB_DIRS (quotes included):\n"
" " (string-join active-locations " ")
"\n")))))))
(display-use-hint prefix resolved-layout packages)))))