~ chicken-core (chicken-5) 70fed042fc81b37de4a0ecabb06a2ca4e11cb3cc


commit 70fed042fc81b37de4a0ecabb06a2ca4e11cb3cc
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Aug 30 09:23:41 2018 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Fri Aug 31 06:59:44 2018 +1200

    Handle directories transparently in chicken-install
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/egg-compile.scm b/egg-compile.scm
index e523f590..35c871b4 100644
--- a/egg-compile.scm
+++ b/egg-compile.scm
@@ -768,15 +768,12 @@
     (print cmd " " out " " ddir destf)
     (print-end-command platform)))
 
-(define ((install-data name #!key files destination mode) 
-         srcdir platform)
+(define (install-random-files dest files mode srcdir platform)
   (let* ((fcmd (install-file-command platform))
          (dcmd (copy-directory-command platform))
+         (root (string-append srcdir "/"))
          (mkdir (mkdir-command platform))
          (sfiles (map (cut prefix srcdir <>) files))
-         (dest (or destination (if (eq? mode 'target)
-                                   default-sharedir 
-                                   (override-prefix "/share" host-sharedir))))
          (dfile (quotearg (slashify dest platform)))
          (ddir (quotearg (slashify (shell-variable "DESTDIR" platform)
                                    platform))))
@@ -784,26 +781,55 @@
     (let-values (((ds fs) (partition directory? sfiles)))
       (for-each
        (lambda (d)
-         (print dcmd " " (quotearg (slashify d platform)) " " ddir dfile)
-	 (print-end-command platform))
+         (let* ((ds (strip-dir-prefix srcdir d))
+                (fdir (pathname-directory ds)))
+           (when fdir
+             (print mkdir " " ddir
+                    (slashify (make-pathname dfile fdir)
+                              platform)))
+           (print dcmd " " (quotearg (slashify d platform))
+                  " " ddir
+                  (if fdir
+                      (slashify (make-pathname dfile fdir)
+                                platform)
+                      dfile))
+           (print-end-command platform)))
        ds)
       (when (pair? fs)
-        (print fcmd (arglist fs) " " ddir dfile)
-	(print-end-command platform)))))
+        (for-each
+          (lambda (f)
+            (let* ((fs (strip-dir-prefix srcdir f))
+                   (fdir (pathname-directory fs)))
+              (when fdir
+                (print mkdir " " ddir
+                       (slashify (make-pathname dfile fdir)
+                                 platform)))
+              (print fcmd " " (quotearg (slashify f platform))
+                     " " ddir
+                     (if fdir
+                         (slashify (make-pathname dfile fdir)
+                                   platform)
+                         dfile)))
+            (print-end-command platform))
+          fs)))))
+
+(define ((install-data name #!key files destination mode)
+         srcdir platform)
+  (install-random-files (or destination
+                            (if (eq? mode 'target)
+                                default-sharedir
+                                (override-prefix "/share"
+                                                 host-sharedir)))
+                        files mode srcdir platform))
 
 (define ((install-c-include name #!key deps files destination mode) 
          srcdir platform)
-  (let* ((cmd (install-file-command platform))
-         (mkdir (mkdir-command platform))
-         (dest (or destination (if (eq? mode 'target) 
-                                   default-incdir 
-                                   (override-prefix "/include" host-incdir))))
-         (dfile (quotearg (slashify dest platform)))
-         (ddir (quotearg (slashify (shell-variable "DESTDIR" platform)
-                                   platform))))
-    (print "\n" mkdir " " ddir dfile)
-    (print cmd (arglist (map (cut prefix srcdir <>) files)) " " ddir dfile)
-    (print-end-command platform)))
+  (install-random-files (or destination
+                            (if (eq? mode 'target)
+                                default-incdir
+                                (override-prefix "/include"
+                                                 host-incdir)))
+                        files mode srcdir platform))
 
 
 ;;; Generate shell or batch commands from abstract build/install operations
@@ -962,3 +988,9 @@ EOF
 (define (print-end-command platform)
   (case platform
     ((windows) (print "if errorlevel 1 exit /b 1"))))
+
+(define (strip-dir-prefix prefix fname)
+  (let* ((plen (string-length prefix))
+         (p1 (substring fname 0 plen)))
+    (assert (string=? prefix p1) "wrong prefix")
+    (substring fname (add1 plen))))
diff --git a/manual/Egg specification format b/manual/Egg specification format
index 3f5a7212..b97e7e94 100644
--- a/manual/Egg specification format	
+++ b/manual/Egg specification format	
@@ -336,6 +336,8 @@ locations, which are:
 
 Specifies source files for this component and only applies
 to components of type {{data}}, {{c-include}} and {{scheme-include}}.
+Both files and directories may be given and parent directories
+are created as needed.
 
 ==== modules
 
Trap