aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop
diff options
context:
space:
mode:
Diffstat (limited to 'src/Rahm/Desktop')
-rw-r--r--src/Rahm/Desktop/Keys.hs78
-rw-r--r--src/Rahm/Desktop/Keys/KeyFeed.hs17
-rw-r--r--src/Rahm/Desktop/Swap.hs64
3 files changed, 143 insertions, 16 deletions
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)
generated by cgit (git 2.34.1) at 2026-10-19 18:30:20 +0000