- don't try to install packages which are already installed (provided
the version is the same, of course), - improved error message when a location isn't found.
This commit is contained in:
michel-schinz
parent
956c5219fe
commit
c1c3d8211e
|
|
@ -1,5 +1,5 @@
|
|||
;;; Installation library for scsh modules.
|
||||
;;; $Id: install-lib.scm,v 1.19 2004/06/13 17:56:13 michel-schinz Exp $
|
||||
;;; $Id: install-lib.scm,v 1.20 2004/07/08 12:15:30 michel-schinz Exp $
|
||||
|
||||
;; TODO
|
||||
;; - think about --build: does it make sense?
|
||||
|
|
@ -312,7 +312,9 @@
|
|||
;; Return the directory associated with the LOCATION in LAYOUT.
|
||||
(define (layout-dir layout location)
|
||||
(assert (valid-location? location) "invalid location" location)
|
||||
(alist-get location layout #f))
|
||||
(or (alist-get location layout #f)
|
||||
(display-error-and-exit "cannot find the directory for location '"
|
||||
location "' in active layout.")))
|
||||
|
||||
;; Predefined layouts
|
||||
|
||||
|
|
@ -846,7 +848,7 @@ END
|
|||
|
||||
;; 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)
|
||||
(define (display-use-hint prefix layout packages skipped-pkgs)
|
||||
(let* ((active-locations (delete-duplicates
|
||||
(map (lambda (pkg)
|
||||
(string-append "\""
|
||||
|
|
@ -864,28 +866,40 @@ END
|
|||
(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 (every (lambda (script)
|
||||
(find-library-file script (lib-dirs) ""))
|
||||
load-scripts))
|
||||
(if (not (null? packages))
|
||||
(begin
|
||||
(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 (every (lambda (script)
|
||||
(find-library-file script (lib-dirs) ""))
|
||||
load-scripts))
|
||||
(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"))))
|
||||
(if (not (null? skipped-pkgs))
|
||||
(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"))))
|
||||
(as-string "The following scsh package"
|
||||
(if (many? skipped-pkgs) "s were" " was")
|
||||
" *not* installed, because "
|
||||
(if (many? skipped-pkgs) "they were" "it was") "\n"
|
||||
"already present (use --force option to force"
|
||||
" reinstallation):\n"
|
||||
" "(string-join (map package-full-name skipped-pkgs) ", ")
|
||||
"\n")))))
|
||||
|
||||
;;
|
||||
;; Command line parsing
|
||||
|
|
@ -1024,6 +1038,16 @@ END
|
|||
(force . #f)
|
||||
(exclude . ,(lambda args #f))))
|
||||
|
||||
;; Partition PACKAGES in two sets: the ones which are not installed
|
||||
;; yet, and the ones which are already. If FORCE? is true, pretend
|
||||
;; that all packages are not installed yet.
|
||||
(define (partition-packages prefix layout packages force?)
|
||||
(partition (lambda (pkg)
|
||||
(or force?
|
||||
(file-not-exists?
|
||||
(layout-dir (absolute-layout (layout pkg) prefix) 'base))))
|
||||
packages))
|
||||
|
||||
(define (install-main-internal cmd-line display-hint?)
|
||||
(let* ((packages (load&check-packages))
|
||||
(all-pkg-opts (all-package-options packages)))
|
||||
|
|
@ -1042,7 +1066,8 @@ END
|
|||
all-opts
|
||||
all-dfts))
|
||||
(prefix (alist-get 'prefix options-values))
|
||||
(layout (alist-get 'layout options-values)))
|
||||
(layout (alist-get 'layout options-values))
|
||||
(force? (alist-get 'force options-values)))
|
||||
(if (null? packages)
|
||||
(display-error-and-exit
|
||||
"no package to install"
|
||||
|
|
@ -1058,9 +1083,14 @@ END
|
|||
(let ((resolved-layout (resolve-layout layout)))
|
||||
(if (not resolved-layout)
|
||||
(display-error-and-exit "invalid layout "layout))
|
||||
(install-packages packages options-values)
|
||||
(if display-hint?
|
||||
(display-use-hint prefix resolved-layout packages))))))
|
||||
(receive (pkgs-install pkgs-skip)
|
||||
(partition-packages prefix resolved-layout packages force?)
|
||||
(install-packages pkgs-install options-values)
|
||||
(if display-hint?
|
||||
(display-use-hint prefix
|
||||
resolved-layout
|
||||
pkgs-install
|
||||
pkgs-skip)))))))
|
||||
|
||||
(define (install-main-quiet cmd-line)
|
||||
(install-main-internal cmd-line #f))
|
||||
|
|
@ -1088,7 +1118,8 @@ END
|
|||
all-opts
|
||||
all-dfts))
|
||||
(prefix (alist-get 'prefix options-values))
|
||||
(layout (alist-get 'layout options-values)))
|
||||
(layout (alist-get 'layout options-values))
|
||||
(force? (alist-get 'force options-values)))
|
||||
(if (null? packages)
|
||||
(display-error-and-exit
|
||||
"no package to install"))
|
||||
|
|
|
|||
Loading…
Reference in New Issue