----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.CurrentWorkspaceOnTop
-- Description :  Ensure that windows on the current workspace are on top.
-- Copyright   :  (c) Jan Vornberger 2009
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
-- Stability   :  unstable
-- Portability :  not portable
--
-- Ensures that the windows of the current workspace are always in front
-- of windows that are located on other visible screens. This becomes important
-- if you use decoration and drag windows from one screen to another. Using this
-- module, the dragged window will always be in front of other windows.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.CurrentWorkspaceOnTop (
    -- * Usage
    -- $usage
    currentWorkspaceOnTop
    ) where

import XMonad
import qualified XMonad.StackSet as S
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Prelude (unless, when)
import qualified Data.Map as M

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Hooks.CurrentWorkspaceOnTop
-- >
-- > main = xmonad $ def {
-- >    ...
-- >    logHook = currentWorkspaceOnTop
-- >    ...
-- >  }
--

newtype CWOTState = CWOTS String

instance ExtensionClass CWOTState where
  initialValue :: CWOTState
initialValue = String -> CWOTState
CWOTS String
""

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
    WindowSet
ws <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    (CWOTS String
lastTag) <- X CWOTState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    let curTag :: String
curTag = Workspace String (Layout Window) Window -> String
forall i l a. Workspace i l a -> i
S.tag (Workspace String (Layout Window) Window -> String)
-> (WindowSet -> Workspace String (Layout Window) Window)
-> WindowSet
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (WindowSet
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> Screen String (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 -> String) -> WindowSet -> String
forall a b. (a -> b) -> a -> b
$ WindowSet
ws
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
curTag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
lastTag) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
        -- the following is more or less a reimplementation of what's happening in "XMonad.Operation"
        let s :: Screen String (Layout Window) Window ScreenId ScreenDetail
s = WindowSet
-> Screen String (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 :: Workspace String (Layout Window) Window
wsp = Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace Screen String (Layout Window) Window ScreenId ScreenDetail
s
            viewrect :: Rectangle
viewrect = ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle) -> ScreenDetail -> Rectangle
forall a b. (a -> b) -> a -> b
$ Screen String (Layout Window) Window ScreenId ScreenDetail
-> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
S.screenDetail Screen String (Layout Window) Window ScreenId ScreenDetail
s
            tmpStack :: Maybe (Stack Window)
tmpStack = Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack Workspace String (Layout Window) Window
wsp Maybe (Stack Window)
-> (Stack Window -> Maybe (Stack Window)) -> Maybe (Stack Window)
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)
        ([(Window, Rectangle)]
rs, Maybe (Layout Window)
ml') <- Workspace String (Layout Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (Layout Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace String (Layout Window) Window
wsp { stack :: Maybe (Stack Window)
S.stack = Maybe (Stack Window)
tmpStack } Rectangle
viewrect
        String -> Maybe (Layout Window) -> X ()
updateLayout String
curTag Maybe (Layout Window)
ml'
        let this :: WindowSet
this = String -> 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 String
curTag WindowSet
ws
            fltWins :: [Window]
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]
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  -- order: first all floating windows, then the order the layout returned
        -- end of reimplementation

        Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Window] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Window]
wins) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ 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] -> Window
forall a. [a] -> a
head [Window]
wins)  -- raise first window of current workspace to the very top,
            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]
wins      -- then use restackWindows to let all other windows from the workspace follow
        CWOTState -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put(String -> CWOTState
CWOTS String
curTag)