mirror of
https://codeberg.org/leana8959/.files.git
synced 2025-12-06 22:59:15 +00:00
311 lines
12 KiB
Haskell
311 lines
12 KiB
Haskell
{-# LANGUAGE NegativeLiterals #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
|
|
import XMonad
|
|
import XMonad.Actions.Submap
|
|
import XMonad.Actions.SwapWorkspaces
|
|
import XMonad.Hooks.DynamicLog
|
|
import XMonad.Hooks.EwmhDesktops
|
|
import XMonad.Hooks.FadeWindows
|
|
import XMonad.Hooks.InsertPosition
|
|
import XMonad.Hooks.ManageDocks
|
|
import XMonad.Hooks.ManageHelpers
|
|
import XMonad.Hooks.RefocusLast
|
|
import XMonad.Hooks.StatusBar
|
|
import XMonad.Layout.NoBorders
|
|
import XMonad.Layout.Reflect
|
|
import XMonad.Layout.Renamed
|
|
import XMonad.Layout.ResizableTile
|
|
import XMonad.Layout.Spacing
|
|
import XMonad.StackSet qualified as W
|
|
import XMonad.Util.EZConfig
|
|
import XMonad.Util.Hacks
|
|
import XMonad.Util.NamedScratchpad
|
|
import XMonad.Util.SpawnOnce
|
|
import XMonad.Layout.Magnifier
|
|
|
|
import Data.Map.Strict qualified as M
|
|
import Data.Monoid
|
|
import System.Posix
|
|
import Graphics.X11.ExtraTypes.XF86
|
|
|
|
import Leanamonad.Layouts.ReflectMsg
|
|
import Leanamonad.GreekChar
|
|
|
|
main :: IO ()
|
|
main =
|
|
xmonad
|
|
-- Fix all java things that don't scale with XMonad
|
|
-- https://wiki.archlinux.org/title/java#Gray_window,_applications_not_resizing_with_WM,_menus_immediately_closing
|
|
. javaHack
|
|
. withSB xmobarConfig . docks
|
|
. ewmhFullscreen . ewmh
|
|
$ def
|
|
{ modMask = superMask
|
|
, borderWidth = 5
|
|
, normalBorderColor = "#18005f"
|
|
, focusedBorderColor = "#875fff"
|
|
, focusFollowsMouse = True
|
|
, terminal = myTerm
|
|
, workspaces = myWorkspaces
|
|
|
|
, logHook =
|
|
let
|
|
fadeHook =
|
|
composeOne
|
|
[ -- easier to paint over stuff
|
|
isFloating
|
|
<&&> isFocused
|
|
<&&> title ~? "Wplace"
|
|
-?> transparency 0.5
|
|
|
|
-- matches the second string of the WM_CLASS
|
|
, className `isOneOf`
|
|
[ "firefox"
|
|
, "Signal"
|
|
, "steam"
|
|
, "discord"
|
|
]
|
|
-?> opaque
|
|
|
|
, isFloating -?> ifM isFocused (transparency 0.04) (transparency 0.08)
|
|
, isUnfocused -?> transparency 0.02
|
|
]
|
|
in
|
|
fadeWindowsLogHook fadeHook
|
|
<> 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 = named "Normal"
|
|
$ smartSpacingWithEdge 5
|
|
$ reflectMsg . reflectHoriz
|
|
$ ResizableTall 1 (1/10) (3/7) []
|
|
mag = magnifyxy 1.05 1.3 (NoMaster 3) False
|
|
in avoidStruts . smartBorders $
|
|
mag tallr ||| Full
|
|
|
|
, manageHook =
|
|
let
|
|
hasEvenWindows :: X Bool
|
|
hasEvenWindows = g <$> get
|
|
where g = even . length . W.integrate'
|
|
. W.stack . W.workspace . W.current . windowset
|
|
|
|
-- When having a lot of windows this will converge into the middle of the stack
|
|
insertInMiddle :: Query (Endo WindowSet)
|
|
insertInMiddle =
|
|
ifM
|
|
(liftX hasEvenWindows)
|
|
(insertPosition Below Newer) -- New window is odd
|
|
(insertPosition Above Newer) -- New window is even
|
|
in
|
|
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
|
|
, Just <$> insertInMiddle
|
|
]
|
|
}
|
|
|
|
-- Only remove mappings that needs pass through (it's a map).
|
|
`removeKeys`
|
|
[ (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] ]
|
|
|
|
`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")
|
|
|
|
-- 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 )
|
|
])
|
|
|
|
-- 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"
|
|
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 )
|
|
])
|
|
|
|
++ (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"
|
|
|
|
superMask, altMask :: KeyMask
|
|
superMask = mod4Mask
|
|
altMask = mod1Mask
|
|
|
|
myWorkspaces :: [String]
|
|
myWorkspaces = take 8 . fmap (:[]) $ 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)
|
|
|
|
xmobarConfig :: StatusBarConfig
|
|
xmobarConfig = statusBarProp "xmobar -x 0" (pure myPrettyPrinter)
|
|
where
|
|
myPrettyPrinter =
|
|
filterOutWsPP [scratchpadWorkspaceTag]
|
|
$ def
|
|
{ ppCurrent = xmobarColor "#000000" "#ffffff" . wrap " " " " . fmap toUpper
|
|
, ppHiddenNoWindows = xmobarColor "#9c9c9c" "" . const "⋅"
|
|
, ppSep = " | "
|
|
}
|
|
|
|
|
|
isOneOf :: Eq a => Query a -> [a] -> Query Bool
|
|
isOneOf q = fmap or . traverse (q =?)
|
|
|
|
isFocused :: Query Bool
|
|
isFocused = fmap not isUnfocused
|
|
|
|
isFirefoxPIP :: Query Bool
|
|
isFirefoxPIP =
|
|
className =? "firefox"
|
|
<&&> title =? "Picture-in-Picture"
|
|
|
|
myScratchpads :: [NamedScratchpad]
|
|
myScratchpads =
|
|
[ NS "cmus"
|
|
(myTerm ++ " -T 'cmus' cmus")
|
|
(title =? "cmus")
|
|
(customFloating centeredFloat)
|
|
, NS "btop"
|
|
(myTerm ++ " -T 'btop' btop")
|
|
(title =? "btop")
|
|
(customFloating fullFloat)
|
|
, NS "pass"
|
|
(myTerm ++ " -T 'pass' -- fish -i -c 'while :; fzf-pass; end'")
|
|
(title =? "pass")
|
|
(customFloating smallFloat)
|
|
, NS "emoji-picker"
|
|
(myTerm ++ " -T 'emoji-picker' -- fish -i -c 'while :; emoji-picker; end'")
|
|
(title =? "emoji-picker")
|
|
(customFloating smallFloat)
|
|
]
|