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
open! Oxbow_state
open! Oxbow_ipc
open! Oxbow_ops
let snapshot_tags (output : Output.t) =
match output.name, Records.to_tags output with
| None, _ | _, None -> None
| Some name, Some record -> Some ((Record.Tags, name), Event.Tags record)
;;
let snapshot_windows (wm : Wm.t) (output : Output.t) =
match output.name with
| None -> None
| Some name ->
let ev =
match Output.focused_window output with
| Some w -> Event.Window (Records.to_window wm w)
| None -> Event.Window_cleared name
in
Some ((Record.Window, name), ev)
;;
let snapshot_layout (output : Output.t) =
match output.name, Records.to_layout output with
| None, _ | _, None -> None
| Some name, Some record -> Some ((Record.Layout, name), Event.Layout record)
;;
let snapshot_mode (seat : Seat.t) =
match seat.name, Records.to_mode seat with
| None, _ | _, None -> None
| Some name, Some record -> Some ((Record.Mode, name), Event.Mode record)
;;
let snapshot_focus (seat : Seat.t) =
match seat.name, Records.to_focus seat with
| None, _ | _, None -> None
| Some name, Some record -> Some ((Record.Focus, name), Event.Focus record)
;;
let snapshot_output (wm : Wm.t) (output : Output.t) =
match output.name, wm.seats with
| None, _ | _, [] -> None
| Some name, seat :: _ ->
Some ((Record.Output, name), Event.Output (Records.to_output seat output))
;;
let snapshots (wm : Wm.t) =
let seat_snaps =
List.concat_map
(fun (s : Seat.t) ->
let snaps = [ snapshot_mode s; snapshot_focus s ] in
List.filter_map Fun.id snaps)
wm.seats
in
let out_snaps =
List.concat_map
(fun (o : Output.t) ->
let snaps =
[ snapshot_tags o
; snapshot_windows wm o
; snapshot_layout o
; snapshot_output wm o
]
in
List.filter_map Fun.id snaps)
wm.outputs
in
out_snaps @ seat_snaps
;;
let matches (sub : Wm.Ipc.Subscriber.t) (k, source) =
List.exists (Record.equal k) sub.kinds
&&
match sub.output with
| None -> true
| Some o ->
(match k with
| Mode | Focus -> true
| Tags | Window | Layout | Output -> String.equal o source)
;;
let offer (sub : Wm.Ipc.Subscriber.t) key line =
if List.mem_assoc key sub.pending
then
sub.pending
<- List.map (fun (k, old) -> if k = key then k, line else k, old) sub.pending
else sub.pending <- sub.pending @ [ key, line ];
Eio.Condition.broadcast sub.wake
;;
let seed (wm : Wm.t) (sub : Wm.Ipc.Subscriber.t) =
wm.ipc.last <- snapshots wm;
List.iter
(fun (key, ev) -> if matches sub key then offer sub key (Event.to_line ev))
wm.ipc.last
;;
let publish (wm : Wm.t) =
match wm.ipc.subscribers with
| [] -> ()
| _ :: _ ->
let snaps = snapshots wm in
let changed =
List.filter_map
(fun (key, ev) ->
match List.assoc_opt key wm.ipc.last with
| None -> Some (key, ev)
| Some ev' when ev <> ev' -> Some (key, ev)
| _ -> None)
snaps
in
List.iter
(fun (key, ev) ->
let line = Event.to_line ev in
List.iter
(fun sub -> if matches sub key then offer sub key line)
wm.ipc.subscribers)
changed;
wm.ipc.last <- snaps
;;