From 210a4d94836d07bb71cad46b3e670c1977cfe833 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Sun, 21 Mar 2021 20:24:15 +0100
Subject: Updated PM examples

---
 editor/tooltip.ml | 123 +++++++++++++++++++-----------------------------------
 1 file changed, 42 insertions(+), 81 deletions(-)

(limited to 'editor/tooltip.ml')

diff --git a/editor/tooltip.ml b/editor/tooltip.ml
index 693d68d..43c345f 100755
--- a/editor/tooltip.ml
+++ b/editor/tooltip.ml
@@ -29,10 +29,9 @@ let set_position
       Jstr.( (of_float ( box_bottom -. start##.top )) + (v "px") )
       el
 
-let tooltip
+let boldtip
   : PM.View.editor_view Js.t -> < .. > Js.t
   = fun view ->
-
     (* Create the element which will be displayed over the editor *)
     let tooltip = El.div []
         ~at:At.([class' (Jstr.v "tooltip")]) in
@@ -45,86 +44,48 @@ let tooltip
       : PM.View.editor_view Js.t -> PM.State.editor_state Js. t Js.opt -> unit
       = fun view state_opt ->
 
-        Js.Opt.iter state_opt
-          (fun previous_state ->
-             if ((view##.state##.doc##eq previous_state##.doc) = Js._true)
-             && ((previous_state##.selection##eq view##.state##.selection) = Js._true)
-             then
-               ()
-             else (
-               if (view##.state##.selection##.empty) = Js._true then
-                 (* Hide the tooltip if the selection is empty *)
-                 El.set_inline_style El.Style.display (Jstr.v "none") tooltip
-               else (
-                 (* otherwise, reposition it and update its content *)
-                 set_position view tooltip;
-                 El.set_prop
-                   (El.Prop.jstr (Jstr.v "textContent"))
-                   (Jstr.of_int
-                      (view##.state##.selection##._to -  view##.state##.selection##.from))
-                   tooltip)))
-    and destroy () = El.remove tooltip in
-
-    object%js
-      val update = Js.wrap_callback update
-      val destroy= Js.wrap_callback destroy
-    end
-
-let tooltip_plugin
-  : PM.t -> PM.State.plugin Js.t
-  = fun t ->
-    let state = Jv.get (Jv.Id.to_jv t) "state" in
-
-    let params = object%js
-      val view = (fun view -> tooltip view)
-    end in
-
-    Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |]
-    |> Jv.Id.of_jv
-
-
-let boldtip
-  : PM.View.editor_view Js.t -> < .. > Js.t
-  = fun view ->
-    (* Create the element which will be displayed over the editor *)
-    let tooltip = El.div []
-        ~at:At.([class' (Jstr.v "tooltip")]) in
-    El.set_inline_style El.Style.display (Jstr.v "none") tooltip;
-
-    let parent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv view##.dom) "parentNode") in
-    let () = El.append_children parent [tooltip] in
-
-    let update
-      : PM.View.editor_view Js.t -> PM.State.editor_state Js. t Js.opt -> unit
-      = fun view _state_opt ->
+        (* Compare the previous and actual state. If the stored marks are the
+           same, just return *)
         let state = view##.state in
-        let is_bold = Option.bind (PM.O.get state##.schema##.marks "strong")
-            (fun mark_type ->
-               let is_strong =
-                 Js.Opt.bind state##.storedMarks
-                   (fun t -> mark_type##isInSet t) in
-               Js.Opt.case is_strong
-                 (fun () -> None)
-                 (fun _ -> Some (Jstr.v "gras"))) in
-        let is_em = Option.bind (PM.O.get state##.schema##.marks "em")
-            (fun mark_type ->
-               let is_strong =
-                 Js.Opt.bind state##.storedMarks
-                   (fun t -> mark_type##isInSet t) in
-               Js.Opt.case is_strong
-                 (fun () -> None)
-                 (fun _ -> Some (Jstr.(v "emphase")))) in
-
-        let marks = List.filter_map [is_bold; is_em] ~f:(fun x -> x) in
-        match marks with
-        | [] -> El.set_inline_style El.Style.display (Jstr.v "none") tooltip
-        | _ ->
-          (* The mark is present, add in the content *)
-          set_position view tooltip;
-          El.set_prop
-            (El.Prop.jstr (Jstr.v "textContent"))
-            (Jstr.concat marks ~sep:(Jstr.v ", "))
-            tooltip
+        let previous_stored_marks =
+          Js.Opt.bind state_opt (fun state -> state##.storedMarks)
+          |> Js.Opt.to_option
+        and current_stored_marks = state##.storedMarks in
+        let same = match previous_stored_marks, Js.Opt.to_option current_stored_marks with
+          | Some arr1, Some arr2 ->
+            Js_lib.Array.compare arr1 arr2 ~f:(fun v1 v2 -> v1##eq v2)
+          | None, None -> Js._true
+          | _, _ -> Js._false in
+
+        if same <> Js._true then
+
+          let is_bold = Option.bind (PM.O.get state##.schema##.marks "strong")
+              (fun mark_type ->
+                 let is_strong =
+                   Js.Opt.bind current_stored_marks
+                     (fun t -> mark_type##isInSet t) in
+                 Js.Opt.case is_strong
+                   (fun () -> None)
+                   (fun _ -> Some (Jstr.v "gras"))) in
+          let is_em = Option.bind (PM.O.get state##.schema##.marks "em")
+              (fun mark_type ->
+                 let is_strong =
+                   Js.Opt.bind current_stored_marks
+                     (fun t -> mark_type##isInSet t) in
+                 Js.Opt.case is_strong
+                   (fun () -> None)
+                   (fun _ -> Some (Jstr.(v "emphase")))) in
+
+          let marks = List.filter_map [is_bold; is_em] ~f:(fun x -> x) in
+          match marks with
+          | [] -> El.set_inline_style El.Style.display (Jstr.v "none") tooltip
+          | _ ->
+            (* The mark is present, add in the content *)
+            set_position view tooltip;
+            El.set_prop
+              (El.Prop.jstr (Jstr.v "textContent"))
+              (Jstr.concat marks ~sep:(Jstr.v ", "))
+              tooltip
 
     and destroy () = El.remove tooltip in
 
-- 
cgit v1.2.3