136 lines
3.8 KiB
Haskell
136 lines
3.8 KiB
Haskell
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"
|