package oxbow

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

Source file seat.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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
open! Oxbow_core
open! Oxbow_ipc
include Types.Seat

module Warp_request = struct
  include Types.Seat.Warp_request

  let of_override = function
    | Some b -> Forced b
    | None -> Follow_config
  ;;
end

let unbind_xkb_binding s mode mods keysym =
  let matches (b : Xkb_binding.t) =
    Mode.equal b.mode mode && b.mods = mods && b.keysym = keysym
  in
  let to_destroy, to_keep = List.partition matches s.xkb_bindings in
  List.iter (fun (k : Xkb_binding.t) -> Emit.destroy_xkb_binding k.obj) to_destroy;
  s.xkb_bindings <- to_keep;
  not @@ List.is_empty to_destroy
;;

let queue_pending s request =
  Queue.add request s.pending_requests;
  Schedule.manage ()
;;

let xkb_binding_create (wm : Types.Wm.t) s mode mods keysym command =
  let body = Request.Body.Command command in
  let keysym_i32 = Int32.of_int (Xkbcommon.Keysym.to_int keysym) in
  let binding : Xkb_binding.t =
    { obj =
        Emit.create_xkb_binding
          wm.river_xkb_v1
          ~seat:s.obj
          ~keysym:keysym_i32
          ~mods
          ~on_pressed:(fun () -> queue_pending s { body; reply = None })
    ; seat = s
    ; mode
    ; enabled = false
    ; command
    ; mods
    ; keysym
    }
  in
  s.xkb_bindings <- binding :: s.xkb_bindings
;;

let replace_xkb_binding wm s mode mods keysym command =
  let replaced = unbind_xkb_binding s mode mods keysym in
  xkb_binding_create wm s mode mods keysym command;
  replaced
;;

let unbind_pointer_binding s mode mods button =
  let matches (p : Pointer_binding.t) =
    Mode.equal p.mode mode && p.mods = mods && p.button = button
  in
  let to_destroy, to_keep = List.partition matches s.pointer_bindings in
  List.iter (fun (p : Pointer_binding.t) -> Emit.destroy_pointer_binding p.obj) to_destroy;
  s.pointer_bindings <- to_keep;
  not @@ List.is_empty to_destroy
;;

let pointer_binding_create s mode mods button command =
  let body = Request.Body.Command command in
  let binding : Pointer_binding.t =
    { obj =
        Emit.create_pointer_binding
          s.obj
          ~button:(Pointer_button.to_int32 button)
          ~mods
          ~on_pressed:(fun () -> queue_pending s { body; reply = None })
    ; seat = s
    ; mode
    ; enabled = false
    ; command
    ; mods
    ; button
    }
  in
  s.pointer_bindings <- binding :: s.pointer_bindings
;;

let replace_pointer_binding s mode mods button command =
  let replaced = unbind_pointer_binding s mode mods button in
  pointer_binding_create s mode mods button command;
  replaced
;;

let refresh_cursor_target s =
  if Option.is_some s.hovered then s.cursor_target <- s.hovered
;;

let drain_pending s = Queue.take_opt s.pending_requests

let clear_pending s =
  Queue.iter
    (fun (p : Pending_request.t) ->
       Option.iter (fun u -> Eio.Promise.resolve_error u "wm shutting down") p.reply)
    s.pending_requests;
  Queue.clear s.pending_requests
;;

let set_output s output =
  match s.output, output with
  | Some o, Some o' when o == o' -> ()
  | None, None -> ()
  | _ ->
    s.output <- output;
    Schedule.manage ()
;;

let set_focus_cleared s v = s.focus_cleared <- v

let focus_output s output =
  if not @@ Phys.opt_equal s.output output then set_output s output
;;

let set_layer_focus s layer =
  s.layer_focus <- layer;
  Schedule.manage ()
;;

let set_mode s mode =
  if Mode.(equal mode locked)
  then Error "cannot enter 'locked' mode manually"
  else Ok (s.mode <- mode)
;;

let set_position s (x, y) = s.position <- { x; y }

let set_cursor_target s window =
  s.cursor_target <- window;
  Schedule.manage ()
;;

let set_focus_state s state = s.focus_state <- state
let set_op s op = s.op <- Some op
let clear_op s = s.op <- None

let set_op_delta s dx dy =
  match s.op with
  | Some (Move d) ->
    d.dx <- dx;
    d.dy <- dy
  | Some (Resize d) ->
    d.dx <- dx;
    d.dy <- dy
  | None -> ()
;;

let release_op s =
  match s.op with
  | Some (Move d) -> d.release <- true
  | Some (Resize d) -> d.release <- true
  | None -> ()
;;

let set_lifecycle s lifecycle = s.lifecycle <- lifecycle
let set_name s name = s.name <- name
let set_hovered s window = s.hovered <- window
let set_interacted s window = s.interacted <- window
let set_warp_request s v = s.warp_request <- v
let set_overview_watch s v = s.overview_watch <- v
let set_watch_sent s sent = s.watch_sent <- sent

let bind (wm : Types.Wm.t) s ?(mode = Mode.normal) mods (key : Types.Key.t) command =
  match key with
  | Keysym keysym -> replace_xkb_binding wm s mode mods keysym command
  | Pointer button -> replace_pointer_binding s mode mods button command
;;

let unbind s ?(mode = Mode.normal) mods (key : Types.Key.t) =
  match key with
  | Keysym keysym -> unbind_xkb_binding s mode mods keysym
  | Pointer button -> unbind_pointer_binding s mode mods button
;;

let clear_bindings s =
  List.iter (fun (k : Xkb_binding.t) -> Emit.destroy_xkb_binding k.obj) s.xkb_bindings;
  List.iter
    (fun (p : Pointer_binding.t) -> Emit.destroy_pointer_binding p.obj)
    s.pointer_bindings;
  s.xkb_bindings <- [];
  s.pointer_bindings <- []
;;

let focused_window s =
  match s.output with
  | Some o -> Output.focused_window o
  | None -> None
;;