diff options
Diffstat (limited to 'src/Rahm/Desktop/Submap.hs')
| -rw-r--r-- | src/Rahm/Desktop/Submap.hs | 20 |
1 files changed, 13 insertions, 7 deletions
diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs index 5db8928..48a3144 100644 --- a/src/Rahm/Desktop/Submap.hs +++ b/src/Rahm/Desktop/Submap.hs @@ -9,6 +9,10 @@ module Rahm.Desktop.Submap ( submapDefault, submapDefaultWithKey) where +import Rahm.Desktop.Common +import Control.Monad.Trans.Maybe +import Control.Monad.Trans +import Control.Monad (void) import XMonad hiding (keys) import Control.Monad.Fix (fix) import qualified Data.Map as Map @@ -54,7 +58,8 @@ 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 :: + (KeyMask -> KeySym -> String -> MaybeT X a) -> MaybeT X a mapNextStringWithKeysym fn = do XConf { theRoot = root, display = d } <- ask io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime @@ -76,17 +81,18 @@ mapNextStringWithKeysym fn = do Nothing -> return Nothing io $ ungrabKeyboard d currentTime - case ret of - Just (m, str, keysym) -> fn m keysym str - Nothing -> return () + + (m, str, keysym) <- MaybeT $ return ret + fn m keysym str {- Like submap, but on the character typed rather than the kysym. -} -mapNextString :: (KeyMask -> String -> X ()) -> X () +mapNextString :: (KeyMask -> String -> MaybeT X a) -> MaybeT X a 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 = runMaybeT_ $ + mapNextStringWithKeysym $ \mask sym _ -> lift $ do + Map.findWithDefault (def (mask, sym)) (mask, sym) m submapDefault :: X () -> Map (KeyMask, KeySym) (X ()) -> X () submapDefault def = submapDefaultWithKey (const def) |