From 04a1fd2e2f2eaa9878c4bc67351784d6685ca22b Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Fri, 8 Dec 2023 18:07:41 -0700 Subject: Fix some dragging behavior. Remove some conflicting bindings. --- src/Rahm/Desktop/Dragging.hs | 85 +++++++++++++++++++++++++++++++------------- src/Rahm/Desktop/Keys.hs | 78 ++++++++++------------------------------ 2 files changed, 79 insertions(+), 84 deletions(-) (limited to 'src') diff --git a/src/Rahm/Desktop/Dragging.hs b/src/Rahm/Desktop/Dragging.hs index 853cf43..4ec0edc 100644 --- a/src/Rahm/Desktop/Dragging.hs +++ b/src/Rahm/Desktop/Dragging.hs @@ -4,7 +4,7 @@ import Control.Monad (filterM, when) import Control.Monad.Trans (lift) import Control.Monad.Trans.Maybe (MaybeT (MaybeT)) import Data.IORef (newIORef, readIORef, writeIORef) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isJust) import Rahm.Desktop.Common (pointerLocation, pointerWindow, runMaybeT_, setBorderColor) import Rahm.Desktop.Layout.Hole (addHoleForWindow, removeHoleForWindow, resetHole) import Rahm.Desktop.Layout.PinWindow (isWindowPinned, pinWindow, unpinWindow) @@ -35,6 +35,15 @@ afterDrag action = do st {X.dragging = Just (fn, cleanup >> action)} s -> s +isDragging :: X Bool +isDragging = X.gets (isJust . X.dragging) + +finishDrag :: X () +finishDrag = runMaybeT_ $ do + (_, cleanup) <- MaybeT $ X.gets X.dragging + X.modify $ \s -> s {X.dragging = Nothing} + lift cleanup + windowsUnderCursor :: X [X.Window] windowsUnderCursor = do (dpy, root) <- X.asks $ (,) <$> X.display <*> X.theRoot @@ -56,7 +65,10 @@ windowsUnderCursor = do aw sinkOnRelease :: AfterDragAction -sinkOnRelease = AfterDragAction $ \window _ -> do +sinkOnRelease = AfterDragAction $ \window _ -> sinkByWindowUnderCursor window + +sinkByWindowUnderCursor :: X.Window -> X () +sinkByWindowUnderCursor window = do (cx, cy) <- pointerLocation wins <- filter (/= window) <$> windowsUnderCursor t <- fmap (W.tag . W.workspace) <$> X.pointScreen cx cy @@ -81,8 +93,11 @@ ifReleased but (AfterDragAction act) = AfterDragAction $ \win b -> do ifReleased' :: X.Button -> (X.Window -> X.Button -> X ()) -> AfterDragAction ifReleased' but act = ifReleased but (AfterDragAction act) -mouseResizeWindowAndThen :: (X.Window -> X ()) -> - AfterDragAction -> X.Window -> X () +mouseResizeWindowAndThen :: + (X.Window -> X ()) -> + AfterDragAction -> + X.Window -> + X () mouseResizeWindowAndThen beforeAction (AfterDragAction releaseAction) window = do beforeAction window windowPinned <- isWindowPinned window @@ -97,10 +112,18 @@ mouseResizeWindowAndThen beforeAction (AfterDragAction releaseAction) window = d curev <- X.asks X.currentEvent when windowPinned $ pinWindow window - releaseAction window (maybe 0 X.ev_button curev) + releaseAction + window + ( maybe + 0 + ( \case + X.ButtonEvent {X.ev_button = b} -> b + _ -> 0 + ) + curev + ) X.refresh - mouseMoveWindowAndThen :: (X.Window -> X ()) -> AfterDragAction -> @@ -119,7 +142,16 @@ mouseMoveWindowAndThen beforeAction (AfterDragAction releaseAction) window = do curev <- X.asks X.currentEvent when windowPinned $ pinWindow window - releaseAction window (maybe 0 X.ev_button curev) + releaseAction + window + ( maybe + 0 + ( \case + X.ButtonEvent {X.ev_button = b} -> b + _ -> 0 + ) + curev + ) X.refresh dragWorkspace :: X () @@ -136,7 +168,8 @@ dragWorkspace = do dragWindow :: X () dragWindow = do w <- pointerWindow - if w == 0 + isDockOrRoot <- windowIsDockOrRoot w + if isDockOrRoot then dragWorkspace else do cleanup <- setBorderColor "#00ffff" [w] @@ -163,26 +196,28 @@ dragWindow = do (nx, ny) <- pointerLocation w' <- pointerWindow (_, iocleanup) <- io $ readIORef ref - dock <- X.getAtom "_NET_WM_WINDOW_TYPE_DOCK" - desk <- X.getAtom "_NET_WM_WINDOW_TYPE_DESKTOP" - mbr <- - if w' == 0 - then return Nothing - else getProp32s "_NET_WM_WINDOW_TYPE" w' - - let isDock = - maybe False (any ((`elem` [dock, desk]) . fromIntegral)) mbr - case w' of - _ | w' == 0 || isDock -> - runMaybeT_ $ do - (W.Screen (W.tag -> ws1) _ _) <- MaybeT $ X.pointScreen nx ny - lift $ do - setAlternateWindows [w] - X.windows $ W.sink w . W.shiftWin ws1 w - _ -> do + isDockOrRoot <- windowIsDockOrRoot w' + if isDockOrRoot + then runMaybeT_ $ do + (W.Screen (W.tag -> ws1) _ _) <- MaybeT $ X.pointScreen nx ny + lift $ do + setAlternateWindows [w] + X.windows $ W.sink w . W.shiftWin ws1 w + else do X.windows $ W.focusWindow w . W.swapWindows [(w, w')] setAlternateWindows [w, w'] iocleanup cleanup + where + windowIsDockOrRoot 0 = return True + windowIsDockOrRoot w = do + dock <- X.getAtom "_NET_WM_WINDOW_TYPE_DOCK" + desk <- X.getAtom "_NET_WM_WINDOW_TYPE_DESKTOP" + mbr <- + if w == 0 + then return Nothing + else getProp32s "_NET_WM_WINDOW_TYPE" w + + return $ maybe False (any ((`elem` [dock, desk]) . fromIntegral)) mbr diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index 94308e5..ae293ee 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -295,15 +295,20 @@ keymap = runKeys $ do let subkeys keysM = Submap (runKeys keysM config) repeatable keysM = Repeat (runKeys keysM config) - bind xK_apostrophe $ + bind xK_apostrophe $ do justMod $ - doc "Jump to a window" $ - pushPendingBuffer "' " $ do - runMaybeT_ $ do - l <- readNextLocationSet' - case l of - (h : _) -> lift (focusLocation h) - _ -> return () + doc "Jump to a window/tile currently dragging window" $ do + ifM + D.isDragging + (D.finishDrag >> withFocused D.sinkByWindowUnderCursor) + $ pushPendingBuffer "' " $ do + runMaybeT_ $ do + l <- readNextLocationSet' + case l of + (h : _) -> lift (focusLocation h) + _ -> return () + shiftMod $ + doc "Drag workspace to another." $ D.dragWindow bind xK_semicolon $ justMod $ @@ -1083,20 +1088,14 @@ mouseMap = runButtons $ do subMouse $ do bind button3 $ noMod $ - doc "Move to workspace 's' (Spotify)" $ - noWindow (gotoWorkspace "s") + doc "Drag a workspace to a different screen" $ + noWindow D.dragWorkspace bind button1 $ noMod $ doc "Swap a window with another window by dragging." $ noWindow D.dragWindow - bind button13 $ do - noMod $ - doc "Kill the window under the cursor" $ - noWindow $ - click >> CopyWindow.kill1 - bind button14 $ do noMod $ doc "Pop the window under the cursor" $ @@ -1129,12 +1128,14 @@ mouseMap = runButtons $ do subMouse $ do bind button1 $ noMod $ - doc "Move the mouse under the cursor (like how Mod+leftMouse works)" $ + doc + "Move the mouse under the cursor (like how Mod+leftMouse works)" myMouseMoveWindow bind button2 $ noMod $ - doc "Run the command that started a window." $ + doc + "Run the command that started a window." duplWindow bind button3 $ @@ -1249,47 +1250,6 @@ mouseMap = runButtons $ do ) in windows f >> escape - let workspaceButtons = - [ ( button2, - "Swap the master window with the one under the cursor", - noWindow swapMaster - ), - ( button9, - "View the next workspace", - noWindow $ viewAdjacent next - ), - ( button8, - "View the previous workspace", - noWindow $ viewAdjacent prev - ), - ( button4, - "Focus the previous window in the stack", - noWindow $ windows W.focusUp - ), - ( button5, - "Focus the next window in the stack", - noWindow $ windows W.focusDown - ), - ( button7, - "Swap the current screen with the one to the right", - noWindow $ do - click - runMaybeT_ $ - (lift . gotoWorkspaceFn) =<< workspaceForStringT ",." - ), - ( button6, - "Swap the current screen with the one to the left", - noWindow $ do - click - runMaybeT_ $ - (lift . gotoWorkspaceFn) =<< workspaceForStringT ";." - ) - ] - - continuous $ - forM_ workspaceButtons $ \(b, d, a) -> - bind b $ noMod $ doc d a - -- Bindings specific to a window. These are set similarly to th ekeymap above, -- but uses a Query monad to tell which windows the keys will apply to. -- -- cgit