jon.recoil.org
A fork of mtelver's day10 project
1open Code_mirror
2
3module Tooltip_view = struct
4 type t = Jv.t
5
6 include (Jv.Id : Jv.CONV with type t := t)
7
8 let dom t = Jv.get t "dom" |> Brr.El.of_jv
9
10 type offset = { x : int; y : int }
11 type coords = { left : int; right : int; top : int; bottom : int }
12
13 let offset_of_jv o = { x = Jv.Int.get o "x"; y = Jv.Int.get o "y" }
14
15 let offset_to_jv { x; y } =
16 let o = Jv.obj [||] in
17 Jv.Int.set o "x" x;
18 Jv.Int.set o "y" y;
19 o
20
21 let _coords_of_jv o =
22 {
23 left = Jv.Int.get o "left";
24 right = Jv.Int.get o "right";
25 top = Jv.Int.get o "top";
26 bottom = Jv.Int.get o "bottom";
27 }
28
29 let coords_to_jv { left; right; top; bottom } =
30 let o = Jv.obj [||] in
31 Jv.Int.set o "left" left;
32 Jv.Int.set o "right" right;
33 Jv.Int.set o "top" top;
34 Jv.Int.set o "bottom" bottom;
35 o
36
37 let offset t = Jv.get t "offset" |> offset_of_jv
38
39 let create ~dom ?offset ?get_coords ?overlap ?mount ?update ?positioned () =
40 let get_coords =
41 Option.map
42 (fun get_coords ->
43 Jv.repr (fun pos -> get_coords (Jv.to_int pos) |> coords_to_jv))
44 get_coords
45 in
46 let o = Jv.obj [||] in
47 Jv.set o "dom" (Brr.El.to_jv dom);
48 Jv.set_if_some o "offset" @@ Option.map offset_to_jv offset;
49 Jv.set_if_some o "getCoords" get_coords;
50 Jv.Bool.set_if_some o "overlap" overlap;
51 Jv.set_if_some o "mount"
52 @@ Option.map
53 (fun mount -> Jv.repr (fun view -> mount (Editor.View.of_jv view)))
54 mount;
55 Jv.set_if_some o "update"
56 @@ Option.map
57 (fun update ->
58 Jv.repr (fun view_up -> update (Editor.View.Update.of_jv view_up)))
59 update;
60 Jv.set_if_some o "positioned" @@ Option.map Jv.repr positioned;
61 o
62end
63
64module Tooltip = struct
65 type t = Jv.t
66
67 include (Jv.Id : Jv.CONV with type t := t)
68
69 let pos t = Jv.Int.get t "pos"
70 let end_ t = Jv.to_option Jv.to_int @@ Jv.get t "end"
71
72 let create ~pos ?end_ ~create ?above ?strict_side ?arrow () =
73 let o = Jv.obj [||] in
74 Jv.Int.set o "pos" pos;
75 Jv.Int.set_if_some o "end" end_;
76 Jv.set o "create"
77 @@ Jv.repr (fun view ->
78 create (Editor.View.of_jv view) |> Tooltip_view.to_jv);
79 Jv.Bool.set_if_some o "above" above;
80 Jv.Bool.set_if_some o "strictSide" strict_side;
81 Jv.Bool.set_if_some o "arrow" arrow;
82 o
83end
84
85type hover_config = Jv.t
86
87let hover_config ?hide_on_change ?hover_time () =
88 let o = Jv.obj [||] in
89 Jv.Bool.set_if_some o "hide_on_change" hide_on_change;
90 Jv.Int.set_if_some o "hover_time" hover_time;
91 o
92
93let hover_tooltip ?config source =
94 (* let g = Jv.get Jv.global "__CM__hoverTooltip" in *)
95 let source =
96 Jv.repr @@ fun view pos side ->
97 let fut =
98 source ~view:(Editor.View.of_jv view) ~pos:(Jv.to_int pos)
99 ~side:(Jv.to_int side)
100 in
101 let fut = Fut.map (fun v -> Ok v) fut in
102 Fut.to_promise fut ~ok:(fun t ->
103 Option.value ~default:Jv.null (Option.map Tooltip.to_jv t))
104 in
105 let args =
106 if Option.is_none config then [| source |]
107 else [| source; Option.get config |]
108 in
109 Jv.call Jv.global "__CM__hoverTooltip" args |> Extension.of_jv