summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Config.hs7
-rw-r--r--Config.hs-boot3
-rw-r--r--Main.hs61
-rw-r--r--Operations.hs52
4 files changed, 69 insertions, 54 deletions
diff --git a/Config.hs b/Config.hs
index f70f0e5..98f30eb 100644
--- a/Config.hs
+++ b/Config.hs
@@ -141,3 +141,10 @@ keys = M.fromList $
[((m .|. modMask, key), screenWorkspace sc >>= f)
| (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
, (f, m) <- [(view, 0), (shift, shiftMask)]]
+
+mouseBindings :: M.Map (KeyMask, Button) (Window -> X ())
+mouseBindings = M.fromList $
+ [ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w))
+ , ((modMask, button2), (\w -> focus w >> swapMaster))
+ , ((modMask, button3), (\w -> focus w >> mouseResizeWindow w))
+ ]
diff --git a/Config.hs-boot b/Config.hs-boot
index ca01d46..2d66ae1 100644
--- a/Config.hs-boot
+++ b/Config.hs-boot
@@ -1,6 +1,3 @@
module Config where
import Graphics.X11.Xlib.Types (Dimension)
-import Graphics.X11.Xlib (KeyMask)
borderWidth :: Dimension
-modMask :: KeyMask
-numlockMask :: KeyMask
diff --git a/Main.hs b/Main.hs
index f3f2219..1d759e9 100644
--- a/Main.hs
+++ b/Main.hs
@@ -73,6 +73,8 @@ main = do
selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask
.|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask
grabKeys dpy rootw
+ grabButtons dpy rootw
+
sync dpy False
ws <- scan dpy rootw
@@ -110,45 +112,19 @@ grabKeys dpy rootw = do
where grab kc m = grabKey dpy kc m rootw True grabModeAsync grabModeAsync
+grabButtons :: Display -> Window -> IO ()
+grabButtons dpy rootw = do
+ ungrabButton dpy anyButton anyModifier rootw
+ mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) extraModifiers) (M.keys mouseBindings)
+ where grab button mask = grabButton dpy button mask rootw False buttonPressMask
+ grabModeAsync grabModeSync none none
+
+extraModifiers :: [KeyMask]
+extraModifiers = [0, numlockMask, lockMask, numlockMask .|. lockMask ]
+
cleanMask :: KeyMask -> KeyMask
cleanMask = (complement (numlockMask .|. lockMask) .&.)
-------------------------------------------------------------------------
--- 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
-
-mouseMoveWindow :: Window -> X ()
-mouseMoveWindow 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
-
-mouseResizeWindow :: Window -> X ()
-mouseResizeWindow w = withDisplay $ \d -> do
- io $ raiseWindow d w
- wa <- io $ getWindowAttributes 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 (fromIntegral (max 1 (ex - fromIntegral (wa_x wa))))
- (fromIntegral (max 1 (ey - fromIntegral (wa_y wa))))
- float w
-
-- ---------------------------------------------------------------------
-- | Event handler. Map X events onto calls into Operations.hs, which
-- modify our internal model of the window manager state.
@@ -184,11 +160,14 @@ handle e@(MappingNotifyEvent {ev_window = w}) = do
when (ev_request e == mappingKeyboard) $ withDisplay $ io . flip grabKeys w
-- click on an unfocused window, makes it focused on this workspace
-handle (ButtonEvent {ev_window = w, ev_event_type = t, ev_state = m, ev_button = b })
- | t == buttonPress && cleanMask m == modMask && b == button1 = mouseMoveWindow w
- | t == buttonPress && cleanMask m == modMask && b == button2 = focus w >> swapMaster
- | t == buttonPress && cleanMask m == modMask && b == button3 = mouseResizeWindow w
- | t == buttonPress = focus w
+handle (ButtonEvent { ev_window = w, ev_subwindow = subw, ev_event_type = t, ev_state = m, ev_button = b })
+ | t == buttonPress = do isr <- isRoot w
+ -- If it's the root window, then it's something we
+ -- grabbed in grabButtons. Otherwise, it's
+ -- click-to-focus.
+ if isr
+ then whenJust (M.lookup (cleanMask m, b) mouseBindings) ($ subw)
+ else focus w
-- entered a normal window, makes this focused.
handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
diff --git a/Operations.hs b/Operations.hs
index 243da7e..370f066 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -15,7 +15,7 @@ module Operations where
import XMonad
import qualified StackSet as W
-import {-# SOURCE #-} Config (borderWidth, modMask, numlockMask)
+import {-# SOURCE #-} Config (borderWidth)
import Data.Maybe
import Data.List (genericIndex, intersectBy, partition, delete)
@@ -240,17 +240,13 @@ rescreen = do
-- ---------------------------------------------------------------------
-extraModifiers :: [KeyMask]
-extraModifiers = [0, numlockMask, lockMask, numlockMask .|. lockMask ]
-
-- | setButtonGrab. Tell whether or not to intercept clicks on a given window
setButtonGrab :: Bool -> Window -> X ()
-setButtonGrab grabAll w = withDisplay $ \d -> io $ do
- when (not grabAll) $ ungrabButton d anyButton anyModifier w
- mapM_ (grab d) masks
- where masks = if grabAll then [anyModifier] else map (modMask .|.) extraModifiers
- grab d m = grabButton d anyButton m w False (buttonPressMask .|. buttonReleaseMask)
- grabModeAsync grabModeSync none none
+setButtonGrab grab w = withDisplay $ \d -> io $
+ if grab
+ then grabButton d anyButton anyModifier w False buttonPressMask
+ grabModeAsync grabModeSync none none
+ else ungrabButton d anyButton anyModifier w
-- ---------------------------------------------------------------------
-- Setting keyboard focus
@@ -433,3 +429,39 @@ float w = withDisplay $ \d -> do
--
-- toggleFloating :: Window -> X ()
-- toggleFloating w = gets windowset >>= \ws -> if M.member w (W.floating ws) then sink w else float w
+
+------------------------------------------------------------------------
+-- 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
+
+mouseMoveWindow :: Window -> X ()
+mouseMoveWindow 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
+
+mouseResizeWindow :: Window -> X ()
+mouseResizeWindow w = withDisplay $ \d -> do
+ io $ raiseWindow d w
+ wa <- io $ getWindowAttributes 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 (fromIntegral (max 1 (ex - fromIntegral (wa_x wa))))
+ (fromIntegral (max 1 (ey - fromIntegral (wa_y wa))))
+ float w
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 10:24:41 +0100