--------------------------------------------------------------------------------
-- |
-- Module       : XMonad.Actions.CycleWindows
-- Description  : Cycle windows while maintaining focus in place.
-- Copyright    : (c) Wirt Wolff <wirtwolff@gmail.com>
-- License      : BSD3-style (see LICENSE)
--
-- Maintainer   : Wirt Wolff <wirtwolff@gmail.com>
-- Stability    : unstable
-- Portability  : unportable
--
-- Provides bindings to cycle windows up or down on the current workspace
-- stack while maintaining focus in place.
--
-- Bindings are available to:
--
-- * Cycle nearby or nth windows into the focused frame
--
-- * Cycle a window halfway around the stack
--
-- * Cycle windows through the focused position.
--
-- * Cycle unfocused windows.
--
-- These bindings are especially useful with layouts that hide some of
-- the windows in the stack, such as Full, "XMonad.Layout.TwoPane" or
-- when using "XMonad.Layout.LimitWindows" to only show three or four
-- panes. See also "XMonad.Actions.RotSlaves" for related actions.
-----------------------------------------------------------------------------
module XMonad.Actions.CycleWindows (
        -- * Usage
        -- $usage

        -- * Cycling nearby or nth window into current frame
        -- $cycle
        cycleRecentWindows,
        cycleStacks',
        -- * Cycling half the stack to get rid of a boring window
        -- $opposite
        rotOpposite', rotOpposite,
        -- * Cycling windows through the current frame
        -- $focused
        rotFocused', rotFocusedUp, rotFocusedDown, shiftToFocus',
        -- * Cycling windows through other frames
        -- $unfocused
        rotUnfocused', rotUnfocusedUp, rotUnfocusedDown,
        -- * Updating the mouse pointer
        -- $pointer

        -- * Generic list rotations
        -- $generic
        rotUp, rotDown
) where

import XMonad
import qualified XMonad.StackSet as W
import XMonad.Actions.RotSlaves

import Control.Arrow (second)

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.CycleWindows
-- >    -- config
-- >    -- other key bindings with x here your config
-- >
-- >              -- make sure mod matches keysym
-- >  , ((mod4Mask,  xK_s), cycleRecentWindows [xK_Super_L] xK_s xK_w)
-- >  , ((modm, xK_z), rotOpposite)
-- >  , ((modm                , xK_i), rotUnfocusedUp)
-- >  , ((modm                , xK_u), rotUnfocusedDown)
-- >  , ((modm .|. controlMask, xK_i), rotFocusedUp)
-- >  , ((modm .|. controlMask, xK_u), rotFocusedDown)
--
-- Also, if you use focus follows mouse, you will want to read the section
-- on updating the mouse pointer below.  For detailed instructions on
-- editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".
{- $pointer
With FocusFollowsMouse == True, the focus is updated after binding
actions, possibly focusing a window you didn't intend to focus. Most
people using TwoPane probably already have a logHook causing the mouse
to follow focus. (See "XMonad.Actions.UpdatePointer", or "XMonad.Actions.Warp")

If you want this built into the key binding instead, use the appropriate
action from one of those modules to also have your bindings move the pointer
to the point of your choice on the current window:

> import XMonad.Actions.UpdatePointer -- or Actions.Warp

and either

> -- modify the window rotation bindings
> , ((modm .|. controlMask, xK_i   ), rotFocusedUp
>                                            >> updatePointer (Relative 1 1))
> , ((modm .|. controlMask, xK_u   ), rotFocusedDown
>                                            >> updatePointer (Relative 1 1))
>
>    -- or add to xmonad's logHook
>    , logHook = dynamicLogWithPP xmobarPP
>                    >> updatePointer Nearest -- or your preference

-}

-- $cycle
-- Cycle windows into focus from below or above the focused pane by pressing
-- a key while one or more modifier keys is held down. The window order isn't
-- changed until a modifier is released, leaving the previously focused window
-- just below the new one, (or above if the window just above is chosen.) For
-- best results use the same modifier + key combination as the one used to invoke
-- the \"bring from below\" action.  Also, once cycling, pressing a number key n
-- will focus the nth window, with 0 being the one originally focused.
cycleRecentWindows :: [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 shift windows from below the current choice into the current frame.
                    -> KeySym  -- ^ Key used to shift windows from above the current choice into the current frame.
                               --   If it's the same as the first key, it is effectively ignored.
                    -> X ()
cycleRecentWindows :: [KeySym] -> KeySym -> KeySym -> X ()
cycleRecentWindows = (Stack KeySym -> [Stack KeySym])
-> [KeySym] -> KeySym -> KeySym -> X ()
cycleStacks' Stack KeySym -> [Stack KeySym]
forall a. (Eq a, Show a, Read a) => Stack a -> [Stack a]
stacks where
    stacks :: Stack a -> [Stack a]
stacks Stack a
s = (a -> Stack a) -> [a] -> [Stack a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Stack a -> Stack a
forall a. (Eq a, Show a, Read a) => a -> Stack a -> Stack a
`shiftToFocus'` Stack a
s) (Stack a -> [a]
forall a. Stack a -> [a]
wins Stack a
s)
    wins :: Stack a -> [a]
wins (W.Stack a
t [a]
l [a]
r) = a
t a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
r [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
l


-- | Cycle through a /finite/ list of window stacks with repeated presses
--   of a key while a modifier key is held down. For best results use the same
--   mod key + key combination as the one used to invoke the \"bring from below\"
--   action. You could use cycleStacks' with a different stack permutations
--   function to, for example, cycle from one below to one above to two below,
--   etc. instead of in order. You are responsible for having it generate a
--   finite list, though, or xmonad may hang seeking its length.
cycleStacks' :: (W.Stack Window -> [W.Stack Window]) -- ^ A function to a finite list of permutations of a given stack.
                                    -> [KeySym]  -- ^ A list of modifier keys used to invoke 'cycleStacks''.
                                                 --   As soon as any is released, we're no longer cycling on the [Stack Window]
                                    -> KeySym    -- ^ Key used to select a \"next\" stack.
                                    -> KeySym    -- ^ Key used to select a \"previous\" stack.
                                    -> X ()
cycleStacks' :: (Stack KeySym -> [Stack KeySym])
-> [KeySym] -> KeySym -> KeySym -> X ()
cycleStacks' Stack KeySym -> [Stack KeySym]
filteredPerms [KeySym]
mods KeySym
keyNext KeySym
keyPrev = do
    XConf {theRoot :: XConf -> KeySym
theRoot = KeySym
root, display :: XConf -> Display
display = Display
d} <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask
    [Stack KeySym]
stacks <- (XState -> [Stack KeySym]) -> X [Stack KeySym]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> [Stack KeySym]) -> X [Stack KeySym])
-> (XState -> [Stack KeySym]) -> X [Stack KeySym]
forall a b. (a -> b) -> a -> b
$ [Stack KeySym]
-> (Stack KeySym -> [Stack KeySym])
-> Maybe (Stack KeySym)
-> [Stack KeySym]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack KeySym -> [Stack KeySym]
filteredPerms (Maybe (Stack KeySym) -> [Stack KeySym])
-> (XState -> Maybe (Stack KeySym)) -> XState -> [Stack KeySym]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace WorkspaceId (Layout KeySym) KeySym
-> Maybe (Stack KeySym)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace WorkspaceId (Layout KeySym) KeySym
 -> Maybe (Stack KeySym))
-> (XState -> Workspace WorkspaceId (Layout KeySym) KeySym)
-> XState
-> Maybe (Stack KeySym)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout KeySym) KeySym
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
 -> Workspace WorkspaceId (Layout KeySym) KeySym)
-> (XState
    -> Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> XState
-> Workspace WorkspaceId (Layout KeySym) KeySym
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> 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
W.current (StackSet WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
 -> Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> (XState
    -> StackSet
         WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> XState
-> Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
windowset

    let evt :: IO (EventType, KeySym)
evt = (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)
        choose :: Int -> (EventType, KeySym) -> X ()
choose Int
n (EventType
t, KeySym
s)
              | 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  = IO (EventType, KeySym) -> X (EventType, KeySym)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO (EventType, KeySym)
evt X (EventType, KeySym) -> ((EventType, KeySym) -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> (EventType, KeySym) -> X ()
choose (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  = IO (EventType, KeySym) -> X (EventType, KeySym)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO (EventType, KeySym)
evt X (EventType, KeySym) -> ((EventType, KeySym) -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> (EventType, KeySym) -> X ()
choose (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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KeySym
xK_0..KeySym
xK_9] = IO (EventType, KeySym) -> X (EventType, KeySym)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO (EventType, KeySym)
evt X (EventType, KeySym) -> ((EventType, KeySym) -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> (EventType, KeySym) -> X ()
choose (KeySym -> Int
numKeyToN KeySym
s)
              | 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 ()
doStack Int
n X () -> X (EventType, KeySym) -> X (EventType, KeySym)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (EventType, KeySym) -> X (EventType, KeySym)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO (EventType, KeySym)
evt X (EventType, KeySym) -> ((EventType, KeySym) -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> (EventType, KeySym) -> X ()
choose Int
n
        doStack :: Int -> X ()
doStack Int
n = (StackSet WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> X ()
windows ((StackSet WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
 -> X ())
-> (Stack KeySym
    -> StackSet
         WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> Stack KeySym
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack KeySym -> Stack KeySym)
-> StackSet
     WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' ((Stack KeySym -> Stack KeySym)
 -> StackSet
      WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> (Stack KeySym -> Stack KeySym -> Stack KeySym)
-> Stack KeySym
-> StackSet
     WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack KeySym -> Stack KeySym -> Stack KeySym
forall a b. a -> b -> a
const (Stack KeySym -> X ()) -> Stack KeySym -> X ()
forall a b. (a -> b) -> a -> b
$ [Stack KeySym]
stacks [Stack KeySym] -> Int -> Stack KeySym
forall a. [a] -> Int -> a
`cycref` 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
    IO (EventType, KeySym) -> X (EventType, KeySym)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO (EventType, KeySym)
evt X (EventType, KeySym) -> ((EventType, KeySym) -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> (EventType, KeySym) -> X ()
choose Int
1
    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 [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) -- modify' ensures l is never [], but must also be finite
        numKeyToN :: KeySym -> Int
numKeyToN = Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
48 (Int -> Int) -> (KeySym -> Int) -> KeySym -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> Int
forall a. Read a => WorkspaceId -> a
read (WorkspaceId -> Int) -> (KeySym -> WorkspaceId) -> KeySym -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeySym -> WorkspaceId
forall a. Show a => a -> WorkspaceId
show

-- | Given a stack element and a stack, shift or insert the element (window)
--   at the currently focused position.
shiftToFocus' :: (Eq a, Show a, Read a) => a -> W.Stack a -> W.Stack a
shiftToFocus' :: a -> Stack a -> Stack a
shiftToFocus' a
w s :: Stack a
s@(W.Stack a
_ [a]
ls [a]
_) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
w ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
revls') [a]
rs'
  where ([a]
revls', [a]
rs') = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls) ([a] -> ([a], [a])) -> ([a] -> [a]) -> [a] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
w) ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
s


-- $opposite
-- Shifts the focused window as far as possible from the current focus,
-- i.e. halfway around the stack. Windows above the focus up to the \"opposite\"
-- position remain in place, while those above the insertion shift toward
-- the current focus. This is useful for people who use lots of windows in Full,
-- TwoPane, etc., to get rid of boring windows while cycling and swapping
-- near the focus.
rotOpposite :: X()
rotOpposite :: X ()
rotOpposite = (StackSet WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> X ()
windows ((StackSet WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
 -> X ())
-> (StackSet
      WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ (Stack KeySym -> Stack KeySym)
-> StackSet
     WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' Stack KeySym -> Stack KeySym
forall a. Stack a -> Stack a
rotOpposite'

-- | The opposite rotation on a Stack.
rotOpposite' :: W.Stack a -> W.Stack a
rotOpposite' :: Stack a -> Stack a
rotOpposite' (W.Stack a
t [a]
l [a]
r) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
t' [a]
l' [a]
r'
  where rrvl :: [a]
rrvl = [a]
r [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
l
        part :: Int
part = ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
rrvl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        ([a]
l',a
t':[a]
r') =  ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [a] -> [a]
forall a. [a] -> [a]
reverse (([a], [a]) -> ([a], [a]))
-> ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l) ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall a b. (a -> b) -> a -> b
$
                                [a] -> [a]
forall a. [a] -> [a]
reverse (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
part [a]
rrvl [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
t a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
part [a]
rrvl)


-- $focused
-- Most people will want the @rotAllUp@ or @rotAllDown@ actions from
-- "XMonad.Actions.RotSlaves" to cycle all windows in the stack.
--
-- The following actions keep the \"next\" window stable, which is
-- mostly useful in two window layouts, or when you have a log viewer or
-- buffer window you want to keep next to the cycled window.

-- | Rotate windows through the focused frame, excluding the \"next\" window.
-- With, e.g. TwoPane, this allows cycling windows through either the
-- master or slave pane, without changing the other frame. When the master
-- is focused, the window below is skipped, when a non-master window is
-- focused, the master is skipped.
rotFocusedUp :: X ()
rotFocusedUp :: X ()
rotFocusedUp = (StackSet WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> X ()
windows ((StackSet WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
 -> X ())
-> ((Stack KeySym -> Stack KeySym)
    -> StackSet
         WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> (Stack KeySym -> Stack KeySym)
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack KeySym -> Stack KeySym)
-> StackSet
     WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' ((Stack KeySym -> Stack KeySym) -> X ())
-> (Stack KeySym -> Stack KeySym) -> X ()
forall a b. (a -> b) -> a -> b
$ ([KeySym] -> [KeySym]) -> Stack KeySym -> Stack KeySym
forall a. ([a] -> [a]) -> Stack a -> Stack a
rotFocused' [KeySym] -> [KeySym]
forall a. [a] -> [a]
rotUp
rotFocusedDown :: X ()
rotFocusedDown :: X ()
rotFocusedDown = (StackSet WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> X ()
windows ((StackSet WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
 -> X ())
-> ((Stack KeySym -> Stack KeySym)
    -> StackSet
         WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> (Stack KeySym -> Stack KeySym)
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack KeySym -> Stack KeySym)
-> StackSet
     WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' ((Stack KeySym -> Stack KeySym) -> X ())
-> (Stack KeySym -> Stack KeySym) -> X ()
forall a b. (a -> b) -> a -> b
$ ([KeySym] -> [KeySym]) -> Stack KeySym -> Stack KeySym
forall a. ([a] -> [a]) -> Stack a -> Stack a
rotFocused' [KeySym] -> [KeySym]
forall a. [a] -> [a]
rotDown

-- | The focused rotation on a stack.
rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a
rotFocused' :: ([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)) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
t' [] (a
ra -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs') -- Master has focus
    where (a
t':[a]
rs') = [a] -> [a]
f (a
ta -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs)
rotFocused' [a] -> [a]
f s :: Stack a
s@W.Stack{} = ([a] -> [a]) -> Stack a -> Stack a
forall a. ([a] -> [a]) -> Stack a -> Stack a
rotSlaves' [a] -> [a]
f Stack a
s                    -- otherwise


-- $unfocused
-- Rotate windows through the unfocused frames. This is similar to
-- @rotSlaves@, from "XMonad.Actions.RotSlaves", but excludes the current
-- frame rather than master.
rotUnfocusedUp :: X ()
rotUnfocusedUp :: X ()
rotUnfocusedUp = (StackSet WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> X ()
windows ((StackSet WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
 -> X ())
-> ((Stack KeySym -> Stack KeySym)
    -> StackSet
         WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> (Stack KeySym -> Stack KeySym)
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack KeySym -> Stack KeySym)
-> StackSet
     WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' ((Stack KeySym -> Stack KeySym) -> X ())
-> (Stack KeySym -> Stack KeySym) -> X ()
forall a b. (a -> b) -> a -> b
$ ([KeySym] -> [KeySym]) -> Stack KeySym -> Stack KeySym
forall a. ([a] -> [a]) -> Stack a -> Stack a
rotUnfocused' [KeySym] -> [KeySym]
forall a. [a] -> [a]
rotUp
rotUnfocusedDown :: X ()
rotUnfocusedDown :: X ()
rotUnfocusedDown = (StackSet WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> X ()
windows ((StackSet WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
 -> X ())
-> ((Stack KeySym -> Stack KeySym)
    -> StackSet
         WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail)
-> (Stack KeySym -> Stack KeySym)
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack KeySym -> Stack KeySym)
-> StackSet
     WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' ((Stack KeySym -> Stack KeySym) -> X ())
-> (Stack KeySym -> Stack KeySym) -> X ()
forall a b. (a -> b) -> a -> b
$ ([KeySym] -> [KeySym]) -> Stack KeySym -> Stack KeySym
forall a. ([a] -> [a]) -> Stack a -> Stack a
rotUnfocused' [KeySym] -> [KeySym]
forall a. [a] -> [a]
rotDown

-- | The unfocused rotation on a stack.
rotUnfocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a
rotUnfocused' :: ([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]
_ ) = ([a] -> [a]) -> Stack a -> Stack a
forall a. ([a] -> [a]) -> Stack a -> Stack a
rotSlaves' [a] -> [a]
f Stack a
s                 -- Master has focus
rotUnfocused' [a] -> [a]
f   (W.Stack a
t [a]
ls [a]
rs) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
t ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
revls') [a]
rs' -- otherwise
    where  (a
master:[a]
revls)  = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ls
           ([a]
revls',[a]
rs') = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls) ([a] -> [a]
f ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a
mastera -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
revls [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
rs)

-- $generic
-- Generic list rotations such that @rotUp [1..4]@ is equivalent to
-- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are
-- @id@ for null or singleton lists.
rotUp :: [a] -> [a]
rotUp :: [a] -> [a]
rotUp   [a]
l = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
1 [a]
l
rotDown :: [a] -> [a]
rotDown :: [a] -> [a]
rotDown = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
rotUp ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse