diff options
Diffstat (limited to 'src/Rahm')
| -rw-r--r-- | src/Rahm/Desktop/KeysM.hs | 2 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Submap.hs | 43 |
2 files changed, 27 insertions, 18 deletions
diff --git a/src/Rahm/Desktop/KeysM.hs b/src/Rahm/Desktop/KeysM.hs index dcbce2a..403b3fc 100644 --- a/src/Rahm/Desktop/KeysM.hs +++ b/src/Rahm/Desktop/KeysM.hs @@ -470,7 +470,7 @@ documentation = execWriter . document' "" group (\(_, Documented doc _) -> doc) (sortOn (snd . fst) $ Map.toList b) prettyShow :: (KeyMask, KeySym) -> String - prettyShow (mask, key) = printf "<%s%s>" (showMask mask) (keysymToString key) + prettyShow (mask, key) = printf "%s%s" (showMask mask) (keysymToString key) hasSubmap b = case b of Action _ -> False diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs index 2306ee6..da9fe77 100644 --- a/src/Rahm/Desktop/Submap.hs +++ b/src/Rahm/Desktop/Submap.hs @@ -15,26 +15,36 @@ import qualified Data.Map as Map import Data.Map (Map) import Control.Concurrent (threadDelay) import Data.Word (Word64) +import Data.Time.Clock.POSIX + + +currentTimeMillis :: IO Int +currentTimeMillis = round . (*1000) <$> getPOSIXTime getMaskEventWithTimeout :: Int -> Display -> Word64 -> (XEventPtr -> IO a) -> IO (Maybe a) -getMaskEventWithTimeout timeout d mask fn = +getMaskEventWithTimeout timeout d mask fn = do + curTime <- currentTimeMillis allocaXEvent $ \ptr -> do - val <- getMaskEventWithTimeout' ptr timeout + val <- getMaskEventWithTimeout' ptr (curTime + timeout) if val then Just <$> fn ptr else return Nothing where - getMaskEventWithTimeout' ptr t | t <= 0 = return False getMaskEventWithTimeout' ptr timeout = do - b <- checkMaskEvent d mask ptr - if b - then return True - else threadDelay 10 >> getMaskEventWithTimeout' ptr (timeout - 10) + curTime <- currentTimeMillis + + if curTime >= timeout + then return False + else do + b <- checkMaskEvent d mask ptr + if b + then return True + else threadDelay 1000 >> getMaskEventWithTimeout' ptr timeout {- - Like submap fram XMonad.Actions.Submap, but sends the string from @@ -51,7 +61,7 @@ mapNextStringWithKeysym fn = do ret <- io $ fix $ \nextkey -> do ret <- - getMaskEventWithTimeout 150000 d keyPressMask $ \p -> do + getMaskEventWithTimeout 1000 d keyPressMask $ \p -> do KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p keysym <- keycodeToKeysym d code 0 (_, str) <- lookupString (asKeyEvent p) @@ -84,14 +94,14 @@ submapDefault def = submapDefaultWithKey (const def) submap :: Map (KeyMask, KeySym) (X ()) -> X () submap = submapDefault (return ()) -{- Grabs the mouse and returns the next button press. -} -nextButton :: X (ButtonMask, Button) +-- Returns the next button press, or Nothing if the timeout expires before the +-- 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 - ret <- io $ allocaXEvent $ \xEv -> do - maskEvent d buttonPressMask xEv + ret <- io $ getMaskEventWithTimeout 1000 d buttonPressMask $ \xEv -> do ButtonEvent { ev_button = button, ev_state = m } <- getEvent xEv return (m, button) @@ -136,8 +146,7 @@ nextMotionOrButton = do 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 + maybe (return ()) (\arg -> + case Map.lookup arg actions of + Nothing -> defaultAction arg window + Just fn -> fn window) =<< nextButton |