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

* always have a navbar, even at the start page

Browse Source 
* add a "top" link to the navbar
* move search box to the left

svn: r10573
This commit is contained in:
Eli Barzilay 2008-07-03 07:05:20 +00:00
parent d2c666f1e7
commit 3a18f5b9a2
1 changed files with 58 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
collects/scribble/html-render.ss
View File

@ -554,6 +554,7 @@
(values prev (and (pair? (cdr l)) (cadr l))) (values prev (and (pair? (cdr l)) (cadr l)))
(loop (cdr l) (car l)))))) (loop (cdr l) (car l))))))
(define top-content '("top"))
(define contents-content '("contents")) (define contents-content '("contents"))
(define index-content '("index")) (define index-content '("index"))
(define prev-content '(larr " prev")) (define prev-content '(larr " prev"))
@ -611,30 +612,29 @@
(make-with-attributes #f (make-with-attributes #f
`([title . ,(if title* (string-append label " to " title*) label)] `([title . ,(if title* (string-append label " to " title*) label)]
,@more)))) ,@more))))
(define (navbar) (define top-link
`(div ([class "navset"] (titled-url
[style ,(let ([v (if top? 'bottom 'top)]) "up" "../index.html"
(format "margin-~a: 2em; border-~a: ~a" `[onclick . ,(format "return GotoPLTRoot(\"~a\");" (version))]))
v v "2px solid #e0e0c0;"))]) (define navleft
(span ([class "navleft"]) `(span ([class "navleft"])
,(search-box)
nbsp
,@(render (make-element (if up-path top-link "nonavigation")
top-content))
nbsp
,@(render (make-element ,@(render (make-element
(if parent (if parent
(make-target-url "index.html" #f) (make-target-url "index.html" #f)
"nonavigation") "nonavigation")
contents-content)) contents-content))
,@(if index nbsp
`(nbsp ,@(render (if (or (not index) (eq? d index))
,@(render (if (eq? d index)
(make-element "nonavigation" index-content) (make-element "nonavigation" index-content)
(make-link-element (make-link-element
#f index-content (car (part-tags index))))) #f index-content (car (part-tags index)))))))
#; ; no need for these index-local searches (define navright
,@(if (eq? d index) `(span ([class "navright"])
null
`((span ([class "smaller"]) nbsp ,(search-index-box)))))
null)
,@(if up-path `(nbsp ,(search-box)) null))
(span ([class "navright"])
,@(render ,@(render
(make-element (make-element
(cond [(not parent) "nonavigation"] (cond [(not parent) "nonavigation"]
@ -646,28 +646,28 @@
sep-element sep-element
(make-element (make-element
(cond (cond
[(and (part? parent) (toc-part? parent) [(and (part? parent) (toc-part? parent) (part-parent parent ri))
(part-parent parent ri))
(titled-url "up" parent)] (titled-url "up" parent)]
[parent (titled-url "up" "index.html" #:title-from parent)] [parent (titled-url "up" "index.html" #:title-from parent)]
;; up-path = #t => go up to the start page, using ;; up-path = #t => go up to the start page, using
;; cookies to get to the user's version of it (see ;; cookies to get to the user's version of it (see
;; scribblings/main/private/utils for the code that ;; scribblings/main/private/utils for the code that
;; creates these cookies.) ;; creates these cookies.)
[(eq? #t up-path) [(eq? #t up-path) top-link]
(titled-url
"up" "../index.html"
`[onclick
. ,(format "return GotoPLTRoot(\"~a\");" (version))])]
[up-path (titled-url "up" up-path)] [up-path (titled-url "up" up-path)]
[else "nonavigation"]) [else "nonavigation"])
up-content) up-content)
sep-element sep-element
(make-element (make-element
(if next (titled-url "forward" next) "nonavigation") (if next (titled-url "forward" next) "nonavigation")
next-content))) next-content))))
nbsp)) ; needed to make the navset background visible (define navbar
(if (or prev next parent index up-path) (list (navbar)) null)) `(div ([class "navset"]
[style ,(let ([v (if top? 'bottom 'top)])
(format "margin-~a: 2em; border-~a: ~a"
v v "2px solid #e0e0c0;"))])
,navleft ,navright nbsp)) ; need nbsp to make the navset bg visible
(list navbar))
(define/override (render-one d ri fn) (define/override (render-one d ri fn)
(render-one-part d ri fn null)) (render-one-part d ri fn null))