From bf94695abeda0d7bb296ae4cd0f9a53782587d4a Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Mon, 7 Feb 2022 16:14:09 +0100 Subject: Update editor organisation --- editor/plugins/footnotes.ml | 248 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 248 insertions(+) create mode 100755 editor/plugins/footnotes.ml (limited to 'editor/plugins/footnotes.ml') diff --git a/editor/plugins/footnotes.ml b/editor/plugins/footnotes.ml new file mode 100755 index 0000000..794171f --- /dev/null +++ b/editor/plugins/footnotes.ml @@ -0,0 +1,248 @@ +open Brr +open Js_of_ocaml +module PM = Prosemirror + +let footNoteSpec = object%js + + val mutable group = 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 + technically has content *) + val mutable atom = Js._true + + val toDOM + : (PM.Model.node Js.t -> PM.Model.domOutputSpec Js.t) Js.callback + = Js.wrap_callback (fun _ -> + let open PM.Model.Dom_output_spec in + v "footnote" + [ hole ]) + + val parseDOM + : PM.Model.parse_rule Js.t Js.js_array Js.t Js.opt + = Js.some @@ Js.array + [|PM.Model.ParseRule.tag (Jstr.v "footnote")|] + +end + +let footnote_schema pm defaultSchema = + + let nodes = defaultSchema##.spec##.nodes + and marks = defaultSchema##.spec##.marks in + + let specs = PM.Model.schema_spec + (nodes##addToEnd (Jstr.v "footnote") (Js.Unsafe.coerce footNoteSpec)) + (Some marks) + None in + + PM.Model.schema pm + specs + +let build_menu pm schema = + let menu = PM.Example.buildMenuItems pm schema in + + let itemSpec = PM.Menu.menuItemSpec () in + itemSpec##.title := Js.some @@ Jstr.v "Insert footnote"; + itemSpec##.label := Js.some @@ Jstr.v "Footnote"; + itemSpec##.select := Js.wrap_meth_callback (fun _ (state:PM.State.editor_state Js.t) -> + match PM.O.get schema##.nodes "footnote" with + | None -> Js._false + | Some footnote_node -> + let res = Js.Opt.test @@ PM.Transform.insertPoint + pm + state##.doc + ~pos:state##.selection##.from + footnote_node + in + Js.bool res); + + itemSpec##.run := + Js.wrap_meth_callback (fun _this state dispatch _ _ -> + match PM.O.get schema##.nodes "footnote" with + | None -> () + | Some footnote_node -> + + let from' = PM.State.selection_from state##.selection + and to' = PM.State.selection_to state##.selection in + + let content = + if state##.selection##.empty != Js._true + && from'##sameParent to' = Js._true + && from'##.parent##.inlineContent = Js._true then ( + from'##.parent##.content##cut + (from'##.parentOffset) + (Js.some @@ to'##.parentOffset) + ) else ( + PM.Model.empty_fragment pm + ) in + let new_node = footnote_node##create_withFragmentContent + Js.null + (Js.some content) + Js.null + in + dispatch @@ + state##.tr##replaceSelectionWith + new_node + Js.null + ); + + let item = PM.Menu.menu_item pm itemSpec in + let _ = menu##.insertMenu##.content##push item in + menu + +let fromOutside + : bool PM.State.meta_data Js.t + = PM.State.create_str_meta_data (Jstr.v "fromOutside") + +let footnote_view + : PM.t -> PM.Model.node Js.t -> PM.View.editor_view Js.t -> (unit -> int) -> < .. > Js.t + = fun pm init_node outerView get_pos -> + + (* These are used when the footnote is selected *) + let innerView + : PM.View.editor_view Js.t Js.opt ref + = ref Js.null in + + let dispatchInner + : PM.View.editor_view Js.t -> PM.State.transaction Js.t -> unit + = fun view tr -> + let res = view##.state##applyTransaction tr in + view##updateState res##.state; + + let meta = Js.Optdef.get (tr##getMeta fromOutside) (fun () -> false) in + if (not meta) then ( + let outerTr = outerView##.state##.tr + and offsetMap = PM.Transform.offset pm ((get_pos()) + 1) in + res##.transactions##forEach + (Js.wrap_callback @@ + fun (elem:PM.State.transaction Js.t) _ _ -> + elem##.steps##forEach + (Js.wrap_callback @@ fun (step:PM.Transform.step Js.t) _ _ -> + let _ = outerTr##step (step##map offsetMap) in + () + )); + if (outerTr##.docChanged = Js._true) then ( + 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 "popin")]) 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 + ) + + 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 deselectNode = + El.set_class (Jstr.v "ProseMirror-selectednode") false _self##.dom; + if (Js.Opt.test !innerView) then + _self##close + + end -- cgit v1.2.3