{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE MultiWayIf #-}
module XMonad.Actions.CycleRecentWS (
cycleRecentWS,
cycleRecentNonEmptyWS,
cycleWindowSets,
toggleRecentWS,
toggleRecentNonEmptyWS,
toggleWindowSets,
recentWS,
#ifdef TESTING
unView,
#endif
) where
import XMonad.Actions.Repeatable (repeatableSt)
import XMonad hiding (workspaces)
import XMonad.Prelude (void, when)
import XMonad.StackSet hiding (filter, modify)
import Control.Arrow ((&&&))
import Data.Function (on)
import Control.Monad.State (lift)
cycleRecentWS :: [KeySym]
-> KeySym
-> KeySym
-> X ()
cycleRecentWS :: [KeySym] -> KeySym -> KeySym -> X ()
cycleRecentWS = (WindowSet -> [WorkspaceId])
-> [KeySym] -> KeySym -> KeySym -> X ()
cycleWindowSets ((WindowSet -> [WorkspaceId])
-> [KeySym] -> KeySym -> KeySym -> X ())
-> (WindowSet -> [WorkspaceId])
-> [KeySym]
-> KeySym
-> KeySym
-> X ()
forall a b. (a -> b) -> a -> b
$ (WindowSpace -> Bool) -> WindowSet -> [WorkspaceId]
recentWS (Bool -> WindowSpace -> Bool
forall a b. a -> b -> a
const Bool
True)
cycleRecentNonEmptyWS :: [KeySym]
-> KeySym
-> KeySym
-> X ()
cycleRecentNonEmptyWS :: [KeySym] -> KeySym -> KeySym -> X ()
cycleRecentNonEmptyWS = (WindowSet -> [WorkspaceId])
-> [KeySym] -> KeySym -> KeySym -> X ()
cycleWindowSets ((WindowSet -> [WorkspaceId])
-> [KeySym] -> KeySym -> KeySym -> X ())
-> (WindowSet -> [WorkspaceId])
-> [KeySym]
-> KeySym
-> KeySym
-> X ()
forall a b. (a -> b) -> a -> b
$ (WindowSpace -> Bool) -> WindowSet -> [WorkspaceId]
recentWS (Bool -> Bool
not (Bool -> Bool) -> (WindowSpace -> Bool) -> WindowSpace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack KeySym) -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe (Stack KeySym) -> Bool)
-> (WindowSpace -> Maybe (Stack KeySym)) -> WindowSpace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> Maybe (Stack KeySym)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack)
toggleRecentWS :: X ()
toggleRecentWS :: X ()
toggleRecentWS = (WindowSet -> [WorkspaceId]) -> X ()
toggleWindowSets ((WindowSet -> [WorkspaceId]) -> X ())
-> (WindowSet -> [WorkspaceId]) -> X ()
forall a b. (a -> b) -> a -> b
$ (WindowSpace -> Bool) -> WindowSet -> [WorkspaceId]
recentWS (Bool -> WindowSpace -> Bool
forall a b. a -> b -> a
const Bool
True)
toggleRecentNonEmptyWS :: X ()
toggleRecentNonEmptyWS :: X ()
toggleRecentNonEmptyWS = (WindowSet -> [WorkspaceId]) -> X ()
toggleWindowSets ((WindowSet -> [WorkspaceId]) -> X ())
-> (WindowSet -> [WorkspaceId]) -> X ()
forall a b. (a -> b) -> a -> b
$ (WindowSpace -> Bool) -> WindowSet -> [WorkspaceId]
recentWS (Bool -> Bool
not (Bool -> Bool) -> (WindowSpace -> Bool) -> WindowSpace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack KeySym) -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe (Stack KeySym) -> Bool)
-> (WindowSpace -> Maybe (Stack KeySym)) -> WindowSpace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> Maybe (Stack KeySym)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack)
recentWS :: (WindowSpace -> Bool)
-> WindowSet
-> [WorkspaceId]
recentWS :: (WindowSpace -> Bool) -> WindowSet -> [WorkspaceId]
recentWS WindowSpace -> Bool
p WindowSet
w = (WindowSpace -> WorkspaceId) -> [WindowSpace] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
tag
([WindowSpace] -> [WorkspaceId]) -> [WindowSpace] -> [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ (WindowSpace -> Bool) -> [WindowSpace] -> [WindowSpace]
forall a. (a -> Bool) -> [a] -> [a]
filter WindowSpace -> Bool
p
([WindowSpace] -> [WindowSpace]) -> [WindowSpace] -> [WindowSpace]
forall a b. (a -> b) -> a -> b
$ (Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> WindowSpace)
-> [Screen
WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail]
-> [WindowSpace]
forall a b. (a -> b) -> [a] -> [b]
map Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (WindowSet
-> [Screen
WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible WindowSet
w)
[WindowSpace] -> [WindowSpace] -> [WindowSpace]
forall a. [a] -> [a] -> [a]
++ WindowSet -> [WindowSpace]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden WindowSet
w
[WindowSpace] -> [WindowSpace] -> [WindowSpace]
forall a. [a] -> [a] -> [a]
++ [Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (WindowSet
-> Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current WindowSet
w)]
cycleWindowSets :: (WindowSet -> [WorkspaceId])
-> [KeySym]
-> KeySym
-> KeySym
-> X ()
cycleWindowSets :: (WindowSet -> [WorkspaceId])
-> [KeySym] -> KeySym -> KeySym -> X ()
cycleWindowSets WindowSet -> [WorkspaceId]
genOptions [KeySym]
mods KeySym
keyNext KeySym
keyPrev = do
([WorkspaceId]
options, WindowSet -> WindowSet
unView') <- (XState -> ([WorkspaceId], WindowSet -> WindowSet))
-> X ([WorkspaceId], WindowSet -> WindowSet)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> ([WorkspaceId], WindowSet -> WindowSet))
-> X ([WorkspaceId], WindowSet -> WindowSet))
-> (XState -> ([WorkspaceId], WindowSet -> WindowSet))
-> X ([WorkspaceId], WindowSet -> WindowSet)
forall a b. (a -> b) -> a -> b
$ (WindowSet -> [WorkspaceId]
genOptions (WindowSet -> [WorkspaceId])
-> (WindowSet -> WindowSet -> WindowSet)
-> WindowSet
-> ([WorkspaceId], WindowSet -> WindowSet)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& WindowSet -> WindowSet -> WindowSet
forall i l a s sd.
(Eq i, Eq s) =>
StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd
unView) (WindowSet -> ([WorkspaceId], WindowSet -> WindowSet))
-> (XState -> WindowSet)
-> XState
-> ([WorkspaceId], WindowSet -> WindowSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
let
preview :: StateT Int X ()
preview = do
Int
i <- StateT Int X Int
forall s (m :: * -> *). MonadState s m => m s
get
X () -> StateT Int X ()
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (X () -> StateT Int X ()) -> X () -> StateT Int X ()
forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows (WorkspaceId -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view ([WorkspaceId]
options [WorkspaceId] -> Int -> WorkspaceId
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n)) (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> WindowSet
unView')
where n :: Int
n = [WorkspaceId] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WorkspaceId]
options
X ((), Int) -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X ((), Int) -> X ())
-> ((EventType -> KeySym -> StateT Int X ()) -> X ((), Int))
-> (EventType -> KeySym -> StateT Int X ())
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [KeySym]
-> KeySym
-> (EventType -> KeySym -> StateT Int X ())
-> X ((), Int)
forall a s.
Monoid a =>
s
-> [KeySym]
-> KeySym
-> (EventType -> KeySym -> StateT s X a)
-> X (a, s)
repeatableSt (-Int
1) [KeySym]
mods KeySym
keyNext ((EventType -> KeySym -> StateT Int X ()) -> X ())
-> (EventType -> KeySym -> StateT Int X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \EventType
t KeySym
s -> Bool -> StateT Int X () -> StateT Int X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventType
t EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
keyPress) (StateT Int X () -> StateT Int X ())
-> StateT Int X () -> StateT Int X ()
forall a b. (a -> b) -> a -> b
$ if
| KeySym
s KeySym -> KeySym -> Bool
forall a. Eq a => a -> a -> Bool
== KeySym
keyNext -> (Int -> Int) -> StateT Int X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Int -> Int
forall a. Enum a => a -> a
succ StateT Int X () -> StateT Int X () -> StateT Int X ()
forall a b. StateT Int X a -> StateT Int X b -> StateT Int X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT Int X ()
preview
| KeySym
s KeySym -> KeySym -> Bool
forall a. Eq a => a -> a -> Bool
== KeySym
keyPrev -> (Int -> Int) -> StateT Int X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Int -> Int
forall a. Enum a => a -> a
pred StateT Int X () -> StateT Int X () -> StateT Int X ()
forall a b. StateT Int X a -> StateT Int X b -> StateT Int X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT Int X ()
preview
| Bool
otherwise -> () -> StateT Int X ()
forall a. a -> StateT Int X a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
unView :: forall i l a s sd. (Eq i, Eq s)
=> StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd
unView :: forall i l a s sd.
(Eq i, Eq s) =>
StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd
unView StackSet i l a s sd
w0 StackSet i l a s sd
w1 = StackSet i l a s sd -> StackSet i l a s sd
forall {sid} {sd}. StackSet i l a sid sd -> StackSet i l a sid sd
fixOrderH (StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a s sd -> StackSet i l a s sd
fixOrderV (StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> StackSet i l a s sd -> StackSet i l a s sd
forall {l} {a} {sd}.
i -> StackSet i l a s sd -> StackSet i l a s sd
view' (StackSet i l a s sd -> i
forall i l a s sd. StackSet i l a s sd -> i
currentTag StackSet i l a s sd
w0) (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd -> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$ StackSet i l a s sd
w1
where
view' :: i -> StackSet i l a s sd -> StackSet i l a s sd
view' = if Screen i l a s sd -> s
forall i l a sid sd. Screen i l a sid sd -> sid
screen (StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
w0) s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== Screen i l a s sd -> s
forall i l a sid sd. Screen i l a sid sd -> sid
screen (StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
w1) then i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
greedyView else i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view
fixOrderV :: StackSet i l a s sd -> StackSet i l a s sd
fixOrderV StackSet i l a s sd
w | Screen i l a s sd
v : [Screen i l a s sd]
vs <- StackSet i l a s sd -> [Screen i l a s sd]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible StackSet i l a s sd
w = StackSet i l a s sd
w{ visible = insertAt (pfxV (visible w0) vs) v vs }
| Bool
otherwise = StackSet i l a s sd
w
fixOrderH :: StackSet i l a sid sd -> StackSet i l a sid sd
fixOrderH StackSet i l a sid sd
w | Workspace i l a
h : [Workspace i l a]
hs <- StackSet i l a sid sd -> [Workspace i l a]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden StackSet i l a sid sd
w = StackSet i l a sid sd
w{ hidden = insertAt (pfxH (hidden w0) hs) h hs }
| Bool
otherwise = StackSet i l a sid sd
w
pfxV :: [Screen i l a sid sd] -> [Screen i l a sid sd] -> Int
pfxV = [i] -> [i] -> Int
forall x. Eq x => [x] -> [x] -> Int
commonPrefix ([i] -> [i] -> Int)
-> ([Screen i l a sid sd] -> [i])
-> [Screen i l a sid sd]
-> [Screen i l a sid sd]
-> Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Screen i l a sid sd -> i) -> [Screen i l a sid sd] -> [i]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag (Workspace i l a -> i)
-> (Screen i l a sid sd -> Workspace i l a)
-> Screen i l a sid sd
-> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen i l a sid sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace)
pfxH :: [Workspace i l a] -> [Workspace i l a] -> Int
pfxH = [i] -> [i] -> Int
forall x. Eq x => [x] -> [x] -> Int
commonPrefix ([i] -> [i] -> Int)
-> ([Workspace i l a] -> [i])
-> [Workspace i l a]
-> [Workspace i l a]
-> Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Workspace i l a -> i) -> [Workspace i l a] -> [i]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag
insertAt :: Int -> x -> [x] -> [x]
insertAt :: forall x. Int -> x -> [x] -> [x]
insertAt Int
n x
x [x]
xs = let ([x]
l, [x]
r) = Int -> [x] -> ([x], [x])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [x]
xs in [x]
l [x] -> [x] -> [x]
forall a. [a] -> [a] -> [a]
++ [x
x] [x] -> [x] -> [x]
forall a. [a] -> [a] -> [a]
++ [x]
r
commonPrefix :: Eq x => [x] -> [x] -> Int
commonPrefix :: forall x. Eq x => [x] -> [x] -> Int
commonPrefix [x]
a [x]
b = [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Bool] -> Int) -> [Bool] -> Int
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Bool -> Bool
forall a. a -> a
id ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ (x -> x -> Bool) -> [x] -> [x] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith x -> x -> Bool
forall a. Eq a => a -> a -> Bool
(==) [x]
a [x]
b
toggleWindowSets :: (WindowSet -> [WorkspaceId]) -> X ()
toggleWindowSets :: (WindowSet -> [WorkspaceId]) -> X ()
toggleWindowSets WindowSet -> [WorkspaceId]
genOptions = do
[WorkspaceId]
options <- (XState -> [WorkspaceId]) -> X [WorkspaceId]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> [WorkspaceId]) -> X [WorkspaceId])
-> (XState -> [WorkspaceId]) -> X [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ WindowSet -> [WorkspaceId]
genOptions (WindowSet -> [WorkspaceId])
-> (XState -> WindowSet) -> XState -> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
case [WorkspaceId]
options of
[] -> () -> X ()
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
WorkspaceId
o:[WorkspaceId]
_ -> (WindowSet -> WindowSet) -> X ()
windows (WorkspaceId -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view WorkspaceId
o)