2
* Copyright (C) 2007 Vincent Balat
3
* Laboratoire PPS - CNRS Universit� Paris Diderot
5
* This program is free software; you can redistribute it and/or modify
6
* it under the terms of the GNU Lesser General Public License as published by
7
* the Free Software Foundation, with linking exception;
8
* either version 2.1 of the License, or (at your option) any later version.
10
* This program is distributed in the hope that it will be useful,
11
* but WITHOUT ANY WARRANTY; without even the implied warranty of
12
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
* GNU Lesser General Public License for more details.
15
* You should have received a copy of the GNU Lesser General Public License
16
* along with this program; if not, write to the Free Software
17
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
29
(*****************************************************************************)
30
(* print to Ocsigen's streams *)
32
let x_stream, xh_stream =
34
let aux ~width ~encode ?(html_compat = false) arbre cont =
35
let endemptytag = if html_compat then ">" else " />" in
36
let rec xh_print_attrs encode attrs cont = match attrs with
39
(Ocsigen_stream.cont (" "^XML.attrib_to_string encode attr)) (fun () ->
40
xh_print_attrs encode queue cont)
42
and xh_print_text texte i is_first cont =
43
(Ocsigen_stream.cont texte) cont
45
and xh_print_closedtag encode tag attrs i is_first cont =
46
if List.mem tag emptytags
48
(if (i > 0) || is_first then
49
Ocsigen_stream.cont (String.make (taille_tab*i) ' ')
50
else (fun cont -> cont ())) (fun () ->
51
(Ocsigen_stream.cont ("<"^tag)) (fun () ->
52
xh_print_attrs encode attrs (fun () ->
53
(Ocsigen_stream.cont endemptytag) cont)))
55
(if (i > 0) || is_first then
56
Ocsigen_stream.cont (String.make (taille_tab*i) ' ')
57
else (fun cont -> cont ())) (fun () ->
58
(Ocsigen_stream.cont ("<"^tag)) (fun () ->
59
xh_print_attrs encode attrs (fun () ->
60
(Ocsigen_stream.cont ("></"^tag^">")) cont)))
62
and xh_print_inlinetag encode tag attrs taglist i is_first cont =
64
then xh_print_closedtag encode tag attrs i true cont
66
(Ocsigen_stream.cont ("<"^tag)) (fun () ->
67
xh_print_attrs encode attrs (fun () ->
68
(Ocsigen_stream.cont ">") (fun () ->
69
xh_print_taglist taglist 0 false false (fun () ->
70
(Ocsigen_stream.cont ("</"^tag^">") cont)))))
73
and xh_print_blocktag encode tag attrs taglist i cont =
75
then xh_print_closedtag encode tag attrs i true cont
78
(Ocsigen_stream.cont ("\n"^String.make (taille_tab*i) ' '))
79
else (Ocsigen_stream.cont "\n")) (fun () ->
80
(Ocsigen_stream.cont ("<"^tag)) (fun () ->
81
xh_print_attrs encode attrs (fun () ->
82
(Ocsigen_stream.cont ">") (fun () ->
84
xh_print_taglist_removews taglist (i+1) true (fun () ->
87
(Ocsigen_stream.cont ("\n"^String.make (taille_tab*i) ' '))
88
else (Ocsigen_stream.cont "\n")) (fun () ->
89
(Ocsigen_stream.cont ("</"^tag^">") cont)))))))
93
and xh_print_semiblocktag encode tag attrs taglist i cont =
94
(* New line before and after but not inside, for ex for <pre> *)
96
then xh_print_closedtag encode tag attrs i true cont
99
(Ocsigen_stream.cont ("\n"^String.make (taille_tab*i) ' '))
100
else (Ocsigen_stream.cont "\n")) (fun () ->
101
(Ocsigen_stream.cont ("<"^tag)) (fun () ->
103
xh_print_attrs encode attrs (fun () ->
104
(Ocsigen_stream.cont ">") (fun () ->
106
xh_print_taglist taglist 0 false false (fun () ->
108
(Ocsigen_stream.cont ("</"^tag^">") cont))))))
112
and xh_print_taglist_removews taglist i is_first cont =
114
| (Whitespace s)::l -> xh_print_taglist_removews l i is_first cont
115
| l -> xh_print_taglist l i is_first true cont
118
and print_nodes ws1 name xh_attrs xh_taglist ws2 queue i is_first removetailingws cont =
120
if (List.mem name blocktags)
121
then xh_print_blocktag encode name xh_attrs xh_taglist i cont
123
(if (List.mem name semiblocktags)
124
then xh_print_semiblocktag encode name xh_attrs xh_taglist i cont
126
xh_print_text (encode ws1) i is_first (fun () ->
127
xh_print_inlinetag encode name xh_attrs xh_taglist i is_first (fun () ->
128
xh_print_text (encode ws2) i is_first cont))
130
(fun () -> xh_print_taglist queue i false removetailingws cont)
132
and xh_print_taglist taglist i is_first removetailingws cont =
137
| (Comment texte)::queue ->
138
xh_print_text ("<!--"^(encode texte)^"-->") i is_first
139
(fun () -> xh_print_taglist queue i false removetailingws cont)
141
| (Entity e)::queue ->
142
xh_print_text ("&"^e^";") i is_first (* no encoding *)
143
(fun () -> xh_print_taglist queue i false removetailingws cont)
145
| (PCDATA texte)::queue ->
146
xh_print_text (encode texte) i is_first
147
(fun () -> xh_print_taglist queue i false removetailingws cont)
149
| (EncodedPCDATA texte)::queue ->
150
xh_print_text texte i is_first
151
(fun () -> xh_print_taglist queue i false removetailingws cont)
153
| (Whitespace _)::(Element ("hr",xh_attrs,[]))::(Whitespace _)::queue
154
| (Element ("hr",xh_attrs,[]))::(Whitespace _)::queue
155
| (Whitespace _)::(Element ("hr",xh_attrs,[]))::queue
156
| (Element ("hr",xh_attrs,[]))::queue ->
157
xh_print_closedtag id "hr" xh_attrs i is_first
158
(fun () -> xh_print_taglist queue i false removetailingws cont)
160
| (Element (name, xh_attrs, []))::queue ->
161
xh_print_closedtag id name xh_attrs i is_first
162
(fun () -> xh_print_taglist queue i false removetailingws cont)
164
(* Balises de presentation, type inline *)
165
| (Element (name, xh_attrs, xh_taglist))::queue ->
166
xh_print_inlinetag id name xh_attrs xh_taglist i is_first
167
(fun () -> xh_print_taglist queue i false removetailingws cont)
169
(* Balises de type block *)
170
| (Whitespace _)::(BlockElement (name,xh_attrs,xh_taglist))::(Whitespace _)::queue
171
| (BlockElement (name,xh_attrs,xh_taglist))::(Whitespace _)::queue
172
| (Whitespace _)::(BlockElement (name,xh_attrs,xh_taglist))::queue
173
| (BlockElement (name,xh_attrs,xh_taglist))::queue ->
174
xh_print_blocktag id name xh_attrs xh_taglist i
175
(fun () -> xh_print_taglist queue i false removetailingws cont)
177
(* Balises de type "semi block", for ex <pre> *)
178
| (Whitespace _)::(SemiBlockElement (name,xh_attrs,xh_taglist))::(Whitespace _)::queue
179
| (SemiBlockElement (name,xh_attrs,xh_taglist))::(Whitespace _)::queue
180
| (Whitespace _)::(SemiBlockElement (name,xh_attrs,xh_taglist))::queue
181
| (SemiBlockElement (name,xh_attrs,xh_taglist))::queue ->
182
xh_print_semiblocktag id name xh_attrs xh_taglist i
183
(fun () -> xh_print_taglist queue i false removetailingws cont)
185
(* Nodes and Leafs *)
186
| (Whitespace ws1)::(Node (name,xh_attrs,xh_taglist))::(Whitespace ws2)::queue ->
187
print_nodes ws1 name xh_attrs xh_taglist ws2 queue i is_first removetailingws cont
189
| (Node (name,xh_attrs,xh_taglist))::(Whitespace ws2)::queue ->
190
print_nodes "" name xh_attrs xh_taglist ws2 queue i is_first removetailingws cont
192
| (Whitespace ws1)::(Node (name,xh_attrs,xh_taglist))::queue ->
193
print_nodes ws1 name xh_attrs xh_taglist "" queue i is_first removetailingws cont
195
| (Node (name,xh_attrs,xh_taglist))::queue ->
196
print_nodes "" name xh_attrs xh_taglist "" queue i is_first removetailingws cont
198
| (Whitespace ws1)::(Leaf (name,xh_attrs))::(Whitespace ws2)::queue ->
199
print_nodes ws1 name xh_attrs [] ws2 queue i is_first removetailingws cont
201
| (Leaf (name,xh_attrs))::(Whitespace ws2)::queue ->
202
print_nodes "" name xh_attrs [] ws2 queue i is_first removetailingws cont
204
| (Whitespace ws1)::(Leaf (name,xh_attrs))::queue ->
205
print_nodes ws1 name xh_attrs [] "" queue i is_first removetailingws cont
207
| (Leaf (name,xh_attrs))::queue ->
208
print_nodes "" name xh_attrs [] "" queue i is_first removetailingws cont
211
| (Whitespace(texte))::queue ->
212
xh_print_text (encode texte) i is_first
213
(fun () -> xh_print_taglist queue i false removetailingws cont)
216
xh_print_taglist queue i false removetailingws cont
221
xh_print_taglist [arbre] 0 true false cont
223
((fun ?(width = 132) ?(encode = encode_unsafe)
224
?html_compat doctype foret ->
227
(fun arbre cont () ->
228
aux ?width ?encode ?html_compat arbre cont)
231
(fun () -> Ocsigen_stream.empty None))),
234
(fun ?(width = 132) ?(encode = encode_unsafe)
235
?html_compat doctype arbre ->
237
Ocsigen_stream.cont doctype
238
(fun () -> Ocsigen_stream.cont ocsigenadv
241
aux ?width ?encode ?html_compat arbre
243
(fun () -> Ocsigen_stream.empty None)))))
245
let xhtml_stream ?(version=`XHTML_01_01) ?width ?encode ?html_compat arbre =
248
xh_stream ?width ?encode ?html_compat
249
(XHTML.M.doctype version) (XHTML.M.toelt arbre))
251
let xhtml_list_stream ?(version=`XHTML_01_01)
252
?width ?encode ?html_compat foret =
255
x_stream ?width ?encode ?html_compat
256
(XHTML.M.doctype version) (XHTML.M.toeltl foret) ())
added
removed
xmlp4/xhtmlpretty_streams.ml
