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

scheme/install-lib/install-lib.scm

@@ -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
+    (if (not (null? packages))
-     (as-string
+        (begin
-      "The following scsh package" (if (many? packages) "s were" " was")
+          (display
-      " installed successfully:\n"
+           (as-string
-      "  "(string-join (map package-full-name packages) ", ")"\n"))
+            "The following scsh package" (if (many? packages) "s were" " was")
-    (if (not (every (lambda (script)
+            " installed successfully:\n"
-                      (find-library-file script (lib-dirs) ""))
+            "  "(string-join (map package-full-name packages) ", ")"\n"))
-                    load-scripts))
+          (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
+         (as-string "The following scsh package"
-          "To make sure scsh finds "(if (many? packages) "them" "it")", "
+                    (if (many? skipped-pkgs) "s were" " was")
-          "please add the following value"
+                    " *not* installed, because "
-          (if (many? active-locations) "s" "")"\n"
+                    (if (many? skipped-pkgs) "they were" "it was") "\n"
-          "to the environment variable SCSH_LIB_DIRS (quotes included):\n"
+                    "already present (use --force option to force"
-          "  " (string-join active-locations " ") "\n")))
+                    " reinstallation):\n"
-    (display
+                    "  "(string-join (map package-full-name skipped-pkgs) ", ")
-     (as-string
+                    "\n")))))
-      "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
@@ -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)
+        (receive (pkgs-install pkgs-skip)
-        (if display-hint?
+                 (partition-packages prefix resolved-layout packages force?)
-            (display-use-hint prefix resolved-layout packages))))))
+                 (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"))