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