-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.Submap
-- Description :  Create a sub-mapping of key bindings.
-- Copyright   :  (c) Jason Creighton <jcreigh@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Jason Creighton <jcreigh@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A module that allows the user to create a sub-mapping of key bindings.
--
-----------------------------------------------------------------------------

module XMonad.Actions.Submap (
                             -- * Usage
                             -- $usage
                             submap,
                             submapDefault,
                             submapDefaultWithKey
                            ) where
import Data.Bits
import XMonad.Prelude (fix, fromMaybe)
import XMonad hiding (keys)
import qualified Data.Map as M

{- $usage




First, import this module into your @~\/.xmonad\/xmonad.hs@:

> import XMonad.Actions.Submap

Allows you to create a sub-mapping of keys. Example:

>    , ((modm, xK_a), submap . M.fromList $
>        [ ((0, xK_n),     spawn "mpc next")
>        , ((0, xK_p),     spawn "mpc prev")
>        , ((0, xK_z),     spawn "mpc random")
>        , ((0, xK_space), spawn "mpc toggle")
>        ])

So, for example, to run 'spawn \"mpc next\"', you would hit mod-a (to
trigger the submapping) and then 'n' to run that action. (0 means \"no
modifier\"). You are, of course, free to use any combination of
modifiers in the submapping. However, anyModifier will not work,
because that is a special value passed to XGrabKey() and not an actual
modifier.

For detailed instructions on editing your key bindings, see
"XMonad.Doc.Extending#Editing_key_bindings".

-}

-- | Given a 'Data.Map.Map' from key bindings to X () actions, return
--   an action which waits for a user keypress and executes the
--   corresponding action, or does nothing if the key is not found in
--   the map.
submap :: M.Map (KeyMask, KeySym) (X ()) -> X ()
submap :: Map (KeyMask, KeySym) (X ()) -> X ()
submap = X () -> Map (KeyMask, KeySym) (X ()) -> X ()
submapDefault (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Like 'submap', but executes a default action if the key did not match.
submapDefault :: X () -> M.Map (KeyMask, KeySym) (X ()) -> X ()
submapDefault :: X () -> Map (KeyMask, KeySym) (X ()) -> X ()
submapDefault = ((KeyMask, KeySym) -> X ()) -> Map (KeyMask, KeySym) (X ()) -> X ()
submapDefaultWithKey (((KeyMask, KeySym) -> X ())
 -> Map (KeyMask, KeySym) (X ()) -> X ())
-> (X () -> (KeyMask, KeySym) -> X ())
-> X ()
-> Map (KeyMask, KeySym) (X ())
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X () -> (KeyMask, KeySym) -> X ()
forall a b. a -> b -> a
const

-- | Like 'submapDefault', but sends the unmatched key to the default
-- action as argument.
submapDefaultWithKey :: ((KeyMask, KeySym) -> X ())
                     -> M.Map (KeyMask, KeySym) (X ())
                     -> X ()
submapDefaultWithKey :: ((KeyMask, KeySym) -> X ()) -> Map (KeyMask, KeySym) (X ()) -> X ()
submapDefaultWithKey (KeyMask, KeySym) -> X ()
defAction Map (KeyMask, KeySym) (X ())
keys = do
    XConf { theRoot :: XConf -> KeySym
theRoot = KeySym
root, display :: XConf -> Display
display = Display
d } <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask

    IO GrabStatus -> X GrabStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO GrabStatus -> X GrabStatus) -> IO GrabStatus -> X GrabStatus
forall a b. (a -> b) -> a -> b
$ Display
-> KeySym
-> Bool
-> GrabStatus
-> GrabStatus
-> KeySym
-> IO GrabStatus
grabKeyboard Display
d KeySym
root Bool
False GrabStatus
grabModeAsync GrabStatus
grabModeAsync KeySym
currentTime
    IO GrabStatus -> X GrabStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO GrabStatus -> X GrabStatus) -> IO GrabStatus -> X GrabStatus
forall a b. (a -> b) -> a -> b
$ Display
-> KeySym
-> Bool
-> KeySym
-> GrabStatus
-> GrabStatus
-> KeySym
-> KeySym
-> KeySym
-> IO GrabStatus
grabPointer Display
d KeySym
root Bool
False KeySym
buttonPressMask GrabStatus
grabModeAsync GrabStatus
grabModeAsync
                     KeySym
none KeySym
none KeySym
currentTime

    (KeyMask
m, KeySym
s) <- IO (KeyMask, KeySym) -> X (KeyMask, KeySym)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (KeyMask, KeySym) -> X (KeyMask, KeySym))
-> IO (KeyMask, KeySym) -> X (KeyMask, KeySym)
forall a b. (a -> b) -> a -> b
$ (XEventPtr -> IO (KeyMask, KeySym)) -> IO (KeyMask, KeySym)
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO (KeyMask, KeySym)) -> IO (KeyMask, KeySym))
-> (XEventPtr -> IO (KeyMask, KeySym)) -> IO (KeyMask, KeySym)
forall a b. (a -> b) -> a -> b
$ \XEventPtr
p -> (IO (KeyMask, KeySym) -> IO (KeyMask, KeySym))
-> IO (KeyMask, KeySym)
forall a. (a -> a) -> a
fix ((IO (KeyMask, KeySym) -> IO (KeyMask, KeySym))
 -> IO (KeyMask, KeySym))
-> (IO (KeyMask, KeySym) -> IO (KeyMask, KeySym))
-> IO (KeyMask, KeySym)
forall a b. (a -> b) -> a -> b
$ \IO (KeyMask, KeySym)
nextkey -> do
        Display -> KeySym -> XEventPtr -> IO ()
maskEvent Display
d (KeySym
keyPressMask KeySym -> KeySym -> KeySym
forall a. Bits a => a -> a -> a
.|. KeySym
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
            KeySym
keysym <- Display -> KeyCode -> GrabStatus -> IO KeySym
keycodeToKeysym Display
d KeyCode
code GrabStatus
0
            if KeySym -> Bool
isModifierKey KeySym
keysym
                then IO (KeyMask, KeySym)
nextkey
                else (KeyMask, KeySym) -> IO (KeyMask, KeySym)
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyMask
m, KeySym
keysym)
          Event
_ -> (KeyMask, KeySym) -> IO (KeyMask, KeySym)
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyMask
0, KeySym
0)
    -- Remove num lock mask and Xkb group state bits
    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 -> KeySym -> IO ()
ungrabPointer Display
d KeySym
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 -> KeySym -> IO ()
ungrabKeyboard Display
d KeySym
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, KeySym) -> X ()
defAction (KeyMask
m', KeySym
s)) ((KeyMask, KeySym) -> Map (KeyMask, KeySym) (X ()) -> Maybe (X ())
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (KeyMask
m', KeySym
s) Map (KeyMask, KeySym) (X ())
keys)