From a770fa33ff5f5208f1c1a5e5d6186bca8309b6f6 Mon Sep 17 00:00:00 2001 From: Jason Creighton Date: Sat, 2 Jun 2007 06:06:47 +0200 Subject: make mouse bindings configurable darcs-hash:20070602040647-b9aa7-d7bad13c4919882368872a88f04a678308162be6.gz --- Config.hs | 7 +++++++ Config.hs-boot | 3 --- Main.hs | 61 +++++++++++++++++++--------------------------------------- Operations.hs | 52 +++++++++++++++++++++++++++++++++++++++---------- 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 -- cgit v1.2.3