(module test mzscheme (require (lib "etc.ss")) (require (lib "file.ss")) (define-syntax (source-directory-of-expression stx) (syntax-case stx () [(_ context) (syntax/loc #'context (this-expression-source-directory))])) (define-syntax (in-this-directory stx) (syntax-case stx () [(_ e1 e2 ...) #`(parameterize ([current-directory (source-directory-of-expression #,stx)]) e1 e2 ...)])) (define (rm-rf path) (when (or (file-exists? path) (directory-exists? path)) (delete-directory/files path))) (define keep-new-directories? (make-parameter #f (lambda (new-b) (if (not (boolean? new-b)) (raise-type-error 'keep-new-directories? "boolean" new-b) new-b)))) (define-syntax in-new-directory (syntax-rules () [(_ dir-e e1 e2 ...) (let ([dir dir-e]) (dynamic-wind void (lambda () (rm-rf dir) (make-directory dir) (parameterize ([current-directory dir]) e1 e2 ...)) (lambda () (unless (keep-new-directories?) (rm-rf dir)))))])) (provide keep-new-directories? in-new-directory source-directory-of-expression in-this-directory))