diff options
Diffstat (limited to 'editor/prosemirror')
| -rwxr-xr-x | editor/prosemirror/bindings.ml | 194 | ||||
| -rwxr-xr-x | editor/prosemirror/prosemirror.ml | 117 | ||||
| -rwxr-xr-x | editor/prosemirror/prosemirror.mli | 65 |
3 files changed, 246 insertions, 130 deletions
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 |