Commit 07e48e06 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2004-04-14 05:54:46 by afrisch] Update site.cd

Original author: afrisch
Date: 2004-04-14 05:54:47+00:00
parent 78d95413
<?xml version="1.0" encoding="ISO-8859-1" standalone="yes"?> <?xml version="1.0" encoding="ISO-8859-1" standalone="yes"?>
<page name="index"> <page name="index" url="/">
<title>Home page</title> <title>Home page</title>
<banner> <banner>
...@@ -293,18 +293,15 @@ explosion where we cannot); powerful filter operation. ...@@ -293,18 +293,15 @@ explosion where we cannot); powerful filter operation.
</box> </box>
<box title="Related links" link="links"> <box title="Related links" link="links">
<ul> <link url="http://www.w3.org/XML/"
<li> <link url="http://www.w3.org/XML/"
title="Extensible Markup Language (XML)"> The W3C page on XML. </link> title="Extensible Markup Language (XML)"> The W3C page on XML. </link>
</li> <link url="http://www.research.avayalabs.com/user/wadler/xml/"
<li> <link url="http://www.research.avayalabs.com/user/wadler/xml/"
title="XML: Some hyperlinks minus the hype"> By Philip Wadler. </link> title="XML: Some hyperlinks minus the hype"> By Philip Wadler. </link>
</li> <link url="http://xduce.sourceforge.net/"
<li> <link url="http://xduce.sourceforge.net/" title="XDuce"> XDuce home page. </link>
title="XDuce"> XDuce home page. </link> </li> <link url="http://www.cis.upenn.edu/~bcpierce/xtatic/"
<li> <link url="http://www.cis.upenn.edu/~bcpierce/xtatic/" title="Xtatic"> The Xtatic Project. </link>
title="Xtatic"> The Xtatic Project. </link> </li> </box>
</ul> </box>
<meta> <meta>
......
...@@ -144,7 +144,7 @@ let is_valid_mail (Any -> Bool) ...@@ -144,7 +144,7 @@ let is_valid_mail (Any -> Bool)
</em> </em>
</p> </p>
</box> </box>
<box noindex="true" title="" link=""> <box>
<p> <p>
<em> <em>
<b>Correctness remark:</b> while parsing XML Schema documents, CDuce <b>Correctness remark:</b> while parsing XML Schema documents, CDuce
......
...@@ -13,11 +13,12 @@ using H = "xhtml" ...@@ -13,11 +13,12 @@ using H = "xhtml"
(** Input types **) (** Input types **)
type Page = <page name=String new=?"">[ <title>String <banner>[InlineText*]? Item* ] type Site = <site>[ <title>String Page ]
type Page = <page name=String url=?String new=?"">[ <title>String <banner>[InlineText*]? Item* ]
type External = <external {|href=String; title=String; name=String |}>[] type External = <external {|href=String; title=String; name=String |}>[]
type Item = type Item =
<box noindex=?String title=String link=String>Content <box ({| title=String; link=String; short=?String |} | {| |})>Content
| <meta>Content | <meta>Content
| <left>Content | <left>Content
| <footnotes>[] | <footnotes>[]
...@@ -44,12 +45,12 @@ type Content = ...@@ -44,12 +45,12 @@ type Content =
| <sessionsample highlight=?"true"|"false">String | <sessionsample highlight=?"true"|"false">String
| H:Xtable | H:Xtable
| Paper | Slides | Link | Paper | Slides | Link
| <boxes-toc sections=?"">[] (* the optional "section" produces *) | <boxes-toc short=?"" sections=?"">[]
| <pages-toc sections=?"">[] (* a two-level toc *) | <pages-toc sections=?"">[]
| <site-toc>[] | <site-toc>[]
| <local-links href=String>[] | <local-links href=String>[]
| <two-columns>[ <left>Content <right>Content ] | <two-columns>[ <left>Content <right>Content ]
| <note> Content | <note title=?String> Content
| <footnotes>[] | <footnotes>[]
| InlineText | InlineText
)* ] )* ]
...@@ -102,9 +103,9 @@ type Path = [ { url = String; title = String }* ] ...@@ -102,9 +103,9 @@ type Path = [ { url = String; title = String }* ]
type Tree = { name = String; url = String; title = String; type Tree = { name = String; url = String; title = String;
children = [Tree*]; boxes = [H:Xul?] } children = [Tree*]; boxes = [H:Xul?] }
let url_of_name (String -> String) let url_of_page (Page -> String)
| "index" -> "/" | <page url=u>_ -> u
| s -> s @ ".html" | <page name=n>_ -> n @ ".html"
let authors ([Author+] -> String) let authors ([Author+] -> String)
| [ <author>a ] -> a | [ <author>a ] -> a
...@@ -130,7 +131,7 @@ let local_link (sitemap : Tree, l : String, txt : String) : H:Inline = ...@@ -130,7 +131,7 @@ let local_link (sitemap : Tree, l : String, txt : String) : H:Inline =
let compute_sitemap ((Page|External) -> Tree) let compute_sitemap ((Page|External) -> Tree)
| <page name=name>[ <title>title (c::(Page|External) | _)* ] & p -> | <page name=name>[ <title>title (c::(Page|External) | _)* ] & p ->
let children = map c with p -> compute_sitemap p in let children = map c with p -> compute_sitemap p in
{ name = name; url = (url_of_name name); title = title; { name = name; url = (url_of_page p); title = title;
children = children; boxes = (boxes_of p) } children = children; boxes = (boxes_of p) }
| <external name=name href=h title=t>[] -> | <external name=name href=h title=t>[] ->
{ name = name; url = h; title = t; children = []; boxes = [] } { name = name; url = h; title = t; children = []; boxes = [] }
...@@ -143,20 +144,19 @@ let display_sitemap (h : Tree) : H:Xli = ...@@ -143,20 +144,19 @@ let display_sitemap (h : Tree) : H:Xli =
let boxes_of (Page -> [H:Xul?]) let boxes_of (Page -> [H:Xul?])
<page name=n>[ (items::Item | _)*] -> <page>[ (items::Item | _)*] & p ->
let toc = transform items with let toc = transform items with
| <box noindex="">_ -> [] | <box title=t link=l>_ -> [ <li>[ <a href=[ !(url_of_page p) '#' !l ]>t ] ]
| <box title=t link=l>_ -> [ <li>[ <a href=[ !(url_of_name n) '#' !l ]>t ] ]
in in
ul toc ul toc
let link_to (<page name=n>[<title>t ; _ ] & p : Page) : H:Xa = let link_to (<page>[<title>t ; _ ] & p : Page) : H:Xa =
let t = match p with let t = match p with
| <_ new="">_ -> t @ [ <img src="img/new.gif" alt="(new)" style="border:0">[]] | <_ new="">_ -> t @ [ <img src="img/new.gif" alt="(new)" style="border:0">[]]
| _ -> t in | _ -> t in
<a href=(url_of_name n)>t <a href=(url_of_page p)>t
let box (x : H:Flow) : H:Block = let small_box (x : H:Flow) : H:Block =
<table cellpadding="2" <table cellpadding="2"
style="font-size:11px ; font-family:arial,sans-serif; style="font-size:11px ; font-family:arial,sans-serif;
border: solid 2px black; background: #ffffff" width="100%"> border: solid 2px black; background: #ffffff" width="100%">
...@@ -176,6 +176,11 @@ let box_title (x : H:Flow, a : String, t : String) : H:Block = ...@@ -176,6 +176,11 @@ let box_title (x : H:Flow, a : String, t : String) : H:Block =
helvetica">[<a name=a>t] ] helvetica">[<a name=a>t] ]
<tr> [<td>x] ] <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 = " let style = "
a:link:hover, a:visited:hover { a:link:hover, a:visited:hover {
text-decoration: none; text-decoration: none;
...@@ -222,7 +227,8 @@ type PageO = Page | [] ...@@ -222,7 +227,8 @@ type PageO = Page | []
(* Main transformation function *) (* Main transformation function *)
(* returns the last page of the descendance *) (* returns the last page of the descendance *)
let gen_page (prev : PageO, page : Page, next : PageO, let gen_page (site : String,
prev : PageO, page : Page, next : PageO,
path : Path, sitemap : Tree) : PageO = path : Path, sitemap : Tree) : PageO =
match page with match page with
<page name=name>[ <page name=name>[
...@@ -278,7 +284,7 @@ match page with ...@@ -278,7 +284,7 @@ match page with
| <sessionsample>s -> | <sessionsample>s ->
[ <div class="session">[ <pre>(highlight s) ] ] [ <div class="session">[ <pre>(highlight s) ] ]
| <link url=url title=title>com -> | <link url=url title=title>com ->
[ <a href=url>title '. ' !(text com) ] [ <ul>[ <li>[ <a href=url>title '. ' !(text com) ] ] ]
| <ul>lis -> | <ul>lis ->
ul (map lis with <li>x -> <li>(content x)) ul (map lis with <li>x -> <li>(content x))
| H:Xtable & x -> | H:Xtable & x ->
...@@ -292,13 +298,15 @@ match page with ...@@ -292,13 +298,15 @@ match page with
| <external href=l title=t>[] -> [ <li>[ <a href=l>t ] ] in | <external href=l title=t>[] -> [ <li>[ <a href=l>t ] ] in
ul toc ul toc
| <boxes-toc (a)>[] -> | <boxes-toc (a)>[] ->
let sections = match a with { section=_ } -> `true | _ -> `false in
let short = match a with { short=_ } -> `true | _ -> `false in
let toc = transform items with let toc = transform items with
| <box noindex=_>_ -> [] | <box ({title=t; link=l} & ({short=s} | {title=s}))>b ->
| <box title=t link=l>b -> let t = if short then s else t in
let sects = match a with let sects =
| {|sections=_|} -> if sections then
(transform b with <section title=t>_ -> [<br>[] '-' !t]) (transform b with <section title=t>_ -> [<br>[] '-' !t])
| _ -> [] in else [] in
[ <li>[ <a href=('#',l)>t !sects ]] in [ <li>[ <a href=('#',l)>t !sects ]] in
ul toc ul toc
| <site-toc>[] -> | <site-toc>[] ->
...@@ -310,6 +318,7 @@ match page with ...@@ -310,6 +318,7 @@ match page with
<tr>[ <tr>[
<td valign="top">(content x) <td valign="top">(content x)
<td valign="top">(content y) ] ] ] <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) ]] | <note>c -> [ <div class="note">[ <b>"Note: " !(content c) ]]
| <footnotes>[] -> | <footnotes>[] ->
(match !footnotes with (match !footnotes with
...@@ -328,37 +337,38 @@ match page with ...@@ -328,37 +337,38 @@ match page with
width="200" width="200"
style="font-size:80%; border: 1px dashed black; style="font-size:80%; border: 1px dashed black;
background: #ffcd72"> (* altbg 9aa8ba *) background: #ffcd72"> (* altbg 9aa8ba *)
(map left with x -> <tr>[ <td>[ (box (content x)) ] ]) ] in (map left with x -> <tr>[ <td>[ (small_box (content x)) ] ]) ] in
let dpath : H:Inlines = transform path with let dpath : H:Inlines = transform path with
| { url = f; title = t } -> [ <a href=f>t ': '] | { url = f; title = t } -> [ <a href=f>t ': ']
in in
let npath = path @ [ { url = (url_of_name name); title = title } ] in let npath = path @ [ { url = (url_of_page page); title = title } ] in
let subpages = transform items with p & Page -> [ p ] in let subpages = transform items with p & Page -> [ p ] in
let (next,last) = gen_page_seq (page, subpages, next, npath, sitemap) in let (next,last) = gen_page_seq (site,page, subpages, next, npath, sitemap) in
let next = match next with [] -> [] let next = match next with [] -> []
| <page name=n>[ <title>t; _ ] -> | <page>[ <title>t; _ ] & p ->
[ <a href=(url_of_name n)>[ [ <a href=(url_of_page p)>[
<img width="16" height="16" class="icon" alt="Next page:" <img width="16" height="16" class="icon" alt="Next page:"
src="img/right.gif">[] src="img/right.gif">[]
' ' !t ' ' !t
] ] in ] ] in
let prev = match prev with [] -> [] let prev = match prev with [] -> []
| <page name=n>[ <title>t; _ ] -> | <page>[ <title>t; _ ] & p ->
[ <a href=(url_of_name n)>[ [ <a href=(url_of_page p)>[
<img width="16" height="16" class="icon" <img width="16" height="16" class="icon"
alt="Previous page:" src="img/left.gif">[] alt="Previous page:" src="img/left.gif">[]
' ' !t ' ' !t
] ] in ] ] in
let navig = let navig =
if prev = [] then [] else if prev = [] then [] else
[ (box [ [ (small_box [
<p>[ !dpath !title ] <p>[ !dpath !title ]
<p>[ !prev ' ' !next ] ]) ] in <p>[ !prev ' ' !next ] ]) ] in
(* Preparing main panel *) (* Preparing main panel *)
let main = transform items with let main = transform items with
| <box (r)>c -> [ (box_title (content c, r . link, r . title)) ] | <box title=t link=l>c -> [ (box_title (content c, l, t)) ]
| <box>c -> [ (box (content c)) ]
| <footnotes>[] -> | <footnotes>[] ->
(match !footnotes with (match !footnotes with
| [] -> [] | [] -> []
...@@ -392,7 +402,7 @@ text-align:center; color: #aa0000; font: bold 200% helvetica" > ...@@ -392,7 +402,7 @@ text-align:center; color: #aa0000; font: bold 200% helvetica" >
let html : H:Xhtml = let html : H:Xhtml =
<html>[ <html>[
<head>[ <head>[
<title>[ 'CDuce: ' !title ] <title>[ !site ': ' !title ]
<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">[] <meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">[]
<style type="text/css">style <style type="text/css">style
] ]
...@@ -413,22 +423,24 @@ text-align:center; color: #aa0000; font: bold 200% helvetica" > ...@@ -413,22 +423,24 @@ text-align:center; color: #aa0000; font: bold 200% helvetica" >
let gen_page_seq let gen_page_seq
(prev : PageO, pages : [Page*], next : PageO, (site : String,
prev : PageO, pages : [Page*], next : PageO,
path : Path, sitemap : Tree) : (PageO, PageO) = path : Path, sitemap : Tree) : (PageO, PageO) =
match pages with match pages with
| [ p1 p2 ; _ ] & [ _; rest ] -> | [ p1 p2 ; _ ] & [ _; rest ] ->
let last = gen_page (prev,p1,p2, path, sitemap) in let last = gen_page (site,prev,p1,p2, path, sitemap) in
let (_,last) = gen_page_seq (last, rest, next, path, sitemap) in let (_,last) = gen_page_seq (site,last, rest, next, path, sitemap) in
(p1,last) (p1,last)
| [ p ] -> | [ p ] ->
let last = gen_page (prev,p,next, path, sitemap) in (p,last) let last = gen_page (site,prev,p,next, path, sitemap) in (p,last)
| [] -> (next,prev) | [] -> (next,prev)
;; ;;
match load_include input with match load_include input with
| [ Page & p ] -> let _ = gen_page ([],p,[], [], compute_sitemap p) in [] | [ <site>[ <title>(site & String) (p & Page) ] ] ->
let _ = gen_page (site,[],p,[], [], compute_sitemap p) in []
| _ -> raise ("Invalid input document " @ input) | _ -> raise ("Invalid input document " @ input)
<?xml version="1.0" encoding="ISO-8859-1" standalone="yes"?> <?xml version="1.0" encoding="ISO-8859-1" standalone="yes"?>
<site>
<title>CDuce</title>
<include file="index.xml"/> <include file="index.xml"/>
</site>
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment