From d19e124bd397a6d7829a403cec4d3cfc8d0d90de Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 19 Oct 2013 07:35:34 -0600
Subject: [PATCH] make snapshot-site: add "current" links for installers

original commit: e4f4324fa9e17f8d2590d250dd9da4fcecf9a8cd
---
 pkgs/distro-build/download-page.rkt    | 24 +++++++++++++++++++++---
 pkgs/distro-build/manage-snapshots.rkt | 17 ++++++++++++++++-
 2 files changed, 37 insertions(+), 4 deletions(-)

diff --git a/pkgs/distro-build/download-page.rkt b/pkgs/distro-build/download-page.rkt
index fe52113..45bbddc 100644
--- 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
index 9677827..4e62611 100644
--- 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