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
open! Oxbow_core
open! Oxbow_state
let read_parent_pid pid =
let path = Printf.sprintf "/proc/%d/stat" pid in
match In_channel.with_open_text path In_channel.input_line with
| exception Sys_error _ -> None
| None -> None
| Some line ->
(match String.rindex_opt line ')' with
| None -> None
| Some i ->
let rest = String.sub line (i + 1) (String.length line - i - 1) in
let fields = String.split_on_char ' ' rest |> List.filter (fun s -> s <> "") in
Option.bind (List.nth_opt fields 1) int_of_string_opt)
;;
let parent_pid = ref read_parent_pid
let ancestors pid =
let rec walk depth pid' =
if depth = 0
then []
else (
match !parent_pid pid' with
| None -> []
| Some p -> p :: walk (depth - 1) p)
in
walk 64 pid
;;
let find_host (wm : Wm.t) (child : Window.t) =
let chain =
match child.unreliable_pid with
| Some p -> ancestors (Int32.to_int p)
| None -> []
in
let eligible w =
Window.can_swallow w
&& Window.is_tiled_or_floating w
&& Phys.opt_equal w.output child.output
&& Tag.Set.intersects w.tags child.tags
&&
match w.unreliable_pid with
| Some p -> List.mem (Int32.to_int p) chain
| None -> false
in
List.find_opt eligible wm.windows
;;
let swallow ~(host : Window.t) ~child =
Window.set_tags child host.tags;
(match host.output with
| Some o when Window.floats host o ->
Window.set_geom child (Window.clamp32 child host.geom);
Window.set_presentation child host.presentation;
Window.remember_float child
| Some _ | None -> ());
Option.iter (Stacking.replace ~old_w:host ~new_w:child) host.output;
Window.swallow ~host ~child
;;
let try_swallow (wm : Wm.t) (child : Window.t) =
let eligible =
(match child.unreliable_pid with
| Some pid -> Int32.to_int pid > 0
| None -> false)
&& child.swallow.role = Auto
&& Option.is_none child.swallow.relation
&& Window.is_tiled_or_floating child
&& Option.is_none child.parent
&& child.sticky = Off
&& Option.is_some child.output
in
if eligible
then (
match find_host wm child with
| None -> ()
| Some host -> swallow ~host ~child)
;;
let unswallow (child : Window.t) =
match child.swallow.relation with
| None | Some (Swallowed_by _) -> ()
| Some (Swallowing host) ->
Window.set_tags host child.tags;
(match child.output with
| None -> ()
| Some o ->
Stacking.replace ~old_w:child ~new_w:host o;
Stacking.push [ child ] o;
if Window.floats host o then Window.restore_float host);
Window.set_swallow_relation host None;
Window.set_swallow_relation child None
;;
let on_close (w : Window.t) =
match w.swallow.relation with
| None -> ()
| Some (Swallowing _) -> unswallow w
| Some (Swallowed_by child) ->
Window.set_swallow_relation child None;
Window.set_swallow_relation w None
;;
let toggle wm seat target =
Result.map (fun _ -> None)
@@ Targets.transact_all_windows wm seat target ~plan:(fun w ->
match w.swallow.relation, w.swallow.role with
| Some (Swallowing _), _ -> Ok (fun () -> unswallow w)
| Some (Swallowed_by _), _ | None, (Terminal | Disabled) -> Ok ignore
| None, Auto -> Ok (fun () -> try_swallow wm w))
;;