Make the web page header a link to the main page.

This commit is contained in:
Eli Barzilay 2011-03-31 11:05:52 -04:00
parent 00a9247fa9
commit 43275e7b0a
2 changed files with 11 additions and 10 deletions

View File

@ -2,4 +2,4 @@
(require "www/all.rkt" "download/all.rkt" "minis/all.rkt" "stubs/all.rkt")
(set-navbar! (list main download -docs planet community learning)
help)
main help)

View File

@ -109,19 +109,19 @@
[(page part-of) (hash-set! t page part-of)])))
(provide set-navbar!)
(define-syntax-rule (set-navbar! pages help)
(define-syntax-rule (set-navbar! pages top help)
(if (unbox navbar-info)
;; since generation is delayed, it won't make sense to change the navbar
(error 'set-navbar! "called twice")
(set-box! navbar-info (list (lazy pages) (lazy help)))))
(set-box! navbar-info (list (lazy pages) (lazy top) (lazy help)))))
(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 top-promise (lazy (cadr (unbox navbar-info))))
(define help-promise (lazy (caddr (unbox navbar-info))))
(define pages-parts-of-promise
(lazy (map pages->part-of (force pages-promise))))
(define (middle-text size x)
@ -140,11 +140,12 @@
(middle-text 80 ")")
(middle-text 100 ")")))
(define (header-cell logo)
(td OPEN
(img src: logo alt: "[logo]"
style: '("vertical-align: middle; "
"margin: 13px 0.25em 0 0; border: 0;"))
CLOSE))
(td (a href: (get-resource-path (force top-promise))
OPEN
(img src: logo alt: "[logo]"
style: '("vertical-align: middle; "
"margin: 13px 0.25em 0 0; border: 0;"))
CLOSE)))
(define (links-table this)
(table width: "100%"
(tr (map (lambda (nav navpart)