Download platform selector

collects/meta/web/common/extras.rkt

@@ -6,3 +6,10 @@
 (define (parlist first . rest)
   (list (div class: 'parlisttitle first)
         (map (lambda (p) (div class: 'parlistitem p)) rest)))
+
+;; a div that is centered, but the text is still left-justified
+(provide center-div)
+(define (center-div . text)
+  (div align: 'center
+       (div align: 'left style: "display: inline-block;"
+            text)))

collects/meta/web/download/data.rkt

@@ -90,9 +90,8 @@
      "http://www.eecs.northwestern.edu/racket/"
      "Robby Findler"
      "robby@eecs.northwestern.edu")
-    #;
     ("USA, Utah (University of Utah)"
-     "http://www.cs.utah.edu/plt/download/"
+     "http://www.cs.utah.edu/plt/installers/"
      "Matthew Flatt"
      "mflatt@cs.utah.edu")
     #; ; Scheme guy left
@@ -130,7 +129,8 @@
 
 (provide versions+dates all-versions current-version version->date
          (struct-out mirror) mirrors
-         (struct-out installer) all-installers platform->name suffix->name)
+         (struct-out installer) all-installers
+         package->name platform->name suffix->name)
 
 (require racket/list racket/file version/utils racket/runtime-path)
 
@@ -209,22 +209,31 @@
 
 (define all-installers (call-with-input-file installers-data parse-installers))
 
+(define package->name
+  (let ([t (make-hasheq)])
+    (lambda (package)
+      (hash-ref! t package
+        (lambda ()
+          (string-titlecase
+           (regexp-replace #rx"-" (symbol->string package) " ")))))))
+
 (define platform-names
   (for/list ([pn (in-list -platform-names-)])
     (list (regexp (string-append "^" (car pn) "$")) (cadr pn))))
 
-(define platform-names-table (make-hash))
-
-(define (platform->name platform)
-  (hash-ref! platform-names-table platform
-    (lambda ()
-      (or (for/or ([pn (in-list platform-names)])
-            ;; find out if a regexp applied by checking if the result is
-            ;; different (relies on regexp-replace returning the same string
-            ;; when fails)
-            (let ([new (regexp-replace (car pn) platform (cadr pn))])
-              (and (not (eq? new platform)) new)))
-          (error 'platform->name "unrecognized platform: ~e" platform)))))
+(define platform->name
+  (let ([t (make-hash)])
+    (lambda (platform)
+      (hash-ref! t platform
+        (lambda ()
+          (or (for/or ([pn (in-list platform-names)])
+                ;; find out if a regexp applied by checking if the result is
+                ;; different (relies on regexp-replace returning the same
+                ;; string when fails)
+                (let ([new (regexp-replace (car pn) platform (cadr pn))])
+                  (and (not (eq? new platform)) new)))
+              (error 'platform->name "unrecognized platform: ~e"
+                     platform)))))))
 
 (define (suffix->name suffix)
   (cond [(assoc suffix -file-type-names-) => cadr]

collects/meta/web/download/download-pages.rkt

@@ -0,0 +1,58 @@
+#lang at-exp s-exp "shared.rkt"
+
+(require "data.rkt" "installer-pages.rkt")
+
+(provide render-download-page)
+
+(define (render-download-page [version current-version] [package 'racket])
+  @center-div{
+    @h2{Download @(package->name package)
+                 v@version (@(version->date version))}
+    @div[id: "download_panel" style: "display: none;"]{
+      Platform:
+      @select[id: "platform_selector"]{
+        @(for/list ([i (in-list all-installers)]
+                    #:when (and (equal? version (installer-version i))
+                                (equal? package (installer-package i))))
+           (installer->page i 'render-option))}
+      @input[type: 'submit value: "Download" onclick: "do_jump();"]}
+    @script/inline[type: 'text/javascript]{
+      document.getElementById("download_panel").style.display = "block";
+      function do_jump() {
+        var sel = document.getElementById("platform_selector");
+        location.href = sel[sel.selectedIndex].value;
+      }
+      @platform-script
+    }
+    @noscript{
+      Installers are available for the following platforms:
+      @ul{@(for/list ([i (in-list all-installers)]
+                      #:when (and (equal? version (installer-version i))
+                                  (equal? package (installer-package i))))
+             @li{@(installer->page i 'only-platform)})}}})
+
+(define platform-script
+  @literal{@||
+    (function() {
+    var opts = document.getElementById("platform_selector").options;
+    var len = opts.length;
+    // returns a platform name, doubles as a regexp too
+    function getPlatform() {
+      var p = navigator.platform;
+      var l = function(str) { return p.indexOf(str) != -1@";" }
+      // The default is the common case
+      return (p == null)  ? "Windows" :
+             l("Linux") ? (l("_64") ? "Linux x86_64" : "Linux i386")   :
+             l("SunOS") ? "Solaris" :
+             l("Mac") ? (l("Intel") ? "Mac OS X Intel" : "Mac OS X PPC") :
+             "Windows";
+    }
+    // convert name to a regexp by splitting on words
+    var rx = new RegExp(getPlatform().replace(/ +/g,".*"));
+    for (var i=0@";" i<len@";" i++) {
+      if (opts[i].text.search(rx) >= 0) {
+        opts.selectedIndex = i; break;
+      }
+    }
+    })();
+    @||})

collects/meta/web/download/installer-pages.rkt

@@ -8,9 +8,7 @@
   (define html-file (string-append (regexp-replace* #rx"\\." file "-") ".html"))
   (define version (installer-version installer))
   (define date (version->date version))
-  (define package
-    (string-titlecase
-     (regexp-replace #rx"-" (->string (installer-package installer)) " ")))
+  (define package (package->name (installer-package installer)))
   (define size (installer-size installer))
   (define type (if (installer-binary? installer) "" " source"))
   (define platform (platform->name (installer-platform installer)))
@@ -21,13 +19,19 @@
       @td[align: 'right]{@b{@label}:}
       @td{@nbsp}
       @td[align: 'left]{@text}})
-  @page[#:file html-file #:title title]{
+  (define (this url [mode #f])
+    (case mode
+      [(only-platform) (a href: url platform type)]
+      [(render-option) (option value: url platform type)]
+      [(#f) @a[href: url]{@title}]
+      [else (error 'installer-page "unknown mode: ~e" mode)]))
+  @page[#:file html-file #:title title #:referrer this]{
     @table[width: "90%" align: 'center]{
       @tr[valign: 'top]{
         @td[width: "50%"]{
           @table{@(row "Package" package)
                  @(row "Version" @list{@version (@date)})
-                 @(row "Platform" platform)
+                 @(row "Platform" (list platform type))
                  @(row "Type"     suffix-desc)
                  @(row "File"     file)
                  @(row "Size"     size)}}
@@ -47,5 +51,10 @@
     @;div[align: 'right]{(@(link-to 'license))}
     })
 
-(provide installer-pages)
-(define installer-pages (map render-installer-page all-installers))
+(provide installer->page)
+(define installer->page
+  (let ([t (make-hasheq)])
+    (lambda (inst . more)
+      (let ([page (hash-ref! t inst (lambda ()
+                                      (render-installer-page inst)))])
+        (if (null? more) page (apply page more))))))

collects/meta/web/www/download.rkt

@@ -1,13 +1,13 @@
 #lang at-exp s-exp "shared.rkt"
 
-(require "../download/installer-pages.rkt")
+(require "../download/download-pages.rkt")
 
 (provide download-button)
 
 (define download
   (page #:link-title "Download" #:window-title "Download Racket"
         #:file "download/"
-    (ul (map li installer-pages))))
+    (render-download-page)))
 
 (define download-button
   (let ([img1 (copyfile (in-here "download.png"))]