aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop/Workspaces.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Rahm/Desktop/Workspaces.hs')
-rw-r--r--src/Rahm/Desktop/Workspaces.hs27
1 files changed, 19 insertions, 8 deletions
diff --git a/src/Rahm/Desktop/Workspaces.hs b/src/Rahm/Desktop/Workspaces.hs
index 4763e26..6f0c08a 100644
--- a/src/Rahm/Desktop/Workspaces.hs
+++ b/src/Rahm/Desktop/Workspaces.hs
@@ -11,6 +11,7 @@ module Rahm.Desktop.Workspaces
adjacentWorkspaceNotVisible,
adjacentWorkspace,
viewAdjacent,
+ viewAdjacentTo,
adjacentScreen,
withScreen,
workspaceWithWindow,
@@ -19,17 +20,15 @@ module Rahm.Desktop.Workspaces
where
import Control.Arrow (Arrow ((&&&)))
+import Control.Monad.Trans (lift)
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
import Data.Char (isUpper, toLower, toUpper)
-import Data.List (find, sort, sortBy, sortOn)
+import Data.List (find, sort, sortBy, sortOn, (\\))
import Data.List.Safe ((!!))
import Data.Maybe (fromMaybe, mapMaybe)
-import Rahm.Desktop.Common (getCurrentWorkspace, gotoWorkspace)
+import Rahm.Desktop.Common (getCurrentWorkspace, gotoWorkspace, runMaybeT_)
+import Rahm.Desktop.Logger
import qualified Rahm.Desktop.StackSet as W
- ( Screen (Screen, screenDetail, workspace),
- StackSet (StackSet, current, visible),
- Workspace (Workspace, tag),
- integrate',
- )
import XMonad
( Rectangle (Rectangle),
ScreenDetail (SD),
@@ -41,7 +40,6 @@ import XMonad
windows,
withWindowSet,
)
-
import Prelude hiding ((!!))
newtype Selector = Selector (forall a. (a -> Bool) -> [a] -> Maybe a)
@@ -132,6 +130,19 @@ viewAdjacent :: Selector -> X ()
viewAdjacent sel =
gotoWorkspace =<< (adjacentWorkspaceNotVisible sel =<< getCurrentWorkspace)
+viewAdjacentTo :: X (Maybe WorkspaceId) -> Selector -> X ()
+viewAdjacentTo wsM (Selector sel) = runMaybeT_ $ do
+ lift $ logs Debug "viewAdjacentTo"
+ tag <- MaybeT wsM
+ lift $ logs Debug "from: %s" tag
+ ws <- MaybeT $ withWindowSet $ \ws ->
+ let vis = map (W.tag . W.workspace) (W.screens ws)
+ allW = sort $ map (W.tag . snd) (getPopulatedWorkspaces ws)
+ final = allW \\ (vis \\ [tag])
+ in return $ sel (== tag) final
+ lift $ logs Debug "to: %s" ws
+ lift $ windows $ W.switchWorkspaces tag ws
+
adjacentScreen :: Selector -> X WorkspaceId
adjacentScreen (Selector f) = do
(screens, current) <-