Commit ddd227f1 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-05-14 17:03:17 by cvscast] Some comments on site.cd

Original author: cvscast
Date: 2003-05-14 17:03:17+00:00
parent fdbaa52a
(* This CDuce script produces CDuce web site. *)
(** Output types **)
include "xhtml-strict.cd";; (* XHTML 1 Strict DTD *)
include "xhtml-categ.cd";; (* Categories (Inline, ...) from this DTD *)
(** Input types **)
type Page = <page name=String>[ <title>String <banner>[InlineText*] Item* ];;
type External = <external {|href=String; title=String; name=String |}>[];;
type Item =
<box title=String; subtitle=?String; link=String>Content
| <meta>Content
| <left>Content
| Page
| External;;
type Author = <author>String;;
type Paper =
<paper file=?String>[
<title>String Author+ <comment>[InlineText*] <abstract>Content ];;
type Slides =
<slides file=String>[ <title>String Author+ <comment>[InlineText*] ];;
type Link =
<link url=String; title=String>[ InlineText* ];;
type Content =
[ ( <p {||}>[InlineText*]
| <ul {||}>[<li {||}>Content +]
| <section title=String>Content
| <sample>String
| Xtable
| Paper | Slides | Link
| <boxes-toc>[]
| <pages-toc>[]
| <site-toc>[]
| <local-links href=String>[]
| InlineText
)* ];;
type InlineText =
Char
| <(`b|`i|`tt|`em) {||}>[InlineText*]
| <code>String
| <local href=String>[]
| Xa | Ximg | Xbr ;;
(** Generic purpose functions **)
(* Recursive inclusion of XML files and verbatim text files *)
let fun load_include (String -> [Any*])
name ->
let _ = print [ 'Loading ' !name '... \n' ] in
......@@ -12,6 +62,7 @@ let fun load_include (String -> [Any*])
| <include file=(s & String)>[] -> load_include s
| <include-verbatim file=(s & String)>[] -> load_file s;;
(* Highlighting text between {{...}} *)
let fun highlight (String -> [ (Char | Xvar)* ] )
| [ '{{' h ::(Char *?) '}}' ; rest ] ->
......@@ -19,15 +70,17 @@ let fun highlight (String -> [ (Char | Xvar)* ] )
| [ c; rest ] -> [ c; highlight rest ]
| [] -> [];;
(* Split a comma-separated string *)
let fun split_comma (String -> [String*])
| [ x::(Char*?) ',' ; rest ] -> (x, split_comma rest)
| s -> [ s ];;
(* Ugly hack to introduce PHP code ...
The idea is to produce first an XML document with a distinguished element.
The function patch_css search for the textual representation of this
element and replace it with the PHP code. *)
(** Ugly hack to introduce PHP code ...
The idea is to produce first an XML document with a distinguished element.
The function patch_css search for the textual representation of this
element and replace it with the PHP code. **)
let php_css : String =
[' <?php
......@@ -55,61 +108,7 @@ let fun patch_css (String -> String)
type Page =
<page name=String>[
<title>String
<banner>[InlineText*]
Item*
];;
type External = <external {|href=String; title=String; name=String |}>[];;
type Item =
<box title=String; subtitle=?String; link=String>Content
| <meta>Content
| <left>Content
| Page
| External;;
type Author = <author>String;;
type Paper =
<paper file=?String>[
<title>String
Author+
<comment>[InlineText*]
<abstract>Content ];;
type Slides =
<slides file=String>[
<title>String
Author+
<comment>[InlineText*] ];;
type Link =
<link url=String; title=String>[ InlineText* ];;
type Content =
[ ( <p {||}>[InlineText*]
| <ul {||}>[<li {||}>Content +]
| <section title=String>Content
| <sample>String
| Xtable
| Paper | Slides | Link
| <boxes-toc>[]
| <pages-toc>[]
| <site-toc>[]
| <local-links href=String>[]
| InlineText
)* ];;
type InlineText =
Char
| <(`b|`i|`tt|`em) {||}>[InlineText*]
| <code>String
| <local href=String>[]
| Xa | Ximg | Xbr ;;
(** Internal types **)
type Path = [ { url = String; title = String }* ];;
type Tree = { name = String; url = String; title = String;
......@@ -133,7 +132,6 @@ let fun local_link (sitemap : Tree, l : String) : Inline =
try find_local_link ([sitemap],l)
with `Not_found -> raise [ 'Local link not found: ' !l ];;
let fun compute_sitemap ((Page|External) -> Tree)
<page name=name>[ <title>title (c::(Page|External) | _)* ] ->
let children = map c with p -> compute_sitemap p in
......@@ -146,6 +144,8 @@ let fun display_sitemap (h : Tree) : Xli =
let ch = match ch with [] -> [] | l -> [ <ul>l ] in
<li>[ <a href=(h . url)>(h . title); ch ];;
(* Main transformation function *)
let fun gen_page (page : Page, path : Path, sitemap : Tree) : [] =
match page with
<page name=name>[ <title>title <banner>banner ; items ] ->
......@@ -234,17 +234,14 @@ match page with
'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'
' "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'
!(patch_css (print_xml html)) ] in
let _ = print [ 'Generating page ' !name '...\n' ] in
let filename = name @ ".php" in
let _ = dump_to_file filename txt in
let [] = dump_to_file (name @ ".php") txt in
let path = path @ [ { url = name; title = title } ] in
transform items with p & Page -> gen_page (p,path,sitemap);;
(* Entry point *)
match load_include "site.xml" with
| [ Page & p ] ->
let sitemap = compute_sitemap p in
gen_page (p,[],sitemap)
| [ Page & p ] -> gen_page (p,[], compute_sitemap p)
| _ -> raise "Invalid site.xml";;
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