From 3c6488cc3d976fe47dda946b1a5c09828a86f4ec Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Mon, 4 Dec 2023 18:32:13 -0700 Subject: Added a couple of draggable bindings. These new bindings allow the user to click on a window and "drag" it to a different window. This will swap the two windows once the drag button is released. The other binding is similar, but for whole workspaces. --- src/Rahm/Desktop/Common.hs | 44 +++++++++++---------- src/Rahm/Desktop/Keys.hs | 95 +++++++++++++++++++++++++++++++++++++++------- 2 files changed, 107 insertions(+), 32 deletions(-) (limited to 'src') diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs index 4787598..005eeca 100644 --- a/src/Rahm/Desktop/Common.hs +++ b/src/Rahm/Desktop/Common.hs @@ -15,6 +15,7 @@ module Rahm.Desktop.Common getCurrentWorkspace, getCurrentLocation, runMaybeT_, + setBorderColor, Location (..), ) where @@ -133,29 +134,34 @@ myFinallyE m closer = catchE (m <* closer) (\e -> closer >> throwE e) -- Temporarily set the border color of the given windows. withBorderColorE :: String -> [Window] -> ExceptT e X a -> ExceptT e X a withBorderColorE color wins fn = do - d <- lift $ asks display + cleanup <- lift (setBorderColor color wins) + myFinallyE fn (lift cleanup) + +-- Set the border color for the given windows. This function returns another +-- function that should be used to clean up the border changes. +setBorderColor :: String -> [Window] -> X (X ()) +setBorderColor color wins = do + d <- asks display (px, oPx, fPx) <- - lift $ - (,,) - <$> stringToPixel d color - <*> (stringToPixel d =<< asks (normalBorderColor . config)) - <*> (stringToPixel d =<< asks (focusedBorderColor . config)) + (,,) + <$> stringToPixel d color + <*> (stringToPixel d =<< asks (normalBorderColor . config)) + <*> (stringToPixel d =<< asks (focusedBorderColor . config)) (colorName, oColorName, fColorName) <- - lift $ - (,,) - <$> io (pixelToString d px) - <*> io (pixelToString d oPx) - <*> io (pixelToString d fPx) + (,,) + <$> io (pixelToString d px) + <*> io (pixelToString d oPx) + <*> io (pixelToString d fPx) forM_ wins $ \w -> - lift $ setWindowBorderWithFallback d w colorName px + setWindowBorderWithFallback d w colorName px - myFinallyE fn $ - lift $ do - forM_ wins $ \w -> - setWindowBorderWithFallback d w oColorName oPx - withFocused $ \fw -> + return $ do + forM_ wins $ \w -> + setWindowBorderWithFallback d w oColorName oPx + withFocused $ \fw -> + when (fw `elem` wins) $ setWindowBorderWithFallback d fw fColorName fPx withBorderColorM :: String -> [Window] -> MaybeT X a -> MaybeT X a @@ -186,8 +192,8 @@ withBorderWidth width ws fn = do gotoWorkspace :: WorkspaceId -> X () gotoWorkspace wid = do - logs Debug "GotoWorkspace %s" wid - windows $ S.greedyView wid + logs Debug "GotoWorkspace %s" wid + windows $ S.greedyView wid moveLocationToWorkspace :: Location -> WorkspaceId -> X () moveLocationToWorkspace (Location _ (Just win)) wid = diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 55a0742..4bb87d6 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -18,6 +18,7 @@ import Control.Monad.Writer tell, ) import Data.Char (isAlpha) +import Data.IORef import Data.List (foldl') import Data.List.Safe ((!!)) import Data.Map (Map) @@ -46,6 +47,7 @@ import Rahm.Desktop.Common locationWindow, locationWorkspace, runMaybeT_, + setBorderColor, withBorderColor, withBorderColorM, ) @@ -451,18 +453,20 @@ keymap = runKeys $ do (lift . gotoWorkspaceFn) =<< readNextWorkspace shiftMod $ - doc "Switch a workspace with another workspace. \ - \This is a more powerful version of the 'g' command, which does not\ - \assume the current workspace.\ - \which takes two workspaces as arguments and switches them whereas\ - \the 'g' command operates only on the current workspace (.).\ - \thereby G. is the same as g" $ do - pushPendingBuffer "G " $ do - runMaybeT_ $ do - w1 <- readNextWorkspaceName - lift $ addStringToPendingBuffer " " - w2 <- readNextWorkspaceName - lift $ windows $ W.switchWorkspaces w1 w2 + doc + "Switch a workspace with another workspace. \ + \This is a more powerful version of the 'g' command, which does not\ + \assume the current workspace.\ + \which takes two workspaces as arguments and switches them whereas\ + \the 'g' command operates only on the current workspace (.).\ + \thereby G. is the same as g" + $ do + pushPendingBuffer "G " $ do + runMaybeT_ $ do + w1 <- readNextWorkspaceName + lift $ addStringToPendingBuffer " " + w2 <- readNextWorkspaceName + lift $ windows $ W.switchWorkspaces w1 w2 bind xK_d $ justMod $ @@ -976,6 +980,11 @@ mouseMap = runButtons $ do doc "Move to workspace 's' (Spotify)" $ noWindow (gotoWorkspace "s") + bind button1 $ + noMod $ + doc "Swap a window with another window by dragging." $ + noWindow dragWindow + bind button13 $ do noMod $ doc "Kill the window under the cursor" $ @@ -1075,7 +1084,7 @@ mouseMap = runButtons $ do bind button1 $ noMod $ doc "'drag' a workspace to another screen" $ - \w -> mouseMoveWindow w + noWindow dragWorkspace let workspaceButtons = [ ( button2, @@ -1269,3 +1278,63 @@ modifyWindowBorder i = ModifyWindowBorder $ \(Border a b c d) -> where clip i | i < 0 = 0 clip i = i + +dragWorkspace :: X () +dragWorkspace = do + (dpy, root) <- asks $ (,) <$> display <*> theRoot + (_, _, _, fromIntegral -> ox, fromIntegral -> oy, _, _, _) <- io $ queryPointer dpy root + mouseDrag (\_ _ -> return ()) $ do + (_, _, _, fromIntegral -> nx, fromIntegral -> ny, _, _, _) <- io $ queryPointer dpy root + runMaybeT_ $ do + (W.Screen (W.tag -> ws1) _ _) <- MaybeT $ pointScreen ox oy + (W.Screen (W.tag -> ws2) _ _) <- MaybeT $ pointScreen nx ny + + lift $ windows $ W.switchWorkspaces ws1 ws2 + +dragWindow :: X () +dragWindow = do + (dpy, root) <- asks $ (,) <$> display <*> theRoot + (_, _, w, _, _, _, _, _) <- io $ queryPointer dpy root + if w == 0 + then dragWorkspace + else do + cleanup <- setBorderColor "#00ffff" [w] + + ref <- io $ newIORef (w, return ()) + + mouseDrag + ( \_ _ -> do + (_, _, w', _, _, _, _, _) <- io $ queryPointer dpy root + (ow, ocleanup) <- io $ readIORef ref + logs Debug "%s, %s, %s\n" (show w) (show w') (show ow) + case () of + () | ow /= w' -> do + ocleanup + logs Debug "setBorderColor %s\n" w' + cleanup' <- + if w' == 0 || w' == w + then return (return ()) + else setBorderColor "#80a0a0" [w'] + io $ writeIORef ref (w', cleanup') + () -> return () + + return () + ) + $ do + (_, _, w', fromIntegral -> nx, fromIntegral -> ny, _, _, _) <- io $ queryPointer dpy root + (_, iocleanup) <- io $ readIORef ref + + case w' of + 0 -> + runMaybeT_ $ do + (W.Screen (W.tag -> ws1) _ _) <- MaybeT $ pointScreen nx ny + lift $ do + setAlternateWindows [w] + windows $ W.sink w . W.shiftWin ws1 w + _ -> do + windows $ W.focusWindow w . W.swapWindows [(w, w')] + + setAlternateWindows [w, w'] + + iocleanup + cleanup -- cgit