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
|
