{-# 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
-- <https://xmonad.org/TUTORIAL.html#make-xmonad-and-xmobar-talk-to-each-other the tutorial>.

-- | 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 forall a. Eq a => a -> a -> Bool
== EventType
keyPress =
      forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
        KeySym
sym <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io 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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> KeyMask
numberlockMask
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"keycode"
                                        ,forall a. Show a => a -> String
show KeyCode
code
                                        ,String
"sym"
                                        ,forall a. Show a => a -> String
show KeySym
sym
                                        ,String
" ("
                                        ,forall n. (Integral n, Show n) => n -> String
hex KeySym
sym
                                        ,String
" \""
                                        ,KeySym -> String
keysymToString KeySym
sym
                                        ,String
"\") mask"
                                        ,forall n. (Integral n, Show n) => n -> String
hex KeyMask
m
                                        ,String
"(" forall a. [a] -> [a] -> [a]
++ KeyMask -> KeyMask -> String
vmask KeyMask
nl KeyMask
m forall a. [a] -> [a] -> [a]
++ String
")"
                                        ,String
"clean"
                                        ,forall n. (Integral n, Show n) => n -> String
hex KeyMask
msk
                                        ,String
"(" forall a. [a] -> [a] -> [a]
++ KeyMask -> KeyMask -> String
vmask KeyMask
nl KeyMask
msk forall a. [a] -> [a] -> [a]
++ String
")"
                                        ]
        forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
debugKeyEvents Event
_ = 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" forall a. [a] -> [a] -> [a]
++ forall a. (Integral a, Show a) => a -> ShowS
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 forall a b. (a -> b) -> a -> b
$
                         forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$
                         forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
                         forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {a}. (Num a, Bits a) => (a, a) -> ([a], a) -> ([a], a)
vmask' ([],KeyMask
msk) [(KeyMask, String)]
masks
    where
      masks :: [(KeyMask, String)]
masks = forall a b. (a -> b) -> [a] -> [b]
map (\KeyMask
m -> (KeyMask
m,forall a. Show a => a -> String
show KeyMask
m)) [KeyMask
0..forall a. Enum a => Int -> a
toEnum (forall b. FiniteBits b => b -> Int
finiteBitSize KeyMask
msk forall a. Num a => a -> a -> a
- Int
1)] 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 forall a. Bits a => a -> a -> a
.&. a
m forall a. Eq a => a -> a -> Bool
== a
m = (a
sforall a. a -> [a] -> [a]
:[a]
ss,a
v forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement a
m)
      vmask'   (a, a)
_        ([a], a)
r                  = ([a], a)
r