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 (() -> X ()
forall a. a -> X a
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 [((KeyMask, EventMask), String)]
-> [((KeyMask, EventMask), String)]
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 =
WindowConfig
-> [String] -> X (KeyMask, EventMask) -> X (KeyMask, EventMask)
forall a. WindowConfig -> [String] -> X a -> X a
withSimpleWindow WindowConfig
wc [String]
descriptions X (KeyMask, EventMask)
waitForKeyPress X (KeyMask, EventMask) -> ((KeyMask, EventMask) -> X ()) -> X ()
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(KeyMask
m', EventMask
s) ->
X () -> ((String, X ()) -> X ()) -> Maybe (String, X ()) -> X ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> X ()
forall a. a -> X a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (String, X ()) -> X ()
forall a b. (a, b) -> b
snd ((KeyMask, EventMask)
-> Map (KeyMask, EventMask) (String, X ()) -> Maybe (String, X ())
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 =
(((KeyMask, EventMask), String) -> String)
-> [((KeyMask, EventMask), String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\((KeyMask, EventMask)
key, String
desc) -> (KeyMask, EventMask) -> String
keyToString (KeyMask, EventMask)
key String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
desc)
([((KeyMask, EventMask), String)] -> [String])
-> ([((KeyMask, EventMask), String)]
-> [((KeyMask, EventMask), String)])
-> [((KeyMask, EventMask), String)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((KeyMask, EventMask), String)]
-> [((KeyMask, EventMask), String)]
sorted
([((KeyMask, EventMask), String)] -> [String])
-> [((KeyMask, EventMask), String)] -> [String]
forall a b. (a -> b) -> a -> b
$ [(KeyMask, EventMask)]
-> [String] -> [((KeyMask, EventMask), String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map (KeyMask, EventMask) (String, X ()) -> [(KeyMask, EventMask)]
forall k a. Map k a -> [k]
M.keys Map (KeyMask, EventMask) (String, X ())
keys) (((String, X ()) -> String) -> [(String, X ())] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, X ()) -> String
forall a b. (a, b) -> a
fst (Map (KeyMask, EventMask) (String, X ()) -> [(String, X ())]
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 (((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 = X (KeyMask, EventMask)
waitForKeyPress X (KeyMask, EventMask) -> ((KeyMask, EventMask) -> X ()) -> X ()
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
\(KeyMask
m', EventMask
s) -> 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)
waitForKeyPress :: X (KeyMask, KeySym)
waitForKeyPress :: X (KeyMask, EventMask)
waitForKeyPress = do
XConf{ theRoot = root, display = dpy } <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask
io $ do grabKeyboard dpy root False grabModeAsync grabModeAsync currentTime
grabPointer dpy root False buttonPressMask grabModeAsync grabModeAsync
none none currentTime
(m, s) <- io $ allocaXEvent $ \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
dpy (EventMask
keyPressMask EventMask -> EventMask -> EventMask
forall a. Bits a => a -> a -> a
.|. EventMask
buttonPressMask) XEventPtr
p
ev <- XEventPtr -> IO Event
getEvent XEventPtr
p
case ev of
KeyEvent { ev_keycode :: Event -> KeyCode
ev_keycode = KeyCode
code, ev_state :: Event -> KeyMask
ev_state = KeyMask
m } -> do
keysym <- Display -> KeyCode -> CInt -> IO EventMask
keycodeToKeysym Display
dpy KeyCode
code CInt
0
if isModifierKey keysym
then nextkey
else return (m, keysym)
Event
_ -> (KeyMask, EventMask) -> IO (KeyMask, EventMask)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyMask
0, EventMask
0)
m' <- cleanKeyMask <*> pure m
io $ do ungrabPointer dpy currentTime
ungrabKeyboard dpy currentTime
sync dpy False
pure (m', s)