Setup proper WM lifecycle and xcb bindings

src/main.ml

@@ -8,22 +8,51 @@ let spawn cmd =
       Unix.execvp cmd.(0) cmd
   | _pid -> ()
 
+type wm_state = {
+  mutable running : bool;
+  conn : Xcb.Types.Connection.conn_ptr;
+  root : Xcb.Types.Window.t;
+  mutable focus : Xcb.Types.Window.t;
+}
+
 let () =
   let conn = Xcb.Connection.connect () in
 
   print_endline "Connected to X";
 
-  Xcb.Utils.setup conn;
+  let root = Xcb.Utils.get_root conn in
+
+  let state = { running = true; conn; root; focus = root } in
+
+  Xcb.Window.setup conn root;
+  Xcb.Window.keybind conn root 0 24;
+  Xcb.Window.keybind conn root 0 25;
+  Xcb.Window.keybind conn root 0 26;
 
   if Xcb.Connection.flush conn <= 0 then exit 1;
 
-  spawn [| "kitty" |];
+  while state.running do
-
+    (match Xcb.Event.next conn with
-  while true do
+    | None -> ()
-    if Xcb.Connection.flush conn <= 0 then exit 1;
+    | Some ev ->
+        (match Xcb.Event.rtype ev with
+        | KeyPress -> (
+            let key = Xcb.Event.Key.detail (Xcb.Event.Key.from ev) in
+            match key with
+            | 26 -> state.running <- false
+            | 25 -> spawn [| "kitty" |]
+            | 24 -> Xcb.Window.kill state.conn state.focus
+            | _ -> ())
+        | MapRequest ->
+            let req = Xcb.Types.Events.Map_request.from ev in
+            let window = Xcb.Types.Events.Map_request.window req in
+            state.focus <- window;
+            Xcb.Window.map state.conn window
+        | _ -> ());
+        Xcb.Utils.free ev);
+    if Xcb.Connection.flush state.conn <= 0 then exit 1;
     Unix.sleepf 0.01
   done;
 
-  Xcb.Connection.disconnect conn;
+  Xcb.Connection.disconnect state.conn;
-
   print_endline "done"

src/xcb/connection.ml

@@ -1,15 +1,14 @@
 open Ctypes
 open Foreign
 
-type t
-
-let typ : t structure typ = structure "xcb_connection_t"
-
 let _xcb_connect =
-  foreign "xcb_connect" (string_opt @-> ptr int @-> returning (ptr typ))
+  foreign "xcb_connect"
+    (string_opt @-> ptr int @-> returning (ptr Types.Connection.typ))
 
-let disconnect = foreign "xcb_disconnect" (ptr typ @-> returning void)
+let disconnect =
-let flush = foreign "xcb_flush" (ptr typ @-> returning int)
+  foreign "xcb_disconnect" (ptr Types.Connection.typ @-> returning void)
+
+let flush = foreign "xcb_flush" (ptr Types.Connection.typ @-> returning int)
 
 let connect () =
   let screen = allocate int 0 in

src/xcb/cookie.ml

@@ -1,15 +1,18 @@
 open Ctypes
 open Foreign
 
-module Void = struct
+module Atom = struct
-  type t
+  let _xcb_intern_atom =
+    foreign "xcb_intern_atom"
+      (ptr Types.Connection.typ @-> uint8_t @-> uint16_t @-> string
+      @-> returning Types.Cookie.Atom.typ)
 
-  let typ : t structure typ = structure "xcb_void_cookie_t"
+  let intern conn only_if_exists name =
-  let sequence = field typ "sequence" uint32_t
+    _xcb_intern_atom conn
-  let () = seal typ
+      (Unsigned.UInt8.of_int (if only_if_exists then 1 else 0))
+      (Unsigned.UInt16.of_int (String.length name))
+      name
 
-  let _xcb_change_window_attributes_checked =
+  let wm_protocols conn = intern conn true "WM_PROTOCOLS"
-    foreign "xcb_change_window_attributes_checked"
+  let wm_delete_window conn = intern conn false "WM_DELETE_WINDOW"
-      (ptr Connection.typ @-> uint32_t @-> uint32_t @-> ptr uint32_t
-     @-> returning typ)
 end

src/xcb/error.ml

@@ -1,18 +1,15 @@
 open Ctypes
 open Foreign
 
-type t
-
-let typ : t structure typ = structure "xcb_generic_error_t"
-
 let _xcb_request_check =
   foreign "xcb_request_check"
-    (ptr Connection.typ @-> Cookie.Void.typ @-> returning (ptr_opt typ))
+    (ptr Types.Connection.typ @-> Types.Cookie.Void.typ
+    @-> returning (ptr_opt Types.Error.typ))
 
 let has_error =
-  foreign "xcb_connection_has_error" (ptr Connection.typ @-> returning int)
+  foreign "xcb_connection_has_error" (ptr Types.Connection.typ @-> returning int)
 
 let check conn cookie =
   match _xcb_request_check conn cookie with
-  | None -> print_endline "WM ownership acquired"
+  | None -> ()
-  | Some _ -> print_endline "another WM already owns the display"
+  | Some _ -> prerr_endline "failiure"

src/xcb/event.ml

@@ -1,271 +1,72 @@
 open Ctypes
 open Foreign
 
-type generic_event
+type event =
+  | Enter
+  | Leave
+  | KeyPress
+  | KeyRelease
+  | MousePress
+  | MouseMove
+  | MouseRelease
+  | Create
+  | Destroy
+  | Unmap
+  | Map
+  | MapRequest
+  | ConfigureRequest
+  | ResizeRequest
+  | Unknown
 
-let generic_event : generic_event structure typ =
+let event_of_int = function
-  structure "xcb_generic_event_t"
+  | 7 -> Enter
+  | 8 -> Leave
+  | 2 -> KeyPress
+  | 3 -> KeyRelease
+  | 4 -> MousePress
+  | 6 -> MouseMove
+  | 5 -> MouseRelease
+  | 16 -> Create
+  | 17 -> Destroy
+  | 18 -> Unmap
+  | 19 -> Map
+  | 20 -> MapRequest
+  | 23 -> ConfigureRequest
+  | 25 -> ResizeRequest
+  | _ -> Unknown
 
-let response_type = field generic_event "response_type" uint8_t
+module Key = struct
-let pad0 = field generic_event "pad0" uint8_t
+  open Ctypes
-let sequence = field generic_event "sequence" uint16_t
-let pad = field generic_event "pad" (array 7 uint32_t)
-let full_sequence = field generic_event "full_sequence" uint32_t
-let () = seal generic_event
 
-(* TODO: convert all these:
+  type t
-/* Opcode for xcb_create_notify. */
-#define XCB_CREATE_NOTIFY 16
 
-/**
+  let typ : t structure typ = structure "xcb_key_event_t"
- * @brief xcb_create_notify_event_t
+  let response_type = field typ "response_type" uint8_t
- **/
+  let detail = field typ "detail" uint8_t
-typedef struct xcb_create_notify_event_t {
+  let sequence = field typ "sequence" uint16_t
-    uint8_t      response_type;
+  let time = field typ "time" uint32_t
-    uint8_t      pad0;
+  let root = field typ "root" uint32_t
-    uint16_t     sequence;
+  let event = field typ "event" uint32_t
-    xcb_window_t parent;
+  let child = field typ "child" uint32_t
-    xcb_window_t window;
+  let root_x = field typ "root_x" int16_t
-    int16_t      x;
+  let root_y = field typ "root_y" int16_t
-    int16_t      y;
+  let event_x = field typ "event_x" int16_t
-    uint16_t     width;
+  let event_y = field typ "event_y" int16_t
-    uint16_t     height;
+  let state = field typ "state" uint16_t
-    uint16_t     border_width;
+  let same_screen = field typ "same_screen" uint8_t
-    uint8_t      override_redirect;
+  let pad0 = field typ "pad0" uint8_t
-    uint8_t      pad1;
+  let () = seal typ
-} xcb_create_notify_event_t;
+  let from ptr = Ctypes.from_voidp typ (to_voidp ptr)
+  let detail ptr = getf !@ptr detail |> Unsigned.UInt8.to_int
+end
 
-/** Opcode for xcb_destroy_notify. */
+let rtype ptr =
-#define XCB_DESTROY_NOTIFY 17
+  Types.Event.response_type ptr |> Unsigned.UInt8.to_int |> event_of_int
 
-/**
+let _next =
- * @brief xcb_destroy_notify_event_t
+  foreign "xcb_poll_for_event"
- **/
+    (ptr Types.Connection.typ @-> returning (ptr Types.Event.typ))
-typedef struct xcb_destroy_notify_event_t {
-    uint8_t      response_type;
-    uint8_t      pad0;
-    uint16_t     sequence;
-    xcb_window_t event;
-    xcb_window_t window;
-} xcb_destroy_notify_event_t;
 
-/** Opcode for xcb_unmap_notify. */
+let next conn =
-#define XCB_UNMAP_NOTIFY 18
+  let ptr = _next conn in
-
+  if ptr = from_voidp Types.Event.typ null then None else Some ptr
-/**
- * @brief xcb_unmap_notify_event_t
- **/
-typedef struct xcb_unmap_notify_event_t {
-    uint8_t      response_type;
-    uint8_t      pad0;
-    uint16_t     sequence;
-    xcb_window_t event;
-    xcb_window_t window;
-    uint8_t      from_configure;
-    uint8_t      pad1[3];
-} xcb_unmap_notify_event_t;
-
-/** Opcode for xcb_map_notify. */
-#define XCB_MAP_NOTIFY 19
-
-/**
- * @brief xcb_map_notify_event_t
- **/
-typedef struct xcb_map_notify_event_t {
-    uint8_t      response_type;
-    uint8_t      pad0;
-    uint16_t     sequence;
-    xcb_window_t event;
-    xcb_window_t window;
-    uint8_t      override_redirect;
-    uint8_t      pad1[3];
-} xcb_map_notify_event_t;
-
-/** Opcode for xcb_map_request. */
-#define XCB_MAP_REQUEST 20
-
-/**
- * @brief xcb_map_request_event_t
- **/
-typedef struct xcb_map_request_event_t {
-    uint8_t      response_type;
-    uint8_t      pad0;
-    uint16_t     sequence;
-    xcb_window_t parent;
-    xcb_window_t window;
-} xcb_map_request_event_t;
-
-/** Opcode for xcb_enter_notify. */
-#define XCB_ENTER_NOTIFY 7
-
-/**
- * @brief xcb_enter_notify_event_t
- **/
-typedef struct xcb_enter_notify_event_t {
-    uint8_t         response_type;
-    uint8_t         detail;
-    uint16_t        sequence;
-    xcb_timestamp_t time;
-    xcb_window_t    root;
-    xcb_window_t    event;
-    xcb_window_t    child;
-    int16_t         root_x;
-    int16_t         root_y;
-    int16_t         event_x;
-    int16_t         event_y;
-    uint16_t        state;
-    uint8_t         mode;
-    uint8_t         same_screen_focus;
-} xcb_enter_notify_event_t;
-
-/** Opcode for xcb_leave_notify. */
-#define XCB_LEAVE_NOTIFY 8
-
-typedef xcb_enter_notify_event_t xcb_leave_notify_event_t;
-
-/** Opcode for xcb_key_press. */
-#define XCB_KEY_PRESS 2
-
-/**
- * @brief xcb_key_press_event_t
- **/
-typedef struct xcb_key_press_event_t {
-    uint8_t         response_type;
-    xcb_keycode_t   detail;
-    uint16_t        sequence;
-    xcb_timestamp_t time;
-    xcb_window_t    root;
-    xcb_window_t    event;
-    xcb_window_t    child;
-    int16_t         root_x;
-    int16_t         root_y;
-    int16_t         event_x;
-    int16_t         event_y;
-    uint16_t        state;
-    uint8_t         same_screen;
-    uint8_t         pad0;
-} xcb_key_press_event_t;
-
-/** Opcode for xcb_key_release. */
-#define XCB_KEY_RELEASE 3
-
-typedef xcb_key_press_event_t xcb_key_release_event_t;
-
-typedef enum xcb_button_mask_t {
-    XCB_BUTTON_MASK_1 = 256,
-    XCB_BUTTON_MASK_2 = 512,
-    XCB_BUTTON_MASK_3 = 1024,
-    XCB_BUTTON_MASK_4 = 2048,
-    XCB_BUTTON_MASK_5 = 4096,
-    XCB_BUTTON_MASK_ANY = 32768
-} xcb_button_mask_t;
-
-/** Opcode for xcb_button_press. */
-#define XCB_BUTTON_PRESS 4
-
-/**
- * @brief xcb_button_press_event_t
- **/
-typedef struct xcb_button_press_event_t {
-    uint8_t         response_type;
-    xcb_button_t    detail;
-    uint16_t        sequence;
-    xcb_timestamp_t time;
-    xcb_window_t    root;
-    xcb_window_t    event;
-    xcb_window_t    child;
-    int16_t         root_x;
-    int16_t         root_y;
-    int16_t         event_x;
-    int16_t         event_y;
-    uint16_t        state;
-    uint8_t         same_screen;
-    uint8_t         pad0;
-} xcb_button_press_event_t;
-
-/** Opcode for xcb_button_release. */
-#define XCB_BUTTON_RELEASE 5
-
-typedef xcb_button_press_event_t xcb_button_release_event_t;
-
-typedef enum xcb_motion_t {
-    XCB_MOTION_NORMAL = 0,
-    XCB_MOTION_HINT = 1
-} xcb_motion_t;
-
-/** Opcode for xcb_motion_notify. */
-#define XCB_MOTION_NOTIFY 6
-
-/**
- * @brief xcb_motion_notify_event_t
- **/
-typedef struct xcb_motion_notify_event_t {
-    uint8_t         response_type;
-    uint8_t         detail;
-    uint16_t        sequence;
-    xcb_timestamp_t time;
-    xcb_window_t    root;
-    xcb_window_t    event;
-    xcb_window_t    child;
-    int16_t         root_x;
-    int16_t         root_y;
-    int16_t         event_x;
-    int16_t         event_y;
-    uint16_t        state;
-    uint8_t         same_screen;
-    uint8_t         pad0;
-} xcb_motion_notify_event_t;
-
-typedef enum xcb_notify_detail_t {
-    XCB_NOTIFY_DETAIL_ANCESTOR = 0,
-    XCB_NOTIFY_DETAIL_VIRTUAL = 1,
-    XCB_NOTIFY_DETAIL_INFERIOR = 2,
-    XCB_NOTIFY_DETAIL_NONLINEAR = 3,
-    XCB_NOTIFY_DETAIL_NONLINEAR_VIRTUAL = 4,
-    XCB_NOTIFY_DETAIL_POINTER = 5,
-    XCB_NOTIFY_DETAIL_POINTER_ROOT = 6,
-    XCB_NOTIFY_DETAIL_NONE = 7
-} xcb_notify_detail_t;
-
-typedef enum xcb_notify_mode_t {
-    XCB_NOTIFY_MODE_NORMAL = 0,
-    XCB_NOTIFY_MODE_GRAB = 1,
-    XCB_NOTIFY_MODE_UNGRAB = 2,
-    XCB_NOTIFY_MODE_WHILE_GRABBED = 3
-} xcb_notify_mode_t;
-
-/** Opcode for xcb_configure_request. */
-#define XCB_CONFIGURE_REQUEST 23
-
-/**
- * @brief xcb_configure_request_event_t
- **/
-typedef struct xcb_configure_request_event_t {
-    uint8_t      response_type;
-    uint8_t      stack_mode;
-    uint16_t     sequence;
-    xcb_window_t parent;
-    xcb_window_t window;
-    xcb_window_t sibling;
-    int16_t      x;
-    int16_t      y;
-    uint16_t     width;
-    uint16_t     height;
-    uint16_t     border_width;
-    uint16_t     value_mask;
-} xcb_configure_request_event_t;
-
-/** Opcode for xcb_resize_request. */
-#define XCB_RESIZE_REQUEST 25
-
-/**
- * @brief xcb_resize_request_event_t
- **/
-typedef struct xcb_resize_request_event_t {
-    uint8_t      response_type;
-    uint8_t      pad0;
-    uint16_t     sequence;
-    xcb_window_t window;
-    uint16_t     width;
-    uint16_t     height;
-} xcb_resize_request_event_t;*)

src/xcb/reply.ml

@@ -0,0 +1,16 @@
+open Ctypes
+open Foreign
+
+let _xcb_intern_atom_reply =
+  foreign "xcb_intern_atom_reply"
+    (ptr Types.Connection.typ @-> Types.Cookie.Atom.typ @-> ptr_opt void
+    @-> returning (ptr Types.Reply.typ))
+
+let get conn cookie =
+  let reply = _xcb_intern_atom_reply conn cookie None in
+  if is_null reply then None
+  else begin
+    let atom = Types.Reply.get_atom reply in
+    Utils.free (to_voidp reply);
+    Some atom
+  end

src/xcb/screen.ml

@@ -1,25 +0,0 @@
-open Ctypes
-open Foreign
-open Ctypes
-
-type t
-
-let typ : t structure typ = structure "xcb_screen_t"
-let root = field typ "root" Window.typ
-let default_colormap = field typ "default_colormap" uint32_t
-let white_pixel = field typ "white_pixel" uint32_t
-let black_pixel = field typ "black_pixel" uint32_t
-let current_input_masks = field typ "current_input_masks" uint32_t
-let width_in_pixels = field typ "width_in_pixels" uint16_t
-let height_in_pixels = field typ "height_in_pixels" uint16_t
-let width_in_millimeters = field typ "width_in_millimeters" uint16_t
-let height_in_millimeters = field typ "height_in_millimeters" uint16_t
-let min_installed_maps = field typ "min_installed_maps" uint16_t
-let max_installed_maps = field typ "max_installed_maps" uint16_t
-let root_visual = field typ "root_visual" uint32_t
-let backing_stores = field typ "backing_stores" uint8_t
-let save_unders = field typ "save_unders" uint8_t
-let root_depth = field typ "root_depth" uint8_t
-let allowed_depths_len = field typ "allowed_depths_len" uint8_t
-let () = seal typ
-let root ptr = getf ptr root

src/xcb/screen_iterator.ml

@@ -1,22 +1,12 @@
 open Ctypes
 open Foreign
 
-module Setup = struct
+let get =
-  type t
+  foreign "xcb_get_setup"
-
+    (ptr Types.Connection.typ @-> returning (ptr Types.Setup.typ))
-  let typ : t structure typ = structure "xcb_setup_t"
-  let get = foreign "xcb_get_setup" (ptr Connection.typ @-> returning (ptr typ))
-end
-
-type t
-
-let typ : t structure typ = structure "xcb_screen_iterator_t"
-let data = field typ "data" (ptr Screen.typ)
-let rem = field typ "rem" int
-let index = field typ "index" int
-let () = seal typ
 
 let _xcb_get =
-  foreign "xcb_setup_roots_iterator" (ptr Setup.typ @-> returning typ)
+  foreign "xcb_setup_roots_iterator"
+    (ptr Types.Setup.typ @-> returning Types.Screen_iterator.typ)
 
-let screen conn = !@(getf (_xcb_get (Setup.get conn)) data)
+let screen conn = get conn |> _xcb_get |> Types.Screen_iterator.screen

src/xcb/types.ml

@@ -0,0 +1,340 @@
+open Ctypes
+open Foreign
+
+module Connection = struct
+  type t
+  type conn_ptr = t structure ptr
+
+  let typ : t structure typ = structure "xcb_connection_t"
+end
+
+module Window = struct
+  type t = Unsigned.UInt32.t
+
+  let typ : t Ctypes.typ = Ctypes.uint32_t
+  let of_int x = Unsigned.UInt32.of_int x
+end
+
+module Cookie = struct
+  module Void = struct
+    type t
+
+    let typ : t structure typ = structure "xcb_void_cookie_t"
+    let sequence = field typ "sequence" uint32_t
+    let () = seal typ
+  end
+
+  module Atom = struct
+    type t
+
+    let typ : t structure typ = structure "xcb_intern_atom_cookie_t"
+    let sequence = field typ "sequence" uint32_t
+    let () = seal typ
+  end
+end
+
+module Error = struct
+  type t
+
+  let typ : t structure typ = structure "xcb_generic_error_t"
+end
+
+module Event = struct
+  type t
+
+  let typ : t structure typ = structure "xcb_generic_event_t"
+  let response_type = field typ "response_type" uint8_t
+  let pad0 = field typ "pad0" uint8_t
+  let sequence = field typ "sequence" uint16_t
+  let pad = field typ "pad" (array 7 uint32_t)
+  let full_sequence = field typ "full_sequence" uint32_t
+  let () = seal typ
+  let response_type ptr = getf !@ptr response_type
+end
+
+module Events = struct
+  module Map_request = struct
+    open Ctypes
+
+    type t
+
+    let typ : t structure typ = structure "xcb_map_request_event_t"
+    let response_type = field typ "response_type" uint8_t
+    let pad0 = field typ "pad0" uint8_t
+    let sequence = field typ "sequence" uint16_t
+    let parent = field typ "parent" uint32_t
+    let window = field typ "window" Window.typ
+    let () = seal typ
+    let from ptr = Ctypes.from_voidp typ (to_voidp ptr)
+    let window ptr = getf !@ptr window
+  end
+end
+
+module Client_message = struct
+  type t
+
+  let typ : t structure typ = structure "xcb_client_message_event_t"
+  let response_type = field typ "response_type" uint8_t
+  let format = field typ "format" uint8_t
+  let sequence = field typ "sequence" uint16_t
+  let window = field typ "window" Window.typ
+  let type_ = field typ "type" uint32_t
+  let data = field typ "data" (array 5 uint32_t)
+  let () = seal typ
+  let ptr ev = to_voidp (addr ev) |> from_voidp char
+end
+
+module Atom = struct
+  type t = Unsigned.UInt32.t
+
+  let typ : t Ctypes.typ = Ctypes.uint32_t
+end
+
+module Reply = struct
+  type t
+
+  let typ : t structure typ = structure "xcb_intern_atom_reply_t"
+  let response_type = field typ "response_type" uint8_t
+  let pad0 = field typ "pad0" uint8_t
+  let sequence = field typ "sequence" uint16_t
+  let length = field typ "length" uint32_t
+  let atom = field typ "atom" Atom.typ
+  let () = seal typ
+  let get_atom ptr = getf !@ptr atom
+end
+
+module Screen = struct
+  type t
+
+  let typ : t structure typ = structure "xcb_screen_t"
+  let root = field typ "root" Window.typ
+  let default_colormap = field typ "default_colormap" uint32_t
+  let white_pixel = field typ "white_pixel" uint32_t
+  let black_pixel = field typ "black_pixel" uint32_t
+  let current_input_masks = field typ "current_input_masks" uint32_t
+  let width_in_pixels = field typ "width_in_pixels" uint16_t
+  let height_in_pixels = field typ "height_in_pixels" uint16_t
+  let width_in_millimeters = field typ "width_in_millimeters" uint16_t
+  let height_in_millimeters = field typ "height_in_millimeters" uint16_t
+  let min_installed_maps = field typ "min_installed_maps" uint16_t
+  let max_installed_maps = field typ "max_installed_maps" uint16_t
+  let root_visual = field typ "root_visual" uint32_t
+  let backing_stores = field typ "backing_stores" uint8_t
+  let save_unders = field typ "save_unders" uint8_t
+  let root_depth = field typ "root_depth" uint8_t
+  let allowed_depths_len = field typ "allowed_depths_len" uint8_t
+  let () = seal typ
+  let root ptr = getf ptr root
+end
+
+module Setup = struct
+  type t
+
+  let typ : t structure typ = structure "xcb_setup_t"
+end
+
+module Screen_iterator = struct
+  type t
+
+  let typ : t structure typ = structure "xcb_screen_iterator_t"
+  let data = field typ "data" (ptr Screen.typ)
+  let rem = field typ "rem" int
+  let index = field typ "index" int
+  let () = seal typ
+  let screen ptr = !@(getf ptr data)
+end
+
+(* TODO: convert all these:
+/* Opcode for xcb_create_notify. */
+/**
+ * @brief xcb_create_notify_event_t
+ **/
+typedef struct xcb_create_notify_event_t {
+    uint8_t      response_type;
+    uint8_t      pad0;
+    uint16_t     sequence;
+    xcb_window_t parent;
+    xcb_window_t window;
+    int16_t      x;
+    int16_t      y;
+    uint16_t     width;
+    uint16_t     height;
+    uint16_t     border_width;
+    uint8_t      override_redirect;
+    uint8_t      pad1;
+} xcb_create_notify_event_t;
+
+/**
+ * @brief xcb_destroy_notify_event_t
+ **/
+typedef struct xcb_destroy_notify_event_t {
+    uint8_t      response_type;
+    uint8_t      pad0;
+    uint16_t     sequence;
+    xcb_window_t event;
+    xcb_window_t window;
+} xcb_destroy_notify_event_t;
+
+/**
+ * @brief xcb_unmap_notify_event_t
+ **/
+typedef struct xcb_unmap_notify_event_t {
+    uint8_t      response_type;
+    uint8_t      pad0;
+    uint16_t     sequence;
+    xcb_window_t event;
+    xcb_window_t window;
+    uint8_t      from_configure;
+    uint8_t      pad1[3];
+} xcb_unmap_notify_event_t;
+/**
+ * @brief xcb_map_notify_event_t
+ **/
+typedef struct xcb_map_notify_event_t {
+    uint8_t      response_type;
+    uint8_t      pad0;
+    uint16_t     sequence;
+    xcb_window_t event;
+    xcb_window_t window;
+    uint8_t      override_redirect;
+    uint8_t      pad1[3];
+} xcb_map_notify_event_t;
+
+
+
+/**
+ * @brief xcb_enter_notify_event_t
+ **/
+typedef struct xcb_enter_notify_event_t {
+    uint8_t         response_type;
+    uint8_t         detail;
+    uint16_t        sequence;
+    xcb_timestamp_t time;
+    xcb_window_t    root;
+    xcb_window_t    event;
+    xcb_window_t    child;
+    int16_t         root_x;
+    int16_t         root_y;
+    int16_t         event_x;
+    int16_t         event_y;
+    uint16_t        state;
+    uint8_t         mode;
+    uint8_t         same_screen_focus;
+} xcb_enter_notify_event_t;
+
+
+typedef xcb_enter_notify_event_t xcb_leave_notify_event_t;
+
+
+
+
+typedef xcb_key_press_event_t xcb_key_release_event_t;
+
+typedef enum xcb_button_mask_t {
+    XCB_BUTTON_MASK_1 = 256,
+    XCB_BUTTON_MASK_2 = 512,
+    XCB_BUTTON_MASK_3 = 1024,
+    XCB_BUTTON_MASK_4 = 2048,
+    XCB_BUTTON_MASK_5 = 4096,
+    XCB_BUTTON_MASK_ANY = 32768
+} xcb_button_mask_t;
+
+
+/**
+ * @brief xcb_button_press_event_t
+ **/
+typedef struct xcb_button_press_event_t {
+    uint8_t         response_type;
+    xcb_button_t    detail;
+    uint16_t        sequence;
+    xcb_timestamp_t time;
+    xcb_window_t    root;
+    xcb_window_t    event;
+    xcb_window_t    child;
+    int16_t         root_x;
+    int16_t         root_y;
+    int16_t         event_x;
+    int16_t         event_y;
+    uint16_t        state;
+    uint8_t         same_screen;
+    uint8_t         pad0;
+} xcb_button_press_event_t;
+
+
+typedef xcb_button_press_event_t xcb_button_release_event_t;
+
+typedef enum xcb_motion_t {
+    XCB_MOTION_NORMAL = 0,
+    XCB_MOTION_HINT = 1
+} xcb_motion_t;
+
+
+/**
+ * @brief xcb_motion_notify_event_t
+ **/
+typedef struct xcb_motion_notify_event_t {
+    uint8_t         response_type;
+    uint8_t         detail;
+    uint16_t        sequence;
+    xcb_timestamp_t time;
+    xcb_window_t    root;
+    xcb_window_t    event;
+    xcb_window_t    child;
+    int16_t         root_x;
+    int16_t         root_y;
+    int16_t         event_x;
+    int16_t         event_y;
+    uint16_t        state;
+    uint8_t         same_screen;
+    uint8_t         pad0;
+} xcb_motion_notify_event_t;
+
+typedef enum xcb_notify_detail_t {
+    XCB_NOTIFY_DETAIL_ANCESTOR = 0,
+    XCB_NOTIFY_DETAIL_VIRTUAL = 1,
+    XCB_NOTIFY_DETAIL_INFERIOR = 2,
+    XCB_NOTIFY_DETAIL_NONLINEAR = 3,
+    XCB_NOTIFY_DETAIL_NONLINEAR_VIRTUAL = 4,
+    XCB_NOTIFY_DETAIL_POINTER = 5,
+    XCB_NOTIFY_DETAIL_POINTER_ROOT = 6,
+    XCB_NOTIFY_DETAIL_NONE = 7
+} xcb_notify_detail_t;
+
+typedef enum xcb_notify_mode_t {
+    XCB_NOTIFY_MODE_NORMAL = 0,
+    XCB_NOTIFY_MODE_GRAB = 1,
+    XCB_NOTIFY_MODE_UNGRAB = 2,
+    XCB_NOTIFY_MODE_WHILE_GRABBED = 3
+} xcb_notify_mode_t;
+
+
+/**
+ * @brief xcb_configure_request_event_t
+ **/
+typedef struct xcb_configure_request_event_t {
+    uint8_t      response_type;
+    uint8_t      stack_mode;
+    uint16_t     sequence;
+    xcb_window_t parent;
+    xcb_window_t window;
+    xcb_window_t sibling;
+    int16_t      x;
+    int16_t      y;
+    uint16_t     width;
+    uint16_t     height;
+    uint16_t     border_width;
+    uint16_t     value_mask;
+} xcb_configure_request_event_t;
+
+
+/**
+ * @brief xcb_resize_request_event_t
+ **/
+typedef struct xcb_resize_request_event_t {
+    uint8_t      response_type;
+    uint8_t      pad0;
+    uint16_t     sequence;
+    xcb_window_t window;
+    uint16_t     width;
+    uint16_t     height;
+} xcb_resize_request_event_t;*)

src/xcb/utils.ml

@@ -1,15 +1,6 @@
 open Ctypes
 open Foreign
 
-let values =
+let get_root conn = Screen_iterator.screen conn |> Types.Screen.root
-  CArray.of_list uint32_t
+let _free = foreign "free" (ptr void @-> returning void)
-    [ Unsigned.UInt32.of_int (1048576 lor 524288 lor 131072 lor 4194304) ]
+let free x = _free (to_voidp x)
-
-let setup conn =
-  let scr = Screen_iterator.screen conn in
-  let cookie =
-    Cookie.Void._xcb_change_window_attributes_checked conn (Screen.root scr)
-      (Unsigned.UInt32.of_int 2048)
-      (CArray.start values)
-  in
-  Error.check conn cookie

src/xcb/window.ml

@@ -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 values =
-let of_int x = Unsigned.UInt32.of_int x
+  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