diff options
Diffstat (limited to 'editor/prosemirror')
| -rwxr-xr-x | editor/prosemirror/bindings.ml | 1054 | ||||
| -rwxr-xr-x | editor/prosemirror/prosemirror.ml | 580 |
2 files changed, 689 insertions, 945 deletions
diff --git a/editor/prosemirror/bindings.ml b/editor/prosemirror/bindings.ml index 7f6d82f..a6a09dc 100755 --- a/editor/prosemirror/bindings.ml +++ b/editor/prosemirror/bindings.ml @@ -1,750 +1,573 @@ 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 get : 'a t -> Jv.prop -> 'a option - val set - : 'a t -> Jv.prop -> 'a -> unit + val get' : 'a t -> Jv.prop' -> 'a option - val set' - : 'a t -> Jv.prop' -> 'a -> unit + val set : 'a t -> Jv.prop -> 'a -> unit - val create - : unit -> 'a t + val set' : 'a t -> Jv.prop' -> 'a -> unit - val init - : (Jv.prop * 'a) array -> 'a t + val create : unit -> 'a t + val init : (Jv.prop * 'a) array -> 'a t 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 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 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 create - : unit -> 'a t - = fun () -> Jv.obj [||] + let set : 'a t -> Jv.prop -> 'a -> unit = + fun o prop v -> Jv.set o prop (Jv.Id.to_jv v) - let init - : (Jv.prop * 'a) array -> 'a t - = fun param -> Jv.obj (Obj.magic param) -end + let set' : 'a t -> Jv.prop' -> 'a -> unit = + fun o prop v -> Jv.set' o prop (Jv.Id.to_jv v) + -class type ['a] ordered_map = object ('this) + let create : unit -> 'a t = fun () -> Jv.obj [||] - method get: - Jstr.t -> 'a t opt meth + let init : (Jv.prop * 'a) array -> 'a t = + fun param -> Jv.obj (Obj.magic param) +end - method update: - Jstr.t -> 'a t -> Jstr.t opt -> 'this meth +class type ['a] ordered_map = + object ('this) + method get : Jstr.t -> 'a t opt meth - method remove: - Jstr.t -> 'this meth + method update : Jstr.t -> 'a t -> Jstr.t opt -> 'this meth - method addToStart: - Jstr.t -> 'a t -> 'this t meth + method remove : Jstr.t -> 'this meth - method addToEnd: - Jstr.t -> 'a t -> 'this t meth + method addToStart : Jstr.t -> 'a t -> 'this t meth -end + method addToEnd : Jstr.t -> 'a t -> 'this t meth + end module Classes = struct - type 'a meta_data type domOutputSpec + type parse_rule type content_match type slice - class type _node_props = object ('this) + class type _node_props = + object ('this) + method inlineContent : bool t readonly_prop + (** True if this node type has inline content. *) - method inlineContent: - bool t readonly_prop - (** True if this node type has inline content. *) + method isBlock : bool t readonly_prop - method isBlock: - bool t readonly_prop + method isText : bool t readonly_prop - method isText: - bool t readonly_prop + method isInline : bool t readonly_prop - method isInline: - bool t readonly_prop + method isTextblock : bool t readonly_prop - method isTextblock: - bool t readonly_prop + method isLeaf : bool t readonly_prop - method isLeaf: - bool t readonly_prop - - method isAtom: - bool t readonly_prop - - end + method isAtom : bool t readonly_prop + end type depth = int opt - class type mark = object ('this) - - method _type - : mark_type t readonly_prop - - method attrs - : 'a TypedObject.t prop - - method isInSet - : mark t js_array t -> bool t meth - - method eq - : 'this t -> bool t meth - - end - - and node_spec = object ('this) - - method content - : Jstr.t opt prop - - method marks - : Jstr.t opt prop - - method group - : Jstr.t opt prop - - method inline - : bool t opt prop + class type mark = + object ('this) + method _type : mark_type t readonly_prop - method atom - : bool t opt prop + method attrs : 'a TypedObject.t prop - method attrs - : 'a TypedObject.t prop + method isInSet : mark t js_array t -> bool t meth - method selectable - : bool t opt prop + method eq : 'this t -> bool t meth + end - method draggable - : bool t opt prop + and node_spec = + object ('this) + method content : Jstr.t opt prop - method code - : bool t opt prop + method marks : Jstr.t opt prop - method defining - : bool t opt prop + method group : Jstr.t opt prop - method isolating - : bool t opt prop + method inline : bool t opt prop - method toDOM - : (node t -> domOutputSpec t) callback prop + method atom : bool t opt prop - method parseDom - : parse_rule t js_array t opt prop + method attrs : 'a TypedObject.t prop - end + method selectable : bool t opt prop - and resolved_pos = object ('this) + method draggable : bool t opt prop - method pos - : int readonly_prop + method code : bool t opt prop - method depth - : int readonly_prop + method defining : bool t opt prop - method parentOffset - : int readonly_prop + method isolating : bool t opt prop - method parent - : node t readonly_prop + method toDOM : (node t -> domOutputSpec t) callback prop - method doc - : node t readonly_prop + method parseDom : parse_rule t js_array t opt prop + end - method node - : depth -> node t meth + and resolved_pos = + object ('this) + method pos : int readonly_prop - method index - : depth -> int meth + method depth : int readonly_prop - method start - : depth -> int meth + method parentOffset : int readonly_prop - method _end - : depth -> int meth + method parent : node t readonly_prop - method after - : depth -> int meth + method doc : node t readonly_prop - method nodeAfter - : node t opt readonly_prop + method node : depth -> node t meth - method nodeBefore - : node t opt readonly_prop + method index : depth -> int meth - method marks - : unit -> mark t js_array t meth + method start : depth -> int meth - method sameParent - : 'this t -> bool t meth + method _end : depth -> int meth - method max - : 'this t -> 'this t meth + method after : depth -> int meth - method min - : 'this t -> 'this t meth - end + method nodeAfter : node t opt readonly_prop - and mark_spec = object ('this) + method nodeBefore : node t opt readonly_prop - method toDOM: - (node t -> domOutputSpec t) callback prop + method marks : unit -> mark t js_array t meth - method inclusive: - bool t prop + method sameParent : 'this t -> bool t meth - method spanning: - bool t prop + method max : 'this t -> 'this t meth - end + method min : 'this t -> 'this t meth + end - and schema_spec = object ('this) + and mark_spec = + object ('this) + method toDOM : (node t -> domOutputSpec t) callback prop - method nodes: - node_spec ordered_map t readonly_prop + method inclusive : bool t prop - method marks: - mark_spec ordered_map t readonly_prop + method spanning : bool t prop + end - method topNode: - Jstr.t opt readonly_prop + and schema_spec = + object ('this) + method nodes : node_spec ordered_map t readonly_prop - end + method marks : mark_spec ordered_map t readonly_prop - and schema = object ('this) + method topNode : Jstr.t opt readonly_prop + end - method spec: - schema_spec t prop + and schema = + object ('this) + method spec : schema_spec t prop - method nodes: - node_type t TypedObject.t readonly_prop + method nodes : node_type t TypedObject.t readonly_prop - method marks: - mark_type t TypedObject.t readonly_prop + method marks : mark_type t TypedObject.t readonly_prop - method topNodeType: - node_type t readonly_prop + method topNodeType : node_type t readonly_prop - method text: - Jstr.t -> mark t js_array t opt -> node t meth + method text : Jstr.t -> mark t js_array t opt -> node t meth - (** [node t attrs fragment ] Will create a node with the type [t] and + method node : + Jstr.t + -> < .. > t opt + -> fragment t opt + -> mark t js_array t opt + -> node t meth + (** [node t attrs fragment ] Will create a node with the type [t] and attributes [attrs]. The content will always be a fragment. You can create a fragment from an array on node with the function [Model.Fragment.from_array] *) - method node: - Jstr.t -> < .. > t opt -> fragment t opt -> mark t js_array t opt -> node t meth - method mark_fromType: - mark_type t -> 'a TypedObject.t opt -> mark t meth + method mark_fromType : mark_type t -> 'a TypedObject.t opt -> mark t meth + end - end + and node_type = + object ('this) + inherit _node_props - and node_type = object ('this) + method name : Jstr.t readonly_prop - inherit _node_props + method schema : schema t readonly_prop - method name: - Jstr.t readonly_prop + method spec : node_spec t readonly_prop - method schema: - schema t readonly_prop + method contentMatch : content_match t readonly_prop - method spec: - node_spec t readonly_prop + method hasRequiredAttrs : unit -> bool t meth - method contentMatch: - content_match t readonly_prop - - method hasRequiredAttrs: - unit -> bool t meth - - method create_withFragmentContent: - < .. > t opt -> fragment t opt -> mark t opt -> node t meth - - end + method create_withFragmentContent : + < .. > t opt -> fragment t opt -> mark t opt -> node t meth + end (** Signature for MarkType class https://prosemirror.net/docs/ref/#model.MarkType *) - and mark_type = object ('this) - - method name: - Jstr.t readonly_prop + and mark_type = + object ('this) + method name : Jstr.t readonly_prop - method schema: - schema t readonly_prop + method schema : schema t readonly_prop - method spec: - mark_spec t readonly_prop + method spec : mark_spec t readonly_prop - method isInSet: - mark t js_array t -> mark t opt meth - - end + method isInSet : mark t js_array t -> mark t opt meth + end (** Common signature between fragment and node *) - and _element = object ('this) + and _element = + object ('this) + method childCount : int readonly_prop + (** The number of children that the node has. *) - 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 + 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 maybeChild : int -> node t opt meth + (** Get the child node at the given index, if it exists. *) - method eq: - 'this t -> bool t meth - (** Compare this element to another one. *) + method eq : 'this t -> bool t meth + (** Compare this element to another one. *) - method cut: - int -> int opt -> 'this t meth - (** Cut out the element between the two given positions. *) + method cut : int -> int opt -> 'this t 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 toString : unit -> Jstr.t meth + (** Return a debugging string that describes this element. *) - method descendants - : (node t -> pos:int -> node t -> bool t) callback -> unit meth + method descendants : + (node t -> pos:int -> node t -> bool t) callback -> unit meth - method forEach - : (node t -> offset:int -> index:int -> unit) callback -> unit meth + method forEach : + (node t -> offset:int -> index:int -> unit) callback -> unit meth (** Call [f] for every child node, passing the node, its offset into this parent node, and its index. *) + end - end + and fragment = + object ('this) + inherit _element - 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 + 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 findDiffStart : 'this t -> int opt meth - method findDiffEnd - : 'this t -> < a: int prop; b: int prop> t opt meth - - end + 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 + and node = + object ('this) + inherit _element - inherit _node_props + inherit _node_props - method _type - : node_type t readonly_prop + method _type : node_type t readonly_prop - method attrs - : < .. > t prop + method attrs : < .. > t prop - method content - : fragment t prop + method content : fragment t prop - method copy - : fragment t -> 'this t meth + method copy : fragment t -> 'this t meth - method slice - : from:int -> to_:int opt -> slice t meth + method slice : from:int -> to_:int opt -> slice t meth - method resolve - : int -> resolved_pos t meth + method resolve : int -> resolved_pos t meth - method nodeAt - : int -> 'this t opt meth + method nodeAt : int -> 'this t opt meth - method marks - : mark t js_array t readonly_prop + method marks : mark t js_array t readonly_prop - method sameMarkup - : node t -> bool t meth + method sameMarkup : node t -> bool t meth - method text - : Jstr.t opt prop - - end + method text : Jstr.t opt prop + end (** View *) - and editor_props = object ('this) + and editor_props = + object ('this) + method editable : (editor_state t -> bool t) callback prop - method editable - : (editor_state t -> bool t) callback prop + method handleDOMEvents : + (editor_view t -> Jv.t -> bool t) callback TypedObject.t prop - method handleDOMEvents - : (editor_view t -> Jv.t -> bool t) callback TypedObject.t prop + method handleClickOn : + ( editor_view t + -> int t + -> node t + -> int + -> Brr.Ev.Mouse.t Brr.Ev.type' + -> bool t + -> bool t ) + callback + prop - method handleClickOn - : (editor_view t -> int t -> node t -> int -> Brr.Ev.Mouse.t Brr.Ev.type' -> bool t -> bool t) callback prop + method nodeViews : + (node t -> editor_view t -> (unit -> int) -> < .. > t) TypedObject.t + prop + end - method nodeViews - : (node t -> editor_view t -> (unit -> int) -> < .. > t) TypedObject.t prop + and direct_editor_props = + object ('this) + inherit editor_props - end + method state : editor_state t writeonly_prop - and direct_editor_props = object ('this) + method dispatchTransaction : + (editor_view t, transaction t -> unit) meth_callback writeonly_prop + (** The call back is called with this = instance of editor_view *) + end - inherit editor_props + and editor_view = + object ('this) + method state : editor_state t readonly_prop - method state: - editor_state t writeonly_prop + method dom : Brr.El.t readonly_prop 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 + method editable : bool t readonly_prop - and editor_view = object ('this) + method props : direct_editor_props t readonly_prop - method state: - editor_state t readonly_prop + method update : direct_editor_props t -> unit meth - method dom: - Brr.El.t readonly_prop prop + method setProps : direct_editor_props t -> unit meth - method editable: - bool t readonly_prop + method updateState : editor_state t -> unit meth - method props: - direct_editor_props t readonly_prop + method hasFocus : unit -> bool t meth - method update: - direct_editor_props t -> unit meth + method focus : unit -> unit meth - method setProps: - direct_editor_props t -> unit meth + method posAtCoords : + < left : float prop ; top : float prop > t + -> < pos : int prop ; inside : int prop > t meth - method updateState: - editor_state t -> unit meth + method coordsAtPos : + int + -> int opt + -> < left : float prop + ; right : float prop + ; top : float prop + ; bottom : float prop > + t + meth - method hasFocus: - unit -> bool t meth + method domAtPos : + pos:int + -> side:int opt + -> < node : Brr.El.t t prop ; offset : int prop > t meth - method focus: - unit -> unit meth + method destroy : 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 domAtPos: - pos:int -> side:int opt -> < node: Brr.El.t t prop; offset: int prop > t meth - - method destroy - : unit meth - - method dispatch: - transaction t -> unit meth - - end + method dispatch : transaction t -> unit meth + end (** State *) - and plugin = object ('this) - - method props : editor_props t opt prop + and plugin = + object ('this) + method props : editor_props t opt prop - method view: - (editor_view t -> < .. > t) callback opt prop + method view : (editor_view t -> < .. > t) callback opt prop - method filterTransaction: - (transaction t -> editor_state t -> bool t) opt prop + method filterTransaction : + (transaction t -> editor_state t -> bool t) opt prop + end - end + and selection = + object ('this) + method from : int readonly_prop - and selection = object ('this) + method _to : int readonly_prop - method from: - int readonly_prop + method empty : bool t readonly_prop - method _to: - int readonly_prop + method eq : 'this t -> bool t meth - method empty: - bool t readonly_prop + method content : unit -> slice t meth - method eq: - 'this t -> bool t meth + method replace : transaction t -> slice t -> unit meth - method content: - unit -> slice t meth + method replaceWith : transaction t -> node t -> unit meth + end - method replace: - transaction t -> slice t -> unit meth + and text_selection = + object ('this) + inherit selection + end - method replaceWith: - transaction t -> node t -> unit meth - - end - - and text_selection = object ('this) - - inherit selection - - end - - and node_selection = object ('this) - - inherit selection - - end + and node_selection = + object ('this) + inherit selection + end (* Transform *) + and mappable = object ('this) end - 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 + and step_map = + object ('this) + inherit mappable + end - method step - : step t -> 'this t meth + and step = + object ('this) + method map : mappable t -> 'this t meth + end - method docChanged - : bool t prop + and transform = + object ('this) + method doc : node t readonly_prop - method addMark - : from:int -> to_:int -> mark t -> 'this t meth + method steps : step t js_array t readonly_prop - method removeMark - : from:int -> to_:int -> mark t -> 'this t meth + method docs : node t js_array t readonly_prop - method replace - : from:int -> to_:int -> slice t opt -> 'this t meth + method step : step t -> 'this t meth - method delete - : from:int -> to_:int -> 'this t meth + method docChanged : bool t prop - method insert - : pos:int -> node t -> 'this t meth + method addMark : from:int -> to_:int -> mark t -> 'this t meth - method replaceRangeWith - : from:int -> to_:int -> node t -> 'this t meth + method removeMark : from:int -> to_:int -> mark t -> 'this t meth - method setBlockType - : from:int -> to_:int -> node_type t -> < .. > t -> 'this t meth + method replace : from:int -> to_:int -> slice t opt -> 'this t meth - end + method delete : from:int -> to_:int -> 'this t meth - and transaction = object ('this) + method insert : pos:int -> node t -> 'this t meth - inherit transform + method replaceRangeWith : from:int -> to_:int -> node t -> 'this t meth - method time: - int readonly_prop + method setBlockType : + from:int -> to_:int -> node_type t -> < .. > t -> 'this t meth + end - method setTime - : int -> 'this t meth + and transaction = + object ('this) + inherit transform - method storedMarks - : mark t js_array t opt readonly_prop + method time : int readonly_prop - method setStoredMarks - : mark t js_array t opt -> 'this t meth + method setTime : int -> 'this t meth - method addStoredMark - : mark t -> 'this t meth + method storedMarks : mark t js_array t opt readonly_prop - method removeStoredMark_mark - : mark t -> 'this t meth + method setStoredMarks : mark t js_array t opt -> 'this t meth - method removeStoredMark_marktype - : mark_type t -> 'this t meth + method addStoredMark : mark t -> 'this t meth - method ensureMarks - : mark t js_array t -> 'this t meth + method removeStoredMark_mark : mark t -> 'this t meth - method storedMarksSet - : bool readonly_prop + method removeStoredMark_marktype : mark_type t -> 'this t meth - method selection - : selection t readonly_prop + method ensureMarks : mark t js_array t -> 'this t meth - method setSelection - : selection t -> 'this t meth + method storedMarksSet : bool readonly_prop - method deleteSelection - : 'this t meth + method selection : selection t readonly_prop - method replaceSelection - : slice t -> 'this t meth + method setSelection : selection t -> 'this t meth - method replaceSelectionWith - : node t -> bool t opt -> 'this t meth + method deleteSelection : 'this t meth - method selectionSet - : bool readonly_prop + method replaceSelection : slice t -> 'this t meth - method before - : node t readonly_prop + method replaceSelectionWith : node t -> bool t opt -> 'this t meth - method insertText - : Jstr.t -> from:int opt -> to_:int opt -> 'this t meth + method selectionSet : bool readonly_prop - method setMeta - : 'a meta_data t -> 'a -> 'this t meth + method before : node t readonly_prop - method getMeta - : 'a meta_data t -> 'a optdef 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 - end + method getMeta : 'a meta_data t -> 'a optdef meth - and configuration_prop = object ('this) + method scrollIntoView : unit -> 'this t meth + end - method schema: - schema t opt prop + and configuration_prop = + object ('this) + method schema : schema t opt prop - method plugins: - plugin t js_array t opt prop + method plugins : plugin t js_array t opt prop + end - end + and creation_prop = + object ('this) + inherit configuration_prop - and creation_prop = object ('this) + method doc : node t opt prop - inherit configuration_prop + method selection : selection t opt prop - method doc: - node t opt prop + method storedMarks : mark t js_array t opt prop + end - method selection: - selection t opt prop + and editor_state = + object ('this) + method doc : node t readonly_prop - method storedMarks: - mark t js_array t opt prop - - end + method selection : selection t readonly_prop - and editor_state = object ('this) + method storedMarks : mark t js_array t opt readonly_prop - method doc : - node t readonly_prop + method schema : schema t readonly_prop - method selection: - selection t readonly_prop + method plugins : plugin t js_array t readonly_prop - method storedMarks: - mark t js_array t opt readonly_prop + method apply : transaction t -> 'this t meth - method schema: - schema t readonly_prop + method applyTransaction : + transaction t + -> < state : 'this t prop + ; transactions : transaction t js_array t prop > + t + meth - method plugins: - plugin t js_array t readonly_prop + method tr : transaction t readonly_prop - 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 - - method reconfigure: - configuration_prop t meth - - method toJSON: - unit -> Brr.Json.t meth - - end + method reconfigure : configuration_prop t meth + method toJSON : unit -> Brr.Json.t meth + end end module Model = struct - type parse_rule = Classes.parse_rule type domOutputSpec = Classes.domOutputSpec @@ -770,189 +593,160 @@ module Model = struct 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) + class type replace_step = + object ('this) + inherit step + end - inherit step + class type replace_around_step = + object ('this) + inherit step + end - end - - class type replace_around_step = object ('this) - - inherit step - - end - - class type add_mark_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 + 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 - type dispatch = (Classes.transaction t -> unit) + type dispatch = Classes.transaction t -> unit end module View = struct - class type editor_props = Classes.editor_props class type direct_editor_props = Classes.direct_editor_props class type editor_view = Classes.editor_view - end module History = struct + class type history_prop = + object ('this) + method depth : int opt prop - class type history_prop = object ('this) - - method depth: int opt prop - - method newGroupDelay: int opt prop - - end - + method newGroupDelay : int opt prop + end end module SchemaBasic = struct + class type nodes = + object ('this) + method doc : Model.node_spec t prop - class type nodes = object ('this) + method paragraph : Model.node_spec t prop - method doc: - Model.node_spec t prop + method blockquote : Model.node_spec t prop - method paragraph: - Model.node_spec t prop + method horizontal_rule : Model.node_spec t prop - method blockquote: - Model.node_spec t prop + method heading : Model.node_spec t prop - method horizontal_rule: - Model.node_spec t prop + method code_block : Model.node_spec t prop - method heading: - Model.node_spec t prop + method text : Model.node_spec t prop - method code_block: - Model.node_spec t prop + method image : Model.node_spec t prop - method text: - Model.node_spec t prop + method hard_break : Model.node_spec t prop + end - method image: - Model.node_spec t prop + class type marks = + object ('this) + method link : Model.mark_spec t prop - method hard_break: - Model.node_spec t prop - - end + method em : Model.mark_spec t prop - class type marks = object ('this) - - method link: - Model.mark_spec t prop - - method em: - Model.mark_spec t prop - - method strong: - Model.mark_spec t prop - - method code: - Model.mark_spec t prop - - end + method strong : Model.mark_spec t prop + method code : Model.mark_spec t prop + end 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 + 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 - class type menuItems = object ('this) - - method insertMenu - : Menu.dropdown t prop - - method fullMenu - : Menu.menuElement t js_array t prop - - end + method fullMenu : Menu.menuElement t js_array t prop + end - class type options = object ('this) + 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 menuContent - : Menu.menuElement t js_array t prop - - end + method history : bool t opt prop + method menuContent : Menu.menuElement t js_array t prop + end end diff --git a/editor/prosemirror/prosemirror.ml b/editor/prosemirror/prosemirror.ml index c44d090..4d75f4c 100755 --- a/editor/prosemirror/prosemirror.ml +++ b/editor/prosemirror/prosemirror.ml @@ -5,435 +5,385 @@ type t = Jv.t type t' = t -let v - : unit -> t - = fun () -> - Jv.get Jv.global "PM" +let v : unit -> t = fun () -> Jv.get Jv.global "PM" module O = Bindings.TypedObject module Model = struct - include Bindings.Model module Fragment = struct - (** https://prosemirror.net/docs/ref/#model.Fragment^fromArray *) - let from_array - : t -> node Js.t Js.js_array Js.t -> fragment Js.t - = fun t elements -> - let model = Jv.get t "model" in - let class_ = Jv.get model "Fragment" in - Jv.call (Jv.Id.to_jv class_ ) "fromArray" [|Jv.Id.to_jv elements |] - |> Jv.Id.of_jv - + let from_array : t -> node Js.t Js.js_array Js.t -> fragment Js.t = + fun t elements -> + let model = Jv.get t "model" in + let class_ = Jv.get model "Fragment" in + Jv.call (Jv.Id.to_jv class_) "fromArray" [| Jv.Id.to_jv elements |] + |> Jv.Id.of_jv end module Mark = struct + let _set_from : t -> 'a Js.t -> mark Js.t = + fun t element -> + let model = Jv.get t "model" in + let class_ = Jv.get model "Mark" in + Jv.call (Jv.Id.to_jv class_) "setFrom" [| Jv.Id.to_jv element |] + |> Jv.Id.of_jv + - let _set_from - : t -> 'a Js.t -> mark Js.t - = fun t element -> - let model = Jv.get t "model" in - let class_ = Jv.get model "Mark" in - Jv.call (Jv.Id.to_jv class_ ) "setFrom" [|Jv.Id.to_jv element |] - |> Jv.Id.of_jv + let set_from_mark : t -> mark Js.t -> mark Js.t = _set_from + end + module DOMParser = struct + type parser = Jv.t - let set_from_mark - : t -> mark Js.t -> mark Js.t - = _set_from + let from_schema : t -> schema Js.t -> parser = + fun t schema -> + let model = Jv.get t "model" in + let parser = Jv.get model "DOMParser" in + Jv.call (Jv.Id.to_jv parser) "fromSchema" [| Jv.Id.to_jv schema |] + let parse : parser -> El.t -> node Js.t = + fun dom_parser el -> + Jv.call dom_parser "parse" [| Jv.Id.to_jv el |] |> Jv.Id.of_jv end - module DOMParser = struct + let schema_spec : + node_spec Bindings.ordered_map Js.t + -> mark_spec Bindings.ordered_map Js.t option + -> string option + -> schema_spec Js.t = + fun nodes marks_opt topNode_opt -> + let marks = Jv.of_option ~none:Jv.null Jv.Id.to_jv marks_opt + and topNode = Jv.of_option ~none:Jv.null Jv.of_string topNode_opt in + Jv.obj + [| ("nodes", Jv.Id.to_jv nodes); ("marks", marks); ("topNode", topNode) |] + |> Jv.Id.of_jv - type parser = Jv.t + let schema : t -> schema_spec Js.t -> schema Js.t = + fun t spec -> + let model = Jv.get t "model" in + Jv.new' (Jv.get model "Schema") [| Jv.Id.to_jv spec |] |> Jv.Id.of_jv - let from_schema - : t -> schema Js.t -> parser - = fun t schema -> - let model = Jv.get t "model" in - let parser = Jv.get model "DOMParser" in - Jv.call (Jv.Id.to_jv parser) "fromSchema" [|Jv.Id.to_jv schema|] - let parse - : parser -> El.t -> node Js.t - = fun dom_parser el -> - Jv.call dom_parser "parse" [|Jv.Id.to_jv el|] - |> Jv.Id.of_jv + 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 - let schema_spec: - node_spec Bindings.ordered_map Js.t - -> mark_spec Bindings.ordered_map Js.t option - -> string option - -> schema_spec Js.t - = fun nodes marks_opt topNode_opt -> - let marks = Jv.of_option ~none:Jv.null Jv.Id.to_jv marks_opt - and topNode = Jv.of_option ~none:Jv.null Jv.of_string topNode_opt in - Jv.obj - [| "nodes", (Jv.Id.to_jv nodes) - ; "marks", marks - ; "topNode", topNode - |] - |> 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 schema - : t -> schema_spec Js.t -> schema Js.t - = fun t spec -> - let model = Jv.get t "model" in - Jv.new' (Jv.get model "Schema") [| Jv.Id.to_jv spec |] - |> Jv.Id.of_jv + let hole : domOutputSpec Js.t = 0 |> Jv.Id.to_jv |> Jv.Id.of_jv - 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 + let of_ : 'a -> domOutputSpec Js.t = + fun elem -> elem |> Jv.Id.to_jv |> 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 + let of_el : Brr.El.t -> domOutputSpec Js.t = of_ - module ParseRule = struct + let of_jstr : Jstr.t -> domOutputSpec Js.t = of_ - let tag - : Jstr.t -> parse_rule Js.t - = fun name -> - Jv.obj [| "tag", Jv.of_jstr name |] - |> Jv.Id.of_jv + 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 + 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 - include Bindings.State - let configuration_prop - : unit -> configuration_prop Js.t - = fun () -> Js.Unsafe.obj [||] + let configuration_prop : unit -> configuration_prop Js.t = + fun () -> Js.Unsafe.obj [||] - let creation_prop - : unit -> creation_prop Js.t - = fun () -> Js.Unsafe.obj [||] - let create - : t -> creation_prop Js.t -> editor_state Js.t - = fun t props -> - let state = Jv.get t "state" in - let editor_state = Jv.get state "EditorState" in - Jv.call editor_state "create" [|Jv.Id.to_jv props|] - |> Jv.Id.of_jv + let creation_prop : unit -> creation_prop Js.t = fun () -> Js.Unsafe.obj [||] - let fromJSON - : 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 create : t -> creation_prop Js.t -> editor_state Js.t = + fun t props -> + let state = Jv.get t "state" in + let editor_state = Jv.get state "EditorState" in + Jv.call editor_state "create" [| Jv.Id.to_jv props |] |> 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 -> - 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 fromJSON : 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_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 selection_from : selection Js.t -> Model.resolved_pos Js.t = + fun selection -> Jv.Id.(of_jv @@ Jv.get (to_jv selection) "$from") - 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 + 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 + + + let cursor : selection Js.t -> Model.resolved_pos Js.t Js.opt = + fun selection -> Jv.Id.(of_jv @@ Jv.get (to_jv selection) "$cursor") - let cursor - : 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 + let create_str_meta_data : Jstr.t -> 'a meta_data Js.t = Obj.magic 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.Unsafe.obj [||] - - let editor_view - : t -> El.t -> direct_editor_props Js.t -> editor_view Js.t - = fun t node props -> - Jv.new' (Jv.get (Jv.get t "view") "EditorView") [|Jv.Id.to_jv node ; Jv.Id.to_jv props|] - |> Jv.Id.of_jv + let direct_editor_props : unit -> direct_editor_props Js.t = + fun () -> Js.Unsafe.obj [||] + + + let editor_view : t -> El.t -> direct_editor_props Js.t -> editor_view Js.t = + fun t node props -> + 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 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 - + 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 - let baseKeymap - : t' -> (string * t) array - = fun t -> - Jv.get (Jv.get t "commands") "baseKeymap" - |> Jv.Id.of_jv + let baseKeymap : t' -> (string * t) array = + fun t -> Jv.get (Jv.get t "commands") "baseKeymap" |> Jv.Id.of_jv - 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 + 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 - let history_prop - : unit -> history_prop Js.t - = fun () -> Js.Unsafe.obj [||] + let history_prop : unit -> history_prop Js.t = fun () -> 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 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 -> 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 -> 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 -end + let undo : 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 -module Keymap = struct - let keymap - : 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|] - |> Jv.Id.of_jv + let redo : 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 +end +module Keymap = struct + let keymap : 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 |] |> Jv.Id.of_jv end module InputRule = struct - 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 - + (** Create a new inputRule. + + The callback is called with the following elements : + - the editor state + - the elements matched by the regex + - starting position + - ending position + + and shall return a transaction if any modifications are applied. *) + 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 "schema_basic") "schema" - |> Jv.Id.of_jv + let schema : t -> Model.schema Js.t = + fun t -> 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 + 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 - + 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 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 + 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 *) 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 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 - 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 + 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 + + + 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 |