[r2004-04-01 22:10:40 by afrisch] Improve sitemap

Original author: afrisch
Date: 2004-04-01 22:10:40+00:00

web/site.cd

@@ -98,7 +98,7 @@ let split_comma (String -> [String*])
 
 type Path = [ { url = String; title = String }* ]
 type Tree = { name = String; url = String; title = String; 
-              children = [Tree*] } 
+              children = [Tree*]; boxes = [H:Xul?] } 
 
 let url_of_name (String -> String)
    "index" -> "/"
@@ -126,16 +126,17 @@ let local_link (sitemap : Tree, l : String, txt : String) : H:Inline =
  with `Not_found -> raise [ 'Local link not found: ' !l ]
  
 let compute_sitemap ((Page|External) -> Tree)
- <page name=name>[ <title>title (c::(Page|External) | _)* ] ->
+ <page name=name>[ <title>title (c::(Page|External) | _)* ] & p ->
    let children = map c with p -> compute_sitemap p in
-   { name = name; url = (url_of_name name); title = title; children =children }
+   { name = name; url = (url_of_name name); title = title; 
+     children = children; boxes = (boxes_of p) }
 |<external name=name href=h title=t>[] ->
-   { name = name; url = h; title = t; children = [] }
+   { name = name; url = h; title = t; children = []; boxes = [] }
 
 let display_sitemap (h : Tree) :  H:Xli =
   let ch = map h . children with x -> display_sitemap x in
   let ch = match ch with [] -> [] | l -> [ <ul>l ] in
-  <li>[ <a href=(h . url)>(h . title); ch ]
+  <li>[ <a href=(h . url)>[ '[' !(h . title) ']' ] !(h . boxes); ch ]
 
 
 let boxes_of  (Page -> [H:Xul?])
@@ -164,11 +165,13 @@ let meta (x : H:Flow) : H:Block =
     width="100%">
    [ <tr> [<td>x] ]
 
-let box_title (x : H:Flow, t : String) : H:Block =
+let box_title (x : H:Flow, a : String, t : String) : H:Block =
  <table cellpadding="5" 
     style="border: solid 2px black; background: #ffffff" width="100%">
-   [ <tr>[ <td style="background: #fff0f0; color: #0000ff; font: bold
-100% helvetica">t ] <tr> [<td>x] ]
+   [ <tr>[ 
+       <td style="background: #fff0f0; color: #0000ff; font: bold 100%
+                  helvetica">[<a name=a>t] ] 
+     <tr> [<td>x] ]
 
 let style = "
 a:link:hover, a:visited:hover {
@@ -375,12 +378,8 @@ match page with
 
 (* Preparing main panel *)
  let main = transform items with
-  | <box (r)>c ->
-      let b = [
-         <a name=(r . link)>[] 
-         !(content c) ] in
-      [ (box_title (b,r . title)) ]
- | <meta>c -> [ (meta (content c)) ]
+   | <box (r)>c -> [ (box_title (content c, r . link, r . title)) ]
+   | <meta>c -> [ (meta (content c)) ]
  in
  let notes = match !footnotes with
    | [] -> []