Fix and make mruby work better

.gitmodules

@@ -6,11 +6,11 @@
   path = libs/mgems/mruby-marshal-c
   url = https://github.com/LanzaSchneider/mruby-marshal-c.git
   ignore = dirty
-[submodule "libs/mgems/mruby-process"]
-  path = libs/mgems/mruby-process
-  url = https://github.com/iij/mruby-process.git
-  ignore = dirty
 [submodule "libs/mgems/mruby-env"]
   path = libs/mgems/mruby-env
   url = https://github.com/iij/mruby-env.git
   ignore = dirty
+[submodule "libs/mgems/mruby-process"]
+  path = libs/mgems/mruby-process
+  url = https://github.com/katzer/mruby-process
+  ignore = dirty

libs/changes.patch

@@ -31,3 +31,23 @@
    # C compiler settings
    # conf.cc do |cc|
    #   cc.command = ENV['CC'] || 'gcc'
+@@ -79,5 +79,5 @@
+   # Turn on `enable_debug` for better debugging
+   # conf.enable_debug
+-  conf.enable_bintest
+-  conf.enable_test
++  # conf.enable_bintest
++  # conf.enable_test
+ end
+--- ./mgems/mruby-process/mrbgem.rake
++++ ./mgems/mruby-process/mrbgem.rake
+@@ -54,4 +54,9 @@
+   else
+     spec.objs.delete objfile("#{build_dir}/src/win32")
+   end
++
++  spec.objs.delete objfile("#{build_dir}/src/internal")
++  spec.objs.delete objfile("#{build_dir}/src/dln")
++  spec.objs.delete objfile("#{build_dir}/src/signal")
++  spec.objs.delete objfile("#{build_dir}/src/status")
+ end

src/main.ml

@@ -1,38 +1,30 @@
-let spawn cmd =
-  match Unix.fork () with
-  | 0 ->
-      let devnull = Unix.openfile "/dev/null" [ Unix.O_WRONLY ] 0o666 in
-      Unix.dup2 devnull Unix.stdout;
-      Unix.dup2 devnull Unix.stderr;
-      Unix.close devnull;
-      Unix.execvp cmd.(0) cmd
-  | _pid -> ()
-
 type wm_state = {
   mutable running : bool;
   conn : Xcb.Types.Connection.conn_ptr;
+  mrb : Mruby.Types.Mrb_state.mrb_ptr;
   root : Xcb.Types.Window.t;
   mutable focus : Xcb.Types.Window.t;
 }
 
 let () =
-  let conn = Xcb.Connection.connect () in
+  let state =
+    let conn = Xcb.Connection.connect () in
+    let mrb = Mruby.Core.mrb_open in
+    let root = Xcb.Utils.get_root conn in
+    { running = true; conn; mrb; root; focus = root }
+  in
 
-  print_endline "Connected to X";
+  print_endline "Started Kutu WM";
 
-  let root = Xcb.Utils.get_root conn in
+  Xcb.Window.setup state.conn state.root;
+  Xcb.Window.keybind state.conn state.root 0 24;
+  Xcb.Window.keybind state.conn state.root 0 25;
+  Xcb.Window.keybind state.conn state.root 0 26;
 
-  let state = { running = true; conn; root; focus = root } in
+  if Xcb.Connection.flush state.conn <= 0 then exit 1;
-
-  Xcb.Window.setup conn root;
-  Xcb.Window.keybind conn root 0 24;
-  Xcb.Window.keybind conn root 0 25;
-  Xcb.Window.keybind conn root 0 26;
-
-  if Xcb.Connection.flush conn <= 0 then exit 1;
 
   while state.running do
-    (match Xcb.Event.next conn with
+    (match Xcb.Event.next state.conn with
     | None -> ()
     | Some ev ->
         (match Xcb.Event.rtype ev with
@@ -40,7 +32,11 @@ let () =
             let key = Xcb.Event.Key.detail (Xcb.Event.Key.from ev) in
             match key with
             | 26 -> state.running <- false
-            | 25 -> spawn [| "kitty" |]
+            | 25 ->
+                Mruby.Core.mrb_load_string state.mrb
+                  {|
+                  system "kitty &"
+                  |}
             | 24 -> Xcb.Window.kill state.conn state.focus
             | _ -> ())
         | MapRequest ->
@@ -50,9 +46,11 @@ let () =
             Xcb.Window.map state.conn window
         | _ -> ());
         Xcb.Utils.free ev);
+    Mruby.Core.error_check state.mrb;
     if Xcb.Connection.flush state.conn <= 0 then exit 1;
     Unix.sleepf 0.01
   done;
 
+  Mruby.Core.mrb_close state.mrb;
   Xcb.Connection.disconnect state.conn;
-  print_endline "done"
+  print_endline "Closing up Kutu WM"

src/mruby.ml

@@ -1,11 +0,0 @@
-open Ctypes
-open Foreign
-
-type mrb = unit ptr
-
-let mrb : mrb typ = ptr void
-let mrb_open = foreign "mrb_open" (void @-> returning mrb)
-let mrb_close = foreign "mrb_close" (mrb @-> returning void)
-
-let mrb_load_string =
-  foreign "mrb_load_string" (mrb @-> string @-> returning void)

src/mruby/core.ml

@@ -0,0 +1,21 @@
+open Ctypes
+open Foreign
+
+let _mrb_open = foreign "mrb_open" (void @-> returning (ptr Types.Mrb_state.typ))
+let mrb_open = _mrb_open ()
+let mrb_close = foreign "mrb_close" (ptr Types.Mrb_state.typ @-> returning void)
+
+let mrb_print_error =
+  foreign "mrb_print_error" (ptr Types.Mrb_state.typ @-> returning void)
+
+(* TODO: bind module definition and adding functions to the module thing here somehow. *)
+
+let mrb_load_string =
+  foreign "mrb_load_string"
+    (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;
+    Types.Mrb_state.clear_error mrb_ptr
+  end

src/mruby/types.ml

@@ -0,0 +1,24 @@
+open Ctypes
+open Foreign
+
+module Mrb_state = struct
+  type t
+  type mrb_ptr = t structure ptr
+
+  let typ : t structure typ = structure "mrb_state"
+  let jmp = field typ "jmp" (ptr void)
+  let c = field typ "c" (ptr void)
+  let root_c = field typ "root_c" (ptr void)
+  let globals = field typ "globals" (ptr void)
+  let exc = field typ "exc" (ptr void)
+
+  (* as it builds by default on x86_64 linux *)
+  let padding = field typ "padding" (array 24472 char)
+  let () = seal typ
+
+  let has_error mrb_ptr =
+    let exc_val = getf !@mrb_ptr exc in
+    not (is_null exc_val)
+
+  let clear_error mrb_ptr = setf !@mrb_ptr exc null
+end