summaryrefslogtreecommitdiff
path: root/editor/plugins/plugins.ml
blob: 664562875184144430d10b4200caf10daeb9137c (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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
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 ->
        ( 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 *)
    ( match Jstr.to_string res##.parent##._type##.name with
    | "heading" ->
        change_level pm res 1 (fun x -> x > 5) state dispatch
    | "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
  match Js.Opt.to_option res##.nodeBefore with
  | 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 )


(** Activate the given mark at position. 

    [toggle_mark regex pm] will create a rule with the given regex, and
    then apply the mark *)
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 ) )


(** Transform the selection into URL *)
let into_url : Js.regExp Js.t -> PM.t -> PM.InputRule.input_rule Js.t =
 fun regExp pm ->
  PM.InputRule.create
    pm
    regExp
    ~fn:
      ( Js.wrap_callback
      @@ fun (state : PM.State.editor_state Js.t) content ~from ~to_ ->
      let matched_text = Js.array_get content 1 |> Js.Optdef.to_option
      and mark = PM.O.get state##.schema##.marks "link" in

      match (matched_text, mark) with
      | Some url, Some mark_type ->
          let attrs = PM.O.init [| ("href", url) |] in
          (* Create the mark containing the URL *)
          let m = state##.schema##mark_fromType mark_type (Js.some attrs) in
          (* Apply the mark as a transaction *)
          let tr =
            state
            ##. tr
            ## (addMark ~from ~to_ m)
            ## (insertText (Jstr.v " ") ~from:Js.null ~to_:Js.null)
          in
          Js.some tr
      | _ ->
          Js.null )


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"
  and url = into_url (new%js Js.regExp (Js.string "(\\w+://\\S+)\\s$")) pm in

  PM.InputRule.to_plugin pm (Js.array [| bold; url; 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