nix-config/modules/home-manager/desktop-xmonad/xmonad/lib/ManageHook.hs

136 lines
3.8 KiB
Haskell
Raw Normal View History

2022-01-18 09:32:55 +01:00
module ManageHook
( myManageHook
, scratchpadKeybinds
) where
import Text.Printf (printf)
import qualified Data.Map as M
import XMonad.Core
( ManageHook
, X
, XConfig(XConfig)
, modMask
, Layout
)
import XMonad.StackSet (RationalRect (RationalRect))
import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat)
import Graphics.X11.Types
( KeySym , ButtonMask
, xK_s , xK_t , xK_m
, xK_Return
)
import XMonad.ManageHook
( className
, (=?)
, resource
, composeAll
, (-->)
, doFloat
, doShift
, stringProperty
)
import XMonad.Util.NamedScratchpad
( NamedScratchpad (NS)
, customFloating
, namedScratchpadManageHook
, namedScratchpadAction
)
import Utils ( mkSubmap )
scratchpadKeybinds :: XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())
scratchpadKeybinds XConfig {modMask = modm} = M.fromList
[ ((modm, xK_s), mkSubmap modm . map buildSubmap $
[ (xK_Return, "scratchpad")
, (xK_m, "mixer")
-- , (xK_p, "player")
, (xK_t, "top")
-- , (xK_w, "whatsapp")
-- , (xK_g, "hangouts")
])
]
where
buildSubmap (key,name) = ((0,key), namedScratchpadAction myScratchpads name)
myScratchpads :: [NamedScratchpad]
myScratchpads =
[ termApp "scratchpad" "zsh" mngTopScratch
, termApp "top" "top" mngBigFloat
--, termApp "player" "ncmpcpp" mngBiggerFloat
--, NS "mixer" "pavucontrol" (className =? "Pavucontrol") mngSmallerFloat
-- , chromiumApp "whatsapp" "web.whatsapp.com" mngSmallFloat
-- , chromiumApp "hangouts" "hangouts.google.com" mngSmallFloat
]
myManageHook :: ManageHook
myManageHook = mkManageHook myScratchpads
termApp :: String -> String -> ManageHook -> NamedScratchpad
termApp name app = NS name cmd findIt
where
cmd = printf fmt name name app
fmt = "alacritty --class %s --command tmux new -A -s %s %s"
findIt = resource =? name
--chromiumApp :: String -> String -> ManageHook -> NamedScratchpad
--chromiumApp name url = NS name cmd findIt
-- where
-- cmd = printf "chromium --app=https://%s" url
-- findIt = resource =? url
--mngSmallerFloat :: ManageHook
--mngSmallerFloat = centeredFloat 0.6
--mngSmallFloat :: ManageHook
--mngSmallFloat = centeredFloat 0.7
mngBigFloat :: ManageHook
mngBigFloat = centeredFloat 0.8
--mngBiggerFloat :: ManageHook
--mngBiggerFloat = centeredFloat 0.9
centeredFloat :: Rational -> ManageHook
centeredFloat s = customFloating $ RationalRect p p s s
where
p = (1-s) / 2
mngTopScratch :: ManageHook
mngTopScratch = customFloating $ RationalRect l t w h
where
h = 0.3 -- height, 30%
w = 1 -- width, 100%
t = 0 -- distance from top edge, 0%
l = 1 - w -- distance from left edge, 0%
mkManageHook :: [NamedScratchpad] -> ManageHook
mkManageHook scratchpads = composeAll
[ isFullscreen --> doFullFloat
, className =? "MPlayer" --> doFloat
, className =? "VirtualBox" --> doFloat
, className =? "Pinentry" --> doFloat
, className =? "qjackctl" --> doFloat
, className =? "Xmessage" --> doFloat
, className =? "SuperCollider" --> doFloat
, role =? "gimp-dock" --> doFloat
, role =? "GtkFileChooserDialog" --> doFloat
--, className =? "Signal" --> doShift "msg"
--, className =? "Slack" --> doShift "msg"
--, className =? "Element" --> doShift "msg"
--, className =? "TelegramDesktop" --> doShift "msg"
--, resource =? "hangouts.google.com" --> doShift "msg"
--, resource =? "web.whatsapp.com" --> doShift "msg"
, namedScratchpadManageHook scratchpads
]
where
role = stringProperty "WM_WINDOW_ROLE"