From 3cf0041960837701c325b698460678aea1c449b4 Mon Sep 17 00:00:00 2001 From: jao Date: Sun, 25 Nov 2018 05:31:54 +0000 Subject: Exporting Exec constructors from Xmobar --- src/lib/Xmobar.hs | 40 ++- src/lib/Xmobar/Parsers.hs | 13 +- src/lib/Xmobar/Plugins/BufferedPipeReader.hs | 2 +- src/lib/Xmobar/Plugins/CommandReader.hs | 2 +- src/lib/Xmobar/Plugins/DateZone.hs | 1 - src/lib/Xmobar/Plugins/Kbd.hs | 96 +++++++ src/lib/Xmobar/Plugins/Kbd.hsc | 404 --------------------------- src/lib/Xmobar/Plugins/Locks.hs | 4 +- src/lib/Xmobar/Plugins/Mail.hs | 2 +- src/lib/Xmobar/Plugins/PipeReader.hs | 2 +- src/lib/Xmobar/System/Kbd.hsc | 321 +++++++++++++++++++++ xmobar.cabal | 61 ++-- 12 files changed, 499 insertions(+), 449 deletions(-) create mode 100644 src/lib/Xmobar/Plugins/Kbd.hs delete mode 100644 src/lib/Xmobar/Plugins/Kbd.hsc create mode 100644 src/lib/Xmobar/System/Kbd.hsc diff --git a/src/lib/Xmobar.hs b/src/lib/Xmobar.hs index 3ab779d..ecc664a 100644 --- a/src/lib/Xmobar.hs +++ b/src/lib/Xmobar.hs @@ -15,7 +15,27 @@ -- ----------------------------------------------------------------------------- -module Xmobar (xmobar, Runnable (..), module Xmobar.Config) where +module Xmobar (xmobar + , Runnable (..) + , module Xmobar.Config + , module Xmobar.Plugins.BufferedPipeReader + , module Xmobar.Plugins.CommandReader + , module Xmobar.Plugins.Date +#ifdef DATEZONE + , module Xmobar.Plugins.DateZone +#endif + , module Xmobar.Plugins.EWMH + , module Xmobar.Plugins.Kbd + , module Xmobar.Plugins.Locks +#ifdef INOTIFY + , module Xmobar.Plugins.Mail + , module Xmobar.Plugins.MBox +#endif + , module Xmobar.Plugins.Monitors + , module Xmobar.Plugins.PipeReader + , module Xmobar.Plugins.StdinReader + , module Xmobar.Plugins.XMonadLog + ) where import Data.Foldable (for_) import qualified Data.Map as Map @@ -32,6 +52,24 @@ import Xmobar.X11.Types import Xmobar.X11.EventLoop (startLoop, startCommand) import Xmobar.X11.XUtil import Xmobar.X11.Window +import Xmobar.Plugins.BufferedPipeReader +import Xmobar.Plugins.CommandReader +import Xmobar.Plugins.Date +#ifdef DATEZONE +import Xmobar.Plugins.DateZone +#endif +import Xmobar.Plugins.EWMH +import Xmobar.Plugins.Kbd +import Xmobar.Plugins.Locks +#ifdef INOTIFY +import Xmobar.Plugins.Mail +import Xmobar.Plugins.MBox +#endif +import Xmobar.Plugins.Monitors +import Xmobar.Plugins.PipeReader +import Xmobar.Plugins.StdinReader +import Xmobar.Plugins.XMonadLog + splitTemplate :: Config -> [String] splitTemplate conf = diff --git a/src/lib/Xmobar/Parsers.hs b/src/lib/Xmobar/Parsers.hs index b7e4dbd..d8bd409 100644 --- a/src/lib/Xmobar/Parsers.hs +++ b/src/lib/Xmobar/Parsers.hs @@ -50,13 +50,12 @@ allParsers :: ColorString -> FontIndex -> Maybe [Action] -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] -allParsers c f a = - textParser c f a - <|> try (iconParser c f a) - <|> try (rawParser c f a) - <|> try (actionParser c f a) - <|> try (fontParser c a) - <|> colorParser f a +allParsers c f a = textParser c f a + <|> try (iconParser c f a) + <|> try (rawParser c f a) + <|> try (actionParser c f a) + <|> try (fontParser c a) + <|> colorParser f a -- | Gets the string and combines the needed parsers stringParser :: String -> FontIndex -> Maybe [Action] diff --git a/src/lib/Xmobar/Plugins/BufferedPipeReader.hs b/src/lib/Xmobar/Plugins/BufferedPipeReader.hs index 9bb421e..0b55cf7 100644 --- a/src/lib/Xmobar/Plugins/BufferedPipeReader.hs +++ b/src/lib/Xmobar/Plugins/BufferedPipeReader.hs @@ -12,7 +12,7 @@ -- ----------------------------------------------------------------------------- -module Xmobar.Plugins.BufferedPipeReader where +module Xmobar.Plugins.BufferedPipeReader(BufferedPipeReader(..)) where import Control.Monad(forM_, when, void) import Control.Concurrent diff --git a/src/lib/Xmobar/Plugins/CommandReader.hs b/src/lib/Xmobar/Plugins/CommandReader.hs index 87cf5a4..4c71c96 100644 --- a/src/lib/Xmobar/Plugins/CommandReader.hs +++ b/src/lib/Xmobar/Plugins/CommandReader.hs @@ -13,7 +13,7 @@ -- ----------------------------------------------------------------------------- -module Xmobar.Plugins.CommandReader where +module Xmobar.Plugins.CommandReader(CommandReader(..)) where import System.IO import Xmobar.Commands diff --git a/src/lib/Xmobar/Plugins/DateZone.hs b/src/lib/Xmobar/Plugins/DateZone.hs index d3d4341..5dad871 100644 --- a/src/lib/Xmobar/Plugins/DateZone.hs +++ b/src/lib/Xmobar/Plugins/DateZone.hs @@ -23,7 +23,6 @@ module Xmobar.Plugins.DateZone (DateZone(..)) where import Xmobar.Commands -import Xmobar.Commands(tenthSeconds) #ifdef DATEZONE import Control.Concurrent.STM diff --git a/src/lib/Xmobar/Plugins/Kbd.hs b/src/lib/Xmobar/Plugins/Kbd.hs new file mode 100644 index 0000000..76914cc --- /dev/null +++ b/src/lib/Xmobar/Plugins/Kbd.hs @@ -0,0 +1,96 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Kbd +-- Copyright : (c) Martin Perner +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Martin Perner +-- Stability : unstable +-- Portability : unportable +-- +-- A keyboard layout indicator for Xmobar +-- +----------------------------------------------------------------------------- + +module Xmobar.Plugins.Kbd(Kbd(..)) where + +import Data.List (isPrefixOf, findIndex) +import Data.Maybe (fromJust) +import Control.Monad (forever) +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras + +import Xmobar.Commands +import Xmobar.Utils (nextEvent') +import Xmobar.System.Kbd + + +-- '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 = findIndex (\x -> fst x == s) opts in + case c of + Nothing -> s + x -> let i = (fromJust x) in + snd $ opts!!i + +-- returns the active layout +getKbdLay :: Display -> KbdOpts -> IO String +getKbdLay dpy opts = do + lay <- getLayoutStr dpy + curLay <- getKbdLayout dpy + return $ searchReplaceLayout opts $ (splitLayout lay)!!(curLay) + + + +data Kbd = Kbd [(String, String)] + deriving (Read, Show) + +instance Exec Kbd where + alias (Kbd _) = "kbd" + start (Kbd opts) cb = do + + dpy <- openDisplay "" + + -- 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 () diff --git a/src/lib/Xmobar/Plugins/Kbd.hsc b/src/lib/Xmobar/Plugins/Kbd.hsc deleted file mode 100644 index 5439785..0000000 --- a/src/lib/Xmobar/Plugins/Kbd.hsc +++ /dev/null @@ -1,404 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables, ForeignFunctionInterface, MultiParamTypeClasses, DeriveDataTypeable, FlexibleInstances, PatternGuards #-} ------------------------------------------------------------------------------ --- | --- Module : Plugins.Kbd --- Copyright : (c) Martin Perner --- License : BSD-style (see LICENSE) --- --- Maintainer : Martin Perner --- Stability : unstable --- Portability : unportable --- --- A keyboard layout indicator for Xmobar --- ------------------------------------------------------------------------------ - -module Xmobar.Plugins.Kbd where - -import Graphics.X11.Xlib -import Graphics.X11.Xlib.Extras -import Foreign -import Foreign.C.Types -import Foreign.C.String -import Control.Monad (forever) -import Xmobar.Commands -import Xmobar.Utils (nextEvent') -import Data.List (isPrefixOf, findIndex) -import Data.Maybe (fromJust) - -#include -#include -#include - --- --- 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) - poke _ _ = undefined - 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) - poke _ _ = undefined - 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) - poke _ _ = undefined - 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) - poke _ _ = undefined - 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) - poke _ _ = undefined - 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 - -xkbIndicatorStateNotify :: CUInt -xkbIndicatorStateNotify = #const XkbIndicatorStateNotify - -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 - -type KbdOpts = [(String, String)] - --- gets the layout string -getLayoutStr :: Display -> IO String -getLayoutStr dpy = do - kbdDescPtr <- xkbAllocKeyboard - status <- xkbGetNames dpy xkbSymbolsNameMask kbdDescPtr - str <- getLayoutStr' status dpy kbdDescPtr - xkbFreeNames kbdDescPtr xkbGroupNamesMask 1 - xkbFreeKeyboard kbdDescPtr 0 1 - return str - -getLayoutStr' :: Status -> Display -> (Ptr XkbDescRec) -> IO String -getLayoutStr' 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 "Error while requesting layout!" - - --- '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 = findIndex (\x -> fst x == s) opts in - case c of - Nothing -> s - x -> let i = (fromJust x) in - snd $ opts!!i - --- returns the active layout -getKbdLay :: Display -> KbdOpts -> IO String -getKbdLay dpy opts = do - lay <- getLayoutStr dpy - curLay <- getKbdLayout dpy - return $ searchReplaceLayout opts $ (splitLayout lay)!!(curLay) - - - -data Kbd = Kbd [(String, String)] - deriving (Read, Show) - -instance Exec Kbd where - alias (Kbd _) = "kbd" - start (Kbd opts) cb = do - - dpy <- openDisplay "" - - -- 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/src/lib/Xmobar/Plugins/Locks.hs b/src/lib/Xmobar/Plugins/Locks.hs index c086464..1f73f1f 100644 --- a/src/lib/Xmobar/Plugins/Locks.hs +++ b/src/lib/Xmobar/Plugins/Locks.hs @@ -12,7 +12,7 @@ -- ----------------------------------------------------------------------------- -module Xmobar.Plugins.Locks where +module Xmobar.Plugins.Locks(Locks(..)) where import Graphics.X11 import Data.List @@ -20,7 +20,7 @@ import Data.Bits import Control.Monad import Graphics.X11.Xlib.Extras import Xmobar.Commands -import Xmobar.Plugins.Kbd +import Xmobar.System.Kbd import Xmobar.Utils (nextEvent') data Locks = Locks diff --git a/src/lib/Xmobar/Plugins/Mail.hs b/src/lib/Xmobar/Plugins/Mail.hs index 8c0321f..aa28b98 100644 --- a/src/lib/Xmobar/Plugins/Mail.hs +++ b/src/lib/Xmobar/Plugins/Mail.hs @@ -13,7 +13,7 @@ -- ----------------------------------------------------------------------------- -module Xmobar.Plugins.Mail where +module Xmobar.Plugins.Mail(Mail(..)) where import Xmobar.Commands #ifdef INOTIFY diff --git a/src/lib/Xmobar/Plugins/PipeReader.hs b/src/lib/Xmobar/Plugins/PipeReader.hs index ac59356..d04f747 100644 --- a/src/lib/Xmobar/Plugins/PipeReader.hs +++ b/src/lib/Xmobar/Plugins/PipeReader.hs @@ -12,7 +12,7 @@ -- ----------------------------------------------------------------------------- -module Xmobar.Plugins.PipeReader where +module Xmobar.Plugins.PipeReader(PipeReader(..)) where import System.IO import Xmobar.Commands(Exec(..)) diff --git a/src/lib/Xmobar/System/Kbd.hsc b/src/lib/Xmobar/System/Kbd.hsc new file mode 100644 index 0000000..b9e1d57 --- /dev/null +++ b/src/lib/Xmobar/System/Kbd.hsc @@ -0,0 +1,321 @@ +{-# LANGUAGE ScopedTypeVariables, ForeignFunctionInterface, MultiParamTypeClasses, DeriveDataTypeable, FlexibleInstances, PatternGuards #-} +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Kbd +-- Copyright : (c) Martin Perner +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Martin Perner +-- Stability : unstable +-- Portability : unportable +-- +-- A keyboard layout indicator for Xmobar +-- +----------------------------------------------------------------------------- + +module Xmobar.System.Kbd where + +import Foreign +import Foreign.C.Types +import Foreign.C.String + +import Graphics.X11.Xlib + +#include +#include +#include + +-- +-- 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) + poke _ _ = undefined + 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) + poke _ _ = undefined + 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) + poke _ _ = undefined + 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) + poke _ _ = undefined + 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) + poke _ _ = undefined + 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 + +xkbIndicatorStateNotify :: CUInt +xkbIndicatorStateNotify = #const XkbIndicatorStateNotify + +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 + +type KbdOpts = [(String, String)] + +getLayoutStr :: Display -> IO String +getLayoutStr dpy = do + kbdDescPtr <- xkbAllocKeyboard + status <- xkbGetNames dpy xkbSymbolsNameMask kbdDescPtr + str <- getLayoutStr' status dpy kbdDescPtr + xkbFreeNames kbdDescPtr xkbGroupNamesMask 1 + xkbFreeKeyboard kbdDescPtr 0 1 + return str + +getLayoutStr' :: Status -> Display -> (Ptr XkbDescRec) -> IO String +getLayoutStr' 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 "Error while requesting layout!" diff --git a/xmobar.cabal b/xmobar.cabal index dfadeda..88cfbf5 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -98,35 +98,7 @@ library Xmobar.Config, Xmobar.Actions, Xmobar.Commands, - Xmobar.Runnable, - Xmobar.Plugins.BufferedPipeReader, - Xmobar.Plugins.CommandReader, - Xmobar.Plugins.Date, - Xmobar.Plugins.EWMH, - Xmobar.Plugins.PipeReader, - Xmobar.Plugins.MarqueePipeReader, - Xmobar.Plugins.StdinReader, - Xmobar.Plugins.XMonadLog, - Xmobar.Plugins.Kbd, - Xmobar.Plugins.Locks, - Xmobar.Plugins.Monitors, - Xmobar.Plugins.Monitors.Batt, - Xmobar.Plugins.Monitors.Common, - Xmobar.Plugins.Monitors.CoreCommon, - Xmobar.Plugins.Monitors.CoreTemp, - Xmobar.Plugins.Monitors.CpuFreq, - Xmobar.Plugins.Monitors.Cpu, - Xmobar.Plugins.Monitors.Disk, - Xmobar.Plugins.Monitors.Mem, - Xmobar.Plugins.Monitors.MultiCpu, - Xmobar.Plugins.Monitors.Net, - Xmobar.Plugins.Monitors.Swap, - Xmobar.Plugins.Monitors.Thermal, - Xmobar.Plugins.Monitors.ThermalZone, - Xmobar.Plugins.Monitors.Top, - Xmobar.Plugins.Monitors.Uptime, - Xmobar.Plugins.Monitors.Bright, - Xmobar.Plugins.Monitors.CatInt + Xmobar.Runnable other-modules: Xmobar.Parsers, Xmobar.Utils, @@ -134,13 +106,42 @@ library Xmobar.System.Environment, Xmobar.System.Localize, Xmobar.System.Signal, + Xmobar.System.Kbd, Xmobar.X11.Types, Xmobar.X11.XUtil, Xmobar.X11.Bitmap, Xmobar.X11.EventLoop, Xmobar.X11.ColorCache, Xmobar.X11.Window, - Xmobar.X11.Draw + Xmobar.X11.Draw, + Xmobar.Plugins.BufferedPipeReader, + Xmobar.Plugins.CommandReader, + Xmobar.Plugins.Date, + Xmobar.Plugins.EWMH, + Xmobar.Plugins.PipeReader, + Xmobar.Plugins.MarqueePipeReader, + Xmobar.Plugins.StdinReader, + Xmobar.Plugins.XMonadLog, + Xmobar.Plugins.Kbd, + Xmobar.Plugins.Locks, + Xmobar.Plugins.Monitors, + Xmobar.Plugins.Monitors.Batt, + Xmobar.Plugins.Monitors.Common, + Xmobar.Plugins.Monitors.CoreCommon, + Xmobar.Plugins.Monitors.CoreTemp, + Xmobar.Plugins.Monitors.CpuFreq, + Xmobar.Plugins.Monitors.Cpu, + Xmobar.Plugins.Monitors.Disk, + Xmobar.Plugins.Monitors.Mem, + Xmobar.Plugins.Monitors.MultiCpu, + Xmobar.Plugins.Monitors.Net, + Xmobar.Plugins.Monitors.Swap, + Xmobar.Plugins.Monitors.Thermal, + Xmobar.Plugins.Monitors.ThermalZone, + Xmobar.Plugins.Monitors.Top, + Xmobar.Plugins.Monitors.Uptime, + Xmobar.Plugins.Monitors.Bright, + Xmobar.Plugins.Monitors.CatInt extra-libraries: Xrandr Xrender -- cgit v1.2.3