module Xmobar.Plugins.Locks(Locks(..)) where
import Graphics.X11
import Data.List
import Data.Bits
import Control.Monad
import Graphics.X11.Xlib.Extras
import Xmobar.Run.Exec
import Xmobar.System.Kbd
import Xmobar.X11.Events (nextEvent')
data Locks = Locks
deriving (ReadPrec [Locks]
ReadPrec Locks
Int -> ReadS Locks
ReadS [Locks]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Locks]
$creadListPrec :: ReadPrec [Locks]
readPrec :: ReadPrec Locks
$creadPrec :: ReadPrec Locks
readList :: ReadS [Locks]
$creadList :: ReadS [Locks]
readsPrec :: Int -> ReadS Locks
$creadsPrec :: Int -> ReadS Locks
Read, Int -> Locks -> ShowS
[Locks] -> ShowS
Locks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Locks] -> ShowS
$cshowList :: [Locks] -> ShowS
show :: Locks -> String
$cshow :: Locks -> String
showsPrec :: Int -> Locks -> ShowS
$cshowsPrec :: Int -> Locks -> ShowS
Show)
locks :: [ ( KeySym, String )]
locks :: [(KeySym, String)]
locks = [ ( KeySym
xK_Caps_Lock, String
"CAPS" )
, ( KeySym
xK_Num_Lock, String
"NUM" )
, ( KeySym
xK_Scroll_Lock, String
"SCROLL" )
]
run' :: Display -> Window -> IO String
run' :: Display -> KeySym -> IO String
run' Display
d KeySym
root = do
[(Modifier, [KeyCode])]
modMap <- Display -> IO [(Modifier, [KeyCode])]
getModifierMapping Display
d
( Bool
_, KeySym
_, KeySym
_, CInt
_, CInt
_, CInt
_, CInt
_, Modifier
m ) <- Display
-> KeySym
-> IO (Bool, KeySym, KeySym, CInt, CInt, CInt, CInt, Modifier)
queryPointer Display
d KeySym
root
[(KeySym, String)]
ls <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ( \( KeySym
ks, String
_ ) -> do
KeyCode
kc <- Display -> KeySym -> IO KeyCode
keysymToKeycode Display
d KeySym
ks
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem KeyCode
kc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Modifier, [KeyCode])]
modMap of
Maybe (Modifier, [KeyCode])
Nothing -> Bool
False
Just ( Modifier
i, [KeyCode]
_ ) -> forall a. Bits a => a -> Int -> Bool
testBit Modifier
m (forall a b. (Integral a, Num b) => a -> b
fromIntegral Modifier
i)
) [(KeySym, String)]
locks
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(KeySym, String)]
ls
instance Exec Locks where
alias :: Locks -> String
alias Locks
Locks = String
"locks"
start :: Locks -> (String -> IO ()) -> IO ()
start Locks
Locks String -> IO ()
cb = do
Display
d <- String -> IO Display
openDisplay String
""
KeySym
root <- Display -> ScreenNumber -> IO KeySym
rootWindow Display
d (Display -> ScreenNumber
defaultScreen Display
d)
Modifier
_ <- Display -> Modifier -> Modifier -> CULong -> CULong -> IO Modifier
xkbSelectEventDetails Display
d Modifier
xkbUseCoreKbd Modifier
xkbIndicatorStateNotify CULong
m CULong
m
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
ep -> forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
cb forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Display -> KeySym -> IO String
run' Display
d KeySym
root
Display -> XEventPtr -> IO ()
nextEvent' Display
d XEventPtr
ep
XEventPtr -> IO Event
getEvent XEventPtr
ep
Display -> IO ()
closeDisplay Display
d
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
m :: CULong
m = CULong
xkbAllStateComponentsMask