~ chicken-core (chicken-5) 7cf997642a59c0d9183f58e1de1380b8f5b8990e
commit 7cf997642a59c0d9183f58e1de1380b8f5b8990e
Author: Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Sun Sep 14 15:14:43 2014 +0200
Commit: Mario Domenech Goulart <mario.goulart@gmail.com>
CommitDate: Sun Sep 14 18:36:54 2014 -0300
Remove subversion transport type from setup-download
It is not really as useful anymore with the new SYSTEM. And it's still
possible to just make a local checkout.
Signed-off-by: Mario Domenech Goulart <mario.goulart@gmail.com>
diff --git a/setup-download.scm b/setup-download.scm
index 66145ac3..7fd6a5fa 100644
--- a/setup-download.scm
+++ b/setup-download.scm
@@ -30,7 +30,6 @@
(module setup-download (retrieve-extension
locate-egg/local
- locate-egg/svn
locate-egg/http
gather-egg-information
list-extensions
@@ -159,74 +158,6 @@
(with-input-from-file meta read))))))))))
ls)))
- (define (make-svn-ls-cmd uarg parg pnam #!key recursive?)
- (conc "svn ls " uarg #\space parg (if recursive? " -R " " ") (qs pnam)) )
-
- (define (make-svn-export-cmd uarg parg dir tmpdir)
- (conc "svn export " uarg #\space parg #\space #\" dir #\" #\space #\" tmpdir #\"
- (if *quiet* " 1>&2" "")) )
-
- (define (list-eggs/svn repo #!optional username password)
- (let ([uarg (if username (string-append "--username='" username "'") "")]
- [parg (if password (string-append "--password='" password "'") "")])
- (let ([cmd (make-svn-ls-cmd uarg parg repo)])
- (d "listing extension directory ...~% ~a~%" cmd)
- (string-intersperse
- (map (lambda (s) (string-append (string-chomp s "/") "\n"))
- (with-input-from-pipe cmd read-lines))
- ""))))
-
- (define (list-egg-versions/svn name repo #!optional username password)
- (let* ((uarg (if username (string-append "--username='" username "'") ""))
- (parg (if password (string-append "--password='" password "'") ""))
- (cmd (make-svn-ls-cmd uarg parg (make-pathname repo (string-append name "/tags"))))
- (input (with-input-from-pipe cmd read-lines)))
- (if (null? input)
- "unknown\n"
- (string-intersperse
- (map (lambda (s) (string-append (string-chomp s "/") "\n"))
- (with-input-from-pipe cmd read-lines))
- ""))))
-
- (define (locate-egg/svn egg repo #!optional version destination username password)
- (let* ([uarg (if username (string-append "--username='" username "'") "")]
- [parg (if password (string-append "--password='" password "'") "")]
- [cmd (make-svn-ls-cmd uarg parg (make-pathname repo egg) recursive?: #t)])
- (d "checking available versions ...~% ~a~%" cmd)
- (let* ([files (with-input-from-pipe cmd read-lines)]
- [tagver (existing-version
- egg version
- (filter-map
- (lambda (f)
- (and-let* ((m (irregex-search "^tags/([^/]+)/" f)))
- (irregex-match-substring m 1)))
- files))])
- (let-values ([(filedir ver)
- (if tagver
- (values (string-append "tags/" tagver) tagver)
- (begin
- (when-no-such-version-warning egg version)
- (if (member "trunk/" files)
- (values "trunk" "trunk")
- (values "" "") ) ) ) ] )
- (let* ((tmpdir (make-pathname (or destination (get-temporary-directory)) egg))
- (cmd (make-svn-export-cmd
- uarg parg
- (conc
- repo #\/ egg #\/
- (if (eq? *mode* 'meta)
- (metafile filedir egg)
- filedir))
- (if (eq? *mode* 'meta)
- (begin
- (create-directory tmpdir)
- (metafile tmpdir egg))
- tmpdir))))
- (d " ~a~%" cmd)
- (if (zero? (system cmd))
- (values tmpdir ver)
- (values #f "") ) ) ) ) ) )
-
(define (metafile dir egg)
(conc dir #\/ egg ".meta"))
@@ -464,8 +395,6 @@
(case transport
((local)
(locate-egg/local name location version destination clean) )
- ((svn)
- (locate-egg/svn name location version destination username password) )
((http)
(locate-egg/http name location version destination tests proxy-host proxy-port proxy-user-pass) )
(else
@@ -477,8 +406,6 @@
(case transport
((local)
(list-eggs/local location) )
- ((svn)
- (list-eggs/svn location username password) )
((http)
(list-eggs/http location proxy-host proxy-port proxy-user-pass))
(else
@@ -490,8 +417,6 @@
(case transport
((local)
(list-egg-versions/local name location) )
- ((svn)
- (list-egg-versions/svn name location username password) )
(else
(error "cannot list extensions - unsupported transport" transport) ) ) ) )
Trap