From eaaeb8e37037a612cf9f078919004c5910eb2e5f Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Sun, 9 Mar 2025 17:04:01 -0600 Subject: 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. --- src/Rahm/Desktop/Layout/PinWindow.hs | 48 +++++++++++++++++++----------------- 1 file changed, 26 insertions(+), 22 deletions(-) (limited to 'src/Rahm/Desktop/Layout') 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 -- cgit