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

Contents of /web/site.cd

Parent Directory Parent Directory | Revision Log Revision Log


Revision 581 - (hide annotations)
Tue Jul 10 17:46:11 2007 UTC (5 years, 10 months ago) by abate
File size: 10690 byte(s)
[r2003-07-05 13:40:37 by cvscast] Beppe: small changes in the fonts.

Original author: cvscast
Date: 2003-07-05 13:40:37+00:00
1 abate 284 (* This CDuce script produces CDuce web site. *)
2    
3 abate 369 (** Command line **)
4    
5 abate 580 let input =
6 abate 369 match argv with
7 abate 580 | [ s ] -> s
8 abate 431 | _ -> raise "Please specify an input file on the command line"
9 abate 369
10    
11 abate 343 (** Output types **)
12 abate 284
13 abate 488 include "xhtml-strict.cd" (* XHTML 1 Strict DTD *)
14     include "xhtml-categ.cd" (* Categories (Inline, ...) from this DTD *)
15 abate 250
16 abate 336
17 abate 343 (** Input types **)
18    
19 abate 488 type Page = <page name=String>[ <title>String <banner>[InlineText*]? Item* ]
20     type External = <external {|href=String; title=String; name=String |}>[]
21 abate 343
22     type Item =
23 abate 580 <box title=String link=String>Content
24 abate 343 | <meta>Content
25     | <left>Content
26     | Page
27 abate 488 | External
28 abate 343
29 abate 488 type Author = <author>String
30 abate 343 type Paper =
31     <paper file=?String>[
32 abate 488 <title>String Author+ <comment>[InlineText*] <abstract>Content ]
33 abate 343
34     type Slides =
35 abate 488 <slides file=String>[ <title>String Author+ <comment>[InlineText*] ]
36 abate 343
37     type Link =
38 abate 561 <link url=String title=String>[ InlineText* ]
39 abate 343
40     type Content =
41     [ ( <p {||}>[InlineText*]
42     | <ul {||}>[<li {||}>Content +]
43     | <section title=String>Content
44 abate 344 | <sample highlight=?"true"|"false">String
45 abate 343 | Xtable
46     | Paper | Slides | Link
47     | <boxes-toc>[]
48     | <pages-toc>[]
49     | <site-toc>[]
50     | <local-links href=String>[]
51 abate 356 | <two-columns>[ <left>Content <right>Content ]
52 abate 343 | InlineText
53 abate 488 )* ]
54 abate 343
55     type InlineText =
56     Char
57     | <(`b|`i|`tt|`em) {||}>[InlineText*]
58     | <code>String
59 abate 347 | <local href=String>String
60 abate 488 | Xa | Ximg | Xbr
61 abate 343
62    
63     (** Generic purpose functions **)
64    
65     (* Recursive inclusion of XML files and verbatim text files *)
66    
67 abate 488 let load_include (String -> [Any*])
68 abate 336 name ->
69 abate 368 (* let _ = print [ 'Loading ' !name '... \n' ] in *)
70 abate 336 xtransform [ (load_xml name) ] with
71 abate 341 | <include file=(s & String)>[] -> load_include s
72 abate 488 | <include-verbatim file=(s & String)>[] -> load_file s
73 abate 336
74 abate 343 (* Highlighting text between {{...}} *)
75 abate 336
76 abate 488 let highlight (String -> [ (Char | Xvar | Xi)* ] )
77 abate 340 | [ '{{' h ::(Char *?) '}}' ; rest ] ->
78     [ <var class="highlight">h; highlight rest ]
79 abate 381 | [ '%%' h ::(Char *?) '%%' ; rest ] ->
80 abate 370 [ <i>h; highlight rest ]
81 abate 340 | [ c; rest ] -> [ c; highlight rest ]
82 abate 488 | [] -> []
83 abate 336
84 abate 343 (* Split a comma-separated string *)
85    
86 abate 488 let split_comma (String -> [String*])
87 abate 341 | [ x::(Char*?) ',' ; rest ] -> (x, split_comma rest)
88 abate 488 | s -> [ s ]
89 abate 336
90 abate 253
91 abate 343 (** Internal types **)
92 abate 341
93 abate 488 type Path = [ { url = String; title = String }* ]
94 abate 341 type Tree = { name = String; url = String; title = String;
95 abate 488 children = [Tree*] }
96 abate 250
97 abate 488 let url_of_name (String -> String)
98 abate 346 "index" -> "/"
99 abate 488 | s -> s @ ".html"
100 abate 346
101 abate 488 let authors ([Author+] -> String)
102 abate 250 | [ <author>a ] -> a
103     | [ <author>a1 <author>a2 ] -> a1 @ ", and " @ a2
104 abate 488 | [ <author>a; rem ] -> a @ ", " @ authors rem
105 abate 250
106 abate 488 let find_local_link (sitemap : [Tree*], l : String) : Tree =
107 abate 341 match sitemap with
108     | (h,t) ->
109 abate 347 if (h . name = l) then h
110 abate 341 else
111     (try find_local_link (t,l) with `Not_found ->
112     find_local_link (h . children,l))
113 abate 488 | [] -> raise `Not_found
114 abate 341
115 abate 488 let local_link (sitemap : Tree, l : String, txt : String) : Inline =
116 abate 347 try
117     let h = find_local_link ([sitemap],l) in
118     let txt = if txt = "" then h . title else txt in
119     <a href=(h . url)>txt
120 abate 488 with `Not_found -> raise [ 'Local link not found: ' !l ]
121 abate 341
122 abate 488 let compute_sitemap ((Page|External) -> Tree)
123 abate 341 <page name=name>[ <title>title (c::(Page|External) | _)* ] ->
124     let children = map c with p -> compute_sitemap p in
125 abate 346 { name = name; url = url_of_name name; title = title; children =children }
126 abate 561 |<external name=name href=h title=t>[] ->
127 abate 488 { name = name; url = h; title = t; children = [] }
128 abate 341
129 abate 488 let display_sitemap (h : Tree) : Xli =
130 abate 341 let ch = map h . children with x -> display_sitemap x in
131     let ch = match ch with [] -> [] | l -> [ <ul>l ] in
132 abate 488 <li>[ <a href=(h . url)>(h . title); ch ]
133 abate 341
134 abate 488 let link_to (Page -> Xa)
135     <page name=n>[<title>t ; _ ] -> <a href=(url_of_name n)>t
136 abate 351
137 abate 580 let box (x : Flow) : Block =
138     <table cellpadding="2"
139 abate 581 style="font-size:11px ; font-family:arial,sans-serif; border: solid 2px black; background: #ffffff" width="100%">
140 abate 580 [ <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 abate 343 (* Main transformation function *)
190    
191 abate 580
192 abate 386 (* returns the last page of the descendance *)
193 abate 488 let gen_page (prev : Page|[], page : Page, next : Page|[],
194 abate 386 path : Path, sitemap : Tree) : (Page|[]) =
195 abate 341 match page with
196 abate 381 <page name=name>[
197     <title>title <banner>banner | <title>(title & banner); items ] ->
198 abate 341
199 abate 488 let text (t : [InlineText*]) : Inlines =
200 abate 284 map t with
201 abate 341 | <code>x -> <b>[ <tt>(highlight x) ]
202 abate 347 | <local href=l>txt -> local_link (sitemap,l,txt)
203 abate 336 | <(tag & (`b|`i|`tt|`em))>x -> <(tag)>(text x)
204 abate 368 (* | <a href=url>_ & z -> let [] = print [ 'Link: ' !url '\n'] in z *)
205 abate 341 | z -> z
206     in
207 abate 254
208 abate 488 let content (t : Content) : Flow =
209 abate 250 transform t with
210 abate 284 | <section title=title>c ->
211 abate 580 [ <p>[ <b style="color: #008000">title ] !(content c) ]
212 abate 250 | <paper (r)>[ <title>tit aut::Author* <comment>com <abstract>ab ] ->
213 abate 284 [ (match r with { file = f } -> <a href=f>tit | _ -> <b>tit) '. '
214 abate 250 !(authors aut) '. '
215 abate 254 !(text com)
216 abate 250 <div class="abstract">[ 'Abstract:' !(content ab) ]
217     ]
218     | <slides file=f>[ <title>tit aut::Author* <comment>com ] ->
219 abate 254 [ <a href=f>tit '. ' !(authors aut) '. ' !(text com) ]
220 abate 344 | <sample highlight="false">s ->
221     [ <div class="code">[ <pre>s ] ]
222 abate 336 | <sample>s ->
223 abate 340 [ <div class="code">[ <pre>(highlight s) ] ]
224 abate 561 | <link url=url title=title>com ->
225 abate 284 [ <a href=url>title '. ' !(text com) ]
226     | <ul>lis ->
227     [ <ul>(map lis with <li>x -> <li>(content x)) ]
228     | Xtable & x ->
229     [ x ]
230 abate 254 | <p>x -> [ <p>(text x) ]
231 abate 341 | <pages-toc>[] ->
232     let toc =
233     transform items with
234 abate 351 | Page & p -> [ <li>[ (link_to p) ] ]
235 abate 561 | <external href=l title=t>[] -> [ <li>[ <a href=l>t ] ] in
236 abate 341 (match toc with [] -> [] | lis -> [ <ul>lis ])
237     | <boxes-toc>[] ->
238     let toc =
239     transform items with
240 abate 561 <box title=t link=l>_ -> [ <li>[ <a href=('#',l)>t ] ] in
241 abate 341 (match toc with [] -> [] | lis -> [ <ul>lis ])
242     | <site-toc>[] ->
243     [ <ul>[ (display_sitemap sitemap) ] ]
244     | <local-links href=s>[] ->
245     (match (split_comma s) with
246     | [] -> []
247 abate 347 | l -> let l = map l with x -> <li>[ (local_link(sitemap,x,"")) ]
248 abate 341 in [ <ul>l ])
249 abate 356 | <two-columns>[ <left>x <right>y ] ->
250     [ <table width="100%">[
251     <tr>[
252     <td valign="top">(content x)
253     <td valign="top">(content y) ] ] ]
254 abate 341 | t -> text [ t ]
255     in
256 abate 250
257 abate 580
258     (* Preparing left panel *)
259     let navig = transform items with <left>c -> [ c ] in
260     let left = match navig with [] -> [ [<boxes-toc>[]] ] | n -> n in
261     let left =
262     <td valign="top" align="left">[
263 abate 581 <table cellpadding="13" cellspacing="2"
264 abate 580 width="200" style="font-size:80%; border: 1px dashed black; background: #ffcd72">
265     (map left with x -> <tr>[ <td>[ (box (content x)) ] ]) ] in
266    
267 abate 341 let dpath : Inlines = transform path with
268 abate 391 | { url = f; title = t } -> [ <a href=f>t ': ']
269 abate 341 in
270 abate 351 let npath = path @ [ { url = url_of_name name; title = title } ] in
271     let subpages = transform items with p & Page -> [ p ] in
272 abate 386 let (next,last) = gen_page_seq (page, subpages, next, npath, sitemap) in
273 abate 391 let next = match next with [] -> []
274     | <page name=n>[ <title>t; _ ] ->
275     [ <a href=(url_of_name n)>[
276 abate 561 <img width="16" height="16" class="icon" alt="Next page" src="img/right.gif">[]
277 abate 391 ' ' !t
278     ] ] in
279     let prev = match prev with [] -> []
280     | <page name=n>[ <title>t; _ ] ->
281     [ <a href=(url_of_name n)>[
282 abate 561 <img width="16" height="16" class="icon" alt="Previous page" src="img/left.gif">[]
283 abate 391 ' ' !t
284     ] ] in
285 abate 580 let navig =
286 abate 391 if prev = [] then [] else
287 abate 580 [ (box [
288 abate 391 <p>[ !dpath !title ]
289 abate 580 <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 abate 341 let html : Xhtml =
322 abate 250 <html>[
323     <head>[
324 abate 350 <title>[ 'CDuce: ' !title ]
325 abate 561 <meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">[]
326 abate 580 <style type="text/css">style
327 abate 250 ]
328 abate 580 <body style="margin: 0; padding : 0; background: #fcb333">[
329     <table cellspacing="10" cellpadding="0" width="100%" border="0">[
330     <tr>[ left right ]
331     ]
332 abate 250 ]
333 abate 341 ]
334     in
335 abate 391 let txt : Latin1 =
336 abate 351 [ '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"'
337 abate 341 ' "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'
338 abate 580 !(print_xml html) ] in
339     let fn = "www/" @ name @ ".html" in
340 abate 386 let [] = dump_to_file fn txt in
341 abate 488 last
342 abate 386
343 abate 250
344 abate 488 let gen_page_seq
345 abate 351 (prev : Page|[], pages : [Page*], next : Page|[],
346 abate 386 path : Path, sitemap : Tree) : (Page|[], Page|[]) =
347 abate 351 match pages with
348     | [ p1 p2 ; _ ] & [ _; rest ] ->
349 abate 386 let last = gen_page (prev,p1,p2, path, sitemap) in
350     let (_,last) = gen_page_seq (last, rest, next, path, sitemap) in
351     (p1,last)
352 abate 351 | [ p ] ->
353 abate 386 let last = gen_page (prev,p,next, path, sitemap) in (p,last)
354 abate 488 | [] -> (next,prev)
355 abate 351
356    
357 abate 488 ;;
358 abate 284
359 abate 369 match load_include input with
360 abate 386 | [ Page & p ] -> let _ = gen_page ([],p,[], [], compute_sitemap p) in []
361 abate 488 | _ -> raise ("Invalid input document " @ input)
362 abate 369

CVS Admin">CVS Admin
ViewVC Help
Powered by ViewVC 1.1.5