Update editor modules

4 files changed, 132 insertions, 122 deletions

diff --git a/editor/editor.css b/editor/editor.css
index de67f8c..43c9acf 100644
--- a/editor/editor.css
+++ b/editor/editor.css
@@ -382,7 +382,7 @@ li.ProseMirror-selectednode:after {
   border: 0px;
 }
 
-.tooltip, .popin {
+.popin {
   position: absolute;
   border: 1px #3b4252 solid;
   border-radius: 10px;
@@ -393,10 +393,6 @@ li.ProseMirror-selectednode:after {
   z-index: 99;
 }
 
-.tooltip {
-  pointer-events: none;
-}
-
 .popin a[contenteditable="true"] {
   color: #eceff4;
 }
diff --git a/editor/link_editor.ml b/editor/link_editor.ml
index 454dacd..cd7f477 100755
--- a/editor/link_editor.ml
+++ b/editor/link_editor.ml
@@ -3,63 +3,6 @@ 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 ->
@@ -82,14 +25,8 @@ let link_edit
       : 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))
+        Js.Opt.case (state##.doc##nodeAt (view##.state##.selection##._to))
           (fun () -> hide ())
           (fun node ->
              (* Check if we are editing a link *)
@@ -101,14 +38,13 @@ let link_edit
                  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
+                    (* 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
 
-                    Tooltip.set_position
+                    Popin.set_position
                       ~start
                       ~end'
                       view popin;
@@ -116,30 +52,50 @@ let link_edit
                     (* 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 href_value = Option.value
+                        ~default:Jstr.empty
+                        href_opt
+                    in
 
+                    (* Create the popin content *)
                     let a = El.a
-                        ~at:At.[ href href' ]
-                        [ El.txt href' ] in
+                        ~at:At.[ href href_value ]
+                        [ El.txt href_value ] in
 
-                    let entry = build_field a
+                    let entry = Popin.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');
+                           (* 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
diff --git a/editor/popin.ml b/editor/popin.ml
new file mode 100755
index 0000000..cd5154d
--- /dev/null
+++ b/editor/popin.ml
@@ -0,0 +1,84 @@
+open Js_of_ocaml
+open Brr
+module PM = Prosemirror
+
+type binded_field =
+  { field: El.t
+  ; button: El.t
+  }
+
+(** Set the element position just above the selection  *)
+let set_position
+  : start:int -> end':int -> PM.View.editor_view Js.t -> El.t -> unit
+  = fun ~start ~end' view el ->
+    El.set_inline_style El.Style.display (Jstr.v "") el;
+
+    (* These are in screen coordinates *)
+    let start = view##coordsAtPos start Js.null
+    and end' = view##coordsAtPos end' Js.null in
+    let offsetParent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv el) "offsetParent") in
+
+    (* The box in which the tooltip is positioned, to use as base *)
+    let box = Jv.(Id.of_jv @@ call (Jv.Id.to_jv offsetParent) "getBoundingClientRect" [||]) in
+    let box_left = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "left") in
+    let box_bottom = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "bottom") in
+
+    (* Find a center-ish x position from the selection endpoints (when
+       crossing lines, end may be more to the left) *)
+    let left = (start##.left +. end'##.left) /. 2. in
+
+    El.set_inline_style (Jstr.v "left")
+      Jstr.( (of_float ( left -. box_left )) + (v "px") )
+      el;
+    El.set_inline_style (Jstr.v "bottom")
+      Jstr.( (of_float ( box_bottom -. start##.top )) + (v "px") )
+      el
+
+(** 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
+    }
diff --git a/editor/tooltip.ml b/editor/tooltip.ml
index adb37f1..e172cbf 100755
--- a/editor/tooltip.ml
+++ b/editor/tooltip.ml
@@ -7,39 +7,13 @@ module PM = Prosemirror
 
 (** https://prosemirror.net/examples/tooltip/ *)
 
-(** Set the element position just above the selection  *)
-let set_position
-  : start:int -> end':int -> PM.View.editor_view Js.t -> El.t -> unit
-  = fun ~start ~end' view el ->
-    El.set_inline_style El.Style.display (Jstr.v "") el;
-
-    (* These are in screen coordinates *)
-    let start = view##coordsAtPos start Js.null
-    and end' = view##coordsAtPos end' Js.null in
-    let offsetParent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv el) "offsetParent") in
-
-    (* The box in which the tooltip is positioned, to use as base *)
-    let box = Jv.(Id.of_jv @@ call (Jv.Id.to_jv offsetParent) "getBoundingClientRect" [||]) in
-    let box_left = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "left") in
-    let box_bottom = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "bottom") in
-
-    (* Find a center-ish x position from the selection endpoints (when
-       crossing lines, end may be more to the left) *)
-    let left = (start##.left +. end'##.left) /. 2. in
-
-    El.set_inline_style (Jstr.v "left")
-      Jstr.( (of_float ( left -. box_left )) + (v "px") )
-      el;
-    El.set_inline_style (Jstr.v "bottom")
-      Jstr.( (of_float ( box_bottom -. start##.top )) + (v "px") )
-      el
 
 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")
+        ~at:At.([ class' (Jstr.v "popin")
                 ]) in
     El.set_inline_style El.Style.display (Jstr.v "none") tooltip;
 
@@ -90,7 +64,7 @@ let boldtip
             (* The mark is present, add in the content *)
             let start = view##.state##.selection##.from
             and end' = view##.state##.selection##._to in
-            set_position ~start ~end' view tooltip;
+            Popin.set_position ~start ~end' view tooltip;
             El.set_prop
               (El.Prop.jstr (Jstr.v "textContent"))
               (Jstr.concat marks ~sep:(Jstr.v ", "))