Add X.A.CycleWorkspaceByScreen, Per screen WorkspaceHistory

XMonad/Actions/CycleWorkspaceByScreen.hs

@@ -0,0 +1,99 @@
+module XMonad.Actions.CycleWorkspaceByScreen
+  ( cycleWorkspaceOnScreen
+  , cycleWorkspaceOnCurrentScreen
+  , handleKeyEvent
+  , repeatableAction
+  ) where
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.CycleWorkspaceByScreen
+-- Copyright   :  (c) 2017 Ivan Malison
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  IvanMalison@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Cycle through previously viewed workspaces in the order they were viewed most
+-- recently on the screen where cycling is taking place.
+--
+-----------------------------------------------------------------------------
+
+import           Control.Monad
+import           Data.IORef
+import           Data.List
+import           Data.Maybe
+
+import           Graphics.X11.Xlib.Extras
+
+import           XMonad
+import           XMonad.Hooks.WorkspaceHistory
+import qualified XMonad.StackSet as W
+
+-- $usage
+-- This module must be used in conjuction with XMonad.Hooks.WorkspaceHistory
+--
+-- To use, add something like the following to your keybindings
+-- , ((mod4Mask,  xK_slash), cycleWorkspaceOnCurrentScreen [xK_Super_L] xK_slash xK_p)
+
+repeatableAction :: [KeySym] -> (EventType -> KeySym -> X ()) -> X ()
+repeatableAction mods pressHandler = do
+  XConf {theRoot = root, display = d} <- ask
+  let getNextEvent = io $ allocaXEvent $ \p ->
+                 do
+                   maskEvent d (keyPressMask .|. keyReleaseMask) p
+                   KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
+                   s <- io $ keycodeToKeysym d c 0
+                   return (t, s)
+      handleEvent (t, s)
+        | t == keyRelease && s `elem` mods = return ()
+        | otherwise = (pressHandler t s) >> getNextEvent >>= handleEvent
+
+  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
+  getNextEvent >>= handleEvent
+  io $ ungrabKeyboard d currentTime
+
+handleKeyEvent :: EventType
+               -> KeySym
+               -> X ()
+               -> EventType
+               -> KeySym
+               -> Maybe (X ())
+handleKeyEvent eventType key action = helper
+  where
+  helper et k
+    | et == eventType && k == key = Just action
+    | otherwise = Nothing
+
+
+runFirst :: [EventType -> KeySym -> Maybe (X ())] -> EventType -> KeySym -> X ()
+runFirst matchers eventType key =
+  fromMaybe (return ()) $ join $ find isJust $ map (\fn -> fn eventType key) matchers
+
+cycleWorkspaceOnScreen :: ScreenId -> [KeySym] -> KeySym -> KeySym -> X ()
+cycleWorkspaceOnScreen screenId mods nextKey prevKey = workspaceHistoryTransaction $ do
+  startingHistory <- workspaceHistoryByScreen
+  currentWSIndex <- io $ newIORef 1
+  let cycleWorkspaces = fromMaybe [] $ lookup screenId startingHistory
+      getAndIncrementWS increment = do
+        current <- readIORef currentWSIndex
+        modifyIORef
+          currentWSIndex
+          ((`mod` (length cycleWorkspaces)) . (+ increment))
+        return $ cycleWorkspaces !! current
+      focusIncrement i = (io $ getAndIncrementWS i) >>= (windows . W.greedyView)
+
+  focusIncrement 1 -- Do the first workspace cycle
+  repeatableAction mods $
+    runFirst
+      [ handleKeyEvent keyPress nextKey $ focusIncrement 1
+      , handleKeyEvent keyPress prevKey $ focusIncrement (-1)
+      ]
+  return ()
+
+cycleWorkspaceOnCurrentScreen
+  :: [KeySym] -> KeySym -> KeySym -> X ()
+cycleWorkspaceOnCurrentScreen mods n p =
+  withWindowSet $ \ws ->
+    cycleWorkspaceOnScreen (W.screen $ W.current ws) mods n p