1 files changed, 39 insertions, 6 deletions
diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
index da9fe77..496b5f5 100644
--- a/src/Rahm/Desktop/Submap.hs
+++ b/src/Rahm/Desktop/Submap.hs
@@ -11,11 +11,15 @@ module Rahm.Desktop.Submap (
 
 import XMonad hiding (keys)
 import Control.Monad.Fix (fix)
+import Control.Monad (void)
 import qualified Data.Map as Map
 import Data.Map (Map)
 import Control.Concurrent (threadDelay)
 import Data.Word (Word64)
 import Data.Time.Clock.POSIX
+import Rahm.Desktop.RebindKeys
+import Data.Set (Set, (\\))
+import qualified Data.Set as Set
 
 
 currentTimeMillis :: IO Int
@@ -46,7 +50,32 @@ getMaskEventWithTimeout timeout d mask fn = do
             then return True
             else threadDelay 1000 >> getMaskEventWithTimeout' ptr timeout
 
+data KeysToGrab = OnlyKeys [(KeyMask, KeySym)] | AllKeys
+
+grabKeys :: KeysToGrab -> X ()
+grabKeys AllKeys = do
+  XConf { theRoot = root, display = d } <- ask
+  void $ io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
+grabKeys (OnlyKeys (Set.fromList -> keys)) = do
+  ks <- (Set.fromList . Map.keys) <$> asks keyActions
+  let keysToGrab = keys \\ ks -- Avoid grabbing already bound keys
+
+  XConf { theRoot = root, display = d } <- ask
+  mapM_ (doGrab d root) keysToGrab
+
+ungrabKeys :: KeysToGrab -> X ()
+ungrabKeys AllKeys = do
+  XConf { display = d } <- ask
+  io $ ungrabKeyboard d currentTime
+ungrabKeys (OnlyKeys (Set.fromList -> keys)) = do
+  ks <- (Set.fromList . Map.keys) <$> asks keyActions
+  let keysToUngrab = keys \\ ks -- Don't ungrab unbound keys!
+
+  XConf { display = d, theRoot = root } <- ask
+  mapM_ (doUngrab d root) keysToUngrab
+
 {-
+ -
  - Like submap fram XMonad.Actions.Submap, but sends the string from
  - XLookupString to the function along side the keysym.
  -
@@ -54,10 +83,10 @@ getMaskEventWithTimeout timeout d mask fn = do
  - but also allows submappings for keys that may not have a character associated
  - with them (for example, the function keys).
  -}
-mapNextStringWithKeysym :: (KeyMask -> KeySym -> String -> X ()) -> X ()
-mapNextStringWithKeysym fn = do
+mapNextStringWithKeysymOnlyGrabbing :: KeysToGrab -> (KeyMask -> KeySym -> String -> X ()) -> X ()
+mapNextStringWithKeysymOnlyGrabbing keysToGrab fn = do
   XConf { theRoot = root, display = d } <- ask
-  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
+  grabKeys keysToGrab
 
   ret <- io $ fix $ \nextkey -> do
     ret <-
@@ -75,18 +104,22 @@ mapNextStringWithKeysym fn = do
 
       Nothing -> return Nothing
 
-  io $ ungrabKeyboard d currentTime
+  ungrabKeys keysToGrab
   case ret of 
     Just (m, str, keysym) -> fn m keysym str
     Nothing -> return ()
 
+mapNextStringWithKeysym :: (KeyMask -> KeySym -> String -> X ()) -> X ()
+mapNextStringWithKeysym = mapNextStringWithKeysymOnlyGrabbing AllKeys
+
 {- Like submap, but on the character typed rather than the kysym. -}
 mapNextString :: (KeyMask -> String -> X ()) -> X () 
 mapNextString fn = mapNextStringWithKeysym (\m _ s -> fn m s)
 
 submapDefaultWithKey :: ((KeyMask, KeySym) -> X ()) -> Map (KeyMask, KeySym) (X ()) -> X ()
-submapDefaultWithKey def m = mapNextStringWithKeysym $ \mask sym _ -> do
-  Map.findWithDefault (def (mask, sym)) (mask, sym) m
+submapDefaultWithKey def m =
+    mapNextStringWithKeysymOnlyGrabbing (OnlyKeys $ Map.keys m) $ \mask sym _ -> do
+      Map.findWithDefault (def (mask, sym)) (mask, sym) m
 
 submapDefault :: X () -> Map (KeyMask, KeySym) (X ()) -> X ()
 submapDefault def = submapDefaultWithKey (const def)