Improve configs and minor bugs.

config.rb

@@ -0,0 +1,174 @@
+system 'bash ~/main/ocaml/epq/scripts/startup.sh >/dev/null 2>&1 &'
+
+MAX_PROJECTS = 3
+
+SPECIAL = {
+  term1: { cmd: 'kitty' },
+  term2: { cmd: 'kitty' },
+  browser: { cmd: 'firefox' },
+  misc: { cmd: nil }
+}
+
+$current = 0
+
+$p_sub = Array.new(9, 0)
+
+def project_ws(n)
+  :"p#{n}_#{$p_sub[$current]}"
+end
+
+def go_project(n)
+  $current = n
+  jump_ws project_ws($current)
+end
+
+def in_project?(ws)
+  !SPECIAL.key?(ws)
+end
+
+def go_special(name, ws)
+  cfg = SPECIAL.fetch(name)
+
+  if ws == name
+    target = project_ws($current)
+    jump_ws target
+  else
+    jump_ws name
+    system("#{cfg[:cmd]} >/dev/null 2>&1 &") if cfg[:cmd] && ws_empty?(name)
+  end
+end
+
+bind 'q' do |x|
+  kill x
+end
+
+bind 'w' do
+  system 'kitty >/dev/null 2>&1 &'
+end
+
+bind 'e' do
+  system 'bash ~/main/ocaml/epq/scripts/power.sh >/dev/null 2>&1 &'
+end
+
+bind 'd' do
+  system 'bash ~/main/ocaml/epq/scripts/run.sh >/dev/null 2>&1 &'
+end
+
+bind 'v' do
+  system 'CM_LAUNCHER=rofi clipmenu >/dev/null 2>&1 &'
+end
+
+bind 'a' do
+  system 'bash', '-c', "
+    maim -c 0.3,0.5,1.0,0.8 -s | tee /tmp/screenshot_temp.png | xclip -selection clipboard -t image/png;
+    if [ -s '/tmp/screenshot_temp.png' ]; then
+      mv /tmp/screenshot_temp.png ~/screenshots/$(date +%Y-%m-%d_%H:%M:%S).png;
+    fi
+  "
+end
+
+bind 123, :none do
+  system 'bash', '-c', %q(
+    pactl set-sink-volume @DEFAULT_SINK@ +5%;
+    vol=$(pactl get-sink-volume @DEFAULT_SINK@ | grep -o '[0-9]\+%' | head -n1);
+    dunstify "Volume Adjusted" "" -h int:value:$vol -r 997
+  )
+end
+
+bind 122, :none do
+  system 'bash', '-c', %q(
+    pactl set-sink-volume @DEFAULT_SINK@ -5%;
+    vol=$(pactl get-sink-volume @DEFAULT_SINK@ | grep -o '[0-9]\+%' | head -n1);
+    dunstify "Volume Adjusted" "" -h int:value:$vol -r 997
+  )
+end
+
+bind 121, :none do
+  system 'bash', '-c', %q(
+    pactl set-sink-mute @DEFAULT_SINK@ toggle;
+    vol=$(pactl get-sink-volume @DEFAULT_SINK@ | grep -o '[0-9]\+%' | head -n1);
+    dunstify "Volume Adjusted" "" -h int:value:$vol -r 997
+  )
+end
+
+bind 232, :none do
+  system 'bash', '-c', %q(
+    brightnessctl set 5%-;
+    pct=$(brightnessctl -m | cut -d, -f4 | tr -d ' %');
+    dunstify "Brightness" "" -h int:value:$pct -r 998
+  )
+end
+
+bind 233, :none do
+  system 'bash', '-c', %q(
+    brightnessctl set 5%+;
+    pct=$(brightnessctl -m | cut -d, -f4 | tr -d ' %');
+    dunstify "Brightness" "" -h int:value:$pct -r 998
+  )
+end
+
+bind 'x' do
+  system 'kitty -e fish -c "editor" >/dev/null 2>&1 &'
+end
+
+bind 'c' do
+  system 'kitty -e fish -c "y" >/dev/null 2>&1 &'
+end
+
+bind 's' do |x|
+  toggle_float x
+end
+
+bind 'f' do
+  system 'kitty -e fish -c "btop" >/dev/null 2>&1 &'
+end
+
+bind '[' do |_, ws|
+  go_special :term1, ws
+end
+
+bind ']' do |_, ws|
+  go_special :term2, ws
+end
+
+bind 79, :none do |_, ws|
+  go_special :browser, ws
+end
+
+bind 89 do |_, ws|
+  go_special :misc, ws
+end
+
+bind 118, :none do
+  system 'bash', '-c',
+         'dbus-send --print-reply --dest=org.mpris.MediaPlayer2.spotify /org/mpris/MediaPlayer2 org.mpris.MediaPlayer2.Player.PlayPause >/dev/null 2>&1 &'
+end
+
+(0..MAX_PROJECTS - 1).each do |n|
+  bind (n + 1).to_s do
+    go_project(n)
+  end
+end
+
+bind 86, :none do |_, ws|
+  next unless in_project?(ws)
+
+  n = (($current - 1 + MAX_PROJECTS) % MAX_PROJECTS)
+  go_project(n)
+end
+
+bind 82, :none do |_, ws|
+  next unless in_project?(ws)
+
+  n = (($current + 1) % MAX_PROJECTS)
+  go_project(n)
+end
+
+bind 80, :none do |_, ws|
+  next unless in_project?(ws)
+
+  $p_sub[$current] = $p_sub[$current] == 1 ? 0 : 1
+  go_project($current)
+end
+
+go_project(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
       '';
@@ -100,6 +100,8 @@
           ocamlPackages.utop
           ocamlPackages.ocaml-lsp
           ocamlPackages.ocamlformat
+          clang-tools
+          solargraph
         ];
 
         shellHook = ''

scripts/power.sh

@@ -0,0 +1,43 @@
+#!/usr/bin/env bash
+
+set -euo pipefail
+
+opts="  Lock
+󰒲  Suspend
+  Shutdown
+󰜉 Reboot
+  Hibernate
+  Stop KutuWM"
+
+sel=$(printf "%s\n" "$opts" | dmenu -i -p "Select Power Option:" \
+  -nf '#e0af68' -nb '#1f2335' -sb '#f7768e' -sf '#1a1b26' -fn 'AgaveNerdFont-16')
+
+[ -z "$sel" ] && exit 0
+
+case "$sel" in
+*Shutdown*)
+  confirm=$(printf "No\nYes" | dmenu -i -p "Are you sure you want to shutdown? :" \
+    -nf '#e0af68' -nb '#1f2335' -sb '#f7768e' -sf '#1a1b26' -fn 'AgaveNerdFont-16')
+  [ "$confirm" = "Yes" ] && exec shutdown -h now
+  ;;
+*Reboot*)
+  confirm=$(printf "No\nYes" | dmenu -i -p "Are you sure you want to reboot? :" \
+    -nf '#e0af68' -nb '#1f2335' -sb '#f7768e' -sf '#1a1b26' -fn 'HurmitNerdFont-16')
+  [ "$confirm" = "Yes" ] && exec reboot
+  ;;
+*Hibernate*)
+  confirm=$(printf "No\nYes" | dmenu -i -p "Are you sure you want to hibernate? :" \
+    -nf '#e0af68' -nb '#1f2335' -sb '#f7768e' -sf '#1a1b26' -fn 'AgaveNerdFont-16')
+  [ "$confirm" = "Yes" ] && exec systemctl --system hibernate
+  ;;
+*Stop\ KutuWM*)
+  #exec kutu-run.rb stop TODO.
+  pkill X
+  ;;
+*Suspend*)
+  exec systemctl --system suspend
+  ;;
+*Lock*)
+  ~/dotfiles/scripts/lock.sh &
+  ;;
+esac

scripts/run.sh

@@ -0,0 +1,28 @@
+#!/usr/bin/env bash
+
+declare -A aliases=(
+  [editor]="kitty -e fish -c editor"
+  [yazi]="kitty -e fish -c yazi"
+  [btop]="kitty -e fish -c btop"
+)
+
+choice=$(
+  {
+    printf '%s\n' "${!aliases[@]}"
+    compgen -c
+  } |
+    grep -v -E '^(\..*|if|fi|case|esac|for|done|while|until|select|function|return|continue|break|time|exec|source|alias|builtin|read|export|unset|local|set|declare|typeset|:|\.|\[|coproc|l|ll|ls|then|else|elif|do|in|\{|\}|!|\[\[|\]\]|_.*|compgen)$' |
+    sort -u |
+    dmenu -i -p "Enter command  " \
+      -nf '#4abaaf' -nb '#1f2335' -sb '#7aa2f7' -sf '#102030' -fn 'AgaveNerdFont-16'
+)
+
+[ -z "$choice" ] && exit 0
+
+if [[ -v "aliases[$choice]" ]]; then
+  eval "${aliases[$choice]}" >/dev/null 2>&1 &
+else
+  "$choice" >/dev/null 2>&1 &
+fi
+
+disown

scripts/startup.sh

@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+xset s off
+xset -dpms
+
+xsetroot -cursor_name left_ptr
+
+setxkbmap us

src/bindings/core.ml

@@ -15,5 +15,8 @@ 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;
+  Ws_op.register_ws_empty 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 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_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 =
-      Kutu.Layout.calculate state.screen
-        state.workspaces.(state.current).ws_root
-    in
-    (match Kutu.Layout.find_fwindow window windows with
+    begin match Hashtbl.find_opt state.workspaces state.current with
+    | Some ws -> (
+        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 <-
+                  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
-                 state.workspaces.(state.current).ws_root)
-        | None -> print_endline "Error: window is neither tiled nor floating"
-        end);
+                  (Kutu.Layout.calculate state.screen ws.ws_root)
+            | None ->
+                print_endline "Error: window is neither tiled nor floating"
+            end)
+    | None -> ()
+    end;
     self
   in
   Mruby.Bindings.mrb_define_method state.mrb

src/bindings/ws_op.ml

@@ -0,0 +1,88 @@
+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)
+
+let register_ws_empty (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 ws_empty (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
+    match Hashtbl.find_opt state.workspaces name with
+    | Some ws ->
+        let is_empty = ws.ws_root = None && List.is_empty ws.ws_fwindows in
+        Mruby.Bindings.mrb_bool_value
+          (Unsigned.UInt32.of_int (if is_empty then 1 else 0))
+    | None -> Mruby.Bindings.mrb_bool_value (Unsigned.UInt32.of_int 1)
+  in
+  Mruby.Bindings.mrb_define_method state.mrb
+    (Mruby.Types.Mrb_state.get_object_class state.mrb)
+    "ws_empty?" ws_empty
+    (Mruby.Bindings.mrb_args_req 1)

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,7 +28,9 @@ 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 }
+  | Some l -> (
+      match l with
       | Leaf { layout_window = existing } ->
           Split
             {
@@ -41,24 +45,34 @@ let rec insert direction window = function
               layout_direction;
               layout_ratio;
               layout_l;
-          layout_r = insert (flip_direction layout_direction) window layout_r;
-        }
+              layout_r =
+                insert (flip_direction layout_direction) window (Some layout_r);
+            })
 
 let rec remove window = function
-  | Nothing -> (Nothing, false)
+  | None -> (None, false)
+  | Some l -> (
+      match l with
       | Leaf { layout_window = existing } ->
-      if existing = window then (Nothing, true)
-      else (Leaf { layout_window = existing }, false)
+          if existing = window then (None, true)
+          else (Some (Leaf { layout_window = existing }), false)
       | Split { layout_direction; layout_ratio; layout_l; layout_r } -> (
-      let l', l_removed = remove window layout_l in
-      let r', r_removed = remove window layout_r in
+          let l', l_removed = remove window (Some layout_l) in
+          let r', r_removed = remove window (Some layout_r) in
           let removed = l_removed || r_removed in
           match (l', r') with
-      | Nothing, r -> (r, removed)
-      | l, Nothing -> (l, removed)
-      | l, r ->
-          ( Split { layout_direction; layout_ratio; layout_l = l; layout_r = r },
-            removed ))
+          | None, r -> (r, removed)
+          | l, None -> (l, 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 -> []
-  | Leaf { layout_window } -> [ { fw_rect = rect; fw_window = layout_window } ]
+  | None -> []
+  | Some l -> (
+      match l with
+      | Leaf { layout_window } ->
+          [ { fw_rect = rect; fw_window = layout_window } ]
       | Split { layout_direction; layout_ratio; layout_l; layout_r } ->
           let left_rect, right_rect =
             split_rect rect layout_direction layout_ratio
           in
-      let left_windows = calculate left_rect layout_l in
-      let right_windows = calculate right_rect layout_r in
-      left_windows @ right_windows
+          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 : int;
+  mutable current : string;
+  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 =
-      [| { Layout.ws_root = Layout.Nothing; Layout.ws_fwindows = [] } |];
-    current = 0;
+    current = "default";
+    workspaces = Hashtbl.create 16;
+    window_workspace = Hashtbl.create 16;
     screen = Xcb.Screen_iterator.screen_rect conn;
     blocks = Hashtbl.create 16;
   }

src/main.ml

@@ -1,54 +1,27 @@
 let () =
+  let startup_script =
+    if Array.length Sys.argv = 2 then Some Sys.argv.(1)
+    else
+      let default =
+        Filename.concat (Sys.getenv "HOME") ".config/kutu/config.rb"
+      in
+      if Sys.file_exists default then Some default else None
+  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
-    {|
-    MOD_MAP = {
-      none: 0,
-      alt: 8,
-      super: 64
-    }
-    KEY_MAP = {
-      "q" => 24,
-      "w" => 25,
-      "e" => 26,
-      "r" => 27,
-      "f" => 41
-    }
-    def bind(key, mod = :alt, &block)
-      key = KEY_MAP[key]
-      mod = MOD_MAP[mod]
-      raise "unknown key" unless key
-      raise "unknown modifier" unless mod
-      _bind key, mod, &block
-    end
-    def unbind(key, mod = :alt)
-      key = KEY_MAP[key]
-      mod = MOD_MAP[mod]
-      raise "unknown key" unless key
-      raise "unknown modifier" unless 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
-    |};
+  (match startup_script with
+  | Some s ->
+      print_string s;
+      print_endline " : Have something";
+      Mruby.Core.mrb_load_string state.mrb (Mruby.Initial.initial_code s)
+  | None ->
+      print_endline "Nothing";
+      Mruby.Core.mrb_load_string state.mrb (Mruby.Initial.initial_code ""));
   Mruby.Core.error_check state.mrb;
 
   if Xcb.Connection.flush state.conn <= 0 then exit 1;
@@ -63,23 +36,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 <-
-              Kutu.Layout.insert Kutu.Layout.Horizontal window
-                state.workspaces.(state.current).ws_root;
+            let ws =
+              match Hashtbl.find_opt state.workspaces state.current with
+              | 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
-                 state.workspaces.(state.current).ws_root)
+              (Kutu.Layout.calculate state.screen ws.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 +75,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 =
-              Kutu.Layout.remove window state.workspaces.(state.current).ws_root
-              (* TODO: Handle floating windows too. *)
+            begin match Hashtbl.find_opt state.window_workspace window with
+            | None -> ()
+            | Some ws_name ->
+                let ws = Hashtbl.find state.workspaces ws_name in
+                let new_root, tiled_removed =
+                  Kutu.Layout.remove window ws.ws_root
                 in
-            state.workspaces.(state.current).ws_root <- new_root;
-            Xcb.Window.focus state.conn state.root;
-            state.focus <- state.root;
+                if tiled_removed then ws.ws_root <- new_root
+                else
+                  ws.ws_fwindows <-
+                    Kutu.Layout.remove_fwindow window ws.ws_fwindows;
+                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
-                 state.workspaces.(state.current).ws_root)
+                    (Kutu.Layout.calculate state.screen ws.ws_root)
+            end
         | _ -> ());
         Xcb.Utils.free ev);
     Mruby.Core.error_check state.mrb;

src/mruby/bindings.ml

@@ -28,14 +28,26 @@ let mrb_int_value =
   foreign "kutu_mrb_int_value"
     (ptr Types.Mrb_state.typ @-> uint32_t @-> returning Types.Mrb_value.typ)
 
+let mrb_bool_value =
+  foreign "kutu_mrb_bool_value"
+    (uint32_t @-> returning Types.Mrb_value.typ)
+
 let mrb_intern_cstr =
   foreign "mrb_intern_cstr"
     (ptr Types.Mrb_state.typ @-> string @-> returning Types.Mrb_sym.typ)
 
 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/initial.ml

@@ -0,0 +1,105 @@
+let initial_code =
+  Printf.sprintf
+    {|#ruby
+MOD_MAP = {
+  none: 0,
+  alt: 8,
+  super: 64
+}
+KEY_MAP = {
+  "tab" => 23,
+  "q" => 24,
+  "w" => 25,
+  "e" => 26,
+  "r" => 27,
+  "f" => 41,
+  "s" => 39,
+  "a" => 38,
+  "d" => 40,
+  "n" => 57,
+  "b" => 56,
+  "m" => 58,
+  "v" => 55,
+  "x" => 53,
+  "c" => 54,
+  "]" => 35,
+  "[" => 34,
+  "1" => 10,
+  "2" => 11,
+  "3" => 12,
+  "4" => 13,
+  "5" => 14,
+  "6" => 15,
+  "7" => 16,
+  "8" => 17,
+  "9" => 18,
+  "0" => 19
+}
+
+CONFIG_FILE = "%s"
+
+DEFAULT = <<'CODE'
+bind ?q do |x|
+  kill x
+end
+
+bind ?w do
+  system "kitty >/dev/null 2>&1 &"
+end
+
+bind ?e do
+  exit
+end
+CODE
+
+BINDINGS = []
+SYSTEM_BINDINGS = []
+
+def bind(key, mod = :super, system: false, &block)
+  key_ = key.is_a?(String) ? KEY_MAP[key] : key
+  mod_ = MOD_MAP[mod]
+
+  raise "unknown key #{key}" unless key_
+  raise "unknown modifier #{mod}" unless mod_
+
+  _bind key_, mod_, &block
+
+  (system ? SYSTEM_BINDINGS : BINDINGS) << [key_, mod_]
+end
+
+def unbind(key, mod = :super)
+  key_ = key.is_a?(String) ? KEY_MAP[key] : key
+  mod_ = MOD_MAP[mod]
+
+  raise "unknown key #{key}" unless key_
+  raise "unknown modifier #{mod}" unless mod_
+
+  _unbind key_, mod_
+  BINDINGS.delete([key_, mod_])
+end
+
+def unbind_all
+  BINDINGS.each do |key_, mod_|
+    _unbind key_, mod_
+  end
+
+  BINDINGS.clear
+end
+
+bind ?r, system: true do
+  unbind_all
+  if CONFIG_FILE != ""
+    code = File.read(CONFIG_FILE)
+    eval code
+  else
+    eval DEFAULT
+  end
+end
+
+if CONFIG_FILE != ""
+  code = File.read(CONFIG_FILE)
+  eval code
+else
+  eval DEFAULT
+end
+|}

src/shims.c

@@ -1,9 +1,24 @@
-#include <stdint.h>
 #include <mruby.h>
+#include <mruby/boxing_word.h>
+#include <mruby/compile.h>
 #include <mruby/value.h>
+#include <stdint.h>
+#include <stdio.h>
 
-mrb_value
-kutu_mrb_int_value(mrb_state *mrb, uint64_t value)
-{
+mrb_value kutu_mrb_int_value(mrb_state *mrb, uint32_t value) {
   return mrb_int_value(mrb, (mrb_int)value);
 }
+
+mrb_value kutu_mrb_symbol_value(mrb_sym i) { return mrb_symbol_value(i); }
+
+mrb_value kutu_mrb_bool_value(uint32_t b) { return mrb_bool_value(b); }
+
+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

writeup.md

@@ -0,0 +1,6 @@
+# Kutu WM
+
+An X11 window manager written in ocaml.
+
+
+