Added ability to cycle linearly through workspaces with win-N and win-P

1 files changed, 26 insertions, 0 deletions

diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs
index 4828f27..3e7e054 100644
--- a/src/Internal/Keys.hs
+++ b/src/Internal/Keys.hs
@@ -1,5 +1,7 @@
+{-# LANGUAGE RankNTypes #-}
 module Internal.Keys where
 
+import Data.Maybe (isJust)
 import Debug.Trace
 import Control.Applicative
 import Prelude hiding ((!!))
@@ -32,6 +34,8 @@ applyKeys config@(XConfig {modMask = modm}) = do
    withWindowNavigation (xK_k, xK_h, xK_j, xK_l) $
      config { keys = ks }
 
+newtype Selector = Selector (forall a. (Eq a) => a -> [a] -> a)
+
 data WinPrompt = WinPrompt
 
 instance XPrompt WinPrompt where
@@ -71,6 +75,25 @@ newKeys =
 
           swapSc f t (W.Screen ws a b) = W.Screen (swapWs f t ws) a b
 
+          relativeWorkspaceShift :: Selector ->  X ()
+          relativeWorkspaceShift (Selector selector) = do
+            windows $ \ss -> do
+              let tags = sort $ (W.tag <$> filter (isJust . W.stack) (W.workspaces ss))
+                  from = W.tag $ W.workspace $ W.current ss
+                  to = selector from tags
+
+              W.greedyView to ss
+
+          nextWorkspace = Selector select
+            where select n (x:y:xs) | n == x = y
+                  select n (x:xs) = select n xs
+                  select n _ = n
+
+          prevWorkspace = Selector select
+            where select n (x:y:xs) | n == y = x
+                  select n (x:xs) = select n xs
+                  select n _ = n
+
           swapWorkspace :: Char -> X ()
           swapWorkspace toChar = do
               windows $ \ss -> do
@@ -154,6 +177,9 @@ newKeys =
 
         , ((modm, xK_space), sendMessage NextLayout)
 
+        , ((modm, xK_n), relativeWorkspaceShift nextWorkspace)
+        , ((modm, xK_p), relativeWorkspaceShift prevWorkspace)
+
         , ((modm, xK_q), spawn "xmonad --recompile && xmonad --restart")
         , ((modm, xK_z), sendMessage ToggleZoom)