summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--editor/editor.css6
-rwxr-xr-xeditor/link_editor.ml134
-rwxr-xr-xeditor/popin.ml84
-rwxr-xr-xeditor/tooltip.ml30
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 ", "))
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-22 20:25:37 +0000