From e612a344629b999e90089710646e7a0bc68597d2 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Sun, 14 Feb 2021 19:32:36 +0100
Subject: Update prosemirror

---
 editor/editor.ml | 102 ++++++++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 93 insertions(+), 9 deletions(-)

(limited to 'editor/editor.ml')

diff --git a/editor/editor.ml b/editor/editor.ml
index c32a5ba..64fb723 100755
--- a/editor/editor.ml
+++ b/editor/editor.ml
@@ -1,5 +1,96 @@
 open Js_of_ocaml
 open Brr
+module PM = Prosemirror
+
+let change_level
+  : PM.t -> PM.Model.resolved_pos Js.t -> PM.State.editor_state Js.t -> int -> (PM.State.transaction Js.t -> unit) -> (int -> bool) -> bool
+  = fun pm res state incr dispatch pred ->
+    let parent = res##.parent in
+    let attributes = parent##.attrs in
+
+    (* There are some problems to update the view when the content is empty.
+       It looks like the comparaison does not comprae the level argument.
+       In order to prevent any error, juste return in such situation.
+    *)
+    let empty_content = parent##.content##eq (PM.Model.empty_fragment pm)
+    and level = attributes##.level in
+    if (pred level || empty_content) then false
+    else
+      (* Look the position for the previous element *)
+      let resolved = (res##.doc)##resolve (res##.pos -1) in
+      let selection = PM.State.node_selection pm resolved in
+
+      let props = object%js
+        val level = level + incr
+      end in
+
+      let element = parent##copy (PM.Model.empty_fragment pm) in
+      element##.attrs := props;
+      element##.content := parent##.content;
+
+      (* Create a new transaction for replacing the selection *)
+      let tr = state##.tr in
+      let tr = tr##replaceRangeWith
+          selection##.from
+          selection##._to
+          element in
+
+      (* Return at the initial position *)
+      let position = PM.State.create_text_selection
+          pm
+          tr##.doc
+          res##.pos in
+      let tr = tr##setSelection position in
+      dispatch (tr##scrollIntoView ());
+      true
+
+let handle_backspace pm state dispatch =
+
+  (* Get the currrent node *)
+  let res = PM.State.selection_to (state##.selection) in
+
+  match Js.Opt.to_option res##.nodeBefore with
+  | Some _ -> false
+  | None -> (* Line start *)
+    let parent = res##.parent in
+    begin match Jstr.to_string parent##._type##.name with
+      | "heading" -> change_level pm res state (-1) dispatch (fun x -> x <= 1)
+      | _ -> false
+    end
+
+
+(** Increase the title level by one when pressing # at the begining of a line *)
+let handle_sharp pm state dispatch =
+  (* Get the currrent node *)
+  let res = PM.State.selection_to (state##.selection) in
+
+  match Js.Opt.to_option res##.nodeBefore with
+  | Some _ -> false
+  | None -> (* Line start *)
+    let parent = res##.parent in
+    begin match Jstr.to_string parent##._type##.name with
+      | "heading" -> change_level pm res state (+1) dispatch (fun x -> x > 5)
+      | _ -> false
+    end
+
+
+let default_plugins pm schema =
+
+  let props = PM.Example.options schema in
+  props##.menuBar := Js.some false;
+  props##.floatingMenu := Js.some false;
+  let setup = PM.Example.example_setup pm props in
+
+  let keymaps =
+    PM.Keymap.keymap pm
+      [| "Backspace", (handle_backspace pm)
+       ; "#", (handle_sharp pm)
+      |] in
+
+  (* Add the custom keymaps in the list *)
+  let _ = setup##unshift keymaps in
+
+  Js.some setup
 
 let create_new_state pm mySchema content =
   let module PM = Prosemirror in
@@ -11,7 +102,7 @@ let create_new_state pm mySchema content =
 
   let props = PM.State.creation_prop () in
   props##.doc := Js.some doc;
-  props##.plugins := Js.some (PM.example_setup pm mySchema);
+  props##.plugins := default_plugins pm mySchema;
 
   PM.State.create
     pm
@@ -50,23 +141,16 @@ let prosemirror id content =
               Console.(log [Jstr.v "Loading json"]);
 
               let history = PM.History.(history pm (history_prop ()) ) in
-              Console.(log [history]);
               let _ = history in
 
               let obj = PM.State.configuration_prop () in
-              obj##.plugins := Js.some (PM.example_setup pm mySchema);
+              obj##.plugins := default_plugins pm mySchema;
               obj##.schema := Js.some mySchema;
               PM.State.fromJSON pm obj json
           end
       in
 
       let props = PM.View.direct_editor_props () in
-      props##.dispatchTransaction := (Js.wrap_meth_callback (fun view transaction ->
-          Console.(log [ Jstr.v "Document size went from"
-                       ; transaction##.before##.content##.size ]);
-          let state = view##.state##apply transaction in
-          view##updateState state
-        ));
       props##.state := state;
 
 
-- 
cgit v1.2.3