From e8e898507a47dab1f6070984a6be8ee753a83432 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 28 Mar 2020 23:15:41 -0400
Subject: [PATCH] ADD steam to dynamic workspaces

---
 bin/xmonad.hs       | 40 ++++++++++++++++++++++++++++++++++------
 lib/WorkspaceMon.hs | 18 ++++++++++++------
 2 files changed, 46 insertions(+), 12 deletions(-)

diff --git a/bin/xmonad.hs b/bin/xmonad.hs
index 12af9a8..6c37860 100644
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@@ -113,7 +113,8 @@ gimpDynamicWorkspace = DynWorkspace
     , matchGimpRole "gimp-toolbox" -?> doF (toBottom . W.focusMaster)
     , className =? c -?> appendViewShift t
     ]
-  , dwCmd = Just ("g", spawnCmd "gimp-2.10" [])
+  , dwKey = 'g'
+  , dwCmd = Just $ spawnCmd "gimp-2.10" []
   }
   where
     matchGimpRole role = isPrefixOf role <$> stringProperty "WM_WINDOW_ROLE"
@@ -128,7 +129,8 @@ wmDynamicWorkspace = DynWorkspace
   , dwTag = t
   , dwClass = c
   , dwHook = [ className =? c -?> appendViewShift t ]
-  , dwCmd = Just ("v", spawnCmd "vbox-start" ["win8raw"])
+  , dwKey = 'v'
+  , dwCmd = Just $ spawnCmd "vbox-start" ["win8raw"]
   }
   where
     t = "VM"
@@ -140,19 +142,41 @@ xsaneDynamicWorkspace = DynWorkspace
   , dwTag = t
   , dwClass = c
   , dwHook = [ className =? c -?> appendViewShift t >> doFloat ]
-  , dwCmd = Just ("x", spawnCmd "xsane" [])
+  , dwKey = 'x'
+  , dwCmd = Just $ spawnCmd "xsane" []
   }
   where
     t = "XSANE"
     c = "Xsane"
 
+steamDynamicWorkspace :: DynWorkspace
+steamDynamicWorkspace = DynWorkspace
+  { dwName = "Steam Game"
+  , dwTag = t
+  , dwClass = c
+  -- TODO not sure why the doSink is needed, windows should tile be default
+  -- since dynamic workspaces are first in the managehook
+  , dwHook = [ className =? c -?> appendViewShift t >> doSink ]
+  , dwKey = 'z'
+  , dwCmd = Nothing
+  }
+  where
+    t = "STEAM"
+    -- TODO this actually needs to be a list to match all games we care about
+    c = "portal2_linux"
+
 allDWs :: [DynWorkspace]
-allDWs = [xsaneDynamicWorkspace, wmDynamicWorkspace, gimpDynamicWorkspace]
+allDWs = [ xsaneDynamicWorkspace
+         , wmDynamicWorkspace
+         , gimpDynamicWorkspace
+         , steamDynamicWorkspace
+         ]
 
 -- | Layout configuration
 
 myLayouts = onWorkspace (dwTag wmDynamicWorkspace) vmLayout
   $ onWorkspace (dwTag gimpDynamicWorkspace) gimpLayout
+  $ onWorkspace (dwTag steamDynamicWorkspace) steamLayout
   $ mkToggle (single HIDE)
   $ tall ||| fulltab ||| full
   where
@@ -169,6 +193,7 @@ myLayouts = onWorkspace (dwTag wmDynamicWorkspace) vmLayout
     full = renamed [Replace "Full"]
       $ noBorders Full
     vmLayout = noBorders Full
+    steamLayout = vmLayout
     -- TODO use a tabbed layout for multiple master windows
     gimpLayout = renamed [Replace "Gimp Layout"]
       $ avoidStruts
@@ -313,8 +338,11 @@ mkKeys ts c =
    ]) ++
 
   mkNamedSubmap "Dynamic Workspaces"
-  [ ("M-C-" ++ k, "launch/switch to " ++ n, spawnOrSwitch t a)
-  |  DynWorkspace { dwTag = t, dwCmd = Just (k, a), dwName = n } <- allDWs
+  [ ("M-C-" ++ [k], "launch/switch to " ++ n, cmd)
+  |  DynWorkspace { dwTag = t, dwKey = k, dwCmd = a, dwName = n } <- allDWs,
+     let cmd = case a of
+           Just a' -> spawnOrSwitch t a'
+           Nothing -> windows $ W.view t
   ] ++
 
   mkNamedSubmap "Screens"
diff --git a/lib/WorkspaceMon.hs b/lib/WorkspaceMon.hs
index e60ae4d..f6d5e72 100644
--- a/lib/WorkspaceMon.hs
+++ b/lib/WorkspaceMon.hs
@@ -31,6 +31,7 @@ module WorkspaceMon
   , removeDynamicWorkspace
   , runWorkspaceMon
   , spawnOrSwitch
+  , doSink
   )
 where
 
@@ -39,7 +40,6 @@ import           SendXMsg
 
 import qualified Data.Map                         as M
 import           Data.Maybe
-import           Data.Semigroup
 
 import           Control.Concurrent
 import           Control.Monad
@@ -58,8 +58,7 @@ import           System.Process                   (Pid)
 
 import           XMonad.Actions.DynamicWorkspaces
 import           XMonad.Core
-    ( Query
-    , ScreenId
+    ( ManageHook
     , WorkspaceId
     , X
     , withWindowSet
@@ -78,7 +77,8 @@ data DynWorkspace = DynWorkspace
     , dwTag   :: WorkspaceId
     , dwClass :: String
     , dwHook  :: [MaybeManageHook]
-    , dwCmd   :: Maybe (String, X ())
+    , dwKey   :: Char
+    , dwCmd   :: Maybe (X ())
     -- TODO this should also have the layout for this workspace
     }
 
@@ -179,13 +179,19 @@ spawnOrSwitch tag cmd = do
 -- Move windows to new workspace if they are part of a dynamic workspace
 
 viewShift
-  :: WorkspaceId -> Query (Endo (W.StackSet WorkspaceId l Window ScreenId sd))
+  :: WorkspaceId -> ManageHook
 viewShift = doF . liftM2 (.) W.view W.shift
 
 appendViewShift
-  :: String -> Query (Endo (W.StackSet WorkspaceId l Window ScreenId sd))
+  :: String -> ManageHook
 appendViewShift tag = liftX (appendWorkspace tag) >> viewShift tag
 
+-- surprisingly this doesn't exist?
+doSink :: ManageHook
+doSink = doF $ \s -> case W.stack $ W.workspace $ W.current s of
+                       Just s' -> W.sink (W.focus s') s
+                       Nothing -> s
+
 --------------------------------------------------------------------------------
 -- | Eventhook
 -- When an app is closed, this will respond the event that is sent in the main