From 2a7d413e1b69e8b7f3a116951999c0f5bc1ec974 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Thu, 30 Nov 2023 18:56:15 -0700 Subject: Better modelling for moving between windows. Reworked shifting windows and made the movement atomic to improve speed --- src/Rahm/Desktop/Common.hs | 11 ++++----- src/Rahm/Desktop/Keys.hs | 54 ++++++++++++++++++++++++-------------------- src/Rahm/Desktop/Keys/Wml.hs | 48 +++++++++++++++++++-------------------- 3 files changed, 57 insertions(+), 56 deletions(-) (limited to 'src/Rahm') diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs index 01fa35b..993726b 100644 --- a/src/Rahm/Desktop/Common.hs +++ b/src/Rahm/Desktop/Common.hs @@ -19,6 +19,7 @@ module Rahm.Desktop.Common ) where +import Rahm.Desktop.Logger import Data.Void (absurd, Void (..)) import Data.Either (either) import Control.Applicative ((<*)) @@ -149,12 +150,10 @@ withBorderColorE color wins fn = do lift $ setWindowBorderWithFallback d w colorName px myFinallyE fn $ - lift $ - withFocused $ \fw -> do - forM_ wins $ \w -> - when (w /= fw) $ - setWindowBorderWithFallback d w oColorName oPx - + lift $ do + forM_ wins $ \w -> + setWindowBorderWithFallback d w oColorName oPx + withFocused $ \fw -> setWindowBorderWithFallback d fw fColorName fPx withBorderColorM :: String -> [Window] -> MaybeT X a -> MaybeT X a diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 49f0ebf..bc80aa9 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -80,7 +80,7 @@ import Rahm.Desktop.Keys.Dsl ) import Rahm.Desktop.Keys.Wml ( gotoWorkspaceFn, - moveLocationToWorkspaceFn, + moveWindowToWorkspaceFn, readNextLocationSet, readNextWorkspace, readWindowsetMacro, @@ -144,7 +144,7 @@ import Rahm.Desktop.XMobarLog.PendingBuffer pushPendingBuffer, ) import Text.Printf (printf) -import XMonad +import XMonad as X import XMonad.Actions.CopyWindow as CopyWindow import XMonad.Actions.RotSlaves ( rotAllDown, @@ -292,9 +292,12 @@ keymap = runKeys $ do runMaybeT_ $ do l1 <- mapMaybe (\(Location _ w) -> w) <$> readNextLocationSet withBorderColorM "#00ffff" l1 $ do + lift $ addStringToPendingBuffer " " l2 <- mapMaybe (\(Location _ w) -> w) <$> readNextLocationSet let rewriteMap = Map.fromList $ zip l1 l2 ++ zip l2 l1 - lift $ windows $ mapWindows (\w -> fromMaybe w (Map.lookup w rewriteMap)) + lift $ do + setAlternateWindows l1 + windows $ mapWindows (\w -> fromMaybe w (Map.lookup w rewriteMap)) bind xK_BackSpace $ do -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if @@ -576,33 +579,34 @@ keymap = runKeys $ do bind xK_s $ do forM_ [(False, justMod), (True, shiftMod)] $ \(doView, f) -> - f $ - doc + f $ doc ( if doView then "Shift a windowset to a workspace and goto that workspace." else "Shift a windowset to a workspace" ) - $ pushPendingBuffer (if doView then "S " else "s ") $ do - maybeLocs <- runMaybeT readNextLocationSet - addStringToPendingBuffer " " - - forM_ maybeLocs $ \locations -> do - let locationWindows = mapMaybe locationWindow locations - withBorderColor "#00ffff" locationWindows $ do + $ + pushPendingBuffer (if doView then "S " else "s ") $ runMaybeT_ $ do - workspace <- readNextWorkspace - mapM_ (lift . moveLocationToWorkspaceFn workspace) locations - - lift $ setAlternateWindows locationWindows - forM_ locations $ \loc -> - case locationWindow loc of - Nothing -> return () - Just win -> do - lift $ setAlternateWorkspace win (locationWorkspace loc) - - wsName <- MaybeT $ return (workspaceName workspace) - when doView $ - lift $ windows $ W.greedyView wsName + stackset <- lift $ X.windowset <$> X.get + selection <- mapMaybe locationWindow <$> readNextLocationSet + + withBorderColorM "#00ffff" selection $ do + ws <- readNextWorkspace + (Endo allMovements) <- lift $ mconcat <$> mapM (fmap Endo . moveWindowToWorkspaceFn ws) selection + lift $ do + setAlternateWindows selection + forM_ selection $ \win -> do + mapM_ (\t -> do + logs Debug "Set alternate workspace %s -> %s" (show win) t + setAlternateWorkspace win t) (W.findTag win stackset) + + windows $ (\ss -> + case () of + () | doView, + (w:_) <- selection, + Just ws <- W.findTag w ss -> W.greedyView ws ss + _ -> ss + ) . allMovements altMod $ spawnX "sudo -A systemctl suspend && xsecurelock" diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs index e7a7cb9..8abb17b 100644 --- a/src/Rahm/Desktop/Keys/Wml.hs +++ b/src/Rahm/Desktop/Keys/Wml.hs @@ -18,7 +18,7 @@ module Rahm.Desktop.Keys.Wml readNextWorkspace, readNextLocationSet, moveLocationToWorkspace, - moveLocationToWorkspaceFn, + moveWindowToWorkspaceFn, gotoWorkspaceFn, readMacroString, justWorkspace, @@ -96,6 +96,7 @@ import qualified Rahm.Desktop.StackSet as W focusWindow, getLocationWorkspace, greedyView, + shiftWin, integrate', screens, sink, @@ -131,6 +132,7 @@ import XMonad Typeable, Window, WorkspaceId, + WindowSet, X, asks, directories, @@ -209,7 +211,8 @@ instance ExtensionClass MaybeMacros where data Workspace = forall a. (Typeable a) => Workspace - { moveLocationToWorkspaceFn :: Location -> X (), + { + moveWindowToWorkspaceFn :: Window -> X (WindowSet -> WindowSet), gotoWorkspaceFn :: X (), workspaceName :: Maybe String, extraWorkspaceData :: a @@ -247,7 +250,7 @@ readMacroString = do justWorkspace :: String -> Workspace justWorkspace s = Workspace - { moveLocationToWorkspaceFn = flip moveLocationToWorkspace s, + { moveWindowToWorkspaceFn = return . W.shiftWin s, gotoWorkspaceFn = gotoWorkspace s, workspaceName = Just s, extraWorkspaceData = () @@ -256,7 +259,7 @@ justWorkspace s = justWorkspaceWithPreferredWindow :: Window -> String -> Workspace justWorkspaceWithPreferredWindow w s = Workspace - { moveLocationToWorkspaceFn = flip moveLocationToWorkspace s, + { moveWindowToWorkspaceFn = return . W.shiftWin s, gotoWorkspaceFn = do windows $ \ws' -> let ws = W.greedyView s ws' @@ -271,7 +274,7 @@ justWorkspaceWithPreferredWindow w s = blackHoleWorkspace :: Workspace blackHoleWorkspace = Workspace - { moveLocationToWorkspaceFn = mapM_ killWindow . locationWindow, + { moveWindowToWorkspaceFn = \w -> killWindow w >> return id, gotoWorkspaceFn = confirmPrompt def "Do you want to exit xmonad" $ io exitSuccess, workspaceName = Nothing, @@ -281,14 +284,10 @@ blackHoleWorkspace = alternateWorkspace :: Workspace alternateWorkspace = Workspace - { moveLocationToWorkspaceFn = \l@(Location _ maybeWin) -> do - logs Info "Moving Location: %s" (show l) - case maybeWin of - Nothing -> return () - Just win -> do - alter <- getAlternateWorkspace win - logs Info "Moving %s to %s" (show win) (show alter) - mapM_ (moveLocationToWorkspace l) alter, + { moveWindowToWorkspaceFn = \win -> do + alter <- getAlternateWorkspace win + return $ \ss -> + maybe ss (\a -> W.shiftWin a win ss) alter, gotoWorkspaceFn = do (Location _ maybeWin) <- getCurrentLocation case maybeWin of @@ -304,18 +303,17 @@ newtype FloatWorkspace = FloatWorkspace Workspace floatWorkspace :: Workspace -> Workspace floatWorkspace ws@Workspace {extraWorkspaceData = d} = Workspace - { moveLocationToWorkspaceFn = \location -> do - forM_ (locationWindow location) $ \win -> do - case cast d of - Just (FloatWorkspace ws') -> do - windows $ W.sink win - moveLocationToWorkspaceFn ws' location - Nothing -> do - windows $ \ss -> - if win `Map.member` W.floating ss - then ss -- win is already floating - else W.float win (W.RationalRect (1 / 8) (1 / 8) (6 / 8) (6 / 8)) ss - moveLocationToWorkspaceFn ws location, + { moveWindowToWorkspaceFn = \win -> do + case cast d of + Just (FloatWorkspace ws') -> do + movefn <- moveWindowToWorkspaceFn ws' win + return $ W.sink win . movefn + Nothing ->do + movefn <- moveWindowToWorkspaceFn ws win + 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, gotoWorkspaceFn = gotoWorkspaceFn ws, workspaceName = workspaceName ws, extraWorkspaceData = FloatWorkspace ws -- cgit