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/bindings.ml | 262 ++++++++++++++++++++++++++++++++-----
editor/prosemirror/prosemirror.ml | 116 ++++++++++++++--
editor/prosemirror/prosemirror.mli | 56 +++++++-
3 files changed, 390 insertions(+), 44 deletions(-)
(limited to 'editor/prosemirror')
diff --git a/editor/prosemirror/bindings.ml b/editor/prosemirror/bindings.ml
index 08db819..f6d4223 100755
--- a/editor/prosemirror/bindings.ml
+++ b/editor/prosemirror/bindings.ml
@@ -1,5 +1,47 @@
open Js_of_ocaml.Js
+module TypedObject : sig
+
+ type 'a t
+
+ val get
+ : 'a t -> Jv.prop -> 'a option
+
+ val get'
+ : 'a t -> Jv.prop' -> 'a option
+
+ val set
+ : 'a t -> Jv.prop -> 'a -> unit
+
+ val set'
+ : 'a t -> Jv.prop' -> 'a -> unit
+
+end = struct
+
+ type 'a t = Jv.t
+
+ let get
+ : 'a t -> Jv.prop -> 'a
+ = fun t prop ->
+ Jv.to_option Jv.Id.of_jv (Jv.get t prop)
+
+ let get'
+ : 'a t -> Jv.prop' -> 'a
+ = fun t prop ->
+ Jv.to_option Jv.Id.of_jv (Jv.get' t prop)
+
+ let set
+ : 'a t -> Jv.prop -> 'a -> unit
+ = fun o prop v ->
+ Jv.set o prop (Jv.Id.to_jv v)
+
+ let set'
+ : 'a t -> Jv.prop' -> 'a -> unit
+ = fun o prop v ->
+ Jv.set' o prop (Jv.Id.to_jv v)
+
+end
+
class type ['a] ordered_map = object ('this)
method get:
@@ -21,63 +63,131 @@ end
module Model = struct
+ type domOutputSpec
+
+ class type _node_props = object ('this)
+
+ method inlineContent:
+ bool readonly_prop
+ (** True if this node type has inline content. *)
+
+ method isBlock:
+ bool readonly_prop
+
+ method isText:
+ bool readonly_prop
+
+ method isInline:
+ bool readonly_prop
+
+ method isTextblock:
+ bool readonly_prop
+
+ method isLeaf:
+ bool readonly_prop
+
+ method isAtom:
+ bool readonly_prop
+
+ end
+
+
type mark
type node_spec
- type mark_spec
+ type content_match
- class type schema_spec = object ('this)
+ type slice
- method nodes:
- node_spec ordered_map t readonly_prop
+ class type resolved_pos = object ('this)
+
+ method pos:
+ int readonly_prop
+
+ method depth:
+ int readonly_prop
+
+ method parent:
+ node t readonly_prop
+
+ method doc:
+ node t readonly_prop
+
+ method node:
+ int -> node t meth
+
+ method index:
+ int -> int meth
+
+ method nodeAfter:
+ node t opt readonly_prop
+
+ method nodeBefore:
+ node t opt readonly_prop
method marks:
- mark_spec ordered_map t readonly_prop
+ unit -> mark t js_array t meth
- method topNode:
- Jstr.t opt readonly_prop
+ method sameParent:
+ 'this -> bool t meth
+ method max:
+ 'this -> 'this t meth
+
+ method min:
+ 'this -> 'this t meth
end
- class type schema = object ('this)
+ and mark_spec = object ('this)
- method spec:
- schema_spec t prop
+ method toDOM:
+ (node t -> domOutputSpec t) callback writeonly_prop
+
+ method inclusive:
+ bool t prop
+
+ method spanning:
+ bool t prop
end
- type content_match
+ and schema_spec = object ('this)
- type slice
+ method nodes:
+ node_spec ordered_map t readonly_prop
- class type _node_props = object ('this)
+ method marks:
+ mark_spec ordered_map t readonly_prop
- method inlineContent:
- bool readonly_prop
- (** True if this node type has inline content. *)
+ method topNode:
+ Jstr.t opt readonly_prop
- method isBlock:
- bool readonly_prop
+ end
- method isText:
- bool readonly_prop
+ and schema = object ('this)
- method isInline:
- bool readonly_prop
+ method spec:
+ schema_spec t prop
- method isTextblock:
- bool readonly_prop
+ method nodes:
+ node_type t TypedObject.t readonly_prop
- method isLeaf:
- bool readonly_prop
+ method marks:
+ mark_type t TypedObject.t readonly_prop
- method isAtom:
- bool readonly_prop
+ method typoNodeType:
+ node_type t readonly_prop
+
+ method text:
+ Jstr.t -> node t meth
+
+ method node:
+ Jstr.t -> < .. > t opt -> fragment t opt -> mark t js_array t opt -> node t meth
end
- class type node_type = object ('this)
+ and node_type = object ('this)
inherit _node_props
@@ -96,13 +206,30 @@ module Model = struct
method hasRequiredAttrs:
unit -> bool meth
+ method create_withFragment:
+ < .. > t -> fragment t opt -> mark t opt -> node t meth
+
end
- class type mark_type = object ('this)
+ (** Signature for MarkType class
+
+ https://prosemirror.net/docs/ref/#model.MarkType
+ *)
+ and mark_type = object ('this)
+
+ method name:
+ Jstr.t readonly_prop
+
+ method schema:
+ schema t readonly_prop
+
+ method spec:
+ mark_spec t readonly_prop
+
end
(** Common signature between fragment and node *)
- class type _element = object ('this)
+ and _element = object ('this)
method childCount:
int readonly_prop
@@ -164,16 +291,29 @@ module Model = struct
node_type t readonly_prop
method attrs:
- < .. > t readonly_prop
+ < .. > t prop
method content:
- fragment t readonly_prop
+ fragment t prop
+
+ method copy:
+ fragment t -> 'this t meth
+
+ method resolve:
+ int -> resolved_pos t meth
+
+ method nodeAt:
+ int -> 'this t opt meth
method marks:
mark t js_array t readonly_prop
method sameMarkupd:
node t -> bool meth
+
+ method text:
+ Jstr.t opt prop
+
end
end
@@ -219,6 +359,12 @@ module Transform = struct
method step:
step t -> 'this t meth
+ method insert:
+ int -> Model.node t -> 'this t meth
+
+ method replaceRangeWith:
+ int -> int -> Model.node t -> 'this t meth
+
end
end
@@ -244,12 +390,33 @@ module State = struct
class type selection = object ('this)
+ method from:
+ int readonly_prop
+
+ method _to:
+ int readonly_prop
+
method content:
unit -> Model.slice t meth
method replace:
transaction t -> Model.slice t -> unit meth
+ method replaceWith:
+ transaction t -> Model.node t -> unit meth
+
+ end
+
+ and text_selection = object ('this)
+
+ inherit selection
+
+ end
+
+ and node_selection = object ('this)
+
+ inherit selection
+
end
and transaction = object ('this)
@@ -295,12 +462,19 @@ module State = struct
method replaceSelection:
Model.slice t -> 'this t meth
+ method replaceSelectionWith:
+ Model.node t -> bool t -> 'this t meth
+
method selectionSet:
bool readonly_prop
method before:
Model.node t readonly_prop
+ method scrollIntoView :
+ unit -> 'this t meth
+
+
end
class type configuration_prop = object ('this)
@@ -398,6 +572,9 @@ module View = struct
method updateState:
State.editor_state t -> unit meth
+ method dispatch:
+ State.transaction t -> unit meth
+
end
end
@@ -464,3 +641,22 @@ module History = struct
end
end
+
+module Example = struct
+
+ class type options = object ('this)
+
+ method schema:
+ Model.schema t prop
+
+ method menuBar:
+ bool opt prop
+
+ method floatingMenu:
+ bool opt prop
+
+ method history:
+ bool opt prop
+
+ end
+end
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
diff --git a/editor/prosemirror/prosemirror.mli b/editor/prosemirror/prosemirror.mli
index aa27bf4..a4c5d35 100755
--- a/editor/prosemirror/prosemirror.mli
+++ b/editor/prosemirror/prosemirror.mli
@@ -6,6 +6,8 @@ type t
val v
: unit -> t
+module O = Bindings.TypedObject
+
module rec Model : sig
include module type of Bindings.Model
@@ -34,6 +36,24 @@ module rec Model : sig
val empty_fragment
: t -> fragment Js.t
+ module Dom_output_spec : sig
+
+ val v
+ : ?attrs:< .. > -> string -> domOutputSpec Js.t list -> domOutputSpec Js.t
+
+ (** Hole element inside an output_spec element *)
+ val hole
+ : domOutputSpec Js.t
+
+ val of_el
+ : Brr.El.t -> domOutputSpec Js.t
+
+ val of_jstr
+ : Jstr.t -> domOutputSpec Js.t
+
+ val of_obj
+ : < dom: node Js.t Js.readonly_prop ; contentDOM : node Js.t Js.opt Js.readonly_prop > Js.t -> domOutputSpec Js.t
+ end
end
@@ -62,6 +82,24 @@ and State : sig
val fromJSON
: t -> configuration_prop Js.t -> Brr.Json.t -> editor_state Js.t
+ val selection_to
+ : selection Js.t -> Model.resolved_pos Js.t
+
+ val selection_at_start
+ : t-> Model.node Js.t -> selection Js.t
+
+ val is_selectable
+ : t -> Model.node Js.t -> bool Js.t
+
+ val node_selection
+ : t -> Model.resolved_pos Js.t -> node_selection Js.t
+
+ val create_node_selection
+ : t -> Model.node Js.t -> int -> node_selection Js.t
+
+ val create_text_selection
+ : t -> Model.node Js.t -> int -> text_selection Js.t
+
end
(* Editor view *)
@@ -91,6 +129,10 @@ module SchemaBasic : sig
val schema
: t -> Model.schema Js.t
+ val nodes
+ : t -> nodes Js.t
+
+
end
module History : sig
@@ -113,7 +155,7 @@ end
module Keymap : sig
val 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
end
@@ -126,5 +168,13 @@ end
(* Example Setup *)
-val example_setup
- : t -> Model.schema Js.t -> State.plugin Js.t Js.js_array Js.t
+module Example : sig
+
+ include module type of Bindings.Example
+
+ val options
+ : Model.schema Js.t -> options Js.t
+
+ val example_setup
+ : t -> options Js.t -> State.plugin Js.t Js.js_array Js.t
+end
--
cgit v1.2.3