www

commit 3ad9d3b3b4cf16dbe02242576022e6164fe2d1ba
parent ea23f1def588414f76e750f3b2c338eca0da1e2f
Author: Matthew Flatt <mflatt@racket-lang.org>
Date:   Sat,  6 Jul 2013 10:46:27 -0600

show available snapshots on main page

original commit: 580a6cd24adf7d00b24882a6432060e2bfb8ed7c

Diffstat:
M
pkgs/distro-build/manage-snapshots.rkt
 | 
37
++++++++++++++++++++++++++-----------

1 file changed, 26 insertions(+), 11 deletions(-)
diff --git a/pkgs/distro-build/manage-snapshots.rkt b/pkgs/distro-build/manage-snapshots.rkt
@@ -32,18 +32,21 @@
   (printf "Removing old \"current\" link\n")
   (delete-file link-file))
 
-(define snapshots (for/list ([p (in-list (directory-list snapshots-dir))]
-                             #:when (directory-exists? (build-path snapshots-dir p)))
-                    (path-element->string p)))
+(define (get-snapshots)
+  (for/list ([p (in-list (directory-list snapshots-dir))]
+             #:when (directory-exists? (build-path snapshots-dir p)))
+    (path-element->string p)))
 
 (define n (hash-ref config '#:max-snapshots 5))
-(when (n . < . (length snapshots))
-  (define remove-snapshots (remove
-                            current-snapshot
-                            (list-tail (sort snapshots string>?) n)))
-  (for ([s (in-list remove-snapshots)])
-    (printf "Removing snapshot ~a\n" s)
-    (delete-directory/files (build-path snapshots-dir s))))
+
+(let ([snapshots (get-snapshots)])
+  (when (n . < . (length snapshots))
+    (define remove-snapshots (remove
+                              current-snapshot
+                              (list-tail (sort snapshots string>?) n)))
+    (for ([s (in-list remove-snapshots)])
+      (printf "Removing snapshot ~a\n" s)
+      (delete-directory/files (build-path snapshots-dir s)))))
 
 (printf "Creating \"current\" link\n")
 (make-file-or-directory-link current-snapshot link-file)
@@ -58,4 +61,16 @@
                     #:post-content `((p "Snapshot ID: " 
                                         (a ((href ,(string-append current-snapshot
                                                                   "/index.html")))
-                                           ,current-snapshot))))
+                                           ,current-snapshot))
+                                     ,@(let ([snapshots (get-snapshots)])
+                                         (if ((length snapshots) . < . 2)
+                                             null
+                                             `((div ([class "detail"]) 
+                                                  "Other available snapshots:"
+                                                  ,@(for/list ([s (remove "current"
+                                                                          (remove current-snapshot
+                                                                                  (sort snapshots string>?)))])
+                                                      `(span ([class "detail"])
+                                                             nbsp
+                                                             (a ([href ,(string-append s "/index.html")])
+                                                                ,s)))))))))