- 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
parent
f110632621
commit
9fdff3a77c
|
|
@ -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)))
|
||||
|
|
@ -750,7 +753,7 @@ 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
|
||||
--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)))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue