From 8d23a029c57be92a7aed0f18d9fcf1c931c1038e Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Mon, 7 Feb 2022 16:40:45 +0100 Subject: Reformat --- editor/plugins/plugins.ml | 209 ++++++++++++++++++++++++---------------------- 1 file changed, 107 insertions(+), 102 deletions(-) (limited to 'editor/plugins/plugins.ml') 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 -- cgit v1.2.3