Lib: Add support for 'addEventListener' with options (#807)

Author: clembu

CHANGES

@@ -11,6 +11,7 @@
  ** Misc: remove cppo dependency
  ** Misc: remove ppx_tools_versioned dependency in ppx_deriving_json
  ** Misc: support for ocaml 4.09
+ ** Lib: Add support for 'addEventListener' with options
 
  * Bug fixes:
  ** Compiler: don't generate source if no-source-map passed (#780)

lib/js_of_ocaml/dom.ml

@@ -352,16 +352,37 @@ end
 
 type event_listener_id = unit -> unit
 
-let addEventListener (e : (< .. > as 'a) t) typ h capt =
+class type event_listener_options =
+  object
+    method capture : bool t writeonly_prop
+
+    method once : bool t writeonly_prop
+
+    method passive : bool t writeonly_prop
+  end
+
+let addEventListenerWithOptions (e : (< .. > as 'a) t) typ ?capture ?once ?passive h =
   if (Js.Unsafe.coerce e)##.addEventListener == Js.undefined
   then
     let ev = (Js.string "on")##concat typ in
     let callback e = Js.Unsafe.call (h, e, [||]) in
     let () = (Js.Unsafe.coerce e)##attachEvent ev callback in
     fun () -> (Js.Unsafe.coerce e)##detachEvent ev callback
   else
-    let () = (Js.Unsafe.coerce e)##addEventListener typ h capt in
-    fun () -> (Js.Unsafe.coerce e)##removeEventListener typ h capt
+    let opts : event_listener_options t = Js.Unsafe.obj [||] in
+    let iter t f =
+      match t with
+      | None -> ()
+      | Some b -> f b
+    in
+    iter capture (fun b -> opts##.capture := b);
+    iter once (fun b -> opts##.once := b);
+    iter passive (fun b -> opts##.passive := b);
+    let () = (Js.Unsafe.coerce e)##addEventListener typ h opts in
+    fun () -> (Js.Unsafe.coerce e)##removeEventListener typ h opts
+
+let addEventListener (e : (< .. > as 'a) t) typ h capt =
+  addEventListenerWithOptions e typ ~capture:capt h
 
 let removeEventListener id = id ()
 

lib/js_of_ocaml/dom.mli

@@ -334,15 +334,27 @@ module Event : sig
   val make : string -> 'a typ
 end
 
+val addEventListenerWithOptions :
+     (< .. > t as 'a)
+  -> 'b Event.typ
+  -> ?capture:bool t
+  -> ?once:bool t
+  -> ?passive:bool t
+  -> ('a, 'b) event_listener
+  -> event_listener_id
+(** Add an event listener.  This function matches the
+      option-object variant of the [addEventListener] DOM method,
+      except that it returns an id for removing the listener. *)
+
 val addEventListener :
      (< .. > t as 'a)
   -> 'b Event.typ
   -> ('a, 'b) event_listener
   -> bool t
   -> event_listener_id
 (** Add an event listener.  This function matches the
-      [addEventListener] DOM method, except that it returns
-      an id for removing the listener. *)
+      useCapture boolean variant of the [addEventListener] DOM method,
+      except that it returns an id for removing the listener. *)
 
 val removeEventListener : event_listener_id -> unit
 (** Remove the given event listener. *)

lib/js_of_ocaml/dom_html.ml

@@ -816,6 +816,8 @@ type event_listener_id = Dom.event_listener_id
 
 let addEventListener = Dom.addEventListener
 
+let addEventListenerWithOptions = Dom.addEventListenerWithOptions
+
 let removeEventListener = Dom.removeEventListener
 
 class type ['node] collection =

lib/js_of_ocaml/dom_html.mli

@@ -2365,15 +2365,27 @@ end
 
 type event_listener_id = Dom.event_listener_id
 
+val addEventListenerWithOptions :
+     (#eventTarget t as 'a)
+  -> 'b Event.typ
+  -> ?capture:bool t
+  -> ?once:bool t
+  -> ?passive:bool t
+  -> ('a, 'b) event_listener
+  -> event_listener_id
+(** Add an event listener.  This function matches the
+      option-object variant of the [addEventListener] DOM method,
+      except that it returns an id for removing the listener. *)
+
 val addEventListener :
      (#eventTarget t as 'a)
   -> 'b Event.typ
   -> ('a, 'b) event_listener
   -> bool t
   -> event_listener_id
 (** Add an event listener.  This function matches the
-      [addEventListener] DOM method, except that it returns
-      an id for removing the listener. *)
+      useCapture boolean variant of the [addEventListener] DOM method,
+      except that it returns an id for removing the listener. *)
 
 val removeEventListener : event_listener_id -> unit
 (** Remove the given event listener. *)