Add workspace management functions.

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

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 arg1 = Mruby.Bindings.mrb_int_value mrb value1 in
-      let argv = CArray.of_list Mruby.Types.Mrb_value.typ [ arg ] 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

@@ -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 =
+    let ws = List.nth state.workspaces state.current in
-      Kutu.Layout.calculate state.screen
+    let windows = Kutu.Layout.calculate state.screen ws.ws_root in
-        state.workspaces.(state.current).ws_root
-    in
     (match Kutu.Layout.find_fwindow window windows with
     | Some { fw_rect; _ } ->
-        begin match
+        begin match Kutu.Layout.find_fwindow window ws.ws_fwindows with
-          Kutu.Layout.find_fwindow window
-            state.workspaces.(state.current).ws_fwindows
-        with
         | Some _ -> print_endline "Error: window already floating"
         | None ->
-            let new_root, _ =
+            let new_root, _ = Kutu.Layout.remove window ws.ws_root in
-              Kutu.Layout.remove window state.workspaces.(state.current).ws_root
+            ws.ws_root <- new_root;
-            in
+            ws.ws_fwindows <- { fw_rect; fw_window = window } :: ws.ws_fwindows;
-            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;
             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
+              (Kutu.Layout.calculate state.screen ws.ws_root)
-                 state.workspaces.(state.current).ws_root)
         end
     | None ->
-        begin match
+        begin match Kutu.Layout.find_fwindow window ws.ws_fwindows with
-          Kutu.Layout.find_fwindow window
-            state.workspaces.(state.current).ws_fwindows
-        with
         | Some _ ->
-            state.workspaces.(state.current).ws_fwindows <-
+            ws.ws_fwindows <- Kutu.Layout.remove_fwindow window ws.ws_fwindows;
-              Kutu.Layout.remove_fwindow window
-                state.workspaces.(state.current).ws_fwindows;
             Xcb.Window.move_to_bottom state.conn window;
-            state.workspaces.(state.current).ws_root <-
+            ws.ws_root <-
-              Kutu.Layout.insert Kutu.Layout.Horizontal window
+              Kutu.Layout.insert Kutu.Layout.Horizontal window ws.ws_root;
-                state.workspaces.(state.current).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
+              (Kutu.Layout.calculate state.screen ws.ws_root)
-                 state.workspaces.(state.current).ws_root)
         | None -> print_endline "Error: window is neither tiled nor floating"
         end);
     self

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)

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;

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|
+    bind ?r do
-      puts "hello there!"
+      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 <-
+            let ws = List.nth state.workspaces state.current in
-              Kutu.Layout.insert Kutu.Layout.Horizontal window
+            ws.ws_root <-
-                state.workspaces.(state.current).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
+              (Kutu.Layout.calculate state.screen ws.ws_root)
-                 state.workspaces.(state.current).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 =
+            let ws = List.nth state.workspaces state.current in
-              Kutu.Layout.remove window state.workspaces.(state.current).ws_root
+            let new_root, removed = Kutu.Layout.remove window ws.ws_root in
-              (* TODO: Handle floating windows too. *)
+            if removed then ws.ws_root <- new_root
-            in
+            else
-            state.workspaces.(state.current).ws_root <- new_root;
+              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
+              (Kutu.Layout.calculate state.screen ws.ws_root)
-                 state.workspaces.(state.current).ws_root)
         | _ -> ());
         Xcb.Utils.free ev);
     Mruby.Core.error_check state.mrb;

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

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