Allow #:part-of to use symbolic names, add it to a bunch of pages.
(Using a symbolic name makes it easy to use without worrying about circular dependencies.)
This commit is contained in:
parent
f1eec03a2d
commit
ca3b27b810
|
@ -89,7 +89,14 @@
|
||||||
(resource (get-path 'plain id file "html" dir)
|
(resource (get-path 'plain id file "html" dir)
|
||||||
(file-writer output-xml page)
|
(file-writer output-xml page)
|
||||||
referrer)))
|
referrer)))
|
||||||
(if html-only? page this))
|
(when this (pages->part-of this (or part-of this)))
|
||||||
|
(or this page))
|
||||||
|
|
||||||
|
;; maps pages to their parts, so symbolic values can be used to determine it
|
||||||
|
(define pages->part-of
|
||||||
|
(let ([t (make-hasheq)])
|
||||||
|
(case-lambda [(page) (hash-ref t page page)]
|
||||||
|
[(page part-of) (hash-set! t page part-of)])))
|
||||||
|
|
||||||
(provide set-navbar!)
|
(provide set-navbar!)
|
||||||
(define-syntax-rule (set-navbar! pages help)
|
(define-syntax-rule (set-navbar! pages help)
|
||||||
|
@ -100,9 +107,13 @@
|
||||||
|
|
||||||
(define navbar-info (box #f))
|
(define navbar-info (box #f))
|
||||||
(define (navbar-maker logo)
|
(define (navbar-maker logo)
|
||||||
(define pages-promise (lazy (car (or (unbox navbar-info)
|
(define pages-promise
|
||||||
(error 'navbar "no navbar info set")))))
|
(lazy (car (or (unbox navbar-info)
|
||||||
(define help-promise (lazy (cadr (unbox navbar-info))))
|
(error 'navbar "no navbar info set")))))
|
||||||
|
(define help-promise
|
||||||
|
(lazy (cadr (unbox navbar-info))))
|
||||||
|
(define pages-parts-of-promise
|
||||||
|
(lazy (map pages->part-of (force pages-promise))))
|
||||||
(define (middle-text size x)
|
(define (middle-text size x)
|
||||||
(span style: `("font-size: ",size"px; vertical-align: middle;")
|
(span style: `("font-size: ",size"px; vertical-align: middle;")
|
||||||
class: 'navtitle
|
class: 'navtitle
|
||||||
|
@ -126,12 +137,14 @@
|
||||||
CLOSE))
|
CLOSE))
|
||||||
(define (links-table this)
|
(define (links-table this)
|
||||||
(table width: "100%"
|
(table width: "100%"
|
||||||
(tr (map (lambda (nav)
|
(tr (map (lambda (nav navpart)
|
||||||
(td class: 'navlinkcell
|
(td class: 'navlinkcell
|
||||||
(span class: 'navitem
|
(span class: 'navitem
|
||||||
(span class: (if (eq? this nav) 'navcurlink 'navlink)
|
(span class: (if (eq? (pages->part-of this) navpart)
|
||||||
|
'navcurlink 'navlink)
|
||||||
nav))))
|
nav))))
|
||||||
(force pages-promise)))))
|
(force pages-promise)
|
||||||
|
(force pages-parts-of-promise)))))
|
||||||
(lambda (this)
|
(lambda (this)
|
||||||
(div class: 'racketnav
|
(div class: 'racketnav
|
||||||
(div class: 'navcontent
|
(div class: 'navcontent
|
||||||
|
|
|
@ -11,7 +11,7 @@
|
||||||
|
|
||||||
(provide index)
|
(provide index)
|
||||||
(define index
|
(define index
|
||||||
@page[#:link-title "Downloads"]{
|
@page[#:link-title "Downloads" #:part-of 'download]{
|
||||||
@div[style: "float: right;"]{@download-button}
|
@div[style: "float: right;"]{@download-button}
|
||||||
Use these links to browse the download directories directly:
|
Use these links to browse the download directories directly:
|
||||||
@ul{@li{Current @a[href: `(,installers "/recent")]{installers}
|
@ul{@li{Current @a[href: `(,installers "/recent")]{installers}
|
||||||
|
|
|
@ -25,7 +25,7 @@
|
||||||
[(render-option) (option value: url platform type)]
|
[(render-option) (option value: url platform type)]
|
||||||
[(#f) @a[href: url]{@title}]
|
[(#f) @a[href: url]{@title}]
|
||||||
[else (error 'installer-page "unknown mode: ~e" mode)]))
|
[else (error 'installer-page "unknown mode: ~e" mode)]))
|
||||||
@page[#:file html-file #:title title #:referrer this]{
|
@page[#:file html-file #:title title #:referrer this #:part-of 'download]{
|
||||||
@table[width: "90%" align: 'center]{
|
@table[width: "90%" align: 'center]{
|
||||||
@tr[valign: 'top]{
|
@tr[valign: 'top]{
|
||||||
@td[width: "50%"]{
|
@td[width: "50%"]{
|
||||||
|
|
|
@ -17,7 +17,7 @@
|
||||||
see how the sausages are made @mdash and help make them.})))
|
see how the sausages are made @mdash and help make them.})))
|
||||||
|
|
||||||
(define lists
|
(define lists
|
||||||
@page[#:title "Mailing Lists" #:file ""]{
|
@page[#:title "Mailing Lists" #:file "" #:part-of 'community]{
|
||||||
@p{This is the Racket mailing list server. We have three public mailing
|
@p{This is the Racket mailing list server. We have three public mailing
|
||||||
lists listed below, with several mirrors for each one.}
|
lists listed below, with several mirrors for each one.}
|
||||||
@(map show-list MLs)})
|
@(map show-list MLs)})
|
||||||
|
|
|
@ -32,15 +32,13 @@
|
||||||
;; in blogger pages
|
;; in blogger pages
|
||||||
(regexp-replace* #rx" " str "\\ ")))
|
(regexp-replace* #rx" " str "\\ ")))
|
||||||
|
|
||||||
(define (racket-navbar) (get-resource-text 'navbar #f))
|
(define (racket-navbar) (get-resource-text 'navbar 'community))
|
||||||
(define (racket-favicon) (get-resource-text 'favicon-headers))
|
(define (racket-favicon) (get-resource-text 'favicon-headers))
|
||||||
|
|
||||||
(provide blog)
|
(provide blog)
|
||||||
(define blog
|
(define blog
|
||||||
@plain[#:file ""
|
@plain[#:file ""
|
||||||
#:referrer (lambda (u) @a[href: u]{Blog})
|
#:referrer (lambda (u) @a[href: u]{Blog})]{
|
||||||
;; #:part-of community <-- TODO: is doing this a good idea
|
|
||||||
]{
|
|
||||||
@; This is the blogger style template file, with one hole for the CSS and one
|
@; This is the blogger style template file, with one hole for the CSS and one
|
||||||
@; for the navbar, and a few more tweaks (first by soegaard and then by eli).
|
@; for the navbar, and a few more tweaks (first by soegaard and then by eli).
|
||||||
@;
|
@;
|
||||||
|
|
|
@ -10,6 +10,7 @@
|
||||||
(delay (regexp-split #rx"{{{BODY}}}"
|
(delay (regexp-split #rx"{{{BODY}}}"
|
||||||
(xml->string @page[#:id 'browse-downloads
|
(xml->string @page[#:id 'browse-downloads
|
||||||
#:html-only #t
|
#:html-only #t
|
||||||
|
#:part-of 'download
|
||||||
"{{{BODY}}}"]))))
|
"{{{BODY}}}"]))))
|
||||||
|
|
||||||
(define header @plain[#:file "header.html" (car (force header+footer))])
|
(define header @plain[#:file "header.html" (car (force header+footer))])
|
||||||
|
|
|
@ -32,7 +32,7 @@
|
||||||
|
|
||||||
(define listinfo
|
(define listinfo
|
||||||
@page[#:title @list{Mailing lists: @MM{List-Name}}
|
@page[#:title @list{Mailing lists: @MM{List-Name}}
|
||||||
#:extra-headers style-header]{
|
#:extra-headers style-header #:part-of 'community]{
|
||||||
@; --------------------
|
@; --------------------
|
||||||
@comment{@||
|
@comment{@||
|
||||||
Based on the Mailman file "listinfo.html", revision: 5865
|
Based on the Mailman file "listinfo.html", revision: 5865
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
|
|
||||||
(provide community)
|
(provide community)
|
||||||
(define community
|
(define community
|
||||||
@page{
|
@page[#:part-of 'community]{
|
||||||
@mailing-lists-quick
|
@mailing-lists-quick
|
||||||
@parlist[@strong{Discussion Channels}
|
@parlist[@strong{Discussion Channels}
|
||||||
@text{@irc-chat{Chat on IRC} in the @TT{@big{@strong{#racket}}} channel
|
@text{@irc-chat{Chat on IRC} in the @TT{@big{@strong{#racket}}} channel
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
|
|
||||||
(define download
|
(define download
|
||||||
@page[#:link-title "Download" #:window-title "Download Racket"
|
@page[#:link-title "Download" #:window-title "Download Racket"
|
||||||
#:file "download/"]{
|
#:file "download/" #:part-of 'download]{
|
||||||
@(render-download-page)})
|
@(render-download-page)})
|
||||||
|
|
||||||
(define download-button
|
(define download-button
|
||||||
|
|
|
@ -17,7 +17,7 @@
|
||||||
installed. As a second line of defense, the documentation
|
installed. As a second line of defense, the documentation
|
||||||
for the core of the most recent version of Racket is
|
for the core of the most recent version of Racket is
|
||||||
available
|
available
|
||||||
@a[href: "http://docs.plt-scheme.org"]{from this web site}.}
|
@a[href: "http://docs.plt-scheme.org/"]{from this web site}.}
|
||||||
@text{Not sure what to search for? The documentation includes a
|
@text{Not sure what to search for? The documentation includes a
|
||||||
@a[href: "http://docs.plt-scheme.org/guide/"]{guide} (also
|
@a[href: "http://docs.plt-scheme.org/guide/"]{guide} (also
|
||||||
located in your local copy of the documentation) that
|
located in your local copy of the documentation) that
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
"http://webchat.freenode.net?channels=racket&uio=OT10cnVlJjExPTIzNg6b")
|
"http://webchat.freenode.net?channels=racket&uio=OT10cnVlJjExPTIzNg6b")
|
||||||
|
|
||||||
(define irc-chat
|
(define irc-chat
|
||||||
@page[#:title "IRC"]{
|
@page[#:title "IRC" #:part-of 'community]{
|
||||||
@iframe[src: webchat-link width: "100%" height: "400"]})
|
@iframe[src: webchat-link width: "100%" height: "400"]})
|
||||||
|
|
||||||
(define irc-logs-symlink (symlink "/home/scheme/irc-logs/racket/"))
|
(define irc-logs-symlink (symlink "/home/scheme/irc-logs/racket/"))
|
||||||
|
|
|
@ -85,5 +85,5 @@
|
||||||
#:title "Technical Reports"
|
#:title "Technical Reports"
|
||||||
#:extra-headers
|
#:extra-headers
|
||||||
@meta[http-equiv: "refresh"
|
@meta[http-equiv: "refresh"
|
||||||
content: "2;url=http://plt-scheme.org/techreports/"]]{
|
content: "0;url=http://plt-scheme.org/techreports/"]]{
|
||||||
TODO})
|
TODO})
|
||||||
|
|
|
@ -37,7 +37,7 @@
|
||||||
|
|
||||||
(provide people)
|
(provide people)
|
||||||
(define people
|
(define people
|
||||||
@page{
|
@page[#:part-of 'community]{
|
||||||
@p{@|ldquo|PLT@|rdquo| refers to the group that is the core of the Racket
|
@p{@|ldquo|PLT@|rdquo| refers to the group that is the core of the Racket
|
||||||
development team. PLT consists of numerous people distributed across
|
development team. PLT consists of numerous people distributed across
|
||||||
several different universities in the USA: @places}
|
several different universities in the USA: @places}
|
||||||
|
|
Loading…
Reference in New Issue
Block a user