{-# 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
readListPrec :: ReadPrec [TrackFloating a]
$creadListPrec :: forall a. ReadPrec [TrackFloating a]
readPrec :: ReadPrec (TrackFloating a)
$creadPrec :: forall a. ReadPrec (TrackFloating a)
readList :: ReadS [TrackFloating a]
$creadList :: forall a. ReadS [TrackFloating a]
readsPrec :: Int -> ReadS (TrackFloating a)
$creadsPrec :: forall a. Int -> ReadS (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
showList :: [TrackFloating a] -> ShowS
$cshowList :: forall a. [TrackFloating a] -> ShowS
show :: TrackFloating a -> String
$cshow :: forall a. TrackFloating a -> String
showsPrec :: Int -> TrackFloating a -> ShowS
$cshowsPrec :: forall a. Int -> 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 (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 (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 (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 (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
readListPrec :: ReadPrec [UseTransientFor a]
$creadListPrec :: forall a. ReadPrec [UseTransientFor a]
readPrec :: ReadPrec (UseTransientFor a)
$creadPrec :: forall a. ReadPrec (UseTransientFor a)
readList :: ReadS [UseTransientFor a]
$creadList :: forall a. ReadS [UseTransientFor a]
readsPrec :: Int -> ReadS (UseTransientFor a)
$creadsPrec :: forall a. Int -> ReadS (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
showList :: [UseTransientFor a] -> ShowS
$cshowList :: forall a. [UseTransientFor a] -> ShowS
show :: UseTransientFor a -> String
$cshow :: forall a. UseTransientFor a -> String
showsPrec :: Int -> UseTransientFor a -> ShowS
$cshowsPrec :: forall a. Int -> 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
/= :: UseTransientFor a -> UseTransientFor a -> Bool
$c/= :: forall a. UseTransientFor a -> UseTransientFor a -> Bool
== :: UseTransientFor a -> UseTransientFor a -> Bool
$c== :: forall a. 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)
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 (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 (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 (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.
-}