From 2723d084ecd541a42143ee829bea262ed99cde3f Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Thu, 30 Aug 2018 09:23:41 +0200
Subject: [PATCH] Handle directories transparently in chicken-install

---
 egg-compile.scm                 | 75 +++++++++++++++++++++++++++++------------
 manual/Egg specification format |  2 ++
 2 files changed, 56 insertions(+), 21 deletions(-)

diff --git a/egg-compile.scm b/egg-compile.scm
index e6a3dbaa..fff82b27 100644
--- a/egg-compile.scm
+++ b/egg-compile.scm
@@ -773,42 +773,69 @@
     (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)
+         (ddir (quotearg (slashify (shell-variable "DESTDIR" 
+                                                   platform)
                                    platform))))
     (print "\n" mkdir " " ddir dfile)
     (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
@@ -967,3 +994,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
 
-- 
2.16.2