{-# LANGUAGE LambdaCase #-}
module XMonad.Hooks.FloatConfigureReq (
MaybeMaybeManageHook,
floatConfReqHook,
fixSteamFlicker,
fixSteamFlickerMMMH,
) where
import qualified Data.Map.Strict as M
import XMonad
import XMonad.Hooks.ManageHelpers
import XMonad.Prelude
import qualified XMonad.StackSet as W
type MaybeMaybeManageHook = Query (Maybe (Maybe (Endo WindowSet)))
floatConfReqHook :: MaybeMaybeManageHook -> Event -> X All
floatConfReqHook :: MaybeMaybeManageHook -> Event -> X All
floatConfReqHook MaybeMaybeManageHook
mh ConfigureRequestEvent{ev_window :: Event -> Window
ev_window = Window
w} =
forall a. Query a -> Window -> X a
runQuery (forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Query Bool
isFloatQ forall (m :: * -> *) a.
(Functor m, Monad m) =>
m Bool -> m a -> m (Maybe a)
-?> MaybeMaybeManageHook
mh)) Window
w forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (Maybe (Endo WindowSet))
Nothing -> forall a. Monoid a => a
mempty
Just Maybe (Endo WindowSet)
e -> do
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (Endo WindowSet)
e ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Endo a -> a -> a
appEndo)
X ()
sendConfEvent
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> All
All Bool
False)
where
sendConfEvent :: X ()
sendConfEvent = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy ->
Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
dpy Window
w forall a b. (a -> b) -> a -> b
$ \WindowAttributes
wa -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
ev -> do
XEventPtr -> EventType -> IO ()
setEventType XEventPtr
ev EventType
configureNotify
XEventPtr
-> Window
-> Window
-> CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> Window
-> Bool
-> IO ()
setConfigureEvent XEventPtr
ev Window
w Window
w
(WindowAttributes -> CInt
wa_x WindowAttributes
wa) (WindowAttributes -> CInt
wa_y WindowAttributes
wa) (WindowAttributes -> CInt
wa_width WindowAttributes
wa)
(WindowAttributes -> CInt
wa_height WindowAttributes
wa) (WindowAttributes -> CInt
wa_border_width WindowAttributes
wa) Window
none (WindowAttributes -> Bool
wa_override_redirect WindowAttributes
wa)
Display -> Window -> Bool -> Window -> XEventPtr -> IO ()
sendEvent Display
dpy Window
w Bool
False Window
0 XEventPtr
ev
floatConfReqHook MaybeMaybeManageHook
_ Event
_ = forall a. Monoid a => a
mempty
isFloatQ :: Query Bool
isFloatQ :: Query Bool
isFloatQ = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> forall a. X a -> Query a
liftX forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Bool
M.member Window
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
fixSteamFlicker :: Event -> X All
fixSteamFlicker :: Event -> X All
fixSteamFlicker = MaybeMaybeManageHook -> Event -> X All
floatConfReqHook MaybeMaybeManageHook
fixSteamFlickerMMMH
fixSteamFlickerMMMH :: MaybeMaybeManageHook
fixSteamFlickerMMMH :: MaybeMaybeManageHook
fixSteamFlickerMMMH = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Query [Char]
className forall a. Eq a => Query a -> a -> Query Bool
=? [Char]
"steam" forall (m :: * -> *) a.
(Functor m, Monad m) =>
m Bool -> m a -> m (Maybe a)
-?> forall a. Monoid a => a
mempty