    {-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}
    {- |

    Module      :  XMonad.Layout.TrackFloating
    Description :  Track focus in the tiled layer.
    Copyright   :  (c) 2010 & 2013 Adam Vogt
                   2011 Willem Vanlint
    License     :  BSD-style (see xmonad/LICENSE)

    Maintainer  :  vogt.adam@gmail.com
    Stability   :  unstable
    Portability :  unportable

    Layout modifier that tracks focus in the tiled layer while the floating layer
    or another sublayout is in use. This is particularly helpful for tiled layouts
    where the focus determines what is visible. It can also be used to improve the
    behaviour of a child layout that has not been given the focused window.

    The relevant bugs are Issue 4 and 306:
    <http://code.google.com/p/xmonad/issues/detail?id=4>,
    <http://code.google.com/p/xmonad/issues/detail?id=306>
    -}
    module XMonad.Layout.TrackFloating
        (-- * Usage
         -- $usage

         -- ** For other layout modifiers
         -- $layoutModifier
         trackFloating,
         useTransientFor,

         -- ** Exported types
         TrackFloating,
         UseTransientFor,
        ) where

    import XMonad.Prelude
    import XMonad
    import XMonad.Layout.LayoutModifier
    import XMonad.Util.Stack (findZ)
    import qualified XMonad.StackSet as W

    import qualified Data.Traversable as T

    newtype TrackFloating a = TrackFloating (Maybe Window)
        deriving (ReadPrec [TrackFloating a]
    ReadPrec (TrackFloating a)
    Int -> ReadS (TrackFloating a)
    ReadS [TrackFloating a]
    (Int -> ReadS (TrackFloating a))
    -> ReadS [TrackFloating a]
    -> ReadPrec (TrackFloating a)
    -> ReadPrec [TrackFloating a]
    -> Read (TrackFloating a)
    forall a. ReadPrec [TrackFloating a]
    forall a. ReadPrec (TrackFloating a)
    forall a. Int -> ReadS (TrackFloating a)
    forall a. ReadS [TrackFloating a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall a. Int -> ReadS (TrackFloating a)
    readsPrec :: Int -> ReadS (TrackFloating a)
    $creadList :: forall a. ReadS [TrackFloating a]
    readList :: ReadS [TrackFloating a]
    $creadPrec :: forall a. ReadPrec (TrackFloating a)
    readPrec :: ReadPrec (TrackFloating a)
    $creadListPrec :: forall a. ReadPrec [TrackFloating a]
    readListPrec :: ReadPrec [TrackFloating a]
    Read,Int -> TrackFloating a -> ShowS
    [TrackFloating a] -> ShowS
    TrackFloating a -> String
    (Int -> TrackFloating a -> ShowS)
    -> (TrackFloating a -> String)
    -> ([TrackFloating a] -> ShowS)
    -> Show (TrackFloating a)
    forall a. Int -> TrackFloating a -> ShowS
    forall a. [TrackFloating a] -> ShowS
    forall a. TrackFloating a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Int -> TrackFloating a -> ShowS
    showsPrec :: Int -> TrackFloating a -> ShowS
    $cshow :: forall a. TrackFloating a -> String
    show :: TrackFloating a -> String
    $cshowList :: forall a. [TrackFloating a] -> ShowS
    showList :: [TrackFloating a] -> ShowS
    Show)

    instance LayoutModifier TrackFloating Window where
        modifyLayoutWithUpdate :: forall (l :: * -> *).
    LayoutClass l Window =>
    TrackFloating Window
    -> Workspace String (l Window) Window
    -> Rectangle
    -> X (([(Window, Rectangle)], Maybe (l Window)),
          Maybe (TrackFloating Window))
    modifyLayoutWithUpdate (TrackFloating Maybe Window
    mw) ws :: Workspace String (l Window) Window
    ws@W.Workspace{ stack :: forall i l a. Workspace i l a -> Maybe (Stack a)
    W.stack = Maybe (Stack Window)
    ms } Rectangle
    r
          = do
            Maybe Window
    xCur <- (XState -> Maybe Window) -> X (Maybe Window)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Maybe Window
    forall i l a s sd. StackSet i l a s sd -> Maybe a
    W.peek (StackSet String (Layout Window) Window ScreenId ScreenDetail
     -> Maybe Window)
    -> (XState
        -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Maybe Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    forall s i l a sd.
    (Eq s, Eq i) =>
    i -> StackSet i l a s sd -> StackSet i l a s sd
    W.view (Workspace String (l Window) Window -> String
    forall i l a. Workspace i l a -> i
    W.tag Workspace String (l Window) Window
    ws) (StackSet String (Layout Window) Window ScreenId ScreenDetail
     -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> (XState
        -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    windowset)
            let isF :: Bool
    isF = Maybe Window
    xCur Maybe Window -> Maybe Window -> Bool
    forall a. Eq a => a -> a -> Bool
    /= (Stack Window -> Window
    forall a. Stack a -> a
    W.focus (Stack Window -> Window) -> Maybe (Stack Window) -> Maybe Window
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Stack Window)
    ms)
                -- use the remembered focus point when true focus differs from
                -- what this (sub)layout is given, which happens e.g. when true
                -- focus is in floating layer or when another sublayout has focus
                newStack :: Maybe (Stack Window)
    newStack | Bool
    isF = (Maybe Window
    mw Maybe Window
    -> (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
    w -> (Window -> Bool) -> Maybe (Stack Window) -> Maybe (Stack Window)
    forall a. (a -> Bool) -> Zipper a -> Zipper a
    findZ (Window
    wWindow -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) Maybe (Stack Window)
    ms) Maybe (Stack Window)
    -> Maybe (Stack Window) -> Maybe (Stack Window)
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe (Stack Window)
    ms
                         | Bool
    otherwise = Maybe (Stack Window)
    ms
                newState :: Maybe Window
    newState | Bool
    isF = Maybe Window
    mw
                         | Bool
    otherwise = Maybe Window
    xCur
            ([(Window, Rectangle)], Maybe (l Window))
    ran <- Workspace String (l Window) Window
    -> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window))
    forall (layout :: * -> *) a.
    LayoutClass layout a =>
    Workspace String (layout a) a
    -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
    runLayout Workspace String (l Window) Window
    ws{ stack :: Maybe (Stack Window)
    W.stack = Maybe (Stack Window)
    newStack } Rectangle
    r
            (([(Window, Rectangle)], Maybe (l Window)),
     Maybe (TrackFloating Window))
    -> X (([(Window, Rectangle)], Maybe (l Window)),
          Maybe (TrackFloating Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (([(Window, Rectangle)], Maybe (l Window))
    ran, Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Maybe Window
    newState Maybe Window -> Maybe Window -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe Window
    mw) Maybe ()
    -> Maybe (TrackFloating Window) -> Maybe (TrackFloating Window)
    forall a b. Maybe a -> Maybe b -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TrackFloating Window -> Maybe (TrackFloating Window)
    forall a. a -> Maybe a
    Just (Maybe Window -> TrackFloating Window
    forall a. Maybe Window -> TrackFloating a
    TrackFloating Maybe Window
    newState))

    {- | When focus is on the tiled layer, the underlying layout is run with focus
    on the window named by the WM_TRANSIENT_FOR property on the floating window.
    -}
    useTransientFor :: l a -> ModifiedLayout UseTransientFor l a
    useTransientFor :: forall (l :: * -> *) a. l a -> ModifiedLayout UseTransientFor l a
    useTransientFor = UseTransientFor a -> l a -> ModifiedLayout UseTransientFor l a
    forall (m :: * -> *) (l :: * -> *) a.
    m a -> l a -> ModifiedLayout m l a
    ModifiedLayout UseTransientFor a
    forall a. UseTransientFor a
    UseTransientFor

    data UseTransientFor a = UseTransientFor deriving (ReadPrec [UseTransientFor a]
    ReadPrec (UseTransientFor a)
    Int -> ReadS (UseTransientFor a)
    ReadS [UseTransientFor a]
    (Int -> ReadS (UseTransientFor a))
    -> ReadS [UseTransientFor a]
    -> ReadPrec (UseTransientFor a)
    -> ReadPrec [UseTransientFor a]
    -> Read (UseTransientFor a)
    forall a. ReadPrec [UseTransientFor a]
    forall a. ReadPrec (UseTransientFor a)
    forall a. Int -> ReadS (UseTransientFor a)
    forall a. ReadS [UseTransientFor a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall a. Int -> ReadS (UseTransientFor a)
    readsPrec :: Int -> ReadS (UseTransientFor a)
    $creadList :: forall a. ReadS [UseTransientFor a]
    readList :: ReadS [UseTransientFor a]
    $creadPrec :: forall a. ReadPrec (UseTransientFor a)
    readPrec :: ReadPrec (UseTransientFor a)
    $creadListPrec :: forall a. ReadPrec [UseTransientFor a]
    readListPrec :: ReadPrec [UseTransientFor a]
    Read,Int -> UseTransientFor a -> ShowS
    [UseTransientFor a] -> ShowS
    UseTransientFor a -> String
    (Int -> UseTransientFor a -> ShowS)
    -> (UseTransientFor a -> String)
    -> ([UseTransientFor a] -> ShowS)
    -> Show (UseTransientFor a)
    forall a. Int -> UseTransientFor a -> ShowS
    forall a. [UseTransientFor a] -> ShowS
    forall a. UseTransientFor a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Int -> UseTransientFor a -> ShowS
    showsPrec :: Int -> UseTransientFor a -> ShowS
    $cshow :: forall a. UseTransientFor a -> String
    show :: UseTransientFor a -> String
    $cshowList :: forall a. [UseTransientFor a] -> ShowS
    showList :: [UseTransientFor a] -> ShowS
    Show,UseTransientFor a -> UseTransientFor a -> Bool
    (UseTransientFor a -> UseTransientFor a -> Bool)
    -> (UseTransientFor a -> UseTransientFor a -> Bool)
    -> Eq (UseTransientFor a)
    forall a. UseTransientFor a -> UseTransientFor a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. UseTransientFor a -> UseTransientFor a -> Bool
    == :: UseTransientFor a -> UseTransientFor a -> Bool
    $c/= :: forall a. UseTransientFor a -> UseTransientFor a -> Bool
    /= :: UseTransientFor a -> UseTransientFor a -> Bool
    Eq)

    instance LayoutModifier UseTransientFor Window where
        modifyLayout :: forall (l :: * -> *).
    LayoutClass l Window =>
    UseTransientFor Window
    -> Workspace String (l Window) Window
    -> Rectangle
    -> X ([(Window, Rectangle)], Maybe (l Window))
    modifyLayout UseTransientFor Window
    _ ws :: Workspace String (l Window) Window
    ws@W.Workspace{ stack :: forall i l a. Workspace i l a -> Maybe (Stack a)
    W.stack = Maybe (Stack Window)
    ms } Rectangle
    r = do
            Maybe Window
    m <- (XState -> Maybe Window) -> X (Maybe Window)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Maybe Window
    forall i l a s sd. StackSet i l a s sd -> Maybe a
    W.peek (StackSet String (Layout Window) Window ScreenId ScreenDetail
     -> Maybe Window)
    -> (XState
        -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Maybe Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    forall s i l a sd.
    (Eq s, Eq i) =>
    i -> StackSet i l a s sd -> StackSet i l a s sd
    W.view (Workspace String (l Window) Window -> String
    forall i l a. Workspace i l a -> i
    W.tag Workspace String (l Window) Window
    ws) (StackSet String (Layout Window) Window ScreenId ScreenDetail
     -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> (XState
        -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    windowset)
            Display
    d <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
            Maybe Window
    parent <- Maybe (Maybe Window) -> Maybe Window
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (Maybe (Maybe Window) -> Maybe Window)
    -> X (Maybe (Maybe Window)) -> X (Maybe Window)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Window -> X (Maybe Window))
    -> Maybe Window -> X (Maybe (Maybe Window))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    T.traverse (IO (Maybe Window) -> X (Maybe Window)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Maybe Window) -> X (Maybe Window))
    -> (Window -> IO (Maybe Window)) -> Window -> X (Maybe Window)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Display -> Window -> IO (Maybe Window)
    getTransientForHint Display
    d) Maybe Window
    m

            XState
    s0 <- X XState
    forall s (m :: * -> *). MonadState s m => m s
    get
            Maybe Window -> (Window -> X ()) -> X ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust Maybe Window
    parent ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \Window
    p -> XState -> X ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put XState
    s0{ windowset :: StackSet String (Layout Window) Window ScreenId ScreenDetail
    windowset = Window
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    forall s a i l sd.
    (Eq s, Eq a, Eq i) =>
    a -> StackSet i l a s sd -> StackSet i l a s sd
    W.focusWindow Window
    p (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    windowset XState
    s0) }
            ([(Window, Rectangle)], Maybe (l Window))
    result <- Workspace String (l Window) Window
    -> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window))
    forall (layout :: * -> *) a.
    LayoutClass layout a =>
    Workspace String (layout a) a
    -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
    runLayout Workspace String (l Window) Window
    ws{ stack :: Maybe (Stack Window)
    W.stack = (Maybe Window
    parent Maybe Window
    -> (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
    p -> (Window -> Bool) -> Maybe (Stack Window) -> Maybe (Stack Window)
    forall a. (a -> Bool) -> Zipper a -> Zipper a
    findZ (Window
    pWindow -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) Maybe (Stack Window)
    ms) Maybe (Stack Window)
    -> Maybe (Stack Window) -> Maybe (Stack Window)
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe (Stack Window)
    ms } Rectangle
    r

            Maybe Window
    m' <- (XState -> Maybe Window) -> X (Maybe Window)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Maybe Window
    forall i l a s sd. StackSet i l a s sd -> Maybe a
    W.peek (StackSet String (Layout Window) Window ScreenId ScreenDetail
     -> Maybe Window)
    -> (XState
        -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Maybe Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    windowset)

            Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe Window
    m' Maybe Window -> Maybe Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Window
    parent) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $
                -- layout changed the windowset, so don't clobber it
                Maybe Window -> (Window -> X ()) -> X ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust Maybe Window
    m ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \Window
    p -> XState -> X ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put XState
    s0{ windowset :: StackSet String (Layout Window) Window ScreenId ScreenDetail
    windowset = Window
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    forall s a i l sd.
    (Eq s, Eq a, Eq i) =>
    a -> StackSet i l a s sd -> StackSet i l a s sd
    W.focusWindow Window
    p (XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    windowset XState
    s0) }

            ([(Window, Rectangle)], Maybe (l Window))
    -> X ([(Window, Rectangle)], Maybe (l Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Window, Rectangle)], Maybe (l Window))
    result

    {- $usage

    Apply to your layout in a config like:

    > main = xmonad (def{
    >                   layoutHook = trackFloating (useTransientFor
    >                       (noBorders Full ||| Tall 1 0.3 0.5)),
    >                   ...
    >               })

    'useTransientFor' and 'trackFloating' can be enabled independently.  For
    example when the floating window sets @WM_TRANSIENT_FOR@, such as libreoffice's
    file->preferences window, @optionA@ will have the last-focused window magnified
    while @optionB@ will result magnify the window that opened the preferences
    window regardless of which tiled window was focused before.

    > import XMonad.Layout.Magnifier
    > import XMonad.Layout.TrackFloating
    >
    > underlyingLayout = magnifier (Tall 1 0.3 0.5)
    >
    > optionA = trackFloating underlyingLayout
    > optionB = trackFloating (useTransientFor underlyingLayout)

    -}

    {- | Runs another layout with a remembered focus, provided:

    * the subset of windows doesn't include the focus in XState

    * it was previously run with a subset that included the XState focus

    * the remembered focus hasn't since been killed

    -}
    trackFloating ::  l a -> ModifiedLayout TrackFloating l a
    trackFloating :: forall (l :: * -> *) a. l a -> ModifiedLayout TrackFloating l a
    trackFloating = TrackFloating a -> l a -> ModifiedLayout TrackFloating l a
    forall (m :: * -> *) (l :: * -> *) a.
    m a -> l a -> ModifiedLayout m l a
    ModifiedLayout (Maybe Window -> TrackFloating a
    forall a. Maybe Window -> TrackFloating a
    TrackFloating Maybe Window
    forall a. Maybe a
    Nothing)

    {- $layoutModifier
    It also corrects focus issues for full-like layouts inside other layout
    modifiers:

    > import XMonad.Layout.IM
    > import XMonad.Layout.Tabbed
    > import XMonad.Layout.TrackFloating
    > import XMonad.Layout.Reflect

    > gimpLayout = withIM 0.11 (Role "gimp-toolbox") $ reflectHoriz
    >       $ withIM 0.15 (Role "gimp-dock") (trackFloating simpleTabbed)

    Interactions with some layout modifiers (ex. decorations, minimizing) are
    unknown but likely unpleasant.
    -}