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
open Eio.Std
open Wayland_client
let log_msg_src = Logs.Src.create "wayland-client" ~doc:"Wayland client messages"
module Log_msg = (val Logs.src_log log_msg_src : Logs.LOG)
let init_logging = lazy (
match Sys.getenv_opt "WAYLAND_DEBUG" with
| Some ("1" | "client") -> Logs.Src.set_level log_msg_src (Some Logs.Debug)
| _ -> ()
)
type t = {
conn : [`Client] Connection.t;
wl_display : [`V1] Wl_display.t;
}
module type TRACE = Proxy.TRACE with type role = [`Client]
module Trace : TRACE = struct
type role = [`Client]
let inbound (type a) (proxy : (a, _, _) Proxy.t) msg =
Log_msg.debug (fun f ->
let (module M : Metadata.S with type t = a) = Proxy.metadata proxy in
let msg_name, arg_info = M.events (Msg.op msg) in
f "@[<h><- %a.%s %a@]"
Proxy.pp proxy
msg_name
(Msg.pp_args arg_info) msg
)
let outbound (type a) (proxy : (a, _, _) Proxy.t) msg =
Log_msg.debug (fun f ->
let (module M) = Proxy.metadata proxy in
let msg_name, arg_info = M.requests (Msg.op msg) in
f "@[<h>-> %a.%s %a@]"
Proxy.pp proxy
msg_name
(Msg.pp_args arg_info) msg
)
end
let connect ?(trace=(module Trace : TRACE)) ~sw transport =
Lazy.force init_logging;
let conn, wl_display = Connection.connect ~sw ~trace `Client transport @@ object
inherit [_] Wl_display.v1
method on_error _ ~object_id ~code ~message =
Log.err (fun f -> f "Received Wayland error: %ld %S on object %ld" code message object_id)
method on_delete_id proxy ~id =
Proxy.delete_other proxy id
end
in
{ conn; wl_display }
let sync t =
let result, set_result = Promise.create () in
let _ : _ Wl_callback.t = Wl_display.sync t.wl_display @@ object
inherit [_] Wl_callback.v1
method on_done ~callback_data:_ = Promise.resolve set_result ()
end
in
Promise.await result
let wl_display t = t.wl_display
let dump f t = Connection.dump f t.conn
let stop t = Connection.stop t.conn