diff options
| -rw-r--r-- | editor/editor.css | 6 | ||||
| -rwxr-xr-x | editor/link_editor.ml | 134 | ||||
| -rwxr-xr-x | editor/popin.ml | 84 | ||||
| -rwxr-xr-x | editor/tooltip.ml | 30 |
4 files changed, 132 insertions, 122 deletions
diff --git a/editor/editor.css b/editor/editor.css index de67f8c..43c9acf 100644 --- a/editor/editor.css +++ b/editor/editor.css @@ -382,7 +382,7 @@ li.ProseMirror-selectednode:after { border: 0px; } -.tooltip, .popin { +.popin { position: absolute; border: 1px #3b4252 solid; border-radius: 10px; @@ -393,10 +393,6 @@ li.ProseMirror-selectednode:after { z-index: 99; } -.tooltip { - pointer-events: none; -} - .popin a[contenteditable="true"] { color: #eceff4; } diff --git a/editor/link_editor.ml b/editor/link_editor.ml index 454dacd..cd7f477 100755 --- a/editor/link_editor.ml +++ b/editor/link_editor.ml @@ -3,63 +3,6 @@ open Brr module PM = Prosemirror - -type binded_field = - { field: El.t - ; button: El.t - } - - -(** Build a button which allow to activate or desactivate the given Element. - - The function f is called when the user validate the input. - -*) -let build_field - : El.t -> (Jstr.t -> bool) -> binded_field - = fun field f -> - - let button_content = - [ El.i - ~at:At.[ class' (Jstr.v "fas") - ; class' (Jstr.v "fa-pen") ] - [] - ] in - - let button = El.button - button_content - in - - Ev.listen Ev.click - (fun _ -> - match El.at (Jstr.v "contenteditable") field with - | Some value when (Jstr.equal value (Jstr.v "true")) -> - let new_value = El.prop - (El.Prop.jstr (Jstr.v "textContent")) - field in - begin match f new_value with - | true -> - El.set_at (Jstr.v "contenteditable") None field; - El.set_children button button_content - | false -> () - end - | _ -> - El.set_at (Jstr.v "contenteditable") - (Some (Jstr.v "true")) field; - El.set_children button - [ El.i - ~at:At.[ class' (Jstr.v "fas") - ; class' (Jstr.v "fa-check") ] - [] - ] - ) - (El.as_target button); - - { field - ; button = button - } - - let link_edit : PM.View.editor_view Js.t -> < .. > Js.t = fun view -> @@ -82,14 +25,8 @@ let link_edit : PM.View.editor_view Js.t -> PM.State.editor_state Js. t Js.opt -> unit = fun view _state_opt -> - (* Compare the previous and actual state. If the stored marks are the - same, just return *) let state = view##.state in - - (* Get the cursor position *) - - let root = state##.doc in - Js.Opt.case (root##nodeAt (view##.state##.selection##._to)) + Js.Opt.case (state##.doc##nodeAt (view##.state##.selection##._to)) (fun () -> hide ()) (fun node -> (* Check if we are editing a link *) @@ -101,14 +38,13 @@ let link_edit is_present (fun () -> hide ()) (fun mark -> - (* We are on a link we can edit the popsin *) - - (* Get the node's bounding position *) - let position = root##resolve (view##.state##.selection##._to) in + (* Get the node's bounding position and display the popin *) + let position = state##.doc##resolve + (view##.state##.selection##._to) in let start = position##start Js.null and end' = position##_end Js.null in - Tooltip.set_position + Popin.set_position ~start ~end' view popin; @@ -116,30 +52,50 @@ let link_edit (* Extract the value from the attribute *) let attrs = mark##.attrs in let href_opt = PM.O.get attrs "href" in - let href' = Option.value href_opt ~default:Jstr.empty in + let href_value = Option.value + ~default:Jstr.empty + href_opt + in + (* Create the popin content *) let a = El.a - ~at:At.[ href href' ] - [ El.txt href' ] in + ~at:At.[ href href_value ] + [ El.txt href_value ] in - let entry = build_field a + let entry = Popin.build_field a (fun new_value -> - PM.O.set attrs "href" new_value; - - let mark' = state##.schema##mark_fromType link_type (Js.some attrs) in - (* Create a transaction which update the - mark with the new value *) - view##dispatch - state - ##.tr - ##(removeMark - ~from:start - ~to_:end' - mark) - ##(addMark - ~from:start - ~to_:end' - mark'); + (* The function is called when the user validate + the change in the popi. We create a new + transaction in the document by replacing the + mark with the new one. *) + if not (Jstr.equal new_value href_value) then ( + + (* Create a new attribute object for the mark in + order to keep history safe *) + let attrs' = PM.O.init + [| "href", new_value |] in + + Option.iter + (fun v -> PM.O.set attrs' "title" v) + (PM.O.get attrs "title"); + + let mark' = state##.schema##mark_fromType + link_type + (Js.some attrs') in + (* Create a transaction which update the + mark with the new value *) + view##dispatch + state + ##.tr + ##(removeMark + ~from:start + ~to_:end' + mark) + ##(addMark + ~from:start + ~to_:end' + mark') + ); true ) in diff --git a/editor/popin.ml b/editor/popin.ml new file mode 100755 index 0000000..cd5154d --- /dev/null +++ b/editor/popin.ml @@ -0,0 +1,84 @@ +open Js_of_ocaml +open Brr +module PM = Prosemirror + +type binded_field = + { field: El.t + ; button: El.t + } + +(** Set the element position just above the selection *) +let set_position + : start:int -> end':int -> PM.View.editor_view Js.t -> El.t -> unit + = fun ~start ~end' view el -> + El.set_inline_style El.Style.display (Jstr.v "") el; + + (* These are in screen coordinates *) + let start = view##coordsAtPos start Js.null + and end' = view##coordsAtPos end' Js.null in + let offsetParent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv el) "offsetParent") in + + (* The box in which the tooltip is positioned, to use as base *) + let box = Jv.(Id.of_jv @@ call (Jv.Id.to_jv offsetParent) "getBoundingClientRect" [||]) in + let box_left = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "left") in + let box_bottom = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "bottom") in + + (* Find a center-ish x position from the selection endpoints (when + crossing lines, end may be more to the left) *) + let left = (start##.left +. end'##.left) /. 2. in + + El.set_inline_style (Jstr.v "left") + Jstr.( (of_float ( left -. box_left )) + (v "px") ) + el; + El.set_inline_style (Jstr.v "bottom") + Jstr.( (of_float ( box_bottom -. start##.top )) + (v "px") ) + el + +(** Build a button which allow to activate or desactivate the given Element. + + The function f is called when the user validate the input. + +*) +let build_field + : El.t -> (Jstr.t -> bool) -> binded_field + = fun field f -> + + let button_content = + [ El.i + ~at:At.[ class' (Jstr.v "fas") + ; class' (Jstr.v "fa-pen") ] + [] + ] in + + let button = El.button + button_content + in + + Ev.listen Ev.click + (fun _ -> + match El.at (Jstr.v "contenteditable") field with + | Some value when (Jstr.equal value (Jstr.v "true")) -> + let new_value = El.prop + (El.Prop.jstr (Jstr.v "textContent")) + field in + begin match f new_value with + | true -> + El.set_at (Jstr.v "contenteditable") None field; + El.set_children button button_content + | false -> () + end + | _ -> + El.set_at (Jstr.v "contenteditable") + (Some (Jstr.v "true")) field; + El.set_children button + [ El.i + ~at:At.[ class' (Jstr.v "fas") + ; class' (Jstr.v "fa-check") ] + [] + ] + ) + (El.as_target button); + + { field + ; button = button + } diff --git a/editor/tooltip.ml b/editor/tooltip.ml index adb37f1..e172cbf 100755 --- a/editor/tooltip.ml +++ b/editor/tooltip.ml @@ -7,39 +7,13 @@ module PM = Prosemirror (** https://prosemirror.net/examples/tooltip/ *) -(** Set the element position just above the selection *) -let set_position - : start:int -> end':int -> PM.View.editor_view Js.t -> El.t -> unit - = fun ~start ~end' view el -> - El.set_inline_style El.Style.display (Jstr.v "") el; - - (* These are in screen coordinates *) - let start = view##coordsAtPos start Js.null - and end' = view##coordsAtPos end' Js.null in - let offsetParent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv el) "offsetParent") in - - (* The box in which the tooltip is positioned, to use as base *) - let box = Jv.(Id.of_jv @@ call (Jv.Id.to_jv offsetParent) "getBoundingClientRect" [||]) in - let box_left = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "left") in - let box_bottom = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "bottom") in - - (* Find a center-ish x position from the selection endpoints (when - crossing lines, end may be more to the left) *) - let left = (start##.left +. end'##.left) /. 2. in - - El.set_inline_style (Jstr.v "left") - Jstr.( (of_float ( left -. box_left )) + (v "px") ) - el; - El.set_inline_style (Jstr.v "bottom") - Jstr.( (of_float ( box_bottom -. start##.top )) + (v "px") ) - el let boldtip : PM.View.editor_view Js.t -> < .. > Js.t = fun view -> (* Create the element which will be displayed over the editor *) let tooltip = El.div [] - ~at:At.([ class' (Jstr.v "tooltip") + ~at:At.([ class' (Jstr.v "popin") ]) in El.set_inline_style El.Style.display (Jstr.v "none") tooltip; @@ -90,7 +64,7 @@ let boldtip (* The mark is present, add in the content *) let start = view##.state##.selection##.from and end' = view##.state##.selection##._to in - set_position ~start ~end' view tooltip; + Popin.set_position ~start ~end' view tooltip; El.set_prop (El.Prop.jstr (Jstr.v "textContent")) (Jstr.concat marks ~sep:(Jstr.v ", ")) |