{-# LANGUAGE CPP #-}
module XMonad.Hooks.DebugKeyEvents (
debugKeyEvents
) where
import XMonad.Core
import XMonad.Operations (cleanMask)
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
import Control.Monad.State (gets)
import Data.Bits
import Data.List (intercalate)
import Data.Monoid
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 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
EventType
sym <- IO EventType -> X EventType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO EventType -> X EventType) -> IO EventType -> X EventType
forall a b. (a -> b) -> a -> b
$ Display -> KeyCode -> CInt -> IO EventType
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] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " [String
"keycode"
,KeyCode -> String
forall a. Show a => a -> String
show KeyCode
code
,String
"sym"
,EventType -> String
forall a. Show a => a -> String
show EventType
sym
,String
" ("
,EventType -> String
forall n. (Integral n, Show n) => n -> String
hex EventType
sym
,String
" \""
,EventType -> String
keysymToString EventType
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)
hex :: (Integral n, Show n) => n -> String
hex :: 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
""
vmask :: KeyMask -> KeyMask -> String
vmask :: KeyMask -> KeyMask -> String
vmask KeyMask
numLockMask KeyMask
msk = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " ([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
#if __GLASGOW_HASKELL__ < 707
finiteBitSize x = bitSize x
#endif
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