Fix error on change main tag

main.janet

@@ -24,7 +24,20 @@
 (def registry @{})
 (def wl-outputs @{})
 
-(def wm @{:outputs @[] :seats @[] :windows @[] :render-order @[] :inputs @[] :pulldowns @{}})
+(def wm @{:outputs @[] :seats @[] :windows @[] :render-order @[] :inputs @[] :pulldowns @{} :callbacks @{}})
+(defn callback [id & args]
+  (each cb (get-in wm [:callbacks id] {}) (cb ;args)))
+
+(defmacro register-callback [id args & body]
+  (def keysym (gensym))
+  ~(do
+    (def ,keysym [:callbacks ,id @{}])
+    (defn clear [] (put-in wm ,keysym nil))
+    (put-in wm ,keysym (fn ,args ,;body))
+    clear))
+
+(defmacro register-callback-once [id args & body]
+  '(register-callback ,id ,args ,;body '(clear)))
 
 (def tags-main [:a :r :s :t :n :e :i :o])
 (def tags-offload [:comma :period])
@@ -128,7 +141,7 @@
   (defn handle-event [event]
     (match event
       [:closed] (put window :closed true)
-      [:dimensions-hint min-w min-h max-w max-h] (put window :dimensions-bounds {:min-w min-w :max-w max-w :min-h min-h :max-h max-h})
+      [:dimensions-hint min-w min-h max-w max-h] (put window :dimensions-bounds [min-w max-w min-h max-h])
       [:dimensions w h] (do (put window :w w) (put window :h h))
       [:app-id app-id] (put window :app-id app-id)
       [:parent parent] (put window :parent (if parent (:get-user-data parent)))
@@ -146,40 +159,15 @@
     (each k keys
       (put obj k nil))))
 
-(defn output/set-main-tag [output tag]
-  (map |(when (= ($ :tag-main) tag) (put $ :tag-main nil)) (wm :outputs))
-  (put output :tag-main tag)
-  (put output :tag-offload nil))
-
-(defn output/toggle-other-tag [output tag]
-  (if (has-value? (output :tags-other) tag)
-    (do
-      (put output :tags-other (filter |(not (= $ tag)) (output :tags-other)))
-      false)
-    (do
-      (map (fn [output] (update output :tags-other (fn [tags] (filter |(not (= $ tag)) tags)))) (wm :outputs))
-      (update output :tags-other |[;$ tag])
-      true)))
-
-(defn output/toggle-offload-tag [output tag]
-  (put output :tag-offload (if (= (output :tag-offload) tag) nil tag)))
-
-(defn output/ensure-main-tag [output]
-  (when (not (output :tag-main))
-    (def available (->> tags-main
-                        (reverse)
-                        (filter (fn [tag] (not (some |(= tag ($ :tag-main)) (wm :outputs)))))))
-    (def tag (or
-               (find (fn [tag] (not (some |(= ($ :tag) tag) (wm :windows)))) available)
-               (first available)))
-    (put output :tag-main tag)))
-
 (defn output/manage [output]
-  (put output :tags [(output :tag-main)
+  (def new-tags [(output :tag-main)
                  ;(output :tags-other)
                  ;(if (output :tag-offload)
                     [[(output :tag-main) (output :tag-offload)]]
-                        [])]))
+                    [])])
+  (unless (= new-tags (output :tags))
+    (put output :tags new-tags)
+    (callback [:output-new-tags (get-in output [:wl-output :name])] new-tags)))
 
 (defn window/enter-fullscreen [window &opt inform]
   (put window :fullscreen true)
@@ -211,12 +199,11 @@
 
 (defn seat/focus [seat window]
   (defn focus-window [window]
-    (unless (= (seat :focused) window)
     (:focus-window (seat :obj) (window :obj))
     (put seat :focused window)
     (set (wm :render-order) (filter |(not (= $ window)) (wm :render-order)))
     (array/push (wm :render-order) window)
-      (:place-top (window :node))))
+    (:place-top (window :node)))
   (defn clear-focus []
     (when (seat :focused)
       (:clear-focus (seat :obj))
@@ -242,6 +229,10 @@
                      (put seat :focused nil))
     :none (focus-non-layer)))
 
+(defn window/should-float [window]
+  (let [[min-w max-w min-h max-h] (or (window :dimensions-bounds) [0 1 0 1])]
+    (and (= min-w max-w) (= min-h max-h) (< 0 min-w) (< 0 min-h))))
+
 (defn window/manage [window]
   (when (window :new)
     (:use-ssd (window :obj))
@@ -252,11 +243,12 @@
         (:propose-dimensions (window :obj) 0 0))
       (do
         (def seat (first (wm :seats)))
-        (window/set-float window false)
+        (window/set-float window (window/should-float window))
         (window/move-output window (seat :focused-output))
         (each seat (wm :seats) (seat/focus seat window))))
     (when-let [rule ((config :appid-rules) (window :app-id))]
-      (rule window)))
+      (rule window))
+    (callback :new-window window))
 
   (match (window :fullscreen-requested)
     [:enter] (window/enter-fullscreen window)
@@ -287,6 +279,9 @@
   (if (or (not (seat :focused-output)) ((seat :focused-output) :removed))
     (seat/focus-output seat (first (wm :outputs))))
 
+  (when (not= (seat :layer-focus) :non-exclusive)
+    (seat/focus seat (seat :focused)))
+
   (seat/focus seat nil)
 
   (if-let [window (seat :window-interaction)]
@@ -313,7 +308,7 @@
 (defn layout/rows [n x y w h]
   (if (> n 0)
     (do
-      (def height (/ h n))
+      (def height (math/trunc (/ h n)))
       (defn rows [n]
         (if (= n 0) [] (let [Y (- (+ y h) (* n height))]
                          (tuple/join [[x Y w height]]
@@ -343,14 +338,49 @@
        (layout/main (length windows) W H))
 
   (each window (filter |($ :float) (output/windows output))
-    (let [t (+ Y (/ H 4))
+    (callback :layout-floating window)
-          l (+ X (/ W 4))
+    (let [[min-w max-w min-h max-h] (or (window :dimensions-bounds) [(/ W 2) (/ W 2) (/ H 2) (/ H 2)])
-          h (/ H 2)
+          h (if (< 10 min-h) min-h (/ H 2))
-          w (/ W 2)]
+          w (if (< 10 min-w) min-w (/ W 2))
+          t (+ Y (/ H 2) (- (math/trunc (/ h 2))))
+          l (+ X (/ W 2) (- (math/trunc (/ w 2))))]
       (window/set-position window l t)
       (window/propose-dimensions window w h)
       (:place-top (window :node)))))
 
+(defn output/set-main-tag [output tag]
+  (map |(when (= ($ :tag-main) tag) (put $ :tag-main nil)) (wm :outputs))
+  (put output :tag-main tag)
+  (put output :tag-offload nil)
+  (put output :tags-other []))
+
+(defn output/toggle-other-tag [output tag]
+  (if (has-value? (output :tags-other) tag)
+    (do
+      (put output :tags-other (filter |(not (= $ tag)) (output :tags-other)))
+      false)
+    (do
+      (map (fn [output] (update output :tags-other (fn [tags] (filter |(not (= $ tag)) tags)))) (wm :outputs))
+      (update output :tags-other |[;$ tag])
+      (when-let [window (find |(= ($ :tag) tag) (wm :windows))]
+        (put window :output output)
+        (seat/focus (first (wm :seats)) window))
+      true)))
+
+(defn output/toggle-offload-tag [output tag]
+  (put output :tag-offload (if (= (output :tag-offload) tag) nil tag)))
+
+(defn output/ensure-main-tag [output]
+  (when (not (output :tag-main))
+    (def available (->> tags-main
+                        (reverse)
+                        (filter (fn [tag] (not (some |(= tag ($ :tag-main)) (wm :outputs)))))))
+    (def tag (or
+               (find (fn [tag] (not (some |(= ($ :tag) tag) (wm :windows)))) available)
+               (first available)))
+    (put output :tag-main tag)))
+
+
 (defn wm/manage []
   (set (wm :render-order) (filter |(not ($ :closed)) (wm :render-order)))
   (defn close [o] (not (when (or (o :removed) (o :closed)) (:destroy (o :obj)) true)))
@@ -358,8 +388,6 @@
   (set (wm :windows) (filter close (wm :windows)))
   (set (wm :seats) (filter close (wm :seats)))
 
-  (defn output/set-main-tag [output tag]
-    (map |(if (= ($ :tag-main)) tag) (wm :outputs)))
   (map seat/manage (wm :seats))
   (map output/ensure-main-tag (wm :outputs))
   (map output/manage (wm :outputs))
@@ -374,6 +402,7 @@
 
   (:manage-finish (registry "river_window_manager_v1")))
 
+
 (defn rgb-to-u32-rgba [rgb]
   [(* (band 0xff (brushift rgb 16)) (/ 0xffff_ffff 0xff))
    (* (band 0xff (brushift rgb 8)) (/ 0xffff_ffff 0xff))
@@ -418,6 +447,22 @@
 (defn mark-dirty []
   (:manage-dirty (registry "river_window_manager_v1")))
 
+(defn status-display [output]
+  (def output (find |(= (get-in $ [:wl-output :name]) output) (wm :outputs)))
+  (string
+    ":"
+    (if (= (output :tag-offload) :comma) "<" "")
+    (output :tag-main)
+    (if (= (output :tag-offload) :period) ">" "")
+    " "
+    (string/join (map |(string ":" $) (filter keyword? (output :tags-other))))))
+
+(defn status-watcher [output]
+  (def out (dyn *out*))
+  (def clear (register-callback [:output-new-tags output] [tags] (with-dyns [*out* out] (print (status-display output)))))
+  (print (status-display output))
+  (defer (clear) (forever (ev/sleep 0.1))))
+
 
 (defn action/target-in [obj list dir]
   (let [i (or (index-of obj list) -1)]
@@ -432,7 +477,8 @@
     (action/target-in window windows dir)))
 
 (defn spawn [command]
-  (ev/spawn (os/proc-wait (os/spawn ["/bin/sh" "-c" command] :p))))
+  (ev/spawn (os/proc-wait (os/spawn ["/bin/sh" "-c" command] :p)))
+  true)
 
 (defn action/spawn [command]
   (fn [seat binding] (spawn command)))
@@ -444,7 +490,10 @@
                outputs (wm :outputs)
                new-output (action/target-in current-output outputs dir)]
       (seat/focus-output seat new-output)
-      (seat/focus seat (first (output/windows new-output))))))
+      (seat/focus seat (first (output/windows new-output)))
+      (def [x y] (new-output :position))
+      (def [w h] (new-output :dimensions))
+      (:pointer-warp (seat :obj) (+ x (/ w 2)) (+ y (/ h 2))))))
 
 (defn action/goto-tag [tag]
   (def f (cond
@@ -506,20 +555,25 @@
     (def appid (window :app-id))
     (put window :tag [:pulldown appid])
     (window/set-float window true)
-    (when-let [w ((wm :pulldowns) appid)]
+    (when-let [w ((wm :pulldowns) appid)
+               open (not (w :closed))]
       (:close (w :obj)))
     (put (wm :pulldowns) appid window)))
 
 (defn action/pulldown [appid command]
   (fn [seat binding]
-    (when (output/toggle-other-tag (seat :focused-output) [:pulldown appid])
+    (let [output (seat :focused-output)
-      (if-let [window (get-in wm [:pulldowns appid])]
+          tag [:pulldown appid]
-        (if-not (window :closed)
+          has-tag (has-value? (output :tags-other) tag)
-          (do
+          window (get-in wm [:pulldowns appid])
-            (put window :output (seat :focused-output))
+          closed (when window (window :closed))
-            (seat/focus seat window))
+          has-window (and window (not closed))
-          (spawn command))
+          toggle-tag (delay (output/toggle-other-tag output tag))
-        (spawn command)))))
+          open (delay (spawn command))]
+      (cond
+        has-window (toggle-tag)
+        has-tag (open)
+        (do (open) (toggle-tag))))))
 
 
 (defn locked-screen []
@@ -563,6 +617,7 @@
                              [:o G (action/spawn "wl-present-ui")]
                              [:t G (action/pulldown "floating-terminal" "alacritty --class floating-terminal -e tmux new-session -ADX -s floating")]
                              [:r G (action/pulldown "floating-repl" "alacritty --class floating-repl -e censtablo-repl")]
+                             [:h G (action/pulldown "floating-htop" "alacritty --class floating-htop -e htop")]
                              [:XF86AudioLowerVolume {} (action/spawn "pamixer -d 5")]
                              [:XF86AudioRaiseVolume {} (action/spawn "pamixer -i 5")]
                              [:XF86AudioMute {} (action/spawn "pamixer -t")]
@@ -575,12 +630,15 @@
 
 
 (defn rule/tag [tag] (fn [window] (put window :tag tag)))
+(defn rule/float [float] (fn [window] (put window :float float)))
 
 (put config :appid-rules @{"thunderbird" (rule/tag :m)
                            "vesktop" (rule/tag :d)
                            "io.github.alainm23.planify" (rule/tag :j)
                            "floating-terminal" (rule/pulldown)
-                           "floating-repl" (rule/pulldown)})
+                           "floating-repl" (rule/pulldown)
+                           "floating-htop" (rule/pulldown)
+                           "steam" (rule/float false)})
 
 
 (defn startup []
@@ -593,10 +651,10 @@
   (spawn "io.github.alainm23.planify"))
 
 # TODO: layout flexibility
-
+# TODO: fullscreen oddities with games: debug (warframe, novadrift, portal)
-# TODO: swap display tags
+# TODO: firefox focus weirdness
-
+# TODO: double fullscreen
-# TODO: reload with repl?
+# TODO: swaylock hibernate acquire outputs
 
 (defn configure-keymap []
   (def ctx (xkbcommon/context/new))

repl.janet

@@ -1,4 +1,29 @@
 (import spork/netrepl)
+(import spork/msg)
+
+(defn run-commands [sock args]
+  (with [stream (net/connect :unix sock)]
+    (def recv- (msg/make-recv stream))
+    (def send (msg/make-send stream))
+    (send (string/format "\xFF%j" {:auto-flush true :name ""}))
+    (defn recv []
+      (def ms (recv-))
+      (case (ms 0)
+        nil ms
+        0xFF (do
+          (prin (slice ms 1))
+          (flush)
+          (recv))
+        0xFE (slice ms 1))
+        ms)
+    (def prompt (recv))
+    (each arg args
+      (send arg)
+      (loop [:until (= prompt (recv))]))))
+
+(defn main [exe & args]
+  (def sock (string (os/getenv "XDG_RUNTIME_DIR") "/censtablo-" (os/getenv "WAYLAND_DISPLAY")))
+  (if (empty? args)
+     (netrepl/client :unix sock)
+     (run-commands sock args)))
   
-(defn main [exe]
-  (netrepl/client :unix (string (os/getenv "XDG_RUNTIME_DIR") "/censtablo-" (os/getenv "WAYLAND_DISPLAY"))))