package oxbow

  1. Overview
  2. Docs
package oxbow
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file swallow.ml

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))
;;