Improve workspace system into a hashtable

config.rb

@@ -0,0 +1,130 @@
+# ==== State ====
+
+MAX_PROJECTS = 9
+SUBS         = 2   # workspaces per project
+
+$current_project = 1   # 1..MAX_PROJECTS
+$current_sub     = 0   # 0..SUBS-1
+
+# For each special workspace, remembers which workspace you were on
+# before you jumped into it -- so hitting the mode key again toggles back.
+$special_origin = {}
+
+SPECIAL = {
+  terminal: { cmd: "kitty"   },
+  browser:  { cmd: "firefox" },
+  music:    { cmd: "spotify" },
+  misc:     { cmd: nil       },  # doesn't start anything
+  todo:     { cmd: nil       },  # doesn't start anything
+}
+
+# ==== Helpers ====
+
+def project_ws(n, sub)
+  :"p#{n}_#{sub}"
+end
+
+def running?(process)
+  system("pgrep -x #{process} > /dev/null 2>&1")
+end
+
+def go_project(n, sub)
+  $current_project = n
+  $current_sub     = sub
+  jump_ws project_ws(n, sub)
+end
+
+def in_project?(ws)
+  !SPECIAL.key?(ws)
+end
+
+# Toggle between a special-mode workspace (terminal/browser/music/misc/todo)
+# and whatever workspace you were last on. Starts the associated app if
+# it isn't already running. `ws` is the current workspace, passed in by
+# the bind block (bind gives us (window, current_ws)).
+def go_special(name, ws)
+  cfg = SPECIAL.fetch(name)
+
+  if ws == name
+    target = $special_origin[name] || project_ws($current_project, $current_sub)
+    jump_ws target
+  else
+    $special_origin[name] = ws
+    jump_ws name
+    system("#{cfg[:cmd]} >/dev/null 2>&1 &") if cfg[:cmd] && !running?(cfg[:cmd])
+  end
+end
+
+# ==== Untouched bindings ====
+
+bind ?q do |x|
+  kill x
+end
+
+bind ?w do
+  system "kitty >/dev/null 2>&1 &"
+end
+
+bind ?e do
+  exit
+end
+
+bind ?f do |x|
+  toggle_float x
+end
+
+# ==== Mode switches ====
+
+bind ?[ do |_, ws|
+  go_special :terminal, ws
+end
+
+bind ?] do |_, ws|
+  go_special :misc, ws
+end
+
+bind "tab" do |_, ws|
+  go_special :browser, ws
+end
+
+bind 89 do |_, ws|
+  go_special :music, ws
+end
+
+bind 81 do |_, ws|
+  go_special :todo, ws
+end
+
+# ==== Project navigation ====
+
+(1..MAX_PROJECTS).each do |n|
+  bind n.to_s do
+    go_project(n, $current_sub)
+  end
+end
+
+bind 86 do |_, ws|
+  next unless in_project?(ws)
+  n = (($current_project - 2) % MAX_PROJECTS) + 1
+  go_project(n, $current_sub)
+end
+
+bind 82 do |_, ws|
+  next unless in_project?(ws)
+  n = ($current_project % MAX_PROJECTS) + 1
+  go_project(n, $current_sub)
+end
+
+bind 79 do |_, ws|
+  next unless in_project?(ws)
+  go_project($current_project, ($current_sub + 1) % SUBS)
+end
+
+bind 80 do |_, ws|
+  next unless in_project?(ws)
+  go_project($current_project, ($current_sub - 1 + SUBS) % SUBS)
+end
+
+# ==== Startup ====
+
+go_project(1, 0)

flake.nix

@@ -62,7 +62,7 @@
         set -e
           if [ -z "$DISPLAY" ]; then
             exec ${pkgs.xinit}/bin/startx \
-              ${kutu}/bin/kutu \
+              ${kutu}/bin/kutu "$@" \
               -- \
               ${pkgs.xorg-server}/bin/X
           else
@@ -76,7 +76,7 @@
             cleanup() { kill "$XEPHYR_PID" 2>/dev/null || true; }
             trap cleanup EXIT INT TERM
             sleep 1
-            DISPLAY=$DISPLAY_NUM ${kutu}/bin/kutu
+            DISPLAY=$DISPLAY_NUM ${kutu}/bin/kutu "$@"
             echo "Returned: $?"
           fi
       '';

src/bindings/core.ml

@@ -15,5 +15,7 @@ let register_callbacks state =
   register_exit state;
   Window_op.register_kill state;
   Window_op.register_toggle_float 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,20 @@ 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_intern_cstr mrb value2
+        |> Mruby.Bindings.mrb_symbol_value
+      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,52 +31,42 @@ 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 =
+    begin match Hashtbl.find_opt state.workspaces state.current with
-      Kutu.Layout.calculate state.screen
+    | Some ws -> (
-        state.workspaces.(state.current).ws_root
+        let windows = Kutu.Layout.calculate state.screen ws.ws_root in
-    in
+        match Kutu.Layout.find_fwindow window windows with
-    (match Kutu.Layout.find_fwindow window windows with
+        | Some { fw_rect; _ } ->
-    | Some { fw_rect; _ } ->
+            begin match Kutu.Layout.find_fwindow window ws.ws_fwindows with
-        begin match
+            | Some _ -> print_endline "Error: window already floating"
-          Kutu.Layout.find_fwindow window
+            | None ->
-            state.workspaces.(state.current).ws_fwindows
+                let new_root, _ = Kutu.Layout.remove window ws.ws_root in
-        with
+                ws.ws_root <- new_root;
-        | Some _ -> print_endline "Error: window already floating"
+                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 ws.ws_root)
+            end
         | None ->
-            let new_root, _ =
+            begin match Kutu.Layout.find_fwindow window ws.ws_fwindows with
-              Kutu.Layout.remove window state.workspaces.(state.current).ws_root
+            | Some _ ->
-            in
+                ws.ws_fwindows <-
-            state.workspaces.(state.current).ws_root <- new_root;
+                  Kutu.Layout.remove_fwindow window ws.ws_fwindows;
-            state.workspaces.(state.current).ws_fwindows <-
+                Xcb.Window.move_to_bottom state.conn window;
-              { fw_rect; fw_window = window }
+                ws.ws_root <-
-              :: state.workspaces.(state.current).ws_fwindows;
+                  Some
-            Xcb.Window.move_to_top state.conn window;
+                    (Kutu.Layout.insert Kutu.Layout.Horizontal window ws.ws_root);
-            List.iter
+                List.iter
-              (fun { Kutu.Layout.fw_window = window; fw_rect = rect } ->
+                  (fun { Kutu.Layout.fw_window = window; fw_rect = rect } ->
-                Xcb.Window.reshape state.conn window 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 ->
-        end
+                print_endline "Error: window is neither tiled nor floating"
-    | None ->
+            end)
-        begin match
+    | None -> ()
-          Kutu.Layout.find_fwindow window
+    end;
-            state.workspaces.(state.current).ws_fwindows
-        with
-        | Some _ ->
-            state.workspaces.(state.current).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 <-
-              Kutu.Layout.insert Kutu.Layout.Horizontal window
-                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
-                 state.workspaces.(state.current).ws_root)
-        | None -> print_endline "Error: window is neither tiled nor floating"
-        end);
     self
   in
   Mruby.Bindings.mrb_define_method state.mrb

src/bindings/ws_op.ml

@@ -0,0 +1,63 @@
+open Ctypes
+open Foreign
+
+let register_jump (state : Kutu.State.wm_state) =
+  let mrb_get_args =
+    foreign "mrb_get_args"
+      (ptr Mruby.Types.Mrb_state.typ
+      @-> string
+      @-> ptr Mruby.Types.Mrb_sym.typ
+      @-> returning int)
+  in
+  let jump_ws (mrb : Mruby.Types.Mrb_state.t structure ptr)
+      (self : Mruby.Types.Mrb_value.t structure) =
+    let name = allocate Mruby.Types.Mrb_sym.typ (Unsigned.UInt32.of_int 0) in
+    ignore (mrb_get_args mrb "n" name);
+    let name = Mruby.Bindings.mrb_sym_name mrb !@name in
+    let new_ws =
+      match Hashtbl.find_opt state.workspaces name with
+      | Some ws -> ws
+      | None ->
+          let ws = { Kutu.Layout.ws_root = None; ws_fwindows = [] } in
+          Hashtbl.add state.workspaces name ws;
+          ws
+    in
+    if state.current <> name then (
+      begin match Hashtbl.find_opt state.workspaces state.current with
+      | Some old_ws ->
+          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
+      | None -> ()
+      end;
+      state.current <- name;
+      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
+      (Hashtbl.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/layout.ml

@@ -1,7 +1,6 @@
 type direction = Horizontal | Vertical
 
 type layout =
-  | Nothing
   | Leaf of { layout_window : Xcb.Types.Window.t }
   | Split of {
       layout_direction : direction;
@@ -13,10 +12,13 @@ type layout =
 type fwindow = { fw_rect : Decl.Types.rect; fw_window : Xcb.Types.Window.t }
 
 type workspace = {
-  mutable ws_root : layout;
+  mutable ws_root : layout option;
   mutable ws_fwindows : fwindow list;
 }
 
+let empty_workspace () = { ws_root = None; ws_fwindows = [] }
+let is_empty_workspace ws = ws.ws_root = None && ws.ws_fwindows = []
+
 let find_fwindow window fwindows =
   List.find_opt (fun fw -> fw.fw_window = window) fwindows
 
@@ -26,39 +28,51 @@ let remove_fwindow window fwindows =
 let flip_direction = function Horizontal -> Vertical | Vertical -> Horizontal
 
 let rec insert direction window = function
-  | Nothing -> Leaf { layout_window = window }
+  | None -> Leaf { layout_window = window }
-  | Leaf { layout_window = existing } ->
+  | Some l -> (
-      Split
+      match l with
-        {
+      | Leaf { layout_window = existing } ->
-          layout_direction = direction;
+          Split
-          layout_ratio = 0.5;
+            {
-          layout_l = Leaf { layout_window = existing };
+              layout_direction = direction;
-          layout_r = Leaf { layout_window = window };
+              layout_ratio = 0.5;
-        }
+              layout_l = Leaf { layout_window = existing };
-  | Split { layout_direction; layout_ratio; layout_l; layout_r } ->
+              layout_r = Leaf { layout_window = window };
-      Split
+            }
-        {
+      | Split { layout_direction; layout_ratio; layout_l; layout_r } ->
-          layout_direction;
+          Split
-          layout_ratio;
+            {
-          layout_l;
+              layout_direction;
-          layout_r = insert (flip_direction layout_direction) window layout_r;
+              layout_ratio;
-        }
+              layout_l;
+              layout_r =
+                insert (flip_direction layout_direction) window (Some layout_r);
+            })
 
 let rec remove window = function
-  | Nothing -> (Nothing, false)
+  | None -> (None, false)
-  | Leaf { layout_window = existing } ->
+  | Some l -> (
-      if existing = window then (Nothing, true)
+      match l with
-      else (Leaf { layout_window = existing }, false)
+      | Leaf { layout_window = existing } ->
-  | Split { layout_direction; layout_ratio; layout_l; layout_r } -> (
+          if existing = window then (None, true)
-      let l', l_removed = remove window layout_l in
+          else (Some (Leaf { layout_window = existing }), false)
-      let r', r_removed = remove window layout_r in
+      | Split { layout_direction; layout_ratio; layout_l; layout_r } -> (
-      let removed = l_removed || r_removed in
+          let l', l_removed = remove window (Some layout_l) in
-      match (l', r') with
+          let r', r_removed = remove window (Some layout_r) in
-      | Nothing, r -> (r, removed)
+          let removed = l_removed || r_removed in
-      | l, Nothing -> (l, removed)
+          match (l', r') with
-      | l, r ->
+          | None, r -> (r, removed)
-          ( Split { layout_direction; layout_ratio; layout_l = l; layout_r = r },
+          | l, None -> (l, removed)
-            removed ))
+          | Some l, Some r ->
+              ( Some
+                  (Split
+                     {
+                       layout_direction;
+                       layout_ratio;
+                       layout_l = l;
+                       layout_r = r;
+                     }),
+                removed )))
 
 let split_rect (rect : Decl.Types.rect) direction ratio =
   match direction with
@@ -104,12 +118,15 @@ let split_rect (rect : Decl.Types.rect) direction ratio =
       (top, bottom)
 
 let rec calculate rect = function
-  | Nothing -> []
+  | None -> []
-  | Leaf { layout_window } -> [ { fw_rect = rect; fw_window = layout_window } ]
+  | Some l -> (
-  | Split { layout_direction; layout_ratio; layout_l; layout_r } ->
+      match l with
-      let left_rect, right_rect =
+      | Leaf { layout_window } ->
-        split_rect rect layout_direction layout_ratio
+          [ { fw_rect = rect; fw_window = layout_window } ]
-      in
+      | Split { layout_direction; layout_ratio; layout_l; layout_r } ->
-      let left_windows = calculate left_rect layout_l in
+          let left_rect, right_rect =
-      let right_windows = calculate right_rect layout_r in
+            split_rect rect layout_direction layout_ratio
-      left_windows @ right_windows
+          in
+          let left_windows = calculate left_rect (Some layout_l) in
+          let right_windows = calculate right_rect (Some layout_r) in
+          left_windows @ right_windows)

src/kutu/state.ml

@@ -4,8 +4,9 @@ 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 current : string;
-  mutable current : int;
+  workspaces : (string, Layout.workspace) Hashtbl.t;
+  window_workspace : (Xcb.Types.Window.t, string) Hashtbl.t;
   screen : Decl.Types.rect;
   blocks : (int64, Mruby.Types.Mrb_value.t Ctypes.structure) Hashtbl.t;
 }
@@ -21,9 +22,9 @@ let new_state =
     mrb;
     root;
     focus = root;
-    workspaces =
+    current = "default";
-      [| { Layout.ws_root = Layout.Nothing; Layout.ws_fwindows = [] } |];
+    workspaces = Hashtbl.create 16;
-    current = 0;
+    window_workspace = Hashtbl.create 16;
     screen = Xcb.Screen_iterator.screen_rect conn;
     blocks = Hashtbl.create 16;
   }

src/main.ml

@@ -1,54 +1,62 @@
 let () =
+  let startup_script =
+    if Array.length Sys.argv <> 2 then (
+      Printf.eprintf "usage: kutu <startup.rb>\n";
+      exit 1)
+    else Sys.argv.(1)
+  in
   let state = Kutu.State.new_state in
 
   print_endline "Started Kutu WM";
 
   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,
+      "]" => 35,
+      "[" => 34,
+      "1" => 10,
+      "2" => 11,
+      "3" => 12,
+      "4" => 13,
+      "5" => 14,
+      "6" => 15,
+      "7" => 16,
+      "8" => 17,
+      "9" => 18,
+      "0" => 19
     }
     def bind(key, mod = :alt, &block)
-      key = KEY_MAP[key]
+      key_ = key.is_a?(String) ? KEY_MAP[key] : key
       mod = MOD_MAP[mod]
-      raise "unknown key" unless key
+      raise "unknown key #{key.to_s}" unless key_
       raise "unknown modifier" unless mod
-      _bind key, mod, &block
+      _bind key_, mod, &block
     end
     def unbind(key, mod = :alt)
-      key = KEY_MAP[key]
+      key_ = key.is_a?(String) ? KEY_MAP[key] : key
       mod = MOD_MAP[mod]
-      raise "unknown key" unless key
+      raise "unknown key #{key.to_s}" unless key_
       raise "unknown modifier" unless mod
-      _unbind key, mod
+      _unbind key_, mod
-    end
-
-    bind ?q do |x|
-      kill x
-    end
-    bind ?w do |x|
-      system "kitty >/dev/null 2>&1 &"
-    end
-    bind ?e do |x|
-      exit
-    end
-    bind ?r do |x|
-      puts "hello there!"
-    end
-    bind ?f do |x|
-      toggle_float x
     end
     |};
+  Mruby.Core.mrb_load_file state.mrb startup_script;
   Mruby.Core.error_check state.mrb;
 
   if Xcb.Connection.flush state.conn <= 0 then exit 1;
@@ -63,23 +71,37 @@ let () =
             let key = Xcb.Types.Events.Key.detail req in
             let modifier = Xcb.Types.Events.Key.state req in
             Bindings.Keybinds.dispatch_keybind state.mrb state.blocks key
-              modifier state.focus
+              modifier state.focus 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 =
-              Kutu.Layout.insert Kutu.Layout.Horizontal window
+              match Hashtbl.find_opt state.workspaces state.current with
-                state.workspaces.(state.current).ws_root;
+              | Some ws -> ws
+              | None ->
+                  let ws = { Kutu.Layout.ws_root = None; ws_fwindows = [] } in
+                  Hashtbl.add state.workspaces state.current ws;
+                  ws
+            in
+            ws.ws_root <-
+              Some (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)
+            Hashtbl.replace state.window_workspace window state.current
+        | 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 +110,24 @@ let () =
         | Destroy ->
             let req = Xcb.Types.Events.Destroy.from ev in
             let window = Xcb.Types.Events.Destroy.window req in
-            let new_root, removed =
+            begin match Hashtbl.find_opt state.window_workspace window with
-              Kutu.Layout.remove window state.workspaces.(state.current).ws_root
+            | None -> ()
-              (* TODO: Handle floating windows too. *)
+            | Some ws_name ->
-            in
+                let ws = Hashtbl.find state.workspaces ws_name in
-            state.workspaces.(state.current).ws_root <- new_root;
+                let new_root, tiled_removed =
-            Xcb.Window.focus state.conn state.root;
+                  Kutu.Layout.remove window ws.ws_root
-            state.focus <- state.root;
+                in
-            List.iter
+                if tiled_removed then ws.ws_root <- new_root
-              (fun { Kutu.Layout.fw_window = window; fw_rect = rect } ->
+                else
-                Xcb.Window.reshape state.conn window rect)
+                  ws.ws_fwindows <-
-              (Kutu.Layout.calculate state.screen
+                    Kutu.Layout.remove_fwindow window ws.ws_fwindows;
-                 state.workspaces.(state.current).ws_root)
+                Hashtbl.remove state.window_workspace window;
+                if ws_name = state.current then
+                  List.iter
+                    (fun { Kutu.Layout.fw_window = window; fw_rect = rect } ->
+                      Xcb.Window.reshape state.conn window rect)
+                    (Kutu.Layout.calculate state.screen ws.ws_root)
+            end
         | _ -> ());
         Xcb.Utils.free ev);
     Mruby.Core.error_check state.mrb;

src/mruby/bindings.ml

@@ -34,8 +34,16 @@ let mrb_intern_cstr =
 
 let call_sym mrb = mrb_intern_cstr mrb "call"
 
+let mrb_symbol_value =
+  foreign "kutu_mrb_symbol_value"
+    (Types.Mrb_sym.typ @-> returning Types.Mrb_value.typ)
+
 let mrb_funcall_argv =
   foreign "mrb_funcall_argv"
     (ptr Types.Mrb_state.typ @-> Types.Mrb_value.typ @-> Types.Mrb_sym.typ
    @-> int64_t @-> ptr Types.Mrb_value.typ
     @-> returning Types.Mrb_value.typ)
+
+let mrb_sym_name =
+  foreign "mrb_sym_name"
+    (ptr Types.Mrb_state.typ @-> Types.Mrb_sym.typ @-> returning string)

src/mruby/core.ml

@@ -12,6 +12,10 @@ let mrb_load_string =
   foreign "mrb_load_string"
     (ptr Types.Mrb_state.typ @-> string @-> returning void)
 
+let mrb_load_file =
+  foreign "kutu_mrb_load_file"
+    (ptr Types.Mrb_state.typ @-> string @-> returning void)
+
 let error_check mrb_ptr =
   if Types.Mrb_state.has_error mrb_ptr then begin
     mrb_print_error mrb_ptr;

src/shims.c

@@ -1,9 +1,30 @@
 #include <stdint.h>
+#include <stdio.h>
 #include <mruby.h>
 #include <mruby/value.h>
+#include <mruby/compile.h>
 
 mrb_value
 kutu_mrb_int_value(mrb_state *mrb, uint64_t value)
 {
     return mrb_int_value(mrb, (mrb_int)value);
 }
+
+mrb_value
+kutu_mrb_symbol_value(mrb_sym i)
+{
+    return mrb_symbol_value(i);
+}
+
+void
+kutu_mrb_load_file(mrb_state *mrb, const char *filename)
+{
+    FILE *file = fopen(filename, "rb");
+    if (file == NULL) {
+        mrb_raisef(mrb, E_RUNTIME_ERROR,
+                   "could not open file: %s", filename);
+        return;
+    }
+    mrb_load_file(mrb, file);
+    fclose(file);
+}

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