-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.CycleRecentWS
-- Copyright   :  (c) Michal Janeczek <janeczek@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Michal Janeczek <janeczek@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Provides bindings to cycle through most recently used workspaces
-- with repeated presses of a single key (as long as modifier key is
-- held down). This is similar to how many window managers handle
-- window switching.
--
-----------------------------------------------------------------------------

module XMonad.Actions.CycleRecentWS (
                                -- * Usage
                                -- $usage
                                cycleRecentWS,
                                cycleWindowSets
) where

import XMonad hiding (workspaces)
import XMonad.StackSet

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.CycleRecentWS
-- >
-- >   , ((modm, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave)
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".

-- | Cycle through most recent workspaces with repeated presses of a key, while
--   a modifier key is held down. The recency of workspaces previewed while browsing
--   to the target workspace is not affected. That way a stack of most recently used
--   workspaces is maintained, similarly to how many window managers handle window
--   switching. For best effects use the same modkey+key combination as the one used
--   to invoke this action.
cycleRecentWS :: [KeySym] -- ^ A list of modifier keys used when invoking this action.
                          --   As soon as one of them is released, the final switch is made.
              -> KeySym   -- ^ Key used to switch to next (less recent) workspace.
              -> KeySym   -- ^ Key used to switch to previous (more recent) workspace.
                          --   If it's the same as the nextWorkspace key, it is effectively ignored.
              -> X ()
cycleRecentWS :: [KeySym] -> KeySym -> KeySym -> X ()
cycleRecentWS = (WindowSet -> [WindowSet]) -> [KeySym] -> KeySym -> KeySym -> X ()
cycleWindowSets WindowSet -> [WindowSet]
forall s b l a sd.
(Eq s, Eq b) =>
StackSet b l a s sd -> [StackSet b l a s sd]
options
 where options :: StackSet b l a s sd -> [StackSet b l a s sd]
options StackSet b l a s sd
w = (b -> StackSet b l a s sd) -> [b] -> [StackSet b l a s sd]
forall a b. (a -> b) -> [a] -> [b]
map (b -> StackSet b l a s sd -> StackSet b 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 (b -> StackSet b l a s sd -> StackSet b l a s sd)
-> StackSet b l a s sd -> b -> StackSet b l a s sd
forall a b c. (a -> b -> c) -> b -> a -> c
`flip` StackSet b l a s sd
w) (StackSet b l a s sd -> [b]
forall b l a s sd. StackSet b l a s sd -> [b]
recentTags StackSet b l a s sd
w)
       recentTags :: StackSet b l a s sd -> [b]
recentTags StackSet b l a s sd
w = (Workspace b l a -> b) -> [Workspace b l a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Workspace b l a -> b
forall i l a. Workspace i l a -> i
tag ([Workspace b l a] -> [b]) -> [Workspace b l a] -> [b]
forall a b. (a -> b) -> a -> b
$ [Workspace b l a] -> [Workspace b l a]
forall a. [a] -> [a]
tail (StackSet b l a s sd -> [Workspace b l a]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces StackSet b l a s sd
w) [Workspace b l a] -> [Workspace b l a] -> [Workspace b l a]
forall a. [a] -> [a] -> [a]
++ [[Workspace b l a] -> Workspace b l a
forall a. [a] -> a
head (StackSet b l a s sd -> [Workspace b l a]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
workspaces StackSet b l a s sd
w)]


cycref :: [a] -> Int -> a
cycref :: [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)

-- | Cycle through a finite list of WindowSets with repeated presses of a key, while
--   a modifier key is held down. For best effects use the same modkey+key combination
--   as the one used to invoke this action.
cycleWindowSets :: (WindowSet -> [WindowSet]) -- ^ A function used to create a list of WindowSets to choose from
                -> [KeySym]                   -- ^ A list of modifier keys used when invoking this action.
                                              --   As soon as one of them is released, the final WindowSet is chosen and the action exits.
                -> KeySym                     -- ^ Key used to preview next WindowSet from the list of generated options
                -> KeySym                     -- ^ Key used to preview previous WindowSet from the list of generated options.
                                              --   If it's the same as nextOption key, it is effectively ignored.
                -> X ()
cycleWindowSets :: (WindowSet -> [WindowSet]) -> [KeySym] -> KeySym -> KeySym -> X ()
cycleWindowSets WindowSet -> [WindowSet]
genOptions [KeySym]
mods KeySym
keyNext KeySym
keyPrev = do
  [WindowSet]
options <- (XState -> [WindowSet]) -> X [WindowSet]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> [WindowSet]) -> X [WindowSet])
-> (XState -> [WindowSet]) -> X [WindowSet]
forall a b. (a -> b) -> a -> b
$ WindowSet -> [WindowSet]
genOptions (WindowSet -> [WindowSet])
-> (XState -> WindowSet) -> XState -> [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
$ WindowSet -> WindowSet -> WindowSet
forall a b. a -> b -> a
const (WindowSet -> WindowSet -> WindowSet)
-> WindowSet -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ [WindowSet]
options [WindowSet] -> Int -> WindowSet
forall a. [a] -> Int -> a
`cycref` Int
n
                       (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