1 files changed, 171 insertions, 0 deletions
diff --git a/editor/link_editor.ml b/editor/link_editor.ml
new file mode 100755
index 0000000..454dacd
--- /dev/null
+++ b/editor/link_editor.ml
@@ -0,0 +1,171 @@
+open Js_of_ocaml
+open Brr
+
+module PM = Prosemirror
+
+
+type binded_field =
+  { field: El.t
+  ; button: El.t
+  }
+
+
+(** Build a button which allow to activate or desactivate the given Element.
+
+    The function f is called when the user validate the input.
+
+*)
+let build_field
+  : El.t -> (Jstr.t -> bool) -> binded_field
+  = fun field f ->
+
+    let button_content =
+      [ El.i
+          ~at:At.[ class' (Jstr.v "fas")
+                 ; class' (Jstr.v "fa-pen") ]
+          []
+      ] in
+
+    let button = El.button
+        button_content
+    in
+
+    Ev.listen Ev.click
+      (fun _ ->
+         match El.at (Jstr.v "contenteditable") field with
+         | Some value when (Jstr.equal value (Jstr.v "true")) ->
+           let new_value = El.prop
+               (El.Prop.jstr (Jstr.v "textContent"))
+               field in
+           begin match f new_value with
+             | true ->
+               El.set_at (Jstr.v "contenteditable") None field;
+               El.set_children button button_content
+             | false -> ()
+           end
+         | _ ->
+           El.set_at (Jstr.v "contenteditable")
+             (Some (Jstr.v "true")) field;
+           El.set_children button
+             [ El.i
+                 ~at:At.[ class' (Jstr.v "fas")
+                        ; class' (Jstr.v "fa-check") ]
+                 []
+             ]
+      )
+      (El.as_target button);
+
+    { field
+    ; button = button
+    }
+
+
+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 ->
+
+        (* Compare the previous and actual state. If the stored marks are the
+           same, just return *)
+        let state = view##.state in
+
+        (* Get the cursor position *)
+
+        let root = state##.doc in
+        Js.Opt.case (root##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 ->
+                    (* We are on a link we can edit the popsin *)
+
+                    (* Get the node's bounding position *)
+                    let position = root##resolve (view##.state##.selection##._to) in
+                    let start = position##start Js.null
+                    and end' = position##_end Js.null in
+
+                    Tooltip.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' = Option.value href_opt ~default:Jstr.empty in
+
+                    let a = El.a
+                        ~at:At.[ href href' ]
+                        [ El.txt href' ] in
+
+                    let entry = build_field a
+                        (fun new_value ->
+                           PM.O.set attrs "href" new_value;
+
+                           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