module XMonad.Hooks.CurrentWorkspaceOnTop (
currentWorkspaceOnTop
) where
import qualified Data.List.NonEmpty as NE (nonEmpty)
import qualified Data.Map as M
import XMonad
import XMonad.Prelude (NonEmpty ((:|)), when)
import qualified XMonad.StackSet as S
import qualified XMonad.Util.ExtensibleState as XS
newtype CWOTState = CWOTS String
instance ExtensionClass CWOTState where
initialValue :: CWOTState
initialValue = WorkspaceId -> CWOTState
CWOTS WorkspaceId
""
currentWorkspaceOnTop :: X ()
currentWorkspaceOnTop :: X ()
currentWorkspaceOnTop = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> do
WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
(CWOTS WorkspaceId
lastTag) <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
let curTag :: WorkspaceId
curTag = forall i l a. Workspace i l a -> i
S.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current forall a b. (a -> b) -> a -> b
$ WindowSet
ws
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WorkspaceId
curTag forall a. Eq a => a -> a -> Bool
/= WorkspaceId
lastTag) forall a b. (a -> b) -> a -> b
$ do
let s :: Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
s = forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current WindowSet
ws
wsp :: Workspace WorkspaceId (Layout Window) Window
wsp = forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
s
viewrect :: Rectangle
viewrect = ScreenDetail -> Rectangle
screenRect forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> sd
S.screenDetail Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
s
tmpStack :: Maybe (Stack Window)
tmpStack = forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack Workspace WorkspaceId (Layout Window) Window
wsp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
S.filter (forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
S.floating WindowSet
ws)
([(Window, Rectangle)]
rs, Maybe (Layout Window)
ml') <- forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace WorkspaceId (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace WorkspaceId (Layout Window) Window
wsp { stack :: Maybe (Stack Window)
S.stack = Maybe (Stack Window)
tmpStack } Rectangle
viewrect
WorkspaceId -> Maybe (Layout Window) -> X ()
updateLayout WorkspaceId
curTag Maybe (Layout Window)
ml'
let this :: WindowSet
this = forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
S.view WorkspaceId
curTag WindowSet
ws
fltWins :: [Window]
fltWins = forall a. (a -> Bool) -> [a] -> [a]
filter (forall k a. Ord k => k -> Map k a -> Bool
`M.member` forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
S.floating WindowSet
ws) forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> [a]
S.index WindowSet
this
wins :: [Window]
wins = [Window]
fltWins forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Window, Rectangle)]
rs
case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [Window]
wins of
Maybe (NonEmpty Window)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (Window
w :| [Window]
ws') -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO ()
raiseWindow Display
d Window
w
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> [Window] -> IO ()
restackWindows Display
d (Window
w forall a. a -> [a] -> [a]
: [Window]
ws')
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put(WorkspaceId -> CWOTState
CWOTS WorkspaceId
curTag)