/[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 624 by abate, Tue Jul 10 17:48:21 2007 UTC revision 625 by abate, Tue Jul 10 17:48:59 2007 UTC
# Line 57  Line 57 
57     | <(`b|`i|`tt|`em) {| style=?String |}>[InlineText*]     | <(`b|`i|`tt|`em) {| style=?String |}>[InlineText*]
58     | <code>String     | <code>String
59     | <local href=String>String     | <local href=String>String
60     | <footnote>Content     | <footnote>[InlineText*]
61     | Xa | Ximg | Xbr     | Xa | Ximg | Xbr
62    
63    
# Line 123  Line 123 
123  let compute_sitemap ((Page|External) -> Tree)  let compute_sitemap ((Page|External) -> Tree)
124   <page name=name>[ <title>title (c::(Page|External) | _)* ] ->   <page name=name>[ <title>title (c::(Page|External) | _)* ] ->
125     let children = map c with p -> compute_sitemap p in     let children = map c with p -> compute_sitemap p in
126     { name = name; url = url_of_name name; title = title; children =children }     { name = name; url = (url_of_name name); title = title; children =children }
127  |<external name=name href=h title=t>[] ->  |<external name=name href=h title=t>[] ->
128     { name = name; url = h; title = t; children = [] }     { name = name; url = h; title = t; children = [] }
129    
# Line 193  Line 193 
193    
194  (* Main transformation function *)  (* Main transformation function *)
195    
   
196  (* returns the last page of the descendance *)  (* returns the last page of the descendance *)
197  let gen_page (prev : Page|[], page : Page, next : Page|[],  let gen_page (prev : Page|[], page : Page, next : Page|[],
198                    path : Path, sitemap : Tree) : (Page|[]) =                    path : Path, sitemap : Tree) : (Page|[]) =
# Line 201  Line 200 
200  <page name=name>[  <page name=name>[
201          <title>title <banner>banner | <title>(title & banner); items ] ->          <title>title <banner>banner | <title>(title & banner); items ] ->
202    
203     let footnote_counter = ref Int 0 in
204     let footnotes = ref Flow [] in
205    
206   let text (t : [InlineText*]) : Inlines =   let text (t : [InlineText*]) : Inlines =
207    map t with    transform t with
208     | <code>x -> <b>[ <tt>(highlight x) ]     | <code>x -> [ <b>[ <tt>(highlight x) ] ]
209     | <local href=l>txt -> local_link (sitemap,l,txt)     | <local href=l>txt -> [ (local_link (sitemap,l,txt)) ]
210     | <(tag & (`b|`i|`tt|`em)) (attr)>x -> <(tag) (attr)>(text x)     | <(tag & (`b|`i|`tt|`em)) (attr)>x -> [ <(tag) (attr)>(text x) ]
211  (*   | <a href=url>_ & z -> let [] = print [ 'Link: ' !url '\n'] in z *)  (*   | <a href=url>_ & z -> let [] = print [ 'Link: ' !url '\n'] in [z] *)
212     | <footnote>_ -> raise "Footnotes not yet implemented !"     | <footnote>c ->
213     | z -> z        footnote_counter := !footnote_counter + 1;
214          let n = string_of !footnote_counter in
215          let fn = !footnotes in
216          footnotes := [];
217          let c = <p>[ <a name=[ 'note' !n ]>[]
218                       <a href=[ '#bnote' !n ]>[ '[' !n ']' ]
219                       ' ' ; text c ] in
220          footnotes := fn @ [ c ] @ !footnotes;
221          [ <a name=[ 'bnote' !n ]>[]
222            <a href=[ '#note' !n ]>[ '[' !n ']' ] ]
223       | z -> [ z ]
224   in   in
225    
226   let content (t : Content) : Flow =   let content (t : Content) : Flow =
# Line 260  Line 272 
272     | t -> text [ t ]     | t -> text [ t ]
273   in   in
274    
   
275  (* Preparing left panel *)  (* Preparing left panel *)
276   let navig = transform items with <left>c -> [ c ] in   let navig = transform items with <left>c -> [ c ] in
277   let left = match navig with [] -> [ [<boxes-toc>[]] ] | n -> n in   let left = match navig with [] -> [ [<boxes-toc>[]] ] | n -> n in
# Line 275  Line 286 
286   let dpath : Inlines = transform path with   let dpath : Inlines = transform path with
287    | { url = f; title = t } -> [ <a href=f>t ': ']    | { url = f; title = t } -> [ <a href=f>t ': ']
288   in   in
289   let npath = path @ [ { url = url_of_name name; title = title } ] in   let npath = path @ [ { url = (url_of_name name); title = title } ] in
290   let subpages = transform items with p & Page -> [ p ] in   let subpages = transform items with p & Page -> [ p ] in
291   let (next,last) = gen_page_seq (page, subpages, next, npath, sitemap) in   let (next,last) = gen_page_seq (page, subpages, next, npath, sitemap) in
292   let next = match next with [] -> []   let next = match next with [] -> []
# Line 307  Line 318 
318        [ (box_title (b,r . title)) ]        [ (box_title (b,r . title)) ]
319   | <meta>c -> [ (meta (content c)) ]   | <meta>c -> [ (meta (content c)) ]
320   in   in
321   let main = match (navig @ main @ navig) with   let notes = match !footnotes with
322       | [] -> []
323       | n -> [ (meta n) ] in
324     let main = match (navig @ main @ notes @ navig) with
325     | [] -> raise "Empty page !"     | [] -> raise "Empty page !"
326     | x -> x in     | x -> x in
327    
# Line 347  Line 361 
361       '  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'       '  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'
362       !(print_xml html) ] in       !(print_xml html) ] in
363   let fn = "www/" @ name @ ".html" in   let fn = "www/" @ name @ ".html" in
364   let [] = dump_to_file fn txt in   dump_to_file fn txt;
365   last   last
366    
367    
# Line 370  Line 384 
384   | [ Page & p ] -> let _ = gen_page ([],p,[], [], compute_sitemap p) in []   | [ Page & p ] -> let _ = gen_page ([],p,[], [], compute_sitemap p) in []
385   | _ -> raise ("Invalid input document " @ input)   | _ -> raise ("Invalid input document " @ input)
386    
387    
Legend:
Removed from v.624  
changed lines
  Added in v.625
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5