From b173b7ddac441e9d6649b22029d08d4be7aa8431 Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Mon, 27 Apr 2026 18:09:11 -0600 Subject: [feat] implement "swap buddies" double tap Mod4+w to swap the current window with the last window it was swapped with. --- src/Rahm/Desktop/Keys.hs | 78 +++++++++++++++++++++++++++++++--------- src/Rahm/Desktop/Keys/KeyFeed.hs | 17 +++++++++ src/Rahm/Desktop/Swap.hs | 64 +++++++++++++++++++++++++++++++++ 3 files changed, 143 insertions(+), 16 deletions(-) create mode 100644 src/Rahm/Desktop/Swap.hs diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index b6f8737..5fcea5a 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -3,6 +3,7 @@ module Rahm.Desktop.Keys (applyKeys, commandHandler) where import Control.Applicative import Control.Monad ( filterM, + forM, forM_, unless, when, @@ -47,6 +48,7 @@ import Graphics.X11.XScreenSaver (XScreenSaverState (ScreenSaverCycle)) import Rahm.Desktop.BorderColors (BorderColor (BorderColor), withBorderColor, withBorderColorM) import Rahm.Desktop.Common ( Location (..), + Xish (liftFromX), click, duplWindow, focusLocation, @@ -70,7 +72,7 @@ import Rahm.Desktop.History ) import Rahm.Desktop.Keys.Dsl2 import Rahm.Desktop.Keys.Grab (KeySymOrKeyCode (..)) -import Rahm.Desktop.Keys.KeyFeed (execKeyFeed, liftXToFeed, pushKey, runKeyFeed, runKeyFeedX) +import Rahm.Desktop.Keys.KeyFeed import Rahm.Desktop.Keys.Local import Rahm.Desktop.Keys.Wml import Rahm.Desktop.Layout (nLayouts) @@ -119,6 +121,7 @@ import Rahm.Desktop.Submap submap, submapButtonsWithKey, ) +import Rahm.Desktop.Swap import Rahm.Desktop.SwapMaster (swapMaster) import Rahm.Desktop.TabletMode import Rahm.Desktop.Theater @@ -361,21 +364,64 @@ bindings = do bind xK_w $ do justMod $ doc "Swap windows with other windows" $ - pushPendingBuffer "w " $ do - runMaybeT_ $ do - l1 <- mapMaybe (\(Location _ w) -> w) <$> runKeyFeed readNextLocationSet - withBorderColorM selectedWindowsColor l1 $ do - lift $ addStringToPendingBuffer " " - l2 <- mapMaybe (\(Location _ w) -> w) <$> runKeyFeed readNextLocationSet - let (l1', l2') = - if length l1 > length l2 - then (l1, l2) - else (l2, l1) - l1'' = filter (not . (`elem` l2')) l1' - - lift $ do - setAlternateWindows (l1'' ++ l2') - windows $ W.swapWindows $ zip l1'' l2' ++ zip l2' l1'' + pushPendingBuffer "w " $ + execKeyFeed $ do + let doPeek :: KeyFeed a -> KeyFeed a -> KeyFeed a + doPeek ifDouble notDouble = + peekKey + ( \case + (m, xK_w, _) | m == mod4Mask -> skipKey >> ifDouble + _ -> notDouble + ) + in doPeek + ( liftFromX $ do + currentM <- W.peek <$> gets windowset + forM_ currentM $ \current -> do + buddy <- getSwapBuddy current + case buddy of + Just b -> do + logs Debug "Swapping %s with buddy %s" (show current) (show b) + swapWindows [current] [b] + Nothing -> + logs Debug "No swap buddy for %s" (show current) + ) + $ do + l1 <- mapMaybe (\(Location _ w) -> w) <$> readNextLocationSet + liftFromX $ addStringToPendingBuffer " " + l2 <- mapMaybe (\(Location _ w) -> w) <$> readNextLocationSet + let (l1', l2') = + if length l1 > length l2 + then (l1, l2) + else (l2, l1) + l1'' = filter (not . (`elem` l2')) l1' + in liftFromX $ do + setAlternateWindows (l1'' ++ l2') + swapWindows l1'' l2' + + -- let doExec :: KeyFeed a -> KeyFeed a -> KeyFeed a + -- doExec ifDouble notDouble = + -- peekKey + -- ( \case + -- (m, xK_w, _) | m == mod4Mask -> skipKey >> ifDouble + -- _ -> notDouble + -- ) + -- in runKeyFeed $ + -- doExec (pure ()) $ + -- runMaybeT_ $ + -- do + -- l1 <- mapMaybe (\(Location _ w) -> w) <$> readNextLocationSet + -- withBorderColorM selectedWindowsColor l1 $ do + -- lift $ addStringToPendingBuffer " " + -- l2 <- mapMaybe (\(Location _ w) -> w) <$> readNextLocationSet + -- let (l1', l2') = + -- if length l1 > length l2 + -- then (l1, l2) + -- else (l2, l1) + -- l1'' = filter (not . (`elem` l2')) l1' + + -- lift $ do + -- setAlternateWindows (l1'' ++ l2') + -- windows $ W.swapWindows $ zip l1'' l2' ++ zip l2' l1'' shiftMod $ doc "Swap two workspaces (or rename the current one). \ diff --git a/src/Rahm/Desktop/Keys/KeyFeed.hs b/src/Rahm/Desktop/Keys/KeyFeed.hs index c7b08e1..46a2520 100644 --- a/src/Rahm/Desktop/Keys/KeyFeed.hs +++ b/src/Rahm/Desktop/Keys/KeyFeed.hs @@ -7,6 +7,7 @@ import Control.Monad (void, when) import Control.Monad.State (MonadTrans (lift), StateT, evalStateT, modify') import Control.Monad.Trans.Maybe (MaybeT (MaybeT, runMaybeT)) import Data.List.Safe (head, last) +import Linear.V (reifyDim) import Rahm.Desktop.Common (Xish (..)) import Rahm.Desktop.Submap (mapNextStringWithKeysym) import Rahm.Desktop.XMobarLog.PendingBuffer (addStringToPendingBuffer, pushAddPendingBuffer, pushPendingBuffer) @@ -71,6 +72,9 @@ readNextKey fn = KeyFeed $ do upMaybe :: Maybe a -> StateT KeyStream (MaybeT X) a upMaybe m = lift $ MaybeT (return m) +skipKey :: KeyFeed () +skipKey = KeyFeed $ modify' tail + -- Lifts a Maybe int o a KeyFeed. hoistMaybe :: Maybe a -> KeyFeed a hoistMaybe = KeyFeed . lift . MaybeT . return @@ -104,6 +108,19 @@ pushKeys ks = KeyFeed $ modify' (map return ks ++) pushKey :: (KeyMask, KeySym, String) -> KeyFeed () pushKey = pushKeys . (: []) +-- Reads the next key, but does not consume it from the read buffer. +peekKey :: ((KeyMask, KeySym, String) -> KeyFeed a) -> KeyFeed a +peekKey fn = KeyFeed $ do + keyList <- get + nextKeyFn <- lift . MaybeT . return $ head keyList + nextKey@(_, sym, str) <- lift nextKeyFn + modify' ((return nextKey :) . tail) + let (KeyFeed r) = fn nextKey in r + +-- reifiedKey <- lift nextKeyFn +-- modify' (\l -> reifiedKey : tail l) +-- return reifiedKey + -- Converts a string of keys to a stream of keys. toKeyStream :: KeyString -> KeyStream toKeyStream = map return diff --git a/src/Rahm/Desktop/Swap.hs b/src/Rahm/Desktop/Swap.hs new file mode 100644 index 0000000..9415dc2 --- /dev/null +++ b/src/Rahm/Desktop/Swap.hs @@ -0,0 +1,64 @@ +module Rahm.Desktop.Swap + ( SwapBuddy (..), + getSwapBuddy, + recordSwap, + swapWindows, + removeSwapBuddy, + ) +where + +import Control.Monad (forM_, void) +import Data.Default (Default (..)) +import Data.Map (Map) +import qualified Data.Map as Map +import Rahm.Desktop.Common +import Rahm.Desktop.Hooks.WindowChange +import Rahm.Desktop.Logger +import qualified Rahm.Desktop.StackSet as SS +import XMonad (ExtensionClass (..), Window, X, withWindowSet, StateExtension (PersistentExtension), windows) +import qualified XMonad.Util.ExtensibleState as XS +import Data.Maybe (maybeToList) + +newtype SwapBuddy = SwapBuddy + { swapBuddies :: Map Window Window + } + deriving (Read, Show) + +instance Default SwapBuddy where + def = SwapBuddy Map.empty + +instance ExtensionClass SwapBuddy where + initialValue = def + extensionType = PersistentExtension + +-- | Record a swap pairing between two windows. +-- The buddy relationship is bidirectional: w1's buddy becomes w2 and vice versa. +recordSwap :: Window -> Window -> X () +recordSwap w1 w2 = do + XS.modify $ \sw@(SwapBuddy m) -> + SwapBuddy $ Map.insert w1 w2 $ Map.insert w2 w1 m + logs Debug "Recorded swap pairing: %s <-> %s" (show w1) (show w2) + +-- | Get the current (most recent) swap buddy for a window. +getSwapBuddy :: Window -> X (Maybe Window) +getSwapBuddy w = do + SwapBuddy m <- XS.get + return (Map.lookup w m) + +-- | Swap windows between two lists. +-- Each window in w1s is swapped with the corresponding window in w2s. +-- Both windows in each pair become each other's swap buddy. +swapWindows :: [Window] -> [Window] -> X () +swapWindows ws1 ws2 = do + windows $ SS.swapWindows (zip ws1 ws2) + mapM_ (uncurry recordSwap) (zip ws1 ws2) + +-- | Clean up all swap buddy entries for a given window. +-- Should be called when a window is killed or moves to hidden workspace. +removeSwapBuddy :: Window -> X () +removeSwapBuddy w = do + SwapBuddy m <- XS.get + let buddy = Map.lookup w m + cleaned = foldr Map.delete (Map.delete w m) (maybeToList buddy) + XS.put $ SwapBuddy cleaned + logs Debug "Removed swap buddy for window: %s" (show w) -- cgit