{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Hooks.DebugKeyEvents
-- Description  : Track key events.
-- Copyright    : (c) 2011 Brandon S Allbery <allbery.b@gmail.com>
-- License      : BSD
--
-- Maintainer   : Brandon S Allbery <allbery.b@gmail.com>
-- Stability    : unstable
-- Portability  : unportable
--
-- A debugging module to track key events, useful when you can't tell whether
-- xmonad is processing some or all key events.
-----------------------------------------------------------------------------

module XMonad.Hooks.DebugKeyEvents (-- * Usage
                                    -- $usage
                                    debugKeyEvents
                                   ) where

import           XMonad.Core
import           XMonad.Prelude
import           XMonad.Operations               (cleanMask)

import           Graphics.X11.Xlib
import           Graphics.X11.Xlib.Extras

import           Control.Monad.State             (gets)
import           Data.Bits
import           Numeric                         (showHex)
import           System.IO                       (hPutStrLn
                                                 ,stderr)

-- $usage
-- Add this to your handleEventHook to print received key events to the
-- log (the console if you use @startx@/@xinit@, otherwise usually
-- @~/.xsession-errors@).
--
-- >      , handleEventHook = debugKeyEvents
--
-- If you already have a handleEventHook then you should append it:
--
-- >      , handleEventHook = ... <> debugKeyEvents
--
-- Logged key events look like:
--
-- @keycode 53 sym 120 (0x78, "x") mask 0x0 () clean 0x0 ()@
--
-- The @mask@ and @clean@ indicate the modifiers pressed along with
-- the key; @mask@ is raw, and @clean@ is what @xmonad@ sees after
-- sanitizing it (removing @numberLockMask@, etc.)
--
-- For more detailed instructions on editing the logHook see:
--
-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"

-- | Print key events to stderr for debugging
debugKeyEvents :: Event -> X All
debugKeyEvents :: Event -> X All
debugKeyEvents KeyEvent{ev_event_type :: Event -> EventType
ev_event_type = EventType
t, ev_state :: Event -> KeyMask
ev_state = KeyMask
m, ev_keycode :: Event -> KeyCode
ev_keycode = KeyCode
code}
  | EventType
t EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
keyPress =
      (Display -> X All) -> X All
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X All) -> X All) -> (Display -> X All) -> X All
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
        KeySym
sym <- IO KeySym -> X KeySym
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO KeySym -> X KeySym) -> IO KeySym -> X KeySym
forall a b. (a -> b) -> a -> b
$ Display -> KeyCode -> CInt -> IO KeySym
keycodeToKeysym Display
dpy KeyCode
code CInt
0
        KeyMask
msk <- KeyMask -> X KeyMask
cleanMask KeyMask
m
        KeyMask
nl <- (XState -> KeyMask) -> X KeyMask
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> KeyMask
numberlockMask
        IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"keycode"
                                        ,KeyCode -> String
forall a. Show a => a -> String
show KeyCode
code
                                        ,String
"sym"
                                        ,KeySym -> String
forall a. Show a => a -> String
show KeySym
sym
                                        ,String
" ("
                                        ,KeySym -> String
forall n. (Integral n, Show n) => n -> String
hex KeySym
sym
                                        ,String
" \""
                                        ,KeySym -> String
keysymToString KeySym
sym
                                        ,String
"\") mask"
                                        ,KeyMask -> String
forall n. (Integral n, Show n) => n -> String
hex KeyMask
m
                                        ,String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ KeyMask -> KeyMask -> String
vmask KeyMask
nl KeyMask
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                                        ,String
"clean"
                                        ,KeyMask -> String
forall n. (Integral n, Show n) => n -> String
hex KeyMask
msk
                                        ,String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ KeyMask -> KeyMask -> String
vmask KeyMask
nl KeyMask
msk String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                                        ]
        All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
debugKeyEvents Event
_ = All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)

-- | Convenient showHex variant
hex :: (Integral n, Show n) => n -> String
hex :: forall n. (Integral n, Show n) => n -> String
hex n
v = String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ n -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex n
v String
""

-- | Convert a modifier mask into a useful string
vmask                 :: KeyMask -> KeyMask -> String
vmask :: KeyMask -> KeyMask -> String
vmask KeyMask
numLockMask KeyMask
msk =  [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
                         [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
                         ([String], KeyMask) -> [String]
forall a b. (a, b) -> a
fst (([String], KeyMask) -> [String])
-> ([String], KeyMask) -> [String]
forall a b. (a -> b) -> a -> b
$
                         ((KeyMask, String) -> ([String], KeyMask) -> ([String], KeyMask))
-> ([String], KeyMask)
-> [(KeyMask, String)]
-> ([String], KeyMask)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (KeyMask, String) -> ([String], KeyMask) -> ([String], KeyMask)
forall {a} {a}. (Num a, Bits a) => (a, a) -> ([a], a) -> ([a], a)
vmask' ([],KeyMask
msk) [(KeyMask, String)]
masks
    where
      masks :: [(KeyMask, String)]
masks = (KeyMask -> (KeyMask, String)) -> [KeyMask] -> [(KeyMask, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\KeyMask
m -> (KeyMask
m,KeyMask -> String
forall a. Show a => a -> String
show KeyMask
m)) [KeyMask
0..Int -> KeyMask
forall a. Enum a => Int -> a
toEnum (KeyMask -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize KeyMask
msk Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] [(KeyMask, String)] -> [(KeyMask, String)] -> [(KeyMask, String)]
forall a. [a] -> [a] -> [a]
++
              [(KeyMask
numLockMask,String
"num"  )
              ,(   KeyMask
lockMask,String
"lock" )
              ,(KeyMask
controlMask,String
"ctrl" )
              ,(  KeyMask
shiftMask,String
"shift")
              ,(   KeyMask
mod5Mask,String
"mod5" )
              ,(   KeyMask
mod4Mask,String
"mod4" )
              ,(   KeyMask
mod3Mask,String
"mod3" )
              ,(   KeyMask
mod2Mask,String
"mod2" )
              ,(   KeyMask
mod1Mask,String
"mod1" )
              ]
      vmask' :: (a, a) -> ([a], a) -> ([a], a)
vmask'   (a, a)
_   a :: ([a], a)
a@( [a]
_,a
0)                = ([a], a)
a
      vmask' (a
m,a
s)   ([a]
ss,a
v) | a
v a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
m a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
m = (a
sa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ss,a
v a -> a -> a
forall a. Bits a => a -> a -> a
.&. a -> a
forall a. Bits a => a -> a
complement a
m)
      vmask'   (a, a)
_        ([a], a)
r                  = ([a], a)
r