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

make site: add support for help pop-ups on generated download page

Browse Source
This commit is contained in:
Matthew Flatt 2013-11-11 05:18:02 -07:00
parent 7dd10fc9bd
commit 61a78d00e9
5 changed files with 69 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
pkgs/distro-build/assemble-site.rkt
View File

@ -121,4 +121,5 @@
"pdf-doc/") "pdf-doc/")
#:dest (build-path dest-dir #:dest (build-path dest-dir
"index.html") "index.html")
#:help-table (hash-ref config '#:site-help (hash))
#:git-clone (current-directory)) #:git-clone (current-directory))

1
pkgs/distro-build/config.rkt
View File

@ -147,6 +147,7 @@
[(#:source-pkgs?) (boolean? val)] [(#:source-pkgs?) (boolean? val)]
[(#:mac-pkg?) (boolean? val)] [(#:mac-pkg?) (boolean? val)]
[(#:site-dest) (path-string? val)] [(#:site-dest) (path-string? val)]
[(#:site-help) (hash? val)]
[(#:pdf-doc?) (boolean? val)] [(#:pdf-doc?) (boolean? val)]
[(#:max-snapshots) (real? val)] [(#:max-snapshots) (real? val)]
[(#:pause-before) (and (real? val) (not (negative? val)))] [(#:pause-before) (and (real? val) (not (negative? val)))]

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

@ -306,6 +306,13 @@ Top keywords (recognized only in the configuration top-level):
supply non-#f `#:smtp-user' and `#:smtp-password' when supply non-#f `#:smtp-user' and `#:smtp-password' when
authentication is required by the server authentication is required by the server
#:site-help <hash-table> --- hash table of extra "help" information
for entries on a web page created by the `site' and
`snapshot-site' makefile targets; the hash keys are strings for
row labels in the download table (after splitting on "|" and
removing "{...}"), and the values are X-expressions for the help
content
More precisely, the `distro-build/config' language is like More precisely, the `distro-build/config' language is like
`racket/base' except that the module body must have exactly one `racket/base' except that the module body must have exactly one
expression (plus any number of definitions, etc.) that produces a expression (plus any number of definitions, etc.) that produces a

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

@ -1,4 +1,4 @@
#lang racket/base #lang at-exp racket/base
(require racket/format (require racket/format
racket/path racket/path
racket/system racket/system
@ -60,6 +60,7 @@
#:title [title "Racket Downloads"] #:title [title "Racket Downloads"]
#:current-rx [current-rx #f] #:current-rx [current-rx #f]
#:git-clone [git-clone #f] #:git-clone [git-clone #f]
#:help-table [site-help (hash)]
#:post-content [post-content null]) #:post-content [post-content null])
(define base-table (get-installers-table table-file)) (define base-table (get-installers-table table-file))
@ -122,6 +123,29 @@
(list section))) (list section)))
(loop l keys (append prev (list section)) #t)))]))) (loop l keys (append prev (list section)) #t)))])))
(define (get-site-help last-col)
(let ([h (hash-ref site-help last-col #f)])
(if h
(let* ([id "help"]
[toggle (let ([elem (~a "document.getElementById" "('" id "')")])
(~a elem ".style.display = ((" elem ".style.display == 'inline') ? 'none' : 'inline');"
" return false;"))])
`(" "
(div ([class "helpbutton"])
(a ([href "#"]
[class "helpbuttonlabel"]
[onclick ,toggle]
[title "explain"])
nbsp "?" nbsp))
(div ([class "hiddenhelp"]
[id ,id]
[onclick ,toggle]
[style "display: none"])
(div ([class "helpcontent"])
(div ([class "helptext"])
,h)))))
null)))
(call-with-output-file* (call-with-output-file*
dest dest
#:exists 'truncate/replace #:exists 'truncate/replace
@ -130,12 +154,36 @@
(write-xexpr (write-xexpr
`(html `(html
(head (title ,title) (head (title ,title)
(style ,(~a " .detail { font-size: small; }" (style @,~a|{
" .checksum, .path { font-family: monospace; }" .detail { font-size: small; }
" .group { background-color : #ccccff; padding-left: 0.5ex; }" .checksum, .path { font-family: monospace; }
" .major { font-weight : bold; font-size : large; left-border: 1ex; }" .group { background-color : #ccccff; padding-left: 0.5ex; }
" .minor { font-weight : bold; }" .major { font-weight : bold; font-size : large; left-border: 1ex; }
" a { text-decoration: none; }"))) .minor { font-weight : bold; }
.helpbutton {
display: inline;
font-family: sans-serif;
font-size : x-small;
background-color: #ffffee;
border: 1px solid black;
vertical-align: top;
}
.helpbuttonlabel{ vertical-align: top; }
.hiddenhelp {
width: 0em;
position: absolute;
}
.helpcontent {
width: 20em;
font-family: serif;
font-size : small;
font-weight : normal;
background-color: #ffffee;
padding: 10px;
border: 1px solid black;
}
a { text-decoration: none; }
}|))
(body (body
(h2 ,title) (h2 ,title)
(table (table
@ -171,7 +219,8 @@
(combine-url/relative (combine-url/relative
(string->url installers-url) (string->url installers-url)
inst)))) inst))))
,last-col))) ,last-col))
,@(get-site-help last-col))
(td nbsp) (td nbsp)
(td ,(if (past-success? inst) (td ,(if (past-success? inst)
`(span ([class "detail"]) "") `(span ([class "detail"]) "")
@ -225,7 +274,8 @@
(colspan ,num-cols)) (colspan ,num-cols))
,@(for/list ([col (in-list mid-cols)]) ,@(for/list ([col (in-list mid-cols)])
`(span nbsp nbsp nbsp)) `(span nbsp nbsp nbsp))
,last-col))]))) ,last-col
,@(get-site-help last-col)))])))
,@(if docs-url ,@(if docs-url
`((p (a ((href ,docs-url)) "Documentation") `((p (a ((href ,docs-url)) "Documentation")
,@(if pdf-docs-url ,@(if pdf-docs-url

1
pkgs/distro-build/manage-snapshots.rkt
View File

@ -109,6 +109,7 @@
"index.html") "index.html")
#:current-rx current-rx #:current-rx current-rx
#:git-clone (current-directory) #:git-clone (current-directory)
#:help-table (hash-ref config '#:site-help (hash))
#:post-content `((p "Snapshot ID: " #:post-content `((p "Snapshot ID: "
(a ((href ,(string-append current-snapshot (a ((href ,(string-append current-snapshot
"/index.html"))) "/index.html")))