From c6f882fe85e3766464cc68d4edd2abe9bd08217a Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 18 Mar 2022 10:15:13 -0600
Subject: Ability to submap the mouse. Added bindings for my Logitech G502
 Hero.

---
 src/Internal/Submap.hs | 31 ++++++++++++++++++++++++++++++-
 1 file changed, 30 insertions(+), 1 deletion(-)

(limited to 'src/Internal/Submap.hs')

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
-- 
cgit 


From a87cbc7357566b26c7dca7538d4b03da5f8b999a Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Fri, 18 Mar 2022 17:47:40 -0600
Subject: Add experimental motion events. Not super useful at the moment, but
 might be in the future.

---
 src/Internal/Submap.hs | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

(limited to 'src/Internal/Submap.hs')

diff --git a/src/Internal/Submap.hs b/src/Internal/Submap.hs
index 40becdc..e5968ff 100644
--- a/src/Internal/Submap.hs
+++ b/src/Internal/Submap.hs
@@ -2,6 +2,7 @@ module Internal.Submap (
     mapNextString,
     submapButtonsWithKey,
     nextButton,
+    nextMotion,
     module X) where
 
 import XMonad hiding (keys)
@@ -47,6 +48,20 @@ nextButton = do
 
   return ret
 
+nextMotion :: X (Int, Int)
+nextMotion = do
+  XConf { theRoot = root, display = d } <- ask
+  io $ grabPointer d root False pointerMotionMask grabModeAsync grabModeAsync 0 0 currentTime
+
+  ret <- io $ allocaXEvent $ \xEv -> do
+    maskEvent d pointerMotionMask xEv
+    MotionEvent { ev_x = x, ev_y = y } <- getEvent xEv
+    return (fromIntegral x, fromIntegral y)
+
+  io $ ungrabPointer d currentTime
+
+  return ret
+
 submapButtonsWithKey ::
     ((ButtonMask, Button) -> Window -> X ()) -> (Map (ButtonMask, Button) (Window -> X ())) -> Window -> X ()
 submapButtonsWithKey defaultAction actions window = do
-- 
cgit