[Chicken-hackers] [PATCH] copy directories recursively when given to "install-extension"

[Felix]

The attached patch is an attempt to fix the problem recently reported
about the broken installation of the "spock" egg. This egg wants to
install a local directory with library code in the repository, but the
command to copy the directory and all contained files is currently
broken, due to incompatibilities between UNIX' and Windows' way of
copying files.

The patch modifies "install-extension" to detect directories and copy
contained files individually, taking care of creating subdirectories
as needed. This seems to work fine on Linux and Windows, at least for
the simple tests I did.


cheers,
felix

>From 1d1272c9ee9469f78d7c96fdc1bcb698b43ba722 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Tue, 5 Jun 2012 11:17:08 +0200
Subject: [PATCH] copy directories on installation recursively

---
 setup-api.scm |   17 +++++++++++++----
 1 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/setup-api.scm b/setup-api.scm
index f42de41..7203a2f 100644
--- a/setup-api.scm
+++ b/setup-api.scm
@@ -501,8 +501,17 @@
                      to-path
                      (make-pathname prefix to-path) )
                  to-path))))
-    (ensure-directory to)
-    (run (,*copy-command* ,(shellpath from) ,(shellpath to)))
+    (let walk ((from from) (to to))
+      (cond ((directory? from)
+            (for-each
+             (lambda (f)
+               (walk (make-pathname from f) (make-pathname to f)))
+             (directory from)))
+           (else
+            (ensure-directory to)
+            (run (,*copy-command* 
+                  ,(shellpath from)
+                  ,(shellpath to))))))
     to))
 
 (define (path-prefix? pref path)
@@ -667,8 +676,8 @@
     (ensure-directory p)
     p) )
 
-(define (ensure-directory path)
-  (and-let* ((dir (pathname-directory path)))
+(define (ensure-directory path #!optional full)
+  (and-let* ((dir (if full path (pathname-directory path))))
     (if (file-exists? dir)
        (unless (directory? dir)
          (error "cannot create directory: a file with the same name already 
exists") )
-- 
1.6.0.4