More experimental MouseMotion

1 files changed, 19 insertions, 0 deletions

diff --git a/src/Internal/Submap.hs b/src/Internal/Submap.hs
index c51f9b6..32dda2a 100644
--- a/src/Internal/Submap.hs
+++ b/src/Internal/Submap.hs
@@ -3,6 +3,7 @@ module Internal.Submap (
     submapButtonsWithKey,
     nextButton,
     nextMotion,
+    nextMotionOrButton,
     module X) where
 
 import XMonad hiding (keys)
@@ -62,6 +63,24 @@ nextMotion = do
 
   return ret
 
+nextMotionOrButton :: X (Either (Int, Int) (ButtonMask, Button))
+nextMotionOrButton = do
+  XConf { theRoot = root, display = d } <- ask
+  io $ grabPointer d root False (pointerMotionMask .|. buttonPressMask) grabModeAsync grabModeAsync 0 0 currentTime
+
+  ret <- io $ allocaXEvent $ \xEv -> do
+    maskEvent d (pointerMotionMask .|. buttonPressMask) xEv
+    ev <- getEvent xEv
+    case ev of
+      MotionEvent { ev_x = x, ev_y = y } ->
+        return $ Left (fromIntegral x, fromIntegral y)
+      ButtonEvent { ev_button = button, ev_state = m } ->
+        return $ Right (m, button)
+
+  io $ ungrabPointer d currentTime
+
+  return ret
+
 submapButtonsWithKey ::
     ((ButtonMask, Button) -> Window -> X ()) -> Map (ButtonMask, Button) (Window -> X ()) -> Window -> X ()
 submapButtonsWithKey defaultAction actions window = do