Setup proper WM lifecycle and xcb bindings

2026-07-26 14:45:58 +01:00
parent 837d457b10
commit 45ef92f27e
11 changed files with 559 additions and 348 deletions
@@ -1,7 +1,77 @@
 open Ctypes
 open Foreign

-type t = Unsigned.UInt32.t
+let _xcb_change_window_attributes_checked =
+  foreign "xcb_change_window_attributes_checked"
+    (ptr Types.Connection.typ @-> Types.Window.typ @-> uint32_t @-> ptr uint32_t
+    @-> returning Types.Cookie.Void.typ)

-let typ : t Ctypes.typ = Ctypes.uint32_t
-let of_int x = Unsigned.UInt32.of_int x
+let values =
+  CArray.of_list uint32_t
+    [ Unsigned.UInt32.of_int (1048576 lor 524288 lor 131072 lor 4194304) ]
+
+let setup conn root =
+  let cookie =
+    _xcb_change_window_attributes_checked conn root
+      (Unsigned.UInt32.of_int 2048)
+      (CArray.start values)
+  in
+  Error.check conn cookie
+
+let _xcb_grab_key =
+  foreign "xcb_grab_key"
+    (ptr Types.Connection.typ @-> uint8_t @-> Types.Window.typ @-> uint16_t
+   @-> uint8_t @-> uint8_t @-> uint8_t
+    @-> returning Types.Cookie.Void.typ)
+
+let keybind conn window modifier key =
+  let cookie =
+    _xcb_grab_key conn (Unsigned.UInt8.of_int 0) window
+      (Unsigned.UInt16.of_int modifier)
+      (Unsigned.UInt8.of_int key)
+      (Unsigned.UInt8.of_int 1) (Unsigned.UInt8.of_int 1)
+  in
+  Error.check conn cookie
+
+let _xcb_map_window =
+  foreign "xcb_map_window"
+    (ptr Types.Connection.typ @-> Types.Window.typ
+    @-> returning Types.Cookie.Void.typ)
+
+let map conn window =
+  let cookie = _xcb_map_window conn window in
+  Error.check conn cookie
+
+let _xcb_kill_client =
+  foreign "xcb_kill_client"
+    (ptr Types.Connection.typ @-> Types.Window.typ
+    @-> returning Types.Cookie.Void.typ)
+
+let force_kill conn window = ignore (_xcb_kill_client conn window)
+
+let _xcb_send_event =
+  foreign "xcb_send_event"
+    (ptr Types.Connection.typ @-> uint8_t @-> Types.Window.typ @-> uint32_t
+   @-> ptr char
+    @-> returning Types.Cookie.Void.typ)
+
+let kill conn window =
+  let protocols_cookie = Cookie.Atom.wm_protocols conn in
+  let delete_cookie = Cookie.Atom.wm_delete_window conn in
+  match (Reply.get conn protocols_cookie, Reply.get conn delete_cookie) with
+  | Some protocols, Some delete_window ->
+      let ev = make Types.Client_message.typ in
+      setf ev Types.Client_message.response_type (Unsigned.UInt8.of_int 33);
+      setf ev Types.Client_message.window window;
+      setf ev Types.Client_message.type_ protocols;
+      setf ev Types.Client_message.format (Unsigned.UInt8.of_int 32);
+      let data = getf ev Types.Client_message.data in
+      CArray.set data 0 delete_window;
+      CArray.set data 1 (Unsigned.UInt32.of_int 0);
+      let cookie =
+        _xcb_send_event conn (Unsigned.UInt8.of_int 0) window
+          (Unsigned.UInt32.of_int 0)
+          (Types.Client_message.ptr ev)
+      in
+      Error.check conn cookie
+  | _ -> force_kill conn window