diff options
Diffstat (limited to 'editor/prosemirror')
| -rwxr-xr-x | editor/prosemirror/bindings.ml | 577 | ||||
| -rwxr-xr-x | editor/prosemirror/prosemirror.ml | 74 | ||||
| -rwxr-xr-x | editor/prosemirror/prosemirror.mli | 140 |
3 files changed, 543 insertions, 248 deletions
diff --git a/editor/prosemirror/bindings.ml b/editor/prosemirror/bindings.ml index 4b95b73..1711829 100755 --- a/editor/prosemirror/bindings.ml +++ b/editor/prosemirror/bindings.ml @@ -16,6 +16,12 @@ module TypedObject : sig val set' : 'a t -> Jv.prop' -> 'a -> unit + val create + : unit -> 'a t + + val init + : (Jv.prop * 'a) array -> 'a t + end = struct type 'a t = Jv.t @@ -40,6 +46,14 @@ end = struct = fun o prop v -> Jv.set' o prop (Jv.Id.to_jv v) + let create + : unit -> 'a t + = fun () -> Jv.obj [||] + + let init + : (Jv.prop * 'a) array -> 'a t + = fun param -> Jv.obj (Obj.magic param) + end class type ['a] ordered_map = object ('this) @@ -54,102 +68,148 @@ class type ['a] ordered_map = object ('this) Jstr.t -> 'this meth method addToStart: - Jstr.t -> 'a t -> 'this meth + Jstr.t -> 'a t -> 'this t meth method addToEnd: - Jstr.t -> 'a t -> 'this meth + Jstr.t -> 'a t -> 'this t meth end -module Model = struct +module Classes = struct + + type 'a meta_data type domOutputSpec + type parse_rule + + type content_match + + type slice class type _node_props = object ('this) method inlineContent: - bool readonly_prop + bool t readonly_prop (** True if this node type has inline content. *) method isBlock: - bool readonly_prop + bool t readonly_prop method isText: - bool readonly_prop + bool t readonly_prop method isInline: - bool readonly_prop + bool t readonly_prop method isTextblock: - bool readonly_prop + bool t readonly_prop method isLeaf: - bool readonly_prop + bool t readonly_prop method isAtom: - bool readonly_prop + bool t readonly_prop end + type depth = int opt class type mark = object ('this) - method eq: - 'this t -> bool t meth + method eq + : 'this t -> bool t meth - method isInSet: - mark t js_array t -> mark t opt meth + method isInSet + : mark t js_array t -> mark t opt meth end - type node_spec + class type node_spec = object ('this) - type content_match + method content + : Jstr.t opt prop - type slice + method marks + : Jstr.t opt prop - type depth = int opt + method group + : Jstr.t opt prop - class type resolved_pos = object ('this) + method inline + : bool t opt prop - method pos: - int readonly_prop + method atom + : bool t opt prop - method depth: - int readonly_prop + method attrs + : < .. > t opt prop - method parent: - node t readonly_prop + method selectable + : bool t opt prop - method doc: - node t readonly_prop + method draggable + : bool t opt prop - method node: - depth -> node t meth + method code + : bool t opt prop - method index: - depth -> int meth + method defining + : bool t opt prop - method after: - depth -> int meth + method isolating + : bool t opt prop - method nodeAfter: - node t opt readonly_prop + method toDOM + : (node t -> domOutputSpec t) callback prop - method nodeBefore: - node t opt readonly_prop + method parseDom + : parse_rule t js_array t opt prop - method marks: - unit -> mark t js_array t meth + end + + and resolved_pos = object ('this) + + method pos + : int readonly_prop + + method depth + : int readonly_prop + + method parentOffset + : int readonly_prop + + method parent + : node t readonly_prop - method sameParent: - 'this -> bool t meth + method doc + : node t readonly_prop - method max: - 'this -> 'this t meth + method node + : depth -> node t meth - method min: - 'this -> 'this t meth + method index + : depth -> int meth + + method after + : depth -> int meth + + method nodeAfter + : node t opt readonly_prop + + method nodeBefore + : node t opt readonly_prop + + method marks + : unit -> mark t js_array t meth + + method sameParent + : 'this t -> bool t meth + + method max + : 'this t -> 'this t meth + + method min + : 'this t -> 'this t meth end and mark_spec = object ('this) @@ -222,8 +282,8 @@ module Model = struct method hasRequiredAttrs: unit -> bool t meth - method create_withFragment: - < .. > t -> fragment t opt -> mark t opt -> node t meth + method create_withFragmentContent: + < .. > t opt -> fragment t opt -> mark t opt -> node t meth end @@ -268,7 +328,7 @@ module Model = struct (** Compare this element to another one. *) method cut: - int -> int opt -> 'this meth + int -> int opt -> 'this t meth (** Cut out the element between the two given positions. *) method toString: @@ -284,128 +344,80 @@ module Model = struct inherit _element - method size: - int readonly_prop + 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 append + : 'this t -> 'this t meth + + method lastChild + : node t opt readonly_prop - method lastChild: - node t opt readonly_prop + method firstChild + : node t opt readonly_prop - method firstChild: - node t opt readonly_prop + method findDiffStart + : 'this t -> int opt meth + + method findDiffEnd + : 'this t -> < a: int prop; b: int prop> t opt meth end + (** https://prosemirror.net/docs/ref/#model.Node *) and node = object ('this) inherit _element inherit _node_props - method _type: - node_type t readonly_prop - - method attrs: - < .. > t prop + method _type + : node_type t readonly_prop - method content: - 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 t meth - - method text: - Jstr.t opt prop - - end - -end + method attrs + : < .. > t prop -module Transform = struct + method content + : fragment t prop - type step_result + method copy + : fragment t -> 'this t meth - class type step = object ('this) + method slice + : from:int -> to_:int opt -> slice t meth - end + method resolve + : int -> resolved_pos t meth - class type replace_step = object ('this) + method nodeAt + : int -> 'this t opt meth - inherit step + method marks + : mark t js_array t readonly_prop - end + method sameMarkup + : node t -> bool t meth - class type replace_around_step = object ('this) - - inherit step + method text + : Jstr.t opt prop 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 - - method addMark: - from:int -> to_:int -> Model.mark t -> 'this t meth - - method delete: - from:int -> to_:int -> 'this t meth - - method insert: - pos:int -> Model.node t -> 'this t meth - - method replaceRangeWith: - from:int -> to_:int -> Model.node t -> 'this t meth - - method setBlockType: - from:int -> to_:int -> Model.node_type t -> < .. > t -> 'this t meth - - end - -end + (** View *) + and editor_props = object ('this) -module Classes = struct + method editable + : (editor_state t -> bool t) callback prop + method handleDOMEvents + : (editor_view t -> Jv.t -> bool t) callback TypedObject.t prop - (** View *) - class type editor_props = object ('this) + method nodeViews + : (node t -> editor_view t -> (unit -> int) -> < .. > t) TypedObject.t prop - method editable: - (editor_state t -> bool t) callback prop end and direct_editor_props = object ('this) @@ -418,6 +430,7 @@ module Classes = struct (** The call back is called with this = instance of editor_view *) method dispatchTransaction: (editor_view t, transaction t -> unit) meth_callback writeonly_prop + end and editor_view = object ('this) @@ -443,12 +456,21 @@ module Classes = struct method updateState: editor_state t -> unit meth + method hasFocus: + unit -> bool t meth + + method focus: + unit -> 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 destroy + : unit meth + method dispatch: transaction t -> unit meth @@ -483,13 +505,13 @@ module Classes = struct 'this t -> bool t meth method content: - unit -> Model.slice t meth + unit -> slice t meth method replace: - transaction t -> Model.slice t -> unit meth + transaction t -> slice t -> unit meth method replaceWith: - transaction t -> Model.node t -> unit meth + transaction t -> node t -> unit meth end @@ -505,70 +527,132 @@ module Classes = struct end + (* Transform *) + + and mappable = object ('this) + + end + + and step_map = object ('this) + + inherit mappable + + end + + and step = object ('this) + + method map + : mappable t -> 'this t meth + + end + + and transform = object ('this) + + method doc + : node t readonly_prop + + method steps + : step t js_array t readonly_prop + + method docs + : node t js_array t readonly_prop + + method step + : step t -> 'this t meth + + method docChanged + : bool t prop + + method addMark + : from:int -> to_:int -> mark t -> 'this t meth + + method replace + : from:int -> to_:int -> slice t opt -> 'this t meth + + method delete + : from:int -> to_:int -> 'this t meth + + method insert + : pos:int -> node t -> 'this t meth + + method replaceRangeWith + : from:int -> to_:int -> node t -> 'this t meth + + method setBlockType + : from:int -> to_:int -> node_type t -> < .. > t -> 'this t meth + + end + and transaction = object ('this) - inherit Transform.transform + inherit transform method time: int readonly_prop - method setTime: - int -> 'this t meth + method setTime + : int -> 'this t meth - method storedMarks: - Model.mark t js_array t opt readonly_prop + method storedMarks + : mark t js_array t opt readonly_prop - method setStoredMarks: - Model.mark t js_array t opt -> 'this t meth + method setStoredMarks + : mark t js_array t opt -> 'this t meth - method addStoredMark: - Model.mark t -> 'this t meth + method addStoredMark + : mark t -> 'this t meth - method removeStoredMark_mark: - Model.mark t -> 'this t meth + method removeStoredMark_mark + : mark t -> 'this t meth - method removeStoredMark_marktype: - Model.mark_type t -> 'this t meth + method removeStoredMark_marktype + : mark_type t -> 'this t meth - method ensureMarks: - Model.mark t js_array t -> 'this t meth + method ensureMarks + : mark t js_array t -> 'this t meth - method storedMarksSet: - bool readonly_prop + method storedMarksSet + : bool readonly_prop - method selection: - selection t readonly_prop + method selection + : selection t readonly_prop - method setSelection: - selection t -> 'this t meth + method setSelection + : selection t -> 'this t meth - method deleteSelection: - 'this t meth + method deleteSelection + : 'this t meth - method replaceSelection: - Model.slice t -> 'this t meth + method replaceSelection + : slice t -> 'this t meth - method replaceSelectionWith: - Model.node t -> bool t -> 'this t meth + method replaceSelectionWith + : node t -> bool t opt -> 'this t meth - method selectionSet: - bool readonly_prop + method selectionSet + : bool readonly_prop - method before: - Model.node t readonly_prop + method before + : node t readonly_prop - method insertText: - Jstr.t -> from:int opt -> to_:int opt -> 'this t meth + method insertText + : Jstr.t -> from:int opt -> to_:int opt -> 'this t meth - method scrollIntoView : - unit -> 'this t meth + method setMeta + : 'a meta_data t -> 'a -> 'this t meth + + method getMeta + : 'a meta_data t -> 'a optdef meth + + method scrollIntoView + : unit -> 'this t meth end and configuration_prop = object ('this) method schema: - Model.schema t opt prop + schema t opt prop method plugins: plugin t js_array t opt prop @@ -580,29 +664,29 @@ module Classes = struct inherit configuration_prop method doc: - Model.node t opt prop + node t opt prop method selection: selection t opt prop method storedMarks: - Model.mark t js_array t opt prop + mark t js_array t opt prop end and editor_state = object ('this) method doc : - Model.node t readonly_prop + node t readonly_prop method selection: selection t readonly_prop method storedMarks: - Model.mark t js_array t opt readonly_prop + mark t js_array t opt readonly_prop method schema: - Model.schema t readonly_prop + schema t readonly_prop method plugins: plugin t js_array t readonly_prop @@ -610,6 +694,10 @@ module Classes = struct method apply: transaction t -> 'this t meth + method applyTransaction + : transaction t -> + < state: 'this t prop; transactions : transaction t js_array t prop> t meth + method tr: transaction t readonly_prop @@ -623,8 +711,70 @@ module Classes = struct end +module Model = struct + + type parse_rule = Classes.parse_rule + + type domOutputSpec = Classes.domOutputSpec + + type depth = Classes.depth + + class type mark = Classes.mark + + class type fragment = Classes.fragment + + class type node_spec = Classes.node_spec + + class type resolved_pos = Classes.resolved_pos + + class type mark_spec = Classes.mark_spec + + class type schema_spec = Classes.schema_spec + + class type schema = Classes.schema + + class type node_type = Classes.node_type + + class type mark_type = Classes.mark_type + + class type node = Classes.node + +end + +module Transform = struct + + type step_result + + class type step_map = Classes.step_map + + class type step = Classes.step + + 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 = Classes.transform + + +end + module State = struct + type 'a meta_data = 'a Classes.meta_data class type plugin = Classes.plugin class type selection = Classes.selection class type text_selection = Classes.text_selection @@ -710,21 +860,66 @@ module SchemaBasic = struct end +module Menu = struct + + class type menuElement = object ('this) + end + + class type menuItemSpec = object ('this) + method title + : Jstr.t opt prop + + method label + : Jstr.t opt prop + + method select + : (menuItem t, State.editor_state t -> bool t) meth_callback prop + + method run + : (menuItem t, State.editor_state t -> (State.transaction t -> unit) -> View.editor_view t -> 'a Brr.Ev.t -> unit) meth_callback prop + end + + and menuItem = object ('this) + inherit menuElement + end + + class type dropdown = object ('this) + + inherit menuElement + + method content + : menuItem t js_array t prop + end +end + module Example = struct + class type menuItems = object ('this) + + method insertMenu + : Menu.dropdown t prop + + method fullMenu + : Menu.menuElement t js_array t prop + + end + class type options = object ('this) - method schema: - Model.schema t prop + method schema + : Model.schema t prop + + method menuBar + : bool t opt prop - method menuBar: - bool t opt prop + method floatingMenu + : bool t opt prop - method floatingMenu: - bool t opt prop + method history + : bool t opt prop - method history: - bool t opt prop + method menuContent + : Menu.menuElement t js_array t prop end diff --git a/editor/prosemirror/prosemirror.ml b/editor/prosemirror/prosemirror.ml index e37cc3b..8c436a3 100755 --- a/editor/prosemirror/prosemirror.ml +++ b/editor/prosemirror/prosemirror.ml @@ -108,6 +108,16 @@ module Model = struct : < dom: node Js.t Js.readonly_prop ; contentDOM : node Js.t Js.opt Js.readonly_prop > Js.t -> domOutputSpec Js.t = of_ end + + module ParseRule = struct + + let tag + : Jstr.t -> parse_rule Js.t + = fun name -> + Jv.obj [| "tag", Jv.of_jstr name |] + |> Jv.Id.of_jv + + end end module State = struct @@ -115,12 +125,12 @@ module State = struct include Bindings.State let configuration_prop - : unit -> configuration_prop Js_of_ocaml.Js.t - = fun () -> Js_of_ocaml.Js.Unsafe.obj [||] + : unit -> configuration_prop Js.t + = fun () -> Js.Unsafe.obj [||] let creation_prop : unit -> creation_prop Js.t - = fun () -> Js_of_ocaml.Js.Unsafe.obj [||] + = fun () -> Js.Unsafe.obj [||] let create : t -> creation_prop Js.t -> editor_state Js.t @@ -131,13 +141,18 @@ module State = struct |> Jv.Id.of_jv let fromJSON - : t -> configuration_prop Js_of_ocaml.Js.t -> Brr.Json.t -> editor_state Js.t + : t -> configuration_prop Js.t -> Brr.Json.t -> editor_state Js.t = fun t config json -> let state = Jv.get t "state" in 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_from + : selection Js.t -> Model.resolved_pos Js.t + = fun selection -> + Jv.Id.(of_jv @@ Jv.get (to_jv selection) "$from") + let selection_to : selection Js.t -> Model.resolved_pos Js.t = fun selection -> @@ -183,6 +198,10 @@ module State = struct : selection Js.t -> Model.resolved_pos Js.t Js.opt = fun selection -> Jv.Id.(of_jv @@ Jv.get (to_jv selection) "$cursor") + + let create_str_meta_data + : Jstr.t -> 'a meta_data Js.t + = Obj.magic end (* Editor view *) @@ -196,7 +215,7 @@ module View = struct include Bindings.View let direct_editor_props : unit -> direct_editor_props Js.t - = fun () -> Js_of_ocaml.Js.Unsafe.obj [||] + = fun () -> Js.Unsafe.obj [||] let editor_view : t -> El.t -> direct_editor_props Js.t -> editor_view Js.t @@ -206,6 +225,26 @@ module View = struct end +module Transform = struct + + include Bindings.Transform + + let offset + : t -> int -> step_map Js.t + = fun t n -> + let stepmap = Jv.get (Jv.get t "transform") "StepMap" in + Jv.call stepmap "offset" [|Jv.Id.to_jv n|] + |> Jv.Id.of_jv + + let insertPoint + : t -> Model.node Js.t -> pos:int -> Model.node_type Js.t -> int Js.opt + = fun t node ~pos node_t -> + let transform = Jv.get t "transform" in + Jv.call transform "insertPoint" Jv.Id.[|to_jv node ; to_jv pos; to_jv node_t|] + |> Jv.Id.of_jv + +end + module Commands = struct type t = State.editor_state Js.t -> State.dispatch Js.opt -> bool Js.t @@ -238,7 +277,7 @@ module History = struct let history_prop : unit -> history_prop Js.t - = fun () -> Js_of_ocaml.Js.Unsafe.obj [||] + = fun () -> Js.Unsafe.obj [||] let history : t -> history_prop Js.t -> State.plugin Js.t @@ -324,6 +363,22 @@ module SchemaList = struct end +module Menu = struct + + include Bindings.Menu + + let menuItemSpec + : unit -> menuItemSpec Js.t + = fun () -> Js.Unsafe.obj [||] + + let menu_item + : t -> menuItemSpec Js.t -> menuItem Js.t + = fun t spec -> + let menu = Jv.get t "menu" in + Jv.new' (Jv.get menu "MenuItem") [| Jv.Id.to_jv spec |] + |> Jv.Id.of_jv + +end (* Example Setup *) @@ -343,4 +398,11 @@ module Example = struct let setup = Jv.get t "example_setup" in Jv.call setup "exampleSetup" [|Jv.Id.to_jv options|] |> Jv.Id.of_jv + + let buildMenuItems + : t -> Model.schema Js.t -> menuItems Js.t + = fun t schema -> + let setup = Jv.get t "example_setup" in + Jv.call setup "buildMenuItems" [|Jv.Id.to_jv schema|] + |> Jv.Id.of_jv end diff --git a/editor/prosemirror/prosemirror.mli b/editor/prosemirror/prosemirror.mli index eac895a..76545d2 100755 --- a/editor/prosemirror/prosemirror.mli +++ b/editor/prosemirror/prosemirror.mli @@ -10,58 +10,9 @@ val v module O = Bindings.TypedObject -module rec Model : sig - - include module type of Bindings.Model - - val schema_spec: - node_spec Bindings.ordered_map Js.t - -> mark_spec Bindings.ordered_map Js.t option - -> string option - -> schema_spec Js.t - - val schema - : t -> schema_spec Js.t -> schema Js.t - - module DOMParser : sig - - type parser - - val from_schema - : t -> schema Js.t -> parser - - val parse - : parser -> El.t -> node Js.t - - end - - 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 - (* State *) -and State : sig +module rec State : sig include module type of Bindings.State @@ -77,6 +28,9 @@ and State : sig val fromJSON : t -> configuration_prop Js.t -> Brr.Json.t -> editor_state Js.t + val selection_from + : selection Js.t -> Model.resolved_pos Js.t + val selection_to : selection Js.t -> Model.resolved_pos Js.t @@ -98,6 +52,9 @@ and State : sig val cursor : selection Js.t -> Model.resolved_pos Js.t Js.opt + val create_str_meta_data + : Jstr.t -> 'a meta_data Js.t + end (* Editor view *) @@ -120,6 +77,73 @@ and View : sig end +and Model : sig + + include module type of Bindings.Model + + val schema_spec: + node_spec Bindings.ordered_map Js.t + -> mark_spec Bindings.ordered_map Js.t option + -> string option + -> schema_spec Js.t + + val schema + : t -> schema_spec Js.t -> schema Js.t + + module DOMParser : sig + + type parser + + val from_schema + : t -> schema Js.t -> parser + + val parse + : parser -> El.t -> node Js.t + + end + + 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 + + module ParseRule : sig + + val tag: Jstr.t -> parse_rule Js.t + + end + +end + +and Transform : sig + + include module type of Bindings.Transform + + val offset + : t -> int -> step_map Js.t + + val insertPoint + : t -> Model.node Js.t -> pos:int -> Model.node_type Js.t -> int Js.opt + +end + module Commands : sig type t = State.editor_state Js.t -> State.dispatch Js.opt -> bool Js.t @@ -190,6 +214,17 @@ module SchemaList : sig end +module Menu : sig + + include module type of Bindings.Menu + + val menuItemSpec + : unit -> menuItemSpec Js.t + + val menu_item + : t -> menuItemSpec Js.t -> menuItem Js.t +end + (* Example Setup *) module Example : sig @@ -201,4 +236,7 @@ module Example : sig val example_setup : t -> options Js.t -> State.plugin Js.t Js.js_array Js.t -end + + val buildMenuItems + : t -> Model.schema Js.t -> menuItems Js.t +end |