From d17d17261faccb3eb42e91f88ca035e5b1730c66 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Sun, 31 Jan 2021 04:21:01 +0100 Subject: Bindings to prosemirror --- editor/prosemirror/bindings.ml | 376 +++++++++++++++++++++++++++++++++++++ editor/prosemirror/dune | 9 + editor/prosemirror/prosemirror.ml | 206 ++++++++++++++++++++ editor/prosemirror/prosemirror.mli | 145 ++++++++++++++ 4 files changed, 736 insertions(+) create mode 100755 editor/prosemirror/bindings.ml create mode 100755 editor/prosemirror/dune create mode 100755 editor/prosemirror/prosemirror.ml create mode 100755 editor/prosemirror/prosemirror.mli (limited to 'editor/prosemirror') diff --git a/editor/prosemirror/bindings.ml b/editor/prosemirror/bindings.ml new file mode 100755 index 0000000..d2ef2e6 --- /dev/null +++ b/editor/prosemirror/bindings.ml @@ -0,0 +1,376 @@ +open Js_of_ocaml.Js + +module Model = struct + + type mark + + type schema + + type content_match + + type node_spec + + type slice + + 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 + + class type node_type = object ('this) + + inherit _node_props + + method name: + string readonly_prop + + method schema: + schema t readonly_prop + + method spec: + node_spec t readonly_prop + + method contentMatch: + content_match t readonly_prop + + method hasRequiredAttrs: + unit -> bool meth + + end + + class type mark_type = object ('this) + end + + (** Common signature between fragment and node *) + class type _element = object ('this) + + method childCount: + int readonly_prop + (** The number of children that the node has. *) + + method child: + int -> node t meth + (** Get the child node at the given index. Raise an error when the index + is out of range. *) + + method maybeChild: + int -> node t opt meth + (** Get the child node at the given index, if it exists. *) + + method eq: + 'this t -> bool meth + (** Compare this element to another one. *) + + method cut: + int -> int opt -> 'this meth + (** Cut out the element between the two given positions. *) + + method toString: + unit -> Jstr.t meth + (** Return a debugging string that describes this element. *) + + method forEach: + (node t -> int -> int) -> unit meth + + end + + and fragment = object ('this) + + inherit _element + + method size: + int readonly_prop + (** The size of the fragment, which is the total of the size of its + content nodes. *) + + method append: + 'this t -> 'this t meth + + method lastChild: + node t opt readonly_prop + + method firstChild: + node t opt readonly_prop + + end + + and node = object ('this) + + inherit _element + + inherit _node_props + + method _type: + node_type t readonly_prop + + method attrs: + < .. > t readonly_prop + + method content: + fragment t readonly_prop + + method marks: + mark t js_array t readonly_prop + + method sameMarkupd: + node t -> bool meth + end + +end + +module Transform = struct + + type step_result + + class type step = object ('this) + + end + + class type replace_step = object ('this) + + inherit step + + end + + class type replace_around_step = object ('this) + + inherit step + + end + + class type add_mark_step = object ('this) + + inherit step + + end + + + class type transform = object ('this) + + method doc: + Model.node t readonly_prop + + method steps: + step t js_array t readonly_prop + + method docs: + Model.node t js_array t readonly_prop + + method step: + step t -> 'this t meth + + end + +end + +(** + + The class is defined outside of the module View for prevent recursive + declaration. + +*) +class type _editor_props = object ('this) + +end + + +module State = struct + + class type plugin = object ('this) + + method props : _editor_props t readonly_prop + + end + + class type selection = object ('this) + + method content: + unit -> Model.slice t meth + + method replace: + transaction t -> Model.slice t -> unit meth + + end + + and transaction = object ('this) + + inherit Transform.transform + + method time: + int readonly_prop + + method setTime: + int -> 'this t meth + + method storedMarks: + Model.mark t js_array t opt readonly_prop + + method setStoredMarks: + Model.mark t js_array t opt -> 'this t meth + + method addStoredMark: + Model.mark t -> 'this t meth + + method removeStoredMark_mark: + Model.mark t -> 'this t meth + + method removeStoredMark_marktype: + Model.mark_type t -> 'this t meth + + method ensureMarks: + Model.mark t js_array t -> 'this t meth + + method storedMarksSet: + bool readonly_prop + + method selection: + selection t readonly_prop + + method setSelection: + selection t -> 'this t meth + + method deleteSelection: + 'this t meth + + method replaceSelection: + Model.slice t -> 'this t meth + + method selectionSet: + bool readonly_prop + + method before: + Model.node t readonly_prop + + end + + class type configuration_prop = object ('this) + + method schema: + Model.schema t opt prop + + method plugins: + plugin t js_array t opt prop + + end + + class type creation_prop = object ('this) + + inherit configuration_prop + + method doc: + Model.node t opt prop + + method selection: + selection t opt prop + + method storedMarks: + Model.mark t js_array t opt prop + + end + + class type editor_state = object ('this) + + method doc : + Model.node t readonly_prop + + method selection: + selection t readonly_prop + + method storedMarks: + Model.mark t js_array t opt readonly_prop + + method schema: + Model.schema t readonly_prop + + method plugins: + plugin t js_array t readonly_prop + + method apply: + transaction t -> 'this t meth + + method tr: + transaction t readonly_prop + + method reconfigure: + configuration_prop t meth + + method toJSON: + unit -> Brr.Json.t meth + + end + +end + +module View = struct + + class type editor_props = _editor_props + + class type direct_editor_props = object ('this) + + inherit editor_props + + method state: + State.editor_state t writeonly_prop + + (** The call back is called with this = instance of editor_view *) + method dispatchTransaction: + (editor_view t, State.transaction t -> unit) meth_callback writeonly_prop + + end + + and editor_view = object ('this) + + method state: + State.editor_state t readonly_prop + + method dom: + Brr.El.t readonly_prop prop + + method editable: + bool readonly_prop prop + + method update: + direct_editor_props t -> unit meth + + method setProps: + direct_editor_props t -> unit meth + + method updateState: + State.editor_state t -> unit meth + + end + +end + +module History = struct + + class type history_prop = object ('this) + + method depth: int opt prop + + method newGroupDelay: int opt prop + + end + +end diff --git a/editor/prosemirror/dune b/editor/prosemirror/dune new file mode 100755 index 0000000..4fff7b2 --- /dev/null +++ b/editor/prosemirror/dune @@ -0,0 +1,9 @@ +(library + (name prosemirror) + (libraries + brr + js_of_ocaml + j + ) + (preprocess (pps js_of_ocaml-ppx)) + ) diff --git a/editor/prosemirror/prosemirror.ml b/editor/prosemirror/prosemirror.ml new file mode 100755 index 0000000..bf72227 --- /dev/null +++ b/editor/prosemirror/prosemirror.ml @@ -0,0 +1,206 @@ +open Js_of_ocaml +open Brr + +type t = Jv.t + +let v + : unit -> t + = fun () -> + Jv.get Jv.global "PM" + +type pm_schema + +type pm_state = Jv.t + +type pm_view = Jv.t + + +let state + : (t, pm_state) J.prop + = J.prop "state" + +let view + : (t, pm_view) J.prop + = J.prop "view" + +type schema + +let schema_basic + : (t, Jv.t) J.prop + = J.prop "schema_basic" + +(* Model *) + +type pm_model = Jv.t + +let model + : (t, pm_model) J.prop + = J.prop "model" + +module Model = struct + + include Bindings.Model + + module DOMParser = struct + + type t = Jv.t + + let from_schema + : pm_model -> schema Js.t -> t + = fun model schema -> + let parser = Jv.get model "DOMParser" in + Jv.call (Jv.Id.to_jv parser) "fromSchema" [|Jv.Id.to_jv schema|] + + let parse + : t -> El.t -> node Js.t + = fun dom_parser el -> + Jv.call dom_parser "parse" [|Jv.Id.to_jv el|] + |> Jv.Id.of_jv + + end + + let empty_fragment + : t -> fragment Js.t + = fun t -> + let model = Jv.get t "model" in + let fragment = Jv.get model "Fragment" in + Jv.get fragment "empty" + |> Jv.Id.of_jv + +end + +type pm_transform = Jv.t + +let transform + : (t, pm_transform) J.prop + = J.prop "prosemirror-transform" + + +module State = struct + + include Bindings.State + + let configuration_prop + : unit -> configuration_prop Js_of_ocaml.Js.t + = fun () -> Js_of_ocaml.Js.Unsafe.obj [||] + + let creation_prop + : unit -> creation_prop Js.t + = fun () -> Js_of_ocaml.Js.Unsafe.obj [||] + + let create + : pm_state -> creation_prop Js.t -> editor_state Js.t + = fun state props -> + let editor_state = Jv.get state "EditorState" in + Jv.call editor_state "create" [|Jv.Id.to_jv props|] + |> Jv.Id.of_jv + + let fromJSON + : pm_state -> configuration_prop Js_of_ocaml.Js.t -> Brr.Json.t -> editor_state Js.t + = fun state config json -> + let editor_state = Jv.get state "EditorState" in + Jv.call editor_state "fromJSON" [|Jv.Id.to_jv config ; json |] + |> Jv.Id.of_jv +end + +(* Editor view *) + +module View = struct + + module EditorProps = struct + type t = Jv.t + end + + include Bindings.View + let direct_editor_props + : unit -> direct_editor_props Js.t + = fun () -> Js_of_ocaml.Js.Unsafe.obj [||] + + let editor_view + : pm_view -> El.t -> direct_editor_props Js.t -> editor_view Js.t + = fun view node props -> + Jv.new' (Jv.get view "EditorView") [|Jv.Id.to_jv node ; Jv.Id.to_jv props|] + |> Jv.Id.of_jv +end + +(* Schema list *) + +type schema_list = Jv.t + +let schema_list + : (t, schema_list) J.prop + = J.prop "schema_list" + +module SchemaList = struct + + let js f = Jv.of_jstr @@ Jstr.v f + + let js_opt = Jv.of_option + ~none:Jv.null + js + + let add_list_nodes + : schema_list -> ?listGroup:string -> node:Model.node Js.t -> itemContent:string -> unit + = fun s ?listGroup ~node ~itemContent -> + Jv.call (Jv.Id.to_jv s) "addListNodes" [|Jv.Id.to_jv node; js itemContent ; js_opt listGroup|] + |> ignore + +end + +module History = struct + + include Bindings.History + + let history_prop + : unit -> history_prop Js.t + = fun () -> Js_of_ocaml.Js.Unsafe.obj [||] + + let history + : t -> history_prop Js.t -> State.plugin Js.t + = fun t props -> + Jv.call (Jv.get t "history") "history" [|Jv.Id.to_jv props|] + |> Jv.Id.of_jv + + let undo + : t -> State.editor_state Js.t -> (State.transaction -> unit) -> bool + = 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.editor_state Js.t -> (State.transaction -> unit) -> bool + = fun t state fn -> + Jv.call (Jv.get t "history") "redo" [|Jv.Id.to_jv state; Jv.repr fn|] + |> Jv.Id.of_jv +end + +module Keymap = struct + + let keymap + : t -> (string * (State.editor_state Js.t -> (State.transaction -> 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|] + |> Jv.Id.of_jv + +end + +module Commands = struct + + let baseKeymap + : t -> (string * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) array + = fun t -> + Jv.get (Jv.get t "commands") "baseKeymap" + |> Jv.Id.of_jv + +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 diff --git a/editor/prosemirror/prosemirror.mli b/editor/prosemirror/prosemirror.mli new file mode 100755 index 0000000..1e0e889 --- /dev/null +++ b/editor/prosemirror/prosemirror.mli @@ -0,0 +1,145 @@ +open Js_of_ocaml +open Brr + +type t + +val v + : unit -> t + +type schema_list + +type pm_schema + +type pm_state + +type pm_view + +type pm_model + +type pm_transform + +val state + : (t, pm_state) J.prop + +val view + : (t, pm_view) J.prop + +val model + : (t, pm_model) J.prop + +type schema + +val schema_basic + : (t, Jv.t) J.prop + +val schema_list + : (t, schema_list) J.prop + + +val transform + : (t, pm_transform) J.prop + + +module rec Model : sig + + include module type of Bindings.Model + + + module DOMParser : sig + type t + + val from_schema + : pm_model -> schema Js.t -> t + + val parse + : t -> El.t -> node Js.t + + end + + val empty_fragment + : t -> fragment Js.t + +end + +and SchemaList : sig + + val add_list_nodes + : schema_list -> ?listGroup:string -> node:Model.node Js.t -> itemContent:string -> unit + +end + +(* State *) + +and State : sig + + include module type of Bindings.State + + val configuration_prop + : unit -> configuration_prop Js.t + + val creation_prop + : unit -> creation_prop Js.t + + val create + : pm_state -> creation_prop Js.t -> editor_state Js.t + + val fromJSON + : pm_state -> configuration_prop Js.t -> Brr.Json.t -> editor_state Js.t + +end + +(* Editor view *) + +and View : sig + + module EditorProps : sig + + type t + + end + + include module type of Bindings.View + + val direct_editor_props + : unit -> direct_editor_props Js.t + + val editor_view + : pm_view -> El.t -> direct_editor_props Js.t -> editor_view Js.t + +end + +module History : sig + + include module type of Bindings.History + + val history_prop + : unit -> history_prop Js.t + + val history + : t -> history_prop Js.t -> State.plugin Js.t + + val undo + : t -> State.editor_state Js.t -> (State.transaction -> unit) -> bool + + val redo + : t -> State.editor_state Js.t -> (State.transaction -> unit) -> bool +end + +module Keymap : sig + + val keymap + : t -> (string * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) array -> State.plugin Js.t + +end + +module Commands : sig + + val baseKeymap + : t -> (string * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) array + +end + +(* Example Setup *) + +val example_setup + : t -> Model.schema Js.t -> State.plugin Js.t Js.js_array Js.t -- cgit v1.2.3