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]
(Int -> ReadS Locks)
-> ReadS [Locks]
-> ReadPrec Locks
-> ReadPrec [Locks]
-> Read 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
(Int -> Locks -> ShowS)
-> (Locks -> String) -> ([Locks] -> ShowS) -> Show Locks
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 <- ((KeySym, String) -> IO Bool)
-> [(KeySym, String)] -> IO [(KeySym, String)]
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
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ case ((Modifier, [KeyCode]) -> Bool)
-> [(Modifier, [KeyCode])] -> Maybe (Modifier, [KeyCode])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (KeyCode -> [KeyCode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem KeyCode
kc ([KeyCode] -> Bool)
-> ((Modifier, [KeyCode]) -> [KeyCode])
-> (Modifier, [KeyCode])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Modifier, [KeyCode]) -> [KeyCode]
forall a b. (a, b) -> b
snd) [(Modifier, [KeyCode])]
modMap of
Maybe (Modifier, [KeyCode])
Nothing -> Bool
False
Just ( Modifier
i, [KeyCode]
_ ) -> Modifier -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Modifier
m (Modifier -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Modifier
i)
) [(KeySym, String)]
locks
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((KeySym, String) -> String) -> [(KeySym, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (KeySym, String) -> String
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
(XEventPtr -> IO Any) -> IO Any
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO Any) -> IO Any)
-> (XEventPtr -> IO Any) -> IO Any
forall a b. (a -> b) -> a -> b
$ \XEventPtr
ep -> IO Event -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO Event -> IO Any) -> IO Event -> IO Any
forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
cb (String -> IO ()) -> IO String -> IO ()
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
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
m :: CULong
m = CULong
xkbAllStateComponentsMask