{-# LANGUAGE MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
module XMonad.Layout.TrackFloating
(
trackFloating,
useTransientFor,
TrackFloating,
UseTransientFor,
) where
import Control.Monad
import Data.Function
import Data.List
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Set as S
import XMonad
import XMonad.Layout.LayoutModifier
import qualified XMonad.StackSet as W
import qualified Data.Traversable as T
data TrackFloating a = TrackFloating
{ TrackFloating a -> Bool
_wasFloating :: Bool,
TrackFloating a -> Maybe Window
_tiledFocus :: 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,TrackFloating a -> TrackFloating a -> Bool
(TrackFloating a -> TrackFloating a -> Bool)
-> (TrackFloating a -> TrackFloating a -> Bool)
-> Eq (TrackFloating a)
forall a. TrackFloating a -> TrackFloating a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrackFloating a -> TrackFloating a -> Bool
$c/= :: forall a. TrackFloating a -> TrackFloating a -> Bool
== :: TrackFloating a -> TrackFloating a -> Bool
$c== :: forall a. TrackFloating a -> TrackFloating a -> Bool
Eq)
instance LayoutModifier TrackFloating Window where
modifyLayoutWithUpdate :: TrackFloating Window
-> Workspace String (l Window) Window
-> Rectangle
-> X (([(Window, Rectangle)], Maybe (l Window)),
Maybe (TrackFloating Window))
modifyLayoutWithUpdate os :: TrackFloating Window
os@(TrackFloating Bool
_wasF 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
WindowSet
winset <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
let xCur :: Maybe Window
xCur = (Stack Window -> Window) -> Maybe (Stack Window) -> Maybe Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stack Window -> Window
forall a. Stack a -> a
W.focus Maybe (Stack Window)
xStack
xStack :: Maybe (Stack Window)
xStack = Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall a b. (a -> b) -> a -> b
$ 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
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window)
-> Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall a b. (a -> b) -> a -> b
$ 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
W.current WindowSet
winset
isF :: Maybe Bool
isF = (Window -> Bool) -> Maybe Window -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Window
x -> Window
x 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
W.floating WindowSet
winset Bool -> Bool -> Bool
||
(let \\\ :: Maybe (Stack Window) -> Maybe (Stack Window) -> Set Window
(\\\) = Set Window -> Set Window -> Set Window
forall a. Ord a => Set a -> Set a -> Set a
(S.\\) (Set Window -> Set Window -> Set Window)
-> (Maybe (Stack Window) -> Set Window)
-> Maybe (Stack Window)
-> Maybe (Stack Window)
-> Set Window
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ([Window] -> Set Window
forall a. Ord a => [a] -> Set a
S.fromList ([Window] -> Set Window)
-> (Maybe (Stack Window) -> [Window])
-> Maybe (Stack Window)
-> Set Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate')
in Window
x Window -> Set Window -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` (Maybe (Stack Window)
xStack Maybe (Stack Window) -> Maybe (Stack Window) -> Set Window
\\\ Maybe (Stack Window)
ms)))
Maybe Window
xCur
newStack :: Maybe (Stack Window)
newStack
| Just Bool
isF' <- Maybe Bool
isF,
Bool
isF',
Just Window
w <- Maybe Window
mw,
Just Stack Window
s <- Maybe (Stack Window)
ms,
Just Stack Window
ns <- (Stack Window -> Bool) -> [Stack Window] -> Maybe (Stack Window)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
(==) Window
w (Window -> Bool)
-> (Stack Window -> Window) -> Stack Window -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack Window -> Window
forall a. Stack a -> a
W.focus)
([Stack Window] -> Maybe (Stack Window))
-> [Stack Window] -> Maybe (Stack Window)
forall a b. (a -> b) -> a -> b
$ (Stack Window -> Window -> Stack Window)
-> [Stack Window] -> [Window] -> [Stack Window]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Stack Window -> Window -> Stack Window
forall a b. a -> b -> a
const ((Stack Window -> Stack Window) -> Stack Window -> [Stack Window]
forall a. (a -> a) -> a -> [a]
iterate Stack Window -> Stack Window
forall a. Stack a -> Stack a
W.focusDown' Stack Window
s) (Stack Window -> [Window]
forall a. Stack a -> [a]
W.integrate Stack Window
s)
= Stack Window -> Maybe (Stack Window)
forall a. a -> Maybe a
Just Stack Window
ns
| Bool
otherwise
= Maybe (Stack Window)
ms
newState :: Maybe Window
newState = case Maybe Bool
isF of
Just Bool
True -> Maybe Window
mw
Just Bool
False | Just Window
f <- Maybe Window
xCur -> Window -> Maybe Window
forall a. a -> Maybe a
Just Window
f
Maybe Bool
_ -> Maybe Window
forall a. Maybe a
Nothing
([(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,
let n :: TrackFloating a
n = Bool -> Maybe Window -> TrackFloating a
forall a. Bool -> Maybe Window -> TrackFloating a
TrackFloating (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
isF) Maybe Window
newState
in Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (TrackFloating Window
forall a. TrackFloating a
n TrackFloating Window -> TrackFloating Window -> Bool
forall a. Eq a => a -> a -> Bool
/= TrackFloating Window
os) 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 TrackFloating Window
forall a. TrackFloating a
n)
useTransientFor :: l a -> ModifiedLayout UseTransientFor l a
useTransientFor :: l a -> ModifiedLayout UseTransientFor l a
useTransientFor l a
x = 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 l a
x
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 :: 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 (WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek (WindowSet -> Maybe Window)
-> (XState -> WindowSet) -> XState -> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
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)
-> X (Maybe (Maybe Window)) -> X (Maybe Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe Window) -> Maybe Window
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (X (Maybe (Maybe Window)) -> X (Maybe Window))
-> X (Maybe (Maybe Window)) -> X (Maybe Window)
forall a b. (a -> b) -> a -> 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 :: WindowSet
windowset = Window -> WindowSet -> 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 -> WindowSet
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 (Stack Window)
-> Maybe (Maybe (Stack Window)) -> Maybe (Stack Window)
forall a. a -> Maybe a -> a
fromMaybe Maybe (Stack Window)
ms ((Stack Window -> Window -> Maybe (Stack Window))
-> Maybe (Stack Window)
-> Maybe Window
-> Maybe (Maybe (Stack Window))
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Stack Window -> Window -> Maybe (Stack Window)
forall a. Eq a => Stack a -> a -> Maybe (Stack a)
focusWin Maybe (Stack Window)
ms Maybe Window
parent) } Rectangle
r
Maybe Window
m' <- (XState -> Maybe Window) -> X (Maybe Window)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek (WindowSet -> Maybe Window)
-> (XState -> WindowSet) -> XState -> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
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
$
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 :: WindowSet
windowset = Window -> WindowSet -> 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 -> WindowSet
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
focusWin :: Eq a => W.Stack a -> a -> Maybe (W.Stack a)
focusWin :: Stack a -> a -> Maybe (Stack a)
focusWin st :: Stack a
st@(W.Stack a
f [a]
u [a]
d) a
w
| a
w a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
u Bool -> Bool -> Bool
|| a
w a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
d = Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just (Stack a -> Maybe (Stack a))
-> ([Stack a] -> Stack a) -> [Stack a] -> Maybe (Stack a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Stack a] -> Stack a
forall a. [a] -> a
head ([Stack a] -> Stack a)
-> ([Stack a] -> [Stack a]) -> [Stack a] -> Stack a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack a -> Bool) -> [Stack a] -> [Stack a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
w) (a -> Bool) -> (Stack a -> a) -> Stack a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> a
forall a. Stack a -> a
W.focus)
([Stack a] -> Maybe (Stack a)) -> [Stack a] -> Maybe (Stack a)
forall a b. (a -> b) -> a -> b
$ (Stack a -> Stack a) -> Stack a -> [Stack a]
forall a. (a -> a) -> a -> [a]
iterate (if a
w a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
u then Stack a -> Stack a
forall a. Stack a -> Stack a
W.focusUp'
else Stack a -> Stack a
forall a. Stack a -> Stack a
W.focusDown') Stack a
st
| a
w a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
f = Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just Stack a
st
| Bool
otherwise = Maybe (Stack a)
forall a. Maybe a
Nothing
trackFloating :: l a -> ModifiedLayout TrackFloating l a
trackFloating :: l a -> ModifiedLayout TrackFloating l a
trackFloating l a
layout = TrackFloating a -> l a -> ModifiedLayout TrackFloating l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (Bool -> Maybe Window -> TrackFloating a
forall a. Bool -> Maybe Window -> TrackFloating a
TrackFloating Bool
False Maybe Window
forall a. Maybe a
Nothing) l a
layout