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) (define (procedure . str)
(make-element "schemeresult" `("#<procedure:" ,@(decode-content str) ">"))) (make-element "schemeresult" `("#<procedure:" ,@(decode-content str) ">")))
(define (link url (define (link url
#:underline? [underline? #t] #:underline? [underline? #t]
#:style [style (if underline? #f "plainlink")] #:style [style (if underline? #f "plainlink")]
. str) . str)
(make-element (make-target-url url style) (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 // adding index.html works because of the above
function GotoPLTRoot(ver) { function GotoPLTRoot(ver, relative) {
var u = GetCookie("PLT_Root."+ver); var u = GetCookie("PLT_Root."+ver);
if (u == null) return true; // no cookie: use plain up link 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; return false;
} }

View File

@ -57,19 +57,29 @@
(map (lambda (item) (map (lambda (item)
(if (eq? item '---) (if (eq? item '---)
(list '--- (make-toc-element #f null '(nbsp))) (list '--- (make-toc-element #f null '(nbsp)))
(let* ([id (car item)] (let ()
[info (page-info id)] (define id (car item))
[label (car info)] (define info (page-info id))
[root (cadr info)] (define label (car info))
[path (caddr info)] (define root (cadr info))
[text (make-element "tocsubseclink" (list label))] (define path (caddr info))
[dest (case root (define text (make-element "tocsubseclink" (list label)))
[(plt) (build-path (find-doc-dir) path)] (define dest
[(user) (string-append up path)] (case root
[(#f) path] [(plt) (build-path (find-doc-dir) path)]
[else (error "internal error (main-page)")])] [(user) (string-append up path)]
[elt (lambda (style) [(#f) path]
(make-toc-element [else (error "internal error (main-page)")]))
#f null (list (link dest #:style style text))))]) (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"))))) (list id (elt "tocviewlink") (elt "tocviewselflink")))))
links)) links))