viewcvs.cgi/web/site.cd

(* This CDuce script produces CDuce web site. *)

(* The types *)

include "siteTypes.cd";;

(** Command line **)

let (input,outdir) =
  match argv [] with
  | [ s ("-o" o | /(o := "www")) ] -> (s,o)
  | _ -> raise "Please use --arg to specify an input file on the command line"

(** Generic purpose functions **)

(* Recursive inclusion of XML files and verbatim text files *)

let load_include (Latin1 -> [Any*])
 name ->
(*   let _ = print [ 'Loading ' !name '... \n' ] in  *)
   xtransform [ (load_xml name) ] with 
   | <include file=(s & Latin1)>[] -> load_include s
   | <include-verbatim file=(s & Latin1)>[] -> load_file s 
   | <include-forest file=(s & Latin1)>[] -> 
         match load_xml ("string:<fake>"@(load_file s)@"</fake>") with
            <fake> x -> x | _ -> raise "Uhh?"


(* Loading *)

let [<site>[ <title>site (<footer>footer | /(footer:=[])) main_page ] ] = 
 try (load_include input :? [ Site ])
 with err & Latin1 -> 
   print ['Invalid input document:\n' !err '\n']; 
   exit 2 

(* Highlighting text between {{...}} *)

let highlight (String -> [ (Char | H.strong | H.i)* ] )
 | [ '{{%%' h ::(Char *?) '%%}}' ; rest ] -> 
          [ <strong class="highlight">[<i>h]; highlight rest ]
 | [ '{{' h ::(Char *?) '}}' ; rest ] -> 
          [ <strong class="highlight">h; highlight rest ]
 | [ '$$%%' h ::(Char *?) '%%$$' ; rest ] -> 
          [ <strong class="ocaml">[<i>h]; highlight rest ]
 | [ '$$' h ::(Char *?) '$$' ; rest ] -> 
          [ <strong class="ocaml">h; highlight rest ]
 | [ '%%' h ::(Char *?) '%%' ; rest ] ->
          [ <i>h; highlight rest ] 
 | [ c; rest ] -> [ c; highlight rest ]
 | [] -> []

(* Split a comma-separated string *)

let split_comma (String -> [String*])
 | [ x::(Char*?) ',' ; rest ] -> (x, split_comma rest)
 | s -> [ s ]

type wschar = ' ' | '\n' | '\t' | '\r'

let split_thumbnails (String -> [(String,String)*])
 | [ wschar* x::(Char\wschar\':')+ ':' y::_*? '.'; rest ] -> 
        ((x,y), split_thumbnails rest)
 | [ wschar* x::(Char\wschar)+; rest ] -> 
        ((x,""), split_thumbnails rest)
 | [ wschar* ] -> []

(** Internal types **)

type Path = [ { url=String title=String }* ]
type Tree = { name=String url=String title=String
              children=[Tree*] boxes=[H.ul?] } 

let url_of_page (Page -> String)
 | <page url=u ..>_ -> u
 | <page name=n ..>_ -> n @ ".html"

let render(a : String)(p : {presenter=?"yes"|"no" ..}) : H.Flow =
 match p with
 | {presenter="yes" ..} -> [<strong class="ocaml">a] 
 | _ -> a

let authors ([Author+] -> H.Flow)
 | [ <author (p)>a ] -> render a p
 | [ <author (p1)>a1 <author (p2)>a2 ] -> (render a1 p1) @ ", and " @ (render a2 p2)
 | [ <author (p)>a; rem ] -> (render a p)@ ", " @ authors rem

let find_local_link (sitemap : [Tree*], l : String) : Tree =
match sitemap with
 | (h,t) ->
   if (h . name = l) then h
   else 
    (try find_local_link (t,l) with `Not_found -> 
         find_local_link (h . children,l))
 | [] -> raise `Not_found

let local_link (sitemap : Tree, l : String, txt : String) : [H.Inline?] =
 try 
  let h = find_local_link ([sitemap],l)  in
  let txt = if txt = "" then h . title else txt in
  [ <a href=(h . url)>txt ]
 with `Not_found -> 
  print [ 'Warning. Local link not found: ' !(string_of l) '\n' ];
  []
 
let compute_sitemap ((Page|External) -> Tree)
 | <page name=name ..>[ <title>title (c::(Page|External) | _)* ] & p ->
   let children = map c with p -> compute_sitemap p in
   { name url=(url_of_page p) title children boxes=(boxes_of p) }
 | <external name=name href=h title>[] ->
   { name url=h title children=[] boxes=[] }

let ul([H.li*] -> [H.ul?]) [] -> [] | l -> [ <ul>l ]

let ol(([H.li*],{style=?String}) -> [H.ol?]) 
 | ([],_) -> [] 
 | (l,s) -> [ <ol (s)>l ] 

let display_sitemap (h : Tree) :  H.li =
  let ch = map h . children with x -> display_sitemap x in
  <li>[ <a href=(h . url)>[ '[' !(h . title) ']' ] !(h . boxes); (ul ch) ]


let boxes_of (Page -> [H.ul?])
<page ..>[ (items::Item | _)*] & p ->
 let toc = transform items with 
 | <box title=t link=l ..>_ -> [ <li>[ <a href=[ !(url_of_page p) '#' !l ]>t ] ] 
 in
 ul toc

let link_to (<page (r)>[<title>t _* ] & p : Page) : H.a =
 let t = match r with
 | {new="" ..} -> t @ [ <img src="img/new.gif" alt="(new)" style="border:0">[]]
 | _ -> t in
 <a href=(url_of_page p)>t

let small_box (x : H.Flow) : H.Block =
 <table cellpadding="2" 
    style="font-size:11px ; font-family:arial,sans-serif;
           border: solid 2px black; background: #ffffff" width="100%">
   [ <tr> [<td>x] ]

let meta (x : H.Flow) : H.Block =
 <table cellpadding="2" 
    style="border: solid 1px #b0b0b0; background: #e0e0e0; font-size: 80%"  
    width="100%">
   [ <tr> [<td>x] ]

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">[<a name=a>t] ] 
     <tr> [<td>x] ]

let box (x : H.Flow) : H.Block =
 <table cellpadding="5" 
    style="border: solid 2px black; background: #ffffff" width="100%">
   [ <tr> [<td>x] ]

let style = "
a:link:hover, a:visited:hover {
  text-decoration: none;
  background: #FFFFD0;
  color: #FF0000;
}
a.old, a.old:hover, a.old:visited:hover { text-decoration: line-through; }
p { text-align: justify; margin: 1ex 1em 0 1em; }
pre { margin: 1ex 1em 0 1em; }
strong.ocaml{ color: #333b8e; }
strong.highlight { color: #FF0000; }
img.icon { border: 0; }
div.code { background: #E0E0E0; margin: 0.5ex 0.5em 0 0.5em; padding: 0.2ex; }
div.xmlcode { background:#ebefa2; margin: 0.5ex 0.5em 0 0.5em; padding: 0.2ex;}

div.abstract { 
  margin: 1ex 1em 1ex 1em;
  padding: 1ex 1em 1ex 1em;
  background: #F0F0F0;
}

div.note { 
  text-align: justify;
  margin: 1ex 3em 1ex 3em;
  padding: 1ex 1em 1ex 1em;
  background: #D0E2D2;
}

div.session
 { 
  font: bold 80% helvetica;
  margin: 1ex 1em 1ex 1em;
  padding: 1ex 1em 1ex 1em;
  border: solid .5px gray;
}

div.abstract p { font-family: sans-serif; font-size:12px; }
"

type PageO = Page | []


let button(title : String)(onclick : String) : H.Inline =
  <input type="submit" style="font-size:8px;" value=title onclick=onclick>[] 
let button_id(id : String)(title : String)(onclick : String)(style : String) 
: H.Inline =
  <input type="submit" id=id 
   style=("font-size:8px;"@style) value=title 
   onclick=onclick>[] 

let demo(no : Int)(name : String)(prefix : String)(txt : String) : H.Flow = 
 let n = [ 'a' !name '_' ] in
 let prefix = if prefix = "" then "" else [ 'a' !prefix '_' ] in
 [ !(if (no = 1) then [<script src="demo.js" type="text/javascript">" "]
     else [])
  <table style="width:100%">[
   <tr>[ 
    <td style="width:50%">[
     (button_id (n@"btn") "Edit" ("editable('"@n@"','');") "")
     (button "Evaluate" ("submit('"@n@"');"))
     (button "Default" ("defreq('"@n@"');"))
     (button_id (n@"btnclear") "Clear" ("clearreq('"@n@"');") "visibility:hidden;")
    ]
    <td style="width:50%">[
     <input id=(n@"def") type="hidden" value=txt>[]
     <input id=(n@"prefix") type="hidden" value=prefix>[]
     (button "Clear" ("clearres('"@n@"');"))
    ] ]
   <tr>[
    <td valign="top">[ 
     <div id=(n@"container")>[
      <pre id=(n@"req")>txt
      <textarea id=(n@"edit") cols="50" rows="25" style="display:none;border:1px solid #CCCCCC; background-color:#F0F0F0;">txt 
     ]
    ]
    <td valign="top">[ <div id=(n@"res")>[] ] ] ] 
  ]

(* Main transformation function *)

(* returns the last page of the descendance *)

let thumbnail(w : String, h : String)
 (url : String)(title : String) : H.Inlines =
 [ <a href=url>[ 
   <img src=url width=w height=h alt="Click to enlarge" title=title>[] ] ]

let thumbwh({ width=?IntStr height=?IntStr ..} -> 
   (String -> String ->H.Inlines))
  | { width = w; height = h } ->
      let w = int_of w in let h = int_of h in
      (match h with
       | 0 -> raise "Thumbnail height = 0"
       | h -> let w = string_of ((w * 200) div h) in thumbnail (w,"200"))
  | _ -> thumbnail ("266","200")

let gen_page (site : String,
              prev : PageO, page : Page, next : PageO, 
              path : Path, sitemap : Tree) : PageO = 
match page with 
<page name=name leftbar="false"&(leftbar:=`false) else (leftbar:=`true) ..>[ 
 (<title>title <banner>banner | <title>(title & banner)) 
 items::_* ] ->
 let items = items @ footer in

 let footnote_counter = ref Int 0 in 
 let footnotes = ref H.Flow [] in
 let demo_no = ref Int 0 in
 let last_demo = ref String "" in

 let text (t : [InlineText*]) : H.Inlines =
  transform t with
   | <code>x -> [ <b>[ <tt>(highlight x) ] ]
   | <local href=l>txt -> local_link (sitemap,l,txt)
   | <(tag & (`b|`i|`tt|`em)) (attr)>x -> [ <(tag) (attr)>(text x) ]
   | <footnote nocount="true">_ -> 
      let n = string_of !footnote_counter in
      [ <a name=[ 'bnote' !n ]>[]
        <a href=[ '#note' !n ]>[ '[' !n ']' ] ]

   | <footnote>c -> 
      footnote_counter := !footnote_counter + 1;
      let n = string_of !footnote_counter in
      let fn = !footnotes in
      footnotes := [];
      let c = <p>[ <a name=[ 'note' !n ]>[] 
                   <a href=[ '#bnote' !n ]>[ '[' !n ']' ]
                   ' ' ; text c ] in
      footnotes := fn @ [ c ] @ !footnotes;
      [ <a name=[ 'bnote' !n ]>[]
        <a href=[ '#note' !n ]>[ '[' !n ']' ] ]
   | <thumbnail ({href=url ..} & r)>[] ->
      thumbwh r url ""
   | <thumbnails ({href=url ..} & r)>l ->
      let l = split_thumbnails l in
      let f = thumbwh r in
      let c = ref Int 0 in
      (transform l with (x,y) -> 
          let t = f (url @ x) y in
          if (!c = 4) then (c := 1; [ <br>[] ] @ t)
          else (c := !c + 1; t))
   | z -> [ z ] 
 in

 let content (t : Content) : H.Flow =
  transform t with
   | <section title=title>c -> 
         [ <p>[ <b style="color: #008000">title ] !(content c) ]
   | <paper (r)>[ <title>tit aut::Author* <comment>com <abstract>ab  ] ->
         [ (match r with
           | { file = f; old = "" } -> <a class="old" href=f>tit
           | { file = f } -> <a href=f>tit
           | _ -> <b>tit) '. '
           !(authors aut) '. '
           !(text com)
           <div class="abstract">[ 'Abstract:' !(content ab) ]
         ]
   | <slides file=f>[ <title>tit aut::Author* <comment>com ]  ->
        [ <a href=f>tit '. ' !(authors aut) '. ' !(text com) ]
   | <sample highlight="false">s ->
        [ <div class="code">[ <pre>s ] ]
   | <sample ..>s ->
        [ <div class="code">[ <pre>(highlight s) ] ]
   | <xmlsample highlight="false">s ->
        [ <div class="xmlcode">[ <pre>s ] ]
   | <xmlsample ..>s ->
        [ <div class="xmlcode">[ <pre>(highlight s) ] ]
   | <sessionsample highlight="false">s ->
        [ <div class="session">[ <pre>s ] ]
   | <sessionsample ..>s ->
        [ <div class="session">[ <pre>(highlight s) ] ]
   | <link url=url title=title>com -> 
        [ <ul>[ <li>[ <a href=url>title '. ' !(text com) ] ] ]
   | <ul>lis -> 
        ul (map lis with <li>x -> <li>(content x))
   | <ol (attr) >lis -> 
        ol ((map lis with <li>x -> <li>(content x) ),(attr))
   | H.table & x -> 
       [ <table width="100%">[<tr>[<td align="center">[x]]] ]
   | <p (attr)>x -> [ <p (attr)>(text x) ]
   | <pages-toc (a)>[] ->
      let toc = transform items with 
      | Page & p -> 
        let sects = match a with {sections=_ ..} -> boxes_of p | _ -> [] in
        [ <li>[ (link_to p) ; sects ] ]
      | <external href title=t ..>[] -> [ <li>[ <a href>t ] ] in
      ul toc
   | <boxes-toc (a)>[] ->
      let sections = match a with { sections=_ ..} -> `true | _ -> `false in
      let short = match a with { short=_ ..} -> `true | _ -> `false in
      let toc = transform items with 
      | <box ({title=t link=l ..} & ({short=s ..} | {title=s ..}))>b ->
        let t = if short then s else t in
        let sects = 
         if sections then
          (transform b with <section title=t>_ -> [<br>[] '-' !t])
         else [] in
        [ <li>[ <a href=('#',l)>t !sects ]] in
      ul toc
   | <site-toc>[] ->
        [ <ul>[ (display_sitemap sitemap) ] ]
   | <local-links href=s>[] ->
        ul (transform (split_comma s) with x -> 
             match local_link(sitemap,x,"") with [] -> [] | x -> [<li>x])
   | <two-columns>[ <left>x <right>y ] ->
        [ <table width="100%">[ 
            <tr>[ 
              <td valign="top">(content x) 
              <td valign="top">(content y) ] ] ]
   | <note title=t>c ->  [ <div class="note">[ <b>[!t ':  '] !(content c) ]]
   | <note>c ->  [ <div class="note">[ <b>"Note:  " !(content c) ]]
   | <footnotes>[] -> 
       (match !footnotes with 
        | [] -> [] 
        | n -> footnotes := []; [ <br>[] (meta n) ] )
   | <xhtml>i -> i
   | <demo (r)>s -> 
       demo_no := !demo_no + 1; 
       let name = match r with { label .. } -> label | _ -> string_of !demo_no in
       let prefix = 
           match r with { prefix = "last" .. } -> !last_demo 
                      | { prefix .. } -> prefix
                      | _ -> "" in
       last_demo := name;
       demo !demo_no name prefix s
   | t -> text [ t ]
 in

(* Preparing left panel *)

 let left =
  if leftbar then
  let navig = transform items with <left>c -> [ c ] in
  let left = match navig with [] -> [ [<boxes-toc>[]] ] | n -> n in
  [
  
   <td valign="top" align="left">[
     <span style="position:fixed;background:#ffffff;border: solid 2px black; cursor:e-resize;" onclick="javascript:var s=document.getElementById('leftbar').style; var d=s.display=='none'?'block':'none'; s.display=d; document.cookie='leftbar='+d;">"*"
     <table cellpadding="0" cellspacing="15" id="leftbar"
            width="200"
            style="font-size:80%; border: 1px dashed black;
                   background: #ffcd72">        (* altbg 9aa8ba *)
     (map left with x -> <tr>[ <td>[ (small_box (content x)) ] ]) ] ]
 else [] in

 let dpath : H.Inlines = transform path with 
  | { url = f title = t } -> [ <a href=f>t ': '] 
 in
 let npath = path @ [ { url = (url_of_page page); title = title } ] in
 let subpages = transform items with p & Page -> [ p ] in
 let (next,last) = gen_page_seq (site,page, subpages, next, npath, sitemap) in
 let next = match next with [] -> [] 
   | <page ..>[ <title>t; _ ] & p -> 
      [ <a href=(url_of_page p)>[ 
          <img width="16" height="16" class="icon" alt="Next page:"
               src="img/right.gif">[]
          ' ' !t
        ] ] in
 let prev = match prev with [] -> [] 
   | <page ..>[ <title>t; _ ] & p -> 
      [ <a href=(url_of_page p)>[ 
          <img width="16" height="16" class="icon"
               alt="Previous page:" src="img/left.gif">[]
          ' ' !t
        ] ] in
 let navig = 
   if prev = [] then [] else
   [ (small_box [
     <p>[ !dpath !title ]
     <p>[ !prev ' ' !next ] ]) ] in

(* Preparing main panel *)
 let main = transform items with
   | <box title=t link=l ..>c -> [ (box_title (content c, l, t)) ]
   | <box>c -> [ (box (content c)) ]
   | <footnotes>[] -> 
       (match !footnotes with 
        | [] -> [] 
        | n -> footnotes := []; [ (meta n) ] )
   | <meta>c -> [ (meta (content c)) ]
 in
 let notes = match !footnotes with
   | [] -> []
   | n -> [ (meta n) ] in
 let main = match (navig @ main @ notes @ navig) with
   | [] -> raise "Empty page !"
   | x -> x in

 let right : H.td =
  <td valign="top" align="left" style="width:100%">[
   <table width="100%">[
    <tr>[ <td valign="top" align="left"
              style="border: 2px solid black; background: #ffffff;
text-align:center; color: #aa0000; font: bold 200% helvetica" >
          (text banner)
        ]
 
    <tr>[
      <td valign="top" align="left"
          style="border: 1px solid black; background: #fccead">[ (* altbg c8ccd1 *)
       <table width="100%" cellpadding="0" cellspacing="17">
         (map main with x -> <tr>[ <td>[x] ])
      ] ]
  ] ] in

 let html : H.html =
 <html>[
  <head>[ 
   <title>[ !site ': ' !title ]
   <meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">[]
   <style type="text/css">style
  ]
  <body style="margin: 0; padding : 0; background: #fcb333"
        onload="javascript:if (document.cookie.indexOf('leftbar=none')>=0) document.getElementById('leftbar').style.display='none';">[  (* altbg  4e6e99 *)
   <table cellspacing="10" cellpadding="0" width="100%" border="0">[
    <tr>[ !left right ]
   ]
  ]
 ]
 in
 let txt : Latin1 = 
   [ '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'
     '  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'
     !(print_xml html) ] in
 let fn = outdir @ "/" @ name @ ".html" in
 dump_to_file fn txt;
 last
        

let gen_page_seq 
 (site : String,
  prev : PageO, pages : [Page*], next : PageO, 
  path : Path, sitemap : Tree) : (PageO, PageO) =
 match pages with
 | [ p1 p2 ; _ ] & [ _; rest ] -> 
     let last = gen_page (site,prev,p1,p2, path, sitemap) in
     let (_,last)  = gen_page_seq (site,last, rest, next, path, sitemap) in 
     (p1,last)
 | [ p ] ->
     let last = gen_page (site,prev,p,next, path, sitemap) in (p,last)
 | [] -> (next,prev)


;;

gen_page (site,[],main_page,[], [], compute_sitemap main_page)
1	abate	284	(* This CDuce script produces CDuce web site. *)
2
3	abate	1602	(* The types *)
4
5			include "siteTypes.cd";;
6
7	abate	369	( Command line )
8
9	abate	1425	let (input,outdir) =
10	abate	1097	match argv [] with
11	abate	1425	\| [ s ("-o" o \| /(o := "www")) ] -> (s,o)
12	abate	709	\| _ -> raise "Please use --arg to specify an input file on the command line"
13	abate	369
14	abate	343	( Generic purpose functions )
15
16			(* Recursive inclusion of XML files and verbatim text files *)
17
18	abate	1229	let load_include (Latin1 -> [Any*])
19	abate	336	name ->
20	abate	1563	(* let _ = print [ 'Loading ' !name '... \n' ] in *)
21	abate	336	xtransform [ (load_xml name) ] with
22	abate	1229	\| <include file=(s & Latin1)>[] -> load_include s
23			\| <include-verbatim file=(s & Latin1)>[] -> load_file s
24	abate	1681	\| <include-forest file=(s & Latin1)>[] ->
25			match load_xml ("string:<fake>"@(load_file s)@"</fake>") with
26			<fake> x -> x \| _ -> raise "Uhh?"
27	abate	336
28	abate	1681
29	abate	1424	(* Loading *)
30
31			let [<site>[ <title>site (<footer>footer \| /(footer:=[])) main_page ] ] =
32			try (load_include input :? [ Site ])
33	abate	1425	with err & Latin1 ->
34	abate	1563	print ['Invalid input document:\n' !err '\n'];
35	abate	1424	exit 2
36
37	abate	343	(* Highlighting text between {{...}} *)
38	abate	336
39	abate	1519	let highlight (String -> [ (Char \| H.strong \| H.i)* ] )
40	abate	981	\| [ '{{%%' h ::(Char *?) '%%}}' ; rest ] ->
41			[ <strong class="highlight">[<i>h]; highlight rest ]
42	abate	340	\| [ '{{' h ::(Char *?) '}}' ; rest ] ->
43	abate	981	[ <strong class="highlight">h; highlight rest ]
44	abate	1037	\| [ '$$%%' h ::(Char *?) '%%$$' ; rest ] ->
45			[ <strong class="ocaml">[<i>h]; highlight rest ]
46			\| [ '$$' h ::(Char *?) '$$' ; rest ] ->
47			[ <strong class="ocaml">h; highlight rest ]
48	abate	381	\| [ '%%' h ::(Char *?) '%%' ; rest ] ->
49	abate	698	[ <i>h; highlight rest ]
50	abate	340	\| [ c; rest ] -> [ c; highlight rest ]
51	abate	488	\| [] -> []
52	abate	336
53	abate	343	(* Split a comma-separated string *)
54
55	abate	488	let split_comma (String -> [String*])
56	abate	341	\| [ x::(Char*?) ',' ; rest ] -> (x, split_comma rest)
57	abate	488	\| s -> [ s ]
58	abate	336
59	abate	1348	type wschar = ' ' \| '\n' \| '\t' \| '\r'
60	abate	253
61	abate	1348	let split_thumbnails (String -> [(String,String)*])
62			\| [ wschar* x::(Char\wschar\':')+ ':' y::_*? '.'; rest ] ->
63			((x,y), split_thumbnails rest)
64			\| [ wschar* x::(Char\wschar)+; rest ] ->
65			((x,""), split_thumbnails rest)
66			\| [ wschar* ] -> []
67
68	abate	343	( Internal types )
69	abate	341
70	abate	1519	type Path = [ { url=String title=String }* ]
71			type Tree = { name=String url=String title=String
72			children=[Tree*] boxes=[H.ul?] }
73	abate	250
74	abate	1065	let url_of_page (Page -> String)
75	abate	1519	\| <page url=u ..>_ -> u
76			\| <page name=n ..>_ -> n @ ".html"
77	abate	346
78	abate	1519	let render(a : String)(p : {presenter=?"yes"\|"no" ..}) : H.Flow =
79			match p with
80			\| {presenter="yes" ..} -> [<strong class="ocaml">a]
81			\| _ -> a
82	abate	250
83	abate	1495	let authors ([Author+] -> H.Flow)
84	abate	1330	\| [ <author (p)>a ] -> render a p
85			\| [ <author (p1)>a1 <author (p2)>a2 ] -> (render a1 p1) @ ", and " @ (render a2 p2)
86			\| [ <author (p)>a; rem ] -> (render a p)@ ", " @ authors rem
87
88	abate	488	let find_local_link (sitemap : [Tree*], l : String) : Tree =
89	abate	341	match sitemap with
90			\| (h,t) ->
91	abate	347	if (h . name = l) then h
92	abate	341	else
93			(try find_local_link (t,l) with `Not_found ->
94			find_local_link (h . children,l))
95	abate	488	\| [] -> raise `Not_found
96	abate	341
97	abate	1495	let local_link (sitemap : Tree, l : String, txt : String) : [H.Inline?] =
98	abate	347	try
99			let h = find_local_link ([sitemap],l) in
100			let txt = if txt = "" then h . title else txt in
101	abate	1422	[ <a href=(h . url)>txt ]
102			with `Not_found ->
103			print [ 'Warning. Local link not found: ' !(string_of l) '\n' ];
104			[]
105	abate	341
106	abate	488	let compute_sitemap ((Page\|External) -> Tree)
107	abate	1519	\| <page name=name ..>[ <title>title (c::(Page\|External) \| _)* ] & p ->
108	abate	341	let children = map c with p -> compute_sitemap p in
109	abate	1519	{ name url=(url_of_page p) title children boxes=(boxes_of p) }
110			\| <external name=name href=h title>[] ->
111			{ name url=h title children=[] boxes=[] }
112	abate	341
113	abate	1519	let ul([H.li*] -> [H.ul?]) [] -> [] \| l -> [ <ul>l ]
114	abate	1064
115	abate	1519	let ol(([H.li*],{style=?String}) -> [H.ol?])
116			\| ([],_) -> []
117			\| (l,s) -> [ <ol (s)>l ]
118	abate	1126
119	abate	1519	let display_sitemap (h : Tree) : H.li =
120	abate	341	let ch = map h . children with x -> display_sitemap x in
121	abate	1064	<li>[ <a href=(h . url)>[ '[' !(h . title) ']' ] !(h . boxes); (ul ch) ]
122	abate	341
123	abate	681
124	abate	1519	let boxes_of (Page -> [H.ul?])
125			<page ..>[ (items::Item \| _)*] & p ->
126	abate	1064	let toc = transform items with
127	abate	1549	\| <box title=t link=l ..>_ -> [ <li>[ <a href=[ !(url_of_page p) '#' !l ]>t ] ]
128	abate	1064	in
129			ul toc
130	abate	351
131	abate	1519	let link_to (<page (r)>[<title>t _* ] & p : Page) : H.a =
132			let t = match r with
133			\| {new="" ..} -> t @ [ <img src="img/new.gif" alt="(new)" style="border:0">[]]
134	abate	1064	\| _ -> t in
135	abate	1065	<a href=(url_of_page p)>t
136	abate	1064
137	abate	1495	let small_box (x : H.Flow) : H.Block =
138	abate	580	<table cellpadding="2"
139	abate	586	style="font-size:11px ; font-family:arial,sans-serif;
140			border: solid 2px black; background: #ffffff" width="100%">
141	abate	580	[ <tr> [<td>x] ]
142
143	abate	1495	let meta (x : H.Flow) : H.Block =
144	abate	580	<table cellpadding="2"
145	abate	797	style="border: solid 1px #b0b0b0; background: #e0e0e0; font-size: 80%"
146	abate	580	width="100%">
147			[ <tr> [<td>x] ]
148
149	abate	1495	let box_title (x : H.Flow, a : String, t : String) : H.Block =
150	abate	580	<table cellpadding="5"
151			style="border: solid 2px black; background: #ffffff" width="100%">
152	abate	1058	[ <tr>[
153			<td style="background: #fff0f0; color: #0000ff; font: bold 100%
154			helvetica">[<a name=a>t] ]
155			<tr> [<td>x] ]
156	abate	580
157	abate	1495	let box (x : H.Flow) : H.Block =
158	abate	1065	<table cellpadding="5"
159			style="border: solid 2px black; background: #ffffff" width="100%">
160			[ <tr> [<td>x] ]
161
162	abate	580	let style = "
163			a:link:hover, a:visited:hover {
164			text-decoration: none;
165			background: #FFFFD0;
166			color: #FF0000;
167			}
168	abate	1064	a.old, a.old:hover, a.old:visited:hover { text-decoration: line-through; }
169			p { text-align: justify; margin: 1ex 1em 0 1em; }
170			pre { margin: 1ex 1em 0 1em; }
171			strong.ocaml{ color: #333b8e; }
172			strong.highlight { color: #FF0000; }
173			img.icon { border: 0; }
174			div.code { background: #E0E0E0; margin: 0.5ex 0.5em 0 0.5em; padding: 0.2ex; }
175			div.xmlcode { background:#ebefa2; margin: 0.5ex 0.5em 0 0.5em; padding: 0.2ex;}
176	abate	976
177	abate	580	div.abstract {
178			margin: 1ex 1em 1ex 1em;
179			padding: 1ex 1em 1ex 1em;
180			background: #F0F0F0;
181			}
182	abate	976
183			div.note {
184	abate	979	text-align: justify;
185	abate	976	margin: 1ex 3em 1ex 3em;
186			padding: 1ex 1em 1ex 1em;
187			background: #D0E2D2;
188			}
189
190	abate	981	div.session
191			{
192			font: bold 80% helvetica;
193			margin: 1ex 1em 1ex 1em;
194			padding: 1ex 1em 1ex 1em;
195	abate	1430	border: solid .5px gray;
196	abate	981	}
197
198	abate	1683	div.abstract p { font-family: sans-serif; font-size:12px; }
199	abate	580	"
200
201	abate	1064	type PageO = Page \| []
202
203	abate	1387
204	abate	1495	let button(title : String)(onclick : String) : H.Inline =
205	abate	1413	<input type="submit" style="font-size:8px;" value=title onclick=onclick>[]
206			let button_id(id : String)(title : String)(onclick : String)(style : String)
207	abate	1495	: H.Inline =
208	abate	1413	<input type="submit" id=id
209			style=("font-size:8px;"@style) value=title
210			onclick=onclick>[]
211	abate	1387
212	abate	1495	let demo(no : Int)(name : String)(prefix : String)(txt : String) : H.Flow =
213	abate	1412	let n = [ 'a' !name '_' ] in
214			let prefix = if prefix = "" then "" else [ 'a' !prefix '_' ] in
215	abate	1393	[ !(if (no = 1) then [<script src="demo.js" type="text/javascript">" "]
216	abate	1387	else [])
217			<table style="width:100%">[
218			<tr>[
219			<td style="width:50%">[
220	abate	1413	(button_id (n@"btn") "Edit" ("editable('"@n@"','');") "")
221	abate	1387	(button "Evaluate" ("submit('"@n@"');"))
222	abate	1388	(button "Default" ("defreq('"@n@"');"))
223	abate	1413	(button_id (n@"btnclear") "Clear" ("clearreq('"@n@"');") "visibility:hidden;")
224	abate	1387	]
225			<td style="width:50%">[
226	abate	1388	<input id=(n@"def") type="hidden" value=txt>[]
227	abate	1411	<input id=(n@"prefix") type="hidden" value=prefix>[]
228	abate	1388	(button "Clear" ("clearres('"@n@"');"))
229	abate	1387	] ]
230			<tr>[
231	abate	1392	<td valign="top">[
232	abate	1415	<div id=(n@"container")>[
233			<pre id=(n@"req")>txt
234			<textarea id=(n@"edit") cols="50" rows="25" style="display:none;border:1px solid #CCCCCC; background-color:#F0F0F0;">txt
235	abate	1392	]
236			]
237	abate	1393	<td valign="top">[ <div id=(n@"res")>[] ] ] ]
238			]
239	abate	1387
240	abate	343	(* Main transformation function *)
241
242	abate	386	(* returns the last page of the descendance *)
243	abate	1348
244			let thumbnail(w : String, h : String)
245	abate	1495	(url : String)(title : String) : H.Inlines =
246	abate	1348	[ <a href=url>[
247			<img src=url width=w height=h alt="Click to enlarge" title=title>[] ] ]
248
249	abate	1519	let thumbwh({ width=?IntStr height=?IntStr ..} ->
250	abate	1495	(String -> String ->H.Inlines))
251	abate	1348	\| { width = w; height = h } ->
252			let w = int_of w in let h = int_of h in
253			(match h with
254			\| 0 -> raise "Thumbnail height = 0"
255			\| h -> let w = string_of ((w * 200) div h) in thumbnail (w,"200"))
256			\| _ -> thumbnail ("266","200")
257
258	abate	1065	let gen_page (site : String,
259			prev : PageO, page : Page, next : PageO,
260	abate	1064	path : Path, sitemap : Tree) : PageO =
261			match page with
262	abate	1519	<page name=name leftbar="false"&(leftbar:=`false) else (leftbar:=`true) ..>[
263	abate	1424	(<title>title <banner>banner \| <title>(title & banner))
264			items::_* ] ->
265			let items = items @ footer in
266
267	abate	625	let footnote_counter = ref Int 0 in
268	abate	1495	let footnotes = ref H.Flow [] in
269	abate	1387	let demo_no = ref Int 0 in
270	abate	1412	let last_demo = ref String "" in
271	abate	625
272	abate	1495	let text (t : [InlineText*]) : H.Inlines =
273	abate	625	transform t with
274			\| <code>x -> [ <b>[ <tt>(highlight x) ] ]
275	abate	1422	\| <local href=l>txt -> local_link (sitemap,l,txt)
276	abate	625	\| <(tag & (`b\|`i\|`tt\|`em)) (attr)>x -> [ <(tag) (attr)>(text x) ]
277	abate	1519	\| <footnote nocount="true">_ ->
278	abate	1264	let n = string_of !footnote_counter in
279			[ <a name=[ 'bnote' !n ]>[]
280			<a href=[ '#note' !n ]>[ '[' !n ']' ] ]
281
282	abate	625	\| <footnote>c ->
283			footnote_counter := !footnote_counter + 1;
284			let n = string_of !footnote_counter in
285			let fn = !footnotes in
286			footnotes := [];
287			let c = <p>[ <a name=[ 'note' !n ]>[]
288			<a href=[ '#bnote' !n ]>[ '[' !n ']' ]
289			' ' ; text c ] in
290			footnotes := fn @ [ c ] @ !footnotes;
291			[ <a name=[ 'bnote' !n ]>[]
292			<a href=[ '#note' !n ]>[ '[' !n ']' ] ]
293	abate	1519	\| <thumbnail ({href=url ..} & r)>[] ->
294	abate	1348	thumbwh r url ""
295	abate	1519	\| <thumbnails ({href=url ..} & r)>l ->
296	abate	1348	let l = split_thumbnails l in
297			let f = thumbwh r in
298			let c = ref Int 0 in
299			(transform l with (x,y) ->
300			let t = f (url @ x) y in
301			if (!c = 4) then (c := 1; [ <br>[] ] @ t)
302			else (c := !c + 1; t))
303	abate	698	\| z -> [ z ]
304	abate	341	in
305	abate	254
306	abate	1495	let content (t : Content) : H.Flow =
307	abate	250	transform t with
308	abate	284	\| <section title=title>c ->
309	abate	580	[ <p>[ <b style="color: #008000">title ] !(content c) ]
310	abate	1408	\| <paper (r)>[ <title>tit aut::Author* <comment>com <abstract>ab ] ->
311	abate	734	[ (match r with
312	abate	1064	\| { file = f; old = "" } -> <a class="old" href=f>tit
313	abate	734	\| { file = f } -> <a href=f>tit
314			\| _ -> <b>tit) '. '
315	abate	250	!(authors aut) '. '
316	abate	254	!(text com)
317	abate	250	<div class="abstract">[ 'Abstract:' !(content ab) ]
318			]
319			\| <slides file=f>[ <title>tit aut::Author* <comment>com ] ->
320	abate	254	[ <a href=f>tit '. ' !(authors aut) '. ' !(text com) ]
321	abate	344	\| <sample highlight="false">s ->
322			[ <div class="code">[ <pre>s ] ]
323	abate	1519	\| <sample ..>s ->
324	abate	340	[ <div class="code">[ <pre>(highlight s) ] ]
325	abate	979	\| <xmlsample highlight="false">s ->
326			[ <div class="xmlcode">[ <pre>s ] ]
327	abate	1519	\| <xmlsample ..>s ->
328	abate	979	[ <div class="xmlcode">[ <pre>(highlight s) ] ]
329	abate	981	\| <sessionsample highlight="false">s ->
330			[ <div class="session">[ <pre>s ] ]
331	abate	1519	\| <sessionsample ..>s ->
332	abate	981	[ <div class="session">[ <pre>(highlight s) ] ]
333	abate	561	\| <link url=url title=title>com ->
334	abate	1065	[ <ul>[ <li>[ <a href=url>title '. ' !(text com) ] ] ]
335	abate	284	\| <ul>lis ->
336	abate	1064	ul (map lis with <li>x -> <li>(content x))
337	abate	1264	\| <ol (attr) >lis ->
338			ol ((map lis with <li>x -> <li>(content x) ),(attr))
339	abate	1519	\| H.table & x ->
340	abate	1201	[ <table width="100%">[<tr>[<td align="center">[x]]] ]
341	abate	614	\| <p (attr)>x -> [ <p (attr)>(text x) ]
342	abate	681	\| <pages-toc (a)>[] ->
343	abate	1064	let toc = transform items with
344			\| Page & p ->
345	abate	1519	let sects = match a with {sections=_ ..} -> boxes_of p \| _ -> [] in
346	abate	1064	[ <li>[ (link_to p) ; sects ] ]
347	abate	1519	\| <external href title=t ..>[] -> [ <li>[ <a href>t ] ] in
348	abate	1064	ul toc
349	abate	696	\| <boxes-toc (a)>[] ->
350	abate	1519	let sections = match a with { sections=_ ..} -> `true \| _ -> `false in
351			let short = match a with { short=_ ..} -> `true \| _ -> `false in
352	abate	1064	let toc = transform items with
353	abate	1519	\| <box ({title=t link=l ..} & ({short=s ..} \| {title=s ..}))>b ->
354	abate	1065	let t = if short then s else t in
355			let sects =
356			if sections then
357	abate	1064	(transform b with <section title=t>_ -> [<br>[] '-' !t])
358	abate	1065	else [] in
359	abate	1064	[ <li>[ <a href=('#',l)>t !sects ]] in
360			ul toc
361	abate	341	\| <site-toc>[] ->
362			[ <ul>[ (display_sitemap sitemap) ] ]
363			\| <local-links href=s>[] ->
364	abate	1422	ul (transform (split_comma s) with x ->
365			match local_link(sitemap,x,"") with [] -> [] \| x -> [<li>x])
366	abate	356	\| <two-columns>[ <left>x <right>y ] ->
367			[ <table width="100%">[
368			<tr>[
369			<td valign="top">(content x)
370			<td valign="top">(content y) ] ] ]
371	abate	1065	\| <note title=t>c -> [ <div class="note">[ <b>[!t ': '] !(content c) ]]
372	abate	1064	\| <note>c -> [ <div class="note">[ <b>"Note: " !(content c) ]]
373			\| <footnotes>[] ->
374			(match !footnotes with
375			\| [] -> []
376			\| n -> footnotes := []; [ <br>[] (meta n) ] )
377	abate	1384	\| <xhtml>i -> i
378	abate	1412	\| <demo (r)>s ->
379			demo_no := !demo_no + 1;
380	abate	1519	let name = match r with { label .. } -> label \| _ -> string_of !demo_no in
381	abate	1412	let prefix =
382	abate	1519	match r with { prefix = "last" .. } -> !last_demo
383			\| { prefix .. } -> prefix
384	abate	1412	\| _ -> "" in
385			last_demo := name;
386			demo !demo_no name prefix s
387	abate	341	\| t -> text [ t ]
388			in
389	abate	250
390	abate	580	(* Preparing left panel *)
391	abate	698
392	abate	1716	let left =
393	abate	1410	if leftbar then
394			let navig = transform items with <left>c -> [ c ] in
395			let left = match navig with [] -> [ [<boxes-toc>[]] ] \| n -> n in
396			[
397	abate	1411
398	abate	580	<td valign="top" align="left">[
399	abate	1418	<span style="position:fixed;background:#ffffff;border: solid 2px black; cursor:e-resize;" onclick="javascript:var s=document.getElementById('leftbar').style; var d=s.display=='none'?'block':'none'; s.display=d; document.cookie='leftbar='+d;">"*"
400	abate	1411	<table cellpadding="0" cellspacing="15" id="leftbar"
401	abate	586	width="200"
402			style="font-size:80%; border: 1px dashed black;
403	abate	797	background: #ffcd72"> (* altbg 9aa8ba *)
404	abate	1410	(map left with x -> <tr>[ <td>[ (small_box (content x)) ] ]) ] ]
405			else [] in
406	abate	580
407	abate	1495	let dpath : H.Inlines = transform path with
408	abate	1519	\| { url = f title = t } -> [ <a href=f>t ': ']
409	abate	341	in
410	abate	1065	let npath = path @ [ { url = (url_of_page page); title = title } ] in
411	abate	351	let subpages = transform items with p & Page -> [ p ] in
412	abate	1065	let (next,last) = gen_page_seq (site,page, subpages, next, npath, sitemap) in
413	abate	391	let next = match next with [] -> []
414	abate	1519	\| <page ..>[ <title>t; _ ] & p ->
415	abate	1065	[ <a href=(url_of_page p)>[
416	abate	595	<img width="16" height="16" class="icon" alt="Next page:"
417	abate	586	src="img/right.gif">[]
418	abate	391	' ' !t
419			] ] in
420			let prev = match prev with [] -> []
421	abate	1519	\| <page ..>[ <title>t; _ ] & p ->
422	abate	1065	[ <a href=(url_of_page p)>[
423	abate	586	<img width="16" height="16" class="icon"
424	abate	595	alt="Previous page:" src="img/left.gif">[]
425	abate	391	' ' !t
426			] ] in
427	abate	580	let navig =
428	abate	391	if prev = [] then [] else
429	abate	1065	[ (small_box [
430	abate	391	<p>[ !dpath !title ]
431	abate	580	<p>[ !prev ' ' !next ] ]) ] in
432
433			(* Preparing main panel *)
434			let main = transform items with
435	abate	1549	\| <box title=t link=l ..>c -> [ (box_title (content c, l, t)) ]
436	abate	1065	\| <box>c -> [ (box (content c)) ]
437	abate	1064	\| <footnotes>[] ->
438			(match !footnotes with
439			\| [] -> []
440			\| n -> footnotes := []; [ (meta n) ] )
441	abate	1058	\| <meta>c -> [ (meta (content c)) ]
442	abate	580	in
443	abate	625	let notes = match !footnotes with
444			\| [] -> []
445			\| n -> [ (meta n) ] in
446			let main = match (navig @ main @ notes @ navig) with
447	abate	580	\| [] -> raise "Empty page !"
448			\| x -> x in
449
450	abate	1519	let right : H.td =
451	abate	580	<td valign="top" align="left" style="width:100%">[
452			<table width="100%">[
453			<tr>[ <td valign="top" align="left"
454			style="border: 2px solid black; background: #ffffff;
455			text-align:center; color: #aa0000; font: bold 200% helvetica" >
456			(text banner)
457			]
458
459			<tr>[
460			<td valign="top" align="left"
461	abate	797	style="border: 1px solid black; background: #fccead">[ (* altbg c8ccd1 *)
462	abate	589	<table width="100%" cellpadding="0" cellspacing="17">
463	abate	580	(map main with x -> <tr>[ <td>[x] ])
464			] ]
465			] ] in
466
467	abate	1519	let html : H.html =
468	abate	250	<html>[
469			<head>[
470	abate	1065	<title>[ !site ': ' !title ]
471	abate	1672	<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">[]
472	abate	580	<style type="text/css">style
473	abate	250	]
474	abate	1418	<body style="margin: 0; padding : 0; background: #fcb333"
475			onload="javascript:if (document.cookie.indexOf('leftbar=none')>=0) document.getElementById('leftbar').style.display='none';">[ (* altbg 4e6e99 *)
476	abate	580	<table cellspacing="10" cellpadding="0" width="100%" border="0">[
477	abate	1410	<tr>[ !left right ]
478	abate	580	]
479	abate	250	]
480	abate	341	]
481			in
482	abate	391	let txt : Latin1 =
483	abate	351	[ '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'
484	abate	341	' "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'
485	abate	580	!(print_xml html) ] in
486	abate	1425	let fn = outdir @ "/" @ name @ ".html" in
487	abate	625	dump_to_file fn txt;
488	abate	488	last
489	abate	386
490	abate	250
491	abate	488	let gen_page_seq
492	abate	1065	(site : String,
493			prev : PageO, pages : [Page*], next : PageO,
494	abate	1064	path : Path, sitemap : Tree) : (PageO, PageO) =
495	abate	351	match pages with
496			\| [ p1 p2 ; _ ] & [ _; rest ] ->
497	abate	1065	let last = gen_page (site,prev,p1,p2, path, sitemap) in
498			let (_,last) = gen_page_seq (site,last, rest, next, path, sitemap) in
499	abate	386	(p1,last)
500	abate	351	\| [ p ] ->
501	abate	1065	let last = gen_page (site,prev,p,next, path, sitemap) in (p,last)
502	abate	488	\| [] -> (next,prev)
503	abate	351
504
505	abate	488	;;
506	abate	284
507	abate	1424	gen_page (site,[],main_page,[], [], compute_sitemap main_page)