xml2fo.cd 18.7 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
(* 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">[
49
	  !(heading2string thead) ' ' <fo:basic-link internal-destination=tid>tt ' '
50
51
52
53
54
55
	  <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">[
56
	  !(heading2string thead) ' ' <fo:basic-link internal-destination=tid>tt ' '
57
58
59
60
61
	  <fo:page-number-citation ref-id=tid>[]
	]
	!(toc_entry2fo le)
      ]

62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
let toc_entry2fo_table ([Entry+] -> [table-row+] ; [] -> []) x ->
  transform x with
    | <entry toc_id=tid toc_title=tt toc_head=thead>le ->[
	<fo:table-row>[
	  <fo:table-cell>[
	    <fo:block font-size="12pt" space-before="10pt" space-after="7pt" font-weight="bold" text-align="end">[
	      !(heading2string thead) ' '
	    ]
	  ]
	  <fo:table-cell>[
	    <fo:block font-size="12pt" space-before="10pt" space-after="7pt" font-weight="bold">[
              <fo:basic-link color="blue" internal-destination=tid>tt
	    ]
	  ]
	  <fo:table-cell>[
	    <fo:block  font-size="12pt" space-before="10pt" space-after="7pt" font-weight="bold" text-align="end">[
	      <fo:page-number-citation ref-id=tid>[]
	    ]
	  ]
	]
	!(toc_entry2fo_table le)
      ]
    |  <entry_page toc_id=tid toc_title=tt toc_head=thead>le ->[
	<fo:table-row>[
	  <fo:table-cell>[
	    <fo:block font-size="18pt" space-before="10pt" space-after="7pt" font-weight="bold" text-align="end">[
	      !(heading2string thead) ' '
	    ]
	  ]
	  <fo:table-cell>[
	    <fo:block font-size="18pt" font-weight="bold" space-after="7pt" space-before="10pt">[
              <fo:basic-link color="blue" internal-destination=tid>tt
	    ]
	  ]
	  <fo:table-cell>[
	    <fo:block  font-size="18pt" space-before="10pt" space-after="7pt" font-weight="bold" text-align="end">[
	      <fo:page-number-citation ref-id=tid>[]
	    ]
	  ]
	]
	!(toc_entry2fo_table le)
      ]


let toc_entry2pdfoutline ([Entry*] -> [fox:outline*]) x ->
  transform x with
    | <(`entry|`entry_page) toc_id=tid toc_title=tt toc_head=thead>le ->
      [<fox:outline internal-destination=tid>[
	  <fox:label>[!(heading2string thead) ' ' !tt ' ']
	  !(toc_entry2pdfoutline le)
	]
      ]


116
let out_global_toc (toc : [Entry?]) : [block*] = [
117
  <fo:block id="toc-main" break-before="page">[]
118
119
120
  <fo:block font-size="22pt" font-weight="bold" space-before="18pt">"Table of Contents"
  !(toc_entry2fo toc)
]
121

122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
let out_global_toc_table ([Entry] -> [block] ; [] -> [])
|  [] -> []
| toc & [Entry] -> [
    <fo:block>[
      <fo:block id="toc-main" break-before="page">[]
      <fo:block font-size="22pt" font-weight="bold" space-before="18pt">"Table of Contents :"
      <fo:table table-layout="fixed">[
	<fo:table-column column-width="2cm">[]
	<fo:table-column column-width="12cm">[]
	<fo:table-column column-width="2cm">[]
	<fo:table-body>[!(toc_entry2fo_table toc)]
      ]
    ]
  ]

137
138
139
140
(** Command line **)

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

141
142
143
let highlight (String -> [ (Char| inline)* ] )
 | [ '{{%%' h ::(Char *?) '%%}}' ; rest ] -> 
          [<fo:inline color="red" font-weight="bold" font-style="italic"> h;  highlight rest] 
144
 | [ '{{' h ::(Char *?) '}}' ; rest ] -> 
145
          [<fo:inline color="red" font-weight="bold"> h;  highlight rest] 
146
 | [ '$$%%' h ::(Char *?) '%%$$' ; rest ] -> 
147
          [<fo:inline color="darkblue" font-weight="bold" font-style="italic"> h;  highlight rest] 
148
 | [ '$$' h ::(Char *?) '$$' ; rest ] -> 
149
          [<fo:inline color="darkblue" font-weight="bold"> h;  highlight rest] 
150
 | [ '%%' h ::(Char *?) '%%' ; rest ] ->
151
          [<fo:inline font-style="italic"> h;  highlight rest] 
152
153
154
 | [ c ; rest ] ->  [c ; highlight rest] 
 | [] -> []

155
 let text (t : [InlineText*]) : [(block|basic-link|Char|inline|list-block|footnote|table)*] =
156
  transform t with
157
158
159
   |<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)]]
160
   |<em>s2 -> [<fo:inline  font-style="italic">[!(text s2)]]
161
   | z & Char  -> [z]
162
   | <code>x -> [<fo:inline color="darkgreen" font-weight="bold" font-family="Courier">[ !(highlight x)] ]
163
164
   | <local href=x>(s2&[InlineText*]) 
                ->[ <fo:basic-link color="blue" text-decoration="underline" 
165
                      internal-destination=x>[!(text s2)]] 
166
   | <a href=['#' ;x]>(s2&[InlineText*])	(* if it starts by # is an internal reference *)
167
168
169
		->[ <fo:basic-link color="blue"
			text-decoration="underline" 
                        internal-destination=x>[!(text s2)]] 
170
   | <a href=x ..>(s2&[InlineText*])  		(* otherwise it is an external reference *)
171
172
173
174
		->[ <fo:basic-link color="red"
			text-decoration="underline"
			font-style="italic"
                        external-destination=x>[!(text s2)]] 
175
   |<footnote ..>t -> [
176
177
178
	<fo:footnote text-indent="0pt">[
            <fo:inline baseline-shift="super" font-size="8pt">"(*)"
    	    <fo:footnote-body>[
179
180
                <fo:list-block
		     provisional-label-separation="0pt"
181
                     provisional-distance-between-starts="18pt"
182
                     space-after\.optimum="6pt">[
183
184
185
186
187
                        <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)]]]]]]]
188

189
 let content (t : Content) : [(block|basic-link|Char|inline|list-block|footnote|table)*] =
190
    transform t with
191
192
193
   | <section title=title1>c 
            -> [<fo:block space-before="5pt">[
                   <fo:block space-after="4pt" font-size="14pt" font-weight="bold">[!title1] !(content c) ]]
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
   |((<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)]]
224
225
226
227
228
229
230
231
   | ((<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"
232
233
		padding-start="4pt"
		padding-after="4pt"
234
		margin-bottom="3pt"
235
		text-align="left"
236
		space-after="10pt">[!(highlight s)]]
237
   | <p>x -> [<fo:block space-after="15pt">[!(text x)]]
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
   | <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>[]]]
			)])
		]]
264
   | <ul ..>u ->[ <fo:list-block provisional-distance-between-starts="18pt"
265
               provisional-label-separation="3pt">( transform u with  
266
		 <li ..>c -> [<fo:list-item>[    
267
268
				<fo:list-item-label text-align="center" end-indent="label-end()">[
			           <fo:block font-size="18pt">"\x2022;"]
269
270
			        <fo:list-item-body start-indent="body-start()">[
				<fo:block>[ !(content c) ]]]])]
271
   | <ol ..>o -> [ <fo:list-block provisional-distance-between-starts="18pt"
272
273
274
               provisional-label-separation="3pt">( 
		let i = ref Int 0 in
                 transform o with  
275
		 <li ..>c -> [<fo:list-item>[    
276
277
				<fo:list-item-label  text-align="right" end-indent="label-end()">[
			           <fo:block>(string_of(i:=!i+1 ; !i)@".")]
278
279
			        <fo:list-item-body start-indent="body-start()">[
				<fo:block>[ !(content c) ]]]])]
280
281
282
283
   | p & Paper -> (paper p)
   | l & Link -> (link l)
   | s & Slides -> (slides s)
   | i & InlineText -> (text [i])
284
285
286
287
288
289
290
291
292
293
   | <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)]]
294
   | <two-columns>[ <left>x <right>y ] -> 
295
296
297
            [<fo:table 
	      space-after="15pt" 
	      table-layout="fixed" 
298
	      inline-progression-dimension\.maximum="125%">[
299
300
301
302
		<fo:table-column>[]
		<fo:table-column>[]
		<fo:table-body>[
		   <fo:table-row>[
303
304
			<fo:table-cell padding="3pt">[<fo:block>[!(content x)]]
			<fo:table-cell padding="3pt">[<fo:block>[!(content y)]]]]]] 
305
306
307
   | <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']]
308
   | <footnotes>_ -> [<fo:block>['A FAIRE FOOTNOTE']]
309
310
   | <demo ..>_ -> [<fo:block>['A FAIRE DEMO LABEL']]
   | <boxes-toc ..>_ -> []
311

312
313
314
315
316
317
318
319
320
321
322
323
324
325

 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']]

 
326

327
let readItem (it : [Item+]): [block*] =
328
329
330
331
   transform it with
     | <box title=t link=x>c -> 
	[<fo:block id=x>[
		<fo:block font-size="22pt"  
332
                          space-before="15pt">[<fo:block space-after="7pt" font-weight="bold">[!t]] !(content c)]]
333
334
335
336
337
338
339
340
     | <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">[
341
			<fo:block text-align="left">[
342
343
344
345
346
				<fo:block font-size="32pt" 
                                    font-weight="bold" 
                                    space-after="40pt" 
                                    space-before="85pt" 
                                    color="black" >[!title1]
347
			] !(readItem litem)
348
		]]
349
     | _ -> raise "ERROR"
350

351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
(* 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"


395
let gen_page (page : Page, cduce_version : Latin1) : [block+] = 
396
397
  match page with 
     (* le cas sans item*)
398
     <page ..>[(<title>_) (<banner>_)?] ->  [<fo:block text-align="center" font-size="35pt" color="green" space-after="30pt">
399
		(raise "error") ]
400
401
 
    (* la cas de base *)
402
    |<page ..>[(<title>title1 (<banner>_)? litem::Item+)] ->(
403
404
	let sortie : [block+]=
	[
405
	      <fo:block text-align="center" space-before="130pt">[
406
407
408
409
410
                   <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)]				          
411
412
	in sortie)
	
413
414
415
416
417
418
419
420
421
422
423
(* 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
424
	let sortie : [ block+ ]= [
425
426
427
428
	  <fo:block text-align="center" space-before="80pt">[
            <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)
429
	    <fo:external-graphic src="url(../../web/img/cduce_logo.jpg)">[]
430
	  ]
431
432
	  !(out_global_toc_table !local_toc)
(*          !(out_global_toc !local_toc) *)
433
434
435
	  !rIH
	]
	in sortie)
436
437
438
439
440
441
442
443
444
	  
	  
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 
445
446
  | [ (inp_file & Latin1) (out_file & Latin1)  (cduce_version & Latin1) ] 
      -> (try let ([ main_page ]) =  (load_include inp_file :? [ Page ]) in 
447
448
449
450
451
452
453
454
455
456
457
	  let content = (gen_pageHead(main_page,cduce_version)) in
          let DebutFo : root = 
            <fo:root >[
	      <fox:outline internal-destination="toc-main">[<fox:label>("Table of Contents")]
	      !(toc_entry2pdfoutline !local_toc)
              <fo:layout-master-set>[
	      <fo:simple-page-master 
			master-name="essai" 
                        page-height="29.7cm" 
                        page-width="21cm">[
                          <fo:region-body margin-top="3cm" 
458
459
460
                                   margin-bottom="3.5cm"  
                                   margin-left="2.5cm" 
                                   margin-right="2.5cm">[]
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
                          <fo:region-after region-name="footer" extent="15mm">[]
                       	]
	      ] 
	      <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">[]
		  ]
		]
		<fo:static-content flow-name="footer">[
		  <fo:block text-align="center">[
		    <fo:page-number>[]
		  ]
		]
		<fo:flow flow-name="xsl-region-body" 
		         font-size="12pt" 
		         text-align="justify"> [!content]
	      ]
	    ] in
	    dump_to_file ("../doc/fomanual/"@out_file)   
484
(*	      dump_to_file (out_file)                      *)
485
              ['<?xml version="1.0" encoding="UTF-8"?>' !(print_xml DebutFo)] 
486
487
				    (*print(print_xml(main_page));*)
				    (* print (gen_page main_page)*)
488
489
490
491
	  with err & Latin1 ->
	    print ['Invalid input document\n' !err '\n']; 
            exit 2 
	 )
492
  | _ -> raise "Wrong argument number or type: please correct the  --arg option";;
493