744 lines
28 KiB
Janet
744 lines
28 KiB
Janet
(import wayland)
|
|
(import spork/netrepl)
|
|
(import xkbcommon)
|
|
|
|
(def river-protocols ((os/environ) "RIVER_PROTOCOLS"))
|
|
|
|
(def interfaces (wayland/scan
|
|
:system-protocols ["stable/viewporter/viewporter.xml"]
|
|
:custom-protocols (map |(string river-protocols $)
|
|
["river-window-management-v1.xml"
|
|
"river-layer-shell-v1.xml"
|
|
"river-xkb-bindings-v1.xml"
|
|
"river-input-management-v1.xml"
|
|
"river-libinput-config-v1.xml"
|
|
"river-xkb-config-v1.xml"])))
|
|
|
|
(def required-interfaces
|
|
{"river_window_manager_v1" 3
|
|
"river_layer_shell_v1" 1
|
|
"river_xkb_bindings_v1" 1
|
|
"river_xkb_config_v1" 1
|
|
"river_input_manager_v1" 1})
|
|
|
|
(def registry @{})
|
|
(def wl-outputs @{})
|
|
|
|
(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])
|
|
(def tags-other [:g :m :q :w :f :p :b :j :l :u :y :z :x :c :d :v :k :h])
|
|
|
|
(def config
|
|
@{:xcursor-theme ["Vanilla-DMZ" 24]
|
|
:border-width 1
|
|
:border-normal 0x646464
|
|
:border-focused 0xffffff
|
|
:appid-rules @{}})
|
|
|
|
(defn binding/create [seat keysym mods action]
|
|
(def binding @{:obj (:get-xkb-binding (registry "river_xkb_bindings_v1") (seat :obj) (xkbcommon/keysym keysym) mods)})
|
|
(defn handle-event [event]
|
|
(match event
|
|
[:pressed] (put seat :pending-action [binding action])))
|
|
(:set-handler (binding :obj) handle-event)
|
|
(:enable (binding :obj))
|
|
(array/push (seat :xkb-bindings) binding))
|
|
|
|
(defn input/configure [input]
|
|
# Map trackpads to laptop displays
|
|
(unless (nil? (string/find "Touchpad" (input :name)))
|
|
(when-let [internal (find |(string/has-prefix? "eDP" (get $ :name "")) wl-outputs)]
|
|
(put input :mapped internal)
|
|
(:map-to-output (input :obj) (internal :obj)))))
|
|
|
|
(defn input/create [input]
|
|
(def input @{:obj input})
|
|
(defn handle-event [event]
|
|
(match event
|
|
[:type type] (put input :type type)
|
|
[:name name] (put input :name name))
|
|
(when (and (input :type) (input :name))
|
|
(input/configure input)))
|
|
(:set-handler (input :obj) handle-event)
|
|
(:set-user-data (input :obj) input)
|
|
(array/push (wm :inputs) input))
|
|
|
|
(defn wl-output/create [name obj]
|
|
(def output @{:obj obj})
|
|
(put wl-outputs name output)
|
|
(defn handle-event [event]
|
|
(match event
|
|
[:name name] (do
|
|
(put output :name name)
|
|
(each input (wm :inputs) (input/configure input)))))
|
|
(:set-handler obj handle-event)
|
|
(:set-user-data obj output))
|
|
|
|
(defn output/create [obj]
|
|
(def output @{:obj obj
|
|
:layer-shell (:get-output (registry "river_layer_shell_v1") obj)
|
|
:new true
|
|
:tags-other []})
|
|
(defn handle-event [event]
|
|
(match event
|
|
[:removed] (put output :removed true)
|
|
[:position x y] (put output :position [x y])
|
|
[:dimensions w h] (put output :dimensions [w h])
|
|
[:wl-output name] (put output :wl-output (wl-outputs name))))
|
|
(defn handle-layer-shell-event [event]
|
|
(match event
|
|
[:non-exclusive-area x y w h] (put output :non-exclusive-area [x y w h])))
|
|
(:set-user-data obj output)
|
|
(:set-handler obj handle-event)
|
|
(:set-handler (output :layer-shell) handle-layer-shell-event)
|
|
output)
|
|
|
|
(defn seat/create [obj]
|
|
(def seat @{:obj obj
|
|
:layer-shell (:get-seat (registry "river_layer_shell_v1") obj)
|
|
:layer-focus :none
|
|
:xkb-bindings @[]
|
|
:pointer-bindings @[]
|
|
:new true})
|
|
(defn handle-event [event]
|
|
(match event
|
|
[:removed] (put seat :removed true)
|
|
[:pointer-enter window] (put seat :pointer-target (:get-user-data window))
|
|
[:pointer-leave] (put seat :pointer-target nil)
|
|
[:window-interaction window] (put seat :window-interaction (:get-user-data window))
|
|
[:shell-surface-interaction shell-surface] (do)))
|
|
(defn handle-layer-shell-event [event]
|
|
(match event
|
|
[:focus-exclusive] (put seat :layer-focus :exclusive)
|
|
[:focus-non-exclusive] (put seat :layer-focus :non-exclusive)
|
|
[:focus-none] (put seat :layer-focus :none)))
|
|
(:set-handler obj handle-event)
|
|
(:set-handler (seat :layer-shell) handle-layer-shell-event)
|
|
(:set-user-data obj seat)
|
|
(:set-xcursor-theme obj ;(config :xcursor-theme))
|
|
seat)
|
|
|
|
(defn window/create [obj]
|
|
(def window
|
|
@{:obj obj
|
|
:node (:get-node obj)
|
|
:new true})
|
|
(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 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)))
|
|
[:decoration-hint hint] (put window :decoration-hint hint)
|
|
[:pointer-move-requested seat] (put window :pointer-move-requested {:seat (:get-user-data seat)})
|
|
[:pointer-resize-requested seat edges] (put window :pointer-resize-requested {:seat (:get-user-data seat) :edges edges})
|
|
[:fullscreen-requested output] (put window :fullscreen-requested [:enter (if output (:get-user-data output))])
|
|
[:exit-fullscreen-requested] (put window :fullscreen-requested [:exit])))
|
|
(:set-handler obj handle-event)
|
|
(:set-user-data obj window)
|
|
window)
|
|
|
|
(defn clear [keys]
|
|
(fn [obj]
|
|
(each k keys
|
|
(put obj k nil))))
|
|
|
|
(defn output/manage [output]
|
|
(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)
|
|
(when inform
|
|
(:inform-fullscreen (window :obj)))
|
|
(:fullscreen (window :obj) ((window :output) :obj)))
|
|
|
|
(defn window/exit-fullscreen [window &opt inform]
|
|
(put window :fullscreen false)
|
|
(when inform
|
|
(:inform-not-fullscreen (window :obj)))
|
|
(:exit-fullscreen (window :obj)))
|
|
|
|
(defn window/set-float [window float]
|
|
(if float
|
|
(:set-tiled (window :obj) {})
|
|
(:set-tiled (window :obj) {:left true :bottom true :top true :right true}))
|
|
(put window :float float))
|
|
|
|
(defn window/move-output [window output]
|
|
(when output
|
|
(put window :tag (output :tag-main))
|
|
(put window :output output)))
|
|
|
|
(defn seat/focus-output [seat output]
|
|
(unless (= output (seat :focused-output))
|
|
(put seat :focused-output output)
|
|
(when output (:set-default (output :layer-shell)))))
|
|
|
|
(defn seat/focus [seat window]
|
|
(defn focus-window [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)))
|
|
(defn clear-focus []
|
|
(when (seat :focused)
|
|
(:clear-focus (seat :obj))
|
|
(put seat :focused nil)))
|
|
(defn focus-non-layer []
|
|
(when (and window (window :output))
|
|
(seat/focus-output seat (window :output)))
|
|
(when-let [output (seat :focused-output)]
|
|
(defn visible? [w] (and w (= output (w :output))))
|
|
(def visible (filter |(= output ($ :output)) (wm :render-order)))
|
|
(cond
|
|
(def fullscreen (last (filter |($ :fullscreen) visible))) (focus-window fullscreen)
|
|
(visible? window) (focus-window window)
|
|
(visible? (seat :focused)) (do)
|
|
(def top-visible (last visible)) (focus-window top-visible)
|
|
(clear-focus))))
|
|
(case (seat :layer-focus)
|
|
:exclusive (put seat :focused nil)
|
|
:non-exclusive (if window
|
|
(do
|
|
(put seat :layer-focus :none)
|
|
(focus-non-layer))
|
|
(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))
|
|
(if-let [parent (window :parent)]
|
|
(do
|
|
(window/set-float window true)
|
|
(put window :tag (parent :tag))
|
|
(:propose-dimensions (window :obj) 0 0))
|
|
(do
|
|
(def seat (first (wm :seats)))
|
|
(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))
|
|
(callback :new-window window))
|
|
|
|
(match (window :fullscreen-requested)
|
|
[:enter] (window/enter-fullscreen window)
|
|
[:enter output] (do
|
|
(window/move-output window output)
|
|
(window/enter-fullscreen window))
|
|
[:exit] (window/exit-fullscreen window))
|
|
|
|
(put window :output (find |(has-value? ($ :tags) (window :tag)) (wm :outputs)))
|
|
|
|
(if (window :output)
|
|
(do
|
|
(:show (window :obj))
|
|
(when (window :fullscreen)
|
|
(:fullscreen (window :obj) ((window :output) :obj))))
|
|
(:hide (window :obj))))
|
|
|
|
|
|
(defn seat/manage [seat]
|
|
(when (seat :new)
|
|
(each binding (config :xkb-bindings)
|
|
(binding/create seat ;binding)))
|
|
|
|
(when-let [window (seat :focused)]
|
|
(when (window :closed)
|
|
(put seat :focused nil)))
|
|
|
|
(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)]
|
|
(seat/focus seat window))
|
|
|
|
(when-let [[binding action] (seat :pending-action)]
|
|
(action seat binding))
|
|
|
|
(seat/focus seat nil))
|
|
|
|
(defn window/set-position [window x y]
|
|
(let [border-width (config :border-width)
|
|
x (+ x border-width)
|
|
y (+ y border-width)]
|
|
(put window :x x)
|
|
(put window :y y)
|
|
(:set-position (window :node) x y)))
|
|
|
|
(defn window/propose-dimensions [window w h]
|
|
(:propose-dimensions (window :obj)
|
|
(max 1 (- w (* 2 (config :border-width))))
|
|
(max 1 (- h (* 2 (config :border-width))))))
|
|
|
|
(defn layout/rows [n x y w h]
|
|
(if (> n 0)
|
|
(do
|
|
(def height (math/trunc (/ h n)))
|
|
(defn rows [n]
|
|
(if (= n 0) [] (let [Y (- (+ y h) (* n height))]
|
|
(tuple/join [[x Y w height]]
|
|
(rows (- n 1))))))
|
|
(rows n))
|
|
[]))
|
|
|
|
(defn layout/split [count n x y w h]
|
|
(if (= n 1)
|
|
[[x y w h]]
|
|
(let [left (/ w 2)
|
|
right (- w left)]
|
|
(tuple/join (layout/rows (min n count) x y (+ x left) h)
|
|
(layout/rows (- n count) (+ x left) y right h)))))
|
|
|
|
(defn layout/main [n w h] (layout/split 1 n 0 0 w h))
|
|
|
|
(defn output/windows [output] (filter |(= output ($ :output)) (wm :windows)))
|
|
|
|
(defn output/layout [output]
|
|
(def [X Y W H] (or (output :non-exclusive-area) [;(output :position) ;(output :dimensions)]))
|
|
(def windows (filter |(not ($ :float)) (output/windows output)))
|
|
(map (fn [window [x y w h]]
|
|
(window/set-position window (+ X x) (+ Y y))
|
|
(window/propose-dimensions window w h))
|
|
windows
|
|
(layout/main (length windows) W H))
|
|
|
|
(each window (filter |($ :float) (output/windows output))
|
|
(callback :layout-floating window)
|
|
(let [[min-w max-w min-h max-h] (or (window :dimensions-bounds) [(/ W 2) (/ W 2) (/ H 2) (/ H 2)])
|
|
h (if (< 10 min-h) min-h (/ H 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)))
|
|
(set (wm :outputs) (filter close (wm :outputs)))
|
|
(set (wm :windows) (filter close (wm :windows)))
|
|
(set (wm :seats) (filter close (wm :seats)))
|
|
|
|
(map seat/manage (wm :seats))
|
|
(map output/ensure-main-tag (wm :outputs))
|
|
(map output/manage (wm :outputs))
|
|
(map window/manage (wm :windows))
|
|
(map |(seat/focus $ nil) (wm :seats)) # Reconcile focus again after potential tag changes
|
|
|
|
(map output/layout (wm :outputs))
|
|
|
|
(map (clear [:new]) (wm :outputs))
|
|
(map (clear [:new :pointer-move-requested :pointer-resize-requested :fullscreen-requested]) (wm :windows))
|
|
(map (clear [:new :window-interaction :pending-action]) (wm :seats))
|
|
|
|
(: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))
|
|
(* (band 0xff rgb) (/ 0xffff_ffff 0xff))
|
|
0xffff_ffff])
|
|
|
|
(defn set-borders [window status]
|
|
(def rgb (case status
|
|
:normal (config :border-normal)
|
|
:focused (config :border-focused)))
|
|
(:set-borders (window :obj)
|
|
{:left true :bottom :true :top :true :right true}
|
|
(config :border-width)
|
|
;(rgb-to-u32-rgba rgb)))
|
|
|
|
(defn window/render [window]
|
|
(when (and (not (window :x)) (window :w))
|
|
(def output ((window :parent) :output))
|
|
(window/set-position
|
|
window
|
|
(+ (output :x) (div (- (output :w) (window :w)) 2))
|
|
(+ (output :y) (div (- (output :h) (window :h)) 2))))
|
|
(if (find |(= ($ :focused) window) (wm :seats))
|
|
(set-borders window :focused)
|
|
(set-borders window :normal)))
|
|
|
|
(defn wm/render []
|
|
(map window/render (wm :windows))
|
|
(:render-finish (registry "river_window_manager_v1")))
|
|
|
|
|
|
(defn wm/handle-event [event]
|
|
(match event
|
|
[:unavailable] (error "another window manager is already running")
|
|
[:finished] (os/exit 0)
|
|
[:manage-start] (wm/manage)
|
|
[:render-start] (wm/render)
|
|
[:output obj] (array/push (wm :outputs) (output/create obj))
|
|
[:seat obj] (array/push (wm :seats) (seat/create obj))
|
|
[:window obj] (array/push (wm :windows) (window/create obj))))
|
|
|
|
(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)]
|
|
(case dir
|
|
:next (get list (+ i 1) (first list))
|
|
:prev (get list (- i 1) (last list)))))
|
|
|
|
(defn action/target [seat dir]
|
|
(when-let [window (seat :focused)
|
|
output (window :output)
|
|
windows (output/windows output)]
|
|
(action/target-in window windows dir)))
|
|
|
|
(defn spawn [command]
|
|
(ev/spawn (os/proc-wait (os/spawn ["/bin/sh" "-c" command] :p)))
|
|
true)
|
|
|
|
(defn action/spawn [command]
|
|
(fn [seat binding] (spawn command)))
|
|
|
|
(defn action/focus [dir] (fn [seat binding] (seat/focus seat (action/target seat dir))))
|
|
(defn action/focus-output [dir]
|
|
(fn [seat binding]
|
|
(when-let [current-output (seat :focused-output)
|
|
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)))
|
|
(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
|
|
(has-value? tags-main tag) output/set-main-tag
|
|
(has-value? tags-other tag) output/toggle-other-tag
|
|
(has-value? tags-offload tag) output/toggle-offload-tag))
|
|
(fn [seat binding]
|
|
(when-let [output (seat :focused-output)]
|
|
(f output tag))))
|
|
|
|
(defn action/set-tag [tag]
|
|
(fn [seat binding]
|
|
(when-let [window (seat :focused)
|
|
output (seat :focused-output)
|
|
main-tag (output :tag-main)]
|
|
(put window :tag (cond
|
|
(= (window :tag) [main-tag tag]) main-tag
|
|
(has-value? tags-offload tag) [main-tag tag]
|
|
tag)))))
|
|
|
|
(defn action/toggle-fullscreen [inform]
|
|
(fn [seat binding]
|
|
(def window (seat :focused))
|
|
(if (window :fullscreen)
|
|
(window/exit-fullscreen window inform)
|
|
(window/enter-fullscreen window inform))))
|
|
|
|
(defn action/close []
|
|
(fn [seat binding]
|
|
(if-let [window (seat :focused)]
|
|
(:close (window :obj)))))
|
|
|
|
(defn action/zoom []
|
|
(fn [seat binding]
|
|
(when-let [focused (seat :focused)
|
|
output (focused :output)
|
|
visible (output/windows output)
|
|
target (if (= focused (first visible)) (get visible 1) focused)
|
|
i (assert (index-of target (wm :windows)))]
|
|
(array/remove (wm :windows) i)
|
|
(array/insert (wm :windows) 0 target)
|
|
(seat/focus seat (first (wm :windows))))))
|
|
|
|
(defn action/screenshot []
|
|
(fn [seat binding]
|
|
(spawn (string "GRIM_DEFAULT_DIR=\"$HOME/tmp\" grim -o " (get-in seat [:focused-output :wl-output :name])))))
|
|
|
|
(defn action/rotate-outputs []
|
|
(def ks [:tag-main :tag-offload :tags-other])
|
|
(fn [seat binding]
|
|
(def outputs (wm :outputs))
|
|
(def tags (map |(tabseq [k :in ks] k ($ k)) outputs))
|
|
(map (fn [out tags]
|
|
(eachp [k tag] tags (put out k tag))) outputs [;(slice tags 1) (first tags)])
|
|
((action/focus-output :next) seat nil)))
|
|
|
|
(defn rule/pulldown []
|
|
(fn [window]
|
|
(def appid (window :app-id))
|
|
(put window :tag [:pulldown appid])
|
|
(window/set-float window true)
|
|
(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]
|
|
(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 []
|
|
(def notifs-status (= 0 (os/execute ["dunstctl" "is-paused" "-e"] :p)))
|
|
(os/execute ["dunstctl" "set-paused" "true"] :p)
|
|
(ev/spawn
|
|
(os/execute ["pidwait" "swaylock"] :p)
|
|
(os/execute ["dunstctl" "set-paused" (if notifs-status "true" "false")] :p)))
|
|
|
|
(defn lock-screen []
|
|
(spawn "swaylock")
|
|
(locked-screen))
|
|
|
|
(defn action/lock-screen []
|
|
(fn [seat binding]
|
|
(lock-screen)))
|
|
|
|
(put config :xkb-bindings (let [G {:mod4 true}
|
|
G-S {:mod4 true :shift true}
|
|
M {:mod1 true}
|
|
M-S {:mod1 true :shift true}]
|
|
[[:Tab M (action/focus :next)]
|
|
[:Tab M-S (action/focus :prev)]
|
|
[:Tab G (action/focus-output :next)]
|
|
[:Tab G-S (action/focus-output :prev)]
|
|
[:Tab {:mod4 true :ctrl true :mod1 true} (action/spawn "toggle-monitor")]
|
|
[:Return G (action/spawn "alacritty")]
|
|
[:f G (action/toggle-fullscreen true)]
|
|
[:f G-S (action/toggle-fullscreen false)]
|
|
[:k G (action/close)]
|
|
[:backslash G (action/zoom)]
|
|
[:backslash G-S (action/rotate-outputs)]
|
|
[:space G (action/spawn "rofi -show launch")]
|
|
[:x {:mod4 true} (action/spawn "rofi -show run")]
|
|
[:b G (action/spawn "rofi -show bt")]
|
|
[:p G (action/spawn "rofi-rbw")]
|
|
[:n G (action/spawn "rofi -show notifications")]
|
|
[:m G (action/spawn "rofi -show cliphist")]
|
|
[:s G (action/screenshot)]
|
|
[:j G (action/spawn "io.github.alainm23.planify.quick-add")]
|
|
[: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")]
|
|
[:XF86AudioPlay {} (action/spawn "playerctl play-pause")]
|
|
[:XF86AudioPrev {} (action/spawn "playerctl previous")]
|
|
[:XF86AudioNext {} (action/spawn "playerctl next")]
|
|
[:Pause {} (action/lock-screen)]
|
|
;(map |[$ {:mod5 true} (action/goto-tag $)] (tuple ;tags-main ;tags-other ;tags-offload))
|
|
;(map |[$ {:mod5 true :shift true} (action/set-tag $)] (tuple ;tags-main ;tags-other ;tags-offload))]))
|
|
|
|
|
|
(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-htop" (rule/pulldown)
|
|
"steam" (rule/float false)})
|
|
|
|
|
|
(defn startup []
|
|
(spawn "pkill waybar; waybar")
|
|
(spawn "kanshi")
|
|
|
|
(spawn "vesktop")
|
|
(spawn "thunderbird")
|
|
(spawn "solaar --window hide")
|
|
(spawn "io.github.alainm23.planify"))
|
|
|
|
# TODO: layout flexibility
|
|
# TODO: fullscreen oddities with games: debug (warframe, novadrift, portal)
|
|
# TODO: firefox focus weirdness
|
|
# TODO: double fullscreen
|
|
# TODO: swaylock hibernate acquire outputs
|
|
|
|
(defn configure-keymap []
|
|
(def ctx (xkbcommon/context/new))
|
|
(def rmlvo (:create-rmlvo ctx))
|
|
(:append-layout rmlvo "us-local")
|
|
(def keymap (:create-keymap rmlvo :text-v2))
|
|
(def str (:get-string keymap :text-v2))
|
|
(def fd (wayland/memfd/from-string str))
|
|
|
|
(def keymap (:create-keymap (registry "river_xkb_config_v1") fd :text-v2))
|
|
(defn apply-km [kb]
|
|
(:set-keymap kb keymap)
|
|
(:set-layout-by-name kb "us-local"))
|
|
(var ready false)
|
|
(def keyboards @[])
|
|
(:set-handler keymap (fn [event]
|
|
(match event
|
|
[:success] (do
|
|
(set ready true)
|
|
(each keyboard keyboards (apply-km keyboard)))
|
|
[:failure err] (errorf "invalid keymap %s" err))))
|
|
|
|
(:set-handler (registry "river_xkb_config_v1") (fn [event]
|
|
(match event
|
|
[:xkb-keyboard keyboard] (if ready (apply-km keyboard) (array/push keyboards keyboard))))))
|
|
|
|
|
|
(def repl-env (curenv))
|
|
(defn repl-server-create []
|
|
(def path (string/format "%s/censtablo-%s" (os/getenv "XDG_RUNTIME_DIR") (os/getenv "WAYLAND_DISPLAY")))
|
|
(protect (os/rm path))
|
|
(netrepl/server :unix path repl-env))
|
|
|
|
# Stolen from https://git.sr.ht/~leon_plickat/river-config/tree/master/item/river/launch-river.sh
|
|
(def env {"WAYLAND_DEBUG" nil
|
|
"MOZ_ENABLE_WAYLAND" "1"
|
|
"CLUTTER_BACKEND" "wayland"
|
|
"QT_QPA_PLATFORM" "wayland"
|
|
"ECORE_EVAS_ENGINE" "wayland-egl"
|
|
"ELM_ENGINE" "wayland_egl"
|
|
"_JAVA_AWT_WM_NONREPARENTING" "1"
|
|
"NO_AT_BRIDGE" "1"
|
|
|
|
"XDG_SESSION_TYPE" "wayland"
|
|
"XDG_SESSION_DESKTOP" "river"
|
|
"XDG_CURRENT_DESKTOP" "river"
|
|
|
|
"NIXOS_OZONE_WL" "1"})
|
|
|
|
(defn main [&]
|
|
(def display (wayland/connect interfaces))
|
|
(eachp [var val] env (os/setenv var val))
|
|
|
|
(put registry :obj (:get-registry display))
|
|
(:set-handler (registry :obj) (fn [event]
|
|
(match event
|
|
[:global name interface version]
|
|
(do
|
|
(when-let [required-version (required-interfaces interface)]
|
|
(when (< version required-version)
|
|
(errorf "wayland compositor supported %s version too old (need %d, got %d)" interface required-version version))
|
|
(put registry interface (:bind (registry :obj) name interface required-version)))
|
|
(when (= interface "wl_output")
|
|
(wl-output/create name (:bind (registry :obj) name interface 4))))
|
|
[:global-remove name]
|
|
(when-let [obj (wl-outputs name)]
|
|
(put wl-outputs name nil)
|
|
(:release (obj :obj))))))
|
|
(:roundtrip display)
|
|
(eachk i required-interfaces
|
|
(unless (get registry i)
|
|
(errorf "wayland compositor does not support %s" i)))
|
|
|
|
(:set-handler (registry "river_window_manager_v1") wm/handle-event)
|
|
(:set-handler (registry "river_input_manager_v1") (fn [event]
|
|
(match event
|
|
[:input-device input] (input/create input))))
|
|
(configure-keymap)
|
|
|
|
(:roundtrip display)
|
|
|
|
(startup)
|
|
|
|
(def repl-server (repl-server-create))
|
|
(defer (:close repl-server)
|
|
(forever (:dispatch display))))
|