module XMonad.Actions.Submap (
submap,
visualSubmap,
visualSubmapSorted,
submapDefault,
submapDefaultWithKey,
subName,
) where
import Data.Bits
import qualified Data.Map as M
import XMonad hiding (keys)
import XMonad.Prelude (fix, fromMaybe, keyToString, cleanKeyMask)
import XMonad.Util.XUtils
submap :: M.Map (KeyMask, KeySym) (X ()) -> X ()
submap :: Map (KeyMask, EventMask) (X ()) -> X ()
submap = X () -> Map (KeyMask, EventMask) (X ()) -> X ()
submapDefault (forall (m :: * -> *) a. Monad m => a -> m a
return ())
visualSubmap :: WindowConfig
-> M.Map (KeyMask, KeySym) (String, X ())
-> X ()
visualSubmap :: WindowConfig -> Map (KeyMask, EventMask) (String, X ()) -> X ()
visualSubmap = ([((KeyMask, EventMask), String)]
-> [((KeyMask, EventMask), String)])
-> WindowConfig -> Map (KeyMask, EventMask) (String, X ()) -> X ()
visualSubmapSorted forall a. a -> a
id
visualSubmapSorted :: ([((KeyMask, KeySym), String)] -> [((KeyMask, KeySym), String)])
-> WindowConfig
-> M.Map (KeyMask, KeySym) (String, X ())
-> X ()
visualSubmapSorted :: ([((KeyMask, EventMask), String)]
-> [((KeyMask, EventMask), String)])
-> WindowConfig -> Map (KeyMask, EventMask) (String, X ()) -> X ()
visualSubmapSorted [((KeyMask, EventMask), String)]
-> [((KeyMask, EventMask), String)]
sorted WindowConfig
wc Map (KeyMask, EventMask) (String, X ())
keys =
forall a. WindowConfig -> [String] -> X a -> X a
withSimpleWindow WindowConfig
wc [String]
descriptions X (KeyMask, EventMask)
waitForKeyPress forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(KeyMask
m', EventMask
s) ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) forall a b. (a, b) -> b
snd (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (KeyMask
m', EventMask
s) Map (KeyMask, EventMask) (String, X ())
keys)
where
descriptions :: [String]
descriptions :: [String]
descriptions =
forall a b. (a -> b) -> [a] -> [b]
map (\((KeyMask, EventMask)
key, String
desc) -> (KeyMask, EventMask) -> String
keyToString (KeyMask, EventMask)
key forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> String
desc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((KeyMask, EventMask), String)]
-> [((KeyMask, EventMask), String)]
sorted
forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall k a. Map k a -> [k]
M.keys Map (KeyMask, EventMask) (String, X ())
keys) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall k a. Map k a -> [a]
M.elems Map (KeyMask, EventMask) (String, X ())
keys))
subName :: String -> X () -> (String, X ())
subName :: String -> X () -> (String, X ())
subName = (,)
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = X (KeyMask, EventMask)
waitForKeyPress forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
\(KeyMask
m', EventMask
s) -> forall a. a -> Maybe a -> a
fromMaybe ((KeyMask, EventMask) -> X ()
defAction (KeyMask
m', EventMask
s)) (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (KeyMask
m', EventMask
s) Map (KeyMask, EventMask) (X ())
keys)
waitForKeyPress :: X (KeyMask, KeySym)
waitForKeyPress :: X (KeyMask, EventMask)
waitForKeyPress = do
XConf{ theRoot :: XConf -> EventMask
theRoot = EventMask
root, display :: XConf -> Display
display = Display
dpy } <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do Display
-> EventMask -> Bool -> CInt -> CInt -> EventMask -> IO CInt
grabKeyboard Display
dpy EventMask
root Bool
False CInt
grabModeAsync CInt
grabModeAsync EventMask
currentTime
Display
-> EventMask
-> Bool
-> EventMask
-> CInt
-> CInt
-> EventMask
-> EventMask
-> EventMask
-> IO CInt
grabPointer Display
dpy EventMask
root Bool
False EventMask
buttonPressMask CInt
grabModeAsync CInt
grabModeAsync
EventMask
none EventMask
none EventMask
currentTime
(KeyMask
m, EventMask
s) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
p -> forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \IO (KeyMask, EventMask)
nextkey -> do
Display -> EventMask -> XEventPtr -> IO ()
maskEvent Display
dpy (EventMask
keyPressMask 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
dpy KeyCode
code CInt
0
if EventMask -> Bool
isModifierKey EventMask
keysym
then IO (KeyMask, EventMask)
nextkey
else forall (m :: * -> *) a. Monad m => a -> m a
return (KeyMask
m, EventMask
keysym)
Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (KeyMask
0, EventMask
0)
KeyMask
m' <- X (KeyMask -> KeyMask)
cleanKeyMask forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyMask
m
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do Display -> EventMask -> IO ()
ungrabPointer Display
dpy EventMask
currentTime
Display -> EventMask -> IO ()
ungrabKeyboard Display
dpy EventMask
currentTime
Display -> Bool -> IO ()
sync Display
dpy Bool
False
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyMask
m', EventMask
s)