summaryrefslogtreecommitdiff
path: root/editor/footnotes.ml
diff options
context:
space:
mode:
Diffstat (limited to 'editor/footnotes.ml')
-rwxr-xr-xeditor/footnotes.ml239
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-02 05:48:40 +0000