aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Main.hs10
-rw-r--r--Operations.hs19
2 files changed, 16 insertions, 13 deletions
diff --git a/Main.hs b/Main.hs
index fc12bce..1716b60 100644
--- a/Main.hs
+++ b/Main.hs
@@ -189,16 +189,16 @@ handle e@(ButtonEvent {ev_event_type = t})
| t == buttonRelease = do
drag <- gets dragging
case drag of
- Just (_,f) -> modify (\s -> s { dragging = Nothing }) >> f
- -- we're done dragging and have released the mouse
- Nothing -> broadcastMessage e
+ -- we're done dragging and have released the mouse:
+ Just (_,f) -> modify (\s -> s { dragging = Nothing }) >> f
+ Nothing -> broadcastMessage e
-- handle motionNotify event, which may mean we are dragging.
handle e@(MotionEvent {ev_event_type = t, ev_x = x, ev_y = y}) = do
drag <- gets dragging
case drag of
- Just (d,_) -> d (fromIntegral x) (fromIntegral y) -- we're dragging
- Nothing -> broadcastMessage e
+ Just (d,_) -> d (fromIntegral x) (fromIntegral y) -- we're dragging
+ Nothing -> broadcastMessage e
-- click on an unfocused window, makes it focused on this workspace
handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })
diff --git a/Operations.hs b/Operations.hs
index c8a9d7a..3e2a561 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -511,14 +511,17 @@ mouseDrag :: (Position -> Position -> X ()) -> X () -> X ()
mouseDrag f done = do
drag <- gets dragging
case drag of
- Just _ -> return () -- error case? we're already dragging
- Nothing -> do XConf { theRoot = root, display = d } <- ask
- io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)
- grabModeAsync grabModeAsync none none currentTime
- let cleanup = do io $ ungrabPointer d currentTime
- modify $ \s -> s { dragging = Nothing }
- done
- modify $ \s -> s { dragging = Just (f, cleanup) }
+ Just _ -> return () -- error case? we're already dragging
+ Nothing -> do
+ XConf { theRoot = root, display = d } <- ask
+ io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)
+ grabModeAsync grabModeAsync none none currentTime
+ modify $ \s -> s { dragging = Just (f, cleanup) }
+ where
+ cleanup = do
+ withDisplay $ io . flip ungrabPointer currentTime
+ modify $ \s -> s { dragging = Nothing }
+ done
mouseMoveWindow :: Window -> X ()
mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do