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