Source file `window_rules.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
open! Oxbow_core
open! Oxbow_state

let ( |>? ) o f = Option.iter f o

(* Effect order: output, tags, presentation, resize, move, sticky, swallow, label.
   Roughly, placement targets -> mode -> geometry -> etc. *)
let apply_effects
      (queue : Window.Request.t -> unit)
      (e : Window_rule.Effects.t)
      (window : Window.t)
  =
  (e.output |>? fun { name; policy } -> queue (Send_to_output_name { name; policy }));
  (e.tags |>? fun arg -> queue (Set_tags arg));
  (e.presentation
   |>? function
   | Float -> queue Float
   | Tile -> queue Tile
   | Fullscreen -> queue (Fullscreen { output = None })
   | Windowed -> queue Exit_fullscreen
   | Maximize -> queue Maximize
   | Fake_fullscreen -> queue Fake_fullscreen);
  (e.resize_to |>? fun { w; h } -> queue (Resize_to { w; h }));
  (e.move_to |>? fun { x; y } -> queue (Move_to { x; y }));
  (e.sticky |>? fun s -> queue (Set_sticky s));
  (e.scratchpad |>? fun name -> Window.set_scratchpad window (Some name));
  e.swallow |>? Window.set_swallow_role window;
  e.label_as |>? fun l -> Window.add_label window l
;;

let apply (window : Window.t) ({ pattern; effects } : Window_rule.t) =
  match Window_pattern.compile pattern with
  | Error e -> Log.debug @@ fun m -> m "%s" e
  | Ok matches ->
    if
      matches
        ~title:window.title
        ~app_id:window.app_id
        ~identifier:window.identifier
        ~labels:window.labels
    then (
      let queue r = Window.queue_request window r in
      apply_effects queue effects window)
;;

let apply_for (wm : Wm.t) window = List.iter (apply window) wm.config.rules.window
let same (p : Window_pattern.t) (r : Window_rule.t) = Window_pattern.equal p r.pattern

let add (wm : Wm.t) (rule : Window_rule.t) =
  Result.bind (Window_pattern.compile rule.pattern)
  @@ fun _ ->
  match List.find_opt (same rule.pattern) wm.config.rules.window with
  | Some old ->
    let merged =
      { rule with
        effects = Window_rule.Effects.merge ~old:old.effects ~new_:rule.effects
      }
    in
    Config.replace_window_rule wm merged;
    List.iter (fun w -> apply w merged) wm.windows;
    Ok None
  | None ->
    Config.add_window_rule wm rule;
    List.iter (fun w -> apply w rule) wm.windows;
    Ok None
;;

let remove wm indices = Config.remove_rules wm `Window indices

let spawn_for (wm : Wm.t) (window : Window.t) =
  List.fold_left
    (fun (position, focus) ({ pattern; effects } : Window_rule.t) ->
       match Window_pattern.compile pattern with
       | Error _ -> position, focus
       | Ok matches ->
         if
           matches
             ~title:window.title
             ~app_id:window.app_id
             ~identifier:window.identifier
             ~labels:window.labels
         then
           ( Option.value effects.spawn_position ~default:position
           , Option.value effects.spawn_focus ~default:focus )
         else position, focus)
    (wm.config.spawn.position, wm.config.spawn.focus)
    wm.config.rules.window
;;