diff options
| -rwxr-xr-x | editor/editor.ml | 90 | ||||
| -rwxr-xr-x | editor/prosemirror/bindings.ml | 9 | ||||
| -rwxr-xr-x | editor/prosemirror/prosemirror.ml | 18 | ||||
| -rwxr-xr-x | editor/prosemirror/prosemirror.mli | 15 |
4 files changed, 64 insertions, 68 deletions
diff --git a/editor/editor.ml b/editor/editor.ml index 64fb723..d32288c 100755 --- a/editor/editor.ml +++ b/editor/editor.ml @@ -3,82 +3,58 @@ open Brr module PM = Prosemirror let change_level - : PM.t -> PM.Model.resolved_pos Js.t -> PM.State.editor_state Js.t -> int -> (PM.State.transaction Js.t -> unit) -> (int -> bool) -> bool - = fun pm res state incr dispatch pred -> + : PM.t -> PM.Model.resolved_pos Js.t -> int -> (int -> bool) -> PM.State.command + = fun pm res incr pred state dispatch -> let parent = res##.parent in let attributes = parent##.attrs in - (* There are some problems to update the view when the content is empty. - It looks like the comparaison does not comprae the level argument. - In order to prevent any error, juste return in such situation. - *) - let empty_content = parent##.content##eq (PM.Model.empty_fragment pm) - and level = attributes##.level in - if (pred level || empty_content) then false - else - (* Look the position for the previous element *) - let resolved = (res##.doc)##resolve (res##.pos -1) in - let selection = PM.State.node_selection pm resolved in - - let props = object%js - val level = level + incr - end in - - let element = parent##copy (PM.Model.empty_fragment pm) in - element##.attrs := props; - element##.content := parent##.content; - - (* Create a new transaction for replacing the selection *) - let tr = state##.tr in - let tr = tr##replaceRangeWith - selection##.from - selection##._to - element in - - (* Return at the initial position *) - let position = PM.State.create_text_selection - pm - tr##.doc - res##.pos in - let tr = tr##setSelection position in - dispatch (tr##scrollIntoView ()); - true + let current_level = if Jv.is_none attributes##.level then + 0 + else + attributes##.level in + let t, props = match pred current_level with + | false -> + (PM.O.get state##.schema##.nodes "heading" + , (object%js + val level = current_level + incr + end :> < > Js.t )) + | true -> + ( PM.O.get state##.schema##.nodes "paragraph" + , object%js end) in + match t with + | None -> Js._false + | Some t -> + PM.Commands.set_block_type pm t props state dispatch -let handle_backspace pm state dispatch = +(** Increase the title level by one when pressing # at the begining of a line *) +let handle_sharp pm state dispatch = - (* Get the currrent node *) let res = PM.State.selection_to (state##.selection) in - match Js.Opt.to_option res##.nodeBefore with - | Some _ -> false + | Some _ -> Js._false | None -> (* Line start *) - let parent = res##.parent in - begin match Jstr.to_string parent##._type##.name with - | "heading" -> change_level pm res state (-1) dispatch (fun x -> x <= 1) - | _ -> false + begin match Jstr.to_string res##.parent##._type##.name with + | "heading" -> change_level pm res 1 (fun x -> x > 5) state dispatch + | "paragraph" -> change_level pm res 1 (fun _ -> false) state dispatch + | _ -> Js._false end +let handle_backspace pm state dispatch = -(** Increase the title level by one when pressing # at the begining of a line *) -let handle_sharp pm state dispatch = - (* Get the currrent node *) let res = PM.State.selection_to (state##.selection) in - match Js.Opt.to_option res##.nodeBefore with - | Some _ -> false + | Some _ -> Js._false | None -> (* Line start *) - let parent = res##.parent in - begin match Jstr.to_string parent##._type##.name with - | "heading" -> change_level pm res state (+1) dispatch (fun x -> x > 5) - | _ -> false + begin match Jstr.to_string res##.parent##._type##.name with + | "heading" -> change_level pm res (-1) (fun x -> x <= 1) state dispatch + | _ -> Js._false end - let default_plugins pm schema = let props = PM.Example.options schema in - props##.menuBar := Js.some false; - props##.floatingMenu := Js.some false; + props##.menuBar := Js.some Js._true; + props##.floatingMenu := Js.some Js._true; let setup = PM.Example.example_setup pm props in let keymaps = diff --git a/editor/prosemirror/bindings.ml b/editor/prosemirror/bindings.ml index f6d4223..cb5a47c 100755 --- a/editor/prosemirror/bindings.ml +++ b/editor/prosemirror/bindings.ml @@ -365,6 +365,9 @@ module Transform = struct method replaceRangeWith: int -> int -> Model.node t -> 'this t meth + method setBlockType: + int -> int -> Model.node_type t -> < .. > t -> 'this t meth + end end @@ -650,13 +653,13 @@ module Example = struct Model.schema t prop method menuBar: - bool opt prop + bool t opt prop method floatingMenu: - bool opt prop + bool t opt prop method history: - bool opt prop + bool t opt prop end end diff --git a/editor/prosemirror/prosemirror.ml b/editor/prosemirror/prosemirror.ml index e97fa9b..e2758c7 100755 --- a/editor/prosemirror/prosemirror.ml +++ b/editor/prosemirror/prosemirror.ml @@ -112,6 +112,10 @@ 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 [||] @@ -176,6 +180,7 @@ module State = struct let state = Jv.get t "state" in Jv.call (Jv.get state "TextSelection") "create" Jv.Id.[|to_jv doc; Jv.of_int number|] |> Jv.Id.of_jv + end (* Editor view *) @@ -249,13 +254,13 @@ module History = struct |> Jv.Id.of_jv let undo - : t -> State.editor_state Js.t -> (State.transaction -> unit) -> bool + : t -> State.command = 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 + : t -> State.command = fun t state fn -> Jv.call (Jv.get t "history") "redo" [|Jv.Id.to_jv state; Jv.repr fn|] |> Jv.Id.of_jv @@ -264,7 +269,7 @@ end module Keymap = struct let keymap - : t -> (string * (State.editor_state Js.t -> (State.transaction Js.t -> unit) -> bool)) array -> State.plugin Js.t + : t -> (string * State.command) 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|] @@ -275,11 +280,16 @@ end module Commands = struct let baseKeymap - : t -> (string * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) array + : t -> (string * State.command) 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 -> State.command + = fun t node props -> + Jv.call (Jv.get t "commands") "setBlockType" Jv.Id.[| to_jv node ; to_jv props |] + |> Jv.Id.of_jv end (* Example Setup *) diff --git a/editor/prosemirror/prosemirror.mli b/editor/prosemirror/prosemirror.mli index a4c5d35..7a723d3 100755 --- a/editor/prosemirror/prosemirror.mli +++ b/editor/prosemirror/prosemirror.mli @@ -100,6 +100,10 @@ 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 + end (* Editor view *) @@ -146,23 +150,26 @@ module History : sig : t -> history_prop Js.t -> State.plugin Js.t val undo - : t -> State.editor_state Js.t -> (State.transaction -> unit) -> bool + : t -> State.command val redo - : t -> State.editor_state Js.t -> (State.transaction -> unit) -> bool + : t -> State.command end module Keymap : sig val keymap - : t -> (string * (State.editor_state Js.t -> (State.transaction Js.t -> unit) -> bool)) array -> State.plugin Js.t + : t -> (string * State.command) array -> State.plugin Js.t end module Commands : sig val baseKeymap - : t -> (string * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) array + : t -> (string * State.command) array + + val set_block_type + : t -> Model.node_type Js.t -> < .. > Js.t -> State.command end |