diff options
| -rw-r--r-- | src/Config.hs | 3 | ||||
| -rw-r--r-- | src/Plugins/Locks.hs | 51 |
2 files changed, 53 insertions, 1 deletions
diff --git a/src/Config.hs b/src/Config.hs index a6ad3e2..622c79c 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -34,6 +34,7 @@ import Plugins.StdinReader import Plugins.XMonadLog import Plugins.EWMH import Plugins.Kbd +import Plugins.Locks #ifdef INOTIFY import Plugins.Mail @@ -120,7 +121,7 @@ infixr :*: -- the 'Runnable.Runnable' Read instance. To install a plugin just add -- the plugin's type to the list of types (separated by ':*:') appearing in -- this function's type signature. -runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: +runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: Locks :*: #ifdef INOTIFY Mail :*: MBox :*: #endif diff --git a/src/Plugins/Locks.hs b/src/Plugins/Locks.hs new file mode 100644 index 0000000..296bcb4 --- /dev/null +++ b/src/Plugins/Locks.hs @@ -0,0 +1,51 @@ +----------------------------------------------------------------------------- +-- | +-- 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 Plugins.Locks where + +import Graphics.X11 +import Data.List +import Data.Bits +import Control.Monad +import Graphics.X11.Xlib.Extras +import Plugins + +data Locks = Locks + deriving (Read, Show) + +locks :: [ ( KeySym, String )] +locks = [ ( xK_Caps_Lock, "CAPS" ) + , ( xK_Num_Lock, "NUM" ) + , ( xK_Scroll_Lock, "SCROLL" ) + ] + +instance Exec Locks where + alias Locks = "locks" + rate Locks = 2 + run Locks = do + d <- openDisplay "" + root <- rootWindow d (defaultScreen d) + + 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 + closeDisplay d + + return $ unwords $ map snd ls
\ No newline at end of file |