toc links on main pages go to user pages where needed
svn: r9993
This commit is contained in:
parent
9127cdaaf8
commit
9b0492e320
|
@ -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)
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue
Block a user