diff options
| -rw-r--r-- | src/Internal/ButtonMasks.hs | 92 | ||||
| -rw-r--r-- | src/Internal/Keys.hs | 6 | ||||
| -rw-r--r-- | src/Main.hs | 3 |
3 files changed, 99 insertions, 2 deletions
diff --git a/src/Internal/ButtonMasks.hs b/src/Internal/ButtonMasks.hs new file mode 100644 index 0000000..9f10246 --- /dev/null +++ b/src/Internal/ButtonMasks.hs @@ -0,0 +1,92 @@ +module Internal.ButtonMasks (withButtonMasks, buttonMask) where + +import Data.Monoid +import Control.Monad (forM_) +import XMonad +import Data.Word +import qualified XMonad.Util.ExtensibleState as XS +import Data.Bits +import Internal.Logger + +button13Mask :: Word32 +button13Mask = 0x01 + +button14Mask :: Word32 +button14Mask = 0x02 + +button15Mask :: Word32 +button15Mask = 0x04 + +button13 :: Button +button13 = 13 + +button14 :: Button +button14 = 14 + +button15 :: Button +button15 = 15 + +newtype ButtonMaskState = ButtonMaskState Word32 deriving (Show, Read, Typeable) + +instance ExtensionClass ButtonMaskState where + initialValue = ButtonMaskState 0 + + +buttonMask :: X Word32 +buttonMask = (\(ButtonMaskState w) -> w) <$> XS.get + +withButtonMasks :: XConfig l -> XConfig l +withButtonMasks xconfig = + xconfig { + startupHook = do + XConf { display = dpy, theRoot = rootw } <- ask + let grab button m = io $ grabButton dpy button m rootw False (buttonPressMask .|. buttonReleaseMask) grabModeAsync grabModeSync none none + + startupHook xconfig + + ems <- extraModifiers + + forM_ [button13, button14, button15] $ \button -> do + forM_ ems $ \mod -> do + grab button mod, + + + handleEventHook = buttonMaskHook <> handleEventHook xconfig + } + +buttonMaskHook :: Event -> X All +buttonMaskHook event = do + case event of + ButtonEvent { ev_button = b, ev_event_type = t, ev_state = st } -> do + logs $ "Button Event! " ++ show b + (ButtonMaskState mask) <- XS.get + logs $ "Cur state " ++ show mask + logs $ "ev_state " ++ show st + + let mMask = + case b of + _ | b == button13 -> Just button13Mask + _ | b == button14 -> Just button14Mask + _ | b == button15 -> Just button15Mask + _ -> Nothing in + + case mMask of + Nothing -> return (All True) + Just mask -> + case t of + _ | t == buttonPress -> do + XS.modify (\(ButtonMaskState m) -> ButtonMaskState $ mask .|. m) + (ButtonMaskState mask) <- XS.get + logs $ "New state " ++ show mask + + return (All False) + + _ | t == buttonRelease -> do + XS.modify (\(ButtonMaskState m) -> ButtonMaskState $ mask .&. (complement m)) + (ButtonMaskState mask) <- XS.get + logs $ "New state " ++ show mask + return (All False) + + _ -> return (All True) + + _ -> return (All True) diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs index 6d34c4a..20e6f15 100644 --- a/src/Internal/Keys.hs +++ b/src/Internal/Keys.hs @@ -54,6 +54,7 @@ import Internal.PassMenu import Internal.Logger import Internal.RebindKeys import Internal.Swallow +import Internal.ButtonMasks import Internal.ScreenRotate (screenRotateForward, screenRotateBackward) type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) @@ -551,7 +552,10 @@ mouseMap = runButtons $ do bind button1 $ do justMod $ \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster - + altMod $ noWindow $ do + m <- buttonMask + logs $ "Mask: " ++ show m + bind button2 $ do justMod $ windows . (W.shiftMaster .) . W.focusWindow diff --git a/src/Main.hs b/src/Main.hs index 0b4a181..0269ef3 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -21,6 +21,7 @@ import Internal.Logger import Internal.DMenu (menuCommandString) import Internal.RebindKeys import Internal.KeysM +import Internal.ButtonMasks import qualified XMonad as X import qualified XMonad.StackSet as W @@ -37,7 +38,7 @@ main = do xmobar <- spawnXMobar (=<<) X.xmonad $ - applyKeys $ ewmh $ docks $ def + applyKeys $ withButtonMasks $ ewmh $ docks $ def { terminal = "alacritty" , modMask = mod3Mask , borderWidth = 2 |