Ticket #864: 0001-copy-directories-on-installation-recursively.patch

File 0001-copy-directories-on-installation-recursively.patch, 1.3 KB (added by felix winkelmann, 12 years ago)

  • setup-api.scm 

    From 1d1272c9ee9469f78d7c96fdc1bcb698b43ba722 Mon Sep 17 00:00:00 2001
From: felix <felix@call-with-current-continuation.org>
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 b  
    501501                      to-path
    502502                      (make-pathname prefix to-path) )
    503503                  to-path))))
    504     (ensure-directory to)
    505     (run (,*copy-command* ,(shellpath from) ,(shellpath to)))
     504    (let walk ((from from) (to to))
     505      (cond ((directory? from)
     506             (for-each
     507              (lambda (f)
     508                (walk (make-pathname from f) (make-pathname to f)))
     509              (directory from)))
     510            (else
     511             (ensure-directory to)
     512             (run (,*copy-command*
     513                   ,(shellpath from)
     514                   ,(shellpath to))))))
    506515    to))
    507516
    508517(define (path-prefix? pref path)
    … …  
    667676    (ensure-directory p)
    668677    p) )
    669678
    670 (define (ensure-directory path)
    671   (and-let* ((dir (pathname-directory path)))
     679(define (ensure-directory path #!optional full)
     680  (and-let* ((dir (if full path (pathname-directory path))))
    672681    (if (file-exists? dir)
    673682        (unless (directory? dir)
    674683          (error "cannot create directory: a file with the same name already exists") )