summaryrefslogtreecommitdiff
path: root/editor/plugins/footnotes.ml
blob: 794171f48192fc9df46e426518264ada1d6243a9 (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
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
open Brr
open Js_of_ocaml
module PM = Prosemirror

let footNoteSpec = object%js

  val mutable group = Jstr.v "inline"
  val mutable content = Jstr.v "inline*" (* The star is very important ! *)
  val mutable inline = Js._true
  val mutable draggable = Js._true
  (*  This makes the view treat the node as a leaf, even though it
      technically has content *)
  val mutable atom = Js._true

  val toDOM
    : (PM.Model.node Js.t -> PM.Model.domOutputSpec Js.t) Js.callback
    = Js.wrap_callback (fun _ ->
        let open PM.Model.Dom_output_spec in
        v "footnote"
          [ hole ])

  val parseDOM
    : PM.Model.parse_rule Js.t Js.js_array Js.t Js.opt
    = Js.some @@ Js.array
      [|PM.Model.ParseRule.tag (Jstr.v "footnote")|]

end

let footnote_schema pm defaultSchema =

  let nodes = defaultSchema##.spec##.nodes
  and marks = defaultSchema##.spec##.marks in

  let specs = PM.Model.schema_spec
      (nodes##addToEnd (Jstr.v "footnote") (Js.Unsafe.coerce footNoteSpec))
      (Some marks)
      None in

  PM.Model.schema pm
    specs

let build_menu pm schema =
  let menu = PM.Example.buildMenuItems pm schema in

  let itemSpec = PM.Menu.menuItemSpec () in
  itemSpec##.title := Js.some @@ Jstr.v "Insert footnote";
  itemSpec##.label := Js.some @@ Jstr.v "Footnote";
  itemSpec##.select := Js.wrap_meth_callback (fun _ (state:PM.State.editor_state Js.t) ->
      match PM.O.get schema##.nodes "footnote" with
      | None ->  Js._false
      | Some footnote_node ->
        let res = Js.Opt.test @@ PM.Transform.insertPoint
            pm
            state##.doc
            ~pos:state##.selection##.from
            footnote_node
        in
        Js.bool res);

  itemSpec##.run :=
    Js.wrap_meth_callback (fun _this state dispatch _ _ ->
        match PM.O.get schema##.nodes "footnote" with
        | None -> ()
        | Some footnote_node ->

          let from' = PM.State.selection_from state##.selection
          and to' = PM.State.selection_to state##.selection in

          let content =
            if state##.selection##.empty != Js._true
            && from'##sameParent to' = Js._true
            && from'##.parent##.inlineContent = Js._true then (
              from'##.parent##.content##cut
                (from'##.parentOffset)
                (Js.some @@ to'##.parentOffset)
            ) else (
              PM.Model.empty_fragment pm
            ) in
          let new_node = footnote_node##create_withFragmentContent
              Js.null
              (Js.some content)
              Js.null
          in
          dispatch @@
          state##.tr##replaceSelectionWith
            new_node
            Js.null
      );

  let item = PM.Menu.menu_item pm itemSpec in
  let _ = menu##.insertMenu##.content##push item in
  menu

let fromOutside
  : bool PM.State.meta_data Js.t
  = PM.State.create_str_meta_data (Jstr.v "fromOutside")

let footnote_view
  : PM.t -> PM.Model.node Js.t -> PM.View.editor_view Js.t -> (unit -> int) -> < .. > Js.t
  = fun pm init_node outerView get_pos ->

    (* These are used when the footnote is selected *)
    let innerView
      : PM.View.editor_view Js.t Js.opt ref
      = ref Js.null in

    let dispatchInner
      : PM.View.editor_view Js.t -> PM.State.transaction Js.t -> unit
      = fun view tr ->
        let res = view##.state##applyTransaction tr in
        view##updateState res##.state;

        let meta = Js.Optdef.get (tr##getMeta fromOutside) (fun () -> false) in
        if (not meta) then (
          let outerTr = outerView##.state##.tr
          and offsetMap = PM.Transform.offset pm ((get_pos()) + 1) in
          res##.transactions##forEach
            (Js.wrap_callback @@
             fun (elem:PM.State.transaction Js.t) _ _ ->
             elem##.steps##forEach
               (Js.wrap_callback @@ fun (step:PM.Transform.step Js.t) _ _ ->
                let _ = outerTr##step (step##map offsetMap) in
                ()
               ));
          if (outerTr##.docChanged = Js._true) then (
            outerView##dispatch outerTr)
        );
    in
    object%js (_self)

      val mutable node: PM.Model.node Js.t = init_node

      (* The node's representation in the editor (empty, for now) *)
      val dom = El.v (Jstr.v "footnote") []

      method _open =
        (* Append a tooltip to the outer node *)
        let tooltip = El.div []
            ~at:At.([class' (Jstr.v "popin")]) in
        El.append_children _self##.dom
          [ tooltip ];

        let dispatch_fn
          : PM.State.transaction Js.t -> unit
          = fun tr -> outerView##dispatch tr in

        let state_properties = Js.Unsafe.coerce (object%js
            val doc = Js.some _self##.node;
            val plugins = Js.some @@ Js.array @@ [|
                PM.Keymap.keymap pm
                  [| ( "Mod-z"
                     , (fun _ _ -> PM.History.undo pm outerView##.state (Js.some dispatch_fn)))
                   ; ( "Mod-y"
                     , (fun _ _ -> PM.History.redo pm outerView##.state (Js.some dispatch_fn)))
                  |]
              |];
          end) in

        let view_properties = PM.View.direct_editor_props () in
        view_properties##.state := PM.State.create pm state_properties;
        (* This is the magic part *)
        view_properties##.dispatchTransaction :=
          (Js.wrap_meth_callback dispatchInner);
        view_properties##.handleDOMEvents := PM.O.init
            [| ( "mousedown"
               , Js.wrap_callback (fun _ _ ->
                     (* Kludge to prevent issues due to the fact that the
                        whole footnote is node-selected (and thus DOM-selected)
                        when the parent editor is focused. *)
                     if (outerView##hasFocus () = Js._true) then (
                       Js.Opt.iter !innerView (fun view -> view##focus ())
                     );
                     Js._false ))|];

        innerView := Js.some
            (PM.View.editor_view pm
               tooltip
               view_properties);

      method close =
        Js.Opt.iter (!innerView)
          (fun view ->
             view##destroy;
             innerView := Js.null;
             El.set_prop
               (El.Prop.jstr (Jstr.v "textContent"))
               (Jstr.empty)
               _self##.dom
          )

      method update
        : PM.Model.node Js.t -> bool Js.t
        = fun node ->
          if (node##sameMarkup _self##.node = Js._false) then (
            Js._false
          ) else (
            _self##.node := node;
            Js.Opt.iter !innerView (fun view ->
                let state = view##.state in
                Js.Opt.iter (node##.content##findDiffStart state##.doc##.content) (fun start ->
                    let res_opt = (node##.content##findDiffEnd state##.doc##.content) in
                    Js.Opt.iter res_opt (fun end_diff ->
                        let overlap = start - (min end_diff##.a end_diff##.b) in
                        let endA, endB =
                          if overlap > 0 then
                            ( end_diff##.a + overlap
                            , end_diff##.b + overlap )
                          else
                            ( end_diff##.a
                            , end_diff##.b )
                        in
                        let tr =
                          state##.tr
                          ##(replace
                               ~from:start
                               ~to_:endB
                               (Js.some @@ node##slice ~from:start ~to_:(Js.some endA)))
                          ##(setMeta fromOutside true) in
                        view##dispatch tr)));
            Js._true
          )

      method destroy =
        Js.Opt.iter !innerView (fun _ -> _self##close)

      method stopEvent e =
        Js.Opt.case !innerView
          (fun () -> Js._false)
          (fun view ->
             let dom = view##.dom in
             Jv.call (Jv.Id.to_jv dom) "contains" [| e##.target|]
             |> Jv.Id.of_jv)

      method ignoreMutation =
        Js._true

      method selectNode =
        El.set_class (Jstr.v "ProseMirror-selectednode") true _self##.dom;
        if not (Js.Opt.test !innerView) then (
          _self##_open
        )

      method deselectNode =
        El.set_class (Jstr.v "ProseMirror-selectednode") false _self##.dom;
        if (Js.Opt.test !innerView) then
          _self##close

    end