{-# LINE 1 "src/Xmobar/System/Kbd.hsc" #-}
{-# 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 Control.Monad ((<=<))

import Foreign
import Foreign.C.Types
import Foreign.C.String

import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras (none)





--
-- Definition for XkbStaceRec and getKbdLayout taken from
-- XMonad.Layout.XKBLayout
--
data XkbStateRec = XkbStateRec {
    XkbStateRec -> CUChar
group :: CUChar,
    XkbStateRec -> CUChar
locked_group :: CUChar,
    XkbStateRec -> CUShort
base_group :: CUShort,
    XkbStateRec -> CUShort
latched_group :: CUShort,
    XkbStateRec -> CUChar
mods :: CUChar,
    XkbStateRec -> CUChar
base_mods :: CUChar,
    XkbStateRec -> CUChar
latched_mods :: CUChar,
    XkbStateRec -> CUChar
locked_mods :: CUChar,
    XkbStateRec -> CUChar
compat_state :: CUChar,
    XkbStateRec -> CUChar
grab_mods :: CUChar,
    XkbStateRec -> CUChar
compat_grab_mods :: CUChar,
    XkbStateRec -> CUChar
lookup_mods :: CUChar,
    XkbStateRec -> CUChar
compat_lookup_mods :: CUChar,
    XkbStateRec -> CUShort
ptr_buttons :: CUShort
}

instance Storable XkbStateRec where
    sizeOf :: XkbStateRec -> Int
sizeOf XkbStateRec
_ = ((Int
18))
{-# LINE 54 "src/Xmobar/System/Kbd.hsc" #-}
    alignment _ = alignment (undefined :: CUShort)
    poke :: Ptr XkbStateRec -> XkbStateRec -> IO ()
poke Ptr XkbStateRec
_ XkbStateRec
_ = IO ()
forall a. HasCallStack => a
undefined
    peek :: Ptr XkbStateRec -> IO XkbStateRec
peek Ptr XkbStateRec
ptr = do
        CUChar
r_group <- ((\Ptr XkbStateRec
hsc_ptr -> Ptr XkbStateRec -> Int -> IO CUChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbStateRec
hsc_ptr Int
0)) Ptr XkbStateRec
ptr
{-# LINE 58 "src/Xmobar/System/Kbd.hsc" #-}
        CUChar
r_locked_group <- ((\Ptr XkbStateRec
hsc_ptr -> Ptr XkbStateRec -> Int -> IO CUChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbStateRec
hsc_ptr Int
1)) Ptr XkbStateRec
ptr
{-# LINE 59 "src/Xmobar/System/Kbd.hsc" #-}
        CUShort
r_base_group <- ((\Ptr XkbStateRec
hsc_ptr -> Ptr XkbStateRec -> Int -> IO CUShort
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbStateRec
hsc_ptr Int
2)) Ptr XkbStateRec
ptr
{-# LINE 60 "src/Xmobar/System/Kbd.hsc" #-}
        CUShort
r_latched_group <- ((\Ptr XkbStateRec
hsc_ptr -> Ptr XkbStateRec -> Int -> IO CUShort
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbStateRec
hsc_ptr Int
4)) Ptr XkbStateRec
ptr
{-# LINE 61 "src/Xmobar/System/Kbd.hsc" #-}
        CUChar
r_mods <- ((\Ptr XkbStateRec
hsc_ptr -> Ptr XkbStateRec -> Int -> IO CUChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbStateRec
hsc_ptr Int
6)) Ptr XkbStateRec
ptr
{-# LINE 62 "src/Xmobar/System/Kbd.hsc" #-}
        CUChar
r_base_mods <- ((\Ptr XkbStateRec
hsc_ptr -> Ptr XkbStateRec -> Int -> IO CUChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbStateRec
hsc_ptr Int
7)) Ptr XkbStateRec
ptr
{-# LINE 63 "src/Xmobar/System/Kbd.hsc" #-}
        CUChar
r_latched_mods <- ((\Ptr XkbStateRec
hsc_ptr -> Ptr XkbStateRec -> Int -> IO CUChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbStateRec
hsc_ptr Int
8)) Ptr XkbStateRec
ptr
{-# LINE 64 "src/Xmobar/System/Kbd.hsc" #-}
        CUChar
r_locked_mods <- ((\Ptr XkbStateRec
hsc_ptr -> Ptr XkbStateRec -> Int -> IO CUChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbStateRec
hsc_ptr Int
9)) Ptr XkbStateRec
ptr
{-# LINE 65 "src/Xmobar/System/Kbd.hsc" #-}
        CUChar
r_compat_state <- ((\Ptr XkbStateRec
hsc_ptr -> Ptr XkbStateRec -> Int -> IO CUChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbStateRec
hsc_ptr Int
10)) Ptr XkbStateRec
ptr
{-# LINE 66 "src/Xmobar/System/Kbd.hsc" #-}
        CUChar
r_grab_mods <- ((\Ptr XkbStateRec
hsc_ptr -> Ptr XkbStateRec -> Int -> IO CUChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbStateRec
hsc_ptr Int
11)) Ptr XkbStateRec
ptr
{-# LINE 67 "src/Xmobar/System/Kbd.hsc" #-}
        CUChar
r_compat_grab_mods <- ((\Ptr XkbStateRec
hsc_ptr -> Ptr XkbStateRec -> Int -> IO CUChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbStateRec
hsc_ptr Int
12)) Ptr XkbStateRec
ptr
{-# LINE 68 "src/Xmobar/System/Kbd.hsc" #-}
        CUChar
r_lookup_mods <- ((\Ptr XkbStateRec
hsc_ptr -> Ptr XkbStateRec -> Int -> IO CUChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbStateRec
hsc_ptr Int
13)) Ptr XkbStateRec
ptr
{-# LINE 69 "src/Xmobar/System/Kbd.hsc" #-}
        CUChar
r_compat_lookup_mods <- ((\Ptr XkbStateRec
hsc_ptr -> Ptr XkbStateRec -> Int -> IO CUChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbStateRec
hsc_ptr Int
14)) Ptr XkbStateRec
ptr
{-# LINE 70 "src/Xmobar/System/Kbd.hsc" #-}
        CUShort
r_ptr_buttons <- ((\Ptr XkbStateRec
hsc_ptr -> Ptr XkbStateRec -> Int -> IO CUShort
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbStateRec
hsc_ptr Int
16)) Ptr XkbStateRec
ptr
{-# LINE 71 "src/Xmobar/System/Kbd.hsc" #-}
        XkbStateRec -> IO XkbStateRec
forall (m :: * -> *) a. Monad m => a -> m a
return XkbStateRec :: CUChar
-> CUChar
-> CUShort
-> CUShort
-> CUChar
-> CUChar
-> CUChar
-> CUChar
-> CUChar
-> CUChar
-> CUChar
-> CUChar
-> CUChar
-> CUShort
-> XkbStateRec
XkbStateRec {
            group :: CUChar
group = CUChar
r_group,
            locked_group :: CUChar
locked_group = CUChar
r_locked_group,
            base_group :: CUShort
base_group = CUShort
r_base_group,
            latched_group :: CUShort
latched_group = CUShort
r_latched_group,
            mods :: CUChar
mods = CUChar
r_mods,
            base_mods :: CUChar
base_mods = CUChar
r_base_mods,
            latched_mods :: CUChar
latched_mods = CUChar
r_latched_mods,
            locked_mods :: CUChar
locked_mods = CUChar
r_locked_mods,
            compat_state :: CUChar
compat_state = CUChar
r_compat_state,
            grab_mods :: CUChar
grab_mods = CUChar
r_grab_mods,
            compat_grab_mods :: CUChar
compat_grab_mods = CUChar
r_compat_grab_mods,
            lookup_mods :: CUChar
lookup_mods = CUChar
r_lookup_mods,
            compat_lookup_mods :: CUChar
compat_lookup_mods = CUChar
r_compat_lookup_mods,
            ptr_buttons :: CUShort
ptr_buttons = CUShort
r_ptr_buttons
        }

foreign import ccall unsafe "X11/XKBlib.h XkbGetState"
    xkbGetState :: Display -> CUInt -> Ptr XkbStateRec -> IO CInt


getKbdLayout :: Display -> IO Int
getKbdLayout :: Display -> IO Int
getKbdLayout Display
d = (Ptr XkbStateRec -> IO Int) -> IO Int
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr XkbStateRec -> IO Int) -> IO Int)
-> (Ptr XkbStateRec -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr XkbStateRec
stRecPtr -> do
    Display -> CUInt -> Ptr XkbStateRec -> IO CInt
xkbGetState Display
d CUInt
0x100 Ptr XkbStateRec
stRecPtr
    XkbStateRec
st <- Ptr XkbStateRec -> IO XkbStateRec
forall a. Storable a => Ptr a -> IO a
peek Ptr XkbStateRec
stRecPtr
    Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ CUChar -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (XkbStateRec -> CUChar
group XkbStateRec
st)

data XkbKeyNameRec = XkbKeyNameRec {
    XkbKeyNameRec -> Ptr CChar
name :: Ptr CChar -- array
}

--
-- the t_ before alias is just because of name collisions
--
data XkbKeyAliasRec = XkbKeyAliasRec {
    XkbKeyAliasRec -> Ptr CChar
real  :: Ptr CChar, -- array
    XkbKeyAliasRec -> Ptr CChar
t_alias :: Ptr CChar  -- array
}

--
-- the t_ before geometry is just because of name collisions
--
data XkbNamesRec = XkbNamesRec {
    XkbNamesRec -> Atom
keycodes :: Atom,
    XkbNamesRec -> Atom
t_geometry :: Atom,
    XkbNamesRec -> Atom
symbols :: Atom,
    XkbNamesRec -> Atom
types :: Atom,
    XkbNamesRec -> Atom
compat :: Atom,
    XkbNamesRec -> [Atom]
vmods :: [Atom], -- Atom              vmods[XkbNumVirtualMods];
    XkbNamesRec -> [Atom]
indicators :: [Atom], -- Atom              indicators[XkbNumIndicators];
    XkbNamesRec -> [Atom]
groups :: [Atom], -- Atom              groups[XkbNumKbdGroups];
    XkbNamesRec -> Ptr XkbKeyNameRec
keys :: Ptr XkbKeyNameRec,
    XkbNamesRec -> Ptr CChar
key_aliases :: Ptr CChar, -- dont care XkbKeyAliasRec,
    XkbNamesRec -> Ptr Atom
radio_groups :: Ptr Atom,
    XkbNamesRec -> Atom
phys_symbols :: Atom,
    XkbNamesRec -> CUChar
num_keys :: CUChar,
    XkbNamesRec -> CUChar
num_key_aliases :: CUChar,
    XkbNamesRec -> CUShort
num_rg :: CUShort
}

--
-- the t_ before map, indicators and compat are just because of name collisions
--
data XkbDescRec = XkbDescRec {
    XkbDescRec -> Ptr CChar
t_dpy :: Ptr CChar, -- struct _XDisplay* ; don't care
    XkbDescRec -> CUShort
flags :: CUShort,
    XkbDescRec -> CUShort
device_spec :: CUShort,
    XkbDescRec -> KeyCode
min_key_code :: KeyCode,
    XkbDescRec -> KeyCode
max_key_code :: KeyCode,
    XkbDescRec -> Ptr CChar
ctrls :: Ptr CChar, -- XkbControlsPtr ;  dont' care
    XkbDescRec -> Ptr CChar
server :: Ptr CChar, -- XkbServerMapPtr ;  dont' care
    XkbDescRec -> Ptr CChar
t_map :: Ptr CChar, --XkbClientMapPtr ;  dont' care
    XkbDescRec -> Ptr CChar
t_indicators :: Ptr CChar, -- XkbIndicatorPtr ;  dont' care
    XkbDescRec -> Ptr XkbNamesRec
names :: Ptr XkbNamesRec, -- array
    XkbDescRec -> Ptr CChar
t_compat :: Ptr CChar, -- XkbCompatMap ;  dont' care
    XkbDescRec -> Ptr CChar
geom :: Ptr CChar -- XkbGeometryPtr ;  dont' care

}

instance Storable XkbKeyNameRec where
    sizeOf :: XkbKeyNameRec -> Int
sizeOf XkbKeyNameRec
_ = ((Int
4))
{-# LINE 152 "src/Xmobar/System/Kbd.hsc" #-}
    alignment _ = alignment (undefined :: CUShort)
    poke :: Ptr XkbKeyNameRec -> XkbKeyNameRec -> IO ()
poke Ptr XkbKeyNameRec
_ XkbKeyNameRec
_ = IO ()
forall a. HasCallStack => a
undefined
    peek :: Ptr XkbKeyNameRec -> IO XkbKeyNameRec
peek Ptr XkbKeyNameRec
ptr = do
        Ptr CChar
r_name <- ((\Ptr XkbKeyNameRec
hsc_ptr -> Ptr XkbKeyNameRec -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbKeyNameRec
hsc_ptr Int
0)) Ptr XkbKeyNameRec
ptr
{-# LINE 156 "src/Xmobar/System/Kbd.hsc" #-}

        XkbKeyNameRec -> IO XkbKeyNameRec
forall (m :: * -> *) a. Monad m => a -> m a
return XkbKeyNameRec :: Ptr CChar -> XkbKeyNameRec
XkbKeyNameRec {
            name :: Ptr CChar
name = Ptr CChar
r_name
        }

instance Storable XkbKeyAliasRec where
    sizeOf :: XkbKeyAliasRec -> Int
sizeOf XkbKeyAliasRec
_ = ((Int
8))
{-# LINE 163 "src/Xmobar/System/Kbd.hsc" #-}
    alignment _ = alignment (undefined :: CUShort)
    poke :: Ptr XkbKeyAliasRec -> XkbKeyAliasRec -> IO ()
poke Ptr XkbKeyAliasRec
_ XkbKeyAliasRec
_ = IO ()
forall a. HasCallStack => a
undefined
    peek :: Ptr XkbKeyAliasRec -> IO XkbKeyAliasRec
peek Ptr XkbKeyAliasRec
ptr = do
        Ptr CChar
r_real <- ((\Ptr XkbKeyAliasRec
hsc_ptr -> Ptr XkbKeyAliasRec -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbKeyAliasRec
hsc_ptr Int
0)) Ptr XkbKeyAliasRec
ptr
{-# LINE 167 "src/Xmobar/System/Kbd.hsc" #-}
        Ptr CChar
r_alias <- ((\Ptr XkbKeyAliasRec
hsc_ptr -> Ptr XkbKeyAliasRec -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbKeyAliasRec
hsc_ptr Int
4)) Ptr XkbKeyAliasRec
ptr
{-# LINE 168 "src/Xmobar/System/Kbd.hsc" #-}

        XkbKeyAliasRec -> IO XkbKeyAliasRec
forall (m :: * -> *) a. Monad m => a -> m a
return XkbKeyAliasRec :: Ptr CChar -> Ptr CChar -> XkbKeyAliasRec
XkbKeyAliasRec {
            real :: Ptr CChar
real = Ptr CChar
r_real,
            t_alias :: Ptr CChar
t_alias = Ptr CChar
r_alias
        }

instance Storable XkbNamesRec where
    sizeOf :: XkbNamesRec -> Int
sizeOf XkbNamesRec
_ = ((Int
496))
{-# LINE 176 "src/Xmobar/System/Kbd.hsc" #-}
    alignment _ = alignment (undefined :: CUShort)
    poke :: Ptr XkbNamesRec -> XkbNamesRec -> IO ()
poke Ptr XkbNamesRec
_ XkbNamesRec
_ = IO ()
forall a. HasCallStack => a
undefined
    peek :: Ptr XkbNamesRec -> IO XkbNamesRec
peek Ptr XkbNamesRec
ptr = do
        Atom
r_keycodes <- ((\Ptr XkbNamesRec
hsc_ptr -> Ptr XkbNamesRec -> Int -> IO Atom
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbNamesRec
hsc_ptr Int
0)) Ptr XkbNamesRec
ptr
{-# LINE 180 "src/Xmobar/System/Kbd.hsc" #-}
        Atom
r_geometry <- ((\Ptr XkbNamesRec
hsc_ptr -> Ptr XkbNamesRec -> Int -> IO Atom
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbNamesRec
hsc_ptr Int
8)) Ptr XkbNamesRec
ptr
{-# LINE 181 "src/Xmobar/System/Kbd.hsc" #-}
        Atom
r_symbols <- ((\Ptr XkbNamesRec
hsc_ptr -> Ptr XkbNamesRec -> Int -> IO Atom
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbNamesRec
hsc_ptr Int
16)) Ptr XkbNamesRec
ptr
{-# LINE 182 "src/Xmobar/System/Kbd.hsc" #-}
        Atom
r_types <- ((\Ptr XkbNamesRec
hsc_ptr -> Ptr XkbNamesRec -> Int -> IO Atom
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbNamesRec
hsc_ptr Int
24)) Ptr XkbNamesRec
ptr
{-# LINE 183 "src/Xmobar/System/Kbd.hsc" #-}
        Atom
r_compat <- ((\Ptr XkbNamesRec
hsc_ptr -> Ptr XkbNamesRec -> Int -> IO Atom
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbNamesRec
hsc_ptr Int
32)) Ptr XkbNamesRec
ptr
{-# LINE 184 "src/Xmobar/System/Kbd.hsc" #-}
        [Atom]
r_vmods <- Int -> Ptr Atom -> IO [Atom]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (Int
16) (Ptr Atom -> IO [Atom]) -> Ptr Atom -> IO [Atom]
forall a b. (a -> b) -> a -> b
$ ((\Ptr XkbNamesRec
hsc_ptr -> Ptr XkbNamesRec
hsc_ptr Ptr XkbNamesRec -> Int -> Ptr Atom
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40)) Ptr XkbNamesRec
ptr
{-# LINE 185 "src/Xmobar/System/Kbd.hsc" #-}
        [Atom]
r_indicators <- Int -> Ptr Atom -> IO [Atom]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (Int
32) (Ptr Atom -> IO [Atom]) -> Ptr Atom -> IO [Atom]
forall a b. (a -> b) -> a -> b
$ ((\Ptr XkbNamesRec
hsc_ptr -> Ptr XkbNamesRec
hsc_ptr Ptr XkbNamesRec -> Int -> Ptr Atom
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
168)) Ptr XkbNamesRec
ptr
{-# LINE 186 "src/Xmobar/System/Kbd.hsc" #-}
        [Atom]
r_groups <- Int -> Ptr Atom -> IO [Atom]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (Int
4) (Ptr Atom -> IO [Atom]) -> Ptr Atom -> IO [Atom]
forall a b. (a -> b) -> a -> b
$ ((\Ptr XkbNamesRec
hsc_ptr -> Ptr XkbNamesRec
hsc_ptr Ptr XkbNamesRec -> Int -> Ptr Atom
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
424)) Ptr XkbNamesRec
ptr
{-# LINE 187 "src/Xmobar/System/Kbd.hsc" #-}
        Ptr XkbKeyNameRec
r_keys <- ((\Ptr XkbNamesRec
hsc_ptr -> Ptr XkbNamesRec -> Int -> IO (Ptr XkbKeyNameRec)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbNamesRec
hsc_ptr Int
456)) Ptr XkbNamesRec
ptr
{-# LINE 188 "src/Xmobar/System/Kbd.hsc" #-}
        Ptr CChar
r_key_aliases <- ((\Ptr XkbNamesRec
hsc_ptr -> Ptr XkbNamesRec -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbNamesRec
hsc_ptr Int
464)) Ptr XkbNamesRec
ptr
{-# LINE 189 "src/Xmobar/System/Kbd.hsc" #-}
        Ptr Atom
r_radio_groups <- ((\Ptr XkbNamesRec
hsc_ptr -> Ptr XkbNamesRec -> Int -> IO (Ptr Atom)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbNamesRec
hsc_ptr Int
472)) Ptr XkbNamesRec
ptr
{-# LINE 190 "src/Xmobar/System/Kbd.hsc" #-}
        Atom
r_phys_symbols <- ((\Ptr XkbNamesRec
hsc_ptr -> Ptr XkbNamesRec -> Int -> IO Atom
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbNamesRec
hsc_ptr Int
480)) Ptr XkbNamesRec
ptr
{-# LINE 191 "src/Xmobar/System/Kbd.hsc" #-}
        CUChar
r_num_keys <- ((\Ptr XkbNamesRec
hsc_ptr -> Ptr XkbNamesRec -> Int -> IO CUChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbNamesRec
hsc_ptr Int
488)) Ptr XkbNamesRec
ptr
{-# LINE 192 "src/Xmobar/System/Kbd.hsc" #-}
        CUChar
r_num_key_aliases <- ((\Ptr XkbNamesRec
hsc_ptr -> Ptr XkbNamesRec -> Int -> IO CUChar
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbNamesRec
hsc_ptr Int
489)) Ptr XkbNamesRec
ptr
{-# LINE 193 "src/Xmobar/System/Kbd.hsc" #-}
        CUShort
r_num_rg <- ((\Ptr XkbNamesRec
hsc_ptr -> Ptr XkbNamesRec -> Int -> IO CUShort
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbNamesRec
hsc_ptr Int
490)) Ptr XkbNamesRec
ptr
{-# LINE 194 "src/Xmobar/System/Kbd.hsc" #-}

        XkbNamesRec -> IO XkbNamesRec
forall (m :: * -> *) a. Monad m => a -> m a
return XkbNamesRec :: Atom
-> Atom
-> Atom
-> Atom
-> Atom
-> [Atom]
-> [Atom]
-> [Atom]
-> Ptr XkbKeyNameRec
-> Ptr CChar
-> Ptr Atom
-> Atom
-> CUChar
-> CUChar
-> CUShort
-> XkbNamesRec
XkbNamesRec {
            keycodes :: Atom
keycodes = Atom
r_keycodes,
            t_geometry :: Atom
t_geometry = Atom
r_geometry,
            symbols :: Atom
symbols = Atom
r_symbols,
            types :: Atom
types = Atom
r_types,
            compat :: Atom
compat = Atom
r_compat,
            vmods :: [Atom]
vmods = [Atom]
r_vmods,
            indicators :: [Atom]
indicators = [Atom]
r_indicators,
            groups :: [Atom]
groups = [Atom]
r_groups,
            keys :: Ptr XkbKeyNameRec
keys = Ptr XkbKeyNameRec
r_keys,
            key_aliases :: Ptr CChar
key_aliases = Ptr CChar
r_key_aliases,
            radio_groups :: Ptr Atom
radio_groups = Ptr Atom
r_radio_groups,
            phys_symbols :: Atom
phys_symbols = Atom
r_phys_symbols,
            num_keys :: CUChar
num_keys = CUChar
r_num_keys,
            num_key_aliases :: CUChar
num_key_aliases = CUChar
r_num_key_aliases,
            num_rg :: CUShort
num_rg = CUShort
r_num_rg
       }

instance Storable XkbDescRec where
    sizeOf :: XkbDescRec -> Int
sizeOf XkbDescRec
_ = ((Int
72))
{-# LINE 215 "src/Xmobar/System/Kbd.hsc" #-}
    alignment _ = alignment (undefined :: CUShort)
    poke :: Ptr XkbDescRec -> XkbDescRec -> IO ()
poke Ptr XkbDescRec
_ XkbDescRec
_ = IO ()
forall a. HasCallStack => a
undefined
    peek :: Ptr XkbDescRec -> IO XkbDescRec
peek Ptr XkbDescRec
ptr = do
        Ptr CChar
r_dpy <- ((\Ptr XkbDescRec
hsc_ptr -> Ptr XkbDescRec -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbDescRec
hsc_ptr Int
0)) Ptr XkbDescRec
ptr
{-# LINE 219 "src/Xmobar/System/Kbd.hsc" #-}
        CUShort
r_flags <- ((\Ptr XkbDescRec
hsc_ptr -> Ptr XkbDescRec -> Int -> IO CUShort
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbDescRec
hsc_ptr Int
8)) Ptr XkbDescRec
ptr
{-# LINE 220 "src/Xmobar/System/Kbd.hsc" #-}
        CUShort
r_device_spec <- ((\Ptr XkbDescRec
hsc_ptr -> Ptr XkbDescRec -> Int -> IO CUShort
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbDescRec
hsc_ptr Int
10)) Ptr XkbDescRec
ptr
{-# LINE 221 "src/Xmobar/System/Kbd.hsc" #-}
        KeyCode
r_min_key_code <- ((\Ptr XkbDescRec
hsc_ptr -> Ptr XkbDescRec -> Int -> IO KeyCode
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbDescRec
hsc_ptr Int
12)) Ptr XkbDescRec
ptr
{-# LINE 222 "src/Xmobar/System/Kbd.hsc" #-}
        KeyCode
r_max_key_code <- ((\Ptr XkbDescRec
hsc_ptr -> Ptr XkbDescRec -> Int -> IO KeyCode
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbDescRec
hsc_ptr Int
13)) Ptr XkbDescRec
ptr
{-# LINE 223 "src/Xmobar/System/Kbd.hsc" #-}
        Ptr CChar
r_ctrls <- ((\Ptr XkbDescRec
hsc_ptr -> Ptr XkbDescRec -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbDescRec
hsc_ptr Int
16)) Ptr XkbDescRec
ptr
{-# LINE 224 "src/Xmobar/System/Kbd.hsc" #-}
        Ptr CChar
r_server <- ((\Ptr XkbDescRec
hsc_ptr -> Ptr XkbDescRec -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbDescRec
hsc_ptr Int
24)) Ptr XkbDescRec
ptr
{-# LINE 225 "src/Xmobar/System/Kbd.hsc" #-}
        Ptr CChar
r_map <- ((\Ptr XkbDescRec
hsc_ptr -> Ptr XkbDescRec -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbDescRec
hsc_ptr Int
32)) Ptr XkbDescRec
ptr
{-# LINE 226 "src/Xmobar/System/Kbd.hsc" #-}
        Ptr CChar
r_indicators <- ((\Ptr XkbDescRec
hsc_ptr -> Ptr XkbDescRec -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbDescRec
hsc_ptr Int
40)) Ptr XkbDescRec
ptr
{-# LINE 227 "src/Xmobar/System/Kbd.hsc" #-}
        Ptr XkbNamesRec
r_names <- ((\Ptr XkbDescRec
hsc_ptr -> Ptr XkbDescRec -> Int -> IO (Ptr XkbNamesRec)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbDescRec
hsc_ptr Int
48)) Ptr XkbDescRec
ptr
{-# LINE 228 "src/Xmobar/System/Kbd.hsc" #-}
        Ptr CChar
r_compat <- ((\Ptr XkbDescRec
hsc_ptr -> Ptr XkbDescRec -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbDescRec
hsc_ptr Int
56)) Ptr XkbDescRec
ptr
{-# LINE 229 "src/Xmobar/System/Kbd.hsc" #-}
        Ptr CChar
r_geom <- ((\Ptr XkbDescRec
hsc_ptr -> Ptr XkbDescRec -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr XkbDescRec
hsc_ptr Int
64)) Ptr XkbDescRec
ptr
{-# LINE 230 "src/Xmobar/System/Kbd.hsc" #-}

        XkbDescRec -> IO XkbDescRec
forall (m :: * -> *) a. Monad m => a -> m a
return XkbDescRec :: Ptr CChar
-> CUShort
-> CUShort
-> KeyCode
-> KeyCode
-> Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> Ptr CChar
-> Ptr XkbNamesRec
-> Ptr CChar
-> Ptr CChar
-> XkbDescRec
XkbDescRec {
            t_dpy :: Ptr CChar
t_dpy = Ptr CChar
r_dpy,
            flags :: CUShort
flags = CUShort
r_flags,
            device_spec :: CUShort
device_spec = CUShort
r_device_spec,
            min_key_code :: KeyCode
min_key_code = KeyCode
r_min_key_code,
            max_key_code :: KeyCode
max_key_code = KeyCode
r_max_key_code,
            ctrls :: Ptr CChar
ctrls = Ptr CChar
r_ctrls,
            server :: Ptr CChar
server = Ptr CChar
r_server,
            t_map :: Ptr CChar
t_map = Ptr CChar
r_map,
            t_indicators :: Ptr CChar
t_indicators = Ptr CChar
r_indicators,
            names :: Ptr XkbNamesRec
names = Ptr XkbNamesRec
r_names,
            t_compat :: Ptr CChar
t_compat = Ptr CChar
r_compat,
            geom :: Ptr CChar
geom = Ptr CChar
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 :: CUInt
xkbUseCoreKbd = CUInt
256
{-# LINE 274 "src/Xmobar/System/Kbd.hsc" #-}

xkbStateNotify :: CUInt
xkbStateNotify :: CUInt
xkbStateNotify = CUInt
2
{-# LINE 277 "src/Xmobar/System/Kbd.hsc" #-}

xkbIndicatorStateNotify :: CUInt
xkbIndicatorStateNotify :: CUInt
xkbIndicatorStateNotify = CUInt
4
{-# LINE 280 "src/Xmobar/System/Kbd.hsc" #-}

xkbMapNotify :: CUInt
xkbMapNotify :: CUInt
xkbMapNotify = CUInt
1
{-# LINE 283 "src/Xmobar/System/Kbd.hsc" #-}

xkbMapNotifyMask :: CUInt
xkbMapNotifyMask :: CUInt
xkbMapNotifyMask = CUInt
2
{-# LINE 286 "src/Xmobar/System/Kbd.hsc" #-}

xkbNewKeyboardNotifyMask :: CUInt
xkbNewKeyboardNotifyMask :: CUInt
xkbNewKeyboardNotifyMask  = CUInt
1
{-# LINE 289 "src/Xmobar/System/Kbd.hsc" #-}

xkbAllStateComponentsMask :: CULong
xkbAllStateComponentsMask :: CULong
xkbAllStateComponentsMask = CULong
16383
{-# LINE 292 "src/Xmobar/System/Kbd.hsc" #-}

xkbGroupStateMask :: CULong
xkbGroupStateMask :: CULong
xkbGroupStateMask = CULong
16
{-# LINE 295 "src/Xmobar/System/Kbd.hsc" #-}

xkbSymbolsNameMask :: CUInt
xkbSymbolsNameMask :: CUInt
xkbSymbolsNameMask = CUInt
4
{-# LINE 298 "src/Xmobar/System/Kbd.hsc" #-}

xkbGroupNamesMask :: CUInt
xkbGroupNamesMask :: CUInt
xkbGroupNamesMask = CUInt
4096
{-# LINE 301 "src/Xmobar/System/Kbd.hsc" #-}

type KbdOpts = [(String, String)]

getLayoutStr :: Display -> IO String
getLayoutStr :: Display -> IO String
getLayoutStr Display
dpy =  do
        Ptr XkbDescRec
kbdDescPtr <- IO (Ptr XkbDescRec)
xkbAllocKeyboard
        CInt
status <- Display -> CUInt -> Ptr XkbDescRec -> IO CInt
xkbGetNames Display
dpy CUInt
xkbSymbolsNameMask Ptr XkbDescRec
kbdDescPtr
        String
str <- CInt -> Display -> Ptr XkbDescRec -> IO String
getLayoutStr' CInt
status Display
dpy Ptr XkbDescRec
kbdDescPtr
        Ptr XkbDescRec -> CUInt -> CInt -> IO ()
xkbFreeNames Ptr XkbDescRec
kbdDescPtr CUInt
xkbSymbolsNameMask CInt
1
        Ptr XkbDescRec -> CUInt -> CInt -> IO ()
xkbFreeKeyboard Ptr XkbDescRec
kbdDescPtr CUInt
0 CInt
1
        String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
str

getLayoutStr' :: Status -> Display -> (Ptr XkbDescRec) -> IO String
getLayoutStr' :: CInt -> Display -> Ptr XkbDescRec -> IO String
getLayoutStr' CInt
st Display
dpy Ptr XkbDescRec
kbdDescPtr =
        if CInt
st CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 then -- Success
            do
            XkbDescRec
kbdDesc <- Ptr XkbDescRec -> IO XkbDescRec
forall a. Storable a => Ptr a -> IO a
peek Ptr XkbDescRec
kbdDescPtr
            XkbNamesRec
nameArray <- Ptr XkbNamesRec -> IO XkbNamesRec
forall a. Storable a => Ptr a -> IO a
peek (XkbDescRec -> Ptr XkbNamesRec
names XkbDescRec
kbdDesc)
            Ptr CChar
atom <- Display -> Atom -> IO (Ptr CChar)
xGetAtomName Display
dpy (XkbNamesRec -> Atom
symbols XkbNamesRec
nameArray)
            String
str <- Ptr CChar -> IO String
peekCString Ptr CChar
atom
            String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
str
        else -- Behaviour on error
            do
                String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"Error while requesting layout!"

getGrpNames :: Display -> IO [String]
getGrpNames :: Display -> IO [String]
getGrpNames Display
dpy =  do
        Ptr XkbDescRec
kbdDescPtr <- IO (Ptr XkbDescRec)
xkbAllocKeyboard
        CInt
status <- Display -> CUInt -> Ptr XkbDescRec -> IO CInt
xkbGetNames Display
dpy CUInt
xkbGroupNamesMask Ptr XkbDescRec
kbdDescPtr
        [String]
str <- CInt -> Display -> Ptr XkbDescRec -> IO [String]
getGrpNames' CInt
status Display
dpy Ptr XkbDescRec
kbdDescPtr
        Ptr XkbDescRec -> CUInt -> CInt -> IO ()
xkbFreeNames Ptr XkbDescRec
kbdDescPtr CUInt
xkbGroupNamesMask CInt
1
        Ptr XkbDescRec -> CUInt -> CInt -> IO ()
xkbFreeKeyboard Ptr XkbDescRec
kbdDescPtr CUInt
0 CInt
1
        [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
str

getGrpNames' :: Status -> Display -> (Ptr XkbDescRec) -> IO [String]
getGrpNames' :: CInt -> Display -> Ptr XkbDescRec -> IO [String]
getGrpNames' CInt
st Display
dpy Ptr XkbDescRec
kbdDescPtr =
        if CInt
st CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 then -- Success
            do
            XkbDescRec
kbdDesc <- Ptr XkbDescRec -> IO XkbDescRec
forall a. Storable a => Ptr a -> IO a
peek Ptr XkbDescRec
kbdDescPtr
            XkbNamesRec
nameArray <- Ptr XkbNamesRec -> IO XkbNamesRec
forall a. Storable a => Ptr a -> IO a
peek (XkbDescRec -> Ptr XkbNamesRec
names XkbDescRec
kbdDesc)
            let grpsArr :: [Atom]
grpsArr = XkbNamesRec -> [Atom]
groups XkbNamesRec
nameArray
            let grps :: [Atom]
grps = (Atom -> Bool) -> [Atom] -> [Atom]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
/=Atom
none) [Atom]
grpsArr
            (Atom -> IO String) -> [Atom] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Ptr CChar -> IO String
peekCString (Ptr CChar -> IO String)
-> (Atom -> IO (Ptr CChar)) -> Atom -> IO String
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Display -> Atom -> IO (Ptr CChar)
xGetAtomName Display
dpy) [Atom]
grps
        else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
"Error while requesting layout!"]