Skip to content

Instantly share code, notes, and snippets.

@entropie

entropie/xmonad.hs

Created August 26, 2024 15:45
Show Gist options
  • Save entropie/c8072585593b784bff9b8af95c187b5d to your computer and use it in GitHub Desktop.
Save entropie/c8072585593b784bff9b8af95c187b5d to your computer and use it in GitHub Desktop.
Download ZIP
xmonad.hs 2024, a decade old
Raw
xmonad.hs
{-# OPTIONS_GHC -Wno-deprecations #-}
import XMonad
import System.IO
import XMonad.Actions.CycleWS
import XMonad.Actions.FloatKeys
import XMonad.Actions.SpawnOn
import XMonad.Config.Gnome
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.SetWMName (setWMName)
import XMonad.Layout.Accordion
import XMonad.Layout.Named
import XMonad.Layout.NoBorders
import XMonad.Layout.Tabbed
import XMonad.Layout.ToggleLayouts
import XMonad.Layout.PerWorkspace
import XMonad.Layout.LayoutHints
import XMonad.Layout.ThreeColumns
import XMonad.Layout.OneBig
import XMonad.Prompt
import XMonad.Prompt.Shell
import XMonad.Util.Run(spawnPipe)
import XMonad.Util.SpawnOnce
import XMonad.Util.NamedScratchpad
import XMonad.Hooks.FadeInactive
import XMonad.Hooks.ManageHelpers
import XMonad.Actions.Submap
import XMonad.Actions.GridSelect
import XMonad.Util.EZConfig
import qualified Data.Map as M
import XMonad.Hooks.EwmhDesktops as E
import qualified XMonad.StackSet as W
import XMonad.Hooks.EwmhDesktops (ewmh)
-- Paths
myBitmapsPath = "/home/mit/.xmonad/xbm/"
-- Font
myFont = "-*-monaco-*-*-*-*-12-*-*-*-*-*-*-*"
-- Colors
myBgBgColor = "black"
myFgColor = "lightgreen"
myBgColor = "black"
myHighlightedFgColor = "lightgreen"
myHighlightedBgColor = "gray40"
myActiveBorderColor = "gray80"
myInactiveBorderColor = "gray20"
myCurrentWsFgColor = "white"
myCurrentWsBgColor = "gray40"
myVisibleWsFgColor = "gold"
myVisibleWsBgColor = "gray20"
myHiddenWsFgColor = "gray80"
myHiddenEmptyWsFgColor = "gray50"
myUrgentWsBgColor = "brown"
myTitleFgColor = "lightgreen"
myUrgencyHintFgColor = "white"
myUrgencyHintBgColor = "brown"
-- dzen general options
myDzenGenOpts = "-fg '" ++ myFgColor ++ "' -bg '" ++ myBgColor ++ "' -fn '" ++ myFont ++ "' -h '16' -dock "
-- Status Bar
myStatusBar = "$DZEN_STATUS_OPTS " ++ myDzenGenOpts
-- Conky Bar
-- myConkyBar = "conky -c ~/.conkyrc | dzen2 -ta r -x 1200 -w 848 -xs 0 " ++ myDzenGenOpts
myConkyBar = "conky -c ~/.conkyrc.$(hostname) | $DZEN_OPTS " ++ myDzenGenOpts
myXPConfig = def {
position = Bottom,
promptBorderWidth = 0,
height = 15,
bgColor = myBgColor,
fgColor = myFgColor,
fgHLight = myHighlightedFgColor,
bgHLight = myHighlightedBgColor
}
myKeys = [
((mod4Mask, xK_p), shellPrompt myXPConfig)
, ((mod4Mask, xK_q), spawn "killall conky dzen2 xxkb; xmonad --recompile; xmonad --restart")
, ((mod4Mask .|. shiftMask, xK_q), spawn "killall conky dzen2 xxkb xmonad-x86_64-linux")
, ((mod4Mask, xK_b), sendMessage ToggleStruts)
, ((mod4Mask, xK_period), prevScreen)
, ((mod4Mask, xK_comma), nextScreen)
, ((mod4Mask, xK_y), toggleWS' ["NSP"])
, ((mod4Mask, xK_f), sendMessage (XMonad.Layout.ToggleLayouts.Toggle "Full"))
, ((mod4Mask .|. shiftMask,xK_a), spawn "transset -a --dec .05")
, ((mod4Mask, xK_a), spawn "transset -a --inc .05")
, ((mod4Mask, xK_u), spawn "redshift -o -P -l 51.31577526265084:12.37111980340817")
, ((mod4Mask .|. shiftMask,xK_u), spawn "redshift -x")
-- , ((mod4Mask, xK_g), goToSelected defaultGSConfig)
, ((mod4Mask, xK_m), submap . M.fromList $
[ ((0, xK_n), spawn "M next")
, ((0, xK_p), spawn "M prev")
, ((0, xK_space), spawn "M play")
])
, ((mod4Mask, xK_x), namedScratchpadAction scratchpads "copyq")
, ((mod4Mask, xK_s), namedScratchpadAction scratchpads "term")
, ((mod4Mask .|. shiftMask, xK_s), namedScratchpadAction scratchpads "music")
, ((mod4Mask .|. controlMask, xK_s ), namedScratchpadAction scratchpads "volume")
]
myMouseBindings = [
-- ((mod4Mask, button1), (\_ -> windows W.focusDown ))
-- , ((mod4Mask, button3), (\_ -> windows W.focusUp ))
]
customPP :: PP
customPP = def {
ppHidden = xmobarColor "#5e5c4e" ""
, ppCurrent = xmobarColor "#0C9CB3" "" . wrap "[" "]"
, ppUrgent = xmobarColor "#a3b064" "" . wrap "*" "*"
, ppLayout = xmobarColor "#a3b064" ""
, ppTitle = xmobarColor "#d4ff19" "" . shorten 255
, ppSep = "<fc=#5e5c4e> | </fc>"
}
myStartupHook = do
setWMName "LG3D"
-- Workspaces
myWorkspaces =
[
wrapBitmap "arch_10x10.xbm",
wrapBitmap "bug_02.xbm",
wrapBitmap "fox.xbm",
wrapBitmap "empty.xbm",
wrapBitmap "dish.xbm",
wrapBitmap "cat.xbm",
wrapBitmap "shroom.xbm",
wrapBitmap "eye_l.xbm",
wrapBitmap "eye_r.xbm"
]
where
wrapBitmap bitmap = "^p(5)^i(" ++ myBitmapsPath ++ bitmap ++ ")^p(5)"
termWs = (myWorkspaces !! 0)
devWs = (myWorkspaces !! 1)
webWs = (myWorkspaces !! 2)
tempWs = (myWorkspaces !! 3)
imWs = (myWorkspaces !! 4)
atermWs = (myWorkspaces !! 5)
misc2Ws = (myWorkspaces !! 6)
mediaWS = (myWorkspaces !! 7)
gxfWs = (myWorkspaces !! 8)
-- Layouts
myLayoutHook =
-- $ onWorkspace devWs dev
gtiled ||| ogrid ||| htiled
where
gtiled = named "GTiled"
$ Tall 1 (5/100) (1/2)
ogrid = named "Ogrid"
$ ThreeColMid 1 (3/100) (1/2)
tiledM = named "Tiled"
$ Tall 1 (5/100) (2/(1+(toRational(sqrt(5)::Double))))
htiled = named "HTiled"
$ OneBig (3/4) (3/4)
nmaster = 1
delta = 3/100
ratio = 1/2
scratchpads :: [NamedScratchpad]
scratchpads =
[ NS "music" "kitty --title Music -e zsh -c \"ncmpcpp\""
(title =? "Music")
(customFloating $ W.RationalRect (1/4) (1/4) (2/4) (2/4))
-- , NS "term" "urxvt -title Scratchpad -e tmux -uLmain attach -t1"
, NS "term" "kitty --title scratchpad --name scratchpad -e zsh -c \"tmux attach -t scratchpad || tmux new-session -s scratchpad\""
(title =? "scratchpad")
(customFloating $ W.RationalRect (0) (0) (1) (1))
, NS "volume" "pavucontrol"
(className =? "Pavucontrol")
(customFloating $ W.RationalRect (1/4) (1/4) (2/4) (2/4))
, NS "copyq" "copyq toggle"
(className =? "copyq")
(customFloating $ W.RationalRect (1/4) (1/4) (2/4) (2/4))
]
-- I like to have these floating windows transparent
myNSManageHook :: NamedScratchpads -> ManageHook
myNSManageHook s =
namedScratchpadManageHook s
<+> composeOne
[ title =? "Music"
-?> (ask >>= \w -> liftX (setOpacity w 0.7) >> idHook)
, title =? "scratchpad"
-?> (ask >>= \w -> liftX (setOpacity w 1) >> idHook)
, className =? "Pavucontrol"
-?> (ask >>= \w -> liftX (setOpacity w 0.8) >> idHook)
, className =? "copyq"
-?> (ask >>= \w -> liftX (setOpacity w 0.8) >> idHook)
]
main = do
myStatusBarPipe <- spawnPipe myStatusBar
conkyBar <- spawnPipe myConkyBar
xmonad $ ewmh $ docks $ gnomeConfig {
manageHook = myManageHook <+> manageHook gnomeConfig
, layoutHook = avoidStruts $ XMonad.Layout.ToggleLayouts.toggleLayouts (noBorders $ Full) $ (smartBorders $ myLayoutHook)
, logHook = dynamicLogWithPP $ myDzenPP myStatusBarPipe
, startupHook = myStartupHook
, focusFollowsMouse = False
, modMask = mod4Mask
, terminal = "kitty"
-- , handleEventHook = E.fullscreenEventHook
, handleEventHook = E.fullscreenEventHook
, normalBorderColor = myInactiveBorderColor
, focusedBorderColor = myActiveBorderColor
, workspaces = myWorkspaces
} `additionalKeys` myKeys `additionalMouseBindings` myMouseBindings
-- Dzen config
myDzenPP h = def {
ppOutput = hPutStrLn h,
ppSep = "^bg(" ++ myBgBgColor ++ ")^r(1,15)^bg()",
ppSort = fmap (namedScratchpadFilterOutWorkspace.) (ppSort xmobarPP),
ppWsSep = "",
ppCurrent = wrapFgBg myCurrentWsFgColor myCurrentWsBgColor,
ppVisible = wrapFgBg myVisibleWsFgColor myVisibleWsBgColor,
ppHidden = wrapFg myHiddenWsFgColor,
ppHiddenNoWindows = wrapFg myHiddenEmptyWsFgColor,
ppUrgent = wrapBg myUrgentWsBgColor,
ppTitle = (\x -> " " ++ wrapFg myTitleFgColor x),
ppLayout = dzenColor myFgColor"" .
(\x -> case x of
"Tiled" -> wrapBitmap "mtall.xbm"
"HTiled" -> wrapBitmap "mtall.xbm"
"Dev" -> wrapBitmap "bug_01.xbm"
"GTiled" -> wrapBitmap "tall.xbm"
"Ogrid " -> wrapBitmap "pacman.xbm"
"IM" -> wrapBitmap "pacman.xbm"
"Full" -> wrapBitmap "full.xbm"
_ -> wrapBitmap "empty.xbm"
)
}
where
wrapFgBg fgColor bgColor content= wrap ("^fg(" ++ fgColor ++ ")^bg(" ++ bgColor ++ ")") "^fg()^bg()" content
wrapFg color content = wrap ("^fg(" ++ color ++ ")") "^fg()" content
wrapBg color content = wrap ("^bg(" ++ color ++ ")") "^bg()" content
wrapBitmap bitmap = "^p(5)^i(" ++ myBitmapsPath ++ bitmap ++ ")^p(5)"
myManageHook :: ManageHook
myManageHook = composeAll (
[ manageHook gnomeConfig
, resource =? "stalonetray" --> doIgnore
, className =? "Unity-2d-panel" --> doIgnore
, stringProperty "WM_WINDOW_ROLE" =? "bubble" --> doCenterFloat
, myNSManageHook scratchpads
-- , manageDialogs
, manageAppsWSs
, manageKitty
, manageEmacs
, manageIm
, manageAppsWSs
, manageDocks
])
manageIm :: ManageHook
manageIm = composeOne
[ appName =? c -?> doShift imWs
| c <- [ "crx_nckgahadagoaajjgafhacjanaoiihapd" ]]
manageEmacs :: ManageHook
manageEmacs =
className =? "Emacs"
--> (ask >>= \w -> liftX (setOpacity w 0.95) >> idHook)
manageKitty :: ManageHook
manageKitty =
className =? "kitty"
--> (ask >>= \w -> liftX (setOpacity w 0.8) >> idHook)
manageGimp :: ManageHook
manageGimp =
className =? "Gimp"
--> (doShift gxfWs)
<+> composeOne
[ stringProperty "WM_WINDOW_ROLE" =? "gimp-image-window"
-?> doCenterFloat
, stringProperty "WM_WINDOW_ROLE" =? "gimp-image-new"
-?> doCenterFloat
, stringProperty "WM_WINDOW_ROLE" =? "gimp-dock"
-?> doTopRightFloat
, stringProperty "WM_WINDOW_ROLE" =? "gimp-toolbox"
-?> doTopLeftFloat
, stringProperty "WM_WINDOW_ROLE" =? "gimp-toolbox-color-dialog"
-?> doBottomRightFloat
, return True -?> doFloat ]
manageAppsWSs :: ManageHook
manageAppsWSs = composeAll
[ className =? "Chrome" --> doShift webWs
, className =? "Emacs" --> doShift devWs
]
manageDialogs :: ManageHook
manageDialogs = composeAll
[
stringProperty "WM_WINDOW_ROLE" =? "GtkFileChooserDialog" --> (customFloating $ W.RationalRect (1/4) (1/4) (2/4) (2/4))
]
doFlopDown :: ManageHook
doFlopDown = doF (W.focusUp . W.swapDown)
doTopRightFloat :: ManageHook
doTopRightFloat = ask
>>= \w -> doF . W.float w . position . snd
=<< liftX (floatLocation w)
where
position (W.RationalRect _ _ w h) = W.RationalRect (1-w) 0.03 w h
doTopLeftFloat :: ManageHook
doTopLeftFloat = ask
>>= \w -> doF . W.float w . position . snd
=<< liftX (floatLocation w)
where
position (W.RationalRect _ _ w h) = W.RationalRect 0 0.03 w h
doBottomRightFloat :: ManageHook
doBottomRightFloat = ask
>>= \w -> doF . W.float w . position . snd
=<< liftX (floatLocation w)
where
position (W.RationalRect _ _ w h) = W.RationalRect (1-w) (1-h) w h
doBottomLeftFloat :: ManageHook
doBottomLeftFloat = ask
>>= \w -> doF . W.float w . position . snd
=<< liftX (floatLocation w)
where
position (W.RationalRect _ _ w h) = W.RationalRect 0 (1-h) w h
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment