From 7f95de36237888dd5d94cdb000c855dba0daebdd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Tue, 4 Nov 2025 10:50:29 +0800 Subject: [PATCH 1/6] vanadium/xmonad: temporary modification to allow nmaster description --- .../vanadium/home/xmonad/leanamonad.cabal | 3 +- .../{Layouts => Layout}/ReflectMsg.hs | 2 +- .../lib/Leanamonad/Layout/ResizableTile.hs | 119 ++++++++++++++++++ .../vanadium/home/xmonad/xmonad.hs | 7 +- 4 files changed, 126 insertions(+), 5 deletions(-) rename nix/configurations/vanadium/home/xmonad/lib/Leanamonad/{Layouts => Layout}/ReflectMsg.hs (94%) create mode 100644 nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ResizableTile.hs diff --git a/nix/configurations/vanadium/home/xmonad/leanamonad.cabal b/nix/configurations/vanadium/home/xmonad/leanamonad.cabal index de874f27..c1978c6c 100644 --- a/nix/configurations/vanadium/home/xmonad/leanamonad.cabal +++ b/nix/configurations/vanadium/home/xmonad/leanamonad.cabal @@ -24,7 +24,8 @@ library import: common hs-source-dirs: lib exposed-modules: - Leanamonad.Layouts.ReflectMsg + Leanamonad.Layout.ReflectMsg + Leanamonad.Layout.ResizableTile Leanamonad.GreekChar executable leanamonad diff --git a/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layouts/ReflectMsg.hs b/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ReflectMsg.hs similarity index 94% rename from nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layouts/ReflectMsg.hs rename to nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ReflectMsg.hs index f86e4632..8b69af56 100644 --- a/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layouts/ReflectMsg.hs +++ b/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ReflectMsg.hs @@ -1,7 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -module Leanamonad.Layouts.ReflectMsg where +module Leanamonad.Layout.ReflectMsg where import XMonad ( Resize (Expand, Shrink), diff --git a/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ResizableTile.hs b/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ResizableTile.hs new file mode 100644 index 00000000..f12ec245 --- /dev/null +++ b/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ResizableTile.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.ResizableTile +-- Description : More useful tiled layout that allows you to change a width\/height of window. +-- Copyright : (c) MATSUYAMA Tomohiro +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : MATSUYAMA Tomohiro +-- Stability : unstable +-- Portability : unportable +-- +-- More useful tiled layout that allows you to change a width\/height of window. +-- +----------------------------------------------------------------------------- + +-- Ported from upstream XMonad.Layout.ResizableTile +-- Related https://github.com/xmonad/xmonad-contrib/issues/954 +module Leanamonad.Layout.ResizableTile ( + -- * Usage + -- $usage + ResizableTall(..), MirrorResize(..) + ) where + +import XMonad hiding (tile, splitVertically, splitHorizontallyBy) +import XMonad.Prelude +import qualified XMonad.StackSet as W +import qualified Data.Map as M + +-- $usage +-- You can use this module with the following in your @xmonad.hs@: +-- +-- > import XMonad.Layout.ResizableTile +-- +-- Then edit your @layoutHook@ by adding the ResizableTile layout: +-- +-- > myLayout = ResizableTall 1 (3/100) (1/2) [] ||| etc.. +-- > main = xmonad def { layoutHook = myLayout } +-- +-- For more detailed instructions on editing the layoutHook see +-- and +-- "XMonad.Doc.Extending#Editing_the_layout_hook". +-- +-- You may also want to add the following key bindings: +-- +-- > , ((modm, xK_a), sendMessage MirrorShrink) +-- > , ((modm, xK_z), sendMessage MirrorExpand) +-- +-- For detailed instruction on editing the key binding see: +-- +-- . + +data MirrorResize = MirrorShrink | MirrorExpand +instance Message MirrorResize + +data ResizableTall a = ResizableTall + { _nmaster :: Int -- ^ number of master windows + , _delta :: Rational -- ^ change when resizing by 'Shrink', 'Expand', + -- 'MirrorShrink', 'MirrorExpand' + , _frac :: Rational -- ^ width of master + , _slaves :: [Rational] -- ^ fraction to multiply the window + -- height that would be given when divided equally. + -- + -- slave windows are assigned their modified + -- heights in order, from top to bottom + -- + -- unspecified values are replaced by 1 + } deriving (Show, Read) + +instance LayoutClass ResizableTall a where + doLayout (ResizableTall nmaster _ frac mfrac) r = + return . (, Nothing) . + ap zip (tile frac (mfrac ++ repeat 1) r nmaster . length) . W.integrate + handleMessage (ResizableTall nmaster delta frac mfrac) m = + do ms <- W.stack . W.workspace . W.current <$> gets windowset + fs <- M.keys . W.floating <$> gets windowset + return $ ms >>= unfloat fs >>= handleMesg + where handleMesg s = msum [fmap resize (fromMessage m) + ,fmap (`mresize` s) (fromMessage m) + ,fmap incmastern (fromMessage m)] + unfloat fs s = if W.focus s `elem` fs + then Nothing + else Just (s { W.up = W.up s \\ fs + , W.down = W.down s \\ fs }) + resize Shrink = ResizableTall nmaster delta (max 0 $ frac-delta) mfrac + resize Expand = ResizableTall nmaster delta (min 1 $ frac+delta) mfrac + mresize MirrorShrink s = mresize' s delta + mresize MirrorExpand s = mresize' s (negate delta) + mresize' s d = let n = length $ W.up s + total = n + length (W.down s) + 1 + pos = if n == (nmaster-1) || n == (total-1) then n-1 else n + mfrac' = modifymfrac (mfrac ++ repeat 1) d pos + in ResizableTall nmaster delta frac $ take total mfrac' + modifymfrac [] _ _ = [] + modifymfrac (f:fx) d n | n == 0 = f+d : fx + | otherwise = f : modifymfrac fx d (n-1) + incmastern (IncMasterN d) = ResizableTall (max 0 (nmaster+d)) delta frac mfrac + description (ResizableTall {_nmaster}) = "ResizableTall " <> show _nmaster + +tile :: Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle] +tile f mf r nmaster n = if n <= nmaster || nmaster == 0 + then splitVertically mf n r + else splitVertically mf nmaster r1 ++ splitVertically (drop nmaster mf) (n-nmaster) r2 -- two columns + where (r1,r2) = splitHorizontallyBy f r + +splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle] +splitVertically [] _ r = [r] +splitVertically _ n r | n < 2 = [r] +splitVertically (f:fx) n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh : + splitVertically fx (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh)) + where smallh = min sh (floor $ fromIntegral (sh `div` fromIntegral n) * f) --hmm, this is a fold or map. + +splitHorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle) +splitHorizontallyBy f (Rectangle sx sy sw sh) = + ( Rectangle sx sy leftw sh + , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh) + where leftw = floor $ fromIntegral sw * f diff --git a/nix/configurations/vanadium/home/xmonad/xmonad.hs b/nix/configurations/vanadium/home/xmonad/xmonad.hs index 301d0afc..366737db 100644 --- a/nix/configurations/vanadium/home/xmonad/xmonad.hs +++ b/nix/configurations/vanadium/home/xmonad/xmonad.hs @@ -13,7 +13,7 @@ import XMonad.Hooks.StatusBar import XMonad.Layout.NoBorders import XMonad.Layout.Reflect import XMonad.Layout.Renamed -import XMonad.Layout.ResizableTile +-- import XMonad.Layout.ResizableTile import XMonad.Layout.Spacing import qualified XMonad.StackSet as W import XMonad.Util.EZConfig @@ -26,7 +26,8 @@ import qualified Data.Map.Strict as M import System.Posix import Graphics.X11.ExtraTypes.XF86 -import Leanamonad.Layouts.ReflectMsg +import Leanamonad.Layout.ReflectMsg +import Leanamonad.Layout.ResizableTile import Leanamonad.GreekChar main :: IO () @@ -65,7 +66,7 @@ main = putEnv "MOZ_USE_XINPUT2=1" -- Force touchpad for firefox , layoutHook = - let tallr = named "Normal" + let tallr = renamed [ KeepWordsRight 2 ] {- keep "ResizableTall n" -} $ smartSpacingWithEdge 5 $ reflectMsg . reflectHoriz $ ResizableTall 1 (1/10) (3/7) [] From b9fd0ef6b3614267f11979f560b470d967a00d5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 5 Nov 2025 08:45:27 +0800 Subject: [PATCH 2/6] vanadium/xmonad: allow nmaster description --- .../lib/Leanamonad/Layout/ResizableTile.hs | 130 +++--------------- .../vanadium/home/xmonad/xmonad.hs | 4 +- 2 files changed, 22 insertions(+), 112 deletions(-) diff --git a/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ResizableTile.hs b/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ResizableTile.hs index f12ec245..7692147d 100644 --- a/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ResizableTile.hs +++ b/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ResizableTile.hs @@ -1,119 +1,27 @@ {-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} ------------------------------------------------------------------------------ --- | --- Module : XMonad.Layout.ResizableTile --- Description : More useful tiled layout that allows you to change a width\/height of window. --- Copyright : (c) MATSUYAMA Tomohiro --- License : BSD-style (see LICENSE) --- --- Maintainer : MATSUYAMA Tomohiro --- Stability : unstable --- Portability : unportable --- --- More useful tiled layout that allows you to change a width\/height of window. --- ------------------------------------------------------------------------------ +module Leanamonad.Layout.ResizableTile + ( module XMonad.Layout.ResizableTile + , RTFixDescription(..) + ) where --- Ported from upstream XMonad.Layout.ResizableTile --- Related https://github.com/xmonad/xmonad-contrib/issues/954 -module Leanamonad.Layout.ResizableTile ( - -- * Usage - -- $usage - ResizableTall(..), MirrorResize(..) - ) where - -import XMonad hiding (tile, splitVertically, splitHorizontallyBy) -import XMonad.Prelude +import XMonad import qualified XMonad.StackSet as W -import qualified Data.Map as M +import XMonad.Layout.ResizableTile --- $usage --- You can use this module with the following in your @xmonad.hs@: --- --- > import XMonad.Layout.ResizableTile --- --- Then edit your @layoutHook@ by adding the ResizableTile layout: --- --- > myLayout = ResizableTall 1 (3/100) (1/2) [] ||| etc.. --- > main = xmonad def { layoutHook = myLayout } --- --- For more detailed instructions on editing the layoutHook see --- and --- "XMonad.Doc.Extending#Editing_the_layout_hook". --- --- You may also want to add the following key bindings: --- --- > , ((modm, xK_a), sendMessage MirrorShrink) --- > , ((modm, xK_z), sendMessage MirrorExpand) --- --- For detailed instruction on editing the key binding see: --- --- . +newtype RTFixDescription a = RTFixDescription { unwrapRT :: ResizableTall a } + deriving (Read, Show) -data MirrorResize = MirrorShrink | MirrorExpand -instance Message MirrorResize +instance LayoutClass RTFixDescription a where + runLayout (W.Workspace t l s) = + let ws' = W.Workspace t (unwrapRT l) s + in fmap (fmap (fmap RTFixDescription)) + . runLayout ws' -data ResizableTall a = ResizableTall - { _nmaster :: Int -- ^ number of master windows - , _delta :: Rational -- ^ change when resizing by 'Shrink', 'Expand', - -- 'MirrorShrink', 'MirrorExpand' - , _frac :: Rational -- ^ width of master - , _slaves :: [Rational] -- ^ fraction to multiply the window - -- height that would be given when divided equally. - -- - -- slave windows are assigned their modified - -- heights in order, from top to bottom - -- - -- unspecified values are replaced by 1 - } deriving (Show, Read) + handleMessage (RTFixDescription l) m = + fmap (fmap RTFixDescription) + $ handleMessage l m -instance LayoutClass ResizableTall a where - doLayout (ResizableTall nmaster _ frac mfrac) r = - return . (, Nothing) . - ap zip (tile frac (mfrac ++ repeat 1) r nmaster . length) . W.integrate - handleMessage (ResizableTall nmaster delta frac mfrac) m = - do ms <- W.stack . W.workspace . W.current <$> gets windowset - fs <- M.keys . W.floating <$> gets windowset - return $ ms >>= unfloat fs >>= handleMesg - where handleMesg s = msum [fmap resize (fromMessage m) - ,fmap (`mresize` s) (fromMessage m) - ,fmap incmastern (fromMessage m)] - unfloat fs s = if W.focus s `elem` fs - then Nothing - else Just (s { W.up = W.up s \\ fs - , W.down = W.down s \\ fs }) - resize Shrink = ResizableTall nmaster delta (max 0 $ frac-delta) mfrac - resize Expand = ResizableTall nmaster delta (min 1 $ frac+delta) mfrac - mresize MirrorShrink s = mresize' s delta - mresize MirrorExpand s = mresize' s (negate delta) - mresize' s d = let n = length $ W.up s - total = n + length (W.down s) + 1 - pos = if n == (nmaster-1) || n == (total-1) then n-1 else n - mfrac' = modifymfrac (mfrac ++ repeat 1) d pos - in ResizableTall nmaster delta frac $ take total mfrac' - modifymfrac [] _ _ = [] - modifymfrac (f:fx) d n | n == 0 = f+d : fx - | otherwise = f : modifymfrac fx d (n-1) - incmastern (IncMasterN d) = ResizableTall (max 0 (nmaster+d)) delta frac mfrac - description (ResizableTall {_nmaster}) = "ResizableTall " <> show _nmaster - -tile :: Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle] -tile f mf r nmaster n = if n <= nmaster || nmaster == 0 - then splitVertically mf n r - else splitVertically mf nmaster r1 ++ splitVertically (drop nmaster mf) (n-nmaster) r2 -- two columns - where (r1,r2) = splitHorizontallyBy f r - -splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle] -splitVertically [] _ r = [r] -splitVertically _ n r | n < 2 = [r] -splitVertically (f:fx) n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh : - splitVertically fx (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh)) - where smallh = min sh (floor $ fromIntegral (sh `div` fromIntegral n) * f) --hmm, this is a fold or map. - -splitHorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle) -splitHorizontallyBy f (Rectangle sx sy sw sh) = - ( Rectangle sx sy leftw sh - , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh) - where leftw = floor $ fromIntegral sw * f + description (RTFixDescription l) = + description l <> " " <> show (_nmaster l) diff --git a/nix/configurations/vanadium/home/xmonad/xmonad.hs b/nix/configurations/vanadium/home/xmonad/xmonad.hs index 366737db..d7921849 100644 --- a/nix/configurations/vanadium/home/xmonad/xmonad.hs +++ b/nix/configurations/vanadium/home/xmonad/xmonad.hs @@ -13,7 +13,7 @@ import XMonad.Hooks.StatusBar import XMonad.Layout.NoBorders import XMonad.Layout.Reflect import XMonad.Layout.Renamed --- import XMonad.Layout.ResizableTile +import XMonad.Layout.ResizableTile import XMonad.Layout.Spacing import qualified XMonad.StackSet as W import XMonad.Util.EZConfig @@ -27,6 +27,7 @@ import System.Posix import Graphics.X11.ExtraTypes.XF86 import Leanamonad.Layout.ReflectMsg +-- TODO: rename this module import Leanamonad.Layout.ResizableTile import Leanamonad.GreekChar @@ -69,6 +70,7 @@ main = let tallr = renamed [ KeepWordsRight 2 ] {- keep "ResizableTall n" -} $ smartSpacingWithEdge 5 $ reflectMsg . reflectHoriz + $ RTFixDescription $ ResizableTall 1 (1/10) (3/7) [] mag = magnifyxy 1.05 1.3 (NoMaster 3) False in avoidStruts . smartBorders $ From ca6fb5e7d2f9bb63226941e2bf5d4598cbe6449d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 5 Nov 2025 08:54:06 +0800 Subject: [PATCH 3/6] vanadium/xmonad: refactor --- nix/configurations/vanadium/home/xmonad/leanamonad.cabal | 6 +++--- .../lib/{Leanamonad/GreekChar.hs => Data/Char/Greek.hs} | 2 +- .../ReflectMsg.hs => XMonad/Layout/Reflect/Message.hs} | 2 +- .../Layout/ResizableTile/FixDescription.hs} | 5 ++--- nix/configurations/vanadium/home/xmonad/xmonad.hs | 7 +++---- 5 files changed, 10 insertions(+), 12 deletions(-) rename nix/configurations/vanadium/home/xmonad/lib/{Leanamonad/GreekChar.hs => Data/Char/Greek.hs} (95%) rename nix/configurations/vanadium/home/xmonad/lib/{Leanamonad/Layout/ReflectMsg.hs => XMonad/Layout/Reflect/Message.hs} (94%) rename nix/configurations/vanadium/home/xmonad/lib/{Leanamonad/Layout/ResizableTile.hs => XMonad/Layout/ResizableTile/FixDescription.hs} (86%) diff --git a/nix/configurations/vanadium/home/xmonad/leanamonad.cabal b/nix/configurations/vanadium/home/xmonad/leanamonad.cabal index c1978c6c..250a2d53 100644 --- a/nix/configurations/vanadium/home/xmonad/leanamonad.cabal +++ b/nix/configurations/vanadium/home/xmonad/leanamonad.cabal @@ -24,9 +24,9 @@ library import: common hs-source-dirs: lib exposed-modules: - Leanamonad.Layout.ReflectMsg - Leanamonad.Layout.ResizableTile - Leanamonad.GreekChar + XMonad.Layout.Reflect.Message + XMonad.Layout.ResizableTile.FixDescription + Data.Char.Greek executable leanamonad import: common diff --git a/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/GreekChar.hs b/nix/configurations/vanadium/home/xmonad/lib/Data/Char/Greek.hs similarity index 95% rename from nix/configurations/vanadium/home/xmonad/lib/Leanamonad/GreekChar.hs rename to nix/configurations/vanadium/home/xmonad/lib/Data/Char/Greek.hs index 844e05b5..43e8b23f 100644 --- a/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/GreekChar.hs +++ b/nix/configurations/vanadium/home/xmonad/lib/Data/Char/Greek.hs @@ -1,4 +1,4 @@ -module Leanamonad.GreekChar where +module Data.Char.Greek where import Data.List (find) diff --git a/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ReflectMsg.hs b/nix/configurations/vanadium/home/xmonad/lib/XMonad/Layout/Reflect/Message.hs similarity index 94% rename from nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ReflectMsg.hs rename to nix/configurations/vanadium/home/xmonad/lib/XMonad/Layout/Reflect/Message.hs index 8b69af56..61811072 100644 --- a/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ReflectMsg.hs +++ b/nix/configurations/vanadium/home/xmonad/lib/XMonad/Layout/Reflect/Message.hs @@ -1,7 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -module Leanamonad.Layout.ReflectMsg where +module XMonad.Layout.Reflect.Message where import XMonad ( Resize (Expand, Shrink), diff --git a/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ResizableTile.hs b/nix/configurations/vanadium/home/xmonad/lib/XMonad/Layout/ResizableTile/FixDescription.hs similarity index 86% rename from nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ResizableTile.hs rename to nix/configurations/vanadium/home/xmonad/lib/XMonad/Layout/ResizableTile/FixDescription.hs index 7692147d..18a813cd 100644 --- a/nix/configurations/vanadium/home/xmonad/lib/Leanamonad/Layout/ResizableTile.hs +++ b/nix/configurations/vanadium/home/xmonad/lib/XMonad/Layout/ResizableTile/FixDescription.hs @@ -1,9 +1,8 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} -module Leanamonad.Layout.ResizableTile - ( module XMonad.Layout.ResizableTile - , RTFixDescription(..) +module XMonad.Layout.ResizableTile.FixDescription + ( RTFixDescription(..) ) where import XMonad diff --git a/nix/configurations/vanadium/home/xmonad/xmonad.hs b/nix/configurations/vanadium/home/xmonad/xmonad.hs index d7921849..d4ec6659 100644 --- a/nix/configurations/vanadium/home/xmonad/xmonad.hs +++ b/nix/configurations/vanadium/home/xmonad/xmonad.hs @@ -12,8 +12,10 @@ import XMonad.Hooks.RefocusLast import XMonad.Hooks.StatusBar import XMonad.Layout.NoBorders import XMonad.Layout.Reflect +import XMonad.Layout.Reflect.Message import XMonad.Layout.Renamed import XMonad.Layout.ResizableTile +import XMonad.Layout.ResizableTile.FixDescription import XMonad.Layout.Spacing import qualified XMonad.StackSet as W import XMonad.Util.EZConfig @@ -26,10 +28,7 @@ import qualified Data.Map.Strict as M import System.Posix import Graphics.X11.ExtraTypes.XF86 -import Leanamonad.Layout.ReflectMsg --- TODO: rename this module -import Leanamonad.Layout.ResizableTile -import Leanamonad.GreekChar +import Data.Char.Greek main :: IO () main = From 8139f16952692e6bd1c2edc561e65cc968cb35dc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 5 Nov 2025 09:13:06 +0800 Subject: [PATCH 4/6] vanadium/xmonad: break into small bindings We noticed that this makes error message smaller and easier to understand. --- .../vanadium/home/xmonad/xmonad.hs | 330 +++++++++--------- 1 file changed, 165 insertions(+), 165 deletions(-) diff --git a/nix/configurations/vanadium/home/xmonad/xmonad.hs b/nix/configurations/vanadium/home/xmonad/xmonad.hs index d4ec6659..27a744ad 100644 --- a/nix/configurations/vanadium/home/xmonad/xmonad.hs +++ b/nix/configurations/vanadium/home/xmonad/xmonad.hs @@ -46,170 +46,175 @@ main = , focusFollowsMouse = True , terminal = myTerm , workspaces = myWorkspaces - - , logHook = refocusLastLogHook - - , startupHook = do - spawnOnce "fcitx5 &" -- Input method - - spawn "feh --no-fehbg --bg-fill ~/.wallpaper &" -- wallpaper - - -- Needed to make gnome keyring work - -- https://wiki.archlinux.org/title/GNOME/Keyring#Using_gnome-keyring-daemon_outside_desktop_environments_(KDE,_GNOME,_XFCE,_...) - spawn "dbus-update-activation-environment DISPLAY XAUTHORITY WAYLAND_DISPLAY" - - io $ do - -- This is done here because: - -- - setting `home.sessionVariable` (home-manager) would only effect shells, probably due to the order of launched processes blah blah - -- - setting `environment.sessionVariables` (NixOS) would make my set up less portable - putEnv "GLFW_IM_MODULE=ibus" -- Make sure kitty knows how to talk to fcitx - putEnv "MOZ_USE_XINPUT2=1" -- Force touchpad for firefox - - , layoutHook = - let tallr = renamed [ KeepWordsRight 2 ] {- keep "ResizableTall n" -} - $ smartSpacingWithEdge 5 - $ reflectMsg . reflectHoriz - $ RTFixDescription - $ ResizableTall 1 (1/10) (3/7) [] - mag = magnifyxy 1.05 1.3 (NoMaster 3) False - in avoidStruts . smartBorders $ - mag tallr ||| Full - - , manageHook = - composeAll - [ className ~? "NautilusPreviewer" --> customFloating centeredFloat - , className =? "feh" --> customFloating buttomRightFloat - , className =? "Minder" - <&&> not <$> title ~? "Pick a Color" -- ignore the color picker - --> customFloating centeredFloat - , isFirefoxPIP --> doFloat - - , namedScratchpadManageHook myScratchpads - ] - - <> - composeOne - [ className =? "firefox" -?> insertPosition Master Newer - , className =? "kitty" -?> insertPosition Below Newer - , className `isOneOf` - [ "sioyek" - , "Nautilus" - ] - -?> insertPosition End Older - ] + , logHook = refocusLastLogHook + , startupHook = myStartupHook + , layoutHook = myLayout + , manageHook = myManageHook } - -- Only remove mappings that needs pass through (it's a map). - `removeKeys` - [ (superMask, xK_h) - , (superMask, xK_l) - , (superMask, xK_p) + -- Only remove mappings that needs pass through + `removeKeys` removedKeybinds + `additionalKeys` keybinds - -- It has been more than once that I actidently killed xmonad >:( - , (superMask .|. shiftMask, xK_q) - ] - ++ [ (superMask , n) | n <- [xK_1 .. xK_9] ] - ++ [ (superMask .|. shiftMask, n) | n <- [xK_1 .. xK_9] ] +myLayout = + let tallr = renamed [ KeepWordsRight 2 ] {- keep "ResizableTall n" -} + $ smartSpacingWithEdge 5 + $ reflectMsg . reflectHoriz + $ RTFixDescription + $ ResizableTall 1 (1/10) (3/7) [] + mag = magnifyxy 1.05 1.3 (NoMaster 3) False + in avoidStruts . smartBorders $ + mag tallr ||| Full - `additionalKeys` - [ - -- Display - ((0, xF86XK_MonBrightnessDown), spawn "light -U 5") - , ((0, xF86XK_MonBrightnessUp ), spawn "light -A 5") - , ((shiftMask, xF86XK_MonBrightnessDown), spawn "light -U 1") - , ((shiftMask, xF86XK_MonBrightnessUp ), spawn "light -A 1") - , ((altMask, xF86XK_MonBrightnessUp ), spawn "autorandr --change --ignore-lid") - , ((altMask, xF86XK_MonBrightnessDown), spawn "autorandr --change --ignore-lid") +isOneOf :: Eq a => Query a -> [a] -> Query Bool +isOneOf q = fmap or . traverse (q =?) - -- Volume adjustments - -- Don't overload the mute button - -- In case of doubt, smashing the button becomes deterministic - , ((0, xF86XK_AudioMute), spawn "pactl -- set-sink-mute 0 1" ) -- mute - , ((controlMask, xF86XK_AudioMute), spawn "pactl -- set-sink-mute 0 0" ) -- unmute - , ((0, xF86XK_AudioLowerVolume), spawn "pactl -- set-sink-volume 0 -5%") - , ((0, xF86XK_AudioRaiseVolume), spawn "pactl -- set-sink-volume 0 +5%") - , ((shiftMask, xF86XK_AudioLowerVolume), spawn "pactl -- set-sink-volume 0 -1%") - , ((shiftMask, xF86XK_AudioRaiseVolume), spawn "pactl -- set-sink-volume 0 +1%") +myManageHook :: ManageHook +myManageHook = + composeAll + [ className ~? "NautilusPreviewer" --> customFloating centeredFloat + , className =? "feh" --> customFloating buttomRightFloat + , className =? "Minder" + <&&> not <$> title ~? "Pick a Color" -- ignore the color picker + --> customFloating centeredFloat + , className =? "firefox" + <&&> title =? "Picture-in-Picture" + --> doFloat + , namedScratchpadManageHook myScratchpads + ] + <> composeOne + [ className =? "firefox" -?> insertPosition Master Newer + , className =? "kitty" -?> insertPosition Below Newer + , className `isOneOf` + [ "sioyek" + , "Nautilus" + ] + -?> insertPosition End Older + ] - -- Playback control - , ((0, xF86XK_AudioPrev), spawn "playerctl previous" ) - , ((0, xF86XK_AudioPlay), spawn "playerctl play-pause") - , ((0, xF86XK_AudioNext), spawn "playerctl next" ) +myStartupHook :: X () +myStartupHook = do + spawnOnce "fcitx5 &" -- Input method - -- Toggle fullscreen - , ((superMask, xK_Escape), sendMessage NextLayout) + spawn "feh --no-fehbg --bg-fill ~/.wallpaper &" -- wallpaper - -- Resize windows - , ((superMask, xK_equal ), sendMessage $ IncMasterN 1) - , ((superMask, xK_minus ), sendMessage $ IncMasterN -1) - , ((superMask, xK_comma ), sendMessage Shrink ) - , ((superMask, xK_period ), sendMessage Expand ) - , ((superMask .|. shiftMask, xK_comma ), sendMessage MirrorShrink ) - , ((superMask .|. shiftMask, xK_period), sendMessage MirrorExpand ) - , ((superMask , xK_apostrophe), sendMessage Toggle ) + -- Needed to make gnome keyring work + -- https://wiki.archlinux.org/title/GNOME/Keyring#Using_gnome-keyring-daemon_outside_desktop_environments_(KDE,_GNOME,_XFCE,_...) + spawn "dbus-update-activation-environment DISPLAY XAUTHORITY WAYLAND_DISPLAY" - -- [D]o sink and lift - , ( (superMask, xK_d) - , submap $ M.fromList - [ ((0, xK_t), withFocused $ windows . W.sink) - , ((0, xK_l), withFocused $ windows . flip W.float centeredFloat) - ] - ) - ] + io $ do + -- This is done here because: + -- - setting `home.sessionVariable` (home-manager) would only effect shells, probably due to the order of launched processes blah blah + -- - setting `environment.sessionVariables` (NixOS) would make my set up less portable + putEnv "GLFW_IM_MODULE=ibus" -- Make sure kitty knows how to talk to fcitx + putEnv "MOZ_USE_XINPUT2=1" -- Force touchpad for firefox - -- Screenshots - ++ (let - fullscreen = "maim -u | xclip -in -selection clipboard -t image/png" +removedKeybinds :: [(KeyMask, KeySym)] +removedKeybinds = + [ (superMask, xK_h) + , (superMask, xK_l) + , (superMask, xK_p) + + -- It has been more than once that I actidently killed xmonad >:( + , (superMask .|. shiftMask, xK_q) + ] + ++ [ (superMask , n) | n <- [xK_1 .. xK_9] ] + ++ [ (superMask .|. shiftMask, n) | n <- [xK_1 .. xK_9] ] + +keybinds :: [((KeyMask, KeySym), X ())] +keybinds = + [ + -- Display + ((0, xF86XK_MonBrightnessDown), spawn "light -U 5") + , ((0, xF86XK_MonBrightnessUp ), spawn "light -A 5") + , ((shiftMask, xF86XK_MonBrightnessDown), spawn "light -U 1") + , ((shiftMask, xF86XK_MonBrightnessUp ), spawn "light -A 1") + , ((altMask, xF86XK_MonBrightnessUp ), spawn "autorandr --change --ignore-lid") + , ((altMask, xF86XK_MonBrightnessDown), spawn "autorandr --change --ignore-lid") + + -- Volume adjustments + -- Don't overload the mute button + -- In case of doubt, smashing the button becomes deterministic + , ((0, xF86XK_AudioMute), spawn "pactl -- set-sink-mute 0 1" ) -- mute + , ((controlMask, xF86XK_AudioMute), spawn "pactl -- set-sink-mute 0 0" ) -- unmute + , ((0, xF86XK_AudioLowerVolume), spawn "pactl -- set-sink-volume 0 -5%") + , ((0, xF86XK_AudioRaiseVolume), spawn "pactl -- set-sink-volume 0 +5%") + , ((shiftMask, xF86XK_AudioLowerVolume), spawn "pactl -- set-sink-volume 0 -1%") + , ((shiftMask, xF86XK_AudioRaiseVolume), spawn "pactl -- set-sink-volume 0 +1%") + + -- Playback control + , ((0, xF86XK_AudioPrev), spawn "playerctl previous" ) + , ((0, xF86XK_AudioPlay), spawn "playerctl play-pause") + , ((0, xF86XK_AudioNext), spawn "playerctl next" ) + + -- Toggle fullscreen + , ((superMask, xK_Escape), sendMessage NextLayout) + + -- Resize windows + , ((superMask, xK_equal ), sendMessage $ IncMasterN 1) + , ((superMask, xK_minus ), sendMessage $ IncMasterN -1) + , ((superMask, xK_comma ), sendMessage Shrink ) + , ((superMask, xK_period ), sendMessage Expand ) + , ((superMask .|. shiftMask, xK_comma ), sendMessage MirrorShrink ) + , ((superMask .|. shiftMask, xK_period), sendMessage MirrorExpand ) + , ((superMask , xK_apostrophe), sendMessage Toggle ) + + -- [D]o sink and lift + , ( (superMask, xK_d) + , submap $ M.fromList + [ ((0, xK_t), withFocused $ windows . W.sink) + , ((0, xK_l), withFocused $ windows . flip W.float centeredFloat) + ] + ) + ] + + -- Screenshots + ++ (let fullscreen = "maim -u | xclip -in -selection clipboard -t image/png" withSelection = "maim -u -s -b 5 -o | xclip -in -selection clipboard -t image/png" toFloat = "maim -u -s -b 5 -o | feh --auto-zoom -" - in - [ ((0, xK_Print), spawn fullscreen ) - , ((superMask .|. shiftMask, xK_3 ), spawn fullscreen ) - , ((superMask .|. shiftMask, xK_4 ), spawn withSelection) - , ((superMask .|. shiftMask, xK_5 ), spawn toFloat ) - ]) + in [ ((0, xK_Print), spawn fullscreen ) + , ((superMask .|. shiftMask, xK_3 ), spawn fullscreen ) + , ((superMask .|. shiftMask, xK_4 ), spawn withSelection) + , ((superMask .|. shiftMask, xK_5 ), spawn toFloat ) + ] + ) - -- Yeet - ++ (let - workspaceKeys = [xK_h, xK_t, xK_n, xK_s, xK_m, xK_w, xK_v, xK_z] - in - [ ((superMask, k), windows $ W.greedyView space) - | (k, space) <- zip workspaceKeys myWorkspaces - ] - ++ - [ ((superMask .|. altMask, k), windows $ W.greedyView space . W.shift space) - | (k, space) <- zip workspaceKeys myWorkspaces - ] - ++ - [ ((superMask .|. controlMask, k), windows $ swapWithCurrent space) - | (k, space) <- zip workspaceKeys myWorkspaces - ]) + -- Yeet + ++ (let workspaceKeys = [xK_h, xK_t, xK_n, xK_s, xK_m, xK_w, xK_v, xK_z] + in [ ((superMask, k), windows $ W.greedyView space) + | (k, space) <- zip workspaceKeys myWorkspaces + ] + ++ [ ((superMask .|. altMask, k), windows $ W.greedyView space . W.shift space) + | (k, space) <- zip workspaceKeys myWorkspaces + ] + ++ [ ((superMask .|. controlMask, k), windows $ swapWithCurrent space) + | (k, space) <- zip workspaceKeys myWorkspaces + ] + ) - -- Launcher - ++ (let - launchFirefox = "if type firefox; then firefox; else firefox-esr; fi" + -- Launcher + ++ (let launchFirefox = "if type firefox; then firefox; else firefox-esr; fi" launchDmenu = "dmenu_run -i -fn \"Iosevka-14\" -nb \"#36363a\" -nf \"#e2e2e4\" -sb \"#f7f7f8\" -sf \"#36363a\" -l 10" lock = "xscreensaver-command -lock" - in - [ ((controlMask .|. altMask, xK_m), namedScratchpadAction myScratchpads "cmus" ) - , ((controlMask .|. altMask, xK_t), namedScratchpadAction myScratchpads "btop" ) - , ((controlMask .|. altMask, xK_p), namedScratchpadAction myScratchpads "pass" ) - , ((controlMask .|. altMask, xK_e), namedScratchpadAction myScratchpads "emoji-picker") - , ((controlMask .|. altMask, xK_b), spawn launchFirefox ) - , ((superMask, xK_o), spawn launchDmenu ) - , ((superMask, xK_l), spawn lock ) - ]) + in [ ((controlMask .|. altMask, xK_m), namedScratchpadAction myScratchpads "cmus" ) + , ((controlMask .|. altMask, xK_t), namedScratchpadAction myScratchpads "btop" ) + , ((controlMask .|. altMask, xK_p), namedScratchpadAction myScratchpads "pass" ) + , ((controlMask .|. altMask, xK_e), namedScratchpadAction myScratchpads "emoji-picker") + , ((controlMask .|. altMask, xK_b), spawn launchFirefox ) + , ((superMask, xK_o), spawn launchDmenu ) + , ((superMask, xK_l), spawn lock ) + ] + ) - ++ (let - powerprofile p = (p, spawn $ "powerprofilesctl set " ++ p) - in - [ ( (superMask, xK_p), visualSubmap def $ M.fromList - [ ((0, xK_1), powerprofile "power-saver") - , ((0, xK_2), powerprofile "balanced" ) - , ((0, xK_3), powerprofile "performance") - ] - ) - ]) + ++ (let powerprofile p = (p, spawn $ "powerprofilesctl set " ++ p) + in [ ( (superMask, xK_p), visualSubmap def $ M.fromList + [ ((0, xK_1), powerprofile "power-saver") + , ((0, xK_2), powerprofile "balanced" ) + , ((0, xK_3), powerprofile "performance") + ] + ) + ] + ) myTerm :: String myTerm = "kitty" @@ -219,13 +224,13 @@ superMask = mod4Mask altMask = mod1Mask myWorkspaces :: [String] -myWorkspaces = take 8 . fmap (:[]) $ greekLower +myWorkspaces = map (:[]) $ take 8 greekLower centeredFloat, smallFloat, fullFloat, buttomRightFloat :: W.RationalRect -centeredFloat = W.RationalRect (1/9) (1/9) (7/9) (7/9) -smallFloat = W.RationalRect (3/5) (3/5) (2/7) (2/7) -fullFloat = W.RationalRect 0 0 1 1 -buttomRightFloat = W.RationalRect (1/2) (1/2) (1/2) (1/2) +centeredFloat = W.RationalRect (1/9) (1/9) (7/9) (7/9) +smallFloat = W.RationalRect (3/5) (3/5) (2/7) (2/7) +fullFloat = W.RationalRect 0 0 1 1 +buttomRightFloat = W.RationalRect (1/2) (1/2) (1/2) (1/2) xmobarConfig :: StatusBarConfig xmobarConfig = statusBarProp "xmobar -x 0" (pure myPrettyPrinter) @@ -238,30 +243,25 @@ xmobarConfig = statusBarProp "xmobar -x 0" (pure myPrettyPrinter) , ppSep = " | " } - -isOneOf :: Eq a => Query a -> [a] -> Query Bool -isOneOf q = fmap or . traverse (q =?) - -isFirefoxPIP :: Query Bool -isFirefoxPIP = - className =? "firefox" - <&&> title =? "Picture-in-Picture" - myScratchpads :: [NamedScratchpad] myScratchpads = - [ NS "cmus" + [ NS + "cmus" (myTerm ++ " -T 'cmus' cmus") (title =? "cmus") (customFloating centeredFloat) - , NS "btop" + , NS + "btop" (myTerm ++ " -T 'btop' btop") (title =? "btop") (customFloating fullFloat) - , NS "pass" + , NS + "pass" (myTerm ++ " -T 'pass' -- fish -i -c 'while :; fzf-pass; end'") (title =? "pass") (customFloating smallFloat) - , NS "emoji-picker" + , NS + "emoji-picker" (myTerm ++ " -T 'emoji-picker' -- fish -i -c 'while :; emoji-picker; end'") (title =? "emoji-picker") (customFloating smallFloat) From 5587ce4ce7b80b31f5f3ab361ecaad2af62b4c64 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 5 Nov 2025 09:25:49 +0800 Subject: [PATCH 5/6] vanadium/connectivity: remove braincell purification block on youtube --- nix/configurations/vanadium/nixos/connectivity.nix | 2 -- 1 file changed, 2 deletions(-) diff --git a/nix/configurations/vanadium/nixos/connectivity.nix b/nix/configurations/vanadium/nixos/connectivity.nix index b2f9a380..29927865 100644 --- a/nix/configurations/vanadium/nixos/connectivity.nix +++ b/nix/configurations/vanadium/nixos/connectivity.nix @@ -61,8 +61,6 @@ # Gotta purify my smoos brain for a while 0.0.0.0 instagram.com 0.0.0.0 www.instagram.com - 0.0.0.0 youtube.com - 0.0.0.0 www.youtube.com ''; }; From 9bf39623d67c1eeb3dee2eb52fe4aa7391576c9a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 5 Nov 2025 17:57:52 +0800 Subject: [PATCH 6/6] packages/ruler: update --- nix/packages/by-name/ruler/package.nix | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/nix/packages/by-name/ruler/package.nix b/nix/packages/by-name/ruler/package.nix index e217fae0..fb88291c 100644 --- a/nix/packages/by-name/ruler/package.nix +++ b/nix/packages/by-name/ruler/package.nix @@ -12,8 +12,8 @@ domain = "git.confusedcompiler.org"; owner = "leana8959"; repo = "ruler"; - rev = "12b287522215781b21791101bf85f8a0dddd1225"; - hash = "sha256-XoTTxKxlUmtM9mxguwdEsMSp6qBkEgBcviM8bTgs95o="; + rev = "f328620a52b25d4c9dea64425afe5995dfb8cb5a"; + hash = "sha256-8nSVFckWXkf9dRTdzjbHRhf/qPdbXHEkVI4DyW3zfSo="; }) {};