Exporting Exec constructors from Xmobar

1 files changed, 0 insertions, 404 deletions

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 <martin@perner.cc>
--- 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 <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)]
-
--- 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: