From 6544ae5f2398416dad067beddcc2e9d10eb74dfd Mon Sep 17 00:00:00 2001 From: Syed Daanish Date: Thu, 10 Sep 2026 14:51:21 +0100 Subject: [PATCH] Add workspace management functions. --- src/bindings/core.ml | 4 ++ src/bindings/keybinds.ml | 9 +-- src/bindings/window_op.ml | 41 ++++--------- src/bindings/ws_op.ml | 120 ++++++++++++++++++++++++++++++++++++++ src/kutu/state.ml | 4 +- src/main.ml | 66 +++++++++++++++------ src/xcb/types.ml | 36 +++++++----- src/xcb/window.ml | 16 ++++- 8 files changed, 227 insertions(+), 69 deletions(-) create mode 100644 src/bindings/ws_op.ml diff --git a/src/bindings/core.ml b/src/bindings/core.ml index 142ffaa..2a09b9c 100644 --- a/src/bindings/core.ml +++ b/src/bindings/core.ml @@ -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 diff --git a/src/bindings/keybinds.ml b/src/bindings/keybinds.ml index c1e3604..bcfa06b 100644 --- a/src/bindings/keybinds.ml +++ b/src/bindings/keybinds.ml @@ -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 diff --git a/src/bindings/window_op.ml b/src/bindings/window_op.ml index 94323bf..9b5a8de 100644 --- a/src/bindings/window_op.ml +++ b/src/bindings/window_op.ml @@ -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 diff --git a/src/bindings/ws_op.ml b/src/bindings/ws_op.ml new file mode 100644 index 0000000..65f2bbf --- /dev/null +++ b/src/bindings/ws_op.ml @@ -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) diff --git a/src/kutu/state.ml b/src/kutu/state.ml index e1b5968..11b60f2 100644 --- a/src/kutu/state.ml +++ b/src/kutu/state.ml @@ -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; diff --git a/src/main.ml b/src/main.ml index b424289..ebb7b5f 100644 --- a/src/main.ml +++ b/src/main.ml @@ -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; diff --git a/src/xcb/types.ml b/src/xcb/types.ml index 37f1451..8575f8e 100644 --- a/src/xcb/types.ml +++ b/src/xcb/types.ml @@ -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 diff --git a/src/xcb/window.ml b/src/xcb/window.ml index edbabf1..2bcb2cf 100644 --- a/src/xcb/window.ml +++ b/src/xcb/window.ml @@ -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