diff options
Diffstat (limited to 'src/Rahm/Desktop')
| -rw-r--r-- | src/Rahm/Desktop/Submap.hs | 55 |
1 files changed, 30 insertions, 25 deletions
diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs index 9c20381..246d85c 100644 --- a/src/Rahm/Desktop/Submap.hs +++ b/src/Rahm/Desktop/Submap.hs @@ -16,7 +16,7 @@ module Rahm.Desktop.Submap where import Control.Concurrent (threadDelay) -import Control.Exception (SomeException (SomeException), catch) +import Control.Exception (SomeException (SomeException), catch, finally) import Control.Monad (when) import Control.Monad.Fix (fix) import Control.Monad.Trans (MonadTrans (lift)) @@ -130,30 +130,35 @@ nextButtonOrKeyEvent = do when b (MaybeT (return Nothing)) XConf {theRoot = root, display = d} <- ask - io $ do - grabKeyboard d root False grabModeAsync grabModeAsync currentTime - grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime - - ret <- MaybeT $ - io $ - fix $ \tryAgain -> do - ret <- - getMaskEventWithTimeout 5000 d (keyPressMask .|. buttonPressMask) $ \p -> do - ev <- getEvent p - case ev of - ButtonEvent {ev_button = b, ev_state = m} -> - return $ ButtonPress m b - KeyEvent {ev_keycode = code, ev_state = m} -> do - keysym <- keycodeToKeysym d code 0 - (_, str) <- lookupString (asKeyEvent p) - return $ KeyPress m keysym str - case ret of - Just (KeyPress m sym str) | isModifierKey sym -> tryAgain - x -> return x - - io $ do - ungrabKeyboard d currentTime - ungrabPointer d currentTime + + ret <- + MaybeT $ + io $ + ( do + grabKeyboard d root False grabModeAsync grabModeAsync currentTime + grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime + fix + ( \tryAgain -> + do + ret <- + getMaskEventWithTimeout 5000 d (keyPressMask .|. buttonPressMask) $ \p -> do + ev <- getEvent p + case ev of + ButtonEvent {ev_button = b, ev_state = m} -> + return $ ButtonPress m b + KeyEvent {ev_keycode = code, ev_state = m} -> do + keysym <- keycodeToKeysym d code 0 + (_, str) <- lookupString (asKeyEvent p) + return $ KeyPress m keysym str + case ret of + Just (KeyPress m sym str) | isModifierKey sym -> tryAgain + x -> return x + ) + ) + `finally` ( do + ungrabKeyboard d currentTime + ungrabPointer d currentTime + ) m' <- lift $ cleanMask (event_mask ret) return ret {event_mask = m'} |