diff options
author | jao <jao@gnu.org> | 2018-11-25 15:10:29 +0000 |
---|---|---|
committer | jao <jao@gnu.org> | 2018-11-25 15:10:29 +0000 |
commit | 77df1ac30fa7af5948f7ff64f5fee9aed64552b3 (patch) | |
tree | 647a4eb67ff1c293a5c530538ee88fc0093b577a /src/lib/Xmobar/System/Kbd.hsc | |
parent | e0d6da82de8d0d1cef98896164c6016b84e47068 (diff) | |
download | xmobar-77df1ac30fa7af5948f7ff64f5fee9aed64552b3.tar.gz xmobar-77df1ac30fa7af5948f7ff64f5fee9aed64552b3.tar.bz2 |
Back to app/src, since it seems they're the default convention for stack
Diffstat (limited to 'src/lib/Xmobar/System/Kbd.hsc')
-rw-r--r-- | src/lib/Xmobar/System/Kbd.hsc | 321 |
1 files changed, 0 insertions, 321 deletions
diff --git a/src/lib/Xmobar/System/Kbd.hsc b/src/lib/Xmobar/System/Kbd.hsc deleted file mode 100644 index b9e1d57..0000000 --- a/src/lib/Xmobar/System/Kbd.hsc +++ /dev/null @@ -1,321 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables, ForeignFunctionInterface, MultiParamTypeClasses, DeriveDataTypeable, FlexibleInstances, PatternGuards #-} ------------------------------------------------------------------------------ --- | --- Module : Plugins.Kbd --- Copyright : (c) Martin Perner --- License : BSD-style (see LICENSE) --- --- Maintainer : Martin Perner <martin@perner.cc> --- 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 <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) - 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!" |