summaryrefslogtreecommitdiff
path: root/editor/plugins
diff options
context:
space:
mode:
Diffstat (limited to 'editor/plugins')
-rwxr-xr-xeditor/plugins/link_editor.ml216
-rwxr-xr-xeditor/plugins/plugins.ml209
2 files changed, 203 insertions, 222 deletions
diff --git a/editor/plugins/link_editor.ml b/editor/plugins/link_editor.ml
index 9bfdfd4..9fcfc51 100755
--- a/editor/plugins/link_editor.ml
+++ b/editor/plugins/link_editor.ml
@@ -1,127 +1,103 @@
open Brr
-
module Js = Js_of_ocaml.Js
module PM = Prosemirror
-let link_edit
- : PM.View.editor_view Js.t -> < .. > Js.t
- = fun view ->
-
- let popin = El.div []
- ~at:At.([class' (Jstr.v "popin")]) in
-
- El.set_inline_style El.Style.display (Jstr.v "none") popin;
-
- let parent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv view##.dom) "parentNode") in
- let () = El.append_children parent [popin] in
-
- let hide
- : unit -> unit
- = fun () ->
- El.set_inline_style El.Style.display (Jstr.v "none") popin
- in
-
- let update
- : PM.View.editor_view Js.t -> PM.State.editor_state Js. t Js.opt -> unit
- = fun view _state_opt ->
-
- let state = view##.state in
- Js.Opt.case (state##.doc##nodeAt (view##.state##.selection##._to))
- (fun () -> hide ())
- (fun node ->
- (* Check if we are editing a link *)
- match PM.O.get state##.schema##.marks "link" with
- | None -> ()
- | Some link_type ->
- let is_present = link_type##isInSet node##.marks in
- Js.Opt.case
- is_present
- (fun () -> hide ())
- (fun mark ->
- (* Get the node's bounding position and display the popin *)
- let position = state##.doc##resolve
- (view##.state##.selection##._to) in
- let start = position##start Js.null
- and end' = position##_end Js.null in
-
- Popin.set_position
- ~start
- ~end'
- view popin;
-
- (* Extract the value from the attribute *)
- let attrs = mark##.attrs in
- let href_opt = PM.O.get attrs "href" in
- let href_value = Option.value
- ~default:Jstr.empty
- href_opt
- in
-
- (* Create the popin content *)
- let a = El.a
- ~at:At.[ href href_value ]
- [ El.txt href_value ] in
-
- let entry = Popin.build_field a
- (fun new_value ->
- (* The function is called when the user validate
- the change in the popi. We create a new
- transaction in the document by replacing the
- mark with the new one. *)
- if not (Jstr.equal new_value href_value) then (
-
- (* Create a new attribute object for the mark in
- order to keep history safe *)
- let attrs' = PM.O.init
- [| "href", new_value |] in
-
- Option.iter
- (fun v -> PM.O.set attrs' "title" v)
- (PM.O.get attrs "title");
-
- let mark' = state##.schema##mark_fromType
- link_type
- (Js.some attrs') in
- (* Create a transaction which update the
- mark with the new value *)
- view##dispatch
- state
- ##.tr
- ##(removeMark
- ~from:start
- ~to_:end'
- mark)
- ##(addMark
- ~from:start
- ~to_:end'
- mark')
- );
- true
-
- ) in
-
-
- El.set_children popin
- [ entry.field
- ; entry.button ];
-
- ))
-
- and destroy () = El.remove popin in
-
+let link_edit : PM.View.editor_view Js.t -> < .. > Js.t =
+ fun view ->
+ let popin = El.div [] ~at:At.[ class' (Jstr.v "popin") ] in
+
+ El.set_inline_style El.Style.display (Jstr.v "none") popin;
+
+ let parent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv view##.dom) "parentNode") in
+ let () = El.append_children parent [ popin ] in
+
+ let hide : unit -> unit =
+ fun () -> El.set_inline_style El.Style.display (Jstr.v "none") popin
+ in
+
+ let update :
+ PM.View.editor_view Js.t -> PM.State.editor_state Js.t Js.opt -> unit =
+ fun view _state_opt ->
+ let state = view##.state in
+ Js.Opt.case
+ (state##.doc##nodeAt view##.state##.selection##._to)
+ (fun () -> hide ())
+ (fun node ->
+ (* Check if we are editing a link *)
+ match PM.O.get state##.schema##.marks "link" with
+ | None -> ()
+ | Some link_type ->
+ let is_present = link_type##isInSet node##.marks in
+ Js.Opt.case
+ is_present
+ (fun () -> hide ())
+ (fun mark ->
+ (* Get the node's bounding position and display the popin *)
+ let position =
+ state##.doc##resolve view##.state##.selection##._to
+ in
+ let start = position##start Js.null
+ and end' = position##_end Js.null in
+
+ Popin.set_position ~start ~end' view popin;
+
+ (* Extract the value from the attribute *)
+ let attrs = mark##.attrs in
+ let href_opt = PM.O.get attrs "href" in
+ let href_value = Option.value ~default:Jstr.empty href_opt in
+
+ (* Create the popin content *)
+ let a = El.a ~at:At.[ href href_value ] [ El.txt href_value ] in
+
+ let entry =
+ Popin.build_field a (fun new_value ->
+ (* The function is called when the user validate
+ the change in the popi. We create a new
+ transaction in the document by replacing the
+ mark with the new one. *)
+ if not (Jstr.equal new_value href_value)
+ then (
+ (* Create a new attribute object for the mark in
+ order to keep history safe *)
+ let attrs' = PM.O.init [| ("href", new_value) |] in
+
+ Option.iter
+ (fun v -> PM.O.set attrs' "title" v)
+ (PM.O.get attrs "title");
+
+ let mark' =
+ state##.schema##mark_fromType
+ link_type
+ (Js.some attrs')
+ in
+ (* Create a transaction which update the
+ mark with the new value *)
+ view##dispatch
+ state
+ ##. tr
+ ## (removeMark ~from:start ~to_:end' mark)
+ ## (addMark ~from:start ~to_:end' mark') );
+ true )
+ in
+
+ El.set_children popin [ entry.field; entry.button ] ) )
+ and destroy () = El.remove popin in
+
+ object%js
+ val update = Js.wrap_callback update
+
+ val destroy = Js.wrap_callback destroy
+ end
+
+
+let plugin : PM.t -> PM.State.plugin Js.t =
+ fun t ->
+ let state = Jv.get (Jv.Id.to_jv t) "state" in
+
+ let params =
object%js
- val update = Js.wrap_callback update
- val destroy= Js.wrap_callback destroy
+ val view = fun view -> link_edit view
end
+ in
-let plugin
- : PM.t -> PM.State.plugin Js.t
- = fun t ->
- let state = Jv.get (Jv.Id.to_jv t) "state" in
-
- let params = object%js
- val view = (fun view -> link_edit view)
- end in
-
- Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |]
- |> Jv.Id.of_jv
+ Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |] |> Jv.Id.of_jv
diff --git a/editor/plugins/plugins.ml b/editor/plugins/plugins.ml
index 3a92df8..51b761c 100755
--- a/editor/plugins/plugins.ml
+++ b/editor/plugins/plugins.ml
@@ -1,131 +1,137 @@
module Js = Js_of_ocaml.Js
module PM = Prosemirror
-
module Footnotes = Footnotes
(** Commands *)
-let change_level
- : PM.t -> PM.Model.resolved_pos Js.t -> int -> (int -> bool) -> PM.Commands.t
- = fun pm res incr pred state dispatch ->
- let parent = res##.parent in
- let attributes = parent##.attrs in
-
- let current_level = if Jv.is_none attributes##.level then
- 0
- else
- attributes##.level in
- let t, props = match pred current_level with
- | false ->
+let change_level :
+ PM.t -> PM.Model.resolved_pos Js.t -> int -> (int -> bool) -> PM.Commands.t
+ =
+ fun pm res incr pred state dispatch ->
+ let parent = res##.parent in
+ let attributes = parent##.attrs in
+
+ 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"
- , Js.some (object%js
- val level = current_level + incr
- end))
- | true ->
- ( PM.O.get state##.schema##.nodes "paragraph"
- , Js.null) in
- match t with
- | None -> Js._false
- | Some t ->
+ , Js.some
+ (object%js
+ val level = current_level + incr
+ end ) )
+ | true ->
+ (PM.O.get state##.schema##.nodes "paragraph", Js.null)
+ in
+ match t with
+ | None ->
+ Js._false
+ | Some t ->
PM.Commands.set_block_type pm t props state dispatch
+
(** Increase the title level by one when pressing # at the begining of a line *)
let handle_sharp pm state dispatch =
-
- let res = PM.State.selection_to (state##.selection) in
+ let res = PM.State.selection_to state##.selection in
match Js.Opt.to_option res##.nodeBefore with
- | Some _ -> Js._false
- | None -> (* Line start *)
- begin match Jstr.to_string res##.parent##._type##.name with
- | "heading" ->
+ | Some _ ->
+ Js._false
+ | None ->
+ (* Line start *)
+ ( match Jstr.to_string res##.parent##._type##.name with
+ | "heading" ->
change_level pm res 1 (fun x -> x > 5) state dispatch
- | "paragraph" ->
- begin match PM.O.get state##.schema##.nodes "heading" with
- | None -> Js._false
- | Some t ->
- let props = Js.some (object%js
- val level = 1
- end) in
- PM.Commands.set_block_type pm t props state dispatch
- end
- | _ -> Js._false
- end
+ | "paragraph" ->
+ ( match PM.O.get state##.schema##.nodes "heading" with
+ | None ->
+ Js._false
+ | Some t ->
+ let props =
+ Js.some
+ (object%js
+ val level = 1
+ end )
+ in
+ PM.Commands.set_block_type pm t props state dispatch )
+ | _ ->
+ Js._false )
-let handle_backspace pm state dispatch =
- let res = PM.State.selection_to (state##.selection) in
+let handle_backspace pm state dispatch =
+ let res = PM.State.selection_to state##.selection in
match Js.Opt.to_option res##.nodeBefore with
- | Some _ -> Js._false
- | None -> (* Line start *)
- 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 toggle_mark
- : Js.regExp Js.t -> PM.t -> string -> PM.InputRule.input_rule Js.t
- = fun regExp pm mark_type_name ->
- PM.InputRule.create pm
- regExp
- ~fn:(Js.wrap_callback @@ fun (state:PM.State.editor_state Js.t) _ ~from ~to_ ->
- match PM.O.get state##.schema##.marks mark_type_name with
- | None -> Js.null
- | Some mark_type ->
-
- let m = state##.schema##mark_fromType mark_type Js.null in
-
- (* Delete the markup code *)
- let tr = (state##.tr)##delete ~from ~to_ in
-
- (* Check if the mark is active at the position *)
- let present = Js.Opt.bind
- (PM.State.cursor (tr##.selection))
- (fun resolved ->
- Js.Opt.map
- (mark_type##isInSet (resolved##marks ()))
- (fun _ -> resolved)
- ) in
- Js.Opt.case present
- (fun () ->
- let tr = tr##addStoredMark m in
- Js.some @@ tr)
- (fun _resolved ->
- let tr = tr##removeStoredMark_mark m in
- Js.some tr))
+ | Some _ ->
+ Js._false
+ | None ->
+ (* Line start *)
+ ( match Jstr.to_string res##.parent##._type##.name with
+ | "heading" ->
+ change_level pm res (-1) (fun x -> x <= 1) state dispatch
+ | _ ->
+ Js._false )
+
+
+let toggle_mark :
+ Js.regExp Js.t -> PM.t -> string -> PM.InputRule.input_rule Js.t =
+ fun regExp pm mark_type_name ->
+ PM.InputRule.create
+ pm
+ regExp
+ ~fn:
+ ( Js.wrap_callback
+ @@ fun (state : PM.State.editor_state Js.t) _ ~from ~to_ ->
+ match PM.O.get state##.schema##.marks mark_type_name with
+ | None ->
+ Js.null
+ | Some mark_type ->
+ let m = state##.schema##mark_fromType mark_type Js.null in
+
+ (* Delete the markup code *)
+ let tr = state##.tr##delete ~from ~to_ in
+
+ (* Check if the mark is active at the position *)
+ let present =
+ Js.Opt.bind
+ (PM.State.cursor tr##.selection)
+ (fun resolved ->
+ Js.Opt.map
+ (mark_type##isInSet (resolved##marks ()))
+ (fun _ -> resolved) )
+ in
+ Js.Opt.case
+ present
+ (fun () ->
+ let tr = tr##addStoredMark m in
+ Js.some @@ tr )
+ (fun _resolved ->
+ let tr = tr##removeStoredMark_mark m in
+ Js.some tr ) )
+
let input_rule pm =
+ let bold = toggle_mark (new%js Js.regExp (Js.string "\\*\\*$")) pm "strong"
+ and em = toggle_mark (new%js Js.regExp (Js.string "//$")) pm "em" in
- let bold =
- toggle_mark
- (new%js Js.regExp (Js.string "\\*\\*$"))
- pm
- "strong"
- and em =
- toggle_mark
- (new%js Js.regExp (Js.string "//$"))
- pm
- "em" in
+ PM.InputRule.to_plugin pm (Js.array [| bold; em |])
- PM.InputRule.to_plugin pm
- (Js.array [| bold; em |])
let default pm schema =
-
- (** Load the history plugin *)
- let _ = PM.History.(history pm (history_prop ()) ) in
+ (* Load the history plugin *)
+ let _ = PM.History.(history pm (history_prop ())) in
let props = PM.Example.options schema in
- props##.menuBar := Js.some Js._true;
- props##.floatingMenu := Js.some Js._true;
- props##.menuContent := (Footnotes.build_menu pm schema)##.fullMenu;
+ props##.menuBar := Js.some Js._true ;
+ props##.floatingMenu := Js.some Js._true ;
+ props##.menuContent := (Footnotes.build_menu pm schema)##.fullMenu ;
let setup = PM.Example.example_setup pm props in
let keymaps =
- PM.Keymap.keymap pm
- [| "Backspace", (handle_backspace pm)
- ; "#", (handle_sharp pm)
- |] in
+ PM.Keymap.keymap
+ pm
+ [| ("Backspace", handle_backspace pm); ("#", handle_sharp pm) |]
+ in
(* Add the custom keymaps in the list *)
let _ = setup##unshift keymaps in
@@ -133,5 +139,4 @@ let default pm schema =
let _ = setup##push (Tooltip.bold_plugin pm) in
let _ = setup##push (Link_editor.plugin pm) in
-
Js.some setup