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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
commit ebf7150f41c64ac0e18e9f89d1e565b6c3115414
Author: Vasilis Papavasileiou <git@vasilis.airpost.net>
Date: Thu Aug 6 11:52:11 2015 +0200
up-to-date version of @drup's new-style wrapping (ocsigen/tyxml#58)
diff --git a/lib/tyxml/tyxml_js.ml b/lib/tyxml/tyxml_js.ml
index 0143219..4799600 100644
--- a/lib/tyxml/tyxml_js.ml
+++ b/lib/tyxml/tyxml_js.ml
@@ -20,8 +20,19 @@
let js_string_of_float f = (Js.number_of_float f)##toString()
let js_string_of_int i = (Js.number_of_float (float_of_int i))##toString()
+
+module type XML =
+ Xml_sigs.T
+ with type uri = string
+ and type event_handler = Dom_html.event Js.t -> bool
+ and type mouse_event_handler = Dom_html.mouseEvent Js.t -> bool
+ and type keyboard_event_handler = Dom_html.keyboardEvent Js.t -> bool
+ and type elt = Dom.node Js.t
+
+
module Xml = struct
+ module W = Xml_wrap.NoWrap
type 'a wrap = 'a
type 'a list_wrap = 'a list
@@ -162,7 +173,6 @@ module Xml_wrap = struct
let append x y = ReactiveData.RList.concat x y
end
-
module Util = struct
open ReactiveData
open RList
@@ -226,9 +236,23 @@ end
module R = struct
- module Xml_wed = struct
- type 'a wrap = 'a Xml_wrap.t
- type 'a list_wrap = 'a Xml_wrap.tlist
+
+ let filter_attrib (name,a) on =
+ match a with
+ | Xml.Event _ ->
+ raise (Invalid_argument "filter_attrib not implemented for event handler")
+ | Xml.Attr a ->
+ name,
+ Xml.Attr
+ (React.S.l2
+ (fun on a -> if on then a else None) on a)
+
+ let attach_attribs = Xml.attach_attribs
+
+ module Xml = struct
+ module W = Xml_wrap
+ type 'a wrap = 'a W.t
+ type 'a list_wrap = 'a W.tlist
type uri = Xml.uri
let string_of_uri = Xml.string_of_uri
let uri_of_string = Xml.uri_of_string
@@ -239,7 +263,7 @@ module R = struct
type attrib = Xml.attrib
let attr name f s =
- let a = Xml_wrap.fmap f s in
+ let a = W.fmap f s in
name,Xml.Attr a
let float_attrib name s = attr name (fun f -> Some (js_string_of_float f)) s
@@ -267,7 +291,7 @@ module R = struct
let leaf = Xml.leaf
let node ?(a=[]) name l =
let e = Dom_html.document##createElement(Js.string name) in
- Xml.attach_attribs e a;
+ attach_attribs e a;
Util.update_children (e :> Dom.node Js.t) l;
(e :> Dom.node Js.t)
let cdata = Xml.cdata
@@ -275,30 +299,22 @@ module R = struct
let cdata_style = Xml.cdata_style
end
- module Xml_wed_svg = struct
- include Xml_wed
+ module Xml_Svg = struct
+ include Xml
let leaf = Xml_Svg.leaf
let node ?(a = []) name l =
let e =
Dom_html.document##createElementNS(Dom_svg.xmlns,Js.string name) in
- Xml.attach_attribs e a;
+ attach_attribs e a;
Util.update_children (e :> Dom.node Js.t) l;
(e :> Dom.node Js.t)
end
- module Svg = Svg_f.MakeWrapped(Xml_wrap)(Xml_wed_svg)
- module Html5 = Html5_f.MakeWrapped(Xml_wrap)(Xml_wed)(Svg)
- let filter_attrib (name,a) on =
- match a with
- | Xml.Event _ ->
- raise (Invalid_argument "filter_attrib not implemented for event handler")
- | Xml.Attr a ->
- name,
- Xml.Attr
- (React.S.l2
- (fun on a -> if on then a else None) on a)
+ module Svg = Svg_f.Make(Xml_Svg)
+ module Html5 = Html5_f.Make(Xml)(Svg)
+
end
module To_dom = Tyxml_cast.MakeTo(struct
diff --git a/lib/tyxml/tyxml_js.mli b/lib/tyxml/tyxml_js.mli
index b3323cc..8cb33c5 100644
--- a/lib/tyxml/tyxml_js.mli
+++ b/lib/tyxml/tyxml_js.mli
@@ -37,13 +37,16 @@
@see <https://ocsigen.org/tyxml/dev/api/Html5_sigs.T> Html5_sigs.T to have a list of available functions to build HTML.
*)
-module Xml : Xml_sigs.T
+module type XML =
+ Xml_sigs.T
with type uri = string
and type event_handler = Dom_html.event Js.t -> bool
and type mouse_event_handler = Dom_html.mouseEvent Js.t -> bool
and type keyboard_event_handler = Dom_html.keyboardEvent Js.t -> bool
and type elt = Dom.node Js.t
+module Xml : XML with module W = Xml_wrap.NoWrap
+
module Xml_wrap : Xml_wrap.T
with type 'a t = 'a React.signal
and type 'a tlist = 'a ReactiveData.RList.t
@@ -57,10 +60,13 @@ module Svg : Svg_sigs.Make(Xml).T
module Html5 : Html5_sigs.Make(Xml)(Svg).T
module R : sig
- module Svg : Svg_sigs.MakeWrapped(Xml_wrap)(Xml).T
+ module Xml : XML with module W = Xml_wrap
+
+ module Svg : Svg_sigs.Make(Xml).T
with type +'a elt = 'a Svg.elt
and type +'a attrib = 'a Svg.attrib
- module Html5 : Html5_sigs.MakeWrapped(Xml_wrap)(Xml)(Svg).T
+
+ module Html5 : Html5_sigs.Make(Xml)(Svg).T
with type +'a elt = 'a Html5.elt
and type +'a attrib = 'a Html5.attrib
val filter_attrib : 'a Html5.attrib -> bool React.signal -> 'a Html5.attrib
|
GitWeb