{-# 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 ((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 (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 (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 (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
XConf {theRoot :: XConf -> KeySym
theRoot = KeySym
root, display :: XConf -> Display
display = Display
d} <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask
let event :: IO (EventType, KeySym)
event = (XEventPtr -> IO (EventType, KeySym)) -> IO (EventType, KeySym)
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO (EventType, KeySym)) -> IO (EventType, KeySym))
-> (XEventPtr -> IO (EventType, KeySym)) -> IO (EventType, KeySym)
forall a b. (a -> b) -> a -> b
$ \XEventPtr
p -> do
Display -> KeySym -> XEventPtr -> IO ()
maskEvent Display
d (KeySym
keyPressMask KeySym -> KeySym -> KeySym
forall a. Bits a => a -> a -> a
.|. KeySym
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
KeySym
s <- Display -> KeyCode -> CInt -> IO KeySym
keycodeToKeysym Display
d KeyCode
c CInt
0
(EventType, KeySym) -> IO (EventType, KeySym)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventType
t, KeySym
s)
let setOption :: Int -> X ()
setOption Int
n = do (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ 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. [a] -> Int -> a
`cycref` Int
n) (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> WindowSet
unView'
(EventType
t, KeySym
s) <- IO (EventType, KeySym) -> X (EventType, KeySym)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO (EventType, KeySym)
event
case () of
() | EventType
t EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
keyPress Bool -> Bool -> Bool
&& KeySym
s KeySym -> KeySym -> Bool
forall a. Eq a => a -> a -> Bool
== KeySym
keyNext -> Int -> X ()
setOption (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
| EventType
t EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
keyPress Bool -> Bool -> Bool
&& KeySym
s KeySym -> KeySym -> Bool
forall a. Eq a => a -> a -> Bool
== KeySym
keyPrev -> Int -> X ()
setOption (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
| EventType
t EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
keyRelease Bool -> Bool -> Bool
&& KeySym
s KeySym -> [KeySym] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KeySym]
mods -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise -> Int -> X ()
setOption Int
n
IO CInt -> X CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO CInt -> X CInt) -> IO CInt -> X CInt
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
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
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 [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [a] -> Int
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 = 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 :: [Screen i l a s sd]
visible = Int
-> Screen i l a s sd -> [Screen i l a s sd] -> [Screen i l a s sd]
forall x. Int -> x -> [x] -> [x]
insertAt ([Screen i l a s sd] -> [Screen i l a s sd] -> Int
forall {l} {a} {sid} {sd}.
[Screen i l a sid sd] -> [Screen i l a sid sd] -> Int
pfxV (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
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 <- 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 :: [Workspace i l a]
hidden = Int -> Workspace i l a -> [Workspace i l a] -> [Workspace i l a]
forall x. Int -> x -> [x] -> [x]
insertAt ([Workspace i l a] -> [Workspace i l a] -> Int
forall {l} {a}. [Workspace i l a] -> [Workspace i l a] -> Int
pfxH (StackSet i l a s 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 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 = [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 (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 (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 (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 (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)