aboutsummaryrefslogtreecommitdiff
path: root/editor/plugins.ml
blob: 68f9c31f2e40b9fc12bc59beb815eef2e8dcada5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
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_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

  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;
  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

  (* Add the custom keymaps in the list *)
  let _ = setup##unshift keymaps in
  let _ = setup##push (input_rule pm) in
  let _ = setup##push (Tooltip.bold_plugin pm) in
  let _ = setup##push (Link_editor.plugin pm) in


  Js.some setup