1 files changed, 89 insertions, 0 deletions
diff --git a/editor/plugins/tooltip.ml b/editor/plugins/tooltip.ml
new file mode 100755
index 0000000..05d56d4
--- /dev/null
+++ b/editor/plugins/tooltip.ml
@@ -0,0 +1,89 @@
+open StdLabels
+open Brr
+
+module Js = Js_of_ocaml.Js
+module PM = Prosemirror
+
+(** https://prosemirror.net/examples/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 "popin")
+                ]) 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 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_em =
+                   Js.Opt.bind current_stored_marks
+                     (fun t -> mark_type##isInSet t) in
+                 Js.Opt.case is_em
+                   (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 *)
+            let start = view##.state##.selection##.from
+            and end' = view##.state##.selection##._to in
+            Popin.set_position ~start ~end' view tooltip;
+            El.set_prop
+              (El.Prop.jstr (Jstr.v "textContent"))
+              (Jstr.concat marks ~sep:(Jstr.v ", "))
+              tooltip
+
+    and destroy () = El.remove tooltip in
+
+    object%js
+      val update = Js.wrap_callback update
+      val destroy= Js.wrap_callback destroy
+    end
+
+let bold_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 -> boldtip view)
+    end in
+
+    Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |]
+    |> Jv.Id.of_jv