    -----------------------------------------------------------------------------
    -- |
    -- 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,
                                 visualSubmap,
                                 submapDefault,
                                 submapDefaultWithKey,

                                 -- * Utilities
                                 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

    {- $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, 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 ())

    -- | Like 'submap', but visualise the relevant options.
    --
    -- ==== __Example__
    --
    -- > import qualified Data.Map as Map
    -- > import XMonad.Actions.Submap
    -- >
    -- > gotoLayout :: [(String, X ())]   -- for use with EZConfig
    -- > gotoLayout =  -- assumes you have a layout named "Tall" and one named "Full".
    -- >   ["M-l", visualSubmap def $ Map.fromList $ map (\(k, s, a) -> ((0, k), (s, a)))
    -- >             [ (xK_t, "Tall", switchToLayout "Tall")     -- "M-l t" switches to "Tall"
    -- >             , (xK_r, "Full", switchToLayout "Full")     -- "M-l r" switches to "full"
    -- >             ]]
    --
    -- One could alternatively also write @gotoLayout@ as
    --
    -- > gotoLayout = ["M-l", visualSubmap def $ Map.fromList $
    -- >                        [ ((0, xK_t), subName "Tall" $ switchToLayout "Tall")
    -- >                        , ((0, xK_r), subName "Full" $ switchToLayout "Full")
    -- >                        ]]
    visualSubmap :: WindowConfig -- ^ The config for the spawned window.
                 -> M.Map (KeyMask, KeySym) (String, X ())
                                 -- ^ A map @keybinding -> (description, action)@.
                 -> X ()
    visualSubmap :: WindowConfig -> Map (KeyMask, EventMask) (String, X ()) -> X ()
    visualSubmap 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 c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\(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)
                    (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))

    -- | Give a name to an action.
    subName :: String -> X () -> (String, X ())
    subName :: String -> X () -> (String, X ())
    subName = (,)

    -- | 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, 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

    -- | 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, 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)

    -----------------------------------------------------------------------
    -- Internal stuff

    waitForKeyPress :: X (KeyMask, KeySym)
    waitForKeyPress :: X (KeyMask, EventMask)
    waitForKeyPress = do
        XConf{ theRoot :: XConf -> EventMask
    theRoot = EventMask
    root, display :: XConf -> Display
    display = Display
    dpy } <- 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
    $ 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) <- 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
    dpy (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
    dpy KeyCode
    code CInt
    0
                if EventMask -> Bool
    isModifierKey EventMask
    keysym
                    then IO (KeyMask, EventMask)
    nextkey
                    else (KeyMask, EventMask) -> IO (KeyMask, EventMask)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (KeyMask
    m, EventMask
    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)
        KeyMask
    m' <- X (KeyMask -> KeyMask)
    cleanKeyMask X (KeyMask -> KeyMask) -> X KeyMask -> X KeyMask
    forall a b. X (a -> b) -> X a -> X b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> KeyMask -> X KeyMask
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure KeyMask
    m
        IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    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
        (KeyMask, EventMask) -> X (KeyMask, EventMask)
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (KeyMask
    m', EventMask
    s)