{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}
module XMonad.Layout.TrackFloating
(
trackFloating,
useTransientFor,
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)
ReadS [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
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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall i l a. Workspace i l a -> i
W.tag Workspace String (l Window) Window
ws) 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 forall a. Eq a => a -> a -> Bool
/= (forall a. Stack a -> a
W.focus forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Stack Window)
ms)
newStack :: Maybe (Stack Window)
newStack | Bool
isF = (Maybe Window
mw forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> forall a. (a -> Bool) -> Zipper a -> Zipper a
findZ (Window
wforall a. Eq a => a -> a -> Bool
==) Maybe (Stack Window)
ms) 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 <- 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
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Window, Rectangle)], Maybe (l Window))
ran, forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Maybe Window
newState forall a. Eq a => a -> a -> Bool
/= Maybe Window
mw) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just (forall a. Maybe Window -> TrackFloating a
TrackFloating Maybe Window
newState))
useTransientFor :: l a -> ModifiedLayout UseTransientFor l a
useTransientFor :: forall (l :: * -> *) a. l a -> ModifiedLayout UseTransientFor l a
useTransientFor = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall a. UseTransientFor a
UseTransientFor
data UseTransientFor a = UseTransientFor deriving (ReadPrec [UseTransientFor a]
ReadPrec (UseTransientFor a)
ReadS [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
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
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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall i l a. Workspace i l a -> i
W.tag Workspace String (l Window) Window
ws) forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
Maybe Window
parent <- forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. Display -> Window -> IO (Maybe Window)
getTransientForHint Display
d) Maybe Window
m
XState
s0 <- forall s (m :: * -> *). MonadState s m => m s
get
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Window
parent forall a b. (a -> b) -> a -> b
$ \Window
p -> forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
s0{ windowset :: StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset = 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 <- 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
p -> forall a. (a -> Bool) -> Zipper a -> Zipper a
findZ (Window
pforall a. Eq a => a -> a -> Bool
==) Maybe (Stack Window)
ms) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Stack Window)
ms } Rectangle
r
Maybe Window
m' <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Window
m' forall a. Eq a => a -> a -> Bool
== Maybe Window
parent) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Window
m forall a b. (a -> b) -> a -> b
$ \Window
p -> forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
s0{ windowset :: StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset = 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) }
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)], Maybe (l Window))
result
trackFloating :: l a -> ModifiedLayout TrackFloating l a
trackFloating :: forall (l :: * -> *) a. l a -> ModifiedLayout TrackFloating l a
trackFloating = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (forall a. Maybe Window -> TrackFloating a
TrackFloating forall a. Maybe a
Nothing)