{-# LANGUAGE ViewPatterns #-}
module XMonad.Actions.CycleWindows (
cycleRecentWindows,
cycleStacks',
rotOpposite', rotOpposite,
rotFocused', rotFocusedUp, rotFocusedDown, shiftToFocus',
rotUnfocused', rotUnfocusedUp, rotUnfocusedDown,
rotUp, rotDown
) where
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import qualified Data.List.NonEmpty as NE
import XMonad.Actions.RotSlaves
import Control.Arrow (second)
cycleRecentWindows :: [KeySym]
-> KeySym
-> KeySym
-> X ()
cycleRecentWindows :: [Window] -> Window -> Window -> X ()
cycleRecentWindows = (Stack Window -> [Stack Window])
-> [Window] -> Window -> Window -> X ()
cycleStacks' forall {a}. (Eq a, Show a, Read a) => Stack a -> [Stack a]
stacks where
stacks :: Stack a -> [Stack a]
stacks Stack a
s = forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Eq a, Show a, Read a) => a -> Stack a -> Stack a
`shiftToFocus'` Stack a
s) (forall {a}. Stack a -> [a]
wins Stack a
s)
wins :: Stack a -> [a]
wins (W.Stack a
t [a]
l [a]
r) = a
t forall a. a -> [a] -> [a]
: [a]
r forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse [a]
l
cycleStacks' :: (W.Stack Window -> [W.Stack Window])
-> [KeySym]
-> KeySym
-> KeySym
-> X ()
cycleStacks' :: (Stack Window -> [Stack Window])
-> [Window] -> Window -> Window -> X ()
cycleStacks' Stack Window -> [Stack Window]
filteredPerms [Window]
mods Window
keyNext Window
keyPrev = do
XConf {theRoot :: XConf -> Window
theRoot = Window
root, display :: XConf -> Display
display = Display
d} <- forall r (m :: * -> *). MonadReader r m => m r
ask
[Stack Window]
stacks <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack Window -> [Stack Window]
filteredPerms forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack 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
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
let evt :: IO (EventType, Window)
evt = forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$
\XEventPtr
p -> do Display -> Window -> XEventPtr -> IO ()
maskEvent Display
d (Window
keyPressMask forall a. Bits a => a -> a -> a
.|. Window
keyReleaseMask) XEventPtr
p
KeyEvent {ev_event_type :: Event -> EventType
ev_event_type = EventType
t, ev_keycode :: Event -> KeyCode
ev_keycode = KeyCode
c} <- XEventPtr -> IO Event
getEvent XEventPtr
p
Window
s <- Display -> KeyCode -> CInt -> IO Window
keycodeToKeysym Display
d KeyCode
c CInt
0
forall (m :: * -> *) a. Monad m => a -> m a
return (EventType
t, Window
s)
choose :: Int -> (EventType, Window) -> X ()
choose Int
n (EventType
t, Window
s)
| EventType
t forall a. Eq a => a -> a -> Bool
== EventType
keyPress Bool -> Bool -> Bool
&& Window
s forall a. Eq a => a -> a -> Bool
== Window
keyNext = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO (EventType, Window)
evt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> (EventType, Window) -> X ()
choose (Int
nforall a. Num a => a -> a -> a
+Int
1)
| EventType
t forall a. Eq a => a -> a -> Bool
== EventType
keyPress Bool -> Bool -> Bool
&& Window
s forall a. Eq a => a -> a -> Bool
== Window
keyPrev = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO (EventType, Window)
evt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> (EventType, Window) -> X ()
choose (Int
nforall a. Num a => a -> a -> a
-Int
1)
| EventType
t forall a. Eq a => a -> a -> Bool
== EventType
keyPress Bool -> Bool -> Bool
&& Window
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window
xK_0..Window
xK_9] = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO (EventType, Window)
evt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> (EventType, Window) -> X ()
choose (Window -> Int
numKeyToN Window
s)
| EventType
t forall a. Eq a => a -> a -> Bool
== EventType
keyRelease Bool -> Bool -> Bool
&& Window
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
mods = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = Int -> X ()
doStack Int
n forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO (EventType, Window)
evt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> (EventType, Window) -> X ()
choose Int
n
doStack :: Int -> X ()
doStack Int
n = (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ [Stack Window]
stacks forall {a}. [a] -> Int -> a
`cycref` Int
n
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> Bool -> CInt -> CInt -> Window -> IO CInt
grabKeyboard Display
d Window
root Bool
False CInt
grabModeAsync CInt
grabModeAsync Window
currentTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO (EventType, Window)
evt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> (EventType, Window) -> X ()
choose Int
1
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO ()
ungrabKeyboard Display
d Window
currentTime
where cycref :: [a] -> Int -> a
cycref [a]
l Int
i = [a]
l forall {a}. [a] -> Int -> a
!! (Int
i forall a. Integral a => a -> a -> a
`mod` forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l)
numKeyToN :: Window -> Int
numKeyToN = forall a. Num a => a -> a -> a
subtract Int
48 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => WorkspaceId -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> WorkspaceId
show
shiftToFocus' :: (Eq a, Show a, Read a) => a -> W.Stack a -> W.Stack a
shiftToFocus' :: forall a. (Eq a, Show a, Read a) => a -> Stack a -> Stack a
shiftToFocus' a
w s :: Stack a
s@(W.Stack a
_ [a]
ls [a]
_) = forall a. a -> [a] -> [a] -> Stack a
W.Stack a
w (forall a. [a] -> [a]
reverse [a]
revls') [a]
rs'
where ([a]
revls', [a]
rs') = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= a
w) forall a b. (a -> b) -> a -> b
$ forall {a}. Stack a -> [a]
W.integrate Stack a
s
rotOpposite :: X()
rotOpposite :: X ()
rotOpposite = (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ 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. Stack a -> Stack a
rotOpposite'
rotOpposite' :: W.Stack a -> W.Stack a
rotOpposite' :: forall a. Stack a -> Stack a
rotOpposite' (W.Stack a
t [a]
l [a]
r) = forall a. a -> [a] -> [a] -> Stack a
W.Stack a
t' [a]
l' [a]
r'
where rrvl :: [a]
rrvl = [a]
r forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse [a]
l
part :: Int
part = (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
rrvl forall a. Num a => a -> a -> a
+ Int
1) forall a. Integral a => a -> a -> a
`div` Int
2
([a]
l', forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> a
t' :| [a]
r') = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l) forall a b. (a -> b) -> a -> b
$
forall a. [a] -> [a]
reverse (forall a. Int -> [a] -> [a]
take Int
part [a]
rrvl forall a. [a] -> [a] -> [a]
++ a
t forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
drop Int
part [a]
rrvl)
rotFocusedUp :: X ()
rotFocusedUp :: X ()
rotFocusedUp = (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
$ forall a. ([a] -> [a]) -> Stack a -> Stack a
rotFocused' forall a. [a] -> [a]
rotUp
rotFocusedDown :: X ()
rotFocusedDown :: X ()
rotFocusedDown = (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
$ forall a. ([a] -> [a]) -> Stack a -> Stack a
rotFocused' forall a. [a] -> [a]
rotDown
rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a
rotFocused' :: forall a. ([a] -> [a]) -> Stack a -> Stack a
rotFocused' [a] -> [a]
_ s :: Stack a
s@(W.Stack a
_ [] []) = Stack a
s
rotFocused' [a] -> [a]
f (W.Stack a
t [] (a
r:[a]
rs)) = forall a. a -> [a] -> [a] -> Stack a
W.Stack a
t' [] (a
rforall a. a -> [a] -> [a]
:[a]
rs')
where (forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> a
t' :| [a]
rs') = [a] -> [a]
f (a
tforall a. a -> [a] -> [a]
:[a]
rs)
rotFocused' [a] -> [a]
f s :: Stack a
s@W.Stack{} = forall a. ([a] -> [a]) -> Stack a -> Stack a
rotSlaves' [a] -> [a]
f Stack a
s
rotUnfocusedUp :: X ()
rotUnfocusedUp :: X ()
rotUnfocusedUp = (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
$ forall a. ([a] -> [a]) -> Stack a -> Stack a
rotUnfocused' forall a. [a] -> [a]
rotUp
rotUnfocusedDown :: X ()
rotUnfocusedDown :: X ()
rotUnfocusedDown = (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
$ forall a. ([a] -> [a]) -> Stack a -> Stack a
rotUnfocused' forall a. [a] -> [a]
rotDown
rotUnfocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a
rotUnfocused' :: forall a. ([a] -> [a]) -> Stack a -> Stack a
rotUnfocused' [a] -> [a]
_ s :: Stack a
s@(W.Stack a
_ [] []) = Stack a
s
rotUnfocused' [a] -> [a]
f s :: Stack a
s@(W.Stack a
_ [] [a]
_ ) = forall a. ([a] -> [a]) -> Stack a -> Stack a
rotSlaves' [a] -> [a]
f Stack a
s
rotUnfocused' [a] -> [a]
f (W.Stack a
t [a]
ls [a]
rs) = forall a. a -> [a] -> [a] -> Stack a
W.Stack a
t (forall a. [a] -> [a]
reverse [a]
revls') [a]
rs'
where (a
master :| [a]
revls) = forall a. NonEmpty a -> NonEmpty a
NE.reverse (let a
l:[a]
ll = [a]
ls in a
l forall a. a -> [a] -> NonEmpty a
:| [a]
ll)
([a]
revls',[a]
rs') = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls) ([a] -> [a]
f forall a b. (a -> b) -> a -> b
$ a
masterforall a. a -> [a] -> [a]
:[a]
revls forall a. [a] -> [a] -> [a]
++ [a]
rs)
rotUp :: [a] -> [a]
rotUp :: forall a. [a] -> [a]
rotUp [a]
l = forall a. Int -> [a] -> [a]
drop Int
1 [a]
l forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
take Int
1 [a]
l
rotDown :: [a] -> [a]
rotDown :: forall a. [a] -> [a]
rotDown = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
rotUp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse