{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, MultiWayIf #-}
module XMonad.Hooks.RefocusLast (
refocusLastLogHook,
refocusLastLayoutHook,
refocusLastWhen,
refocusingIsActive,
isFloat,
toggleRefocusing,
toggleFocus,
swapWithLast,
refocusWhen,
shiftRLWhen,
updateRecentsOn,
RecentWins(..),
RecentsMap(..),
RefocusLastLayoutHook(..),
RefocusLastToggle(..),
withRecentsIn,
) where
import XMonad
import XMonad.Prelude (All (..), asum, fromMaybe, when)
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.Stack (findS, mapZ_)
import XMonad.Layout.LayoutModifier
import qualified Data.Map.Strict as M
data RecentWins = Recent { RecentWins -> Window
previous :: !Window, RecentWins -> Window
current :: !Window }
deriving (Int -> RecentWins -> ShowS
[RecentWins] -> ShowS
RecentWins -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [RecentWins] -> ShowS
$cshowList :: [RecentWins] -> ShowS
show :: RecentWins -> WorkspaceId
$cshow :: RecentWins -> WorkspaceId
showsPrec :: Int -> RecentWins -> ShowS
$cshowsPrec :: Int -> RecentWins -> ShowS
Show, ReadPrec [RecentWins]
ReadPrec RecentWins
Int -> ReadS RecentWins
ReadS [RecentWins]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RecentWins]
$creadListPrec :: ReadPrec [RecentWins]
readPrec :: ReadPrec RecentWins
$creadPrec :: ReadPrec RecentWins
readList :: ReadS [RecentWins]
$creadList :: ReadS [RecentWins]
readsPrec :: Int -> ReadS RecentWins
$creadsPrec :: Int -> ReadS RecentWins
Read, RecentWins -> RecentWins -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecentWins -> RecentWins -> Bool
$c/= :: RecentWins -> RecentWins -> Bool
== :: RecentWins -> RecentWins -> Bool
$c== :: RecentWins -> RecentWins -> Bool
Eq)
newtype RecentsMap = RecentsMap (M.Map WorkspaceId RecentWins)
deriving (Int -> RecentsMap -> ShowS
[RecentsMap] -> ShowS
RecentsMap -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [RecentsMap] -> ShowS
$cshowList :: [RecentsMap] -> ShowS
show :: RecentsMap -> WorkspaceId
$cshow :: RecentsMap -> WorkspaceId
showsPrec :: Int -> RecentsMap -> ShowS
$cshowsPrec :: Int -> RecentsMap -> ShowS
Show, ReadPrec [RecentsMap]
ReadPrec RecentsMap
Int -> ReadS RecentsMap
ReadS [RecentsMap]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RecentsMap]
$creadListPrec :: ReadPrec [RecentsMap]
readPrec :: ReadPrec RecentsMap
$creadPrec :: ReadPrec RecentsMap
readList :: ReadS [RecentsMap]
$creadList :: ReadS [RecentsMap]
readsPrec :: Int -> ReadS RecentsMap
$creadsPrec :: Int -> ReadS RecentsMap
Read, RecentsMap -> RecentsMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecentsMap -> RecentsMap -> Bool
$c/= :: RecentsMap -> RecentsMap -> Bool
== :: RecentsMap -> RecentsMap -> Bool
$c== :: RecentsMap -> RecentsMap -> Bool
Eq)
instance ExtensionClass RecentsMap where
initialValue :: RecentsMap
initialValue = Map WorkspaceId RecentWins -> RecentsMap
RecentsMap forall k a. Map k a
M.empty
extensionType :: RecentsMap -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension
data RefocusLastLayoutHook a = RefocusLastLayoutHook
deriving (Int -> RefocusLastLayoutHook a -> ShowS
forall a. Int -> RefocusLastLayoutHook a -> ShowS
forall a. [RefocusLastLayoutHook a] -> ShowS
forall a. RefocusLastLayoutHook a -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [RefocusLastLayoutHook a] -> ShowS
$cshowList :: forall a. [RefocusLastLayoutHook a] -> ShowS
show :: RefocusLastLayoutHook a -> WorkspaceId
$cshow :: forall a. RefocusLastLayoutHook a -> WorkspaceId
showsPrec :: Int -> RefocusLastLayoutHook a -> ShowS
$cshowsPrec :: forall a. Int -> RefocusLastLayoutHook a -> ShowS
Show, ReadPrec [RefocusLastLayoutHook a]
ReadPrec (RefocusLastLayoutHook a)
ReadS [RefocusLastLayoutHook a]
forall a. ReadPrec [RefocusLastLayoutHook a]
forall a. ReadPrec (RefocusLastLayoutHook a)
forall a. Int -> ReadS (RefocusLastLayoutHook a)
forall a. ReadS [RefocusLastLayoutHook a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RefocusLastLayoutHook a]
$creadListPrec :: forall a. ReadPrec [RefocusLastLayoutHook a]
readPrec :: ReadPrec (RefocusLastLayoutHook a)
$creadPrec :: forall a. ReadPrec (RefocusLastLayoutHook a)
readList :: ReadS [RefocusLastLayoutHook a]
$creadList :: forall a. ReadS [RefocusLastLayoutHook a]
readsPrec :: Int -> ReadS (RefocusLastLayoutHook a)
$creadsPrec :: forall a. Int -> ReadS (RefocusLastLayoutHook a)
Read)
instance LayoutModifier RefocusLastLayoutHook a where
modifyLayout :: forall (l :: * -> *).
LayoutClass l a =>
RefocusLastLayoutHook a
-> Workspace WorkspaceId (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
modifyLayout RefocusLastLayoutHook a
_ w :: Workspace WorkspaceId (l a) a
w@(W.Workspace WorkspaceId
tg l a
_ Maybe (Stack a)
_) Rectangle
r = WorkspaceId -> X ()
updateRecentsOn WorkspaceId
tg forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace WorkspaceId (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace WorkspaceId (l a) a
w Rectangle
r
newtype RefocusLastToggle = RefocusLastToggle { RefocusLastToggle -> Bool
refocusing :: Bool }
deriving (Int -> RefocusLastToggle -> ShowS
[RefocusLastToggle] -> ShowS
RefocusLastToggle -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [RefocusLastToggle] -> ShowS
$cshowList :: [RefocusLastToggle] -> ShowS
show :: RefocusLastToggle -> WorkspaceId
$cshow :: RefocusLastToggle -> WorkspaceId
showsPrec :: Int -> RefocusLastToggle -> ShowS
$cshowsPrec :: Int -> RefocusLastToggle -> ShowS
Show, ReadPrec [RefocusLastToggle]
ReadPrec RefocusLastToggle
Int -> ReadS RefocusLastToggle
ReadS [RefocusLastToggle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RefocusLastToggle]
$creadListPrec :: ReadPrec [RefocusLastToggle]
readPrec :: ReadPrec RefocusLastToggle
$creadPrec :: ReadPrec RefocusLastToggle
readList :: ReadS [RefocusLastToggle]
$creadList :: ReadS [RefocusLastToggle]
readsPrec :: Int -> ReadS RefocusLastToggle
$creadsPrec :: Int -> ReadS RefocusLastToggle
Read, RefocusLastToggle -> RefocusLastToggle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RefocusLastToggle -> RefocusLastToggle -> Bool
$c/= :: RefocusLastToggle -> RefocusLastToggle -> Bool
== :: RefocusLastToggle -> RefocusLastToggle -> Bool
$c== :: RefocusLastToggle -> RefocusLastToggle -> Bool
Eq)
instance ExtensionClass RefocusLastToggle where
initialValue :: RefocusLastToggle
initialValue = RefocusLastToggle { refocusing :: Bool
refocusing = Bool
True }
extensionType :: RefocusLastToggle -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension
refocusLastLogHook :: X ()
refocusLastLogHook :: X ()
refocusLastLogHook = forall a. (WindowSet -> X a) -> X a
withWindowSet (WorkspaceId -> X ()
updateRecentsOn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> i
W.currentTag)
refocusLastLayoutHook :: l a -> ModifiedLayout RefocusLastLayoutHook l a
refocusLastLayoutHook :: forall (l :: * -> *) a.
l a -> ModifiedLayout RefocusLastLayoutHook l a
refocusLastLayoutHook = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall a. RefocusLastLayoutHook a
RefocusLastLayoutHook
refocusLastWhen :: Query Bool -> Event -> X All
refocusLastWhen :: Query Bool -> Event -> X All
refocusLastWhen Query Bool
p Event
event = Bool -> All
All Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ case Event
event of
UnmapEvent { ev_send_event :: Event -> Bool
ev_send_event = Bool
synth, ev_window :: Event -> Window
ev_window = Window
w } -> do
Int
e <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. a -> Maybe a -> a
fromMaybe Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> Map Window Int
waitingUnmap)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
synth Bool -> Bool -> Bool
|| Int
e forall a. Eq a => a -> a -> Bool
== Int
0) (Window -> X ()
refocusLast Window
w)
DestroyWindowEvent { ev_window :: Event -> Window
ev_window = Window
w } -> Window -> X ()
refocusLast Window
w
Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
refocusLast :: Window -> X ()
refocusLast Window
w = X Bool -> X () -> X ()
whenX (forall a. Query a -> Window -> X a
runQuery Query Bool
p Window
w) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
ws ->
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Window
w WindowSet
ws) forall a b. (a -> b) -> a -> b
$ \WorkspaceId
tag ->
forall a. WorkspaceId -> a -> (Window -> Window -> X a) -> X a
withRecentsIn WorkspaceId
tag () forall a b. (a -> b) -> a -> b
$ \Window
lw Window
cw ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
w forall a. Eq a => a -> a -> Bool
== Window
cw) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XState
xs ->
XState
xs { windowset :: WindowSet
windowset = WorkspaceId -> [Window] -> WindowSet -> WindowSet
tryFocusIn WorkspaceId
tag [Window
lw] WindowSet
ws }
refocusingIsActive :: Query Bool
refocusingIsActive :: Query Bool
refocusingIsActive = (forall a. X a -> Query a
liftX forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets) RefocusLastToggle -> Bool
refocusing
isFloat :: Query Bool
isFloat :: Query Bool
isFloat = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> (forall a. X a -> Query a
liftX forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets) (forall k a. Ord k => k -> Map k a -> Bool
M.member Window
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
toggleRefocusing :: X ()
toggleRefocusing :: X ()
toggleRefocusing = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (Bool -> RefocusLastToggle
RefocusLastToggle forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefocusLastToggle -> Bool
refocusing)
toggleFocus :: X ()
toggleFocus :: X ()
toggleFocus = (Window -> Window -> X ()) -> X ()
withRecents forall a b. (a -> b) -> a -> b
$ \Window
lw Window
cw ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
cw forall a. Eq a => a -> a -> Bool
/= Window
lw) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ [Window] -> WindowSet -> WindowSet
tryFocus [Window
lw]
swapWithLast :: X ()
swapWithLast :: X ()
swapWithLast = (Window -> Window -> X ()) -> X ()
withRecents forall a b. (a -> b) -> a -> b
$ \Window
lw Window
cw ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
cw forall a. Eq a => a -> a -> Bool
/= Window
lw) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {i} {l} {s} {sd}.
(Maybe (Stack a) -> Maybe (Stack a))
-> StackSet i l a s sd -> StackSet i l a s sd
modify''forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Zipper a -> Zipper b
mapZ_ forall a b. (a -> b) -> a -> b
$ \Window
w ->
if | (Window
w forall a. Eq a => a -> a -> Bool
== Window
lw) -> Window
cw
| (Window
w forall a. Eq a => a -> a -> Bool
== Window
cw) -> Window
lw
| Bool
otherwise -> Window
w
where modify'' :: (Maybe (Stack a) -> Maybe (Stack a))
-> StackSet i l a s sd -> StackSet i l a s sd
modify'' Maybe (Stack a) -> Maybe (Stack a)
f = forall a i l s sd.
Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
W.modify (Maybe (Stack a) -> Maybe (Stack a)
f forall a. Maybe a
Nothing) (Maybe (Stack a) -> Maybe (Stack a)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
refocusWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)
refocusWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)
refocusWhen Query Bool
p WorkspaceId
tag = forall a. WorkspaceId -> a -> (Window -> Window -> X a) -> X a
withRecentsIn WorkspaceId
tag forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ \Window
lw Window
cw -> do
Bool
b <- forall a. Query a -> Window -> X a
runQuery Query Bool
p Window
cw
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
b then WorkspaceId -> [Window] -> WindowSet -> WindowSet
tryFocusIn WorkspaceId
tag [Window
cw, Window
lw] else forall a. a -> a
id)
shiftRLWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)
shiftRLWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)
shiftRLWhen Query Bool
p WorkspaceId
to = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> do
WindowSet -> WindowSet
refocus <- Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)
refocusWhen Query Bool
p (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws)
let shift :: StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
shift = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
W.shiftWin WorkspaceId
to) (forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ws)
forall (m :: * -> *) a. Monad m => a -> m a
return (WindowSet -> WindowSet
refocus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {l} {sd}.
StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
shift)
updateRecentsOn :: WorkspaceId -> X ()
updateRecentsOn :: WorkspaceId -> X ()
updateRecentsOn WorkspaceId
tag = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
ws ->
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek forall a b. (a -> b) -> a -> b
$ 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 WorkspaceId
tag WindowSet
ws) forall a b. (a -> b) -> a -> b
$ \Window
fw -> do
Map WorkspaceId RecentWins
m <- X (Map WorkspaceId RecentWins)
getRecentsMap
let insertRecent :: Window -> Window -> m ()
insertRecent Window
l Window
c = forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WorkspaceId RecentWins -> RecentsMap
RecentsMap forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
tag (Window -> Window -> RecentWins
Recent Window
l Window
c) Map WorkspaceId RecentWins
m
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WorkspaceId
tag Map WorkspaceId RecentWins
m of
Just (Recent Window
_ Window
cw) -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
cw forall a. Eq a => a -> a -> Bool
/= Window
fw) (forall {m :: * -> *}. XLike m => Window -> Window -> m ()
insertRecent Window
cw Window
fw)
Maybe RecentWins
Nothing -> forall {m :: * -> *}. XLike m => Window -> Window -> m ()
insertRecent Window
fw Window
fw
tryFocus :: [Window] -> WindowSet -> WindowSet
tryFocus :: [Window] -> WindowSet -> WindowSet
tryFocus [Window]
wins = forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' forall a b. (a -> b) -> a -> b
$ \Stack Window
s ->
forall a. a -> Maybe a -> a
fromMaybe Stack Window
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum forall a b. (a -> b) -> a -> b
$ (\Window
w -> forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
findS (forall a. Eq a => a -> a -> Bool
== Window
w) Stack Window
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Window]
wins
tryFocusIn :: WorkspaceId -> [Window] -> WindowSet -> WindowSet
tryFocusIn :: WorkspaceId -> [Window] -> WindowSet -> WindowSet
tryFocusIn WorkspaceId
tag [Window]
wins WindowSet
ws =
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 s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Window] -> WindowSet -> WindowSet
tryFocus [Window]
wins 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 WorkspaceId
tag forall a b. (a -> b) -> a -> b
$ WindowSet
ws
getRecentsMap :: X (M.Map WorkspaceId RecentWins)
getRecentsMap :: X (Map WorkspaceId RecentWins)
getRecentsMap = forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(RecentsMap Map WorkspaceId RecentWins
m) -> forall (m :: * -> *) a. Monad m => a -> m a
return Map WorkspaceId RecentWins
m
withRecentsIn :: WorkspaceId -> a -> (Window -> Window -> X a) -> X a
withRecentsIn :: forall a. WorkspaceId -> a -> (Window -> Window -> X a) -> X a
withRecentsIn WorkspaceId
tag a
dflt Window -> Window -> X a
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return a
dflt) (\(Recent Window
lw Window
cw) -> Window -> Window -> X a
f Window
lw Window
cw)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WorkspaceId
tag
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X (Map WorkspaceId RecentWins)
getRecentsMap
withRecents :: (Window -> Window -> X ()) -> X ()
withRecents :: (Window -> Window -> X ()) -> X ()
withRecents Window -> Window -> X ()
f = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> forall a. WorkspaceId -> a -> (Window -> Window -> X a) -> X a
withRecentsIn (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) () Window -> Window -> X ()
f