diff options
Diffstat (limited to 'src/Rahm/Desktop/Submap.hs')
| -rw-r--r-- | src/Rahm/Desktop/Submap.hs | 53 |
1 files changed, 40 insertions, 13 deletions
diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs index 2cb71c3..f5d8f9f 100644 --- a/src/Rahm/Desktop/Submap.hs +++ b/src/Rahm/Desktop/Submap.hs @@ -8,6 +8,7 @@ module Rahm.Desktop.Submap submap, submapDefault, submapDefaultWithKey, + escape, ) where @@ -19,15 +20,17 @@ import Data.Map (Map) import qualified Data.Map as Map (findWithDefault, lookup) import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Word (Word64) -import Rahm.Desktop.Common (runMaybeT_) +import Rahm.Desktop.Common (pointerWindow, runMaybeT_) import XMonad ( Button, ButtonMask, Display, Event (..), + ExtensionClass (initialValue), KeyMask, KeySym, MonadReader (ask), + StateExtension, Window, X, XConf (..), @@ -52,6 +55,23 @@ import XMonad ungrabPointer, (.|.), ) +import qualified XMonad.Util.ExtensibleState as XS + +newtype Escape = Escape Bool + +instance ExtensionClass Escape where + initialValue = Escape False + +-- Escape a submapping. Useful for continuous submappings where a final +-- button/key should finish the mapping. +escape :: X () +escape = XS.put (Escape True) + +getEscape :: X Bool +getEscape = do + (Escape cur) <- XS.get + XS.put (Escape False) + return cur currentTimeMillis :: IO Int currentTimeMillis = round . (* 1000) <$> getPOSIXTime @@ -131,17 +151,23 @@ submap = submapDefault (return ()) -- next button is pressed. nextButton :: X (Maybe (ButtonMask, Button)) nextButton = do - XConf {theRoot = root, display = d} <- ask - io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime + b <- getEscape + if b + then return Nothing + else nextButton' + where + nextButton' = do + XConf {theRoot = root, display = d} <- ask + io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime - ret <- io $ - getMaskEventWithTimeout 5000 d buttonPressMask $ \xEv -> do - ButtonEvent {ev_button = button, ev_state = m} <- getEvent xEv - return (m, button) + ret <- io $ + getMaskEventWithTimeout 5000 d buttonPressMask $ \xEv -> do + ButtonEvent {ev_button = button, ev_state = m} <- getEvent xEv + return (m, button) - io $ ungrabPointer d currentTime + io $ ungrabPointer d currentTime - return ret + return ret {- Grabs the mouse and reports the next mouse motion. -} nextMotion :: X (Int, Int) @@ -184,9 +210,10 @@ submapButtonsWithKey :: submapButtonsWithKey defaultAction actions window = do maybe (return ()) - ( \arg@(_, button) -> - case Map.lookup arg actions of - Nothing -> defaultAction arg window - Just fn -> fn window + ( \key -> do + win' <- pointerWindow + case Map.lookup key actions of + Nothing -> defaultAction key win' + Just fn -> fn win' ) =<< nextButton |