Rearrange xcb bindings

src/dune

@@ -1,3 +1,5 @@
+(include_subdirs qualified)
+
 (executable
  (name main)
  (libraries ctypes-foreign)

src/main.ml

@@ -1,22 +1,29 @@
 let spawn cmd =
-  match Unix.fork () with 0 -> Unix.execvp cmd.(0) cmd | _pid -> ()
+  match Unix.fork () with
+  | 0 ->
+      let devnull = Unix.openfile "/dev/null" [ Unix.O_WRONLY ] 0o666 in
+      Unix.dup2 devnull Unix.stdout;
+      Unix.dup2 devnull Unix.stderr;
+      Unix.close devnull;
+      Unix.execvp cmd.(0) cmd
+  | _pid -> ()
 
 let () =
-  let conn = Xcb.connect () in
+  let conn = Xcb.Functions.connect () in
 
   print_endline "connected";
 
-  let _ = Xcb.window_attribute_setup conn in
+  Xcb.Functions.window_attribute_setup conn;
 
-  Xcb.flush conn;
+  if Xcb.Functions.flush conn <= 0 then exit 1;
 
   spawn [| "kitty" |];
 
   while true do
-    Xcb.flush conn;
+    if Xcb.Functions.flush conn <= 0 then exit 1;
     Unix.sleepf 0.01
   done;
 
-  Xcb.disconnect conn;
+  Xcb.Functions.disconnect conn;
 
   print_endline "done"

src/xcb/functions.ml

@@ -0,0 +1,53 @@
+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/types.ml

@@ -41,55 +41,5 @@ 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"
-
-let xcb_connect =
-  foreign "xcb_connect" (string_opt @-> ptr int @-> returning (ptr connection))
-
-let xcb_disconnect = foreign "xcb_disconnect" (ptr connection @-> returning void)
-let xcb_flush = foreign "xcb_flush" (ptr connection @-> returning int)
-
-let connect () =
-  let screen = allocate int 0 in
-  xcb_connect None screen
-
-let disconnect conn = xcb_disconnect conn
-let flush conn = ignore (xcb_flush conn)
-
-let get_setup =
-  foreign "xcb_get_setup" (ptr connection @-> returning (ptr setup))
-
-let setup_roots_iterator =
-  foreign "xcb_setup_roots_iterator" (ptr setup @-> returning screen_iterator)
-
-let scr conn = getf (setup_roots_iterator (get_setup conn)) data
-let root_window conn : window = getf !@(scr conn) 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 connection @-> uint32_t @-> uint32_t @-> ptr uint32_t
-   @-> returning void_cookie)
-
-let xcb_request_check =
-  foreign "xcb_request_check"
-    (ptr connection @-> void_cookie @-> returning (ptr_opt 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"