diff options
Diffstat (limited to 'editor/footnotes.ml')
-rwxr-xr-x | editor/footnotes.ml | 239 |
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 |