* Tweaking the search box to look a little better

* Made up/prev/next links have tooltips with targets

svn: r10490

original commit: 4f10870042830dc78a8fd1b0e9bd939dbac4665b
This commit is contained in:
Eli Barzilay 2008-06-28 16:21:35 +00:00
parent 1e0df4ad49
commit e820ac1623

View File

@ -189,13 +189,15 @@
) )
(define (search-index-box) ; appears on every page (define (search-box) ; appears on every page
(let ([sa string-append]) (let ([sa string-append])
`(input `(input
([style ,(sa "font-size: 75%; margin: 0px; padding: 0px; border: 1px;" ([style ,(sa "font-size: 60%; margin: 0px; padding: 0px;"
" background-color: #eee; color: #888;")] " background-color: #eee; color: #888;"
" border: 1px solid #ddd; text-align: center;")]
[type "text"] [type "text"]
[value "...search..."] [value "...search..."]
[size "12"]
[title "Enter a search string to search the manuals"] [title "Enter a search string to search the manuals"]
[onkeypress ,(format "return DoSearchKey(event, this, ~s);" (version))] [onkeypress ,(format "return DoSearchKey(event, this, ~s);" (version))]
[onfocus ,(sa "this.style.color=\"black\";" [onfocus ,(sa "this.style.color=\"black\";"
@ -591,6 +593,25 @@
(and (part-style? d 'index) (and (part-style? d 'index)
d)))))))) d))))))))
(define (render . content) (render-content content d ri)) (define (render . content) (render-content content d ri))
(define (titled-url label x #:title-from [tfrom #f] . more)
(define-values (url title)
(cond [(part? x)
(values (derive-filename x)
(string-append
"\"" (content->string (part-title-content x)) "\""))]
[(equal? x "index.html") (values x "the manual top")]
[(equal? x "../index.html") (values x "the documentation top")]
[(string? x) (values x #f)]
[else (error 'navigation "internal error ~e" x)]))
(define title*
(if (and tfrom (part? tfrom))
(string-append
"\"" (content->string (part-title-content tfrom)) "\"")
title))
(make-target-url url
(make-with-attributes #f
`([title . ,(if title* (string-append label " to " title*) label)]
,@more))))
(if (not (or prev next parent index up-path)) (if (not (or prev next parent index up-path))
null null
`(,@(if pre-space? '((p nbsp)) null) `(,@(if pre-space? '((p nbsp)) null)
@ -611,42 +632,38 @@
null null
`((span ([class "smaller"]) nbsp ,(search-index-box))))) `((span ([class "smaller"]) nbsp ,(search-index-box)))))
null) null)
,@(if up-path ,@(if up-path `(nbsp ,(search-box)) null))
`(nbsp (span ([class "smaller"]) ,(search-index-box)))
null))
(div ([class "navright"]) (div ([class "navright"])
,@(render ,@(render
(make-element (make-element
(if parent (cond [(not parent) "nonavigation"]
(make-target-url (if prev (derive-filename prev) "index.html") [prev (titled-url "backward" prev)]
#f) [else (titled-url "backward" "index.html"
"nonavigation") #:title-from
(and (part? parent) parent))])
prev-content) prev-content)
sep-element sep-element
(make-element (make-element
(cond (cond
[(and (part? parent) (toc-part? parent)
(part-parent parent ri))
(titled-url "up" 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.)
[(and (eq? #t up-path) (not parent)) [(eq? #t up-path)
(make-target-url (titled-url
"../index.html" "up" "../index.html"
(make-with-attributes `[onclick
#f `([onclick . ,(format "return GotoPLTRoot(\"~a\");" . ,(format "return GotoPLTRoot(\"~a\");" (version))])]
(version))])))] [up-path (titled-url "up" up-path)]
[(or parent up-path)
(make-target-url
(cond [(not parent) up-path]
[(and (toc-part? parent) (part-parent parent ri))
(derive-filename parent)]
[else "index.html"])
#f)]
[else "nonavigation"]) [else "nonavigation"])
up-content) up-content)
sep-element sep-element
(make-element (if next (make-element (if next
(make-target-url (derive-filename next) #f) (titled-url "forward" next)
"nonavigation") "nonavigation")
next-content))) next-content)))
(p nbsp)))) (p nbsp))))