{-# LANGUAGE CPP #-}
module XMonad.Hooks.DebugKeyEvents (
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)
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)
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
""
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