xml2fo.cd 16.4 KB
Newer Older
1
(* Input Types *)
2
include "../../web/siteTypes.cd";;
3
4

(* Output Types *)
5
include "fo_dtd.cd";;
6

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
(* Heading numbering *)
type heading = <heading>[Int heading?]

let heading2string
  (heading -> [PCDATA])
	       | <heading>[x] -> string_of x
	       | <heading>[x h] ->
		   [!(string_of x) '.' ;(heading2string h)]

let incHeading
  (heading -> heading)
	       | <heading>[x] -> <heading>[(x + 1)]
	       | <heading>[x h] -> <heading>[x (incHeading h)]

let newHLevel
  (heading -> heading)
	       | <heading>[x] -> <heading>[x <heading>[0]]
	       | <heading>[x h] -> <heading>[x (newHLevel h)]

(* Table of contents *)
type Entry =
    <entry toc_id=String toc_title=String toc_head=heading>[Entry*]
  | <entry_page toc_id=String toc_title=String toc_head=heading>[Entry*]

let local_toc = ref [Entry?] []

let new_entry_toc (nid : String , ntitle : String , nhead : heading) : Entry =
  <entry toc_id=nid toc_title=ntitle toc_head=nhead>[]

let new_entry_page_toc (nid : String , ntitle : String , nhead : heading) : Entry =
  <entry_page toc_id=nid toc_title=ntitle toc_head=nhead>[]

let add_entry_toc (toc : [Entry?] , new : [Entry?]) : [Entry?] =
  match toc with
    | [] -> new
    | [<entry (attr)>l] -> [<entry (attr)>[!l !new]]
    | [<entry_page (attr)>l] -> [<entry_page (attr)>[!l !new]]

let toc_entry2fo ([Entry*] -> [block*]) x ->
  transform x with
    | <entry toc_id=tid toc_title=tt toc_head=thead>le ->
      [<fo:block font-size="12pt" space-before="10pt" space-after="7pt" font-weight="bold">[
	  !(heading2string thead) ' ' !tt ' '
	  <fo:page-number-citation ref-id=tid>[]
	]
	!(toc_entry2fo le)
      ]
    |  <entry_page toc_id=tid toc_title=tt toc_head=thead>le ->
      [<fo:block font-size="18pt" font-weight="bold" space-after="7pt" space-before="10pt">[
	  !(heading2string thead) ' ' !tt ' '
	  <fo:page-number-citation ref-id=tid>[]
	]
	!(toc_entry2fo le)
      ]

let out_global_toc (toc : [Entry?]) : [block*] = [
  <fo:block break-before="page">[]
  <fo:block font-size="22pt" font-weight="bold" space-before="18pt">"Table of Contents"
  !(toc_entry2fo toc)
]
67
68
69
70
71

(** Command line **)

(* Highlighting text between {{...}} *)

72
73
74
let highlight (String -> [ (Char| inline)* ] )
 | [ '{{%%' h ::(Char *?) '%%}}' ; rest ] -> 
          [<fo:inline color="red" font-weight="bold" font-style="italic"> h;  highlight rest] 
75
 | [ '{{' h ::(Char *?) '}}' ; rest ] -> 
76
          [<fo:inline color="red" font-weight="bold"> h;  highlight rest] 
77
 | [ '$$%%' h ::(Char *?) '%%$$' ; rest ] -> 
78
          [<fo:inline color="darkblue" font-weight="bold" font-style="italic"> h;  highlight rest] 
79
 | [ '$$' h ::(Char *?) '$$' ; rest ] -> 
80
          [<fo:inline color="darkblue" font-weight="bold"> h;  highlight rest] 
81
 | [ '%%' h ::(Char *?) '%%' ; rest ] ->
82
          [<fo:inline font-style="italic"> h;  highlight rest] 
83
84
85
 | [ c ; rest ] ->  [c ; highlight rest] 
 | [] -> []

86
 let text (t : [InlineText*]) : [(block|basic-link|Char|inline|list-block|footnote|table)*] =
87
  transform t with
88
89
90
   |<b>s2 ->[<fo:inline font-weight="bold">[!(text s2)]] 
   |<i>s2 -> [<fo:inline font-style="italic">[!(text s2)]]
   |<tt>s2 -> [<fo:inline font-family="Courier" color="green">[!(text s2)]]
91
   |<em>s2 -> [<fo:inline  font-style="italic">[!(text s2)]]
92
   | z & Char  -> [z]
93
   | <code>x -> [<fo:inline color="darkgreen" font-weight="bold" font-family="Courier">[ !(highlight x)] ]
94
95
   | <local href=x>(s2&[InlineText*]) 
                ->[ <fo:basic-link color="blue" text-decoration="underline" 
96
                      internal-destination=x>[!(text s2)]] 
97
   | <a href=['#' ;x]>(s2&[InlineText*])	(* if it starts by # is an internal reference *)
98
99
100
		->[ <fo:basic-link color="blue"
			text-decoration="underline" 
                        internal-destination=x>[!(text s2)]] 
101
   | <a href=x ..>(s2&[InlineText*])  		(* otherwise it is an external reference *)
102
103
104
105
		->[ <fo:basic-link color="red"
			text-decoration="underline"
			font-style="italic"
                        external-destination=x>[!(text s2)]] 
106
   |<footnote ..>t -> [
107
108
109
	<fo:footnote text-indent="0pt">[
            <fo:inline baseline-shift="super" font-size="8pt">"(*)"
    	    <fo:footnote-body>[
110
111
                <fo:list-block
		     provisional-label-separation="0pt"
112
                     provisional-distance-between-starts="18pt"
113
                     space-after\.optimum="6pt">[
114
115
116
117
118
                        <fo:list-item>[
                          <fo:list-item-label end-indent="label-end()">[
                               <fo:block font-size="8pt">"(*)"]
                          <fo:list-item-body start-indent="body-start()">[
                              <fo:block font-size="8pt">[!(text t)]]]]]]]
119

120
 let content (t : Content) : [(block|basic-link|Char|inline|list-block|footnote|table)*] =
121
    transform t with
122
123
124
   | <section title=title1>c 
            -> [<fo:block space-before="5pt">[
                   <fo:block space-after="4pt" font-size="14pt" font-weight="bold">[!title1] !(content c) ]]
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
   |((<sessionsample >s) | <sessionsample highlight="false">s)
            -> [<fo:block font-family="Courier"
		font-size="10pt"
		linefeed-treatment="preserve"
		white-space-collapse="false"
		white-space-treatment="preserve" 
		background-color="white"
		border-style="dashed"
		padding-start="34pt"
		padding-end="34pt"
		padding-before="14pt"
		padding-after="14pt"
		margin-bottom="3pt"
		margin-left="15pt"
		margin-right="15pt"
		text-align="left"
		space-after="10pt">[!(highlight s)]]
  |((<xmlsample >s) | <xmlsample highlight="false">s)
           -> [<fo:block font-family="Courier"
		font-size="10pt"
		linefeed-treatment="preserve"
		white-space-collapse="false"
		white-space-treatment="preserve" 
		background-color="lightyellow"
		border-style="dashed"
		padding-start="4pt"
		padding-after="4pt"
		margin-bottom="3pt"
		text-align="left"
		space-after="10pt">[!(highlight s)]]
155
156
157
158
159
160
161
162
   | ((<sample >s) | <sample highlight="false">s) 
           -> [<fo:block font-family="Courier"
		font-size="10pt"
		linefeed-treatment="preserve"
		white-space-collapse="false"
		white-space-treatment="preserve" 
		background-color="lightgray"
		border-style="dashed"
163
164
		padding-start="4pt"
		padding-after="4pt"
165
		margin-bottom="3pt"
166
		text-align="left"
167
		space-after="10pt">[!(highlight s)]]
168
   | <p>x -> [<fo:block space-after="15pt">[!(text x)]]
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
   | <table ..> [ (col:: H.col)* (rows::H.tr)+] 
           -> [<fo:table space-after="15pt" table-layout="fixed" inline-progression-dimension\.maximum="95%">[
         	   !(map col with <col ..>[] -> <fo:table-column width="proportional-column-width(1)">[])
		   <fo:table-body>( transform rows with
			<tr ..> y -> [<fo:table-row>( transform y with
                           | <th ..> (z&Content) 
				-> [<fo:table-cell 
                                        padding="6pt" 
                                        background-color="silver" 
                                        border="0.5pt solid black">[ 
                                        <fo:block font-weight="bold">[!(content z) ]]]
			   | <td style=['background:' ;c] ..> (z&Content) 
                                -> [<fo:table-cell 
                                        padding="3pt" 
                                        background-color=c 
                                        border="0.5pt solid black" 
                                        text-align="left">[ <fo:block>[!(content z) ]]]
			   | <td ..> (z&Content) 
                                -> [<fo:table-cell 
                                        padding="3pt" 
                                        border="0.5pt solid black" 
                                        text-align="left">[ <fo:block>[!(content z) ]]]
                                  (* fake entry to assure that it will have type table-cell+*)
                           | _ -> [<fo:table-cell>[<fo:block>[]]]
			)])
		]]
195
   | <ul ..>u ->[ <fo:list-block provisional-distance-between-starts="18pt"
196
               provisional-label-separation="3pt">( transform u with  
197
		 <li ..>c -> [<fo:list-item>[    
198
199
				<fo:list-item-label text-align="center" end-indent="label-end()">[
			           <fo:block font-size="18pt">"\x2022;"]
200
201
			        <fo:list-item-body start-indent="body-start()">[
				<fo:block>[ !(content c) ]]]])]
202
   | <ol ..>o -> [ <fo:list-block provisional-distance-between-starts="18pt"
203
204
205
               provisional-label-separation="3pt">( 
		let i = ref Int 0 in
                 transform o with  
206
		 <li ..>c -> [<fo:list-item>[    
207
208
				<fo:list-item-label  text-align="right" end-indent="label-end()">[
			           <fo:block>(string_of(i:=!i+1 ; !i)@".")]
209
210
			        <fo:list-item-body start-indent="body-start()">[
				<fo:block>[ !(content c) ]]]])]
211
212
213
214
   | p & Paper -> (paper p)
   | l & Link -> (link l)
   | s & Slides -> (slides s)
   | i & InlineText -> (text [i])
215
216
217
218
219
220
221
222
223
224
   | <note>s -> [<fo:block
 		background-color="lightgreen"
		border-style="dashed"
		padding-before="15pt"
		padding-end="25pt"
		padding-start="25pt"
		padding-after="15pt"
		margin-left="35pt"
		margin-right="35pt"
		space-after="10pt">[(<fo:inline font-weight="bold">"Note: ") !(content s)]]
225
   | <two-columns>[ <left>x <right>y ] -> 
226
227
228
            [<fo:table 
	      space-after="15pt" 
	      table-layout="fixed" 
229
	      inline-progression-dimension\.maximum="125%">[
230
231
232
233
		<fo:table-column>[]
		<fo:table-column>[]
		<fo:table-body>[
		   <fo:table-row>[
234
235
			<fo:table-cell padding="3pt">[<fo:block>[!(content x)]]
			<fo:table-cell padding="3pt">[<fo:block>[!(content y)]]]]]] 
236
237
238
   | <pages-toc ..>_ ->[<fo:block>['TODO PAGES TABLE OF CONTENTS']]
   | <site-toc ..>_ -> [<fo:block>['TODO SITE TABLE OF CONTENTS']]
   | <local-links ..>_ -> [<fo:block>['A FAIRE LOCAL LINKS']]
239
   | <footnotes>_ -> [<fo:block>['A FAIRE FOOTNOTE']]
240
241
   | <demo ..>_ -> [<fo:block>['A FAIRE DEMO LABEL']]
   | <boxes-toc ..>_ -> []
242

243
244
245
246
247
248
249
250
251
252
253
254
255
256

 let paper (p : Paper) : [block*] =
   match p with
       _ -> [<fo:block>['A FAIRE PAPER']]
	 
 let link (l : Link) : [block*] =
   match l with
      _ -> [<fo:block>['A FAIRE LINK']] 
	
 let slides (s : Slides) : [block*] =
   match s with
       _ -> [<fo:block>['A FAIRE SLIDE']]

 
257

258
let readItem (it : [Item+]): [block*] =
259
260
261
262
   transform it with
     | <box title=t link=x>c -> 
	[<fo:block id=x>[
		<fo:block font-size="22pt"  
263
                          space-before="15pt">[<fo:block space-after="7pt" font-weight="bold">[!t]] !(content c)]]
264
265
266
267
268
269
270
271
     | <box>c -> [<fo:block>[!(content c)]]
     | <meta>c -> (* non utilise pour manuel et tutoriel*)
	    [<fo:block>[!(content c)]]
     | <left>_ -> [<fo:block>[]]
     | <footnotes>[] -> [<fo:block>[ ]]
     | <page .. > [(<title>_) (<banner>_)? ] -> [<fo:block>['box vide!!!!!!!!!!!!!']]
     | <page name=x >[(<title>title1 (<banner>_)? litem::Item+)] -> 
		[<fo:block id=x	break-before="page" text-align-last="justify">[
272
			<fo:block text-align="left">[
273
274
275
276
277
				<fo:block font-size="32pt" 
                                    font-weight="bold" 
                                    space-after="40pt" 
                                    space-before="85pt" 
                                    color="black" >[!title1]
278
			] !(readItem litem)
279
		]]
280
     | _ -> raise "ERROR"
281

282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
(* adding heading numbering ... *)
let readItemHead (([Item+],heading) -> [block*]) (it,head) ->
  let href = ref heading head in
   transform it with
     | <box title=t link=x>c ->
	 let _ = href := incHeading !href in
	 let box_entry = new_entry_toc (x,t,!href) in
	 let saved_toc = !local_toc in let _ = local_toc := [box_entry] in
	 let result = [<fo:block id=x>[
			  <fo:block font-size="22pt" space-before="15pt">[
			    <fo:block space-after="7pt" font-weight="bold">[!(heading2string !href) ' ' !t]] !(content c)
			]
		      ] in
	 let new_toc = add_entry_toc (saved_toc,!local_toc) in
	   local_toc := new_toc ;
	   result
     | <box>c -> [<fo:block>[!(content c)]]
     | <meta>c -> (* non utilise pour manuel et tutoriel*)
	    [<fo:block>[!(content c)]]
     | <left>_ -> [<fo:block>[]]
     | <footnotes>[] -> [<fo:block>[ ]]
     | <page .. > [(<title>_) (<banner>_)? ] -> [<fo:block>['box vide!!!!!!!!!!!!!']]
     | <page name=x >[(<title>title1 (<banner>_)? litem::Item+)] -> 
	 let _ = href := incHeading !href in
	 let box_entry = new_entry_page_toc (x,title1,!href) in
	 let saved_toc = !local_toc in let _ = local_toc := [box_entry] in
	 let result = [<fo:block id=x break-before="page" text-align-last="justify">[
			  <fo:block text-align="left">[
			    <fo:block font-size="32pt" 
				font-weight="bold" 
				space-after="40pt" 
				space-before="85pt" 
				color="black" >[
				  !(heading2string !href) ' ' !title1
				]
			  ] !(readItemHead (litem,newHLevel !href))
			]
		      ] in
	 let new_toc = add_entry_toc (saved_toc,!local_toc) in
	   local_toc := new_toc ;
	   result
     | _ -> raise "ERROR"


326
let gen_page (page : Page, cduce_version : Latin1) : [block+] = 
327
328
  match page with 
     (* le cas sans item*)
329
     <page ..>[(<title>_) (<banner>_)?] ->  [<fo:block text-align="center" font-size="35pt" color="green" space-after="30pt">
330
		(raise "error") ]
331
332
 
    (* la cas de base *)
333
    |<page ..>[(<title>title1 (<banner>_)? litem::Item+)] ->(
334
335
	let sortie : [block+]=
	[
336
	      <fo:block text-align="center" space-before="130pt">[
337
338
339
340
341
                   <fo:block font-size="35pt" font-weight="bold">"CDuce Programming Language" 
                   <fo:block font-size="35pt" font-weight="bold" space-after="20pt">[!title1]
                   <fo:block font-size="18pt" font-weight="bold">("Language Version "@cduce_version)
	      ]
	      !(readItem litem)]				          
342
343
	in sortie)
	
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
(* adding heading numbering *)
let gen_pageHead (page : Page, cduce_version : Latin1) : [block+] = 
  match page with 
     (* le cas sans item*)
     <page ..>[(<title>_) (<banner>_)?] ->  [<fo:block text-align="center" font-size="35pt" color="green" space-after="30pt">
		(raise "error") ]
 
    (* la cas de base *)
    |<page ..>[(<title>title1 (<banner>_)? litem::Item+)] -> (
	let head = <heading>[0] in
	let rIH = (readItemHead (litem, head)) in
	let sortie : [block+]= [
	  <fo:block text-align="center" space-before="80pt">[
	    <fo:external-graphic src="url(img/cduce_logo.jpg)">[]
            <fo:block font-size="35pt" font-weight="bold" space-before="30pt">"CDuce Programming Language" 
	    <fo:block font-size="35pt" font-weight="bold" space-after="20pt">[!title1]
            <fo:block font-size="18pt" font-weight="bold">("Language Version "@cduce_version)
	  ]
          !(out_global_toc !local_toc)
	  !rIH
	]
	in sortie)
366
367
368
369
370
371
372
373
374
	  
	  
let load_include (Latin1 -> [Any*])
 name ->
   xtransform [ (load_xml name) ] with 
   | <include file=(s & Latin1)>[] -> load_include s
   | <include-verbatim file=(s & Latin1)>[] -> load_file s
in
match argv [] with 
375
376
377
378
379
380
381
382
383
384
385
386
387
  | [ (inp_file & Latin1) (out_file & Latin1)  (cduce_version & Latin1) ] 
      -> (try let ([ main_page ]) =  (load_include inp_file :? [ Page ]) in 
             let DebutFo : root = 
                  <fo:root >[
                     <fo:layout-master-set>[
		        <fo:simple-page-master 
                            master-name="essai" 
                            page-height="29.7cm" 
                            page-width="21cm">[
                               <fo:region-body margin-top="3cm" 
                                   margin-bottom="3.5cm"  
                                   margin-left="2.5cm" 
                                   margin-right="2.5cm">[]
388
                               <fo:region-after region-name="footer" extent="15mm">[]
389
390
391
392
393
394
395
396
397
                       	   ]
	                ] 
	             <fo:page-sequence initial-page-number="auto" master-reference="essai" >[ 
                        <fo:static-content flow-name="xsl-footnote-separator">[
 		           <fo:block>[
		              <fo:leader leader-pattern="rule"
                 	          leader-length="100%"
                 	          rule-style="solid"
                 	          rule-thickness="0.5pt">[]]]
398
399
400
			<fo:static-content flow-name="footer">[
			  <fo:block text-align="center">[<fo:page-number>[]]
			]
401
402
403
	                <fo:flow 
		            flow-name="xsl-region-body" 
		            font-size="12pt" 
404
		            text-align="justify"> [!(gen_pageHead(main_page,cduce_version))] ]] in
405
406
	      dump_to_file ("../doc/fomanual/"@out_file)   
(*	      dump_to_file (out_file)                      *)
407
                           ['<?xml version="1.0" encoding="ISO-8859-1"?>' !(print_xml DebutFo)] 
408
409
				    (*print(print_xml(main_page));*)
				    (* print (gen_page main_page)*)
410
411
412
413
	 with err & Latin1 -> print ['Invalid input document\n' !err '\n']; 
         exit 2 
       ) 
  | _ -> raise "Wrong argument number or type: please correct the  --arg option";;
414