Merge pull request #167 from IvanMalison/CycleWorkspaceByScreen

Cycle workspace by screen

CHANGES.md

@@ -47,6 +47,15 @@
     called for activated windows.  But this lifts `manageHook` into
     `FocusHook` and it needs to be converted back later using `manageFocus`.
 
+  * `XMonad.Actions.CycleWorkspaceByScreen`
+
+    A new module that allows cycling through previously viewed workspaces in the
+    order they were viewed most recently on the screen where cycling is taking
+    place.
+
+    Also provides the `repeatableAction` helper function which can be used to
+    build actions that can be repeated while a modifier key is held down.
+
 ### Bug Fixes and Minor Changes
 
   * `XMonad.Actions.GridSelect`
@@ -91,6 +100,10 @@
     - New function: `windowMultiPrompt` for using `mkXPromptWithModes`
       with window prompts.
 
+  * `XMonad.Hooks.WorkspaceHistory`
+
+    - Now supports per screen history.
+
 ## 0.13 (February 10, 2017)
 
 ### Breaking Changes

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

XMonad/Hooks/WorkspaceHistory.hs

@@ -15,19 +15,24 @@
 -----------------------------------------------------------------------------
 
 module XMonad.Hooks.WorkspaceHistory
-    ( -- * Usage
+      -- * Usage
       -- $usage
-
       -- * Hooking
-      workspaceHistoryHook
+  ( workspaceHistoryHook
-
       -- * Querying
   , workspaceHistory
-
+  , workspaceHistoryByScreen
+  , workspaceHistoryWithScreen
+    -- * Handling edits
+  , workspaceHistoryTransaction
   ) where
 
+import           Control.Applicative
+import           Prelude
+
 import XMonad
-import XMonad.StackSet (currentTag)
+import XMonad.StackSet hiding (filter, delete)
+import Data.List
 import qualified XMonad.Util.ExtensibleState as XS
 
 -- $usage
@@ -46,10 +51,10 @@ import qualified XMonad.Util.ExtensibleState as XS
 --
 -- To make use of the collected data, a query function is provided.
 
-data WorkspaceHistory =
+data WorkspaceHistory = WorkspaceHistory
-    WorkspaceHistory { history :: [WorkspaceId] -- ^ Workspaces in reverse-chronological order.
+  { history :: [(ScreenId, WorkspaceId)] -- ^ Workspace Screens in
-                     }
+                                         -- reverse-chronological order.
-    deriving (Typeable, Read, Show)
+  } deriving (Typeable, Read, Show)
 
 instance ExtensionClass WorkspaceHistory where
     initialValue = WorkspaceHistory []
@@ -58,17 +63,41 @@ instance ExtensionClass WorkspaceHistory where
 -- | A 'logHook' that keeps track of the order in which workspaces have
 -- been viewed.
 workspaceHistoryHook :: X ()
-workspaceHistoryHook = gets (currentTag . windowset) >>= (XS.modify . makeFirst)
+workspaceHistoryHook = gets windowset >>= (XS.modify . updateLastActiveOnEachScreen)
+
+workspaceHistoryWithScreen :: X [(ScreenId, WorkspaceId)]
+workspaceHistoryWithScreen = XS.gets history
+
+workspaceHistoryByScreen :: X [(ScreenId, [WorkspaceId])]
+workspaceHistoryByScreen =
+  map (\wss -> (fst $ head wss, map snd wss)) .
+  groupBy (\a b -> fst a == fst b) .
+  sortBy (\a b -> compare (fst a) $ fst b)<$>
+  workspaceHistoryWithScreen
 
 -- | A list of workspace tags in the order they have been viewed, with the
 -- most recent first. No duplicates are present, but not all workspaces are
 -- guaranteed to appear, and there may be workspaces that no longer exist.
 workspaceHistory :: X [WorkspaceId]
-workspaceHistory = XS.gets history
+workspaceHistory = nub . map snd <$> XS.gets history
 
+workspaceHistoryTransaction :: X () -> X ()
+workspaceHistoryTransaction action = do
+  startingHistory <- XS.gets history
+  action
+  new <- (flip updateLastActiveOnEachScreen $ WorkspaceHistory startingHistory) <$> gets windowset
+  XS.put new
 
--- | Cons the 'WorkspaceId' onto the 'WorkspaceHistory' if it is not
+-- | Update the last visible workspace on each monitor if needed
 -- already there, or move it to the front if it is.
-makeFirst :: WorkspaceId -> WorkspaceHistory -> WorkspaceHistory
+updateLastActiveOnEachScreen :: WindowSet -> WorkspaceHistory -> WorkspaceHistory
-makeFirst w v = let (xs, ys) = break (w ==) $ history v
+updateLastActiveOnEachScreen StackSet {current = cur, visible = vis} wh =
-                in v { history = w : (xs ++ drop 1 ys) }
+  WorkspaceHistory { history = doUpdate cur $ foldl updateLastForScreen (history wh) $ vis ++ [cur] }
+  where
+    firstOnScreen sid = find ((== sid) . fst)
+    doUpdate Screen {workspace = Workspace { tag = wid }, screen = sid} curr =
+      let newEntry = (sid, wid) in newEntry:delete newEntry curr
+    updateLastForScreen curr Screen {workspace = Workspace { tag = wid }, screen = sid} =
+      let newEntry = (sid, wid)
+          alreadyCurrent = maybe False (== newEntry) $ firstOnScreen sid curr
+      in if alreadyCurrent then curr else newEntry:delete newEntry curr

xmonad-contrib.cabal

@@ -81,25 +81,22 @@ library
     if impl(ghc >= 6.12.1)
         ghc-options:    -fno-warn-unused-do-bind
 
-    exposed-modules:    XMonad.Doc
+    exposed-modules:    XMonad.Actions.AfterDrag
-                        XMonad.Doc.Configuring
-                        XMonad.Doc.Extending
-                        XMonad.Doc.Developing
-                        XMonad.Actions.AfterDrag
                         XMonad.Actions.BluetileCommands
                         XMonad.Actions.Commands
                         XMonad.Actions.ConstrainedResize
                         XMonad.Actions.CopyWindow
                         XMonad.Actions.CycleRecentWS
                         XMonad.Actions.CycleSelectedLayouts
-                        XMonad.Actions.CycleWindows
                         XMonad.Actions.CycleWS
+                        XMonad.Actions.CycleWindows
+                        XMonad.Actions.CycleWorkspaceByScreen
                         XMonad.Actions.DeManage
                         XMonad.Actions.DwmPromote
-                        XMonad.Actions.DynamicWorkspaces
+                        XMonad.Actions.DynamicProjects
                         XMonad.Actions.DynamicWorkspaceGroups
                         XMonad.Actions.DynamicWorkspaceOrder
-                        XMonad.Actions.DynamicProjects
+                        XMonad.Actions.DynamicWorkspaces
                         XMonad.Actions.FindEmptyWorkspace
                         XMonad.Actions.FlexibleManipulate
                         XMonad.Actions.FlexibleResize
@@ -108,6 +105,7 @@ library
                         XMonad.Actions.FocusNth
                         XMonad.Actions.GridSelect
                         XMonad.Actions.GroupNavigation
+                        XMonad.Actions.KeyRemap
                         XMonad.Actions.Launcher
                         XMonad.Actions.LinkWorkspaces
                         XMonad.Actions.MessageFeedback
@@ -122,7 +120,6 @@ library
                         XMonad.Actions.Plane
                         XMonad.Actions.Promote
                         XMonad.Actions.RandomBackground
-                        XMonad.Actions.KeyRemap
                         XMonad.Actions.RotSlaves
                         XMonad.Actions.Search
                         XMonad.Actions.ShowText
@@ -142,13 +139,13 @@ library
                         XMonad.Actions.WindowMenu
                         XMonad.Actions.WindowNavigation
                         XMonad.Actions.WithAll
+                        XMonad.Actions.Workscreen
                         XMonad.Actions.WorkspaceCursors
                         XMonad.Actions.WorkspaceNames
-                        XMonad.Actions.Workscreen
                         XMonad.Config.Arossato
                         XMonad.Config.Azerty
-                        XMonad.Config.Bluetile
                         XMonad.Config.Bepo
+                        XMonad.Config.Bluetile
                         XMonad.Config.Desktop
                         XMonad.Config.Dmwit
                         XMonad.Config.Droundy
@@ -158,14 +155,18 @@ library
                         XMonad.Config.Prime
                         XMonad.Config.Sjanssen
                         XMonad.Config.Xfce
+                        XMonad.Doc
+                        XMonad.Doc.Configuring
+                        XMonad.Doc.Developing
+                        XMonad.Doc.Extending
                         XMonad.Hooks.CurrentWorkspaceOnTop
                         XMonad.Hooks.DebugEvents
                         XMonad.Hooks.DebugKeyEvents
+                        XMonad.Hooks.DebugStack
                         XMonad.Hooks.DynamicBars
                         XMonad.Hooks.DynamicHooks
                         XMonad.Hooks.DynamicLog
                         XMonad.Hooks.DynamicProperty
-                        XMonad.Hooks.DebugStack
                         XMonad.Hooks.EwmhDesktops
                         XMonad.Hooks.FadeInactive
                         XMonad.Hooks.FadeWindows
@@ -206,8 +207,8 @@ library
                         XMonad.Layout.DecorationAddons
                         XMonad.Layout.DecorationMadness
                         XMonad.Layout.Dishes
-                        XMonad.Layout.DraggingVisualizer
                         XMonad.Layout.DragPane
+                        XMonad.Layout.DraggingVisualizer
                         XMonad.Layout.Drawer
                         XMonad.Layout.Dwindle
                         XMonad.Layout.DwmStyle
@@ -223,8 +224,8 @@ library
                         XMonad.Layout.Hidden
                         XMonad.Layout.HintedGrid
                         XMonad.Layout.HintedTile
-                        XMonad.Layout.IfMax
                         XMonad.Layout.IM
+                        XMonad.Layout.IfMax
                         XMonad.Layout.ImageButtonDecoration
                         XMonad.Layout.IndependentScreens
                         XMonad.Layout.LayoutBuilder
@@ -284,11 +285,11 @@ library
                         XMonad.Layout.WorkspaceDir
                         XMonad.Layout.ZoomRow
                         XMonad.Prompt
-                        XMonad.Prompt.AppendFile
                         XMonad.Prompt.AppLauncher
+                        XMonad.Prompt.AppendFile
                         XMonad.Prompt.ConfirmPrompt
-                        XMonad.Prompt.Directory
                         XMonad.Prompt.DirExec
+                        XMonad.Prompt.Directory
                         XMonad.Prompt.Email
                         XMonad.Prompt.Input
                         XMonad.Prompt.Layout
@@ -307,8 +308,8 @@ library
                         XMonad.Util.DebugWindow
                         XMonad.Util.Dmenu
                         XMonad.Util.Dzen
-                        XMonad.Util.ExtensibleState
                         XMonad.Util.EZConfig
+                        XMonad.Util.ExtensibleState
                         XMonad.Util.Font
                         XMonad.Util.Image
                         XMonad.Util.Invisible
@@ -325,8 +326,8 @@ library
                         XMonad.Util.Replace
                         XMonad.Util.Run
                         XMonad.Util.Scratchpad
-                        XMonad.Util.SpawnOnce
                         XMonad.Util.SpawnNamedPipe
+                        XMonad.Util.SpawnOnce
                         XMonad.Util.Stack
                         XMonad.Util.StringProp
                         XMonad.Util.Themes