summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xeditor/editor.ml90
-rwxr-xr-xeditor/prosemirror/bindings.ml9
-rwxr-xr-xeditor/prosemirror/prosemirror.ml18
-rwxr-xr-xeditor/prosemirror/prosemirror.mli15
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