1
2
3
4
5
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
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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
(* TyXML
* http://www.ocsigen.org/tyxml
* Copyright (C) 2004 Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
* Copyright (C) 2007 Gabriel Kerneis
* Copyright (C) 2010 Cecile Herbelin
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02111-1307, USA.
*)
(** Attributes *)
module M = struct
type uri = string
let uri_of_string s = s
let string_of_uri s = s
type separator = Space | Comma
type aname = string
type acontent =
| AFloat of float
| AInt of int
| AStr of string
| AStrL of separator * string list
type attrib = aname * acontent
type event_handler = string
let acontent (_, a) = a
let aname (name, _) = name
let float_attrib name value = name, AFloat value
let int_attrib name value = name, AInt value
let string_attrib name value = name, AStr value
let space_sep_attrib name values = name, AStrL (Space, values)
let comma_sep_attrib name values = name, AStrL (Comma, values)
let event_handler_attrib name value = name, AStr value
let uri_attrib name value = name, AStr value
let uris_attrib name values = name, AStrL (Space, values)
(* Deprecated alias. *)
let event_attrib = event_handler_attrib
(** Element *)
type ename = string
type econtent =
| Empty
| Comment of string
| EncodedPCDATA of string
| PCDATA of string
| Entity of string
| Leaf of ename * attrib list
| Node of ename * attrib list * elt list
and elt = {
elt : econtent ;
}
let content elt = elt.elt
let empty () = { elt = Empty }
let comment c = { elt = Comment c }
let pcdata d = { elt = PCDATA d }
let encodedpcdata d = { elt = EncodedPCDATA d }
let entity e = { elt = Entity e }
let cdata s = (* GK *)
(* For security reasons, we do not allow "]]>" inside CDATA
(as this string is to be considered as the end of the cdata)
*)
let s' = "\n<![CDATA[\n"^
(Netstring_pcre.global_replace
(Netstring_pcre.regexp_string "]]>") "" s)
^"\n]]>\n" in
encodedpcdata s'
let cdata_script s = (* GK *)
(* For security reasons, we do not allow "]]>" inside CDATA
(as this string is to be considered as the end of the cdata)
*)
let s' = "\n//<![CDATA[\n"^
(Netstring_pcre.global_replace
(Netstring_pcre.regexp_string "]]>") "" s)
^"\n//]]>\n" in
encodedpcdata s'
let cdata_style s = (* GK *)
(* For security reasons, we do not allow "]]>" inside CDATA
(as this string is to be considered as the end of the cdata)
*)
let s' = "\n/* <![CDATA[ */\n"^
(Netstring_pcre.global_replace
(Netstring_pcre.regexp_string "]]>") "" s)
^"\n/* ]]> */\n" in
encodedpcdata s'
let leaf ?a name =
{ elt =
(match a with
| Some a -> Leaf (name, a)
| None -> Leaf (name, [])) }
let node ?a name children =
{ elt =
(match a with
| Some a -> Node (name, a, children)
| None -> Node (name, [], children)) }
end
include M
include Xml_print.Make_simple(M)(struct let emptytags = [] end)
include Xml_iter.Make(M)
let print fmt x = print_list ~output:(Format.pp_print_string fmt) [x]
let print fmt x = Format.fprintf fmt "<< %a >>" print x
|
