aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Rahm/Desktop/Common.hs44
-rw-r--r--src/Rahm/Desktop/Keys.hs95
2 files changed, 107 insertions, 32 deletions
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.<ws> is the same as g<ws>" $ 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.<ws> is the same as g<ws>"
+ $ 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
generated by cgit (git 2.34.1) at 2026-02-22 16:20:29 +0000