toc links on main pages go to user pages where needed

svn: r9993
This commit is contained in:
Eli Barzilay 2008-05-28 00:20:58 +00:00
parent 9127cdaaf8
commit 9b0492e320
3 changed files with 30 additions and 18 deletions

View File

@ -335,8 +335,8 @@
(define (procedure . str)
(make-element "schemeresult" `("#<procedure:" ,@(decode-content str) ">")))
(define (link url
#:underline? [underline? #t]
(define (link url
#:underline? [underline? #t]
#:style [style (if underline? #f "plainlink")]
. str)
(make-element (make-target-url url style)

View File

@ -27,10 +27,12 @@ function SetPLTRoot(ver, relative) {
}
// adding index.html works because of the above
function GotoPLTRoot(ver) {
function GotoPLTRoot(ver, relative) {
var u = GetCookie("PLT_Root."+ver);
if (u == null) return true; // no cookie: use plain up link
location = u + "index.html";
// the relative path is optional, default goes to the toplevel start page
if (!relative) relative = "index.html";
location = u + relative;
return false;
}

View File

@ -57,19 +57,29 @@
(map (lambda (item)
(if (eq? item '---)
(list '--- (make-toc-element #f null '(nbsp)))
(let* ([id (car item)]
[info (page-info id)]
[label (car info)]
[root (cadr info)]
[path (caddr info)]
[text (make-element "tocsubseclink" (list label))]
[dest (case root
[(plt) (build-path (find-doc-dir) path)]
[(user) (string-append up path)]
[(#f) path]
[else (error "internal error (main-page)")])]
[elt (lambda (style)
(make-toc-element
#f null (list (link dest #:style style text))))])
(let ()
(define id (car item))
(define info (page-info id))
(define label (car info))
(define root (cadr info))
(define path (caddr info))
(define text (make-element "tocsubseclink" (list label)))
(define dest
(case root
[(plt) (build-path (find-doc-dir) path)]
[(user) (string-append up path)]
[(#f) path]
[else (error "internal error (main-page)")]))
(define (onclick style)
(if (eq? root 'user)
(make-with-attributes
style
`([onclick
. ,(format "return GotoPLTRoot(\"~a\", \"~a\");"
(version) path)]))
style))
(define (elt style)
(make-toc-element
#f null (list (link dest #:style (onclick style) text))))
(list id (elt "tocviewlink") (elt "tocviewselflink")))))
links))