Better modelling for moving between windows. Reworked shifting windows and made the movement atomic to improve speed

1 files changed, 29 insertions, 25 deletions

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"