-- This module is based on Jason Creighton's XMonad.Actions.Submap

module XMonad.Stockholm.Submap
    ( submapString
    ) where

import qualified Data.Map as M
import Control.Monad.Fix (fix)
import Data.Bits
import XMonad hiding (keys)


-- | Like 'XMonad.Actions.Submap.submapDefault', but provides the looked up string to the default action.
submapString :: (String -> X ()) -> M.Map (KeyMask, KeySym) (X ()) -> X ()
submapString defAction keys = do
    XConf { display = d } <- ask

    (m, s, str) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
        maskEvent d keyPressMask p
        KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
        keysym <- keycodeToKeysym d code 0
        if isModifierKey keysym
            then nextkey
            else do
                (_, str) <- lookupString (asKeyEvent p)
                return (m, keysym, str)

    -- Remove num lock mask and Xkb group state bits
    m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1)

    maybe (defAction str) id (M.lookup (m', s) keys)