blob: 06426d12dff2899f18933a93fb66264f5f9da007 (
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
|
open StdLabels
open Js_of_ocaml
open Brr
module PM = Prosemirror
(** https://prosemirror.net/examples/tooltip/ *)
(** Set the element position just above the selection *)
let set_position
: PM.View.editor_view Js.t -> El.t -> unit
= fun view el ->
El.set_inline_style El.Style.display (Jstr.v "") el;
let start = view##coordsAtPos (view##.state##.selection##.from) Js.null
and end' = view##coordsAtPos (view##.state##.selection##._to) Js.null in
let offsetParent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv el) "offsetParent") in
let box = Jv.(Id.of_jv @@ call (Jv.Id.to_jv offsetParent) "getBoundingClientRect" [||]) in
let box_left = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "left") in
let box_bottom = Jv.(Id.of_jv @@ get (Jv.Id.to_jv box) "bottom") in
let left = Float.max
((start##.left +. end'##.left) /. 2.)
(start##.left +. 3.) in
El.set_inline_style (Jstr.v "left")
Jstr.( (of_float ( left -. box_left )) + (v "px") )
el;
El.set_inline_style (Jstr.v "bottom")
Jstr.( (of_float ( box_bottom -. start##.top )) + (v "px") )
el
let tooltip
: PM.View.editor_view Js.t -> < .. > Js.t
= fun view ->
(* Create the element which will be displayed over the editor *)
let tooltip = El.div []
~at:At.([class' (Jstr.v "tooltip")]) in
El.set_inline_style El.Style.display (Jstr.v "none") tooltip;
let parent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv view##.dom) "parentNode") in
let () = El.append_children parent [tooltip] in
let update
: PM.View.editor_view Js.t -> PM.State.editor_state Js. t Js.opt -> unit
= fun view state_opt ->
Js.Opt.case state_opt
(fun () -> ())
(fun previous_state ->
if ((view##.state##.doc##eq previous_state##.doc) = Js._true)
&& ((previous_state##.selection##eq view##.state##.selection) = Js._true)
then
()
else (
if (view##.state##.selection##.empty) = Js._true then
(* Hide the tooltip if the selection is empty *)
El.set_inline_style El.Style.display (Jstr.v "none") tooltip
else (
(* otherwise, reposition it and update its content *)
set_position view tooltip;
El.set_prop
(El.Prop.jstr (Jstr.v "textContent"))
(Jstr.of_int
(view##.state##.selection##._to - view##.state##.selection##.from))
tooltip)))
and destroy () = El.remove tooltip in
object%js
val update = Js.wrap_callback update
val destroy= Js.wrap_callback destroy
end
let tooltip_plugin
: PM.t -> PM.State.plugin Js.t
= fun t ->
let state = Jv.get (Jv.Id.to_jv t) "state" in
let params = object%js
val view = (fun view -> tooltip view)
end in
Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |]
|> Jv.Id.of_jv
let boldtip
: PM.View.editor_view Js.t -> < .. > Js.t
= fun view ->
(* Create the element which will be displayed over the editor *)
let tooltip = El.div []
~at:At.([class' (Jstr.v "tooltip")]) in
El.set_inline_style El.Style.display (Jstr.v "none") tooltip;
let parent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv view##.dom) "parentNode") in
let () = El.append_children parent [tooltip] in
let update
: PM.View.editor_view Js.t -> PM.State.editor_state Js. t Js.opt -> unit
= fun view _state_opt ->
let state = view##.state in
let is_bold = match PM.O.get state##.schema##.marks "strong" with
| None -> None
| Some mark_type ->
let is_strong = Js.Opt.bind state##.storedMarks (fun t -> mark_type##isInSet t) in
Js.Opt.case is_strong
(fun () -> None)
(fun _ -> Some (Jstr.v "gras")) in
let is_em = match PM.O.get state##.schema##.marks "em" with
| None -> None
| Some mark_type ->
let is_strong = Js.Opt.bind state##.storedMarks (fun t -> mark_type##isInSet t) in
Js.Opt.case is_strong
(fun () -> None)
(fun _ -> Some (Jstr.(v "emphase"))) in
let marks = List.filter_map [is_bold ; is_em]
~f:(fun x -> x) in
match marks with
| [] -> El.set_inline_style El.Style.display (Jstr.v "none") tooltip
| _ ->
(* The mark is present, add in the content *)
set_position view tooltip;
El.set_prop
(El.Prop.jstr (Jstr.v "textContent"))
(Jstr.concat marks ~sep:(Jstr.v ", "))
tooltip
and destroy () = El.remove tooltip in
object%js
val update = Js.wrap_callback update
val destroy= Js.wrap_callback destroy
end
let bold_plugin
: PM.t -> PM.State.plugin Js.t
= fun t ->
let state = Jv.get (Jv.Id.to_jv t) "state" in
let params = object%js
val view = (fun view -> boldtip view)
end in
Jv.new' (Jv.get state "Plugin") [| Jv.Id.to_jv params |]
|> Jv.Id.of_jv
|
