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

Allow #:part-of to use symbolic names, add it to a bunch of pages.

Browse Source 
(Using a symbolic name makes it easy to use without worrying about
circular dependencies.)
This commit is contained in:
Eli Barzilay 2010-06-16 13:27:27 -04:00
parent f1eec03a2d
commit ca3b27b810
13 changed files with 33 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/meta/web/common/layout.rkt
View File

@ -89,7 +89,14 @@
(resource (get-path 'plain id file "html" dir)
(file-writer output-xml page)
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!)
(define-syntax-rule (set-navbar! pages help)
@ -100,9 +107,13 @@
(define navbar-info (box #f))
(define (navbar-maker logo)
(define pages-promise (lazy (car (or (unbox navbar-info)
(error 'navbar "no navbar info set")))))
(define help-promise (lazy (cadr (unbox navbar-info))))
(define pages-promise
(lazy (car (or (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)
(span style: `("font-size: ",size"px; vertical-align: middle;")
class: 'navtitle
@ -126,12 +137,14 @@
CLOSE))
(define (links-table this)
(table width: "100%"
(tr (map (lambda (nav)
(tr (map (lambda (nav navpart)
(td class: 'navlinkcell
(span class: 'navitem
(span class: (if (eq? this nav) 'navcurlink 'navlink)
(span class: (if (eq? (pages->part-of this) navpart)
'navcurlink 'navlink)
nav))))
(force pages-promise)))))
(force pages-promise)
(force pages-parts-of-promise)))))
(lambda (this)
(div class: 'racketnav
(div class: 'navcontent

2
collects/meta/web/download/index.rkt
View File

@ -11,7 +11,7 @@
(provide index)
(define index
@page[#:link-title "Downloads"]{
@page[#:link-title "Downloads" #:part-of 'download]{
@div[style: "float: right;"]{@download-button}
Use these links to browse the download directories directly:
@ul{@li{Current @a[href: `(,installers "/recent")]{installers}

2
collects/meta/web/download/installer-pages.rkt
View File

@ -25,7 +25,7 @@
[(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]{
@page[#:file html-file #:title title #:referrer this #:part-of 'download]{
@table[width: "90%" align: 'center]{
@tr[valign: 'top]{
@td[width: "50%"]{

2
collects/meta/web/minis/lists.rkt
View File

@ -17,7 +17,7 @@
see how the sausages are made @mdash and help make them.})))
(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
lists listed below, with several mirrors for each one.}
@(map show-list MLs)})

6
collects/meta/web/stubs/blog.rkt
View File

@ -32,15 +32,13 @@
;; in blogger pages
(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))
(provide blog)
(define blog
@plain[#:file ""
#:referrer (lambda (u) @a[href: u]{Blog})
;; #:part-of community <-- TODO: is doing this a good idea
]{
#:referrer (lambda (u) @a[href: u]{Blog})]{
@; 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).
@;

1
collects/meta/web/stubs/dirlist.rkt
View File

@ -10,6 +10,7 @@
(delay (regexp-split #rx"{{{BODY}}}"
(xml->string @page[#:id 'browse-downloads
#:html-only #t
#:part-of 'download
"{{{BODY}}}"]))))
(define header @plain[#:file "header.html" (car (force header+footer))])

2
collects/meta/web/stubs/mailman.rkt
View File

@ -32,7 +32,7 @@
(define listinfo
@page[#:title @list{Mailing lists: @MM{List-Name}}
#:extra-headers style-header]{
#:extra-headers style-header #:part-of 'community]{
@; --------------------
@comment{@||
Based on the Mailman file "listinfo.html", revision: 5865

2
collects/meta/web/www/community.rkt
View File

@ -6,7 +6,7 @@
(provide community)
(define community
@page{
@page[#:part-of 'community]{
@mailing-lists-quick
@parlist[@strong{Discussion Channels}
@text{@irc-chat{Chat on IRC} in the @TT{@big{@strong{#racket}}} channel

2
collects/meta/web/www/download.rkt
View File

@ -6,7 +6,7 @@
(define download
@page[#:link-title "Download" #:window-title "Download Racket"
#:file "download/"]{
#:file "download/" #:part-of 'download]{
@(render-download-page)})
(define download-button

2
collects/meta/web/www/help.rkt
View File

@ -17,7 +17,7 @@
installed. As a second line of defense, the documentation
for the core of the most recent version of Racket is
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
@a[href: "http://docs.plt-scheme.org/guide/"]{guide} (also
located in your local copy of the documentation) that

2
collects/meta/web/www/irc.rkt
View File

@ -6,7 +6,7 @@
"http://webchat.freenode.net?channels=racket&uio=OT10cnVlJjExPTIzNg6b")
(define irc-chat
@page[#:title "IRC"]{
@page[#:title "IRC" #:part-of 'community]{
@iframe[src: webchat-link width: "100%" height: "400"]})
(define irc-logs-symlink (symlink "/home/scheme/irc-logs/racket/"))

2
collects/meta/web/www/outreach+research.rkt
View File

@ -85,5 +85,5 @@
#:title "Technical Reports"
#:extra-headers
@meta[http-equiv: "refresh"
content: "2;url=http://plt-scheme.org/techreports/"]]{
content: "0;url=http://plt-scheme.org/techreports/"]]{
TODO})

2
collects/meta/web/www/people.rkt
View File

@ -37,7 +37,7 @@
(provide people)
(define people
@page{
@page[#:part-of 'community]{
@p{@|ldquo|PLT@|rdquo| refers to the group that is the core of the Racket
development team. PLT consists of numerous people distributed across
several different universities in the USA: @places}