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/footnotes.ml | 248 ---------------------------------------------------- 1 file changed, 248 deletions(-) delete mode 100755 editor/footnotes.ml (limited to 'editor/footnotes.ml') diff --git a/editor/footnotes.ml b/editor/footnotes.ml deleted file mode 100755 index 794171f..0000000 --- a/editor/footnotes.ml +++ /dev/null @@ -1,248 +0,0 @@ -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