aboutsummaryrefslogtreecommitdiff
path: root/src/Internal/Submap.hs
diff options
context:
space:
mode:
authorJosh Rahm <rahm@google.com>2022-03-18 10:15:13 -0600
committerJosh Rahm <joshuarahm@gmail.com>2022-10-09 12:19:45 -0600
commitf0b813ca548319d6ae6c95bd9a35db67223e00ae (patch)
tree747b1c1b534db4815cac8fd0b1cd0f9c9ddc3110 /src/Internal/Submap.hs
parentc2201172d4b582cfc90a87cfe6a3a0c95cdea4e7 (diff)
downloadrde-f0b813ca548319d6ae6c95bd9a35db67223e00ae.tar.gz
rde-f0b813ca548319d6ae6c95bd9a35db67223e00ae.tar.bz2
rde-f0b813ca548319d6ae6c95bd9a35db67223e00ae.zip
Ability to submap the mouse. Added bindings for my Logitech G502 Hero.
Diffstat (limited to 'src/Internal/Submap.hs')
-rw-r--r--src/Internal/Submap.hs31
1 files changed, 30 insertions, 1 deletions
diff --git a/src/Internal/Submap.hs b/src/Internal/Submap.hs
index cdc2f95..40becdc 100644
--- a/src/Internal/Submap.hs
+++ b/src/Internal/Submap.hs
@@ -1,7 +1,13 @@
-module Internal.Submap (mapNextString, module X) where
+module Internal.Submap (
+ mapNextString,
+ submapButtonsWithKey,
+ nextButton,
+ module X) where
import XMonad hiding (keys)
import Control.Monad.Fix (fix)
+import qualified Data.Map as Map
+import Data.Map (Map)
import XMonad.Actions.Submap as X
@@ -26,3 +32,26 @@ mapNextString fn = do
io $ ungrabKeyboard d currentTime
fn m str
+
+nextButton :: X (ButtonMask, Button)
+nextButton = do
+ XConf { theRoot = root, display = d } <- ask
+ io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime
+
+ ret <- io $ allocaXEvent $ \xEv -> do
+ maskEvent d buttonPressMask xEv
+ ButtonEvent { ev_button = button, ev_state = m } <- getEvent xEv
+ return (m, button)
+
+ io $ ungrabPointer d currentTime
+
+ return ret
+
+submapButtonsWithKey ::
+ ((ButtonMask, Button) -> Window -> X ()) -> (Map (ButtonMask, Button) (Window -> X ())) -> Window -> X ()
+submapButtonsWithKey defaultAction actions window = do
+ arg <- nextButton
+
+ case Map.lookup arg actions of
+ Nothing -> defaultAction arg window
+ Just fn -> fn window