From 3f5e3dd53755dd67c24721afc62e32d2187e3583 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Wed, 24 Feb 2021 20:51:43 +0100
Subject: Update editor code

---
 editor/plugins.ml | 134 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 134 insertions(+)
 create mode 100755 editor/plugins.ml

(limited to 'editor/plugins.ml')

diff --git a/editor/plugins.ml b/editor/plugins.ml
new file mode 100755
index 0000000..6173c4f
--- /dev/null
+++ b/editor/plugins.ml
@@ -0,0 +1,134 @@
+open Js_of_ocaml
+module PM = Prosemirror
+
+(** 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 ->
+        ( 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 ->
+      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
+  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 > 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
+
+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_type 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
+
+  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
+
+  let props = PM.Example.options schema in
+  props##.menuBar := Js.some Js._true;
+  props##.floatingMenu := Js.some Js._true;
+  let setup = PM.Example.example_setup pm props in
+
+  let keymaps =
+    PM.Keymap.keymap pm
+      [| "Backspace", (handle_backspace pm)
+       ; "#", (handle_sharp pm)
+      |] in
+
+  (* Add the custom keymaps in the list *)
+  let _ = setup##unshift keymaps in
+  let _ = setup##push (input_rule pm) in
+  let _ = setup##push (Tooltip.tooltip_plugin pm) in
+  let _ = setup##push (Tooltip.bold_plugin pm) in
+
+
+  Js.some setup
-- 
cgit v1.2.3