Added custom link popin in text editor

1 files changed, 115 insertions, 124 deletions

diff --git a/editor/footnotes.ml b/editor/footnotes.ml
index a2bc9c6..a3ba9cd 100755
--- a/editor/footnotes.ml
+++ b/editor/footnotes.ml
@@ -5,7 +5,7 @@ module PM = Prosemirror
 let footNoteSpec = object%js
 
   val mutable group = Jstr.v "inline"
-  val mutable content = Jstr.v "inline*"
+  val mutable content = Jstr.v "inline*" (* The star is very important ! *)
   val mutable inline = Js._true
   val mutable draggable = Js._true
   (*  This makes the view treat the node as a leaf, even though it
@@ -126,132 +126,123 @@ let footnote_view
             outerView##dispatch outerTr)
         );
     in
+    object%js (_self)
+
+      val mutable node: PM.Model.node Js.t = init_node
+
+      (* The node's representation in the editor (empty, for now) *)
+      val dom = El.v (Jstr.v "footnote") []
+
+      method _open =
+        (* Append a tooltip to the outer node *)
+        let tooltip = El.div []
+            ~at:At.([class' (Jstr.v "footnote-tooltip")]) in
+        El.append_children _self##.dom
+          [ tooltip ];
+
+        let dispatch_fn
+          : PM.State.transaction Js.t -> unit
+          = fun tr -> outerView##dispatch tr in
+
+        let state_properties = Js.Unsafe.coerce (object%js
+            val doc = Js.some _self##.node;
+            val plugins = Js.some @@ Js.array @@ [|
+                PM.Keymap.keymap pm
+                  [| ( "Mod-z"
+                     , (fun _ _ -> PM.History.undo pm outerView##.state (Js.some dispatch_fn)))
+                   ; ( "Mod-y"
+                     , (fun _ _ -> PM.History.redo pm outerView##.state (Js.some dispatch_fn)))
+                  |]
+              |];
+          end) in
+
+        let view_properties = PM.View.direct_editor_props () in
+        view_properties##.state := PM.State.create pm state_properties;
+        (* This is the magic part *)
+        view_properties##.dispatchTransaction :=
+          (Js.wrap_meth_callback dispatchInner);
+        view_properties##.handleDOMEvents := PM.O.init
+            [| ( "mousedown"
+               , Js.wrap_callback (fun _ _ ->
+                     (* Kludge to prevent issues due to the fact that the
+                        whole footnote is node-selected (and thus DOM-selected)
+                        when the parent editor is focused. *)
+                     if (outerView##hasFocus () = Js._true) then (
+                       Js.Opt.iter !innerView (fun view -> view##focus ())
+                     );
+                     Js._false ))|];
+
+        innerView := Js.some
+            (PM.View.editor_view pm
+               tooltip
+               view_properties);
+
+      method close =
+        Js.Opt.iter (!innerView)
+          (fun view ->
+             view##destroy;
+             innerView := Js.null;
+             El.set_prop
+               (El.Prop.jstr (Jstr.v "textContent"))
+               (Jstr.empty)
+               _self##.dom
+          )
 
-
-    let obj =
-      object%js (_self)
-
-        val mutable node: PM.Model.node Js.t = init_node
-
-        (* The node's representation in the editor (empty, for now) *)
-        val dom = El.v (Jstr.v "footnote") []
-
-        method _open =
-          (* Append a tooltip to the outer node *)
-          let tooltip = El.div []
-              ~at:At.([class' (Jstr.v "footnote-tooltip")]) in
-          El.append_children _self##.dom
-            [ tooltip ];
-
-          let dispatch_fn
-            : PM.State.transaction Js.t -> unit
-            = fun tr -> outerView##dispatch tr in
-
-          let state_properties = Js.Unsafe.coerce (object%js
-              val doc = Js.some _self##.node;
-              val plugins = Js.some @@ Js.array @@ [|
-                  PM.Keymap.keymap pm
-                    [| ( "Mod-z"
-                       , (fun _ _ -> PM.History.undo pm outerView##.state (Js.some dispatch_fn)))
-                     ; ( "Mod-y"
-                       , (fun _ _ -> PM.History.redo pm outerView##.state (Js.some dispatch_fn)))
-                    |]
-                |];
-            end) in
-
-          let view_properties = PM.View.direct_editor_props () in
-          view_properties##.state := PM.State.create pm state_properties;
-          (* This is the magic part *)
-          view_properties##.dispatchTransaction :=
-            (Js.wrap_meth_callback dispatchInner);
-          view_properties##.handleDOMEvents := PM.O.init
-              [| ( "mousedown"
-                 , Js.wrap_callback (fun _ _ ->
-                       (* Kludge to prevent issues due to the fact that the
-                          whole footnote is node-selected (and thus DOM-selected)
-                          when the parent editor is focused. *)
-                       if (outerView##hasFocus () = Js._true) then (
-                         Js.Opt.iter !innerView (fun view -> view##focus ())
-                       );
-                       Js._false ))|];
-
-          innerView := Js.some
-              (PM.View.editor_view pm
-                 tooltip
-                 view_properties);
-
-        method close =
-          Js.Opt.iter (!innerView)
-            (fun view ->
-               view##destroy;
-               innerView := Js.null;
-               El.set_prop
-                 (El.Prop.jstr (Jstr.v "textContent"))
-                 (Jstr.empty)
-                 _self##.dom
-            )
-
-        (*  TODO
-            https://prosemirror.net/docs/ref/#view.NodeView.update *)
-        method update
-          : PM.Model.node Js.t -> bool Js.t
-          = fun node ->
-            if (node##sameMarkup _self##.node = Js._false) then (
-              Js._false
-            ) else (
-              _self##.node := node;
-              Js.Opt.iter !innerView (fun view ->
-                  let state = view##.state in
-                  Js.Opt.iter (node##.content##findDiffStart state##.doc##.content) (fun start ->
-                      let res_opt = (node##.content##findDiffEnd state##.doc##.content) in
-                      Js.Opt.iter res_opt (fun end_diff ->
-                          let overlap = start - (min end_diff##.a end_diff##.b) in
-                          let endA, endB =
-                            if overlap > 0 then
-                              ( end_diff##.a + overlap
-                              , end_diff##.b + overlap )
-                            else
-                              ( end_diff##.a
-                              , end_diff##.b )
-                          in
-                          let tr =
-                            state##.tr
-                            ##(replace
-                                 ~from:start
-                                 ~to_:endB
-                                 (Js.some @@ node##slice ~from:start ~to_:(Js.some endA)))
-                            ##(setMeta fromOutside true) in
-                          view##dispatch tr)));
-              Js._true
-            )
-
-        method destroy =
-          Js.Opt.iter !innerView (fun _ -> _self##close)
-
-        method stopEvent e =
-          Js.Opt.case !innerView
-            (fun () -> Js._false)
-            (fun view ->
-               let dom = view##.dom in
-               Jv.call (Jv.Id.to_jv dom) "contains" [| e##.target|]
-               |> Jv.Id.of_jv)
-
-        method ignoreMutation =
-          Js._true
-
-        method selectNode =
-          El.set_class (Jstr.v "ProseMirror-selectednode") true _self##.dom;
-          if not (Js.Opt.test !innerView) then (
-            _self##_open
+      method update
+        : PM.Model.node Js.t -> bool Js.t
+        = fun node ->
+          if (node##sameMarkup _self##.node = Js._false) then (
+            Js._false
+          ) else (
+            _self##.node := node;
+            Js.Opt.iter !innerView (fun view ->
+                let state = view##.state in
+                Js.Opt.iter (node##.content##findDiffStart state##.doc##.content) (fun start ->
+                    let res_opt = (node##.content##findDiffEnd state##.doc##.content) in
+                    Js.Opt.iter res_opt (fun end_diff ->
+                        let overlap = start - (min end_diff##.a end_diff##.b) in
+                        let endA, endB =
+                          if overlap > 0 then
+                            ( end_diff##.a + overlap
+                            , end_diff##.b + overlap )
+                          else
+                            ( end_diff##.a
+                            , end_diff##.b )
+                        in
+                        let tr =
+                          state##.tr
+                          ##(replace
+                               ~from:start
+                               ~to_:endB
+                               (Js.some @@ node##slice ~from:start ~to_:(Js.some endA)))
+                          ##(setMeta fromOutside true) in
+                        view##dispatch tr)));
+            Js._true
           )
 
+      method destroy =
+        Js.Opt.iter !innerView (fun _ -> _self##close)
 
+      method stopEvent e =
+        Js.Opt.case !innerView
+          (fun () -> Js._false)
+          (fun view ->
+             let dom = view##.dom in
+             Jv.call (Jv.Id.to_jv dom) "contains" [| e##.target|]
+             |> Jv.Id.of_jv)
 
-        method deselectNode =
-          El.set_class (Jstr.v "ProseMirror-selectednode") false _self##.dom;
-          if (Js.Opt.test !innerView) then
-            _self##close
+      method ignoreMutation =
+        Js._true
 
-      end
-    in
-    obj
+      method selectNode =
+        El.set_class (Jstr.v "ProseMirror-selectednode") true _self##.dom;
+        if not (Js.Opt.test !innerView) then (
+          _self##_open
+        )
+
+      method deselectNode =
+        El.set_class (Jstr.v "ProseMirror-selectednode") false _self##.dom;
+        if (Js.Opt.test !innerView) then
+          _self##close
+
+    end