chicken-hackers
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Chicken-hackers] [PATCH] copy directories recursively when given to


From: Felix
Subject: Re: [Chicken-hackers] [PATCH] copy directories recursively when given to "install-extension"
Date: Sun, 10 Jun 2012 00:20:33 +0200 (CEST)

> 
> Why is ensure-directory changed?  The new optional argument isn't being
> passed anywhere I can see, so the change seems to be either unneccessary
> or there's a mistake in one of the calls (looks like the former, to me).

I initially planned to use this in the implementation but it turned
out not to be necessary. Yet, I thought it might come in handy one
day. But I see now that it should be used in two cases. A new patch
is attached.


>From 97d742f1039b3a6b3caa914acaf7d56456c64809 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 |   23 ++++++++++++++++-------
 1 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/setup-api.scm b/setup-api.scm
index f42de41..50ab484 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)
@@ -615,7 +624,7 @@
   (when (setup-install-mode)
     (let* ((files (check-filelist (if (list? files) files (list files))))
           (pre (installation-prefix))
-          (ppath (ensure-directory (make-pathname pre "bin")))
+          (ppath (ensure-directory (make-pathname pre "bin") #t))
           (files (if *windows*
                       (map (lambda (f)
                              (if (list? f) 
@@ -637,7 +646,7 @@
   (when (setup-install-mode)
     (let* ((files (check-filelist (if (list? files) files (list files))))
           (pre (installation-prefix))
-          (ppath (ensure-directory (make-pathname pre "bin")))
+          (ppath (ensure-directory (make-pathname pre "bin") #t))
           (pfiles (map (lambda (f)
                          (let ((from (if (pair? f) (car f) f))
                                (to (make-dest-pathname ppath f)) )
@@ -664,11 +673,11 @@
                          (sprintf "lib/chicken/~a" (##sys#fudge 42)))
                         (repository-path)))) ; otherwise use repo-path
               (repository-path))) )
-    (ensure-directory p)
+    (ensure-directory p #t)
     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


reply via email to

[Prev in Thread] Current Thread [Next in Thread]