viewcvs.cgi/web/macros.cd

type XML_elem = <(_)>XML;;
type XML = [ (XML_elem | Char)* ];;

let fun banner (title : Any, subtitle : Any) : XML =
[<table border="0"; cellspacing="0"; cellpadding="2";
       width="100%"; bgcolor="#000000">[
  <tr>[
    <td>[
      <table border="0"; cellspacing="0"; cellpadding="2";
             width="100%"; bgcolor="#FFFFFF">[
        <tr>[
          <td>[
            !(match title with 
              | t & XML \ [] -> [<b>[<font color="red"; size="+3">
                                        [<center>t]]]
              | _ -> []
            )     
            !(match subtitle with 
              | t & XML \ [] -> [<b>[<font size="-2">t]]
              | _ -> []
            )         
          ]
        ]
      ]
    ]
  ]
]];;


let fun box (title : Any, subtitle : Any, content : XML) : XML =
[<table border="0"; cellspacing="0"; cellpadding="2";
       width="100%"; bgcolor="#000000">[
  <tr>[
    <td>[
      <table border="0"; cellspacing="0"; cellpadding="2";
             width="100%"; bgcolor="#FFFFFF">[
        <tr>[
          <td>[
            !(match title with 
              | t & XML \ [] -> [<b>[<font color="blue"; size="+2">t]<br>[]]
              | _ -> []
            )     
            !(match subtitle with 
              | t & XML \ [] -> [<b>[<font size="-2">t]]
              | _ -> []
            )         
            !(match content with 
              | [] -> []
              | t & XML \ [] -> [ <p>content ]
            )         
          ]
        ]
      ]
    ]
  ]
]];;

let fun convert (XML_elem | Char | XML -> XML)
 | <box ({ title=t } & ({ subtitle=st } | (st := `nil)))>x -> 
      box (t,st,convert x) 
 | <banner ({ title=t } & ({ subtitle=st } | (st := `nil)))>x -> 
      banner (t,st) 
 | <(tag) (attr)>x -> [<(tag) (attr)>(convert x)]
 | c & Char -> [c]
 | seq -> transform seq with x -> convert x;;


let src =
  match [ (load_xml "index.xml") ] with
  | XML & x -> x
  | _ -> raise ("Invalid input ...");;

let conv : XML = convert src;;

let out : String = 
  [ '<!doctype html public "-//w3c//dtd html 4.0 transitional//en">' ]
  @
  (transform convert src with x -> print_xml x);;

dump_to_file "index.html" out;;

1	type XML_elem = <(_)>XML;;
2	type XML = [ (XML_elem \| Char)* ];;
3
4	let fun banner (title : Any, subtitle : Any) : XML =
5	[<table border="0"; cellspacing="0"; cellpadding="2";
6	width="100%"; bgcolor="#000000">[
7	<tr>[
8	<td>[
9	<table border="0"; cellspacing="0"; cellpadding="2";
10	width="100%"; bgcolor="#FFFFFF">[
11	<tr>[
12	<td>[
13	!(match title with
14	\| t & XML \ [] -> [<b>[<font color="red"; size="+3">
15	[<center>t]]]
16	\| _ -> []
17	)
18	!(match subtitle with
19	\| t & XML \ [] -> [<b>[<font size="-2">t]]
20	\| _ -> []
21	)
22	]
23	]
24	]
25	]
26	]
27	]];;
28
29
30	let fun box (title : Any, subtitle : Any, content : XML) : XML =
31	[<table border="0"; cellspacing="0"; cellpadding="2";
32	width="100%"; bgcolor="#000000">[
33	<tr>[
34	<td>[
35	<table border="0"; cellspacing="0"; cellpadding="2";
36	width="100%"; bgcolor="#FFFFFF">[
37	<tr>[
38	<td>[
39	!(match title with
40	\| t & XML \ [] -> [<b>[<font color="blue"; size="+2">t]<br>[]]
41	\| _ -> []
42	)
43	!(match subtitle with
44	\| t & XML \ [] -> [<b>[<font size="-2">t]]
45	\| _ -> []
46	)
47	!(match content with
48	\| [] -> []
49	\| t & XML \ [] -> [ <p>content ]
50	)
51	]
52	]
53	]
54	]
55	]
56	]];;
57
58	let fun convert (XML_elem \| Char \| XML -> XML)
59	\| <box ({ title=t } & ({ subtitle=st } \| (st := `nil)))>x ->
60	box (t,st,convert x)
61	\| <banner ({ title=t } & ({ subtitle=st } \| (st := `nil)))>x ->
62	banner (t,st)
63	\| <(tag) (attr)>x -> [<(tag) (attr)>(convert x)]
64	\| c & Char -> [c]
65	\| seq -> transform seq with x -> convert x;;
66
67
68	let src =
69	match [ (load_xml "index.xml") ] with
70	\| XML & x -> x
71	\| _ -> raise ("Invalid input ...");;
72
73	let conv : XML = convert src;;
74
75	let out : String =
76	[ '<!doctype html public "-//w3c//dtd html 4.0 transitional//en">' ]
77	@
78	(transform convert src with x -> print_xml x);;
79
80	dump_to_file "index.html" out;;
81