From 9b0492e320cf761bd2831fabd64c12e723967092 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Wed, 28 May 2008 00:20:58 +0000
Subject: [PATCH] toc links on main pages go to user pages where needed

svn: r9993
---
 collects/scribble/manual.ss                |  4 +--
 collects/scribble/scribble-common.js       |  6 ++--
 collects/scribblings/main/private/utils.ss | 38 ++++++++++++++--------
 3 files changed, 30 insertions(+), 18 deletions(-)

diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
index 0a2468a416..691f791def 100644
--- a/collects/scribble/manual.ss
+++ b/collects/scribble/manual.ss
@@ -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)
diff --git a/collects/scribble/scribble-common.js b/collects/scribble/scribble-common.js
index c1aab35133..1aef1c0db9 100644
--- a/collects/scribble/scribble-common.js
+++ b/collects/scribble/scribble-common.js
@@ -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;
 }
 
diff --git a/collects/scribblings/main/private/utils.ss b/collects/scribblings/main/private/utils.ss
index 7c78ac299d..608dbd9a82 100644
--- a/collects/scribblings/main/private/utils.ss
+++ b/collects/scribblings/main/private/utils.ss
@@ -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))