new toc in manual pages

svn: r10606

original commit: 601a590aa5eb1f312d0901a488f48995ce527b30

collects/scribble/html-render.ss

@@ -201,11 +201,12 @@
        [value ,emptylabel]
        [title "Enter a search string to search the manuals"]
        [onkeypress ,(format "return DoSearchKey(event, this, ~s);" (version))]
-       [onfocus ,(sa "this.style.color=\"black\";"
+       [onfocus ,(sa "this.style.color=\"black\"; "
-                     " if (this.value.indexOf(\""emptylabel"\")>=0)"
+                     "this.style.textAlign=\"left\"; "
-                     " this.value=\"\";")]
+                     "if (this.value == \""emptylabel"\") this.value=\"\";")]
        [onblur ,(sa "if (this.value.match(/^ *$/)) {"
                     " this.style.color=\""dimcolor"\";"
+                    " this.style.textAlign=\"center\";"
                     " this.value=\""emptylabel"\"; }")]))))
 
 ;; ----------------------------------------
@@ -337,29 +338,24 @@
 
     ;; ----------------------------------------
 
-    (define/private (reveal-subparts? p)
+    (define/private (reveal-subparts? p) ;!!! need to use this
       (part-style? p 'reveal))
 
     (define/public (toc-wrap table)
       null)
 
     (define/public (render-toc-view d ri)
-      (define-values (top mine)
+      (define toc-chain
-        (let loop ([d d] [mine d])
+        (let loop ([d d] [r (if (pair? (part-parts d)) (list d) '())])
-          (let ([p (collected-info-parent (part-collected-info d ri))])
+          (cond [(collected-info-parent (part-collected-info d ri))
-            (if p
+                 => (lambda (p) (loop p (cons p r)))]
-              (loop p (if (reveal-subparts? d) mine d))
+                [(pair? r) r]
-              (values d mine)))))
+                ;; we have no toc, so use just the current part
-      (define (do-part pp)
+                [else (list d)])))
-        (let ([p (car pp)] [show-number? (cdr pp)])
+      (define top (car toc-chain))
-          `(tr (td ([align "right"])
+      (define (toc-item->title+num t show-mine?)
-                 ,@(if show-number?
+        (values
-                     (format-number
+         `((a ([href ,(let ([dest (resolve-get t ri (car (part-tags t)))])
-                      (collected-info-number (part-collected-info p ri))
-                      '((tt nbsp)))
-                     '("-" nbsp)))
-               (td (a ([href
-                        ,(let ([dest (resolve-get p ri (car (part-tags p)))])
                         (format "~a~a~a"
                                 (from-root (relative->path (dest-path dest))
                                            (get-dest-directory))
@@ -367,44 +363,53 @@
                                 (if (dest-page? dest)
                                   ""
                                   (anchor-name (dest-anchor dest)))))]
-                       [class ,(if (eq? p mine)
+               [class ,(if (or (eq? t d) (and show-mine? (memq t toc-chain)))
-                                 "tocviewselflink" "tocviewlink")])
+                         "tocviewselflink"
-                     ,@(render-content (or (part-title-content p) '("???"))
+                         "tocviewlink")])
-                                       d ri))))))
+              ,@(render-content (or (part-title-content t) '("???")) d ri)))
+         (format-number (collected-info-number (part-collected-info t ri))
+                        '(nbsp))))
+      (define (toc-item->block t i)
+        (define-values (title num) (toc-item->title+num t #f))
+        (define children (part-parts t)) ; note: might be empty
+        (define id (format "tocview_~a" i))
+        (define expand? (eq? t (last toc-chain)))
+        (define top? (eq? t top))
+        (define header
+          `(table ([cellspacing "0"] [cellpadding "0"])
+             (tr ()
+               (td ([style "width: 1em;"])
+                 ,(if (null? children)
+                    'bull
+                    `(a ([href "javascript:void(0);"]
+                         [title "Expand/Collapse"]
+                         [class "tocviewtoggle"]
+                         [onclick ,(format "TocviewToggle(this,\"~a\");" id)])
+                       ,(if expand? 9662 9654))))
+               (td () ,@num)
+               (td () ,@title))))
+        `(div ([class "tocviewlist"]
+               ,@(if top? `([style "margin-bottom: 1em;"]) '()))
+           ,(if top? `(div ([class "tocviewtitle"]) ,header) header)
+           ,(if (null? children)
+              ""
+              `(div ([class "tocviewsublist"]
+                     [style ,(format "display: ~a; margin-bottom: ~aem;"
+                                     (if expand? 'block 'none)
+                                     (if top? 0 1))]
+                     [id ,id])
+                 (table ([cellspacing "0"] [cellpadding "0"])
+                   ,@(for/list ([c children])
+                       (let-values ([(t n) (toc-item->title+num c #t)])
+                         `(tr () (td ([align "right"]) ,@n) (td () ,@t)))))))))
       (define (toc-content)
-        (parameterize ([extra-breaking? #t])
+        (for/list ([t toc-chain] [i (in-naturals)])
-          (map do-part
+          (toc-item->block t i)))
-               (let loop ([l (map (lambda (v) (cons v #t)) (part-parts top))])
-                 (cond [(null? l) null]
-                       [(reveal-subparts? (caar l))
-                        (cons (car l)
-                              (loop (append (map (lambda (v) (cons v #f))
-                                                 (part-parts (caar l)))
-                                            (cdr l))))]
-                       [else (cons (car l) (loop (cdr l)))])))))
       `((div ([class "tocset"])
           ,@(if (part-style? d 'no-toc)
               null
-              (let* ([toc-content (toc-content)]
+              ;; toc-wrap determines if we get the toc or just the title !!!
-                     [toc-content
+              `((div ([class "tocview"]) ,@(toc-content))))
-                      (if (null? toc-content)
-                        '()
-                        (toc-wrap
-                         `(table ([class "tocviewlist"] [cellspacing "0"])
-                            ,@toc-content)))]
-                     [title-content
-                      `(div ([class "tocviewtitle"])
-                         (a ([href "index.html"]
-                             [class ,(if (eq? mine top)
-                                       "tocviewselflink"
-                                       "tocviewlink")])
-                           ,@(render-content (or (part-title-content top)
-                                                 '("???"))
-                                             d ri)))])
-                `((div ([class "tocview"])
-                    ,title-content
-                    (div nbsp)
-                    ,@toc-content))))
           ,@(render-onthispage-contents
              d ri top (if (part-style? d 'no-toc) "tocview" "tocsub"))
           ,@(parameterize ([extra-breaking? #t])
@@ -634,20 +639,17 @@
       (define navleft
         `(span ([class "navleft"])
            ,search-box
-           nbsp
+           ,@(render
-           ,@(render (make-element (if up-path top-link "nonavigation")
+              sep-element
-                                   top-content))
+              (make-element (if up-path top-link "nonavigation") top-content)
-           nbsp
+              sep-element
-           ,@(render (make-element
+              (make-element
-                      (if parent
+               (if parent (make-target-url "index.html" #f) "nonavigation")
-                        (make-target-url "index.html" #f)
+               contents-content)
-                        "nonavigation")
+              sep-element
-                      contents-content))
+              (if (or (not index) (eq? d index))
-           nbsp
-           ,@(render (if (or (not index) (eq? d index))
                 (make-element "nonavigation" index-content)
-                       (make-link-element
+                (make-link-element #f index-content (car (part-tags index)))))))
-                        #f index-content (car (part-tags index)))))))
       (define navright
         `(span ([class "navright"])
            ,@(render

collects/scribble/scribble-common.js

@@ -55,6 +55,13 @@ function DoSearchKey(event, field, ver) {
   return true;
 }
 
+function TocviewToggle(glyph,id) {
+  var s = document.getElementById(id).style;
+  var expand = s.display == "none";
+  s.display = expand ? "block" : "none";
+  glyph.innerHTML = expand ? "▾" : "▶";
+}
+
 // `noscript' is problematic in some browsers (always renders as a
 // block), use this hack instead (does not always work!)
 // document.write("<style>mynoscript { display:none; }</style>");

collects/scribble/scribble.css

@@ -142,6 +142,9 @@ table td {
   width: 12.5em;
   margin-right: 2em;
 }
+.tocset td {
+  vertical-align: top;
+}
 
 .tocview {
   text-align: left;
@@ -154,19 +157,24 @@ table td {
   background-color: #f0f0e0;
 }
 
-.tocviewtitle {
-  font-size: 82%;
-  font-weight: bold;
-  margin: 0.2em 0.2em 0.2em 0.2em;
-}
-
 .tocviewlist {
-  margin: 0.2em 0.2em 0.2em 0.2em;
+  margin: 0.2em;
+}
+.tocviewlist table {
+  font-size: 82%;
 }
 
-.tocviewlist td {
+.tocviewsublist {
-  font-size: 82%;
+  margin-left: 0.4em;
-  vertical-align: top;
+  border-left: 1px solid #bbf;
+  padding-left: 0.8em;
+}
+.tocviewsublist table {
+  font-size: 75%;
+}
+
+.tocviewtitle * {
+  font-weight: bold;
 }
 
 .tocviewlink {
@@ -179,12 +187,15 @@ table td {
   color: blue;
 }
 
-.tocsublist {
+.tocviewtoggle {
-  margin: 0.2em 0.2em 0.2em 0.2em;
+  text-decoration: none;
+  color: blue;
 }
 
+.tocsublist {
+  margin: 0.2em;
+}
 .tocsublist td {
-  vertical-align: top;
   padding-left: 1em;
   text-indent: -1em;
 }
@@ -212,7 +223,7 @@ table td {
 .tocsubtitle {
   font-size: 82%;
   font-style: italic;
-  margin: 0.2em 0.2em 0.2em 0.2em;
+  margin: 0.2em;
 }
 
 .sepspace {