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 = (Display -> X ()) -> X ()
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Display
d -> do
ws <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
(CWOTS lastTag) <- XS.get
let curTag = Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
S.tag (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> (WindowSet -> Workspace WorkspaceId (Layout Window) Window)
-> WindowSet
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
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
-> Workspace WorkspaceId (Layout Window) Window)
-> (WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> Workspace WorkspaceId (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current (WindowSet -> WorkspaceId) -> WindowSet -> WorkspaceId
forall a b. (a -> b) -> a -> b
$ WindowSet
ws
when (curTag /= lastTag) $ do
let s = WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current WindowSet
ws
wsp = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
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 = ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle) -> ScreenDetail -> Rectangle
forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
S.screenDetail Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
s
tmpStack = Workspace WorkspaceId (Layout Window) Window
-> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack Workspace WorkspaceId (Layout Window) Window
wsp Maybe (Stack Window)
-> (Stack Window -> Maybe (Stack Window)) -> Maybe (Stack Window)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Window -> Bool) -> Stack Window -> Maybe (Stack Window)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
S.filter (Window -> Map Window RationalRect -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
S.floating WindowSet
ws)
(rs, ml') <- runLayout wsp { S.stack = tmpStack } viewrect
updateLayout curTag ml'
let this = WorkspaceId -> WindowSet -> WindowSet
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 -> Bool) -> [Window] -> [Window]
forall a. (a -> Bool) -> [a] -> [a]
filter (Window -> Map Window RationalRect -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
S.floating WindowSet
ws) ([Window] -> [Window]) -> [Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ WindowSet -> [Window]
forall i l a s sd. StackSet i l a s sd -> [a]
S.index WindowSet
this
wins = [Window]
fltWins [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ ((Window, Rectangle) -> Window)
-> [(Window, Rectangle)] -> [Window]
forall a b. (a -> b) -> [a] -> [b]
map (Window, Rectangle) -> Window
forall a b. (a, b) -> a
fst [(Window, Rectangle)]
rs
case NE.nonEmpty wins of
Maybe (NonEmpty Window)
Nothing -> () -> X ()
forall a. a -> X a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (Window
w :| [Window]
ws') -> do
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO ()
raiseWindow Display
d Window
w
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> [Window] -> IO ()
restackWindows Display
d (Window
w Window -> [Window] -> [Window]
forall a. a -> [a] -> [a]
: [Window]
ws')
XS.put(CWOTS curTag)