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

Add workspace management functions.

Browse Source
This commit is contained in:
syedm
2026-09-10 14:51:21 +01:00
parent ac72396a0f
commit 6544ae5f23
8 changed files with 227 additions and 69 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/bindings/core.ml
+4
View File
@@ -15,5 +15,9 @@ let register_callbacks state =
register_exit state;
Window_op.register_kill state;
Window_op.register_toggle_float state;
Ws_op.register_new state;
Ws_op.register_remove state;
Ws_op.register_jump state;
Ws_op.register_ws_count state;
Keybinds.register_bind state;
Keybinds.register_unbind state
src/bindings/keybinds.ml
+5 -4
View File
@@ -68,16 +68,17 @@ let register_unbind (state : Kutu.State.wm_state) =
"_unbind" unregister_keybind
(Mruby.Bindings.mrb_args_req 2)
let dispatch_keybind mrb hashtbl key modifier value =
let dispatch_keybind mrb hashtbl key modifier value1 value2 =
match Hashtbl.find_opt hashtbl (bind_key key modifier) with
| None -> ()
| Some block ->
let arg = Mruby.Bindings.mrb_int_value mrb value in
let argv = CArray.of_list Mruby.Types.Mrb_value.typ [ arg ] in
let arg1 = Mruby.Bindings.mrb_int_value mrb value1 in
let arg2 = Mruby.Bindings.mrb_int_value mrb value2 in
let argv = CArray.of_list Mruby.Types.Mrb_value.typ [ arg1; arg2 ] in
ignore
(Mruby.Bindings.mrb_funcall_argv mrb block
(Mruby.Bindings.call_sym mrb)
(Signed.Int64.of_int 1) (CArray.start argv))
(Signed.Int64.of_int 2) (CArray.start argv))
let cleanup mrb hashtbl =
Hashtbl.iter
src/bindings/window_op.ml
+12 -29
View File
@@ -31,50 +31,33 @@ let register_toggle_float (state : Kutu.State.wm_state) =
let win_id = allocate int64_t 0L in
ignore (mrb_get_args mrb "i" win_id);
let window = Unsigned.UInt32.of_int64 !@win_id in
let windows =
Kutu.Layout.calculate state.screen
state.workspaces.(state.current).ws_root
in
let ws = List.nth state.workspaces state.current in
let windows = Kutu.Layout.calculate state.screen ws.ws_root in
(match Kutu.Layout.find_fwindow window windows with
| Some { fw_rect; _ } ->
begin match
Kutu.Layout.find_fwindow window
state.workspaces.(state.current).ws_fwindows
with
begin match Kutu.Layout.find_fwindow window ws.ws_fwindows with
| Some _ -> print_endline "Error: window already floating"
| None ->
let new_root, _ =
Kutu.Layout.remove window state.workspaces.(state.current).ws_root
in
state.workspaces.(state.current).ws_root <- new_root;
state.workspaces.(state.current).ws_fwindows <-
{ fw_rect; fw_window = window }
:: state.workspaces.(state.current).ws_fwindows;
let new_root, _ = Kutu.Layout.remove window ws.ws_root in
ws.ws_root <- new_root;
ws.ws_fwindows <- { fw_rect; fw_window = window } :: ws.ws_fwindows;
Xcb.Window.move_to_top state.conn window;
List.iter
(fun { Kutu.Layout.fw_window = window; fw_rect = rect } ->
Xcb.Window.reshape state.conn window rect)
(Kutu.Layout.calculate state.screen
state.workspaces.(state.current).ws_root)
(Kutu.Layout.calculate state.screen ws.ws_root)
end
| None ->
begin match
Kutu.Layout.find_fwindow window
state.workspaces.(state.current).ws_fwindows
with
begin match Kutu.Layout.find_fwindow window ws.ws_fwindows with
| Some _ ->
state.workspaces.(state.current).ws_fwindows <-
Kutu.Layout.remove_fwindow window
state.workspaces.(state.current).ws_fwindows;
ws.ws_fwindows <- Kutu.Layout.remove_fwindow window ws.ws_fwindows;
Xcb.Window.move_to_bottom state.conn window;
state.workspaces.(state.current).ws_root <-
Kutu.Layout.insert Kutu.Layout.Horizontal window
state.workspaces.(state.current).ws_root;
ws.ws_root <-
Kutu.Layout.insert Kutu.Layout.Horizontal window ws.ws_root;
List.iter
(fun { Kutu.Layout.fw_window = window; fw_rect = rect } ->
Xcb.Window.reshape state.conn window rect)
(Kutu.Layout.calculate state.screen
state.workspaces.(state.current).ws_root)
(Kutu.Layout.calculate state.screen ws.ws_root)
| None -> print_endline "Error: window is neither tiled nor floating"
end);
self
src/bindings/ws_op.ml
+120
View File
@@ -0,0 +1,120 @@
open Ctypes
open Foreign
let register_new (state : Kutu.State.wm_state) =
let new_ws (mrb : Mruby.Types.Mrb_state.t structure ptr)
(self : Mruby.Types.Mrb_value.t structure) =
let old_ws = List.nth state.workspaces state.current in
state.workspaces <-
List.append state.workspaces [ { ws_root = Nothing; ws_fwindows = [] } ];
state.current <- List.length state.workspaces - 1;
List.iter
(fun { Kutu.Layout.fw_window = window; fw_rect } ->
Xcb.Window.unmap state.conn window)
(Kutu.Layout.calculate state.screen old_ws.ws_root);
List.iter
(fun { Kutu.Layout.fw_window = window; fw_rect } ->
Xcb.Window.unmap state.conn window)
old_ws.ws_fwindows;
self
in
Mruby.Bindings.mrb_define_method state.mrb
(Mruby.Types.Mrb_state.get_object_class state.mrb)
"new_ws" new_ws (Unsigned.UInt32.of_int 0)
let rec remove_at index = function
| [] -> []
| _ :: rest when index = 0 -> rest
| x :: rest -> x :: remove_at (index - 1) rest
let register_remove (state : Kutu.State.wm_state) =
let mrb_get_args =
foreign "mrb_get_args"
(ptr Mruby.Types.Mrb_state.typ
@-> string @-> ptr int64_t @-> returning int)
in
let remove_ws (mrb : Mruby.Types.Mrb_state.t structure ptr)
(self : Mruby.Types.Mrb_value.t structure) =
let ws_number = allocate int64_t 0L in
ignore (mrb_get_args mrb "i" ws_number);
let ws_number = Signed.Int64.to_int !@ws_number in
let total = List.length state.workspaces in
if total > 1 && ws_number < total && ws_number >= 0 then (
let dest_idx = if ws_number > 0 then ws_number - 1 else 1 in
let removed = List.nth state.workspaces ws_number in
let dest = List.nth state.workspaces dest_idx in
dest.ws_fwindows <- dest.ws_fwindows @ removed.ws_fwindows;
List.iter
(fun { Kutu.Layout.fw_window = window; fw_rect } ->
dest.ws_root <- Kutu.Layout.insert Horizontal window dest.ws_root;
Xcb.Window.unmap state.conn window)
(Kutu.Layout.calculate state.screen removed.ws_root);
state.workspaces <- remove_at ws_number state.workspaces;
if ws_number = state.current then
state.current <- (if ws_number > 0 then ws_number - 1 else 0)
else if ws_number > state.current then state.current <- state.current - 1;
List.iter
(fun { Kutu.Layout.fw_window = window; fw_rect = rect } ->
Xcb.Window.map state.conn window;
Xcb.Window.reshape state.conn window rect)
(Kutu.Layout.calculate state.screen dest.ws_root);
List.iter
(fun { Kutu.Layout.fw_window = window; fw_rect } ->
Xcb.Window.map state.conn window)
dest.ws_fwindows);
self
in
Mruby.Bindings.mrb_define_method state.mrb
(Mruby.Types.Mrb_state.get_object_class state.mrb)
"remove_ws" remove_ws
(Mruby.Bindings.mrb_args_req 1)
let register_jump (state : Kutu.State.wm_state) =
let mrb_get_args =
foreign "mrb_get_args"
(ptr Mruby.Types.Mrb_state.typ
@-> string @-> ptr int64_t @-> returning int)
in
let jump_ws (mrb : Mruby.Types.Mrb_state.t structure ptr)
(self : Mruby.Types.Mrb_value.t structure) =
let ws_number = allocate int64_t 0L in
ignore (mrb_get_args mrb "i" ws_number);
let ws_number = Signed.Int64.to_int !@ws_number in
let total = List.length state.workspaces in
if ws_number < total && ws_number >= 0 && ws_number <> state.current then (
let old_ws = List.nth state.workspaces state.current in
let new_ws = List.nth state.workspaces ws_number in
state.current <- ws_number;
List.iter
(fun { Kutu.Layout.fw_window = window; fw_rect } ->
Xcb.Window.unmap state.conn window)
(Kutu.Layout.calculate state.screen old_ws.ws_root);
List.iter
(fun { Kutu.Layout.fw_window = window; fw_rect } ->
Xcb.Window.unmap state.conn window)
old_ws.ws_fwindows;
List.iter
(fun { Kutu.Layout.fw_window = window; fw_rect = rect } ->
Xcb.Window.map state.conn window;
Xcb.Window.reshape state.conn window rect)
(Kutu.Layout.calculate state.screen new_ws.ws_root);
List.iter
(fun { Kutu.Layout.fw_window = window; fw_rect } ->
Xcb.Window.map state.conn window)
new_ws.ws_fwindows);
self
in
Mruby.Bindings.mrb_define_method state.mrb
(Mruby.Types.Mrb_state.get_object_class state.mrb)
"jump_ws" jump_ws
(Mruby.Bindings.mrb_args_req 1)
let register_ws_count (state : Kutu.State.wm_state) =
let ws_count (mrb : Mruby.Types.Mrb_state.t structure ptr)
(_ : Mruby.Types.Mrb_value.t structure) =
Mruby.Bindings.mrb_int_value mrb
(List.length state.workspaces |> Unsigned.UInt32.of_int)
in
Mruby.Bindings.mrb_define_method state.mrb
(Mruby.Types.Mrb_state.get_object_class state.mrb)
"ws_count" ws_count (Unsigned.UInt32.of_int 0)
src/kutu/state.ml
+2 -2
View File
@@ -4,7 +4,7 @@ type wm_state = {
mrb : Mruby.Types.Mrb_state.mrb_ptr;
root : Xcb.Types.Window.t;
mutable focus : Xcb.Types.Window.t;
workspaces : Layout.workspace array;
mutable workspaces : Layout.workspace list;
mutable current : int;
screen : Decl.Types.rect;
blocks : (int64, Mruby.Types.Mrb_value.t Ctypes.structure) Hashtbl.t;
@@ -22,7 +22,7 @@ let new_state =
root;
focus = root;
workspaces =
[| { Layout.ws_root = Layout.Nothing; Layout.ws_fwindows = [] } |];
[ { Layout.ws_root = Layout.Nothing; Layout.ws_fwindows = [] } ];
current = 0;
screen = Xcb.Screen_iterator.screen_rect conn;
blocks = Hashtbl.create 16;
src/main.ml
+47 -19
View File
@@ -5,18 +5,24 @@ let () =
Bindings.Core.register_callbacks state;
Mruby.Core.mrb_load_string state.mrb
{|
{|#ruby
MOD_MAP = {
none: 0,
alt: 8,
super: 64
}
KEY_MAP = {
"tab" => 23,
"q" => 24,
"w" => 25,
"e" => 26,
"r" => 27,
"f" => 41
"f" => 41,
"n" => 57,
"b" => 56,
"m" => 58,
"v" => 55,
}
def bind(key, mod = :alt, &block)
key = KEY_MAP[key]
@@ -33,21 +39,37 @@ let () =
_unbind key, mod
end
bind "tab" do
system "firefox >/dev/null 2>&1 &"
end
bind ?q do |x|
kill x
end
bind ?w do |x|
bind ?w do
system "kitty >/dev/null 2>&1 &"
end
bind ?e do |x|
bind ?e do
exit
end
bind ?r do |x|
puts "hello there!"
bind ?r do
unbind ?w
end
bind ?f do |x|
toggle_float x
end
bind ?v do |_, x|
remove_ws x
end
bind ?b do |_, x|
jump_ws ((x - 1 + ws_count) % ws_count)
end
bind ?n do |_, x|
jump_ws ((x + 1) % ws_count)
end
bind ?m do
new_ws
end
|};
Mruby.Core.error_check state.mrb;
@@ -64,22 +86,29 @@ let () =
let modifier = Xcb.Types.Events.Key.state req in
Bindings.Keybinds.dispatch_keybind state.mrb state.blocks key
modifier state.focus
(Unsigned.UInt32.of_int state.current)
| MapRequest ->
let req = Xcb.Types.Events.Map_request.from ev in
let window = Xcb.Types.Events.Map_request.window req in
Xcb.Window.map state.conn window;
Xcb.Window.setup_window state.conn window;
Xcb.Window.focus state.conn window;
Xcb.Window.move_to_bottom state.conn window;
state.focus <- window;
state.workspaces.(state.current).ws_root <-
Kutu.Layout.insert Kutu.Layout.Horizontal window
state.workspaces.(state.current).ws_root;
let ws = List.nth state.workspaces state.current in
ws.ws_root <-
Kutu.Layout.insert Kutu.Layout.Horizontal window ws.ws_root;
List.iter
(fun { Kutu.Layout.fw_window = window; fw_rect = rect } ->
Xcb.Window.reshape state.conn window rect)
(Kutu.Layout.calculate state.screen
state.workspaces.(state.current).ws_root)
(Kutu.Layout.calculate state.screen ws.ws_root)
| Create ->
let req = Xcb.Types.Events.Create.from ev in
let window = Xcb.Types.Events.Create.window req in
let override_ridirect =
Xcb.Types.Events.Create.override_redirect req
in
if override_ridirect == Unsigned.UInt8.of_int 0 then
Xcb.Window.setup_window state.conn window
| Enter ->
let req = Xcb.Types.Events.Enter.from ev in
let window = Xcb.Types.Events.Enter.window req in
@@ -88,18 +117,17 @@ let () =
| Destroy ->
let req = Xcb.Types.Events.Destroy.from ev in
let window = Xcb.Types.Events.Destroy.window req in
let new_root, removed =
Kutu.Layout.remove window state.workspaces.(state.current).ws_root
(* TODO: Handle floating windows too. *)
in
state.workspaces.(state.current).ws_root <- new_root;
let ws = List.nth state.workspaces state.current in
let new_root, removed = Kutu.Layout.remove window ws.ws_root in
if removed then ws.ws_root <- new_root
else
ws.ws_fwindows <- Kutu.Layout.remove_fwindow window ws.ws_fwindows;
Xcb.Window.focus state.conn state.root;
state.focus <- state.root;
List.iter
(fun { Kutu.Layout.fw_window = window; fw_rect = rect } ->
Xcb.Window.reshape state.conn window rect)
(Kutu.Layout.calculate state.screen
state.workspaces.(state.current).ws_root)
(Kutu.Layout.calculate state.screen ws.ws_root)
| _ -> ());
Xcb.Utils.free ev);
Mruby.Core.error_check state.mrb;
src/xcb/types.ml
+22 -14
View File
@@ -128,6 +128,28 @@ module Events = struct
let from ptr = from_voidp typ (to_voidp ptr)
let window ptr = getf !@ptr window
end
module Create = struct
type t
let typ : t structure typ = structure "xcb_create_notify_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 x = field typ "x" int16_t
let y = field typ "y" int16_t
let width = field typ "width" int16_t
let height = field typ "height" int16_t
let border_width = field typ "border_width" uint16_t
let override_redirect = field typ "override_redirect" uint8_t
let pad1 = field typ "pad1" uint8_t
let () = seal typ
let from ptr = from_voidp typ (to_voidp ptr)
let window ptr = getf !@ptr window
let override_redirect ptr = getf !@ptr override_redirect
end
end
module Client_message = struct
@@ -211,20 +233,6 @@ end
/**
* @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
src/xcb/window.ml
+15 -1
View File
@@ -20,9 +20,14 @@ let setup conn root =
Error.check conn cookie
let window_event_mask = 1 lsl 4
let substructure_mask = 1 lsl 19
let values_window =
CArray.of_list uint32_t [ Unsigned.UInt32.of_int window_event_mask ]
CArray.of_list uint32_t
[
Unsigned.UInt32.of_int window_event_mask;
Unsigned.UInt32.of_int substructure_mask;
]
let setup_window conn window =
let cookie =
@@ -106,6 +111,15 @@ let map conn window =
let cookie = _xcb_map_window conn window in
Error.check conn cookie
let _xcb_unmap_window =
foreign "xcb_unmap_window"
(ptr Types.Connection.typ @-> Types.Window.typ
@-> returning Types.Cookie.Void.typ)
let unmap conn window =
let cookie = _xcb_unmap_window conn window in
Error.check conn cookie
let _xcb_set_input_focus =
foreign "xcb_set_input_focus"
(ptr Types.Connection.typ @-> uint8_t @-> Types.Window.typ @-> uint32_t