module XMonad.Actions.Submap (
submap,
submapDefault,
submapDefaultWithKey
) where
import Data.Bits
import XMonad.Prelude (fix, fromMaybe)
import XMonad hiding (keys)
import qualified Data.Map as M
submap :: M.Map (KeyMask, KeySym) (X ()) -> X ()
submap :: Map (KeyMask, EventMask) (X ()) -> X ()
submap = X () -> Map (KeyMask, EventMask) (X ()) -> X ()
submapDefault (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
submapDefault :: X () -> M.Map (KeyMask, KeySym) (X ()) -> X ()
submapDefault :: X () -> Map (KeyMask, EventMask) (X ()) -> X ()
submapDefault = ((KeyMask, EventMask) -> X ())
-> Map (KeyMask, EventMask) (X ()) -> X ()
submapDefaultWithKey (((KeyMask, EventMask) -> X ())
-> Map (KeyMask, EventMask) (X ()) -> X ())
-> (X () -> (KeyMask, EventMask) -> X ())
-> X ()
-> Map (KeyMask, EventMask) (X ())
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X () -> (KeyMask, EventMask) -> X ()
forall a b. a -> b -> a
const
submapDefaultWithKey :: ((KeyMask, KeySym) -> X ())
-> M.Map (KeyMask, KeySym) (X ())
-> X ()
submapDefaultWithKey :: ((KeyMask, EventMask) -> X ())
-> Map (KeyMask, EventMask) (X ()) -> X ()
submapDefaultWithKey (KeyMask, EventMask) -> X ()
defAction Map (KeyMask, EventMask) (X ())
keys = do
XConf { theRoot :: XConf -> EventMask
theRoot = EventMask
root, display :: XConf -> Display
display = Display
d } <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask
IO CInt -> X CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO CInt -> X CInt) -> IO CInt -> X CInt
forall a b. (a -> b) -> a -> b
$ Display
-> EventMask -> Bool -> CInt -> CInt -> EventMask -> IO CInt
grabKeyboard Display
d EventMask
root Bool
False CInt
grabModeAsync CInt
grabModeAsync EventMask
currentTime
IO CInt -> X CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO CInt -> X CInt) -> IO CInt -> X CInt
forall a b. (a -> b) -> a -> b
$ Display
-> EventMask
-> Bool
-> EventMask
-> CInt
-> CInt
-> EventMask
-> EventMask
-> EventMask
-> IO CInt
grabPointer Display
d EventMask
root Bool
False EventMask
buttonPressMask CInt
grabModeAsync CInt
grabModeAsync
EventMask
none EventMask
none EventMask
currentTime
(KeyMask
m, EventMask
s) <- IO (KeyMask, EventMask) -> X (KeyMask, EventMask)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (KeyMask, EventMask) -> X (KeyMask, EventMask))
-> IO (KeyMask, EventMask) -> X (KeyMask, EventMask)
forall a b. (a -> b) -> a -> b
$ (XEventPtr -> IO (KeyMask, EventMask)) -> IO (KeyMask, EventMask)
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO (KeyMask, EventMask)) -> IO (KeyMask, EventMask))
-> (XEventPtr -> IO (KeyMask, EventMask))
-> IO (KeyMask, EventMask)
forall a b. (a -> b) -> a -> b
$ \XEventPtr
p -> (IO (KeyMask, EventMask) -> IO (KeyMask, EventMask))
-> IO (KeyMask, EventMask)
forall a. (a -> a) -> a
fix ((IO (KeyMask, EventMask) -> IO (KeyMask, EventMask))
-> IO (KeyMask, EventMask))
-> (IO (KeyMask, EventMask) -> IO (KeyMask, EventMask))
-> IO (KeyMask, EventMask)
forall a b. (a -> b) -> a -> b
$ \IO (KeyMask, EventMask)
nextkey -> do
Display -> EventMask -> XEventPtr -> IO ()
maskEvent Display
d (EventMask
keyPressMask EventMask -> EventMask -> EventMask
forall a. Bits a => a -> a -> a
.|. EventMask
buttonPressMask) XEventPtr
p
Event
ev <- XEventPtr -> IO Event
getEvent XEventPtr
p
case Event
ev of
KeyEvent { ev_keycode :: Event -> KeyCode
ev_keycode = KeyCode
code, ev_state :: Event -> KeyMask
ev_state = KeyMask
m } -> do
EventMask
keysym <- Display -> KeyCode -> CInt -> IO EventMask
keycodeToKeysym Display
d KeyCode
code CInt
0
if EventMask -> Bool
isModifierKey EventMask
keysym
then IO (KeyMask, EventMask)
nextkey
else (KeyMask, EventMask) -> IO (KeyMask, EventMask)
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyMask
m, EventMask
keysym)
Event
_ -> (KeyMask, EventMask) -> IO (KeyMask, EventMask)
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyMask
0, EventMask
0)
KeyMask
m' <- KeyMask -> X KeyMask
cleanMask (KeyMask -> X KeyMask) -> KeyMask -> X KeyMask
forall a b. (a -> b) -> a -> b
$ KeyMask
m KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.&. ((KeyMask
1 KeyMask -> Int -> KeyMask
forall a. Bits a => a -> Int -> a
`shiftL` Int
12) KeyMask -> KeyMask -> KeyMask
forall a. Num a => a -> a -> a
- KeyMask
1)
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> EventMask -> IO ()
ungrabPointer Display
d EventMask
currentTime
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> EventMask -> IO ()
ungrabKeyboard Display
d EventMask
currentTime
IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Bool -> IO ()
sync Display
d Bool
False
X () -> Maybe (X ()) -> X ()
forall a. a -> Maybe a -> a
fromMaybe ((KeyMask, EventMask) -> X ()
defAction (KeyMask
m', EventMask
s)) ((KeyMask, EventMask)
-> Map (KeyMask, EventMask) (X ()) -> Maybe (X ())
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (KeyMask
m', EventMask
s) Map (KeyMask, EventMask) (X ())
keys)