open Brr module Js = Js_of_ocaml.Js module PM = Prosemirror let link_edit : PM.View.editor_view Js.t -> < .. > Js.t = fun view -> let popin = El.div [] ~at:At.([class' (Jstr.v "popin")]) in El.set_inline_style El.Style.display (Jstr.v "none") popin; let parent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv view##.dom) "parentNode") in let () = El.append_children parent [popin] in let hide : unit -> unit = fun () -> El.set_inline_style El.Style.display (Jstr.v "none") popin in let update : PM.View.editor_view Js.t -> PM.State.editor_state Js. t Js.opt -> unit = fun view _state_opt -> let state = view##.state in Js.Opt.case (state##.doc##nodeAt (view##.state##.selection##._to)) (fun () -> hide ()) (fun node -> (* Check if we are editing a link *) match PM.O.get state##.schema##.marks "link" with | None -> () | Some link_type -> let is_present = link_type##isInSet node##.marks in Js.Opt.case is_present (fun () -> hide ()) (fun mark -> (* Get the node's bounding position and display the popin *) let position = state##.doc##resolve (view##.state##.selection##._to) in let start = position##start Js.null and end' = position##_end Js.null in Popin.set_position ~start ~end' view popin; (* Extract the value from the attribute *) let attrs = mark##.attrs in let href_opt = PM.O.get attrs "href" in let href_value = Option.value ~default:Jstr.empty href_opt in (* Create the popin content *) let a = El.a ~at:At.[ href href_value ] [ El.txt href_value ] in let entry = Popin.build_field a (fun new_value -> (* The function is called when the user validate the change in the popi. We create a new transaction in the document by replacing the mark with the new one. *) if not (Jstr.equal new_value href_value) then ( (* Create a new attribute object for the mark in order to keep history safe *) let attrs' = PM.O.init [| "href", new_value |] in Option.iter (fun v -> PM.O.set attrs' "title" v) (PM.O.get attrs "title"); let mark' = state##.schema##mark_fromType link_type (Js.some attrs') in (* Create a transaction which update the mark with the new value *) view##dispatch state ##.tr ##(removeMark ~from:start ~to_:end' mark) ##(addMark ~from:start ~to_:end' mark') ); true ) in El.set_children popin [ entry.field ; entry.button ]; )) and destroy () = El.remove popin in object%js val update = Js.wrap_callback update val destroy= Js.wrap_callback destroy end let 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 -> link_edit view) end in Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |] |> Jv.Id.of_jv