syedm/kutu
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Arrange xcb bindings properly

Browse Source
This commit is contained in:
Syed Daanish
2026-07-26 09:48:54 +01:00
parent 9b33f9617a
commit 837d457b10
11 changed files with 395 additions and 104 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/main.ml
+6 -6
View File
@@ -9,21 +9,21 @@ let spawn cmd =
| _pid -> ()
let () =
let conn = Xcb.Functions.connect () in
let conn = Xcb.Connection.connect () in
print_endline "connected";
print_endline "Connected to X";
Xcb.Functions.window_attribute_setup conn;
Xcb.Utils.setup conn;
if Xcb.Functions.flush conn <= 0 then exit 1;
if Xcb.Connection.flush conn <= 0 then exit 1;
spawn [| "kitty" |];
while true do
if Xcb.Functions.flush conn <= 0 then exit 1;
if Xcb.Connection.flush conn <= 0 then exit 1;
Unix.sleepf 0.01
done;
Xcb.Functions.disconnect conn;
Xcb.Connection.disconnect conn;
print_endline "done"
src/xcb/connection.ml
+16
View File
@@ -0,0 +1,16 @@
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))
let disconnect = foreign "xcb_disconnect" (ptr typ @-> returning void)
let flush = foreign "xcb_flush" (ptr typ @-> returning int)
let connect () =
let screen = allocate int 0 in
_xcb_connect None screen
src/xcb/cookie.ml
+15
View File
@@ -0,0 +1,15 @@
open Ctypes
open Foreign
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
let _xcb_change_window_attributes_checked =
foreign "xcb_change_window_attributes_checked"
(ptr Connection.typ @-> uint32_t @-> uint32_t @-> ptr uint32_t
@-> returning typ)
end
src/xcb/error.ml
+18
View File
@@ -0,0 +1,18 @@
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))
let has_error =
foreign "xcb_connection_has_error" (ptr Connection.typ @-> returning int)
let check conn cookie =
match _xcb_request_check conn cookie with
| None -> print_endline "WM ownership acquired"
| Some _ -> print_endline "another WM already owns the display"
src/xcb/event.ml
+271
View File
@@ -0,0 +1,271 @@
open Ctypes
open Foreign
type generic_event
let generic_event : generic_event structure typ =
structure "xcb_generic_event_t"
let response_type = field generic_event "response_type" uint8_t
let pad0 = field generic_event "pad0" uint8_t
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:
/* Opcode for xcb_create_notify. */
#define XCB_CREATE_NOTIFY 16
/**
* @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;
/** Opcode for xcb_destroy_notify. */
#define XCB_DESTROY_NOTIFY 17
/**
* @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;
/** Opcode for xcb_unmap_notify. */
#define XCB_UNMAP_NOTIFY 18
/**
* @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/functions.ml
-53
View File
@@ -1,53 +0,0 @@
open Ctypes
open Foreign
let xcb_connect =
foreign "xcb_connect"
(string_opt @-> ptr int @-> returning (ptr Types.connection))
let disconnect =
foreign "xcb_disconnect" (ptr Types.connection @-> returning void)
let flush = foreign "xcb_flush" (ptr Types.connection @-> returning int)
let connect () =
let screen = allocate int 0 in
xcb_connect None screen
let get_setup =
foreign "xcb_get_setup" (ptr Types.connection @-> returning (ptr Types.setup))
let setup_roots_iterator =
foreign "xcb_setup_roots_iterator"
(ptr Types.setup @-> returning Types.screen_iterator)
let scr conn = getf (setup_roots_iterator (get_setup conn)) Types.data
let root_window conn : Types.window = getf !@(scr conn) Types.root
let values =
CArray.of_list uint32_t
[ Unsigned.UInt32.of_int (1048576 lor 524288 lor 131072 lor 4194304) ]
let xcb_change_window_attributes_checked =
foreign "xcb_change_window_attributes_checked"
(ptr Types.connection @-> uint32_t @-> uint32_t @-> ptr uint32_t
@-> returning Types.void_cookie)
let xcb_request_check =
foreign "xcb_request_check"
(ptr Types.connection @-> Types.void_cookie
@-> returning (ptr_opt Types.generic_error))
let window_attribute_setup conn =
let cookie =
xcb_change_window_attributes_checked conn (root_window conn)
(Unsigned.UInt32.of_int 2048)
(CArray.start values)
in
match xcb_request_check conn cookie with
| None -> print_endline "WM ownership acquired"
| Some _ -> print_endline "another WM already owns the display"
let connection_has_error =
foreign "xcb_connection_has_error" (ptr Types.connection @-> returning int)
src/xcb/screen.ml
+25
View File
@@ -0,0 +1,25 @@
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
+22
View File
@@ -0,0 +1,22 @@
open Ctypes
open Foreign
module Setup = struct
type t
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)
let screen conn = !@(getf (_xcb_get (Setup.get conn)) data)
src/xcb/types.ml
-45
View File
@@ -1,45 +0,0 @@
open Ctypes
open Foreign
type connection
type screen
type screen_iterator
type setup
type window = Unsigned.UInt32.t
type void_cookie
type generic_error
let generic_error : generic_error structure typ =
structure "xcb_generic_error_t"
let void_cookie : void_cookie structure typ = structure "xcb_void_cookie_t"
let sequence = field void_cookie "sequence" uint32_t
let () = seal void_cookie
let screen : screen structure typ = structure "xcb_screen_t"
let root = field screen "root" uint32_t
let default_colormap = field screen "default_colormap" uint32_t
let white_pixel = field screen "white_pixel" uint32_t
let black_pixel = field screen "black_pixel" uint32_t
let current_input_masks = field screen "current_input_masks" uint32_t
let width_in_pixels = field screen "width_in_pixels" uint16_t
let height_in_pixels = field screen "height_in_pixels" uint16_t
let width_in_millimeters = field screen "width_in_millimeters" uint16_t
let height_in_millimeters = field screen "height_in_millimeters" uint16_t
let min_installed_maps = field screen "min_installed_maps" uint16_t
let max_installed_maps = field screen "max_installed_maps" uint16_t
let root_visual = field screen "root_visual" uint32_t
let backing_stores = field screen "backing_stores" uint8_t
let save_unders = field screen "save_unders" uint8_t
let root_depth = field screen "root_depth" uint8_t
let allowed_depths_len = field screen "allowed_depths_len" uint8_t
let () = seal screen
let screen_iterator : screen_iterator structure typ =
structure "xcb_screen_iterator_t"
let data = field screen_iterator "data" (ptr screen)
let rem = field screen_iterator "rem" int
let index = field screen_iterator "index" int
let () = seal screen_iterator
let setup : setup structure typ = structure "xcb_setup_t"
let connection : connection structure typ = structure "xcb_connection_t"
src/xcb/utils.ml
+15
View File
@@ -0,0 +1,15 @@
open Ctypes
open Foreign
let values =
CArray.of_list uint32_t
[ Unsigned.UInt32.of_int (1048576 lor 524288 lor 131072 lor 4194304) ]
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
+7
View File
@@ -0,0 +1,7 @@
open Ctypes
open Foreign
type t = Unsigned.UInt32.t
let typ : t Ctypes.typ = Ctypes.uint32_t
let of_int x = Unsigned.UInt32.of_int x