- --dest-dir is now taken to be a (string) prefix for the files, as

this seems to be what other tools use; consequently, the default
    is now the empty string instead of "/",
- removed re-root-file-name,
- layouts can now be specified as functions in .scsh-pkg-defaults.scm,
- bug fix: textual layouts on the command line now work.

scheme/install-lib/install-lib.scm

@@ -1,5 +1,5 @@
 ;;; Installation library for scsh modules.
-;;; $Id: install-lib.scm,v 1.18 2004/05/22 10:43:08 michel-schinz Exp $
+;;; $Id: install-lib.scm,v 1.19 2004/06/13 17:56:13 michel-schinz Exp $
 
 ;; TODO
 ;; - think about --build: does it make sense?
@@ -98,15 +98,6 @@
       (path-list->file-name (append (make-list (- (length dir-pl) cp-len) "..")
                                     (drop abs-pl cp-len))))))
 
-;; Return the name of FNAME, which must be absolute, with NEW-ROOT as
-;; root.
-(define (re-root-file-name fname new-root)
-  (let ((fname-pl (split-file-name fname))
-        (new-root-pl (split-file-name new-root)))
-    (if (string=? (first fname-pl) "")
-        (path-list->file-name (append new-root-pl (cdr fname-pl)))
-        (error "no root to replace in relative file name" fname))))
-
 ;; Similar to path-list->file-name, but take all arguments as
 ;; components of the path.
 (define (paths->file-name . paths)
@@ -302,13 +293,14 @@
     (lambda (str)
       (call-with-current-continuation
        (lambda (return)
+         (lambda (pkg)
            (map (lambda (name&value)
                   (let ((name/value (split-sides name&value)))
                     (if (= 2 (length name/value))
                         (cons (string->symbol (first name/value))
                               (second name/value))
                         (return #f))))
-              (split-defs str)))))))
+                (split-defs str))))))))
 
 ;; Return an absolute version of LAYOUT by prepending PREFIX to all
 ;; its components (which must be relative).
@@ -384,12 +376,14 @@
     ("fhs"         . ,fhs-layout)
     ("fhs-program" . ,fhs-program-layout)))
 
-;; If NAME-OR-LAYOUT refers to a predefined layout, return it.
-;; Otherwise, if NAME-OR-LAYOUT is a valid layout definition, parse
-;; and return it. Otherwise, return false.
-(define (resolve-layout name-or-layout)
-  (or (alist-get name-or-layout predefined-layouts #f)
-      (parse-layout name-or-layout)))
+;; If LAYOUT-SPEC is a procedure, return it as-is. If it's a string
+;; and refers to a predefined layout, this layout is returned. If it's
+;; a string and a valid layout definition, parse and return it.
+;; Otherwise, return false.
+(define (resolve-layout layout-spec)
+  (or (and (procedure? layout-spec) layout-spec)
+      (alist-get layout-spec predefined-layouts #f)
+      (parse-layout layout-spec)))
 
 ;;
 ;; Packages
@@ -700,7 +694,7 @@
 (define (install-packages packages options-values)
   (let* ((prefix (alist-get 'prefix options-values))
          (dest-dir (alist-get 'dest-dir options-values))
-         (dest-prefix (and prefix (re-root-file-name prefix dest-dir)))
+         (dest-prefix (and prefix (string-append dest-dir prefix)))
          (layout-fn (resolve-layout (alist-get 'layout options-values)))
          (layout-to (alist-get 'layout-to options-values))
          (build (alist-get 'build options-values))
@@ -1006,7 +1000,7 @@ END
 
 (define options-defaults
   `((prefix          . #f)
-    (dest-dir        . "/")
+    (dest-dir        . "")
     (layout          . "scsh")
     (layout-to       . #f)
     (build           . ,(host))
@@ -1019,7 +1013,7 @@ END
 
 (define program-options-defaults
   `((prefix          . "/usr/local")
-    (dest-dir        . "/")
+    (dest-dir        . "")
     (layout          . "fhs-program")
     (layout-to       . #f)
     (build           . ,(host))