{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternGuards #-}
module XMonad.Actions.CycleRecentWS (
cycleRecentWS,
cycleRecentNonEmptyWS,
cycleWindowSets,
toggleRecentWS,
toggleRecentNonEmptyWS,
toggleWindowSets,
recentWS,
#ifdef TESTING
unView,
#endif
) where
import XMonad hiding (workspaces)
import XMonad.StackSet hiding (filter)
import Control.Arrow ((&&&))
import Data.Function (on)
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
XConf {theRoot :: XConf -> KeySym
theRoot = KeySym
root, display :: XConf -> Display
display = Display
d} <- forall r (m :: * -> *). MonadReader r m => m r
ask
let event :: IO (KeySym, KeySym)
event = forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
p -> do
Display -> KeySym -> XEventPtr -> IO ()
maskEvent Display
d (KeySym
keyPressMask forall a. Bits a => a -> a -> a
.|. KeySym
keyReleaseMask) XEventPtr
p
KeyEvent {ev_event_type :: Event -> KeySym
ev_event_type = KeySym
t, ev_keycode :: Event -> KeyCode
ev_keycode = KeyCode
c} <- XEventPtr -> IO Event
getEvent XEventPtr
p
KeySym
s <- Display -> KeyCode -> CInt -> IO KeySym
keycodeToKeysym Display
d KeyCode
c CInt
0
forall (m :: * -> *) a. Monad m => a -> m a
return (KeySym
t, KeySym
s)
let setOption :: Int -> X ()
setOption Int
n = do (WindowSet -> WindowSet) -> X ()
windows 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
view ([WorkspaceId]
options forall a. [a] -> Int -> a
`cycref` Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> WindowSet
unView'
(KeySym
t, KeySym
s) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO (KeySym, KeySym)
event
case () of
() | KeySym
t forall a. Eq a => a -> a -> Bool
== KeySym
keyPress Bool -> Bool -> Bool
&& KeySym
s forall a. Eq a => a -> a -> Bool
== KeySym
keyNext -> Int -> X ()
setOption (Int
nforall a. Num a => a -> a -> a
+Int
1)
| KeySym
t forall a. Eq a => a -> a -> Bool
== KeySym
keyPress Bool -> Bool -> Bool
&& KeySym
s forall a. Eq a => a -> a -> Bool
== KeySym
keyPrev -> Int -> X ()
setOption (Int
nforall a. Num a => a -> a -> a
-Int
1)
| KeySym
t forall a. Eq a => a -> a -> Bool
== KeySym
keyRelease Bool -> Bool -> Bool
&& KeySym
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KeySym]
mods -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> Int -> X ()
setOption Int
n
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> KeySym -> Bool -> CInt -> CInt -> KeySym -> IO CInt
grabKeyboard Display
d KeySym
root Bool
False CInt
grabModeAsync CInt
grabModeAsync KeySym
currentTime
Int -> X ()
setOption Int
0
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> KeySym -> IO ()
ungrabKeyboard Display
d KeySym
currentTime
where
cycref :: [a] -> Int -> a
cycref :: forall a. [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)
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)