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/prosemirror/prosemirror.ml | 116 +++++++++++++++++++++++++++++++++++---
 1 file changed, 108 insertions(+), 8 deletions(-)

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

diff --git a/editor/prosemirror/prosemirror.ml b/editor/prosemirror/prosemirror.ml
index c19abe0..e97fa9b 100755
--- a/editor/prosemirror/prosemirror.ml
+++ b/editor/prosemirror/prosemirror.ml
@@ -8,12 +8,15 @@ let v
   = fun () ->
     Jv.get Jv.global "PM"
 
+module O = Bindings.TypedObject
+
 module Model = struct
 
   include Bindings.Model
 
   module DOMParser = struct
 
+
     type parser = Jv.t
 
     let from_schema
@@ -63,6 +66,46 @@ module Model = struct
       Jv.get fragment "empty"
       |> Jv.Id.of_jv
 
+  module Dom_output_spec = struct
+
+    let v
+      : ?attrs:< .. > -> string -> domOutputSpec Js.t list -> domOutputSpec Js.t
+      = fun ?attrs name elems ->
+
+        let elems = match attrs with
+          | None -> elems
+          | Some v -> Jv.Id.(of_jv @@ to_jv @@ v)::elems in
+
+        let elems = (Jv.Id.of_jv @@ Jv.of_string name)::elems in
+        (Jv.of_list Jv.Id.to_jv elems)
+        |> Jv.Id.to_jv
+        |> Jv.Id.of_jv
+
+    let hole
+      : domOutputSpec Js.t
+      = 0
+        |> Jv.Id.to_jv
+        |> Jv.Id.of_jv
+
+    let of_
+      : 'a -> domOutputSpec Js.t
+      = fun elem ->
+        elem
+        |> Jv.Id.to_jv
+        |> Jv.Id.of_jv
+
+    let of_el
+      : Brr.El.t -> domOutputSpec Js.t
+      = of_
+
+    let of_jstr
+      : Jstr.t -> domOutputSpec Js.t
+      = of_
+
+    let of_obj
+      : < dom: node Js.t Js.readonly_prop ; contentDOM : node Js.t Js.opt Js.readonly_prop > Js.t -> domOutputSpec Js.t
+      = of_
+  end
 end
 
 module State = struct
@@ -92,6 +135,47 @@ module State = struct
       let editor_state = Jv.get state "EditorState" in
       Jv.call editor_state "fromJSON" [|Jv.Id.to_jv config ; json |]
       |> Jv.Id.of_jv
+
+  let selection_to
+    : selection Js.t -> Model.resolved_pos Js.t
+    = fun selection ->
+      Jv.Id.(of_jv @@ Jv.get (to_jv selection) "$to")
+
+  let node_selection
+    : t -> Model.resolved_pos Js.t -> node_selection Js.t
+    = fun t pos ->
+      let state = Jv.get t "state" in
+      Jv.new' (Jv.get state "NodeSelection") [| Jv.Id.to_jv pos |]
+      |> Jv.Id.of_jv
+
+  let is_selectable
+    : t -> Model.node Js.t -> bool Js.t
+    = fun t node ->
+      let selection = Jv.get (Jv.get t "state") "NodeSelection" in
+      Jv.call selection "isSelectable" [|Jv.Id.to_jv node|]
+      |> Jv.Id.of_jv
+
+  let selection_at_start
+    : t-> Model.node Js.t -> selection Js.t
+    = fun t node ->
+      let selection = Jv.get (Jv.get t "state") "NodeSelection" in
+      Jv.call selection "atStart" [|Jv.Id.to_jv node|]
+      |> Jv.Id.of_jv
+
+
+  let create_node_selection
+    : t -> Model.node Js.t -> int -> node_selection Js.t
+    = fun t doc number ->
+      let state = Jv.get t "state" in
+      Jv.call (Jv.get state "NodeSelection") "create" Jv.Id.[|to_jv doc; Jv.of_int number|]
+      |> Jv.Id.of_jv
+
+  let create_text_selection
+    : t -> Model.node Js.t -> int -> node_selection Js.t
+    = fun t doc number ->
+      let state = Jv.get t "state" in
+      Jv.call (Jv.get state "TextSelection") "create" Jv.Id.[|to_jv doc; Jv.of_int number|]
+      |> Jv.Id.of_jv
 end
 
 (* Editor view *)
@@ -142,6 +226,12 @@ module SchemaBasic = struct
       Jv.get (Jv.get t "schema_basic") "schema"
       |> Jv.Id.of_jv
 
+  let nodes
+    : t -> nodes Js.t
+    = fun t ->
+      Jv.get (Jv.get t "schema_basic") "nodes"
+      |> Jv.Id.of_jv
+
 end
 
 module History = struct
@@ -174,7 +264,7 @@ end
 module Keymap = struct
 
   let keymap
-    : t -> (string * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) array -> State.plugin Js.t
+    : t -> (string * (State.editor_state Js.t -> (State.transaction Js.t -> unit) -> bool)) 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|]
@@ -194,10 +284,20 @@ end
 
 (* Example Setup *)
 
-let example_setup
-  : t -> Model.schema Js.t -> State.plugin Js.t Js.js_array Js.t
-  = fun t schema ->
-    let setup = Jv.get t "example_setup" in
-    let props = Jv.obj [|("schema", Jv.Id.to_jv schema)|] in
-    Jv.call setup "exampleSetup" [|props|]
-    |> Jv.Id.of_jv
+module Example = struct
+
+  include Bindings.Example
+
+  let options
+    : Model.schema Js.t -> options Js.t
+    = fun schema ->
+      Jv.obj [|("schema", Jv.Id.to_jv schema)|]
+      |> Jv.Id.of_jv
+
+  let example_setup
+    : t -> options Js.t -> State.plugin Js.t Js.js_array Js.t
+    = fun t options ->
+      let setup = Jv.get t "example_setup" in
+      Jv.call setup "exampleSetup" [|Jv.Id.to_jv options|]
+      |> Jv.Id.of_jv
+end
-- 
cgit v1.2.3