blob: adb37f13626cdbc2a4b7599486b4085b86196870 (
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
|
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
: start:int -> end':int -> PM.View.editor_view Js.t -> El.t -> unit
= fun ~start ~end' view el ->
El.set_inline_style El.Style.display (Jstr.v "") el;
(* These are in screen coordinates *)
let start = view##coordsAtPos start Js.null
and end' = view##coordsAtPos end' Js.null in
let offsetParent = Jv.(Id.of_jv @@ get (Jv.Id.to_jv el) "offsetParent") in
(* The box in which the tooltip is positioned, to use as base *)
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
(* Find a center-ish x position from the selection endpoints (when
crossing lines, end may be more to the left) *)
let left = (start##.left +. end'##.left) /. 2. 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 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 ->
(* Compare the previous and actual state. If the stored marks are the
same, just return *)
let state = view##.state in
let previous_stored_marks =
Js.Opt.bind state_opt (fun state -> state##.storedMarks)
|> Js.Opt.to_option
and current_stored_marks = state##.storedMarks in
let same = match previous_stored_marks, Js.Opt.to_option current_stored_marks with
| Some arr1, Some arr2 ->
Js_lib.Array.compare arr1 arr2 ~f:(fun v1 v2 -> v1##eq v2)
| None, None -> Js._true
| _, _ -> Js._false in
if same <> Js._true then
let is_bold = Option.bind (PM.O.get state##.schema##.marks "strong")
(fun mark_type ->
let is_strong =
Js.Opt.bind current_stored_marks
(fun t -> mark_type##isInSet t) in
Js.Opt.case is_strong
(fun () -> None)
(fun _ -> Some (Jstr.v "gras"))) in
let is_em = Option.bind (PM.O.get state##.schema##.marks "em")
(fun mark_type ->
let is_em =
Js.Opt.bind current_stored_marks
(fun t -> mark_type##isInSet t) in
Js.Opt.case is_em
(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 *)
let start = view##.state##.selection##.from
and end' = view##.state##.selection##._to in
set_position ~start ~end' 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
|
