Created
September 10, 2025 09:25
-
-
Save Aster89/34747b2ef46bb5e21cc634a87c1d2db1 to your computer and use it in GitHub Desktop.
My xmonad config
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# LANGUAGE LambdaCase #-} | |
| import XMonad | |
| import XMonad.Hooks.DynamicLog | |
| import XMonad.Hooks.EwmhDesktops | |
| import XMonad.Hooks.RefocusLast (refocusLastLayoutHook) | |
| import XMonad.Hooks.StatusBar | |
| import XMonad.Hooks.StatusBar.PP | |
| import XMonad.Layout.FocusTracking (focusTracking) | |
| import XMonad.Layout.NoBorders | |
| import XMonad.Layout.Spacing | |
| import XMonad.StackSet | |
| import XMonad.Util.Dmenu | |
| import XMonad.Util.EZConfig (additionalKeysP) | |
| import XMonad.Util.Loggers | |
| import XMonad.Util.ClickableWorkspaces | |
| import XMonad.Util.Run | |
| import Control.Monad (join) | |
| import Data.Sequences (toLower) | |
| import Data.Functor ((<&>)) | |
| import Flow ((.>)) | |
| import System.Exit (exitSuccess) | |
| main :: IO () | |
| main = xmonad | |
| . ewmhFullscreen | |
| . ewmh | |
| . withEasySB (statusBarProp (unwords [xmobarexe, xmobarhs]) (clickablePP myXmobarPP)) toggleStrutsKey | |
| $ myConfig | |
| where | |
| toggleStrutsKey XConfig { modMask = m } = (m, xK_b) | |
| xmobarhs = "~/.config/xmobar/xmobar.hs" | |
| xmobarexe = "xmobar" | |
| myXmobarPP :: PP | |
| myXmobarPP = def { | |
| ppSep = " | ", -- | |
| ppTitleSanitize = xmobarStrip, | |
| ppCurrent = wrap " " "" . xmobarBorder "Top" "#00ffff" 2, | |
| ppHidden = white . wrap " " "", | |
| ppHiddenNoWindows = const "", | |
| ppUrgent = red . wrap (yellow "!") (yellow "!"), | |
| ppOrder = \[ws, l, _, wins] -> [ws, l, wins], | |
| ppExtras = [logTitles formatFocused formatUnfocused] | |
| } | |
| where | |
| formatFocused = wrap (white "[") (white "]") . green . ppWindow | |
| formatUnfocused = wrap (lowWhite "[") (lowWhite "]") . blue . ppWindow | |
| ppWindow :: String -> String | |
| ppWindow = xmobarRaw . (\w -> if null w then "untitled" else w) . shorten 30 | |
| blue, lowWhite, green, red, white, yellow :: String -> String | |
| green = xmobarColor "#00ffff" "" | |
| blue = xmobarColor "#bd93f9" "" | |
| white = xmobarColor "#f8f8f2" "" | |
| yellow = xmobarColor "#f1fa8c" "" | |
| red = xmobarColor "#ff5555" "" | |
| lowWhite = xmobarColor "#777777" "" | |
| myConfig = def | |
| { terminal = "urxvt" | |
| , modMask = mod4Mask | |
| , borderWidth = 3 | |
| , normalBorderColor = "grey" | |
| , focusedBorderColor = "green" | |
| , layoutHook = smartBorders myLayout | |
| } | |
| `additionalKeysP` myKeys | |
| myKeys = ("M-<Space>", sendMessage NextLayout) | |
| : ("M-S-q", quitXMonadConfirm) | |
| : ("M-<End>", shutDownMenu) | |
| : ("M-S-z", spawn "systemctl suspend") | |
| : ("M-S-<Space>", spawn "rofi -show combi -theme sidebar.rasi") | |
| : ("<XF86HomePage>", spawn "qutebrowser") | |
| : ("<XF86Calculator>", spawn "urxvt -e calc") | |
| : ("<XF86Explorer>", spawn "urxvt -e ranger") | |
| -- TODO: XF86Mail | |
| -- TODO: scroll lock | |
| -- TODO: game mode | |
| -- TODO: M-S-XF86Menu for changing keyboard layout | |
| : ("<XF86AudioRaiseVolume>", spawn "amixer -q -D pulse set Master 1%+ unmute") | |
| : ("<XF86AudioLowerVolume>", spawn "amixer -q -D pulse set Master 1%- unmute") | |
| : ("S-<XF86AudioRaiseVolume>", spawn "amixer -q -D pulse set Master 5%+ unmute") | |
| : ("S-<XF86AudioLowerVolume>", spawn "amixer -q -D pulse set Master 5%- unmute") | |
| : ("<XF86AudioMute>", spawn "pactl set-sink-mute 0 toggle") | |
| : ("<XF86AudioPlay>", spawn "playerctl play-pause") | |
| : ("<XF86AudioStop>", spawn "playerctl stop") | |
| : ("<XF86AudioPrev>", spawn "playerctl previous") | |
| : ("<XF86AudioNext>", spawn "playerctl next") | |
| : ("S-<Print>", spawn "flameshot") | |
| : ("<Print>", spawn "flameshot gui") | |
| : [(otherModMasks ++ "M-" ++ key, action tag) | (key, tag) <- join zip (map pure "123456789"), | |
| (otherModMasks, action) <- [("", view .> windows), ("S-", shift .> windows)]] | |
| myLayout = spacingRaw True (Border 10 0 10 0) True (Border 0 10 0 10) True layouts | |
| where tall = Tall 1 (3/100) (1/2) | |
| layouts = refocusLastLayoutHook | |
| $ focusTracking | |
| -- $ avoidStruts -- XXX what is this for? | |
| $ tall ||| Mirror tall ||| Full | |
| xmobarBGcolor = "#1f222d" | |
| dMenu opts = menuArgs "dmenu" (opts ++ ["-b", "-nb", xmobarBGcolor]) | |
| yesNoMenu = toLower <$> dMenu ["-p", "Are you sure?"] ["Yes", "No"] | |
| shutDownMenu :: X () | |
| shutDownMenu = do | |
| choice <- dMenu [] $ map fst actions | |
| case lookup choice actions of | |
| (Just action) -> spawn action | |
| Nothing -> return () | |
| where | |
| actions = [("suspend","systemctl suspend"), | |
| ("shutdown","systemctl poweroff"), | |
| ("screenoff","xset dpms force off"), | |
| ("reboot","systemctl reboot")] | |
| quitXMonadConfirm :: X () | |
| quitXMonadConfirm = yesNoMenu >>= \case "yes" -> io exitSuccess | |
| _ -> return () |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment