diff options
Diffstat (limited to 'editor/plugins')
| -rwxr-xr-x | editor/plugins/link_editor.ml | 216 | ||||
| -rwxr-xr-x | editor/plugins/plugins.ml | 209 |
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 |