diff options
author | Pavan Rikhi <pavan.rikhi@gmail.com> | 2018-03-17 22:48:24 -0400 |
---|---|---|
committer | jao <jao@gnu.org> | 2018-11-21 21:41:35 +0000 |
commit | 4d1402a1a7d87767267d48a77998e4fb13395b31 (patch) | |
tree | 17fd6160dc1fa9c8a0676a94bcf8d19b551c655c /src/Xmobar/Plugins/Locks.hs | |
parent | 9e2a5c7daddf683d4be7c318aefed3da3ea7a89a (diff) | |
download | xmobar-4d1402a1a7d87767267d48a77998e4fb13395b31.tar.gz xmobar-4d1402a1a7d87767267d48a77998e4fb13395b31.tar.bz2 |
Split Modules into Library & Executable Structure
Move the Main module to a new `app` directory. All other modules have
been nested under the `Xmobar` name. Lots of module headers & imports
were updated.
Diffstat (limited to 'src/Xmobar/Plugins/Locks.hs')
-rw-r--r-- | src/Xmobar/Plugins/Locks.hs | 64 |
1 files changed, 64 insertions, 0 deletions
diff --git a/src/Xmobar/Plugins/Locks.hs b/src/Xmobar/Plugins/Locks.hs new file mode 100644 index 0000000..9a971e5 --- /dev/null +++ b/src/Xmobar/Plugins/Locks.hs @@ -0,0 +1,64 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Locks +-- Copyright : (c) Patrick Chilton +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Patrick Chilton <chpatrick@gmail.com> +-- Stability : unstable +-- Portability : unportable +-- +-- A plugin that displays the status of the lock keys. +-- +----------------------------------------------------------------------------- + +module Xmobar.Plugins.Locks where + +import Graphics.X11 +import Data.List +import Data.Bits +import Control.Monad +import Graphics.X11.Xlib.Extras +import Xmobar.Plugins +import Xmobar.Plugins.Kbd +import Xmobar.XUtil (nextEvent') + +data Locks = Locks + deriving (Read, Show) + +locks :: [ ( KeySym, String )] +locks = [ ( xK_Caps_Lock, "CAPS" ) + , ( xK_Num_Lock, "NUM" ) + , ( xK_Scroll_Lock, "SCROLL" ) + ] + +run' :: Display -> Window -> IO String +run' d root = do + modMap <- getModifierMapping d + ( _, _, _, _, _, _, _, m ) <- queryPointer d root + + ls <- filterM ( \( ks, _ ) -> do + kc <- keysymToKeycode d ks + return $ case find (elem kc . snd) modMap of + Nothing -> False + Just ( i, _ ) -> testBit m (fromIntegral i) + ) locks + + return $ unwords $ map snd ls + +instance Exec Locks where + alias Locks = "locks" + start Locks cb = do + d <- openDisplay "" + root <- rootWindow d (defaultScreen d) + _ <- xkbSelectEventDetails d xkbUseCoreKbd xkbIndicatorStateNotify m m + + allocaXEvent $ \ep -> forever $ do + cb =<< run' d root + nextEvent' d ep + getEvent ep + + closeDisplay d + return () + where + m = xkbAllStateComponentsMask |