aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop/Dragging.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Rahm/Desktop/Dragging.hs')
-rw-r--r--src/Rahm/Desktop/Dragging.hs85
1 files changed, 60 insertions, 25 deletions
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