/[svn]/website/trunk/web/site.cd
ViewVC logotype

Diff of /website/trunk/web/site.cd

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 340 by abate, Tue Jul 10 17:26:32 2007 UTC revision 341 by abate, Tue Jul 10 17:26:43 2007 UTC
# Line 9  Line 9 
9   name ->   name ->
10     let _ = print [ 'Loading ' !name '... \n' ] in     let _ = print [ 'Loading ' !name '... \n' ] in
11     xtransform [ (load_xml name) ] with     xtransform [ (load_xml name) ] with
12       <include file=(s & String)>[] -> load_include s;;     | <include file=(s & String)>[] -> load_include s
13       | <include-verbatim file=(s & String)>[] -> load_file s;;
14    
15    
16  let fun highlight (String -> [ (Char | Xvar)* ] )  let fun highlight (String -> [ (Char | Xvar)* ] )
# Line 18  Line 19 
19   | [ c; rest ] -> [ c; highlight rest ]   | [ c; rest ] -> [ c; highlight rest ]
20   | [] -> [];;   | [] -> [];;
21    
22    let fun split_comma (String -> [String*])
23     | [ x::(Char*?) ',' ; rest ] -> (x, split_comma rest)
24     | s -> [ s ];;
25    
26    
27    (* Ugly hack to introduce PHP code ...
28       The idea is to produce first an XML document with a distinguished element.
29       The function patch_css search for the textual representation of this
30       element and replace it with the PHP code. *)
31    
32    let php_css : String =
33    [' <?php
34    $browser = getenv("HTTP_USER_AGENT");
35    if (preg_match("/MSIE/i", "$browser")) {
36            $css = "<link rel=\\"stylesheet\\" href=\\"cduce.css\\"
37    type=\\"text/css\\">";
38    } elseif (preg_match("/Mozilla/i", "$browser")) {
39            $css = "<blink>For better presentation use a more recent version
40    of your browser, like Netscape 6</blink>";
41    } if (preg_match("/Mozilla\\/5.0/i", "$browser")) {
42            $css = "<link rel=\\"stylesheet\\" href=\\"cduce.css\\"
43    type=\\"text/css\\">";
44    } elseif  (preg_match("/opera/i", "$browser")) {
45            $css = "<link rel=\\"stylesheet\\" href=\\"cduce.css\\"
46    type=\\"text/css\\">";
47    }
48    echo "$css";
49    ?> '];;
50    
51    
52    let fun patch_css (String -> String)
53    | [ a::_*? '<meta content="css"/>'; rem ] -> a @ php_css @ rem
54    | s -> s;;
55    
56    
57    
58    
 type SitePage =  
    Page  
  | <external {|href=String; title=String|}>[];;  
 type Site = <site>[ SitePage* ];;  
59    
60  type Page =  type Page =
61    <page output=String>[    <page name=String>[
62      <title>String      <title>String
63      <banner>[InlineText*]      <banner>[InlineText*]
64      <navig>[ NavigBox* ] <main>[ Box* ] ];;      Item*
65      ];;
66    
67    type External = <external {|href=String; title=String; name=String |}>[];;
68    
69    type Item =
70       <box title=String; subtitle=?String; link=String>Content
71     | <meta>Content
72     | <left>Content
73     | Page
74     | External;;
75    
76  type Author = <author>String;;  type Author = <author>String;;
77  type Paper =  type Paper =
# Line 54  Line 97 
97       | <sample>String       | <sample>String
98       | Xtable       | Xtable
99       | Paper | Slides | Link       | Paper | Slides | Link
100       | <include-verbatim file=String>[]       | <boxes-toc>[]
101       | InlineText )* ];;       | <pages-toc>[]
102         | <site-toc>[]
103         | <local-links href=String>[]
104         | InlineText
105         )* ];;
106    
107  type InlineText =  type InlineText =
108       Char       Char
109     | <(`b|`i|`tt|`em) {||}>[InlineText*]     | <(`b|`i|`tt|`em) {||}>[InlineText*]
110     | <duce>String     | <code>String
111     | Xa     | <local href=String>[]
112     | Ximg | Xbr ;;     | Xa | Ximg | Xbr ;;
113    
114  type Box = <box title=String; subtitle=?String; link=String>Content  type Path = [ { url = String; title = String }* ];;
115           | <meta>Content;;  type Tree = { name = String; url = String; title = String;
116  type NavigBox = <box>Content | <toc>[];;                children = [Tree*] } ;;
117    
118  let fun authors ([Author+] -> String)  let fun authors ([Author+] -> String)
119     | [ <author>a ] -> a     | [ <author>a ] -> a
120     | [ <author>a1 <author>a2 ] -> a1 @ ", and " @ a2     | [ <author>a1 <author>a2 ] -> a1 @ ", and " @ a2
121     | [ <author>a; rem ] -> a @ ", " @ authors rem;;     | [ <author>a; rem ] -> a @ ", " @ authors rem;;
122    
123    let fun find_local_link (sitemap : [Tree*], l : String) : Inline =
124    match sitemap with
125     | (h,t) ->
126       if (h . name = l) then <a href=(h . url)>(h . title)
127       else
128        (try find_local_link (t,l) with `Not_found ->
129             find_local_link (h . children,l))
130     | [] -> raise `Not_found;;
131    
132    let fun local_link (sitemap : Tree, l : String) : Inline =
133     try find_local_link ([sitemap],l)
134     with `Not_found -> raise [ 'Local link not found: ' !l ];;
135    
136    
137    let fun compute_sitemap ((Page|External) -> Tree)
138     <page name=name>[ <title>title (c::(Page|External) | _)* ] ->
139       let children = map c with p -> compute_sitemap p in
140       { name = name; url = name; title = title; children =children }
141    |<external name=name; href=h; title=t>[] ->
142       { name = name; url = h; title = t; children = [] };;
143    
144    let fun display_sitemap (h : Tree) :  Xli =
145      let ch = map h . children with x -> display_sitemap x in
146      let ch = match ch with [] -> [] | l -> [ <ul>l ] in
147      <li>[ <a href=(h . url)>(h . title); ch ];;
148    
149    let fun gen_page (page : Page, path : Path, sitemap : Tree) : [] =
150    match page with
151    <page name=name>[ <title>title <banner>banner ; items ] ->
152    
153  let fun text (t : [InlineText*]) : Inlines =  let fun text (t : [InlineText*]) : Inlines =
154    map t with    map t with
155     | <duce>x -> <b>[ <tt>(highlight x) ]     | <code>x -> <b>[ <tt>(highlight x) ]
156       | <local href=l>[] -> local_link (sitemap,l)
157     | <(tag & (`b|`i|`tt|`em))>x -> <(tag)>(text x)     | <(tag & (`b|`i|`tt|`em))>x -> <(tag)>(text x)
158     | z -> z;;     | z -> z
159     in
160    
161  let fun content (t : Content) : Flow =  let fun content (t : Content) : Flow =
162    transform t with    transform t with
# Line 91  Line 170 
170           ]           ]
171     | <slides file=f>[ <title>tit aut::Author* <comment>com ]  ->     | <slides file=f>[ <title>tit aut::Author* <comment>com ]  ->
172          [ <a href=f>tit '. ' !(authors aut) '. ' !(text com) ]          [ <a href=f>tit '. ' !(authors aut) '. ' !(text com) ]
    | <include-verbatim file=f>[] ->  
         [ <div class="code">[ <pre>(load_file f) ] ]  
173     | <sample>s ->     | <sample>s ->
174          [ <div class="code">[ <pre>(highlight s) ] ]          [ <div class="code">[ <pre>(highlight s) ] ]
175     | <link url=url; title=title>com ->     | <link url=url; title=title>com ->
# Line 102  Line 179 
179     | Xtable & x ->     | Xtable & x ->
180          [ x ]          [ x ]
181     | <p>x -> [ <p>(text x) ]     | <p>x -> [ <p>(text x) ]
182     | x -> text [ x ];;     | <pages-toc>[] ->
183            let toc =
184             transform items with
185               <page name=l>[<title>t;_]
186             | <external href=l; title=t>[] -> [ <li>[ <a href=l>t ] ] in
187            (match toc with [] -> [] | lis -> [ <ul>lis ])
188       | <boxes-toc>[] ->
189            let toc =
190             transform items with
191              <box title=t; link=l>_ -> [ <li>[ <a href=('#',l)>t ] ] in
192            (match toc with [] -> [] | lis -> [ <ul>lis ])
193       | <site-toc>[] ->
194            [ <ul>[ (display_sitemap sitemap) ] ]
195       | <local-links href=s>[] ->
196             (match (split_comma s) with
197               | [] -> []
198               | l -> let l = map l with x -> <li>[ (local_link(sitemap,x)) ]
199                      in [ <ul>l ])
200       | t -> text [ t ]
201     in
202    
203  let fun main2html (Box -> Flow)   let main : Flow = transform items with
204    <box (r)>c ->    | <box (r)>c ->
205     [ <div class="box">[     [ <div class="box">[
206         <h2>(r . title)         <h2>(r . title)
207          !(match r with { subtitle = t } -> [<b>t] | _ -> [])          !(match r with { subtitle = t } -> [<b>t] | _ -> [])
208         <a name=r . link>[]         <a name=r . link>[]
209         !(content c)  ] ]         !(content c)  ] ]
210  | <meta>c -> [ <div class="meta">(content c) ];;    | <meta>c -> [ <div class="meta">(content c) ]
211     in
212     let navig : Flow = transform items with
213  (* Ugly hack to introduce PHP code ...    | <left>c -> [<div class="box">(content c)]
214     The idea is to produce first an XML document with a distinguished element.   in
215     The function patch_css search for the textual representation of this   let dpath : Inlines = transform path with
216     element and replace it with the PHP code. *)    | { url = f; title = t } -> [ <a href=f>t ' :: ']
   
 let php_css : String =  
 [' <?php  
 $browser = getenv("HTTP_USER_AGENT");  
 if (preg_match("/MSIE/i", "$browser")) {  
         $css = "<link rel=\\"stylesheet\\" href=\\"cduce.css\\"  
 type=\\"text/css\\">";  
 } elseif (preg_match("/Mozilla/i", "$browser")) {  
         $css = "<blink>For better presentation use a more recent version  
 of your browser, like Netscape 6</blink>";  
 } if (preg_match("/Mozilla\\/5.0/i", "$browser")) {  
         $css = "<link rel=\\"stylesheet\\" href=\\"cduce.css\\"  
 type=\\"text/css\\">";  
 } elseif  (preg_match("/opera/i", "$browser")) {  
         $css = "<link rel=\\"stylesheet\\" href=\\"cduce.css\\"  
 type=\\"text/css\\">";  
 }  
 echo "$css";  
 ?> '];;  
   
   
 let fun patch_css (String -> String)  
 | [ a::_*? '<meta content="css"/>'; rem ] -> a @ php_css @ rem  
 | s -> s;;  
   
 let fun page2html (Page -> Xhtml)  
 <page>[ <title>title <banner>banner <navig>navig <main>main ] ->  
  let toc =  
    transform main with <box title=t; link=l>_ -> [ <li>[ <a href=('#',l)>t ] ] in  
  let toc = match toc with [] -> [] | lis -> [ <ul>lis ] in  
  let navig : Flow = transform navig with  
   | <box>c -> [ <div class="box">(content c) ]  
   | <toc>[] -> [ <div class="box">toc ]  
217   in   in
218     let html : Xhtml =
219   <html>[   <html>[
220    <head>[    <head>[
221     <title>title     <title>title
# Line 159  Line 223 
223     <meta content="css">[]  (* Placeholder for PHP code *)     <meta content="css">[]  (* Placeholder for PHP code *)
224    ]    ]
225    <body>[    <body>[
226     <div class="title">[ <h1>(text banner) ]     <div class="title">[ <h1>(text banner) <p>[ !dpath !title ] ]
227     <div id="Sidelog">navig     <div id="Sidelog">navig
228     <div id="Content">(transform main with b -> main2html b)     <div id="Content">main
229    ]    ]
  ];;  
   
 type P = (String,<title>String);;  
   
 let fun make_plan (l : [ P+ ]) : Page =  
 <page output="plan.php">[  
   <title>"CDuce site"  
   <banner>"CDuce site"  
   <navig>[ <box>[ <a href="/">"Home" ] ]  
   <main>[  
     <box title="Pages"; link="pages">[  
       <ul>(map l with (file,<title>t) -> <li>[<a href=file>t])  
230      ]      ]
231      <meta>[ 'This page was automatically generated by a CDuce program.' ]   in
232    ]   let txt : String =
 ];;  
   
 let fun do_page(Page -> P)  
  <page output=outf>[ tit & <title>_; _ ] & page ->  
     let _ = print [ 'Generating html... ' ] in  
     let html : String =  
233         [ (* '<?xml version="1.0" encoding="iso-8859-1"?>' *)         [ (* '<?xml version="1.0" encoding="iso-8859-1"?>' *)
234           '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'           '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'
235           '  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'           '  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'
236           !(patch_css (print_xml (page2html page))) ] in       !(patch_css (print_xml html)) ] in
237      let _ = print [ 'Saving to ' !outf '...\n' ] in   let _ = print [ 'Generating page ' !name '...\n' ] in
238      let _ = dump_to_file outf html in   let filename = name @ ".php" in
239      (outf, tit);;   let _ = dump_to_file filename txt in
240     let path = path @ [ { url = name; title = title } ] in
241     transform items with p & Page -> gen_page (p,path,sitemap);;
242    
243    
244    
 let site =  
245   match load_include "site.xml" with   match load_include "site.xml" with
246   | [ Site & <site>s ] ->   | [ Page & p ] ->
247       let ts = map s with       let sitemap = compute_sitemap p in
248               | Page & p -> do_page p       gen_page (p,[],sitemap)
              | <external href=url; title=t>_ -> (url,<title>t) in  
      let _ = print [ 'Create plan... ' ] in  
      let plan = make_plan (ts @ [("plan.php", <title>"CDuce site")]) in  
      let _ = do_page plan in  
      []  
249   | _ -> raise "Invalid site.xml";;   | _ -> raise "Invalid site.xml";;
250    
Legend:
Removed from v.340  
changed lines
  Added in v.341
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5