diff options
| -rw-r--r-- | editor/editor.css | 98 | ||||
| -rwxr-xr-x | editor/editor.ml | 58 | ||||
| -rwxr-xr-x | editor/footnotes.ml | 239 | ||||
| -rwxr-xr-x | editor/link_editor.ml | 171 | ||||
| -rwxr-xr-x | editor/plugins.ml | 3 | ||||
| -rwxr-xr-x | editor/prosemirror/bindings.ml | 37 | ||||
| -rwxr-xr-x | editor/prosemirror/prosemirror.ml | 18 | ||||
| -rwxr-xr-x | editor/prosemirror/prosemirror.mli | 7 | ||||
| -rwxr-xr-x | editor/storage.ml | 86 | ||||
| -rwxr-xr-x | editor/tooltip.ml | 25 |
10 files changed, 502 insertions, 240 deletions
diff --git a/editor/editor.css b/editor/editor.css index 75d9495..de67f8c 100644 --- a/editor/editor.css +++ b/editor/editor.css @@ -372,10 +372,17 @@ li.ProseMirror-selectednode:after { } -.editor a[href] { +.editor a[href] { position: relative; } -.tooltip, .editor a[href]:hover::after { + +.popin button { + color: white; + background-color:#2e3440; + border: 0px; +} + +.tooltip, .popin { position: absolute; border: 1px #3b4252 solid; border-radius: 10px; @@ -384,51 +391,54 @@ li.ProseMirror-selectednode:after { color: #eceff4; font-size: 14px; z-index: 99; +} + +.tooltip { pointer-events: none; } -.editor a[href]:hover::after { - content: attr(href); - left: 0; - top: 24px; +.popin a[contenteditable="true"] { + color: #eceff4; } +.ProseMirror { + counter-reset: prosemirror-footnote; +} - .ProseMirror { - counter-reset: prosemirror-footnote; - } - footnote { - display: inline-block; - position: relative; - cursor: pointer; - } - footnote::after { - content: counter(prosemirror-footnote); - vertical-align: super; - font-size: 75%; - counter-increment: prosemirror-footnote; - } - .ProseMirror-hideselection .footnote-tooltip *::selection { background-color: transparent; } - .ProseMirror-hideselection .footnote-tooltip *::-moz-selection { background-color: transparent; } - .footnote-tooltip { - cursor: auto; - position: absolute; - left: -30px; - top: calc(100% + 10px); - background: silver; - padding: 3px; - border-radius: 2px; - width: 500px; - } - .footnote-tooltip::before { - border: 5px solid silver; - border-top-width: 0px; - border-left-color: transparent; - border-right-color: transparent; - position: absolute; - top: -5px; - left: 27px; - content: " "; - height: 0; - width: 0; - } +footnote { + display: inline-block; + position: relative; + cursor: pointer; +} +footnote::after { + content: counter(prosemirror-footnote); + vertical-align: super; + font-size: 75%; + counter-increment: prosemirror-footnote; +} +.ProseMirror-hideselection .footnote-tooltip *::selection { background-color: transparent; } + +.ProseMirror-hideselection .footnote-tooltip *::-moz-selection { background-color: transparent; } + +.footnote-tooltip { + cursor: auto; + position: absolute; + left: -30px; + top: calc(100% + 10px); + background: silver; + padding: 3px; + border-radius: 2px; + width: 500px; +} +.footnote-tooltip::before { + border: 5px solid silver; + border-top-width: 0px; + border-left-color: transparent; + border-right-color: transparent; + position: absolute; + top: -5px; + left: 27px; + content: " "; + height: 0; + width: 0; +} diff --git a/editor/editor.ml b/editor/editor.ml index 19480e2..1c2b8a5 100755 --- a/editor/editor.ml +++ b/editor/editor.ml @@ -2,55 +2,6 @@ open Js_of_ocaml open Brr module PM = Prosemirror -let create_new_state pm mySchema content = - let module PM = Prosemirror in - - let doc = PM.Model.( - DOMParser.parse - (DOMParser.from_schema pm mySchema) - (Jv.Id.of_jv content)) in - - let props = PM.State.creation_prop () in - props##.doc := Js.some doc; - props##.plugins := Plugins.default pm mySchema; - - PM.State.create - pm - props - -let storage_key = (Jstr.v "editor") - -let storage = Brr_io.Storage.local G.window - -(** Read the state from the local storage, or load the content from the given - element *) -let load_storage - : PM.t -> PM.Model.schema Js.t -> Jv.t -> PM.State.editor_state Js.t - = fun pm schema content -> - let opt_data = Brr_io.Storage.get_item storage storage_key in - match opt_data with - | None -> create_new_state pm schema content - | Some contents -> - (* Try to load from the storage *) - match Json.decode contents with - | Error _ -> create_new_state pm schema content - | Ok json -> - let obj = PM.State.configuration_prop () in - obj##.plugins := Plugins.default pm schema; - obj##.schema := Js.some schema; - PM.State.fromJSON pm obj json - -let save_storage - : PM.View.editor_view Js.t -> unit - = fun view -> - let contents = view##.state##toJSON () in - let storage = Brr_io.Storage.local G.window in - Brr_io.Storage.set_item - storage - storage_key - (Json.encode @@ contents) - |> Console.log_if_error ~use:() - let prosemirror id content = begin match (Jv.is_none id), (Jv.is_none content) with | false, false -> @@ -61,8 +12,6 @@ let prosemirror id content = let schema = (PM.SchemaBasic.schema pm) in let schema = Footnotes.footnote_schema pm schema in - Console.(log [ schema ]); - let specs = PM.Model.schema_spec (PM.SchemaList.add_list_nodes pm @@ -74,7 +23,7 @@ let prosemirror id content = let mySchema = PM.Model.schema pm specs in (* Create the initial state *) - let state = load_storage pm mySchema content in + let state = Storage.load pm mySchema content in let props = PM.View.direct_editor_props () in props##.state := state; @@ -90,16 +39,15 @@ let prosemirror id content = let nodes = PM.O.init [| ("footnote", view') |] in props##.nodeViews := nodes; - let view = PM.View.editor_view pm (Jv.Id.of_jv id) props in - Console.(log [Jstr.v "main view"; view]); + (* Attach an event on focus out *) let _ = Brr_note.Evr.on_el (Ev.focusout) - (fun _ -> save_storage view) + (fun _ -> Storage.save view) (Jv.Id.of_jv id) in () 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 diff --git a/editor/link_editor.ml b/editor/link_editor.ml new file mode 100755 index 0000000..454dacd --- /dev/null +++ b/editor/link_editor.ml @@ -0,0 +1,171 @@ +open Js_of_ocaml +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 -> + + let popin = El.div [] + ~at:At.([class' (Jstr.v "popin")]) in + + El.set_inline_style El.Style.display (Jstr.v "none") popin; + + let parent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv view##.dom) "parentNode") in + let () = El.append_children parent [popin] in + + let hide + : unit -> unit + = fun () -> + El.set_inline_style El.Style.display (Jstr.v "none") popin + in + + let update + : 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)) + (fun () -> hide ()) + (fun node -> + (* Check if we are editing a link *) + match PM.O.get state##.schema##.marks "link" with + | None -> () + | Some link_type -> + let is_present = link_type##isInSet node##.marks in + Js.Opt.case + 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 + let start = position##start Js.null + and end' = position##_end Js.null in + + Tooltip.set_position + ~start + ~end' + view popin; + + (* 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 a = El.a + ~at:At.[ href href' ] + [ El.txt href' ] in + + let entry = 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'); + true + + ) in + + + El.set_children popin + [ entry.field + ; entry.button ]; + + )) + + and destroy () = El.remove popin in + + object%js + val update = Js.wrap_callback update + val destroy= Js.wrap_callback destroy + end + +let plugin + : PM.t -> PM.State.plugin Js.t + = fun t -> + let state = Jv.get (Jv.Id.to_jv t) "state" in + + let params = object%js + val view = (fun view -> link_edit view) + end in + + Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |] + |> Jv.Id.of_jv diff --git a/editor/plugins.ml b/editor/plugins.ml index 69319c4..68f9c31 100755 --- a/editor/plugins.ml +++ b/editor/plugins.ml @@ -71,7 +71,7 @@ let toggle_mark | None -> Js.null | Some mark_type -> - let m = state##.schema##mark_type mark_type Js.null in + let m = state##.schema##mark_fromType mark_type Js.null in (* Delete the markup code *) let tr = (state##.tr)##delete ~from ~to_ in @@ -129,6 +129,7 @@ let default pm schema = let _ = setup##unshift keymaps in let _ = setup##push (input_rule pm) in let _ = setup##push (Tooltip.bold_plugin pm) in + let _ = setup##push (Link_editor.plugin pm) in Js.some setup diff --git a/editor/prosemirror/bindings.ml b/editor/prosemirror/bindings.ml index 1711829..49c0904 100755 --- a/editor/prosemirror/bindings.ml +++ b/editor/prosemirror/bindings.ml @@ -116,11 +116,14 @@ module Classes = struct class type mark = object ('this) - method eq - : 'this t -> bool t meth + method attrs + : 'a TypedObject.t prop method isInSet - : mark t js_array t -> mark t opt meth + : mark t js_array t -> bool t meth + + method eq + : 'this t -> bool t meth end @@ -142,7 +145,7 @@ module Classes = struct : bool t opt prop method attrs - : < .. > t opt prop + : 'a TypedObject.t prop method selectable : bool t opt prop @@ -190,6 +193,12 @@ module Classes = struct method index : depth -> int meth + method start + : depth -> int meth + + method _end + : depth -> int meth + method after : depth -> int meth @@ -258,8 +267,8 @@ module Classes = struct method node: Jstr.t -> < .. > t opt -> fragment t opt -> mark t js_array t opt -> node t meth - method mark_type: - mark_type t -> < .. > t opt -> mark t meth + method mark_fromType: + mark_type t -> 'a TypedObject.t opt -> mark t meth end @@ -335,8 +344,11 @@ module Classes = struct unit -> Jstr.t meth (** Return a debugging string that describes this element. *) - method forEach: - (node t -> int -> int) -> unit meth + method descendants + : (node t -> pos:int -> node t -> bool t) callback -> unit meth + + method forEach + : (node t -> offset:int -> index:int -> unit) callback -> unit meth end @@ -415,6 +427,9 @@ module Classes = struct method handleDOMEvents : (editor_view t -> Jv.t -> bool t) callback TypedObject.t prop + method handleClickOn + : (editor_view t -> int t -> node t -> int -> Brr.Ev.Mouse.t Brr.Ev.type' -> bool t -> bool t) callback prop + method nodeViews : (node t -> editor_view t -> (unit -> int) -> < .. > t) TypedObject.t prop @@ -468,6 +483,9 @@ module Classes = struct method coordsAtPos: int -> int opt -> < left: float prop; right: float prop; top: float prop; bottom: float prop > t meth + method domAtPos: + pos:int -> side:int opt -> < node: Brr.El.t t prop; offset: int prop > t meth + method destroy : unit meth @@ -566,6 +584,9 @@ module Classes = struct method addMark : from:int -> to_:int -> mark t -> 'this t meth + method removeMark + : from:int -> to_:int -> mark t -> 'this t meth + method replace : from:int -> to_:int -> slice t opt -> 'this t meth diff --git a/editor/prosemirror/prosemirror.ml b/editor/prosemirror/prosemirror.ml index 8c436a3..2a9b92c 100755 --- a/editor/prosemirror/prosemirror.ml +++ b/editor/prosemirror/prosemirror.ml @@ -16,6 +16,24 @@ module Model = struct include Bindings.Model + module Mark = struct + + let _set_from + : t -> 'a Js.t -> mark Js.t + = fun t element -> + let model = Jv.get t "model" in + let class_ = Jv.get model "Mark" in + Jv.call (Jv.Id.to_jv class_ ) "setFrom" [|Jv.Id.to_jv element |] + |> Jv.Id.of_jv + + + let set_from_mark + : t -> mark Js.t -> mark Js.t + = _set_from + + + end + module DOMParser = struct diff --git a/editor/prosemirror/prosemirror.mli b/editor/prosemirror/prosemirror.mli index 76545d2..9260af6 100755 --- a/editor/prosemirror/prosemirror.mli +++ b/editor/prosemirror/prosemirror.mli @@ -90,6 +90,13 @@ and Model : sig val schema : t -> schema_spec Js.t -> schema Js.t + module Mark : sig + + val set_from_mark + : t -> mark Js.t -> mark Js.t + + end + module DOMParser : sig type parser diff --git a/editor/storage.ml b/editor/storage.ml new file mode 100755 index 0000000..2dc768a --- /dev/null +++ b/editor/storage.ml @@ -0,0 +1,86 @@ +open Js_of_ocaml +open Brr +module PM = Prosemirror +let storage_key = (Jstr.v "editor") + +let storage = Brr_io.Storage.local G.window + +let create_new_state pm mySchema content = + let module PM = Prosemirror in + + let doc = PM.Model.( + DOMParser.parse + (DOMParser.from_schema pm mySchema) + (Jv.Id.of_jv content)) in + + let props = PM.State.creation_prop () in + props##.doc := Js.some doc; + props##.plugins := Plugins.default pm mySchema; + + PM.State.create + pm + props + + +let page_id + : unit -> Jstr.t option + = fun () -> + let uri = Brr.Window.location Brr.G.window in + let query = Brr.Uri.query uri in + let params = Brr.Uri.Params.of_jstr query in + Brr.Uri.Params.find (Jstr.v "page") params + +(** Read the state from the local storage, or load the content from the given + element *) +let load' + : PM.t -> PM.Model.schema Js.t -> Jv.t -> Jstr.t -> PM.State.editor_state Js.t + = fun pm schema content key -> + + let opt_data = Brr_io.Storage.get_item storage key in + match opt_data with + | None -> create_new_state pm schema content + | Some contents -> + (* Try to load from the storage *) + match Json.decode contents with + | Error _ -> create_new_state pm schema content + | Ok json -> + let obj = PM.State.configuration_prop () in + obj##.plugins := Plugins.default pm schema; + obj##.schema := Js.some schema; + PM.State.fromJSON pm obj json + +let load + : PM.t -> PM.Model.schema Js.t -> Jv.t -> PM.State.editor_state Js.t + = fun pm schema content -> + match page_id () with + | None -> load' pm schema content storage_key + | Some value -> + let key = Jstr.concat + ~sep:(Jstr.v "_") + [storage_key ; value] in + load' pm schema content key + + +(** Save the view *) +let save' + : PM.View.editor_view Js.t -> Jstr.t -> unit + = fun view key -> + let contents = view##.state##toJSON () in + let storage = Brr_io.Storage.local G.window in + Brr_io.Storage.set_item + storage + key + (Json.encode @@ contents) + |> Console.log_if_error ~use:() + + +let save + : PM.View.editor_view Js.t -> unit + = fun view -> + match page_id () with + | None -> save' view storage_key + | Some value -> + let key = Jstr.concat + ~sep:(Jstr.v "_") + [storage_key ; value] in + save' view key diff --git a/editor/tooltip.ml b/editor/tooltip.ml index 43c345f..adb37f1 100755 --- a/editor/tooltip.ml +++ b/editor/tooltip.ml @@ -9,17 +9,22 @@ module PM = Prosemirror (** Set the element position just above the selection *) let set_position - : PM.View.editor_view Js.t -> El.t -> unit - = fun view el -> + : 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; - let start = view##coordsAtPos (view##.state##.selection##.from) Js.null - and end' = view##coordsAtPos (view##.state##.selection##._to) Js.null in + + (* 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") @@ -34,7 +39,8 @@ let boldtip = fun view -> (* Create the element which will be displayed over the editor *) let tooltip = El.div [] - ~at:At.([class' (Jstr.v "tooltip")]) in + ~at:At.([ class' (Jstr.v "tooltip") + ]) in El.set_inline_style El.Style.display (Jstr.v "none") tooltip; let parent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv view##.dom) "parentNode") in @@ -51,6 +57,7 @@ let boldtip Js.Opt.bind state_opt (fun state -> state##.storedMarks) |> Js.Opt.to_option and current_stored_marks = state##.storedMarks in + let same = match previous_stored_marks, Js.Opt.to_option current_stored_marks with | Some arr1, Some arr2 -> Js_lib.Array.compare arr1 arr2 ~f:(fun v1 v2 -> v1##eq v2) @@ -69,10 +76,10 @@ let boldtip (fun _ -> Some (Jstr.v "gras"))) in let is_em = Option.bind (PM.O.get state##.schema##.marks "em") (fun mark_type -> - let is_strong = + let is_em = Js.Opt.bind current_stored_marks (fun t -> mark_type##isInSet t) in - Js.Opt.case is_strong + Js.Opt.case is_em (fun () -> None) (fun _ -> Some (Jstr.(v "emphase")))) in @@ -81,7 +88,9 @@ let boldtip | [] -> El.set_inline_style El.Style.display (Jstr.v "none") tooltip | _ -> (* The mark is present, add in the content *) - set_position view tooltip; + let start = view##.state##.selection##.from + and end' = view##.state##.selection##._to in + set_position ~start ~end' view tooltip; El.set_prop (El.Prop.jstr (Jstr.v "textContent")) (Jstr.concat marks ~sep:(Jstr.v ", ")) |