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

Diff of /web/site.cd

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

revision 561 by abate, Tue Jul 10 17:44:49 2007 UTC revision 580 by abate, Tue Jul 10 17:46:08 2007 UTC
# Line 2  Line 2 
2    
3  (** Command line **)  (** Command line **)
4    
5  let (input, php) =  let input =
6    match argv with    match argv with
7    | [ "-php" s ] -> (s, `true)    | [ s ] -> s
   | [ s ] -> (s, `false)  
8    | _ -> raise "Please specify an input file on the command line"    | _ -> raise "Please specify an input file on the command line"
9    
10    
# Line 21  Line 20 
20  type External = <external {|href=String; title=String; name=String |}>[]  type External = <external {|href=String; title=String; name=String |}>[]
21    
22  type Item =  type Item =
23     <box title=String subtitle=?String link=String>Content     <box title=String link=String>Content
24   | <meta>Content   | <meta>Content
25   | <left>Content   | <left>Content
26   | Page   | Page
# Line 89  Line 88 
88   | s -> [ s ]   | s -> [ s ]
89    
90    
 (** 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 css : Latin1 =  
   ['<link rel="stylesheet" href="cduce.css" type="text/css">']  
   
 let protect_quote (s : Latin1) : Latin1 =  
   transform s with '"' -> [ '\\"' ] | c -> [c]  
   
 let php_css : Latin1 =  
 if php then  
 [' <?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";  
 ?> ']  
 else css  
   
 (** It does not work with IE  
 if php then  
 [' <?php $browser = getenv("HTTP_USER_AGENT");  
 if (preg_match("/Mozilla/i", "$browser") && !preg_match("/Mozilla\\/5.0/i", "$browser"))  
 {  
   echo "<blink>For better presentation use a more recent version of  
 your browser, like Netscape 6</blink>";  
 }  
 else { echo "' !(protect_quote css) '"; }  
 ?> ']  
 else css  
 **)  
   
 let patch_css (Latin1 -> Latin1)  
 | [ a::_*? '<meta content="css"/>'; rem ] -> a @ php_css @ rem  
 | s -> s  
   
   
   
91  (** Internal types **)  (** Internal types **)
92    
93  type Path = [ { url = String; title = String }* ]  type Path = [ { url = String; title = String }* ]
# Line 186  Line 134 
134  let link_to (Page -> Xa)  let link_to (Page -> Xa)
135   <page name=n>[<title>t ; _ ] -> <a href=(url_of_name n)>t   <page name=n>[<title>t ; _ ] -> <a href=(url_of_name n)>t
136    
137    let box (x : Flow) : Block =
138     <table cellpadding="2"
139        style="border: solid 2px black; background: #ffffff" width="100%">
140       [ <tr> [<td>x] ]
141    
142    let meta (x : Flow) : Block =
143     <table cellpadding="2"
144        style="border: solid 1px #b0b0b0; background: #e0e0e0; font-size: 80%"
145        width="100%">
146       [ <tr> [<td>x] ]
147    
148    let box_title (x : Flow, t : String) : Block =
149     <table cellpadding="5"
150        style="border: solid 2px black; background: #ffffff" width="100%">
151       [ <tr>[ <td style="background: #fff0f0; color: #0000ff; font: bold
152    100% helvetica">t ] <tr> [<td>x] ]
153    
154    let style = "
155    a:link:hover, a:visited:hover {
156      text-decoration: none;
157      background: #FFFFD0;
158      color: #FF0000;
159    }
160    p {
161      text-align: justify;
162      margin: 1ex 1em 0 1em;
163    }
164    pre {
165      margin: 1ex 1em 0 1em;
166    }
167    var.highlight {
168      color: #FF0000;
169    }
170    img.icon {
171      border: 0;
172    }
173    div.code {
174      background: #E0E0E0;
175      margin: 0.5ex 0.5em 0 0.5em;
176      padding: 0.2ex;
177    }
178    div.abstract {
179      font: bold 80% helvetica;
180      margin: 1ex 1em 1ex 1em;
181      padding: 1ex 1em 1ex 1em;
182      background: #F0F0F0;
183    }
184    div.abstract p {
185      font: 100% sans-serif;
186    }
187    "
188    
189  (* Main transformation function *)  (* Main transformation function *)
190    
191    
192  (* returns the last page of the descendance *)  (* returns the last page of the descendance *)
193  let gen_page (prev : Page|[], page : Page, next : Page|[],  let gen_page (prev : Page|[], page : Page, next : Page|[],
194                    path : Path, sitemap : Tree) : (Page|[]) =                    path : Path, sitemap : Tree) : (Page|[]) =
# Line 207  Line 208 
208   let content (t : Content) : Flow =   let content (t : Content) : Flow =
209    transform t with    transform t with
210     | <section title=title>c ->     | <section title=title>c ->
211           [ <h4>title !(content c) ]           [ <p>[ <b style="color: #008000">title ] !(content c) ]
212     | <paper (r)>[ <title>tit aut::Author* <comment>com <abstract>ab  ]  ->     | <paper (r)>[ <title>tit aut::Author* <comment>com <abstract>ab  ]  ->
213           [ (match r with { file = f } -> <a href=f>tit | _ -> <b>tit) '. '           [ (match r with { file = f } -> <a href=f>tit | _ -> <b>tit) '. '
214             !(authors aut) '. '             !(authors aut) '. '
# Line 253  Line 254 
254     | t -> text [ t ]     | t -> text [ t ]
255   in   in
256    
257   let main : Flow = transform items with  
258    | <box (r)>c ->  (* Preparing left panel *)
259       [ <div class="box">[   let navig = transform items with <left>c -> [ c ] in
260           <h2>(r . title)   let left = match navig with [] -> [ [<boxes-toc>[]] ] | n -> n in
261            !(match r with { subtitle = t } -> [<b>t] | _ -> [])   let left =
262           <a name=(r . link)>[]     <td valign="top" align="left">[
263           !(content c)  ] ]       <table cellpadding="5" cellspacing="2"
264    | <meta>c -> [ <div class="meta">(content c) ]              width="200" style="font-size:80%; border: 1px dashed black; background: #ffcd72">
265   in       (map left with x -> <tr>[ <td>[ (box (content x)) ] ]) ] in
266   let navig : Flow = transform items with  
   | <left>c -> [<div class="box">(content c)]  
  in  
  let left = match navig with  
   | [] -> [<div class="box">(content [<boxes-toc>[]])]  
   | n -> n in  
267   let dpath : Inlines = transform path with   let dpath : Inlines = transform path with
268    | { url = f; title = t } -> [ <a href=f>t ': ']    | { url = f; title = t } -> [ <a href=f>t ': ']
269   in   in
# Line 286  Line 282 
282            <img width="16" height="16" class="icon" alt="Previous page" src="img/left.gif">[]            <img width="16" height="16" class="icon" alt="Previous page" src="img/left.gif">[]
283            ' ' !t            ' ' !t
284          ] ] in          ] ] in
285   let navig : [ Xdiv* ] =   let navig =
286     if prev = [] then [] else     if prev = [] then [] else
287     [ <div class="box">[     [ (box [
288       <p>[ !dpath !title ]       <p>[ !dpath !title ]
289       <p>[ !prev ' ' !next ] ] ] in       <p>[ !prev ' ' !next ] ]) ] in
290    
291    (* Preparing main panel *)
292     let main = transform items with
293      | <box (r)>c ->
294          let b = [
295             <a name=(r . link)>[]
296             !(content c) ] in
297          [ (box_title (b,r . title)) ]
298     | <meta>c -> [ (meta (content c)) ]
299     in
300     let main = match (navig @ main @ navig) with
301       | [] -> raise "Empty page !"
302       | x -> x in
303    
304     let right : Xtd =
305      <td valign="top" align="left" style="width:100%">[
306       <table width="100%">[
307        <tr>[ <td valign="top" align="left"
308                  style="border: 2px solid black; background: #ffffff;
309    text-align:center; color: #aa0000; font: bold 200% helvetica" >
310              (text banner)
311            ]
312    
313        <tr>[
314          <td valign="top" align="left"
315              style="border: 1px solid black; background: #fccead">[
316           <table width="100%" cellpadding="15">
317             (map main with x -> <tr>[ <td>[x] ])
318          ] ]
319      ] ] in
320    
321   let html : Xhtml =   let html : Xhtml =
322   <html>[   <html>[
323    <head>[    <head>[
324     <title>[ 'CDuce: ' !title ]     <title>[ 'CDuce: ' !title ]
325     <meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">[]     <meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">[]
326     <meta content="css">[]  (* Placeholder for PHP code *)     <style type="text/css">style
327      ]
328      <body style="margin: 0; padding : 0; background: #fcb333">[
329       <table cellspacing="10" cellpadding="0" width="100%" border="0">[
330        <tr>[ left right ]
331    ]    ]
   <body>[  
    <div class="title">[ <h1>(text banner) ]  
    <div id="Sidelog">left  
    <div id="Content">( navig @ main @ navig )  
332    ]    ]
333   ]   ]
334   in   in
335   let txt : Latin1 =   let txt : Latin1 =
336     [ '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'     [ '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'
337       '  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'       '  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'
338       !(patch_css (print_xml html)) ] in       !(print_xml html) ] in
339   let fn = "www/" @ name @ (if php then ".html.php" else ".html") in   let fn = "www/" @ name @ ".html" in
340   let [] = dump_to_file fn txt in   let [] = dump_to_file fn txt in
341   last   last
342    
Legend:
Removed from v.561  
changed lines
  Added in v.580
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5