From 3f5e3dd53755dd67c24721afc62e32d2187e3583 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Wed, 24 Feb 2021 20:51:43 +0100
Subject: Update editor code

---
 editor/prosemirror/prosemirror.ml | 117 ++++++++++++++++++++++++--------------
 1 file changed, 75 insertions(+), 42 deletions(-)

(limited to 'editor/prosemirror/prosemirror.ml')

diff --git a/editor/prosemirror/prosemirror.ml b/editor/prosemirror/prosemirror.ml
index e2758c7..e37cc3b 100755
--- a/editor/prosemirror/prosemirror.ml
+++ b/editor/prosemirror/prosemirror.ml
@@ -3,6 +3,8 @@ open Brr
 
 type t = Jv.t
 
+type t' = t
+
 let v
   : unit -> t
   = fun () ->
@@ -112,10 +114,6 @@ module State = struct
 
   include Bindings.State
 
-  type dispatch = (transaction Js.t -> unit)
-
-  type command = editor_state Js.t -> dispatch Js.opt -> bool Js.t
-
   let configuration_prop
     : unit -> configuration_prop Js_of_ocaml.Js.t
     = fun () -> Js_of_ocaml.Js.Unsafe.obj [||]
@@ -181,6 +179,10 @@ module State = struct
       Jv.call (Jv.get state "TextSelection") "create" Jv.Id.[|to_jv doc; Jv.of_int number|]
       |> Jv.Id.of_jv
 
+  let cursor
+    : selection Js.t -> Model.resolved_pos Js.t Js.opt
+    = fun selection ->
+      Jv.Id.(of_jv @@ Jv.get (to_jv selection) "$cursor")
 end
 
 (* Editor view *)
@@ -199,46 +201,37 @@ module View = struct
   let editor_view
     : t -> El.t -> direct_editor_props Js.t -> editor_view Js.t
     = fun t node props ->
-      let view = Jv.get t "view" in
-      Jv.new' (Jv.get view "EditorView") [|Jv.Id.to_jv node ; Jv.Id.to_jv props|]
-      |> Jv.Id.of_jv
-end
-
-module SchemaList = struct
-
-  let add_list_nodes
-    : t -> Model.node_spec Bindings.ordered_map Js.t -> Jstr.t -> Jstr.t option -> Model.node_spec Bindings.ordered_map Js.t
-    = fun t nodes item_content list_group_opt ->
-      let schema_list = Jv.get t "schema_list" in
-
-      let list_group = Jv.of_option ~none:Jv.null Jv.of_jstr list_group_opt in
-
-      Jv.call schema_list "addListNodes"
-        [|Jv.Id.to_jv nodes
-         ; Jv.of_jstr item_content
-         ; list_group |]
+      Jv.new' (Jv.get (Jv.get t "view") "EditorView") [|Jv.Id.to_jv node ; Jv.Id.to_jv props|]
       |> Jv.Id.of_jv
 
 end
 
-module SchemaBasic = struct
+module Commands = struct
 
-  include Bindings.SchemaBasic
+  type t = State.editor_state Js.t -> State.dispatch Js.opt -> bool Js.t
 
-  let schema
-    : t -> Model.schema Js.t
+  let baseKeymap
+    : t' -> (string * t) array
     = fun t ->
-      Jv.get (Jv.get t "schema_basic") "schema"
+      Jv.get (Jv.get t "commands") "baseKeymap"
       |> Jv.Id.of_jv
 
-  let nodes
-    : t -> nodes Js.t
-    = fun t ->
-      Jv.get (Jv.get t "schema_basic") "nodes"
+  let set_block_type
+    : t' -> Model.node_type Js.t -> < .. > Js.t Js.opt -> t
+    = fun t node props ->
+      Jv.call (Jv.get t "commands") "setBlockType" Jv.Id.[| to_jv node ; to_jv props |]
+      |> Jv.Id.of_jv
+
+  let toggle_mark
+    : t' -> Model.mark_type Js.t -> < .. > Js.t Js.opt -> t
+    = fun t mark props ->
+      Jv.call (Jv.get t "commands") "toggleMark" Jv.Id.[| to_jv mark ; to_jv props |]
       |> Jv.Id.of_jv
 
+
 end
 
+
 module History = struct
 
   include Bindings.History
@@ -254,13 +247,13 @@ module History = struct
       |> Jv.Id.of_jv
 
   let undo
-    : t -> State.command
+    : t -> Commands.t
     = fun t state fn ->
       Jv.call (Jv.get t "history") "undo" [|Jv.Id.to_jv state; Jv.repr fn|]
       |> Jv.Id.of_jv
 
   let redo
-    : t -> State.command
+    : t -> Commands.t
     = fun t state fn ->
       Jv.call (Jv.get t "history") "redo" [|Jv.Id.to_jv state; Jv.repr fn|]
       |> Jv.Id.of_jv
@@ -269,7 +262,7 @@ end
 module Keymap = struct
 
   let keymap
-    : t -> (string * State.command) array -> State.plugin Js.t
+    : t -> (string * Commands.t) array -> State.plugin Js.t
     = fun t props ->
       let props = Jv.obj @@ Array.map (fun (id, f) -> (id, Jv.repr f)) props in
       Jv.call (Jv.get t "keymap") "keymap" [|props|]
@@ -277,21 +270,61 @@ module Keymap = struct
 
 end
 
-module Commands = struct
+module InputRule = struct
 
-  let baseKeymap
-    : t -> (string * State.command) array
+  type input_rule
+
+  let create
+    : t -> Js.regExp Js.t -> fn:(State.editor_state Js.t -> Jstr.t Js.js_array Js.t -> from:int -> to_:int -> State.transaction Js.t Js.opt) Js.callback -> input_rule Js.t
+    = fun t match' ~fn ->
+      Jv.new' (Jv.get (Jv.get t "inputrules") "InputRule") [|Jv.Id.to_jv match' ; Jv.Id.to_jv fn|]
+      |> Jv.Id.of_jv
+
+  let to_plugin
+    : t -> input_rule Js.t Js.js_array Js.t -> State.plugin Js.t
+    = fun t rules ->
+      let obj = Jv.obj [|("rules", Jv.Id.to_jv rules)|] in
+      Jv.call (Jv.get t "inputrules") "inputRules" [| obj |]
+      |> Jv.Id.of_jv
+
+end
+
+module SchemaBasic = struct
+
+  include Bindings.SchemaBasic
+
+  let schema
+    : t -> Model.schema Js.t
     = fun t ->
-      Jv.get (Jv.get t "commands") "baseKeymap"
+      Jv.get (Jv.get t "schema_basic") "schema"
       |> Jv.Id.of_jv
 
-  let set_block_type
-    : t -> Model.node_type Js.t -> < .. > Js.t -> State.command
-    = fun t node props ->
-      Jv.call (Jv.get t "commands") "setBlockType" Jv.Id.[| to_jv node ; to_jv props |]
+  let nodes
+    : t -> nodes Js.t
+    = fun t ->
+      Jv.get (Jv.get t "schema_basic") "nodes"
+      |> Jv.Id.of_jv
+
+end
+
+module SchemaList = struct
+
+  let add_list_nodes
+    : t -> Model.node_spec Bindings.ordered_map Js.t -> Jstr.t -> Jstr.t option -> Model.node_spec Bindings.ordered_map Js.t
+    = fun t nodes item_content list_group_opt ->
+      let schema_list = Jv.get t "schema_list" in
+
+      let list_group = Jv.of_option ~none:Jv.null Jv.of_jstr list_group_opt in
+
+      Jv.call schema_list "addListNodes"
+        [|Jv.Id.to_jv nodes
+         ; Jv.of_jstr item_content
+         ; list_group |]
       |> Jv.Id.of_jv
+
 end
 
+
 (* Example Setup *)
 
 module Example = struct
-- 
cgit v1.2.3