You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
362 lines
15 KiB
362 lines
15 KiB
Backported from:
|
|
|
|
commit 4edaf2275e2f7a027f3c7dc52e1e295a6e56b19a
|
|
Author: Vasilis Papavasileiou <git@vasilis.airpost.net>
|
|
Date: Thu Aug 18 19:40:56 2016 +0200
|
|
|
|
Fix ocsigen/js_of_ocaml#518
|
|
|
|
upstream.
|
|
|
|
Index: eliom-5.0.0/src/lib/eliom_client.client.ml
|
|
===================================================================
|
|
--- eliom-5.0.0.orig/src/lib/eliom_client.client.ml
|
|
+++ eliom-5.0.0/src/lib/eliom_client.client.ml
|
|
@@ -461,23 +461,29 @@ let raw_event_handler value =
|
|
|
|
let closure_name_prefix = Eliom_lib_base.RawXML.closure_name_prefix
|
|
let closure_name_prefix_len = String.length closure_name_prefix
|
|
-let reify_caml_event name node ce : string * (#Dom_html.event Js.t -> bool) =
|
|
+let reify_caml_event name node ce =
|
|
match ce with
|
|
- | Xml.CE_call_service None -> name,(fun _ -> true)
|
|
+ | Xml.CE_call_service None -> name, `Other (fun _ -> true)
|
|
| Xml.CE_call_service (Some (`A, cookies_info, tmpl)) ->
|
|
- name, (fun ev ->
|
|
+ name, `Other (fun ev ->
|
|
let node = Js.Opt.get (Dom_html.CoerceTo.a node)
|
|
(fun () -> Lwt_log.raise_error ~section "not an anchor element")
|
|
in
|
|
raw_a_handler node cookies_info tmpl ev)
|
|
| Xml.CE_call_service
|
|
(Some ((`Form_get | `Form_post) as kind, cookies_info, tmpl)) ->
|
|
- name, (fun ev ->
|
|
+ name, `Other (fun ev ->
|
|
let form = Js.Opt.get (Dom_html.CoerceTo.form node)
|
|
(fun () -> Lwt_log.raise_error ~section "not a form element") in
|
|
raw_form_handler form kind cookies_info tmpl ev)
|
|
| Xml.CE_client_closure f ->
|
|
- name, (fun ev -> try f ev; true with False -> false)
|
|
+ name, `Other (fun ev -> try f ev; true with False -> false)
|
|
+ | Xml.CE_client_closure_keyboard f ->
|
|
+ name,
|
|
+ `Keyboard (fun ev -> try f ev; true with Eliom_lib.False -> false)
|
|
+ | Xml.CE_client_closure_mouse f ->
|
|
+ name,
|
|
+ `Mouse (fun ev -> try f ev; true with Eliom_lib.False -> false)
|
|
| Xml.CE_registered_closure (_, cv) ->
|
|
let name =
|
|
let len = String.length name in
|
|
@@ -485,16 +491,27 @@ let reify_caml_event name node ce : stri
|
|
then String.sub name closure_name_prefix_len
|
|
(len - closure_name_prefix_len)
|
|
else name in
|
|
- name, raw_event_handler cv
|
|
+ name, `Other (raw_event_handler cv)
|
|
|
|
let register_event_handler, flush_load_script =
|
|
let add, _, flush = create_buffer () in
|
|
let register node (name, ev) =
|
|
- let name,f = reify_caml_event name node ev in
|
|
- if name = "onload"
|
|
- then add f
|
|
- else Js.Unsafe.set node (Js.bytestring name)
|
|
- (Dom_html.handler (fun ev -> Js.bool (f ev)))
|
|
+ match reify_caml_event name node ev with
|
|
+ | "onload", `Other f ->
|
|
+ add f
|
|
+ | "onload", `Keyboard _ ->
|
|
+ failwith "keyboard event handler for onload"
|
|
+ | "onload", `Mouse _ ->
|
|
+ failwith "keyboard event handler for onload"
|
|
+ | name, `Other f ->
|
|
+ Js.Unsafe.set node (Js.bytestring name)
|
|
+ (Dom_html.handler (fun ev -> Js.bool (f ev)))
|
|
+ | name, `Keyboard f ->
|
|
+ Js.Unsafe.set node (Js.bytestring name)
|
|
+ (Dom_html.handler (fun ev -> Js.bool (f ev)))
|
|
+ | name, `Mouse f ->
|
|
+ Js.Unsafe.set node (Js.bytestring name)
|
|
+ (Dom_html.handler (fun ev -> Js.bool (f ev)))
|
|
in
|
|
let flush () =
|
|
let fs = flush () in
|
|
Index: eliom-5.0.0/src/lib/eliom_content.server.mli
|
|
===================================================================
|
|
--- eliom-5.0.0.orig/src/lib/eliom_content.server.mli
|
|
+++ eliom-5.0.0/src/lib/eliom_content.server.mli
|
|
@@ -114,7 +114,7 @@ module Xml : sig
|
|
example {% <<a_api project="js_of_ocaml" | type
|
|
Dom_html.mouseEvent>>%} or {% <<a_api project="js_of_ocaml" | type
|
|
Dom_html.keyboardEvent >>%}. *)
|
|
- type -'a caml_event_handler constraint 'a = #Dom_html.event
|
|
+ type caml_event_handler
|
|
|
|
(**/**)
|
|
|
|
@@ -129,18 +129,14 @@ module Xml : sig
|
|
val make_event_handler_table : elt -> Eliom_lib.RawXML.event_handler_table
|
|
val make_client_attrib_table : elt -> Eliom_lib.RawXML.client_attrib_table
|
|
|
|
- val caml_event_handler : ((#Dom_html.event as 'a) Js.t -> unit) Eliom_lib.client_value -> 'a caml_event_handler
|
|
-
|
|
- class type biggest_event = object
|
|
- inherit Dom_html.event
|
|
- inherit Dom_html.mouseEvent
|
|
- inherit Dom_html.keyboardEvent
|
|
- end
|
|
+ val caml_event_handler :
|
|
+ (Dom_html.event Js.t -> unit) Eliom_lib.client_value ->
|
|
+ caml_event_handler
|
|
|
|
type racontent =
|
|
| RA of acontent
|
|
| RAReact of acontent option React.signal
|
|
- | RACamlEventHandler of biggest_event caml_event_handler
|
|
+ | RACamlEventHandler of caml_event_handler
|
|
| RALazyStr of string Eliom_lazy.request
|
|
| RALazyStrL of separator * string Eliom_lazy.request list
|
|
| RAClient of string * attrib option * Eliom_lib.poly
|
|
Index: eliom-5.0.0/src/lib/eliom_content_core.client.ml
|
|
===================================================================
|
|
--- eliom-5.0.0.orig/src/lib/eliom_content_core.client.ml
|
|
+++ eliom-5.0.0/src/lib/eliom_content_core.client.ml
|
|
@@ -87,21 +87,19 @@ module Xml = struct
|
|
let node ?(a = []) name children = make (Node (name, a, children))
|
|
let lazy_node ?a name children = node ?a name (Eliom_lazy.force children)
|
|
|
|
- type biggest_event_handler = biggest_event Js.t -> unit
|
|
-
|
|
type event_handler = Dom_html.event Js.t -> unit
|
|
type mouse_event_handler = Dom_html.mouseEvent Js.t -> unit
|
|
type keyboard_event_handler = Dom_html.keyboardEvent Js.t -> unit
|
|
|
|
let event_handler_attrib name (value : event_handler) =
|
|
internal_event_handler_attrib name
|
|
- (Caml (CE_client_closure (value :> biggest_event_handler)))
|
|
+ (Caml (CE_client_closure value))
|
|
let mouse_event_handler_attrib name (value : mouse_event_handler) =
|
|
internal_event_handler_attrib name
|
|
- (Caml (CE_client_closure (value :> biggest_event_handler)))
|
|
+ (Caml (CE_client_closure_mouse value))
|
|
let keyboard_event_handler_attrib name (value : keyboard_event_handler) =
|
|
internal_event_handler_attrib name
|
|
- (Caml (CE_client_closure (value :> biggest_event_handler)))
|
|
+ (Caml (CE_client_closure_keyboard value))
|
|
|
|
let node_react_children ?(a = []) name children =
|
|
{elt = Lazy.from_val (ReactChildren (Node (name,a,[]),children)); node_id=NoId}
|
|
Index: eliom-5.0.0/src/lib/eliom_content_core.client.mli
|
|
===================================================================
|
|
--- eliom-5.0.0.orig/src/lib/eliom_content_core.client.mli
|
|
+++ eliom-5.0.0/src/lib/eliom_content_core.client.mli
|
|
@@ -35,24 +35,21 @@ module Xml : sig
|
|
type aname = string
|
|
type attrib
|
|
|
|
- type -'a caml_event_handler =
|
|
+ type caml_event_handler =
|
|
| CE_registered_closure of string * Eliom_lib.poly
|
|
(* 'a Js.t -> unit) client_value_server *)
|
|
- | CE_client_closure of ((#Dom_html.event as 'a) Js.t -> unit)
|
|
+ | CE_client_closure of
|
|
+ (Dom_html.event Js.t -> unit) (* Client side-only *)
|
|
+ | CE_client_closure_mouse of
|
|
+ (Dom_html.mouseEvent Js.t -> unit) (* Client side-only *)
|
|
+ | CE_client_closure_keyboard of
|
|
+ (Dom_html.keyboardEvent Js.t -> unit) (* Client side-only *)
|
|
| CE_call_service of
|
|
([ `A | `Form_get | `Form_post] * (bool * string list) option * string option) option Eliom_lazy.request
|
|
|
|
- (* Inherit from all events.
|
|
- Necessary for subtyping since caml_event_handler is contravariant. *)
|
|
- class type biggest_event = object
|
|
- inherit Dom_html.event
|
|
- inherit Dom_html.mouseEvent
|
|
- inherit Dom_html.keyboardEvent
|
|
- end
|
|
-
|
|
type internal_event_handler =
|
|
| Raw of string
|
|
- | Caml of biggest_event caml_event_handler
|
|
+ | Caml of caml_event_handler
|
|
type event_handler = Dom_html.event Js.t -> unit
|
|
type mouse_event_handler = Dom_html.mouseEvent Js.t -> unit
|
|
type keyboard_event_handler = Dom_html.keyboardEvent Js.t -> unit
|
|
@@ -89,7 +86,7 @@ module Xml : sig
|
|
type racontent =
|
|
| RA of acontent
|
|
| RAReact of acontent option React.signal
|
|
- | RACamlEventHandler of biggest_event caml_event_handler
|
|
+ | RACamlEventHandler of caml_event_handler
|
|
| RALazyStr of string Eliom_lazy.request
|
|
| RALazyStrL of separator * string Eliom_lazy.request list
|
|
| RAClient of string * attrib option * Eliom_lib.poly
|
|
Index: eliom-5.0.0/src/lib/eliom_content_core.server.ml
|
|
===================================================================
|
|
--- eliom-5.0.0.orig/src/lib/eliom_content_core.server.ml
|
|
+++ eliom-5.0.0/src/lib/eliom_content_core.server.ml
|
|
@@ -114,7 +114,6 @@ module Xml = struct
|
|
let lazy_node ?(a = []) name children =
|
|
make_lazy (Eliom_lazy.from_fun (fun () -> (Node (name, a, Eliom_lazy.force children))))
|
|
|
|
- type biggest_event_handler = (biggest_event Js.t -> unit) Eliom_lib.client_value
|
|
type event_handler = (Dom_html.event Js.t -> unit) Eliom_lib.client_value
|
|
type mouse_event_handler = (Dom_html.mouseEvent Js.t -> unit) Eliom_lib.client_value
|
|
type keyboard_event_handler = (Dom_html.keyboardEvent Js.t -> unit) Eliom_lib.client_value
|
|
@@ -133,11 +132,11 @@ module Xml = struct
|
|
let biggest_event_handler_attrib name cf =
|
|
internal_event_handler_attrib name (event_handler cf)
|
|
let event_handler_attrib name (cf : event_handler) =
|
|
- biggest_event_handler_attrib name (cf :> biggest_event_handler)
|
|
+ biggest_event_handler_attrib name cf
|
|
let mouse_event_handler_attrib name (cf : mouse_event_handler) =
|
|
- biggest_event_handler_attrib name (cf :> biggest_event_handler)
|
|
+ biggest_event_handler_attrib name cf
|
|
let keyboard_event_handler_attrib name (cf : keyboard_event_handler) =
|
|
- biggest_event_handler_attrib name (cf :> biggest_event_handler)
|
|
+ biggest_event_handler_attrib name cf
|
|
|
|
let client_attrib ?init (x : attrib Eliom_lib.client_value) =
|
|
let crypto = make_cryptographic_safe_string () in
|
|
Index: eliom-5.0.0/src/lib/eliom_content_core.server.mli
|
|
===================================================================
|
|
--- eliom-5.0.0.orig/src/lib/eliom_content_core.server.mli
|
|
+++ eliom-5.0.0/src/lib/eliom_content_core.server.mli
|
|
@@ -28,7 +28,7 @@ module Xml : sig
|
|
and type mouse_event_handler = (Dom_html.mouseEvent Js.t -> unit) Eliom_lib.client_value
|
|
and type keyboard_event_handler = (Dom_html.keyboardEvent Js.t -> unit) Eliom_lib.client_value
|
|
|
|
- type -'a caml_event_handler constraint 'a = #Dom_html.event
|
|
+ type caml_event_handler
|
|
|
|
(**/**)
|
|
|
|
@@ -43,15 +43,9 @@ module Xml : sig
|
|
val make_event_handler_table : elt -> Eliom_lib.RawXML.event_handler_table
|
|
val make_client_attrib_table : elt -> Eliom_lib.RawXML.client_attrib_table
|
|
|
|
- class type biggest_event = object
|
|
- inherit Dom_html.event
|
|
- inherit Dom_html.mouseEvent
|
|
- inherit Dom_html.keyboardEvent
|
|
- end
|
|
-
|
|
type internal_event_handler =
|
|
| Raw of string
|
|
- | Caml of biggest_event caml_event_handler
|
|
+ | Caml of caml_event_handler
|
|
|
|
val internal_event_handler_attrib : aname -> internal_event_handler -> attrib
|
|
val internal_event_handler_of_service :
|
|
@@ -59,12 +53,14 @@ module Xml : sig
|
|
* (bool * string list) option
|
|
* string option) option Eliom_lazy.request -> internal_event_handler
|
|
|
|
- val caml_event_handler : ((#Dom_html.event as 'a) Js.t -> unit) Eliom_lib.client_value -> 'a caml_event_handler
|
|
+ val caml_event_handler :
|
|
+ (Dom_html.event Js.t -> unit) Eliom_lib.client_value ->
|
|
+ caml_event_handler
|
|
|
|
type racontent =
|
|
| RA of acontent
|
|
| RAReact of acontent option React.signal
|
|
- | RACamlEventHandler of biggest_event caml_event_handler
|
|
+ | RACamlEventHandler of caml_event_handler
|
|
| RALazyStr of string Eliom_lazy.request
|
|
| RALazyStrL of separator * string Eliom_lazy.request list
|
|
| RAClient of string * attrib option * Eliom_lib.poly
|
|
Index: eliom-5.0.0/src/lib/eliom_lib_base.shared.ml
|
|
===================================================================
|
|
--- eliom-5.0.0.orig/src/lib/eliom_lib_base.shared.ml
|
|
+++ eliom-5.0.0/src/lib/eliom_lib_base.shared.ml
|
|
@@ -70,26 +70,22 @@ module RawXML = struct
|
|
|
|
type cookie_info = (bool * string list) deriving (Json)
|
|
|
|
- type -'a caml_event_handler =
|
|
+ type caml_event_handler =
|
|
| CE_registered_closure of
|
|
string * poly (* 'a Js.t -> unit) client_value *)
|
|
| CE_client_closure of
|
|
- ((#Dom_html.event as 'a) Js.t -> unit) (* Client side-only *)
|
|
+ (Dom_html.event Js.t -> unit) (* Client side-only *)
|
|
+ | CE_client_closure_mouse of
|
|
+ (Dom_html.mouseEvent Js.t -> unit) (* Client side-only *)
|
|
+ | CE_client_closure_keyboard of
|
|
+ (Dom_html.keyboardEvent Js.t -> unit) (* Client side-only *)
|
|
| CE_call_service of
|
|
([ `A | `Form_get | `Form_post] * (cookie_info option) * string option)
|
|
option Eliom_lazy.request
|
|
|
|
- (* Inherit from all events.
|
|
- Necessary for subtyping since caml_event_handler is contravariant. *)
|
|
- class type biggest_event = object
|
|
- inherit Dom_html.event
|
|
- inherit Dom_html.mouseEvent
|
|
- inherit Dom_html.keyboardEvent
|
|
- end
|
|
-
|
|
type internal_event_handler =
|
|
| Raw of string
|
|
- | Caml of biggest_event caml_event_handler
|
|
+ | Caml of caml_event_handler
|
|
|
|
type uri = string Eliom_lazy.request
|
|
let string_of_uri = Eliom_lazy.force
|
|
@@ -128,7 +124,7 @@ module RawXML = struct
|
|
type racontent =
|
|
| RA of acontent
|
|
| RAReact of acontent option React.signal
|
|
- | RACamlEventHandler of biggest_event caml_event_handler
|
|
+ | RACamlEventHandler of caml_event_handler
|
|
| RALazyStr of string Eliom_lazy.request
|
|
| RALazyStrL of separator * string Eliom_lazy.request list
|
|
| RAClient of string * attrib option * poly (*attrib client_value *)
|
|
Index: eliom-5.0.0/src/lib/eliom_lib_base.shared.mli
|
|
===================================================================
|
|
--- eliom-5.0.0.orig/src/lib/eliom_lib_base.shared.mli
|
|
+++ eliom-5.0.0/src/lib/eliom_lib_base.shared.mli
|
|
@@ -73,24 +73,21 @@ module RawXML : sig
|
|
|
|
type cookie_info = (bool * string list) deriving (Json)
|
|
|
|
- type -'a caml_event_handler =
|
|
+ type caml_event_handler =
|
|
| CE_registered_closure of
|
|
string * poly (* 'a Js.t -> unit) client_value *)
|
|
- | CE_client_closure of ((#Dom_html.event as 'a) Js.t -> unit)
|
|
+ | CE_client_closure of
|
|
+ (Dom_html.event Js.t -> unit) (* Client side-only *)
|
|
+ | CE_client_closure_mouse of
|
|
+ (Dom_html.mouseEvent Js.t -> unit) (* Client side-only *)
|
|
+ | CE_client_closure_keyboard of
|
|
+ (Dom_html.keyboardEvent Js.t -> unit) (* Client side-only *)
|
|
| CE_call_service of
|
|
([ `A | `Form_get | `Form_post] * (cookie_info option) * string option) option Eliom_lazy.request
|
|
|
|
- (* Inherit from all events.
|
|
- Necessary for subtyping since caml_event_handler is contravariant. *)
|
|
- class type biggest_event = object
|
|
- inherit Dom_html.event
|
|
- inherit Dom_html.mouseEvent
|
|
- inherit Dom_html.keyboardEvent
|
|
- end
|
|
-
|
|
type internal_event_handler =
|
|
| Raw of string
|
|
- | Caml of biggest_event caml_event_handler
|
|
+ | Caml of caml_event_handler
|
|
|
|
type uri = string Eliom_lazy.request
|
|
val string_of_uri : uri -> string
|
|
@@ -127,7 +124,7 @@ module RawXML : sig
|
|
type racontent =
|
|
| RA of acontent
|
|
| RAReact of acontent option React.signal
|
|
- | RACamlEventHandler of biggest_event caml_event_handler
|
|
+ | RACamlEventHandler of caml_event_handler
|
|
| RALazyStr of string Eliom_lazy.request
|
|
| RALazyStrL of separator * string Eliom_lazy.request list
|
|
| RAClient of string * attrib option * poly (* attrib client_value *)
|