diff options
| author | Josh Rahm <joshuarahm@gmail.com> | 2022-04-10 13:26:16 -0600 |
|---|---|---|
| committer | Josh Rahm <joshuarahm@gmail.com> | 2022-10-09 12:19:46 -0600 |
| commit | a652c330707e2e9bbe963e01af79ce730cf3452e (patch) | |
| tree | 047655195f50efcbd51db8f825acf589dc6abead /src/Internal/Submap.hs | |
| parent | 381a3e5a00813314249bb74b5460f5ff5a4006bb (diff) | |
| download | rde-a652c330707e2e9bbe963e01af79ce730cf3452e.tar.gz rde-a652c330707e2e9bbe963e01af79ce730cf3452e.tar.bz2 rde-a652c330707e2e9bbe963e01af79ce730cf3452e.zip | |
Rename Internal to Rahm.Desktop
Diffstat (limited to 'src/Internal/Submap.hs')
| -rw-r--r-- | src/Internal/Submap.hs | 104 |
1 files changed, 0 insertions, 104 deletions
diff --git a/src/Internal/Submap.hs b/src/Internal/Submap.hs deleted file mode 100644 index 0e54c43..0000000 --- a/src/Internal/Submap.hs +++ /dev/null @@ -1,104 +0,0 @@ -module Internal.Submap ( - mapNextString, - mapNextStringWithKeysym, - submapButtonsWithKey, - nextButton, - nextMotion, - nextMotionOrButton, - module X) where - -import XMonad hiding (keys) -import Control.Monad.Fix (fix) -import qualified Data.Map as Map -import Data.Map (Map) - -import XMonad.Actions.Submap as X - -{- - - Like submap fram XMonad.Actions.Submap, but sends the string from - - XLookupString to the function along side the keysym. - - - - This function allows mappings where the mapped string might be important, - - 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 a) -> X a -mapNextStringWithKeysym fn = do - XConf { theRoot = root, display = d } <- ask - io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime - - (m, str, keysym) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do - maskEvent d keyPressMask p - KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p - keysym <- keycodeToKeysym d code 0 - (_, str) <- lookupString (asKeyEvent p) - - if isModifierKey keysym - then nextkey - else return (m, str, keysym) - - io $ ungrabKeyboard d currentTime - - fn m keysym str - -{- Like submap, but on the character typed rather than the kysym. -} -mapNextString :: (KeyMask -> String -> X a) -> X a -mapNextString fn = mapNextStringWithKeysym (\m _ s -> fn m s) - -{- Grabs the mouse and returns the next button press. -} -nextButton :: X (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 - ButtonEvent { ev_button = button, ev_state = m } <- getEvent xEv - return (m, button) - - io $ ungrabPointer d currentTime - - return ret - -{- Grabs the mouse and reports the next mouse motion. -} -nextMotion :: X (Int, Int) -nextMotion = do - XConf { theRoot = root, display = d } <- ask - io $ grabPointer d root False pointerMotionMask grabModeAsync grabModeAsync 0 0 currentTime - - ret <- io $ allocaXEvent $ \xEv -> do - maskEvent d pointerMotionMask xEv - MotionEvent { ev_x = x, ev_y = y } <- getEvent xEv - return (fromIntegral x, fromIntegral y) - - io $ ungrabPointer d currentTime - - return ret - -{- Grabs the mouse and reports the next mouse motion or button press. -} -nextMotionOrButton :: X (Either (Int, Int) (ButtonMask, Button)) -nextMotionOrButton = do - XConf { theRoot = root, display = d } <- ask - io $ grabPointer d root False (pointerMotionMask .|. buttonPressMask) grabModeAsync grabModeAsync 0 0 currentTime - - ret <- io $ allocaXEvent $ \xEv -> do - maskEvent d (pointerMotionMask .|. buttonPressMask) xEv - ev <- getEvent xEv - case ev of - MotionEvent { ev_x = x, ev_y = y } -> - return $ Left (fromIntegral x, fromIntegral y) - ButtonEvent { ev_button = button, ev_state = m } -> - return $ Right (m, button) - - io $ ungrabPointer d currentTime - - return ret - -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 |