{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}
module XMonad.Layout.FocusTracking
(
FocusTracking(..)
, focusTracking
) where
import XMonad.Prelude
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Util.Stack (findZ)
import qualified XMonad.StackSet as W
newtype FocusTracking a = FocusTracking (Maybe Window)
deriving (ReadPrec [FocusTracking a]
ReadPrec (FocusTracking a)
Int -> ReadS (FocusTracking a)
ReadS [FocusTracking a]
(Int -> ReadS (FocusTracking a))
-> ReadS [FocusTracking a]
-> ReadPrec (FocusTracking a)
-> ReadPrec [FocusTracking a]
-> Read (FocusTracking a)
forall a. ReadPrec [FocusTracking a]
forall a. ReadPrec (FocusTracking a)
forall a. Int -> ReadS (FocusTracking a)
forall a. ReadS [FocusTracking a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Int -> ReadS (FocusTracking a)
readsPrec :: Int -> ReadS (FocusTracking a)
$creadList :: forall a. ReadS [FocusTracking a]
readList :: ReadS [FocusTracking a]
$creadPrec :: forall a. ReadPrec (FocusTracking a)
readPrec :: ReadPrec (FocusTracking a)
$creadListPrec :: forall a. ReadPrec [FocusTracking a]
readListPrec :: ReadPrec [FocusTracking a]
Read, Int -> FocusTracking a -> ShowS
[FocusTracking a] -> ShowS
FocusTracking a -> String
(Int -> FocusTracking a -> ShowS)
-> (FocusTracking a -> String)
-> ([FocusTracking a] -> ShowS)
-> Show (FocusTracking a)
forall a. Int -> FocusTracking a -> ShowS
forall a. [FocusTracking a] -> ShowS
forall a. FocusTracking a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> FocusTracking a -> ShowS
showsPrec :: Int -> FocusTracking a -> ShowS
$cshow :: forall a. FocusTracking a -> String
show :: FocusTracking a -> String
$cshowList :: forall a. [FocusTracking a] -> ShowS
showList :: [FocusTracking a] -> ShowS
Show)
instance LayoutModifier FocusTracking Window where
modifyLayoutWithUpdate :: forall (l :: * -> *).
LayoutClass l Window =>
FocusTracking Window
-> Workspace String (l Window) Window
-> Rectangle
-> X (([(Window, Rectangle)], Maybe (l Window)),
Maybe (FocusTracking Window))
modifyLayoutWithUpdate (FocusTracking 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)
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{ W.stack = newStack } Rectangle
r
(([(Window, Rectangle)], Maybe (l Window)),
Maybe (FocusTracking Window))
-> X (([(Window, Rectangle)], Maybe (l Window)),
Maybe (FocusTracking 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 () -> FocusTracking Window -> Maybe (FocusTracking Window)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe Window -> FocusTracking Window
forall a. Maybe Window -> FocusTracking a
FocusTracking Maybe Window
newState)
focusTracking :: l a -> ModifiedLayout FocusTracking l a
focusTracking :: forall (l :: * -> *) a. l a -> ModifiedLayout FocusTracking l a
focusTracking = FocusTracking a -> l a -> ModifiedLayout FocusTracking l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (Maybe Window -> FocusTracking a
forall a. Maybe Window -> FocusTracking a
FocusTracking Maybe Window
forall a. Maybe a
Nothing)