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/Keys/Wml.hs | 99 +++++++++++++++++++++++++++++++++++++------- 1 file changed, 83 insertions(+), 16 deletions(-) (limited to 'src/Rahm/Desktop/Keys') diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs index d3e741b..19538fc 100644 --- a/src/Rahm/Desktop/Keys/Wml.hs +++ b/src/Rahm/Desktop/Keys/Wml.hs @@ -19,7 +19,7 @@ module Rahm.Desktop.Keys.Wml readNextLocationSet, readNextLocationSet', moveLocationToWorkspace, - moveWindowToWorkspaceFn, + moveWindowsToWorkspaceFn, getAndResetWindowSelection, getAndResetWindowSelectionOrCurrent, getWindowSelection, @@ -68,6 +68,7 @@ import Data.List.Safe (head, last) import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (catMaybes, fromJust, fromMaybe, maybeToList) +import Data.Monoid (Endo (Endo, appEndo)) import Data.Ord (Down (..)) import Data.Typeable (cast) import Data.Void (Void, absurd) @@ -86,7 +87,7 @@ import Rahm.Desktop.History nextLocation, ) import Rahm.Desktop.Keys.KeyFeed -import Rahm.Desktop.Layout.PinWindow (pinnedWindows) +import Rahm.Desktop.Layout.PinWindow (pinWindows, pinnedWindows, unpinWindow) import Rahm.Desktop.Logger import Rahm.Desktop.Marking ( farLeftWindow, @@ -265,12 +266,17 @@ getAndResetWindowSelectionOrCurrent = do data Workspace = forall a. (Typeable a) => Workspace - { moveWindowToWorkspaceFn :: Window -> X (WindowSet -> WindowSet), + { moveWindowsToWorkspaceFn :: [Window] -> X (WindowSet -> WindowSet), gotoWorkspaceFn :: X (), workspaceName :: Maybe String, + accompanying :: Maybe Workspace, + workspaceWindows :: X [Location], extraWorkspaceData :: a } +forSingleWindow :: (Window -> X (WindowSet -> WindowSet)) -> [Window] -> X (WindowSet -> WindowSet) +forSingleWindow fn ws = appEndo . mconcat <$> mapM (fmap Endo . fn) ws + readWorkspaceMacro :: MaybeT X () readWorkspaceMacro = mapNextStringWithKeysym $ \mask sym s -> do @@ -303,16 +309,18 @@ readMacroString = do justWorkspace :: String -> Workspace justWorkspace s = Workspace - { moveWindowToWorkspaceFn = return . W.shiftWin s, + { moveWindowsToWorkspaceFn = forSingleWindow $ return . W.shiftWin s, gotoWorkspaceFn = gotoWorkspace s, workspaceName = Just s, + accompanying = Just $ justWorkspace $ accompanyingWorkspace s, + workspaceWindows = windowsInWorkspace s, extraWorkspaceData = () } justWorkspaceWithPreferredWindow :: Window -> String -> Workspace justWorkspaceWithPreferredWindow w s = Workspace - { moveWindowToWorkspaceFn = return . W.shiftWin s, + { moveWindowsToWorkspaceFn = forSingleWindow $ return . W.shiftWin s, gotoWorkspaceFn = do windows $ \ws' -> let ws = W.greedyView s ws' @@ -321,23 +329,27 @@ justWorkspaceWithPreferredWindow w s = then W.focusWindow w ws else ws, workspaceName = Just s, + accompanying = Just $ justWorkspace $ accompanyingWorkspace s, + workspaceWindows = windowsInWorkspace s, extraWorkspaceData = () } blackHoleWorkspace :: Workspace blackHoleWorkspace = Workspace - { moveWindowToWorkspaceFn = \w -> killWindow w >> return id, + { moveWindowsToWorkspaceFn = forSingleWindow $ \w -> killWindow w >> return id, gotoWorkspaceFn = confirmPrompt def "Do you want to exit xmonad" $ io exitSuccess, workspaceName = Nothing, + accompanying = Nothing, + workspaceWindows = return [], extraWorkspaceData = () } alternateWorkspace :: Workspace alternateWorkspace = Workspace - { moveWindowToWorkspaceFn = \win -> do + { moveWindowsToWorkspaceFn = forSingleWindow $ \win -> do alter <- getAlternateWorkspace win return $ \ss -> maybe ss (\a -> W.shiftWin a win ss) alter, @@ -348,6 +360,39 @@ alternateWorkspace = Just win -> do mapM_ gotoWorkspace =<< getAlternateWorkspace win, workspaceName = Nothing, + accompanying = Nothing, + workspaceWindows = + let m Nothing = [] + m (Just l) = l + in fmap m $ + runMaybeT $ + mapM windowLocation =<< lift getAlternateWindows, + extraWorkspaceData = () + } + +unpinningWorkspace :: Workspace +unpinningWorkspace = + Workspace + { moveWindowsToWorkspaceFn = forSingleWindow $ \win -> do + unpinWindow win + return id, + gotoWorkspaceFn = return (), + workspaceName = Nothing, + accompanying = Just pinningWorkspace, + workspaceWindows = return [], + extraWorkspaceData = () + } + +pinningWorkspace :: Workspace +pinningWorkspace = + Workspace + { moveWindowsToWorkspaceFn = \wins -> do + pinWindows wins + return id, + gotoWorkspaceFn = return (), + workspaceName = Nothing, + accompanying = Just unpinningWorkspace, + workspaceWindows = map (Location "*" . Just) <$> pinnedWindows, extraWorkspaceData = () } @@ -356,19 +401,39 @@ newtype FloatWorkspace = FloatWorkspace Workspace floatWorkspace :: Workspace -> Workspace floatWorkspace ws@Workspace {extraWorkspaceData = d} = Workspace - { moveWindowToWorkspaceFn = \win -> do + { moveWindowsToWorkspaceFn = \wins -> do case cast d of Just (FloatWorkspace ws') -> do - movefn <- moveWindowToWorkspaceFn ws' win - return $ W.sink win . movefn + movefn <- moveWindowsToWorkspaceFn ws' wins + return $ (appEndo . mconcat $ map (Endo . W.sink) wins) . movefn Nothing -> do - movefn <- moveWindowToWorkspaceFn ws win + movefn <- moveWindowsToWorkspaceFn ws wins return $ \ss -> do - if win `Map.member` W.floating ss - then movefn ss - else movefn $ W.float win (W.RationalRect (1 / 8) (1 / 8) (6 / 8) (6 / 8)) ss, + appEndo + ( mconcat $ + map + ( \win -> + Endo $ + if win `Map.member` W.floating ss + then movefn + else + movefn + . W.float + win + ( W.RationalRect + (1 / 8) + (1 / 8) + (6 / 8) + (6 / 8) + ) + ) + wins + ) + ss, gotoWorkspaceFn = gotoWorkspaceFn ws, workspaceName = workspaceName ws, + accompanying = Just $ floatWorkspace ws, + workspaceWindows = workspaceWindows ws, extraWorkspaceData = FloatWorkspace ws } @@ -520,7 +585,7 @@ readNextWorkspace = -- The accompanying worksapce to the next read workspace. (_, _, "~") -> - justWorkspace . accompanyingWorkspace <$> readNextWorkspaceName + absorbMaybe $ accompanying <$> readNextWorkspace -- The accompanying workspace to the current workspace (equivalent to ~.) (_, _, " ") -> liftXToFeed $ @@ -531,6 +596,8 @@ readNextWorkspace = -- The alternate workspace (_, _, "-") -> return alternateWorkspace + (_, _, "#") -> + return pinningWorkspace -- If the next two read workspaces are equal, go to the third workspace -- otherwise go to the fourth workspace. (_, _, "=") -> do @@ -628,7 +695,7 @@ readNextLocationSet' = -- Windows in a workspace (_, _, s) | s == "\t" || s == "@" || s == "\n" -> - (liftXToFeed . windowsInWorkspace) =<< readNextWorkspaceName + (liftXToFeed . workspaceWindows) =<< readNextWorkspace -- The first window in the next window set. (_, _, "!") -> (: []) <$> absorbMaybe (head <$> readNextLocationSet) -- The windows except the first in a window set. -- cgit