{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.RepeatKey
--
-- Maintainer  :  Marshall Lochbaum <mlochbaum@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Binds a keysym to a "repeat last key" key.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.RepeatKey (
    -- * Usage
    -- $usage
    repeatKey
    ) where

import XMonad
import Data.Monoid
import qualified XMonad.Util.ExtensibleState as XS

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Hooks.RepeatKey.hs
-- >
-- > main = xmonad $ defaultConfig {
-- >    ...
-- >    clientMask = ... .|. keyPressMask
-- >    rootMask   = ... .|. keyPressMask
-- >    handleEventHook = repeatKey xK_F13
-- >    ...
-- >  }
--
-- xK_F13 can be replaced with any keysym.

-- Stores the last key pressed
data Keylog = Keylog (KeyMask, KeyCode) | NoKey deriving Typeable
instance ExtensionClass Keylog where
  initialValue = NoKey

-- | Creates the key repeat hook from a KeySym input
repeatKey :: KeySym -> Event -> X All
repeatKey r (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
    | t==keyPress = do
        s <- withDisplay $ \dpy -> io $ keycodeToKeysym dpy code 0
        if s==r then lastKey else XS.put $ Keylog (m, code)
        return (All (s/=r))
repeatKey _ _ = return (All True)

lastKey :: X ()
lastKey = do
    k <- XS.get :: X Keylog
    case k of NoKey -> return ()
              Keylog key -> doKeyPress key
doKeyPress :: (KeyMask, KeyCode) -> X()
doKeyPress (m,c) = do
    ce <- asks currentEvent
    whenJust ce $ \e -> sendKeyEvent e{ev_state=m, ev_keycode=c}

sendKeyEvent :: Event -> X ()
sendKeyEvent (KeyEvent
              { ev_event_type     = _
              , ev_event_display  = d
              , ev_window         = w
              , ev_root           = r
              , ev_subwindow      = sw
              , ev_state          = m
              , ev_keycode        = c
              , ev_same_screen    = ss
              }) =
    io $ allocaXEvent $ \ev -> do
        setEventType ev keyPress
        setKeyEvent ev w r sw m c ss
        sendEvent d w True keyPressMask ev
        setEventType ev keyRelease
        sendEvent d w True keyReleaseMask ev
sendKeyEvent _ = return ()