Improve pulldowns & status display

This commit is contained in:
bluepython508
2026-02-16 11:12:26 +00:00
parent 8edac33374
commit db554d2d52
2 changed files with 99 additions and 60 deletions

View File

@@ -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])
@@ -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)
;(output :tags-other)
;(if (output :tag-offload)
[[(output :tag-main) (output :tag-offload)]]
[])]))
(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)
@@ -353,6 +341,38 @@
(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))
(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)))
@@ -360,8 +380,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))
@@ -376,6 +394,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))
@@ -420,9 +439,8 @@
(defn mark-dirty []
(:manage-dirty (registry "river_window_manager_v1")))
(defn status-display []
(def seat (first (wm :seats)))
(def output (seat :focused-output))
(defn status-display [output]
(def output (find |(= (get-in $ [:wl-output :name]) output) (wm :outputs)))
(string
":" (output :tag-main)
(case (output :tag-offload)
@@ -432,6 +450,12 @@
" "
(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)]
@@ -521,20 +545,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])
(if-let [window (get-in wm [:pulldowns appid])]
(if-not (window :closed)
(do
(put window :output (seat :focused-output))
(seat/focus seat window))
(spawn command))
(spawn command)))))
(let [output (seat :focused-output)
tag [:pulldown appid]
has-tag (has-value? (output :tags-other) tag)
window (get-in wm [:pulldowns appid])
closed (when window (window :closed))
has-window (and window (not closed))
toggle-tag (delay (output/toggle-other-tag output tag))
open (delay (spawn command))]
(cond
has-window (toggle-tag)
has-tag (open)
(do (open) (toggle-tag))))))
(defn locked-screen []
@@ -608,8 +637,14 @@
(spawn "io.github.alainm23.planify"))
# TODO: layout flexibility
# TODO: reload with repl?
# TODO: fix waybar complaining about <
# TODO: fullscreen oddities with games: debug (warframe, novadrift, portal)
# TODO: firefox focus weirdness
# TODO: double fullscreen
# TODO: floating windows (WF launcher, discord launch screen, pinentry, ...)
# TODO: swaylock hibernate acquire
# TODO: actually do idle lock
# TODO: mouse warp on switch output
(defn configure-keymap []
(def ctx (xkbcommon/context/new))

View File

@@ -3,19 +3,23 @@
(defn run-commands [sock args]
(with [stream (net/connect :unix sock)]
(def recv (msg/make-recv stream))
(def recv- (msg/make-recv stream))
(def send (msg/make-send stream))
(send (string/format "\xFF%j" {:auto-flush false :name ""}))
(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 (string "\xFF" arg))
(def [ok val] (-> (recv)
(parse)))
(if (string? val)
(print val)
(pp val))
(unless ok
(os/exit 1)))))
(send arg)
(loop [:until (= prompt (recv))]))))
(defn main [exe & args]
(def sock (string (os/getenv "XDG_RUNTIME_DIR") "/censtablo-" (os/getenv "WAYLAND_DISPLAY")))