Added custom link popin in text editor

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 ", "))