Change some of how Workspaces work in WML.

This change adds a "workspaceWindows" function on a pseudo-workspace
level so now the windowsets '@_', '@#', '@-' actually have meaning.

Also now the "move to workspace" function buffers the windows which
makes things more responsive and intuitive.

1 files changed, 26 insertions, 22 deletions

diff --git a/src/Rahm/Desktop/Layout/PinWindow.hs b/src/Rahm/Desktop/Layout/PinWindow.hs
index 36dbf27..01be07d 100644
--- a/src/Rahm/Desktop/Layout/PinWindow.hs
+++ b/src/Rahm/Desktop/Layout/PinWindow.hs
@@ -4,7 +4,7 @@ module Rahm.Desktop.Layout.PinWindow where
 
 import Control.Arrow (Arrow (second))
 import Control.Exception (throw)
-import Control.Monad (unless, when)
+import Control.Monad (forM_, unless, when)
 import Control.Monad.Trans (lift)
 import Control.Monad.Trans.Maybe (MaybeT (..))
 import Data.Foldable (find)
@@ -16,13 +16,13 @@ import Data.Maybe (fromMaybe, mapMaybe, maybe)
 import Data.Semigroup (Endo (..))
 import Data.Set (Set)
 import qualified Data.Set as Set
-import Rahm.Desktop.Common (runMaybeT_)
+import Rahm.Desktop.BorderColors (BorderColor (BorderColor), resetBorderColor, setBorderColor)
+import Rahm.Desktop.Common (floatAll, runMaybeT_)
 import Rahm.Desktop.Logger
 import qualified Rahm.Desktop.StackSet as W
 import XMonad
 import qualified XMonad.StackSet as W (filter)
 import qualified XMonad.Util.ExtensibleState as XS
-import Rahm.Desktop.BorderColors (setBorderColor, BorderColor (BorderColor), resetBorderColor)
 
 newtype PinWindowState = PinWindowState (Map ScreenId [(Window, W.RationalRect)])
   deriving (Show, Read)
@@ -85,26 +85,30 @@ instance (LayoutClass l a, sid ~ ScreenId, a ~ Window) => LayoutClass (PinWindow
     return (PinWindowLayout <$> maybeNewLayout)
 
 pinWindow :: Window -> X ()
-pinWindow win = runMaybeT_ $ do
-  lift $ logs Debug "Pinning window %d" win
-  lift $ float win
-
-  ws@(W.StackSet cur vis _ flt) <- gets windowset
-  t <- hoist (W.findTag win ws)
-  scr <- hoist $ find ((== t) . (W.tag . W.workspace)) (cur : vis)
-  rect <- hoist $ Map.lookup win flt
-
+pinWindow = pinWindows . (: [])
+
+pinWindows :: [Window] -> X ()
+pinWindows wins = runMaybeT_ $ do
+  lift $ floatAll wins
+
+  forM_ wins $ \win -> do
+    ws@(W.StackSet cur vis _ flt) <- gets windowset
+    t <- hoist (W.findTag win ws)
+    scr <- hoist $ find ((== t) . (W.tag . W.workspace)) (cur : vis)
+    rect <- hoist $ Map.lookup win flt
+
+    lift $ do
+      XS.modify $ \(PinWindowState mp) ->
+        PinWindowState $
+          Map.alter
+            (Just . maybe [(win, rect)] ((win, rect) :))
+            (W.screen scr)
+            mp
+
+  -- Don't float the window anymore.
   lift $ do
-    XS.modify $ \(PinWindowState mp) ->
-      PinWindowState $
-        Map.alter
-          (Just . maybe [(win, rect)] ((win, rect) :))
-          (W.screen scr)
-          mp
-
-    -- Don't float the window anymore.
-    modifyWindowSet $ W.sink win
-    setBorderColor pinnedWindowColor [win]
+    modifyWindowSet $ appEndo $ mconcat (map (Endo . W.sink) wins)
+    setBorderColor pinnedWindowColor wins
   where
     hoist = MaybeT . return