{-# 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 forall a b. (a -> b) -> a -> b
$ (WindowSpace -> Bool) -> WindowSet -> [WorkspaceId]
recentWS (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 forall a b. (a -> b) -> a -> b
$ (WindowSpace -> Bool) -> WindowSet -> [WorkspaceId]
recentWS (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
stack)
toggleRecentWS :: X ()
toggleRecentWS :: X ()
toggleRecentWS = (WindowSet -> [WorkspaceId]) -> X ()
toggleWindowSets forall a b. (a -> b) -> a -> b
$ (WindowSpace -> Bool) -> WindowSet -> [WorkspaceId]
recentWS (forall a b. a -> b -> a
const Bool
True)
toggleRecentNonEmptyWS :: X ()
toggleRecentNonEmptyWS :: X ()
toggleRecentNonEmptyWS = (WindowSet -> [WorkspaceId]) -> X ()
toggleWindowSets forall a b. (a -> b) -> a -> b
$ (WindowSpace -> Bool) -> WindowSet -> [WorkspaceId]
recentWS (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. (a -> b) -> [a] -> [b]
map forall i l a. Workspace i l a -> i
tag
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter WindowSpace -> Bool
p
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible WindowSet
w)
forall a. [a] -> [a] -> [a]
++ forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden WindowSet
w
forall a. [a] -> [a] -> [a]
++ [forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (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') <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ (WindowSet -> [WorkspaceId]
genOptions forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& 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 b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
let
preview :: StateT Int X ()
preview = do
Int
i <- forall s (m :: * -> *). MonadState s m => m s
get
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows (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 forall a. [a] -> Int -> a
!! (Int
i forall a. Integral a => a -> a -> a
`mod` Int
n)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> WindowSet
unView')
where n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [WorkspaceId]
options
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s.
Monoid a =>
s
-> [KeySym]
-> KeySym
-> (EventType -> KeySym -> StateT s X a)
-> X (a, s)
repeatableSt (-Int
1) [KeySym]
mods KeySym
keyNext forall a b. (a -> b) -> a -> b
$ \EventType
t KeySym
s -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventType
t forall a. Eq a => a -> a -> Bool
== EventType
keyPress) forall a b. (a -> b) -> a -> b
$ if
| KeySym
s forall a. Eq a => a -> a -> Bool
== KeySym
keyNext -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a. Enum a => a -> a
succ forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT Int X ()
preview
| KeySym
s forall a. Eq a => a -> a -> Bool
== KeySym
keyPrev -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a. Enum a => a -> a
pred forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT Int X ()
preview
| Bool
otherwise -> 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 = forall {sid} {sd}. StackSet i l a sid sd -> StackSet i l a sid sd
fixOrderH forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a s sd -> StackSet i l a s sd
fixOrderV forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {l} {a} {sd}.
i -> StackSet i l a s sd -> StackSet i l a s sd
view' (forall i l a s sd. StackSet i l a s sd -> i
currentTag StackSet i l a s sd
w0) 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 forall i l a sid sd. Screen i l a sid sd -> sid
screen (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) forall a. Eq a => a -> a -> Bool
== forall i l a sid sd. Screen i l a sid sd -> sid
screen (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 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 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 <- 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 :: [Screen i l a s sd]
visible = forall x. Int -> x -> [x] -> [x]
insertAt (forall {l} {a} {sid} {sd}.
[Screen i l a sid sd] -> [Screen i l a sid sd] -> Int
pfxV (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
w0) [Screen i l a s sd]
vs) Screen i l a s sd
v [Screen i l a s sd]
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 <- 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 :: [Workspace i l a]
hidden = forall x. Int -> x -> [x] -> [x]
insertAt (forall {l} {a}. [Workspace i l a] -> [Workspace i l a] -> Int
pfxH (forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden StackSet i l a s sd
w0) [Workspace i l a]
hs) Workspace i l a
h [Workspace i l a]
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 = forall x. Eq x => [x] -> [x] -> Int
commonPrefix forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall i l a. Workspace i l a -> i
tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall x. Eq x => [x] -> [x] -> Int
commonPrefix forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [x]
xs in [x]
l forall a. [a] -> [a] -> [a]
++ [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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ WindowSet -> [WorkspaceId]
genOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
case [WorkspaceId]
options of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
WorkspaceId
o:[WorkspaceId]
_ -> (WindowSet -> WindowSet) -> X ()
windows (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)