From 274789e733c46e7e20fc1dc918a7251b0206b3d2 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Mon, 15 Feb 2021 23:03:21 +0100
Subject: Working key handler

---
 editor/editor.ml | 90 +++++++++++++++++++++-----------------------------------
 1 file changed, 33 insertions(+), 57 deletions(-)

(limited to 'editor/editor.ml')

diff --git a/editor/editor.ml b/editor/editor.ml
index 64fb723..d32288c 100755
--- a/editor/editor.ml
+++ b/editor/editor.ml
@@ -3,82 +3,58 @@ 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 ->
+  : PM.t -> PM.Model.resolved_pos Js.t -> int -> (int -> bool) -> PM.State.command
+  = fun pm res incr pred state dispatch ->
     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 current_level = if Jv.is_none attributes##.level then
+        0
+      else
+        attributes##.level in
+    let t, props = match pred current_level with
+      | false ->
+        (PM.O.get state##.schema##.nodes "heading"
+        , (object%js
+          val level = current_level + incr
+        end :> < > Js.t ))
+      | true ->
+        ( PM.O.get state##.schema##.nodes "paragraph"
+        , object%js end) in
+    match t with
+    | None -> Js._false
+    | Some t ->
+      PM.Commands.set_block_type pm t props state dispatch
 
-let handle_backspace pm state dispatch =
+(** 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
+  | Some _ -> Js._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
+    begin match Jstr.to_string res##.parent##._type##.name with
+      | "heading"   -> change_level pm res 1 (fun x -> x > 5) state dispatch
+      | "paragraph" -> change_level pm res 1 (fun _ -> false) state dispatch
+      | _ -> Js._false
     end
 
+let handle_backspace pm state dispatch =
 
-(** 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
+  | Some _ -> Js._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
+    begin match Jstr.to_string res##.parent##._type##.name with
+      | "heading" -> change_level pm res (-1) (fun x -> x <= 1) state dispatch
+      | _ -> Js._false
     end
 
-
 let default_plugins pm schema =
 
   let props = PM.Example.options schema in
-  props##.menuBar := Js.some false;
-  props##.floatingMenu := Js.some false;
+  props##.menuBar := Js.some Js._true;
+  props##.floatingMenu := Js.some Js._true;
   let setup = PM.Example.example_setup pm props in
 
   let keymaps =
-- 
cgit v1.2.3