suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

site' and snapshot-site' targets: make page prettier

Browse Source 
Sorting downloads into categories involves encodings within the
build name: "|" is for hierarchy, and "{...}" affects sorting
but is stripped from the displayed name.
This commit is contained in:
Matthew Flatt 2013-09-10 18:54:28 -06:00
parent c5776e642f
commit 65302df482
2 changed files with 128 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
pkgs/distro-build/doc.txt
View File

@ -257,8 +257,8 @@ Site-configuration keywords (where <string*> means no spaces, etc.):
Machine-only keywords:
#:name <string> --- defaults to host; this string is recorded as a
description of the installer (for use in a generated table of
installer links, for example)
description of the installer and can be used in a generated table of
installer links; see also "Names and Download Pages" below
More precisely, the `distro-build/config' language is like
`racket/base' except that the module body must have exactly one
@ -328,6 +328,38 @@ configuration keywords to values.
distirbution folder. This function is used by `make-readme' when
`#:platform' in `config' is 'macosx.
Names and Download Pages
------------------------
The `#:name' for an installer is used in an HTML table of download
links by the `site' or `snapshot-site' targets. The names are first
sorted. Then, for the purposes of building the table, a "|" separated
by any number of spaces within a name is treated as a hierarchical
delimiter, while anything within "{" and "}" in a hierarchical level
is stripped from the displayed name along with surrounding spaces (so
that it can affect sorting without being displayed).
For example, the names
"Racket | {2} Linux | 32-bit"
"Racket | {2} Linux | 64-bit"
"Racket | {1} Windows | 32-bit"
"Racket | {1} Windows | 64-bit"
"Racket | {3} Source"
are shown (actually or conceptually) as
Racket
Windows
[32-bit]
[64-bit]
Linux
[32-bit]
[64-bit]
[Source]
where the square-bracketed entries are hyperlinks.
Examples
--------

118
pkgs/distro-build/download-page.rkt
View File

@ -2,6 +2,7 @@
(require racket/format
racket/path
racket/system
racket/list
net/url
openssl/sha1
xml)
@ -37,7 +38,7 @@
(define (make-download-page table-file
#:dest [dest "index.html"]
#:installers-url [installers-url "./"]
#:docs-url [docs-url #f]
#:docs-url [docs-url "go"]
#:pdf-docs-url [pdf-docs-url #f]
#:title [title "Racket Downloads"]
#:git-clone [git-clone #f]
@ -58,6 +59,49 @@
(apply system* args))
(get-output-string s))
(define sorted
(sort (hash-keys table) string<?))
(define sorted-and-split
(map (lambda (s)
(map (lambda (e)
(regexp-replace* #rx"^ *{[^}]*} *"
e
""))
(regexp-split #rx" *[|] *" s)))
sorted))
(define elems
(let loop ([l sorted-and-split]
[keys sorted]
[prev null]
[started? #f])
(define len (length prev))
(define (add-sep l)
(if (and started?
(null? prev))
(cons '(#f) l)
l))
(cond
[(null? l) '((#f) (#f nbsp))]
[(not (equal? prev (take (car l) len)))
;; move out a layer:
(loop l keys (drop-right prev 1) #t)]
[(= (add1 len) (length (car l)))
;; a leaf entry:
(add-sep
(cons (cons (car keys)
(append (make-list len 'nbsp)
(list (list-ref (car l) len))))
(loop (cdr l) (cdr keys) prev #t)))]
[else
;; add a heder
(define section (list-ref (car l) len))
(add-sep
(cons (cons #f
(append (make-list len 'nbsp)
(list section)))
(loop l keys (append prev (list section)) #t)))])))
(call-with-output-file*
dest
#:exists 'truncate/replace
@ -68,33 +112,59 @@
(head (title ,title)
(style ,(~a " .detail { font-size: small; }"
" .checksum, .path { font-family: monospace; }"
" .group { background-color : #ccccff; padding-left: 0.5ex; }"
" .major { font-weight : bold; font-size : large; left-border: 1ex; }"
" .minor { font-weight : bold; }"
" a { text-decoration: none; }")))
(body
(h2 ,title)
(table
,@(for/list ([key (in-list (sort (hash-keys table) string<?))])
(define inst (hash-ref table key))
`(tr (td (a ((class "installer")
(href ,(url->string
(combine-url/relative
(string->url installers-url)
inst))))
,key))
(td nbsp)
(td (span ([class "detail"])
,(~r (/ (file-size (build-path (path-only table-file)
inst))
(* 1024 1024))
#:precision 1)
" MB"))
(td nbsp)
(td (span ([class "detail"])
"SHA1: "
(span ([class "checksum"])
,(call-with-input-file*
(build-path (path-only table-file)
inst)
sha1)))))))
,@(for/list ([elem (in-list elems)])
(define key (car elem))
(define inst (and key (hash-ref table key)))
(define mid-cols (if (null? (cdr elem))
#f
(drop-right (cdr elem) 1)))
(define last-col (last elem))
(define level-class
(case (length elem)
[(2) (~a "major" (if key "" " group"))]
[(3) "minor"]
[else "subminor"]))
(cond
[(not mid-cols)
`(tr (td ((colspan "5")) nbsp))]
[inst
`(tr (td
,@(for/list ([col (in-list mid-cols)])
`(span nbsp nbsp nbsp))
(a ((class ,(string-append "installer " level-class))
(href ,(url->string
(combine-url/relative
(string->url installers-url)
inst))))
,last-col))
(td nbsp)
(td (span ([class "detail"])
,(~r (/ (file-size (build-path (path-only table-file)
inst))
(* 1024 1024))
#:precision 1)
" MB"))
(td nbsp)
(td (span ([class "detail"])
"SHA1: "
(span ([class "checksum"])
,(call-with-input-file*
(build-path (path-only table-file)
inst)
sha1)))))]
[else
`(tr (td ((class ,level-class)
(colspan "5"))
,@(for/list ([col (in-list mid-cols)])
`(span nbsp nbsp nbsp))
,last-col))])))
,@(if docs-url
`((p (a ((href ,docs-url)) "Documentation")
,@(if pdf-docs-url