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/bindings.ml     | 194 +++++++++++++++++++++++++------------
 editor/prosemirror/prosemirror.ml  | 117 ++++++++++++++--------
 editor/prosemirror/prosemirror.mli |  65 ++++++++-----
 3 files changed, 246 insertions(+), 130 deletions(-)

(limited to 'editor/prosemirror')

diff --git a/editor/prosemirror/bindings.ml b/editor/prosemirror/bindings.ml
index cb5a47c..4b95b73 100755
--- a/editor/prosemirror/bindings.ml
+++ b/editor/prosemirror/bindings.ml
@@ -92,7 +92,15 @@ module Model = struct
   end
 
 
-  type mark
+  class type mark = object ('this)
+
+    method eq:
+      'this t -> bool t meth
+
+    method isInSet:
+      mark t js_array t -> mark t opt meth
+
+  end
 
   type node_spec
 
@@ -100,6 +108,8 @@ module Model = struct
 
   type slice
 
+  type depth = int opt
+
   class type resolved_pos = object ('this)
 
     method pos:
@@ -115,10 +125,13 @@ module Model = struct
       node t readonly_prop
 
     method node:
-      int -> node t meth
+      depth -> node t meth
 
     method index:
-      int -> int meth
+      depth -> int meth
+
+    method after:
+      depth -> int meth
 
     method nodeAfter:
       node t opt readonly_prop
@@ -142,7 +155,7 @@ module Model = struct
   and mark_spec = object ('this)
 
     method toDOM:
-      (node t -> domOutputSpec t) callback writeonly_prop
+      (node t -> domOutputSpec t) callback prop
 
     method inclusive:
       bool t prop
@@ -185,6 +198,9 @@ module Model = 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
+
   end
 
   and node_type = object ('this)
@@ -204,7 +220,7 @@ module Model = struct
       content_match t readonly_prop
 
     method hasRequiredAttrs:
-      unit -> bool meth
+      unit -> bool t meth
 
     method create_withFragment:
       < .. > t -> fragment t opt -> mark t opt -> node t meth
@@ -226,6 +242,9 @@ module Model = struct
     method spec:
       mark_spec t readonly_prop
 
+    method isInSet:
+      mark t js_array t -> mark t opt meth
+
   end
 
   (** Common signature between fragment and node *)
@@ -245,7 +264,7 @@ module Model = struct
     (** Get the child node at the given index, if it exists. *)
 
     method eq:
-      'this t -> bool meth
+      'this t -> bool t meth
     (** Compare this element to another one. *)
 
     method cut:
@@ -309,7 +328,7 @@ module Model = struct
       mark t js_array t readonly_prop
 
     method sameMarkupd:
-      node t -> bool meth
+      node t -> bool t meth
 
     method text:
       Jstr.t opt prop
@@ -359,39 +378,97 @@ module Transform = struct
     method step:
       step t -> 'this t meth
 
+    method addMark:
+      from:int -> to_:int -> Model.mark t -> 'this t meth
+
+    method delete:
+      from:int -> to_:int -> 'this t meth
+
     method insert:
-      int -> Model.node t -> 'this t meth
+      pos:int -> Model.node t -> 'this t meth
 
     method replaceRangeWith:
-      int -> int -> Model.node t -> 'this t meth
+      from:int -> to_:int -> Model.node t -> 'this t meth
 
     method setBlockType:
-      int -> int -> Model.node_type t -> < .. > t -> 'this t meth
+      from:int -> to_:int -> Model.node_type t -> < .. > t -> 'this t meth
 
   end
 
 end
 
-(**
 
-   The class is defined outside of the module View for prevent recursive
-   declaration.
+module Classes = struct
 
-*)
-class type _editor_props = object ('this)
 
-end
+  (** View *)
+  class type editor_props = object ('this)
 
+    method editable:
+      (editor_state t -> bool t) callback prop
+  end
 
-module State = struct
+  and direct_editor_props = object ('this)
 
-  class type plugin = object ('this)
+    inherit editor_props
 
-    method props : _editor_props t readonly_prop
+    method state:
+      editor_state t writeonly_prop
 
+    (** The call back is called with this = instance of editor_view *)
+    method dispatchTransaction:
+      (editor_view t, transaction t -> unit) meth_callback writeonly_prop
   end
 
-  class type selection = object ('this)
+  and editor_view = object ('this)
+
+    method state:
+      editor_state t readonly_prop
+
+    method dom:
+      Brr.El.t readonly_prop prop
+
+    method editable:
+      bool t readonly_prop
+
+    method props:
+      direct_editor_props t readonly_prop
+
+    method update:
+      direct_editor_props t -> unit meth
+
+    method setProps:
+      direct_editor_props t -> unit meth
+
+    method updateState:
+      editor_state t -> unit meth
+
+    method posAtCoords:
+      < left: float prop ; top: float prop > t -> < pos: int prop; inside: int prop> t meth
+
+    method coordsAtPos:
+      int -> int opt -> < left: float prop; right: float prop; top: float prop; bottom: float prop > t meth
+
+    method dispatch:
+      transaction t -> unit meth
+
+  end
+
+  (** State *)
+
+  and plugin = object ('this)
+
+    method props : editor_props t opt prop
+
+    method view:
+      (editor_view t -> < .. > t) callback opt prop
+
+    method filterTransaction:
+      (transaction t -> editor_state t -> bool t) opt prop
+
+  end
+
+  and selection = object ('this)
 
     method from:
       int readonly_prop
@@ -399,6 +476,12 @@ module State = struct
     method _to:
       int readonly_prop
 
+    method empty:
+      bool t readonly_prop
+
+    method eq:
+      'this t -> bool t meth
+
     method content:
       unit -> Model.slice t meth
 
@@ -474,13 +557,15 @@ module State = struct
     method before:
       Model.node t readonly_prop
 
+    method insertText:
+      Jstr.t -> from:int opt -> to_:int opt -> 'this t meth
+
     method scrollIntoView :
       unit -> 'this t meth
 
-
   end
 
-  class type configuration_prop = object ('this)
+  and configuration_prop = object ('this)
 
     method schema:
       Model.schema t opt prop
@@ -490,7 +575,7 @@ module State = struct
 
   end
 
-  class type creation_prop = object ('this)
+  and creation_prop = object ('this)
 
     inherit configuration_prop
 
@@ -505,7 +590,7 @@ module State = struct
 
   end
 
-  class type editor_state = object ('this)
+  and editor_state = object ('this)
 
     method doc :
       Model.node t readonly_prop
@@ -538,45 +623,37 @@ module State = struct
 
 end
 
-module View = struct
-
-  class type editor_props = _editor_props
-
-  class type direct_editor_props = object ('this)
-
-    inherit editor_props
+module State = struct
 
-    method state:
-      State.editor_state t writeonly_prop
+  class type plugin = Classes.plugin
+  class type selection = Classes.selection
+  class type text_selection = Classes.text_selection
+  class type node_selection = Classes.node_selection
+  class type transaction = Classes.transaction
+  class type configuration_prop = Classes.configuration_prop
+  class type creation_prop = Classes.creation_prop
+  class type editor_state = Classes.editor_state
 
-    (** The call back is called with this = instance of editor_view *)
-    method dispatchTransaction:
-      (editor_view t, State.transaction t -> unit) meth_callback writeonly_prop
+  type dispatch = (Classes.transaction t -> unit)
+end
 
-  end
+module View = struct
 
-  and editor_view = object ('this)
+  class type editor_props = Classes.editor_props
 
-    method state:
-      State.editor_state t readonly_prop
+  class type direct_editor_props = Classes.direct_editor_props
 
-    method dom:
-      Brr.El.t readonly_prop prop
+  class type editor_view = Classes.editor_view
 
-    method editable:
-      bool readonly_prop prop
+end
 
-    method update:
-      direct_editor_props t -> unit meth
+module History = struct
 
-    method setProps:
-      direct_editor_props t -> unit meth
+  class type history_prop = object ('this)
 
-    method updateState:
-      State.editor_state t -> unit meth
+    method depth: int opt prop
 
-    method dispatch:
-      State.transaction t -> unit meth
+    method newGroupDelay: int opt prop
 
   end
 
@@ -633,18 +710,6 @@ module SchemaBasic = struct
 
 end
 
-module History = struct
-
-  class type history_prop = object ('this)
-
-    method depth: int opt prop
-
-    method newGroupDelay: int opt prop
-
-  end
-
-end
-
 module Example = struct
 
   class type options = object ('this)
@@ -662,4 +727,5 @@ module Example = struct
       bool t opt prop
 
   end
+
 end
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
diff --git a/editor/prosemirror/prosemirror.mli b/editor/prosemirror/prosemirror.mli
index 7a723d3..eac895a 100755
--- a/editor/prosemirror/prosemirror.mli
+++ b/editor/prosemirror/prosemirror.mli
@@ -3,6 +3,8 @@ open Brr
 
 type t
 
+type t' = t
+
 val v
   : unit -> t
 
@@ -57,13 +59,6 @@ module rec Model : sig
 
 end
 
-and SchemaList : sig
-
-  val 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
-
-end
-
 (* State *)
 
 and State : sig
@@ -100,9 +95,8 @@ and State : sig
   val create_text_selection 
     : t -> Model.node Js.t -> int -> text_selection Js.t
 
-  type dispatch = (transaction Js.t -> unit)
-
-  type command = editor_state Js.t -> dispatch Js.opt -> bool Js.t
+  val cursor 
+    : selection Js.t -> Model.resolved_pos Js.t Js.opt
 
 end
 
@@ -126,16 +120,18 @@ and View : sig
 
 end
 
-module SchemaBasic : sig
+module Commands : sig
 
-  include module type of Bindings.SchemaBasic
+  type t = State.editor_state Js.t -> State.dispatch Js.opt -> bool Js.t
 
-  val schema 
-    : t -> Model.schema Js.t
+  val baseKeymap 
+    : t' -> (string * t) array
 
-  val nodes 
-    : t -> nodes Js.t
+  val set_block_type 
+    : t' -> Model.node_type Js.t -> < .. > Js.t Js.opt -> t
 
+  val toggle_mark 
+    : t' -> Model.mark_type Js.t -> < .. > Js.t Js.opt -> t
 
 end
 
@@ -150,26 +146,47 @@ module History : sig
     : t -> history_prop Js.t -> State.plugin Js.t
 
   val undo 
-    : t -> State.command
+    : t -> Commands.t
 
   val redo
-    : t -> State.command
+    : t -> Commands.t
 end
 
 module Keymap : sig
 
   val keymap
-    : t -> (string * State.command) array -> State.plugin Js.t
+    : t -> (string * Commands.t) array -> State.plugin Js.t
 
 end
 
-module Commands : sig
+module InputRule : sig
 
-  val baseKeymap 
-    : t -> (string * State.command) array
+  type input_rule
 
-  val set_block_type 
-    : t -> Model.node_type Js.t -> < .. > Js.t -> State.command
+  (** Create a new input rule for the given regExp. *)
+  val 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
+
+  val to_plugin
+    : t -> input_rule Js.t Js.js_array Js.t -> State.plugin Js.t
+end
+
+module SchemaBasic : sig
+
+  include module type of Bindings.SchemaBasic
+
+  val schema 
+    : t -> Model.schema Js.t
+
+  val nodes 
+    : t -> nodes Js.t
+
+end
+
+module SchemaList : sig
+
+  val 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
 
 end
 
-- 
cgit v1.2.3