diff options
| -rw-r--r-- | Main.hs | 19 | ||||
| -rw-r--r-- | Operations.hs | 44 | ||||
| -rw-r--r-- | XMonad.hs | 3 |
3 files changed, 44 insertions, 22 deletions
@@ -65,7 +65,8 @@ main = do { windowset = winset , layouts = M.fromList [(w, safeLayouts) | w <- [0 .. W workspaces - 1]] , mapped = S.empty - , waitingUnmap = M.empty } + , waitingUnmap = M.empty + , dragging = Nothing } xSetErrorHandler -- in C, I'm too lazy to write the binding: dons @@ -183,6 +184,22 @@ handle e@(MappingNotifyEvent {ev_window = w}) = do io $ refreshKeyboardMapping e when (ev_request e == mappingKeyboard) $ withDisplay $ io . flip grabKeys w +-- handle button release, which may finish dragging. +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 + +-- 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 + -- click on an unfocused window, makes it focused on this workspace handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b }) | t == buttonPress = do diff --git a/Operations.hs b/Operations.hs index 5654505..c8a9d7a 100644 --- a/Operations.hs +++ b/Operations.hs @@ -507,26 +507,30 @@ float w = withDisplay $ \d -> do -- Mouse handling -- | Accumulate mouse motion events -mouseDrag :: (XMotionEvent -> IO ()) -> X () -mouseDrag f = do - XConf { theRoot = root, display = d } <- ask - io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask) - grabModeAsync grabModeAsync none none currentTime - io $ allocaXEvent $ \p -> fix $ \again -> do -- event loop - maskEvent d (buttonReleaseMask .|. pointerMotionMask) p - et <- get_EventType p - when (et == motionNotify) $ get_MotionEvent p >>= f >> again - io $ ungrabPointer d currentTime +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) } mouseMoveWindow :: Window -> X () mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do io $ raiseWindow d w wa <- io $ getWindowAttributes d w - (_, _, _, ox, oy, _, _, _) <- io $ queryPointer d w - mouseDrag $ \(_, _, _, ex, ey, _, _, _, _, _) -> - moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox))) - (fromIntegral (fromIntegral (wa_y wa) + (ey - oy))) - float w + (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w + let ox = fromIntegral ox' + oy = fromIntegral oy' + mouseDrag (\ex ey -> do + io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox))) + (fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))) + (float w) mouseResizeWindow :: Window -> X () mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do @@ -534,11 +538,11 @@ mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do wa <- io $ getWindowAttributes d w sh <- io $ getWMNormalHints d w io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa)) - mouseDrag $ \(_, _, _, ex, ey, _, _, _, _, _) -> - resizeWindow d w `uncurry` - applySizeHints sh ((fromIntegral (max 1 (ex - fromIntegral (wa_x wa)))), - (fromIntegral (max 1 (ey - fromIntegral (wa_y wa))))) - float w + mouseDrag (\ex ey -> do + io $ resizeWindow d w `uncurry` + applySizeHints sh ((fromIntegral (max 1 (ex - fromIntegral (wa_x wa)))), + (fromIntegral (max 1 (ey - fromIntegral (wa_y wa)))))) + (float w) -- --------------------------------------------------------------------- -- | Support for window size hints @@ -43,7 +43,8 @@ data XState = XState { windowset :: !WindowSet -- ^ workspace list , mapped :: !(S.Set Window) -- ^ the Set of mapped windows , waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents - , layouts :: !(M.Map WorkspaceId (Layout Window, [Layout Window])) } + , layouts :: !(M.Map WorkspaceId (Layout Window, [Layout Window])) + , dragging :: !(Maybe (Position -> Position -> X (), X ())) } -- ^ mapping of workspaces to descriptions of their layouts data XConf = XConf { display :: Display -- ^ the X11 display |