Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
07cc11b5
Commit
07cc11b5
authored
Oct 05, 2007
by
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
5bea0198
Changes
1
Hide whitespace changes
Inline
Side-by-side
web/site.cd
View file @
07cc11b5
(* 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";;
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment