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