diff options
| -rw-r--r-- | README | 15 | ||||
| -rw-r--r-- | src/Config.hs | 3 | ||||
| -rw-r--r-- | src/Plugins/Kbd.hsc | 415 | ||||
| -rw-r--r-- | xmobar.cabal | 9 |
4 files changed, 436 insertions, 6 deletions
@@ -683,6 +683,8 @@ Monitors have default aliases. distribution can be used to set the given property from the output of any other program or script. +[samples/xmonadpropwrite.hs script]: https://github.com/jaor/xmobar/raw/master/samples/xmonadpropwrite.hs + `Brightness Args RefreshRate` - Aliases to `bright` @@ -700,8 +702,19 @@ Monitors have default aliases. Run Brightness ["-t", "<bar>"] 60 +`Kbd Opts` + +- Registers to XKB/X11-Events and output the currently active keyboard layout. + Supports replacement of layoutnames. +- Aliases to `kbd` +- Opts + - `-e`: String displayed on an error while accessing X (default: "Err") + - `-s`: Search string, can be used multiple times (optional) + - `-r`: Replacement string, one for every Search should be given (optional) +- Example: + + Run Kbd [] ["-s", "us(dvorak)", "-r", "DV", "-s", "us", "-r", "US"] "kbd" -[samples/xmonadpropwrite.hs script]: https://github.com/jaor/xmobar/raw/master/samples/xmonadpropwrite.hs ## Monitor Plugins Commands Arguments diff --git a/src/Config.hs b/src/Config.hs index 3184023..4405314 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -32,6 +32,7 @@ import Plugins.CommandReader import Plugins.StdinReader import Plugins.XMonadLog import Plugins.EWMH +import Plugins.Kbd #ifdef INOTIFY import Plugins.Mail @@ -112,7 +113,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 :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: +runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: #ifdef INOTIFY Mail :*: MBox :*: #endif diff --git a/src/Plugins/Kbd.hsc b/src/Plugins/Kbd.hsc new file mode 100644 index 0000000..8e87af6 --- /dev/null +++ b/src/Plugins/Kbd.hsc @@ -0,0 +1,415 @@ +{-# LANGUAGE ScopedTypeVariables, ForeignFunctionInterface, MultiParamTypeClasses, DeriveDataTypeable, FlexibleInstances, PatternGuards #-} + +module Plugins.Kbd where + +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras +import Foreign +import Foreign.C.Types (CUInt,CULong,CInt,CUShort,CChar,CUChar) +import Foreign.C.String +import Plugins +import Control.Monad (forever) +import XUtil (nextEvent') +import Data.List (isPrefixOf, elemIndex) +import Data.Maybe (fromJust) +import System.Console.GetOpt + +#include <X11/XKBlib.h> +#include <X11/extensions/XKB.h> +#include <X11/extensions/XKBstr.h> + +-- +-- Definition for XkbStaceRec and getKbdLayout taken from +-- XMonad.Layout.XKBLayout +-- +data XkbStateRec = XkbStateRec { + group :: CUChar, + locked_group :: CUChar, + base_group :: CUShort, + latched_group :: CUShort, + mods :: CUChar, + base_mods :: CUChar, + latched_mods :: CUChar, + locked_mods :: CUChar, + compat_state :: CUChar, + grab_mods :: CUChar, + compat_grab_mods :: CUChar, + lookup_mods :: CUChar, + compat_lookup_mods :: CUChar, + ptr_buttons :: CUShort +} + +instance Storable XkbStateRec where + sizeOf _ = (#size XkbStateRec) + alignment _ = alignment (undefined :: CUShort) + peek ptr = do + r_group <- (#peek XkbStateRec, group) ptr + r_locked_group <- (#peek XkbStateRec, locked_group) ptr + r_base_group <- (#peek XkbStateRec, base_group) ptr + r_latched_group <- (#peek XkbStateRec, latched_group) ptr + r_mods <- (#peek XkbStateRec, mods) ptr + r_base_mods <- (#peek XkbStateRec, base_mods) ptr + r_latched_mods <- (#peek XkbStateRec, latched_mods) ptr + r_locked_mods <- (#peek XkbStateRec, locked_mods) ptr + r_compat_state <- (#peek XkbStateRec, compat_state) ptr + r_grab_mods <- (#peek XkbStateRec, grab_mods) ptr + r_compat_grab_mods <- (#peek XkbStateRec, compat_grab_mods) ptr + r_lookup_mods <- (#peek XkbStateRec, lookup_mods) ptr + r_compat_lookup_mods <- (#peek XkbStateRec, compat_lookup_mods) ptr + r_ptr_buttons <- (#peek XkbStateRec, ptr_buttons) ptr + return XkbStateRec { + group = r_group, + locked_group = r_locked_group, + base_group = r_base_group, + latched_group = r_latched_group, + mods = r_mods, + base_mods = r_base_mods, + latched_mods = r_latched_mods, + locked_mods = r_locked_mods, + compat_state = r_compat_state, + grab_mods = r_grab_mods, + compat_grab_mods = r_compat_grab_mods, + lookup_mods = r_lookup_mods, + compat_lookup_mods = r_compat_lookup_mods, + ptr_buttons = r_ptr_buttons + } + +foreign import ccall unsafe "X11/XKBlib.h XkbGetState" + xkbGetState :: Display -> CUInt -> Ptr XkbStateRec -> IO CInt + + +getKbdLayout :: Display -> IO Int +getKbdLayout d = alloca $ \stRecPtr -> do + xkbGetState d 0x100 stRecPtr + st <- peek stRecPtr + return $ fromIntegral (group st) + +-- +-- +-- + +data XkbKeyNameRec = XkbKeyNameRec { + name :: Ptr CChar -- array +} + +-- +-- the t_ before alias is just because of name collisions +-- +data XkbKeyAliasRec = XkbKeyAliasRec { + real :: Ptr CChar, -- array + t_alias :: Ptr CChar -- array +} + +-- +-- the t_ before geometry is just because of name collisions +-- +data XkbNamesRec = XkbNamesRec { + keycodes :: Atom, + t_geometry :: Atom, + symbols :: Atom, + types :: Atom, + compat :: Atom, + vmods :: Ptr Atom, + indicators :: Ptr Atom, -- array + groups :: Ptr Atom, -- array + keys :: Ptr XkbKeyNameRec, + key_aliases :: Ptr CChar, -- dont care XkbKeyAliasRec, + radio_groups :: Ptr Atom, + phys_symbols :: Atom, + num_keys :: CUChar, + num_key_aliases :: CUChar, + num_rg :: CUShort +} + +-- +-- the t_ before map, indicators and compat are just because of name collisions +-- +data XkbDescRec = XkbDescRec { + t_dpy :: Ptr CChar, -- struct _XDisplay* ; don't care + flags :: CUShort, + device_spec :: CUShort, + min_key_code :: KeyCode, + max_key_code :: KeyCode, + ctrls :: Ptr CChar, -- XkbControlsPtr ; dont' care + server :: Ptr CChar, -- XkbServerMapPtr ; dont' care + t_map :: Ptr CChar, --XkbClientMapPtr ; dont' care + t_indicators :: Ptr CChar, -- XkbIndicatorPtr ; dont' care + names :: Ptr XkbNamesRec, -- array + t_compat :: Ptr CChar, -- XkbCompatMap ; dont' care + geom :: Ptr CChar -- XkbGeometryPtr ; dont' care + +} + +instance Storable XkbKeyNameRec where + sizeOf _ = (#size XkbKeyNameRec) + alignment _ = alignment (undefined :: CUShort) + peek ptr = do + r_name <- (#peek XkbKeyNameRec, name) ptr + + return XkbKeyNameRec { + name = r_name + } + +instance Storable XkbKeyAliasRec where + sizeOf _ = (#size XkbKeyAliasRec) + alignment _ = alignment (undefined :: CUShort) + peek ptr = do + r_real <- (#peek XkbKeyAliasRec, real) ptr + r_alias <- (#peek XkbKeyAliasRec, alias) ptr + + return XkbKeyAliasRec { + real = r_real, + t_alias = r_alias + } + +instance Storable XkbNamesRec where + sizeOf _ = (#size XkbNamesRec) + alignment _ = alignment (undefined :: CUShort) + peek ptr = do + r_keycodes <- (#peek XkbNamesRec, keycodes) ptr + r_geometry <- (#peek XkbNamesRec, geometry) ptr + r_symbols <- (#peek XkbNamesRec, symbols ) ptr + r_types <- (#peek XkbNamesRec, types ) ptr + r_compat <- (#peek XkbNamesRec, compat ) ptr + r_vmods <- (#peek XkbNamesRec, vmods ) ptr + r_indicators <- (#peek XkbNamesRec, indicators ) ptr + r_groups <- (#peek XkbNamesRec, groups ) ptr + r_keys <- (#peek XkbNamesRec, keys ) ptr + r_key_aliases <- (#peek XkbNamesRec, key_aliases ) ptr + r_radio_groups <- (#peek XkbNamesRec, radio_groups ) ptr + r_phys_symbols <- (#peek XkbNamesRec, phys_symbols ) ptr + r_num_keys <- (#peek XkbNamesRec,num_keys ) ptr + r_num_key_aliases <- (#peek XkbNamesRec, num_key_aliases ) ptr + r_num_rg <- (#peek XkbNamesRec, num_rg ) ptr + + return XkbNamesRec { + keycodes = r_keycodes, + t_geometry = r_geometry, + symbols = r_symbols, + types = r_types, + compat = r_compat, + vmods = r_vmods, + indicators = r_indicators, + groups = r_groups, + keys = r_keys, + key_aliases = r_key_aliases, + radio_groups = r_radio_groups, + phys_symbols = r_phys_symbols, + num_keys = r_num_keys, + num_key_aliases = r_num_key_aliases, + num_rg = r_num_rg + } + +instance Storable XkbDescRec where + sizeOf _ = (#size XkbDescRec) + alignment _ = alignment (undefined :: CUShort) + peek ptr = do + r_dpy <- (#peek XkbDescRec, dpy) ptr + r_flags <- (#peek XkbDescRec, flags) ptr + r_device_spec <- (#peek XkbDescRec, device_spec) ptr + r_min_key_code <- (#peek XkbDescRec, min_key_code) ptr + r_max_key_code <- (#peek XkbDescRec, max_key_code) ptr + r_ctrls <- (#peek XkbDescRec, ctrls) ptr + r_server <- (#peek XkbDescRec, server) ptr + r_map <- (#peek XkbDescRec, map) ptr + r_indicators <- (#peek XkbDescRec, indicators) ptr + r_names <- (#peek XkbDescRec, names) ptr + r_compat <- (#peek XkbDescRec, compat) ptr + r_geom <- (#peek XkbDescRec, geom) ptr + + return XkbDescRec { + t_dpy = r_dpy, + flags = r_flags, + device_spec = r_device_spec, + min_key_code = r_min_key_code, + max_key_code = r_max_key_code, + ctrls = r_ctrls, + server = r_server, + t_map = r_map, + t_indicators = r_indicators, + names = r_names, + t_compat = r_compat, + geom = r_geom + } + +-- +-- C bindings +-- + +foreign import ccall unsafe "X11/XKBlib.h XkbAllocKeyboard" + xkbAllocKeyboard :: IO (Ptr XkbDescRec) + +foreign import ccall unsafe "X11/XKBlib.h XkbGetNames" + xkbGetNames :: Display -> CUInt -> (Ptr XkbDescRec) -> IO Status + +foreign import ccall unsafe "X11/XKBlib.h XGetAtomName" + xGetAtomName :: Display -> Atom -> IO CString + +foreign import ccall unsafe "X11/XKBlib.h XkbFreeNames" + xkbFreeNames :: (Ptr XkbDescRec) -> CUInt -> CInt -> IO () + +foreign import ccall unsafe "X11/XKBlib.h XkbFreeKeyboard" + xkbFreeKeyboard :: (Ptr XkbDescRec) -> CUInt -> CInt -> IO () + +foreign import ccall unsafe "X11/XKBlib.h XkbSelectEventDetails" + xkbSelectEventDetails :: Display -> CUInt -> CUInt -> CULong -> CULong -> IO CUInt + +foreign import ccall unsafe "X11/XKBlib.h XkbSelectEvents" + xkbSelectEvents :: Display -> CUInt -> CUInt -> CUInt -> IO CUInt + + +xkbUseCoreKbd :: CUInt +xkbUseCoreKbd = #const XkbUseCoreKbd + +xkbStateNotify :: CUInt +xkbStateNotify = #const XkbStateNotify + +xkbMapNotify :: CUInt +xkbMapNotify = #const XkbMapNotify + +xkbMapNotifyMask :: CUInt +xkbMapNotifyMask = #const XkbMapNotifyMask + +xkbNewKeyboardNotifyMask :: CUInt +xkbNewKeyboardNotifyMask = #const XkbNewKeyboardNotifyMask + +xkbAllStateComponentsMask :: CULong +xkbAllStateComponentsMask = #const XkbAllStateComponentsMask + +xkbGroupStateMask :: CULong +xkbGroupStateMask = #const XkbGroupStateMask + +xkbSymbolsNameMask :: CUInt +xkbSymbolsNameMask = #const XkbSymbolsNameMask + +xkbGroupNamesMask :: CUInt +xkbGroupNamesMask = #const XkbGroupNamesMask + +data KbdOpts = KbdOpts + { errorString :: String + , src :: [String] + , rpl :: [String] + } + +defaultOpts :: KbdOpts +defaultOpts = KbdOpts + { errorString = "Err" + , src = [] + , rpl = [] + } + +options :: [OptDescr (KbdOpts -> KbdOpts)] +options = + [ Option ['e'] ["error"] (ReqArg (\x o -> o { errorString = x }) "") "" + , Option ['s'] ["src"] (ReqArg (\x o -> o { src = [x] ++ src o }) "") "" + , Option ['r'] ["rpl"] (ReqArg (\x o -> o { rpl = [x] ++ rpl o }) "") "" + ] + +parseOpts :: [String] -> IO KbdOpts +parseOpts argv = + case getOpt Permute options argv of + (o, _, []) -> return $ foldr id defaultOpts o + (_, _, errs) -> ioError . userError $ concat errs + + +-- gets the layout string +getLayoutStr :: KbdOpts -> Display -> IO String +getLayoutStr opts dpy = do + kbdDescPtr <- xkbAllocKeyboard + status <- xkbGetNames dpy xkbSymbolsNameMask kbdDescPtr + str <- getLayoutStr' opts status dpy kbdDescPtr + xkbFreeNames kbdDescPtr xkbGroupNamesMask 1 + xkbFreeKeyboard kbdDescPtr 0 1 + return str + +getLayoutStr' :: KbdOpts -> Status -> Display -> (Ptr XkbDescRec) -> IO String +getLayoutStr' opts st dpy kbdDescPtr = + if st == 0 then -- Success + do + kbdDesc <- peek kbdDescPtr + nameArray <- peek (names kbdDesc) + atom <- xGetAtomName dpy (symbols nameArray) + str <- peekCString atom + return str + else -- Behaviour on error + do + return (errorString opts) + + +-- 'Bad' prefixes of layouts +noLaySymbols :: [String] +noLaySymbols = ["group", "inet", "ctr", "pc", "ctrl"] + + +-- splits the layout string into the actual layouts +splitLayout :: String -> [String] +splitLayout s = splitLayout' noLaySymbols $ split s '+' + +splitLayout' :: [String] -> [String] -> [String] +-- end of recursion, remove empty strings +splitLayout' [] s = map (takeWhile (\x -> x /= ':')) $ filter (\x -> length x > 0) s +-- remove current string if it has a 'bad' prefix +splitLayout' bad s = splitLayout' (tail bad) [x | x <- s, not $ isPrefixOf (head bad) x] + +-- split String at each Char +split :: String -> Char -> [String] +split [] _ = [""] +split (c:cs) delim + | c == delim = "" : rest + | otherwise = (c : head rest) : tail rest + where + rest = split cs delim + +-- replaces input string if on search list (exact match) with corresponding +-- element on replacement list. +-- +-- if not found, return string unchanged +searchReplaceLayout :: KbdOpts -> String -> String +searchReplaceLayout opts s = let c = elemIndex s (src opts) in + case c of + Nothing -> s + x -> let i = (fromJust x) in + if i >= length (rpl opts) then + s + else + (rpl opts)!!i + +-- returns the active layout +getKbdLay :: Display -> KbdOpts -> IO String +getKbdLay dpy opts = do + lay <- getLayoutStr opts dpy + curLay <- getKbdLayout dpy + return $ searchReplaceLayout opts $ (splitLayout lay)!!(curLay) + + + +data Kbd = Kbd [String] + deriving (Read, Show) + +instance Exec Kbd where + alias (Kbd _) = "kbd" + start (Kbd s) cb = do + + dpy <- openDisplay "" + -- parse parameters + opts <- parseOpts s + + -- initial set of layout + cb =<< (getKbdLay dpy opts) + + -- enable listing for + -- group changes + _ <- xkbSelectEventDetails dpy xkbUseCoreKbd xkbStateNotify xkbAllStateComponentsMask xkbGroupStateMask + -- layout/geometry changes + _ <- xkbSelectEvents dpy xkbUseCoreKbd xkbNewKeyboardNotifyMask xkbNewKeyboardNotifyMask + + allocaXEvent $ \e -> forever $ do + nextEvent' dpy e + _ <- getEvent e + cb =<< (getKbdLay dpy opts) + + closeDisplay dpy + return () + +-- vim:ft=haskell:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20: + diff --git a/xmobar.cabal b/xmobar.cabal index 5d77997..72c1c00 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -68,10 +68,11 @@ executable xmobar Xmobar, Config, Parsers, Commands, XUtil, StatFS, Runnable, Plugins, Plugins.CommandReader, Plugins.Date, Plugins.EWMH, Plugins.PipeReader, Plugins.StdinReader, Plugins.XMonadLog, - Plugins.Utils, Plugins.Monitors, Plugins.Monitors.Batt, - Plugins.Monitors.Common, Plugins.Monitors.CoreCommon, - Plugins.Monitors.CoreTemp, Plugins.Monitors.CpuFreq, - Plugins.Monitors.Cpu, Plugins.Monitors.Disk, Plugins.Monitors.Mem, + Plugins.Utils, Plugins.Kbd, Plugins.Monitors, + Plugins.Monitors.Batt, Plugins.Monitors.Common, + Plugins.Monitors.CoreCommon, Plugins.Monitors.CoreTemp, + Plugins.Monitors.CpuFreq, Plugins.Monitors.Cpu, + Plugins.Monitors.Disk, Plugins.Monitors.Mem, Plugins.Monitors.MultiCpu, Plugins.Monitors.Net, Plugins.Monitors.Swap, Plugins.Monitors.Thermal, Plugins.Monitors.ThermalZone, Plugins.Monitors.Top, |