commit d19e124bd397a6d7829a403cec4d3cfc8d0d90de
parent 6b69a149046b0408bf517f3d7f6a1d0e5c4a9947
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 19 Oct 2013 07:35:34 -0600
make snapshot-site: add "current" links for installers
original commit: e4f4324fa9e17f8d2590d250dd9da4fcecf9a8cd
Diffstat:
2 files changed, 37 insertions(+), 4 deletions(-)
diff --git a/pkgs/distro-build/download-page.rkt b/pkgs/distro-build/download-page.rkt
@@ -41,6 +41,7 @@
#:docs-url [docs-url #f]
#:pdf-docs-url [pdf-docs-url #f]
#:title [title "Racket Downloads"]
+ #:current-rx [current-rx #f]
#:git-clone [git-clone #f]
#:post-content [post-content null])
@@ -131,9 +132,12 @@
[(2) (~a "major" (if key "" " group"))]
[(3) "minor"]
[else "subminor"]))
+ (define num-cols (if current-rx
+ "7"
+ "5"))
(cond
[(not mid-cols)
- `(tr (td ((colspan "5")) nbsp))]
+ `(tr (td ((colspan ,num-cols)) nbsp))]
[inst
`(tr (td
,@(for/list ([col (in-list mid-cols)])
@@ -158,10 +162,24 @@
,(call-with-input-file*
(build-path (path-only table-file)
inst)
- sha1)))))]
+ sha1))))
+ ,@(if current-rx
+ `((td nbsp)
+ (td (span ([class "detail"])
+ ,(if (regexp-match? current-rx inst)
+ `(a ([href ,(url->string
+ (combine-url/relative
+ (string->url installers-url)
+ (bytes->string/utf-8
+ (regexp-replace current-rx
+ (string->bytes/utf-8 inst)
+ #"current"))))])
+ "as " ldquo "current" rdquo)
+ 'nbsp))))
+ null))]
[else
`(tr (td ((class ,level-class)
- (colspan "5"))
+ (colspan ,num-cols))
,@(for/list ([col (in-list mid-cols)])
`(span nbsp nbsp nbsp))
,last-col))])))
diff --git a/pkgs/distro-build/manage-snapshots.rkt b/pkgs/distro-build/manage-snapshots.rkt
@@ -50,9 +50,23 @@
(flush-output)
(delete-directory/files (build-path snapshots-dir s)))))
-(printf "Creating \"current\" link\n")
+(define current-rx (regexp (regexp-quote (version))))
+
+(printf "Creating \"current\" links\n")
(flush-output)
(make-file-or-directory-link current-snapshot link-file)
+(let ([installer-dir (build-path snapshots-dir current-snapshot "installers")])
+ (for ([f (in-list (directory-list installer-dir))])
+ (when (regexp-match? current-rx f)
+ (define file-link (build-path
+ installer-dir
+ (bytes->path
+ (regexp-replace current-rx
+ (path->bytes f)
+ "current"))))
+ (when (link-exists? file-link)
+ (delete-file file-link))
+ (make-file-or-directory-link f file-link))))
(make-download-page (build-path site-dir
installers-dir
@@ -64,6 +78,7 @@
"current/pdf-doc/")
#:dest (build-path snapshots-dir
"index.html")
+ #:current-rx current-rx
#:git-clone (current-directory)
#:post-content `((p "Snapshot ID: "
(a ((href ,(string-append current-snapshot
