~ chicken-core (chicken-5) c48a109d668f3186bb4a213940c0b0b81a1ad03d
commit c48a109d668f3186bb4a213940c0b0b81a1ad03d
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Jun 5 11:17:08 2012 +0200
Commit: Peter Bex <peter.bex@xs4all.nl>
CommitDate: Tue Jun 12 20:05:20 2012 +0200
copy directories on installation recursively
Signed-off-by: Peter Bex <peter.bex@xs4all.nl>
diff --git a/setup-api.scm b/setup-api.scm
index f42de41d..50ab4842 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") )
Trap