From a7414e5ca3af67d88a543c99f65a6e0b588cd44a Mon Sep 17 00:00:00 2001
From: Sylvain Boilard <boilard@crans.org>
Date: Fri, 15 Nov 2024 03:58:48 +0100
Subject: [PATCH] Lib: implement popover API. (#1734)

See:
- https://html.spec.whatwg.org/multipage/popover.html ;
- https://developer.mozilla.org/en-US/docs/Web/API/Popover_API .
---
 CHANGES.md                   |  1 +
 lib/js_of_ocaml/dom_html.ml  | 30 ++++++++++++++++++++++++++++--
 lib/js_of_ocaml/dom_html.mli | 30 ++++++++++++++++++++++++++++--
 3 files changed, 57 insertions(+), 4 deletions(-)

diff --git a/CHANGES.md b/CHANGES.md
index 83b2dab691..391d8652a2 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -39,6 +39,7 @@
 * Runtime: reimplement the runtime of weak and ephemeron (#1707)
 * Lib: Modify Typed_array API for compatibility with WebAssembly
 * Lib: add details element and toggle event (#1728)
+* Lib: implement popover API (#1734)
 * Toplevel: no longer set globals for toplevel initialization
 * Runtime: precompute constants used in `caml_lxm_next` (#1730)
 * Runtime: cleanup runtime
diff --git a/lib/js_of_ocaml/dom_html.ml b/lib/js_of_ocaml/dom_html.ml
index cf9bdf827f..7fc2f7a30b 100644
--- a/lib/js_of_ocaml/dom_html.ml
+++ b/lib/js_of_ocaml/dom_html.ml
@@ -557,6 +557,10 @@ and eventTarget = object ('self)
 
   method onpointerup : ('self t, pointerEvent t) event_listener writeonly_prop
 
+  method onbeforetoggle : ('self t, toggleEvent t) event_listener writeonly_prop
+
+  method ontoggle : ('self t, toggleEvent t) event_listener writeonly_prop
+
   method dispatchEvent : event t -> bool t meth
 end
 
@@ -735,6 +739,8 @@ and element = object
 
   method scrollHeight : int prop
 
+  method popover : js_string t opt prop
+
   method getClientRects : clientRectList t meth
 
   method getBoundingClientRect : clientRect t meth
@@ -747,6 +753,18 @@ and element = object
 
   method blur : unit meth
 
+  method hidePopover : unit meth
+
+  method showPopover : unit meth
+
+  method showPopover_options : _ -> unit meth
+
+  method togglePopover : bool t meth
+
+  method togglePopover_force : bool t -> bool t meth
+
+  method togglePopover_options : _ -> bool t meth
+
   inherit eventTarget
 end
 
@@ -967,6 +985,8 @@ module Event = struct
 
   let waiting = Dom.Event.make "waiting"
 
+  let beforetoggle = Dom.Event.make "beforetoggle"
+
   let toggle = Dom.Event.make "toggle"
 
   let make = Dom.Event.make
@@ -1197,6 +1217,10 @@ class type inputElement = object ('self)
 
   method selectionEnd : int prop
 
+  method popovertarget : element t opt prop
+
+  method popovertargetaction : js_string t prop
+
   method onselect : ('self t, event t) event_listener prop
 
   method onchange : ('self t, event t) event_listener prop
@@ -1272,6 +1296,10 @@ class type buttonElement = object
   method _type : js_string t readonly_prop
 
   method value : js_string t prop
+
+  method popovertarget : element t opt prop
+
+  method popovertargetaction : js_string t prop
 end
 
 class type labelElement = object
@@ -1388,8 +1416,6 @@ class type detailsElement = object ('self)
   method open_ : bool t prop
 
   method name : js_string t prop
-
-  method ontoggle : ('self t, toggleEvent t) event_listener prop
 end
 
 class type imageElement = object ('self)
diff --git a/lib/js_of_ocaml/dom_html.mli b/lib/js_of_ocaml/dom_html.mli
index 7b5f2f7793..95f596a689 100644
--- a/lib/js_of_ocaml/dom_html.mli
+++ b/lib/js_of_ocaml/dom_html.mli
@@ -565,6 +565,10 @@ and eventTarget = object ('self)
 
   method onpointerup : ('self t, pointerEvent t) event_listener writeonly_prop
 
+  method onbeforetoggle : ('self t, toggleEvent t) event_listener writeonly_prop
+
+  method ontoggle : ('self t, toggleEvent t) event_listener writeonly_prop
+
   method dispatchEvent : event t -> bool t meth
 end
 
@@ -748,6 +752,8 @@ and element = object
 
   method scrollHeight : int prop
 
+  method popover : js_string t opt prop
+
   method getClientRects : clientRectList t meth
 
   method getBoundingClientRect : clientRect t meth
@@ -760,6 +766,18 @@ and element = object
 
   method blur : unit meth
 
+  method hidePopover : unit meth
+
+  method showPopover : unit meth
+
+  method showPopover_options : _ -> unit meth
+
+  method togglePopover : bool t meth
+
+  method togglePopover_force : bool t -> bool t meth
+
+  method togglePopover_options : _ -> bool t meth
+
   inherit eventTarget
 end
 
@@ -1007,6 +1025,10 @@ class type inputElement = object ('self)
 
   method selectionEnd : int prop
 
+  method popovertarget : element t opt prop
+
+  method popovertargetaction : js_string t prop
+
   method onselect : ('self t, event t) event_listener prop
 
   method onchange : ('self t, event t) event_listener prop
@@ -1088,6 +1110,10 @@ class type buttonElement = object
 
   (* Cannot be changed under IE *)
   method value : js_string t prop
+
+  method popovertarget : element t opt prop
+
+  method popovertargetaction : js_string t prop
 end
 
 class type labelElement = object
@@ -1204,8 +1230,6 @@ class type detailsElement = object ('self)
   method open_ : bool t prop
 
   method name : js_string t prop
-
-  method ontoggle : ('self t, toggleEvent t) event_listener prop
 end
 
 class type imageElement = object ('self)
@@ -2527,6 +2551,8 @@ module Event : sig
 
   val waiting : mediaEvent t typ
 
+  val beforetoggle : toggleEvent t typ
+
   val toggle : toggleEvent t typ
 
   val make : string -> 'a typ