aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDavid Roundy <droundy@darcs.net>2007-08-07 22:16:16 +0200
committerDavid Roundy <droundy@darcs.net>2007-08-07 22:16:16 +0200
commit444cf3dd778b2e688e06a6e174b8ee813c8f4c9b (patch)
tree456042107b404faec9c0b5113d4ebb2f0ef8fdfa
parent4fcba00eefa16fa92bdd96bc222edb30365a3784 (diff)
downloadxmonad-444cf3dd778b2e688e06a6e174b8ee813c8f4c9b.tar.gz
xmonad-444cf3dd778b2e688e06a6e174b8ee813c8f4c9b.tar.xz
xmonad-444cf3dd778b2e688e06a6e174b8ee813c8f4c9b.zip
move event loop out of mouseDrag.
darcs-hash:20070807201616-72aca-80f5d15118592f79aca8a2e928c4ad4f29fdf8b1.gz
-rw-r--r--Main.hs19
-rw-r--r--Operations.hs44
-rw-r--r--XMonad.hs3
3 files changed, 44 insertions, 22 deletions
diff --git a/Main.hs b/Main.hs
index efa7ab1..fc12bce 100644
--- a/Main.hs
+++ b/Main.hs
@@ -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
diff --git a/XMonad.hs b/XMonad.hs
index 8eec7b1..28f763d 100644
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -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