suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Adds scm-export-repo', which can be used instead of scm-checkout' to

Browse Source 
get a clean directory.
This commit is contained in:
Eli Barzilay 2010-05-13 00:52:47 -04:00
parent 9f0d446ffd
commit 27f76f2da0
2 changed files with 27 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/meta/drdr/metadata.ss
View File

@ -61,7 +61,7 @@
(define tmp-file (make-temporary-file "props~a.ss" #f (current-temporary-directory))) (define tmp-file (make-temporary-file "props~a.ss" #f (current-temporary-directory)))
(and (and
; Checkout the props file ; Checkout the props file
(scm-export (scm-export-file
rev rev
(plt-repository) (plt-repository)
"collects/meta/props" "collects/meta/props"

29
collects/meta/drdr/scm.ss
View File

@ -42,6 +42,17 @@
[_ [_
#f])) #f]))
(define (pipe/proc cmds)
(if (null? (cdr cmds))
((car cmds))
(let-values ([(i o) (make-pipe 4096)])
(parameterize ([current-output-port o])
(thread (lambda () ((car cmds)) (close-output-port o))))
(parameterize ([current-input-port i])
(pipe/proc (cdr cmds))))))
(define-syntax-rule (pipe expr exprs ...)
(pipe/proc (list (lambda () expr) (lambda () exprs) ...)))
(define (system/output-port #:k k #:stdout [init-stdout #f] . as) (define (system/output-port #:k k #:stdout [init-stdout #f] . as)
(define _ (printf "~S~n" as)) (define _ (printf "~S~n" as))
(define-values (sp stdout stdin stderr) (define-values (sp stdout stdin stderr)
@ -150,7 +161,7 @@
(provide/contract (provide/contract
[scm-commit-author ((or/c git-push? svn-rev-log?) . -> . string?)]) [scm-commit-author ((or/c git-push? svn-rev-log?) . -> . string?)])
(define (scm-export rev repo file dest) (define (scm-export-file rev repo file dest)
(define commit (define commit
(push-data-end-commit (push-info rev))) (push-data-end-commit (push-info rev)))
(call-with-output-file* (call-with-output-file*
@ -164,6 +175,17 @@
(git-path) "--no-pager" "show" (format "~a:~a" commit file))))) (git-path) "--no-pager" "show" (format "~a:~a" commit file)))))
(void)) (void))
(define (scm-export-repo rev repo dest)
(pipe
(system*
(git-path) "archive"
(format "--remote=~a" repo)
(format "--prefix=~a/" (regexp-replace #rx"/+$" (path->string* dest) ""))
"--format=tar"
(push-data-end-commit (push-info rev)))
(system* (find-executable-path "tar") "xf" "-" "--absolute-names"))
(void))
(define (scm-checkout rev repo dest) (define (scm-checkout rev repo dest)
(system* (git-path) "clone" (path->string* repo) (path->string* dest)) (system* (git-path) "clone" (path->string* repo) (path->string* dest))
(parameterize ([current-directory dest]) (parameterize ([current-directory dest])
@ -188,5 +210,6 @@
(provide/contract (provide/contract
[scm-update (path? . -> . void?)] [scm-update (path? . -> . void?)]
[scm-revisions-after (exact-nonnegative-integer? . -> . (listof exact-nonnegative-integer?))] [scm-revisions-after (exact-nonnegative-integer? . -> . (listof exact-nonnegative-integer?))]
[scm-export (exact-nonnegative-integer? path-string? string? path-string? . -> . void?)] [scm-export-file (exact-nonnegative-integer? path-string? string? path-string? . -> . void?)]
[scm-checkout (exact-nonnegative-integer? path-string? path-string? . -> . void?)]) [scm-export-repo (exact-nonnegative-integer? path-string? path-string? . -> . void?)]
[scm-checkout (exact-nonnegative-integer? path-string? path-string? . -> . void?)])