diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright © 2013 Auke Booij + +Permission is hereby granted, free of charge, to any person obtaining a +copy of this software and associated documentation files (the "Software"), +to deal in the Software without restriction, including without limitation +the rights to use, copy, modify, merge, publish, distribute, sublicense, +and/or sell copies of the Software, and to permit persons to whom the +Software is furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice (including the next +paragraph) shall be included in all copies or substantial portions of the +Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +DEALINGS IN THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Text/XkbCommon.hs b/Text/XkbCommon.hs new file mode 100644 --- /dev/null +++ b/Text/XkbCommon.hs @@ -0,0 +1,12 @@ +module Text.XkbCommon + ( module Text.XkbCommon.Types + , module Text.XkbCommon.Context + , module Text.XkbCommon.Keymap + , module Text.XkbCommon.KeyboardState + , module Text.XkbCommon.Keysym + ) where +import Text.XkbCommon.Types +import Text.XkbCommon.Context +import Text.XkbCommon.Keymap +import Text.XkbCommon.KeyboardState +import Text.XkbCommon.Keysym diff --git a/Text/XkbCommon/Constants.hs b/Text/XkbCommon/Constants.hs new file mode 100644 --- /dev/null +++ b/Text/XkbCommon/Constants.hs @@ -0,0 +1,6 @@ +module Text.XkbCommon.Constants + ( module Text.XkbCommon.KeysymList + , module Text.XkbCommon.ModList + ) where +import Text.XkbCommon.KeysymList +import Text.XkbCommon.ModList diff --git a/Text/XkbCommon/Context.hsc b/Text/XkbCommon/Context.hsc new file mode 100644 --- /dev/null +++ b/Text/XkbCommon/Context.hsc @@ -0,0 +1,176 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface #-} + +module Text.XkbCommon.Context + ( Context(..), + + ContextFlags, defaultFlags, pureFlags, contextNoDefaultIncludes, contextNoEnvironment, + + newContext, getIncludePaths, setIncludePaths, + appendIncludePath, numIncludePaths, clearIncludePath, appendDefaultIncludePath, + includePathShow, + ) where + +import Foreign +import Foreign.C +import Control.Monad (liftM) +import Data.Maybe +import System.FilePath + +import Text.XkbCommon.InternalTypes + +#include + + + +-- | Construct a new Xkb context from creation preferences. +-- xkb_context_new can fail if the default include path does not exist. +-- +-- (@xkb_context_new@) +newContext :: ContextFlags -> IO (Maybe Context) +newContext c = do + k <- c_new_context c + if k == nullPtr + then return Nothing + else do + l <- newForeignPtr c_unref_context k + return $ Just $ toContext l + +-- | Get the current include paths of a 'Context'. +-- Upon 'Keymap' creation, these directories will be searched for keymap definitions. +getIncludePaths :: Context -> IO [FilePath] +getIncludePaths ctx = do + numPaths <- numIncludePaths ctx + sequence [includePathShow ctx i | i<-[1..numPaths]] + +-- | Set a new list of include paths for a 'Context'. +setIncludePaths :: Context -- ^ Context whose search paths we are changing + -> [FilePath] -- ^ New list of search paths + -> Bool -- ^ Set to True if you also want to search on the default path + -> IO (Maybe ()) -- ^ returns Just () if addition of at least one path succeeded +setIncludePaths ctx list appendDefault = do + clearIncludePath ctx + let listMaybeWith = if appendDefault + then (appendDefaultIncludePath ctx:map addPath list) + else map addPath list + success <- fmap or $ fmap (fmap isJust) $ sequence listMaybeWith + return $ if success + then Just () + else Nothing + where + addPath path = appendIncludePath ctx path + +-- | Remove all 'Keymap' file search paths from a 'Context'. +-- +-- Preferred API is to use 'getIncludePaths' and 'setIncludePaths' +-- +-- (@xkb_context_include_path_clear@) +clearIncludePath :: Context -> IO () +clearIncludePath ctx = withContext ctx $ \ ptr -> c_clear_includes ptr + +-- stateful handling of Xkb context search paths for keymaps +-- fails if the path does not exist +-- | Append a search path for 'Keymap' files to a 'Context'. (@xkb_context_include_path_append@) +-- +-- Preferred API is to use 'getIncludePaths' and 'setIncludePaths' +-- +appendIncludePath :: Context -> FilePath -> IO (Maybe ()) +appendIncludePath c str = withCString str $ + \ cstr -> withContext c $ + \ ptr -> do + err <- c_append_include_path_context ptr cstr + return $ if err == 1 + then Just () + else Nothing + +-- | Append the default 'Keymap' search path (whose location depends on libxkbcommon compile-time settings) (@xkb_context_include_path_append_default@) +-- +-- Preferred API is to use 'getIncludePaths' and 'setIncludePaths' +-- +appendDefaultIncludePath :: Context -> IO (Maybe ()) +appendDefaultIncludePath ctx = withContext ctx $ \ ptr -> do + ret <- c_append_default_include ptr -- returns 0 on error + return (if ret == 0 then Nothing else Just ()) + +-- | (@xkb_context_num_include_paths@) +-- +-- Preferred API is to use 'getIncludePaths' and 'setIncludePaths' +-- +numIncludePaths :: Context -> IO Int +numIncludePaths c = withContext c $ liftM fromIntegral . c_num_include_paths_context + +-- c_show_include_path :: Ptr CContext -> CUInt -> IO CString +-- | Get a specific include path from the context's include path. (@xkb_context_include_path_get@) +-- +-- Preferred API is to use 'getIncludePaths' and 'setIncludePaths' +-- +includePathShow :: Context -> Int -> IO FilePath +includePathShow ctx idx = withContext ctx $ \ ptr -> c_show_include_path ptr (fromIntegral idx) >>= peekCString + + +-- FOREIGN CCALLS + + +-- context related + +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_context_new" + c_new_context :: ContextFlags -> IO (Ptr CContext) + +foreign import ccall unsafe "xkbcommon/xkbcommon.h &xkb_context_unref" + c_unref_context :: FinalizerPtr CContext + +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_context_include_path_append" + c_append_include_path_context :: Ptr CContext -> CString -> IO CInt + +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_context_num_include_paths" + c_num_include_paths_context :: Ptr CContext -> IO CUInt + +-- int xkb_context::xkb_context_include_path_append_default (struct xkb_context *context) +-- Append the default include paths to the contexts include path. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_context_include_path_append_default" + c_append_default_include :: Ptr CContext -> IO CInt + +-- int xkb_context::xkb_context_include_path_reset_defaults (struct xkb_context *context) +-- Reset the context's include path to the default. +--foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_context_include_path_reset_defaults" + +-- void xkb_context::xkb_context_include_path_clear (struct xkb_context *context) +-- Remove all entries from the context's include path. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_context_include_path_clear" + c_clear_includes :: Ptr CContext -> IO () + +-- const char * xkb_context::xkb_context_include_path_get (struct xkb_context *context, unsigned int index) +-- Get a specific include path from the context's include path. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_context_include_path_get" + c_show_include_path :: Ptr CContext -> CUInt -> IO CString + + +-- The foreign calls below are not yet bound... not sure I want to at this stage. + +-- logging related + +-- void xkb_context::xkb_context_set_log_level (struct xkb_context *context, enum xkb_log_level level) +-- Set the current logging level. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_context_set_log_level" + c_set_log_level :: Ptr CContext -> CLogLevel -> IO () + +-- enum xkb_log_level xkb_context::xkb_context_get_log_level (struct xkb_context *context) +-- Get the current logging level. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_context_get_log_level" + c_get_log_level :: Ptr CContext -> IO CLogLevel + +-- void xkb_context::xkb_context_set_log_verbosity (struct xkb_context *context, int verbosity) +-- Sets the current logging verbosity. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_context_set_log_verbosity" + c_set_log_verbosity :: Ptr CContext -> CInt -> IO () + +-- int xkb_context::xkb_context_get_log_verbosity (struct xkb_context *context) +-- Get the current logging verbosity of the context. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_context_get_log_verbosity" + c_get_log_verbosity :: Ptr CContext -> IO CInt + +-- we have to manually translate this in C because the haskell FFI does not support va_list! +-- void xkb_context::xkb_context_set_log_fn (struct xkb_context *context, void(*log_fn)(struct xkb_context *context, enum xkb_log_level level, const char *format, va_list args)) +-- Set a custom function to handle logging messages. +-- foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_context_set_log_fn" +-- c_set_log_fun :: Ptr CContext -> FunPtr (Ptr CContext -> CLogLevel -> CString -> #{type va_list} -> IO ()) -> IO () + diff --git a/Text/XkbCommon/InternalTypes.hsc b/Text/XkbCommon/InternalTypes.hsc new file mode 100644 --- /dev/null +++ b/Text/XkbCommon/InternalTypes.hsc @@ -0,0 +1,237 @@ +{-# LANGUAGE CPP, EmptyDataDecls, GeneralizedNewtypeDeriving, TemplateHaskell #-} +module Text.XkbCommon.InternalTypes + ( Context, CContext, InternalContext, toContext, fromContext, withContext, + ContextFlags(..), defaultFlags, + pureFlags, contextNoDefaultIncludes, contextNoEnvironment, + + Keymap, CKeymap, InternalKeymap, toKeymap, fromKeymap, withKeymap, RMLVO(..), noPrefs, + + KeyboardState, CKeyboardState, toKeyboardState, fromKeyboardState, withKeyboardState, + + readCString, + + Direction(..), keyUp, keyDown, + + CKeysym(..), Keysym(..), toKeysym, fromKeysym, safeToKeysym, + + CLogLevel(..), CKeycode(..), CLayoutIndex(..), CModIndex(..), CLevelIndex(..), + CLedIndex(..), StateComponent(..), CModMask(..), + + stateModDepressed, stateModLatched, stateModLocked, stateModEffective, + stateLayoutDepressed, stateLayoutLatched, stateLayoutLocked, + stateLayoutEffective, stateLeds, + ) where + +import Foreign +import Foreign.C +import Foreign.Storable +import Control.Monad (ap, liftM) +import qualified Foreign.Storable.Newtype as Store +import Data.Flags +import Data.Flags.TH + +#include + +-- | @Context@ is the exposed datatype of an xkbcommon context (@struct xkb_context@) +data Context = Context InternalContext +-- internal datatype and conversion methods... +data CContext +type InternalContext = ForeignPtr CContext +toContext :: InternalContext -> Context +toContext = Context +fromContext :: Context -> InternalContext +fromContext (Context ic) = ic +withContext :: Context -> (Ptr CContext -> IO a) -> IO a +withContext = withForeignPtr . fromContext + +-- | Keymap represents a compiled keymap object. (@struct xkb_keymap@) +data Keymap = Keymap InternalKeymap +-- internals: +data CKeymap +type InternalKeymap = ForeignPtr CKeymap +toKeymap :: InternalKeymap -> Keymap +toKeymap = Keymap +fromKeymap :: Keymap -> InternalKeymap +fromKeymap (Keymap km) = km +withKeymap :: Keymap -> (Ptr CKeymap -> IO a) -> IO a +withKeymap = withForeignPtr . fromKeymap + +-- | The RMLVO type specifies preferences for keymap creation +-- (@struct xkb_rule_names@) +data RMLVO = RMLVO {rules, model, layout, variant, options :: Maybe String} +-- | Specify that no specific keymap is preferred by the program. +-- Depending on the specified 'ContextFlags' during 'Context' creation, +-- 'RMLVO' specifications may be loaded from environment variables. +noPrefs = RMLVO { rules = Nothing + , model = Nothing + , layout = Nothing + , variant = Nothing + , options = Nothing + } + +wrapCString :: CString -> IO (Maybe String) +wrapCString x = if x == nullPtr + then return Nothing + else do + k <- peekCString x + return $ Just k +wrapString :: Maybe String -> IO CString +wrapString Nothing = return nullPtr +wrapString (Just str) = newCString str +instance Storable RMLVO where + sizeOf _ = #{size struct xkb_rule_names} + alignment _ = alignment (undefined :: CInt) + + poke p rmlvo = do + wrapString (rules rmlvo) >>= #{poke struct xkb_rule_names, rules} p + wrapString (model rmlvo) >>= #{poke struct xkb_rule_names, model} p + wrapString (layout rmlvo) >>= #{poke struct xkb_rule_names, layout} p + wrapString (variant rmlvo) >>= #{poke struct xkb_rule_names, variant} p + wrapString (options rmlvo) >>= #{poke struct xkb_rule_names, options} p + peek p = return RMLVO + `ap` (#{peek struct xkb_rule_names, rules} p >>= wrapCString) + `ap` (#{peek struct xkb_rule_names, model} p >>= wrapCString) + `ap` (#{peek struct xkb_rule_names, layout} p >>= wrapCString) + `ap` (#{peek struct xkb_rule_names, variant} p >>= wrapCString) + `ap` (#{peek struct xkb_rule_names, options} p >>= wrapCString) + + +-- | @KeyboardState@ represents the state of a connected keyboard. (@struct xkb_state@) +data KeyboardState = KeyboardState InternalKeyboardState +-- internals: +data CKeyboardState +type InternalKeyboardState = ForeignPtr CKeyboardState +toKeyboardState :: InternalKeyboardState -> KeyboardState +toKeyboardState = KeyboardState +fromKeyboardState :: KeyboardState -> InternalKeyboardState +fromKeyboardState (KeyboardState st) = st +withKeyboardState :: KeyboardState -> (Ptr CKeyboardState -> IO a) -> IO a +withKeyboardState = withForeignPtr . fromKeyboardState + + +-- useful functions + +-- reads a C string obtained from the library and proceeds to free it +readCString :: CString -> IO String +readCString cstr = do + str <- peekCString cstr + free cstr + return str + +newtype CKeysym = CKeysym {unCKeysym :: #{type xkb_keysym_t}} deriving (Show, Eq) +instance Storable CKeysym where + sizeOf = Store.sizeOf unCKeysym + alignment = Store.alignment unCKeysym + peek = Store.peek CKeysym + poke = Store.poke unCKeysym +-- | One graphical symbol (usually on-screen). This is the end product of libxkbcommon. +-- Some keysyms are not graphical characters, but can also represent e.g. Left or Right arrow +-- keys. Refer to the libxkbcommon documentation for details. +-- +-- NOTE that @XKB_KEY_NoSymbol@ is represented by a @Nothing@ in haskell-xkbcommon. +-- +-- (@xkb_keysym_t@) +newtype Keysym = Keysym Int deriving (Show, Eq) +fromKeysym :: Keysym -> CKeysym +fromKeysym (Keysym k) = CKeysym (fromIntegral k) +toKeysym :: CKeysym -> Keysym +toKeysym (CKeysym 0) = error "Keysym must be nonzero!" +toKeysym (CKeysym k) = Keysym (fromIntegral k) +safeToKeysym :: CKeysym -> Maybe Keysym +safeToKeysym (CKeysym 0) = Nothing +safeToKeysym (CKeysym n) = Just (Keysym (fromIntegral n)) + +-- | One keyboard key. Events on keys are the input of libxkbcommon. +newtype CKeycode = CKeycode {unCKeycode :: #{type xkb_keycode_t}} deriving (Show, Eq) +instance Storable CKeycode where + sizeOf = Store.sizeOf unCKeycode + alignment = Store.alignment unCKeycode + peek = Store.peek CKeycode + poke = Store.poke unCKeycode +-- not sure if the below is useful... commented out until it is. +-- fromKeycode :: Keycode -> CKeycode +-- fromKeycode (Keycode k) = CKeycode k +-- toKeycode :: CKeycode -> Keycode +-- toKeycode (CKeycode 0) = error "Keycode must be nonzero!" +-- safeToKeycode :: CKeycode -> Maybe Keycode +-- safeToKeycode (CKeycode 0) = Nothing +-- safeToKeycode (CKeycode n) = Just (Keycode n) + +-- | @ContextFlags@ carry options for construction of a 'Context'. (@enum xkb_context_flags@) +newtype ContextFlags = ContextFlags #{type enum xkb_context_flags} + deriving (Eq, Flags) + +-- tail.init because the first item is the type declaration (which we can already find above) and the last is the Show instance (which we don't want/need) +$(liftM (tail.init) $ bitmaskWrapper "ContextFlags" ''#{type enum xkb_context_flags} [] + [("contextNoEnvironment", #{const XKB_CONTEXT_NO_ENVIRONMENT_NAMES}), + ("contextNoDefaultIncludes", #{const XKB_CONTEXT_NO_DEFAULT_INCLUDES})]) +-- | Default 'ContextFlags': consider RMLVO prefs from the environment variables, and search for 'Keymap' files in the default paths. +defaultFlags = noFlags :: ContextFlags +-- | Pure 'ContextFlags': don't consider env vars or default search paths, which are system-dependent. +pureFlags = contextNoEnvironment .+. contextNoDefaultIncludes + +-- newtype CCompileFlags = CCompileFlags #{type enum xkb_keymap_compile_flags} -- only one option, so disabled +-- | In a key event, a key can be pressed\/moved down ('keyDown') or released\/moved up ('keyUp'). +newtype Direction = Direction #{type enum xkb_key_direction} +#{enum Direction, Direction, keyUp = XKB_KEY_UP, keyDown = XKB_KEY_DOWN} +-- newtype CKeymapFormat = CKeymapFormat #{type enum xkb_keymap_format} -- only one option, so disabled +-- newtype CKeysymFlags = CKeysymFlags #{type enum xkb_keysym_flags} -- only one option, so disabled + +-- | Index of a keyboard layout. +-- +-- The layout index is a state component which detemines which keyboard layout is active. +-- These may be different alphabets, different key arrangements, etc. +-- +-- Layout indexes are consecutive. The first layout has index 0. +-- +-- Each layout is not required to have a name, and the names are not guaranteed to be unique +-- (though they are usually provided and unique). +-- Therefore, it is not safe to use the name as a unique identifier for a layout. +-- Layout names are case-sensitive. +-- +-- Layouts are also called "groups" by XKB. +newtype CLayoutIndex = CLayoutIndex #{type xkb_layout_index_t} +newtype CLedIndex = CLedIndex {unCLedIndex :: #{type xkb_led_index_t}} deriving (Show, Eq) +-- | Index of a shift level. +newtype CLevelIndex = CLevelIndex #{type xkb_level_index_t} +newtype CLogLevel = CLogLevel #{type enum xkb_log_level} +-- | Index of a modifier. +-- +-- A modifier is a state component which changes the way keys are interpreted. +-- A keymap defines a set of modifiers, such as Alt, Shift, Num Lock or Meta, +-- and specifies which keys may activate which modifiers (in a many-to-many relationship, +-- i.e. a key can activate several modifiers, and a modifier may be activated by several keys. +-- Different keymaps do this differently). +-- +-- When retrieving the keysyms for a key, the active modifier set is consulted; +-- this detemines the correct shift level to use within the currently active layout +-- (see 'CLevelIndex'). +-- +-- Modifier indexes are consecutive. The first modifier has index 0. +newtype CModIndex = CModIndex {unCModIndex :: #{type xkb_mod_index_t}} deriving (Show, Eq) +instance Storable CModIndex where + sizeOf = Store.sizeOf unCModIndex + alignment = Store.alignment unCModIndex + peek = Store.peek CModIndex + poke = Store.poke unCModIndex +newtype CModMask = CModMask #{type xkb_mod_mask_t} deriving(Eq, Num, Show) +-- | Modifier and layout types for state objects. +-- +-- In XKB, the DEPRESSED components are also known as \'base\'. +-- +-- (@xkb_state_component@) +newtype StateComponent = StateComponent #{type enum xkb_state_component} -- ATTENTION this is a bitmask! + deriving (Eq, Flags, BoundedFlags) +#{enum StateComponent, StateComponent +, stateModDepressed = XKB_STATE_MODS_DEPRESSED +, stateModLatched = XKB_STATE_MODS_LATCHED +, stateModLocked = XKB_STATE_MODS_LOCKED +, stateModEffective = XKB_STATE_MODS_EFFECTIVE +, stateLayoutDepressed = XKB_STATE_LAYOUT_DEPRESSED +, stateLayoutLatched = XKB_STATE_LAYOUT_LATCHED +, stateLayoutLocked = XKB_STATE_LAYOUT_LOCKED +, stateLayoutEffective = XKB_STATE_LAYOUT_EFFECTIVE +, stateLeds = XKB_STATE_LEDS + } + +-- TODO keysym data types diff --git a/Text/XkbCommon/KeyboardState.hsc b/Text/XkbCommon/KeyboardState.hsc new file mode 100644 --- /dev/null +++ b/Text/XkbCommon/KeyboardState.hsc @@ -0,0 +1,213 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface #-} + +module Text.XkbCommon.KeyboardState + ( KeyboardState, newKeyboardState, updateKeyboardStateKey, updateKeyboardStateMask, getOneKeySym, getStateSyms, + stateRemoveConsumed, + + stateModNameIsActive, stateModIndexIsActive, stateLedNameIsActive, stateSerializeMods, + ) where + +import Foreign +import Foreign.C +import Foreign.Storable +import Data.Functor +import Data.Maybe (mapMaybe) + +import Text.XkbCommon.InternalTypes + +#include + + +-- | Create a new keyboard state object for a keymap. (@xkb_state_new@) +newKeyboardState :: Keymap -> IO KeyboardState +newKeyboardState km = withKeymap km $ + \ ptr -> do + k <- c_new_keyboard_state ptr + l <- newForeignPtr c_unref_keyboard_state k + return $ toKeyboardState l + +-- | Update the keyboard state to reflect a given key being pressed or released. (@xkb_state_update_key@) +updateKeyboardStateKey :: KeyboardState -> CKeycode -> Direction -> IO StateComponent +updateKeyboardStateKey st key dir = withKeyboardState st $ + \ ptr -> c_update_key_state ptr key dir + +-- | Get the single keysym obtained from pressing a particular key in a given keyboard state. +-- (@xkb_state_key_get_one_sym@) +getOneKeySym :: KeyboardState -> CKeycode -> IO (Maybe Keysym) +getOneKeySym st key = withKeyboardState st $ + \ ptr -> do + ks <- c_get_one_key_sym ptr key + return $ safeToKeysym ks + +-- | Get the keysyms obtained from pressing a particular key in a given keyboard state. +-- This function is useful because some keycode sequences produce multiple keysyms. +-- +-- (@xkb_state_key_get_syms@) +getStateSyms :: KeyboardState -> CKeycode -> IO [Keysym] +getStateSyms st key = withKeyboardState st $ \ ptr -> do + init_ptr <- newArray [] :: IO (Ptr CKeysym) + in_ptr <- new init_ptr + num_out <- c_state_get_syms ptr key in_ptr + deref_ptr <- peek in_ptr + out_list <- peekArray (fromIntegral num_out) deref_ptr + --free deref_ptr >> free in_ptr >> free init_ptr + free in_ptr >> free init_ptr + return $ mapMaybe safeToKeysym out_list + +-- Get the effective layout index for a key in a given keyboard state. +-- c_get_layout :: Ptr CKeyboardState -> CKeycode -> IO CLayoutIndex + +-- Get the effective shift level for a key in a given keyboard state and layout. +-- c_key_get_level :: Ptr CKeyboardState -> CKeycode -> CLayoutIndex -> IO CLevelIndex + +-- | Update a keyboard state from a set of explicit masks. (@xkb_state_update_mask@) +updateKeyboardStateMask :: KeyboardState -> (CModMask, CModMask, CModMask) -> (CLayoutIndex, CLayoutIndex, CLayoutIndex) -> IO StateComponent +updateKeyboardStateMask st (mask1, mask2, mask3) (idx1, idx2, idx3) = withKeyboardState st $ \ ptr -> + c_update_state_mask ptr mask1 mask2 mask3 idx1 idx2 idx3 + +-- | The counterpart to xkb_state_update_mask for modifiers, to be used on the server side of +-- serialization. (@xkb_state_serialize_mods@) +stateSerializeMods :: KeyboardState -> StateComponent -> IO CModMask +stateSerializeMods st comp = withKeyboardState st $ \ ptr -> + c_serialize_state_mods ptr comp + +-- The counterpart to xkb_state_update_mask for layouts, to be used on the server side of serialization. +-- c_serialize_state :: Ptr CKeyboardState -> StateComponent -> IO CLayoutIndex + +-- | Test whether a modifier is active in a given keyboard state by name. +-- (@xkb_state_mod_name_is_active@) +stateModNameIsActive :: KeyboardState -> String -> StateComponent -> IO Bool +stateModNameIsActive st name comp = withKeyboardState st $ \ ptr -> + withCString name $ \ cstr -> do + out <- c_state_mod_name_is_active ptr cstr comp + return $ out > 0 + +-- | Test whether a modifier is active in a given keyboard state by index. +-- (@xkb_state_mod_index_is_active@) +stateModIndexIsActive :: KeyboardState -> CModIndex -> StateComponent -> IO Bool +stateModIndexIsActive st idx comp = withKeyboardState st $ \ ptr -> do + out <- c_state_mod_index_is_active ptr idx comp + return $ out > 0 + +-- Test whether a modifier is consumed by keyboard state translation for a key. +-- c_modifier_is_consumed :: Ptr CKeyboardState -> CKeycode -> CModIndex -> IO CInt + +-- | Remove consumed modifiers from a modifier mask for a key. +-- (@xkb_state_mod_mask_remove_consumed@) +stateRemoveConsumed :: KeyboardState -> CKeycode -> CModMask -> IO CModMask +stateRemoveConsumed st kc mask = withKeyboardState st $ \ ptr -> + c_remove_consumed_modifiers ptr kc mask + +-- Test whether a layout is active in a given keyboard state by name. +-- c_layout_name_is_active :: Ptr CKeyboardState -> CString -> StateComponent -> IO CInt + +-- Test whether a layout is active in a given keyboard state by index. +-- c_layout_index_is_active :: Ptr CKeyboardState -> CLayoutIndex -> StateComponent -> IO CInt + +-- | Test whether a LED is active in a given keyboard state by name. +-- (@xkb_state_led_name_is_active@) +stateLedNameIsActive :: KeyboardState -> String -> IO Bool +stateLedNameIsActive st name = withKeyboardState st $ \ ptr -> + withCString name $ \ cstr -> do + out <- c_led_name_is_active ptr cstr + return $ out > 0 + +-- Test whether a LED is active in a given keyboard state by index. +-- c_led_index_is_active :: Ptr CKeyboardState -> CLedIndex -> IO CInt + + + +-- keymap state related + +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_new" + c_new_keyboard_state :: Ptr CKeymap -> IO (Ptr CKeyboardState) + +foreign import ccall unsafe "xkbcommon/xkbcommon.h &xkb_state_unref" + c_unref_keyboard_state :: FinalizerPtr CKeyboardState + +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_update_key" + c_update_key_state :: Ptr CKeyboardState -> CKeycode -> Direction -> IO StateComponent + +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_key_get_one_sym" + c_get_one_key_sym :: Ptr CKeyboardState -> CKeycode -> IO CKeysym + +-- int xkb_state::xkb_state_key_get_syms (struct xkb_state *state, xkb_keycode_t key, const xkb_keysym_t **syms_out) +-- Get the keysyms obtained from pressing a particular key in a given keyboard state. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_key_get_syms" + c_state_get_syms :: Ptr CKeyboardState -> CKeycode -> Ptr (Ptr CKeysym) -> IO CInt + +-- xkb_layout_index_t xkb_state::xkb_state_key_get_layout (struct xkb_state *state, xkb_keycode_t key) +-- Get the effective layout index for a key in a given keyboard state. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_key_get_layout" + c_get_layout :: Ptr CKeyboardState -> CKeycode -> IO CLayoutIndex + +-- xkb_level_index_t xkb_state::xkb_state_key_get_level (struct xkb_state *state, xkb_keycode_t key, xkb_layout_index_t layout) +-- Get the effective shift level for a key in a given keyboard state and layout. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_key_get_level" + c_key_get_level :: Ptr CKeyboardState -> CKeycode -> CLayoutIndex -> IO CLevelIndex + +-- enum xkb_state_component xkb_state::xkb_state_update_mask (struct xkb_state *state, xkb_mod_mask_t depressed_mods, xkb_mod_mask_t latched_mods, xkb_mod_mask_t locked_mods, xkb_layout_index_t depressed_layout, xkb_layout_index_t latched_layout, xkb_layout_index_t locked_layout) +-- Update a keyboard state from a set of explicit masks. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_update_mask" + c_update_state_mask :: Ptr CKeyboardState -> CModMask -> CModMask -> CModMask -> CLayoutIndex -> CLayoutIndex -> CLayoutIndex -> IO StateComponent + +-- xkb_mod_mask_t xkb_state::xkb_state_serialize_mods (struct xkb_state *state, enum xkb_state_component components) +-- The counterpart to xkb_state_update_mask for modifiers, to be used on the server side of serialization. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_serialize_mods" + c_serialize_state_mods :: Ptr CKeyboardState -> StateComponent -> IO CModMask + +-- xkb_layout_index_t xkb_state::xkb_state_serialize_layout (struct xkb_state *state, enum xkb_state_component components) +-- The counterpart to xkb_state_update_mask for layouts, to be used on the server side of serialization. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_serialize_layout" + c_serialize_state :: Ptr CKeyboardState -> StateComponent -> IO CLayoutIndex + +-- int xkb_state::xkb_state_mod_name_is_active (struct xkb_state *state, const char *name, enum xkb_state_component type) +-- Test whether a modifier is active in a given keyboard state by name. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_mod_name_is_active" + c_state_mod_name_is_active :: Ptr CKeyboardState -> CString -> StateComponent -> IO Int + +-- cannot be ccalled due to va_list. libxkbcommon devs say they aren't that useful anyway. +-- int xkb_state::xkb_state_mod_names_are_active (struct xkb_state *state, enum xkb_state_component type, enum xkb_state_match match,...) +-- Test whether a set of modifiers are active in a given keyboard state by name. +-- foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_mod_names_are_active" + +-- int xkb_state::xkb_state_mod_index_is_active (struct xkb_state *state, xkb_mod_index_t idx, enum xkb_state_component type) +-- Test whether a modifier is active in a given keyboard state by index. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_mod_index_is_active" + c_state_mod_index_is_active :: Ptr CKeyboardState -> CModIndex -> StateComponent -> IO CInt + +-- cannot be ccalled due to va_list +-- int xkb_state::xkb_state_mod_indices_are_active (struct xkb_state *state, enum xkb_state_component type, enum xkb_state_match match,...) +-- Test whether a set of modifiers are active in a given keyboard state by index. +-- foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_mod_indices_are_active" + +-- int xkb_state::xkb_state_mod_index_is_consumed (struct xkb_state *state, xkb_keycode_t key, xkb_mod_index_t idx) +-- Test whether a modifier is consumed by keyboard state translation for a key. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_mod_index_is_consumed" + c_modifier_is_consumed :: Ptr CKeyboardState -> CKeycode -> CModIndex -> IO CInt + +-- xkb_mod_mask_t xkb_state::xkb_state_mod_mask_remove_consumed (struct xkb_state *state, xkb_keycode_t key, xkb_mod_mask_t mask) +-- Remove consumed modifiers from a modifier mask for a key. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_mod_mask_remove_consumed" + c_remove_consumed_modifiers :: Ptr CKeyboardState -> CKeycode -> CModMask -> IO CModMask + +-- int xkb_state::xkb_state_layout_name_is_active (struct xkb_state *state, const char *name, enum xkb_state_component type) +-- Test whether a layout is active in a given keyboard state by name. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_layout_name_is_active" + c_layout_name_is_active :: Ptr CKeyboardState -> CString -> StateComponent -> IO CInt + +-- int xkb_state::xkb_state_layout_index_is_active (struct xkb_state *state, xkb_layout_index_t idx, enum xkb_state_component type) +-- Test whether a layout is active in a given keyboard state by index. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_layout_index_is_active" + c_layout_index_is_active :: Ptr CKeyboardState -> CLayoutIndex -> StateComponent -> IO CInt + +-- int xkb_state::xkb_state_led_name_is_active (struct xkb_state *state, const char *name) +-- Test whether a LED is active in a given keyboard state by name. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_led_name_is_active" + c_led_name_is_active :: Ptr CKeyboardState -> CString -> IO CInt + +-- int xkb_state::xkb_state_led_index_is_active (struct xkb_state *state, xkb_led_index_t idx) +-- Test whether a LED is active in a given keyboard state by index. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_state_led_index_is_active" + c_led_index_is_active :: Ptr CKeyboardState -> CLedIndex -> IO CInt + diff --git a/Text/XkbCommon/KeycodeList.hs b/Text/XkbCommon/KeycodeList.hs new file mode 100644 --- /dev/null +++ b/Text/XkbCommon/KeycodeList.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Text.XkbCommon.KeycodeList where + +import Language.Haskell.TH + +import Text.XkbCommon.ParseDefines +import Text.XkbCommon.InternalTypes + +-- TH magic from ParseDefines: +$(runIO genKeycodes >>= return) + +toEvdev :: CKeycode -> Int +toEvdev (CKeycode k) = fromIntegral k - 8 +fromEvdev :: Int -> CKeycode +fromEvdev k = CKeycode $ fromIntegral (k + 8) diff --git a/Text/XkbCommon/Keymap.hsc b/Text/XkbCommon/Keymap.hsc new file mode 100644 --- /dev/null +++ b/Text/XkbCommon/Keymap.hsc @@ -0,0 +1,205 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface #-} + +module Text.XkbCommon.Keymap + ( Keymap, RMLVO(..), noPrefs, + + newKeymapFromNames, newKeymapFromString, keymapAsString, keymapNumLayouts, + keymapKeyNumLayouts, keymapNumMods, keymapModName, keymapModIdx, keymapKeyNumLevels, + keymapNumLeds, keymapLeds, keymapModifiers, + keymapLedName, keymapKeyRepeats + ) where + +import Control.Monad +import Foreign +import Foreign.C +import qualified System.IO.Unsafe as S (unsafePerformIO) + +import Text.XkbCommon.InternalTypes + +#include + + +-- | Create keymap from optional preference of Rules+Model+Layouts+Variants+Options +-- 'Keymap's are immutable but creation can fail. IO because it loads from disk. +-- +-- (@xkb_keymap_new_from_names@) +newKeymapFromNames :: Context -> RMLVO -> IO (Maybe Keymap) +newKeymapFromNames ctx rmlvo = withContext ctx $ \ ptr -> do + crmlvo <- new rmlvo + k <- c_keymap_from_names ptr crmlvo #{const XKB_MAP_COMPILE_PLACEHOLDER } + l <- newForeignPtr c_unref_keymap k + return (if k == nullPtr then Nothing else Just $ toKeymap l) + +-- | Create keymap from string buffer instead of loading from disk +-- Immutable but creation can fail. not IO because it just parses a string. +-- +-- haskell-xkbcommon has no equivalent for xkb_keymap_new_from_file: just load it from disk +-- manually. +-- +-- NOTE this can actually be an IO operation when compilation fails! (error output to stdout) +-- +-- (@xkb_keymap_new_from_string@) +newKeymapFromString :: Context -> String -> Maybe Keymap +newKeymapFromString ctx buf = S.unsafePerformIO $ withCString buf $ \ cstr -> withContext ctx $ \ ptr -> do + k <- c_keymap_from_string ptr cstr #{const XKB_KEYMAP_FORMAT_TEXT_V1} #{const XKB_MAP_COMPILE_PLACEHOLDER } + l <- newForeignPtr c_unref_keymap k + return (if k == nullPtr then Nothing else Just $ toKeymap l) + +-- | Convert a keymap to an enormous string buffer. Opposite of 'newKeymapFromString' +-- +-- (@xkb_keymap_get_as_string@) +keymapAsString :: Keymap -> String +keymapAsString km = S.unsafePerformIO $ withKeymap km $ \ ptr -> + c_keymap_as_string ptr #{const XKB_KEYMAP_FORMAT_TEXT_V1} >>= peekCString + +-- | Get the number of layouts in the keymap. (@xkb_keymap_num_layouts@) +keymapNumLayouts :: Keymap -> CLayoutIndex +keymapNumLayouts km = S.unsafePerformIO $ withKeymap km c_keymap_num_layouts + +-- | Get the number of layouts for a specific key. (@xkb_keymap_num_layouts_for_key@) +keymapKeyNumLayouts :: Keymap -> CKeycode -> CLayoutIndex +keymapKeyNumLayouts km key = S.unsafePerformIO $ withKeymap km $ \ ptr -> c_keymap_num_layouts_key ptr key + +-- | Get the name of a layout by index. (@xkb_keymap_layout_get_name@) +keymapLayoutName :: Keymap -> CLayoutIndex -> Maybe String +keymapLayoutName km idx = S.unsafePerformIO $ withKeymap km $ \ ptr -> do + name <- c_keymap_layout_name ptr idx + if name == nullPtr + then return Nothing + else liftM Just $ peekCString name + +-- | Get the modifiers of a keymap. +keymapModifiers :: Keymap -> [String] +keymapModifiers km = [keymapModName km (CModIndex i) | i <- [0..(fromIntegral $ unCModIndex $ keymapNumMods km)]] + +-- | Get the number of modifiers in the keymap. +-- +-- Preferred API is 'keymapModifiers'. +-- +-- (@xkb_keymap_num_mods@) +keymapNumMods :: Keymap -> CModIndex +keymapNumMods km = S.unsafePerformIO $ withKeymap km c_keymap_num_mods + +-- | Get the name of a modifier by index. (@xkb_keymap_mod_get_name@) +-- +-- Preferred API is 'keymapModifiers'. +-- +keymapModName :: Keymap -> CModIndex -> String +keymapModName km idx = S.unsafePerformIO $ withKeymap km $ + \ ptr -> c_keymap_mod_name ptr idx >>= peekCString + +-- | Get the index of a modifier by name. (@xkb_keymap_mod_get_index@) +-- +-- Preferred API is 'keymapModifiers'. +-- +keymapModIdx :: Keymap -> String -> Maybe CModIndex +keymapModIdx km name = S.unsafePerformIO $ withKeymap km $ + \ ptr -> withCString name $ \ cstr -> do + idx <- c_keymap_mod_index ptr cstr + case idx of + CModIndex (#{const XKB_MOD_INVALID}) -> return Nothing + x@(CModIndex n) -> return $ Just x + +-- | Get the number of shift levels for a specific key and layout. (@xkb_keymap_num_levels_for_key@) +keymapKeyNumLevels :: Keymap -> CKeycode -> CLayoutIndex -> CLevelIndex +keymapKeyNumLevels km kc idx = S.unsafePerformIO $ withKeymap km $ \ ptr -> c_keymap_num_levels ptr kc idx + +-- Get the keysyms obtained from pressing a key in a given layout and shift level. +-- c_keymap_syms_by_level :: Ptr CKeymap -> CKeycode -> CLayoutIndex -> CLevelIndex -> Ptr (Ptr CKeysym) -> IO CInt +-- TODO + +-- | Get the leds of a keymap. +keymapLeds :: Keymap -> [String] +keymapLeds km = [keymapLedName km (CLedIndex i) | i <- [0..(fromIntegral $ unCLedIndex $ keymapNumLeds km)]] + +-- | Get the number of LEDs in the keymap. (@xkb_keymap_num_leds@) +-- +-- Preferred API is 'keymapLeds' +keymapNumLeds :: Keymap -> CLedIndex +keymapNumLeds km = S.unsafePerformIO $ withKeymap km c_keymap_num_leds + +-- | Get the name of a LED by index. (@xkb_keymap_led_get_name@) +-- +-- Preferred API is 'keymapLeds' +keymapLedName :: Keymap -> CLedIndex -> String +keymapLedName km id = S.unsafePerformIO . withKeymap km $ + \ ptr -> c_keymap_led_name ptr id >>= peekCString + +-- | Determine whether a key should repeat or not. (@xkb_keymap_key_repeats@) +keymapKeyRepeats :: Keymap -> CKeycode -> Bool +keymapKeyRepeats km kc = S.unsafePerformIO (withKeymap km $ \ ptr -> c_keymap_key_repeats ptr kc) /= 0 + +-- FOREIGN CCALLS + +-- struct xkb_keymap * xkb_keymap::xkb_keymap_new_from_names (struct xkb_context *context, const struct xkb_rule_names *names, enum xkb_keymap_compile_flags flags) +-- note that we always pass 0 as the third argument since there are no options yet. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keymap_new_from_names" + c_keymap_from_names :: Ptr CContext -> Ptr RMLVO -> CInt -> IO (Ptr CKeymap) + +-- struct xkb_keymap * xkb_keymap::xkb_keymap_new_from_string (struct xkb_context *context, const char *string, enum xkb_keymap_format format, enum xkb_keymap_compile_flags flags) +-- note that the third argument is always 1 because there are no options yet. +-- fourth is always 0 +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keymap_new_from_string" + c_keymap_from_string :: Ptr CContext -> CString -> CInt -> CInt -> IO (Ptr CKeymap) + +-- second argument 0 for V1, -1 for original (ie. V1). +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keymap_get_as_string" + c_keymap_as_string :: Ptr CKeymap -> CInt -> IO CString + +foreign import ccall unsafe "xkbcommon/xkbcommon.h &xkb_keymap_unref" + c_unref_keymap :: FinalizerPtr CKeymap + +-- Get the name of a layout by index. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keymap_layout_get_name" + c_keymap_layout_name :: Ptr CKeymap -> CLayoutIndex -> IO CString + +--xkb_mod_index_t xkb_keymap::xkb_keymap_num_mods (struct xkb_keymap *keymap) +-- Get the number of modifiers in the keymap. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keymap_num_mods" + c_keymap_num_mods :: Ptr CKeymap -> IO CModIndex + +-- const char * xkb_keymap::xkb_keymap_mod_get_name (struct xkb_keymap *keymap, xkb_mod_index_t idx) +-- Get the name of a modifier by index. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keymap_mod_get_name" + c_keymap_mod_name :: Ptr CKeymap -> CModIndex -> IO CString + +-- xkb_mod_index_t xkb_keymap::xkb_keymap_mod_get_index (struct xkb_keymap *keymap, const char *name) +-- Get the index of a modifier by name. More... +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keymap_mod_get_index" + c_keymap_mod_index :: Ptr CKeymap -> CString -> IO CModIndex + +-- xkb_layout_index_t xkb_keymap::xkb_keymap_num_layouts (struct xkb_keymap *keymap) +-- Get the number of layouts in the keymap. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keymap_num_layouts" + c_keymap_num_layouts :: Ptr CKeymap -> IO CLayoutIndex + +-- xkb_layout_index_t xkb_keymap::xkb_keymap_num_layouts_for_key (struct xkb_keymap *keymap, xkb_keycode_t key) +-- Get the number of layouts for a specific key. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keymap_num_layouts_for_key" + c_keymap_num_layouts_key :: Ptr CKeymap -> CKeycode -> IO CLayoutIndex + +-- xkb_level_index_t xkb_keymap::xkb_keymap_num_levels_for_key (struct xkb_keymap *keymap, xkb_keycode_t key, xkb_layout_index_t layout) +-- Get the number of shift levels for a specific key and layout. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keymap_num_levels_for_key" + c_keymap_num_levels :: Ptr CKeymap -> CKeycode -> CLayoutIndex -> IO CLevelIndex + +-- int xkb_keymap::xkb_keymap_key_get_syms_by_level (struct xkb_keymap *keymap, xkb_keycode_t key, xkb_layout_index_t layout, xkb_level_index_t level, const xkb_keysym_t **syms_out) +-- Get the keysyms obtained from pressing a key in a given layout and shift level. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keymap_key_get_syms_by_level" + c_keymap_syms_by_level :: Ptr CKeymap -> CKeycode -> CLayoutIndex -> CLevelIndex -> Ptr (Ptr CKeysym) -> IO CInt + +-- xkb_led_index_t xkb_keymap::xkb_keymap_num_leds (struct xkb_keymap *keymap) +-- Get the number of LEDs in the keymap. More... +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keymap_num_leds" + c_keymap_num_leds :: Ptr CKeymap -> IO CLedIndex + +-- const char * xkb_keymap::xkb_keymap_led_get_name (struct xkb_keymap *keymap, xkb_led_index_t idx) +-- Get the name of a LED by index. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keymap_led_get_name" + c_keymap_led_name :: Ptr CKeymap -> CLedIndex -> IO CString + +-- int xkb_keymap::xkb_keymap_key_repeats (struct xkb_keymap *keymap, xkb_keycode_t key) +-- Determine whether a key should repeat or not. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keymap_key_repeats" + c_keymap_key_repeats :: Ptr CKeymap -> CKeycode -> IO CInt + diff --git a/Text/XkbCommon/Keysym.hsc b/Text/XkbCommon/Keysym.hsc new file mode 100644 --- /dev/null +++ b/Text/XkbCommon/Keysym.hsc @@ -0,0 +1,82 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface #-} + +module Text.XkbCommon.Keysym + ( keysymFromName, keysymFromNameCaseInsensitive, keysymName, keysymUtf8 + ) where + +import Foreign +import Foreign.C +import Foreign.Marshal.Array (peekArray0) +import Data.Text (unpack) +import Data.Text.Encoding (decodeUtf8) +import Data.ByteString (ByteString, pack) +import System.IO.Unsafe as S +import Control.Monad (liftM) + +import Text.XkbCommon.InternalTypes + +#include + + +-- | Get a keysym from its name (case sensitive). +-- (@xkb_keysym_from_name@) +keysymFromName :: String -> Maybe Keysym +keysymFromName str = S.unsafePerformIO $ withCString str $ \ cstr -> + liftM safeToKeysym $ c_keysym_from_name cstr 0 -- 0 means search case sensitive. alternative is #{const XKB_KEYSYM_CASE_INSENSITIVE} + +-- | Get a keysym from its name (case insensitive). +-- (@xkb_keysym_from_name@) +keysymFromNameCaseInsensitive :: String -> Maybe Keysym +keysymFromNameCaseInsensitive str = S.unsafePerformIO $ withCString str $ \ cstr -> + liftM safeToKeysym $ c_keysym_from_name cstr #{const XKB_KEYSYM_CASE_INSENSITIVE} + +-- | Get the ASCII name of a keysym. (@xkb_keysym_get_name@) +keysymName :: Keysym -> String +keysymName ks = S.unsafePerformIO $ do + -- build 64-byte buffer and pass + let buflen = 64 + withCString (replicate buflen ' ') $ \ cstr -> do + len <- c_keysym_name (fromKeysym ks) cstr (fromIntegral buflen) + return =<< peekCString cstr + +-- | Get the on-screen representation of a keysym. +-- (uses @xkb_keysym_to_utf8@, but always encodes to haskell String) +keysymUtf8 :: Keysym -> String +keysymUtf8 ks = S.unsafePerformIO $ do + let buflen = 64 + withCString (replicate buflen ' ') $ \ cstr -> do + len <- c_keysym_utf8_name (fromKeysym ks) cstr (fromIntegral buflen) + bs <- charPtrToByteString0 cstr + return $ unpack $ decodeUtf8 bs + + +-- unsafely marshal zero-terminated char* to ByteString +charPtrToByteString0 :: Ptr CChar -> IO ByteString +charPtrToByteString0 ptr = do + array <- peekArray0 0 ptr + return $ pack $ map fromIntegral array + + +-- int xkb_keysym_get_name (xkb_keysym_t keysym, char *buffer, size_t size) +-- Get the name of a keysym. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keysym_get_name" + c_keysym_name :: CKeysym -> CString -> #{type size_t} -> IO CInt + +-- xkb_keysym_t xkb_keysym_from_name (const char *name, enum xkb_keysym_flags flags) +-- Get a keysym from its name. +-- second argument is always XKB_KEYSYM_CASE_INSENSITIVE +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keysym_from_name" + c_keysym_from_name :: CString -> CInt -> IO CKeysym + +-- below functions aren't bound yet. + +-- int xkb_keysym_to_utf8 (xkb_keysym_t keysym, char *buffer, size_t size) +-- Get the Unicode/UTF-8 representation of a keysym. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keysym_to_utf8" + c_keysym_utf8_name :: CKeysym -> CString -> #{type size_t} -> IO CInt + +-- uint32_t xkb_keysym_to_utf32 (xkb_keysym_t keysym) +-- Get the Unicode/UTF-32 representation of a keysym. +foreign import ccall unsafe "xkbcommon/xkbcommon.h xkb_keysym_to_utf32" + c_keysym_utf32_name :: CKeysym -> #{type uint32_t} + diff --git a/Text/XkbCommon/KeysymList.hs b/Text/XkbCommon/KeysymList.hs new file mode 100644 --- /dev/null +++ b/Text/XkbCommon/KeysymList.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Text.XkbCommon.KeysymList where + +import Language.Haskell.TH + +import Text.XkbCommon.ParseDefines +import Text.XkbCommon.InternalTypes + +-- TH magic from ParseDefines: +$(runIO genKeysyms >>= return) diff --git a/Text/XkbCommon/ModList.hs b/Text/XkbCommon/ModList.hs new file mode 100644 --- /dev/null +++ b/Text/XkbCommon/ModList.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Text.XkbCommon.ModList where + +import Language.Haskell.TH + +import Text.XkbCommon.ParseDefines + +-- TH magic from ParseDefines: +$(runIO genModnames >>= return) diff --git a/Text/XkbCommon/ParseDefines.hs b/Text/XkbCommon/ParseDefines.hs new file mode 100644 --- /dev/null +++ b/Text/XkbCommon/ParseDefines.hs @@ -0,0 +1,58 @@ +module Text.XkbCommon.ParseDefines + ( readHeader, genKeysyms, genKeycodes, genModnames ) where + +import Language.Haskell.TH +import Language.Preprocessor.Cpphs +import System.Process +import Data.List +import Data.Maybe (isJust) +import Data.Text (pack, unpack, toLower) +import Control.Arrow + +-- this function calls the c preprocessor to find out what the full path to a header file is. +readHeader :: String -> IO (String, String) +readHeader str = do + cpp_out <- readProcess "cpp" [] ("#include<" ++ str ++ ">") + -- parse output: + let headerfile = read $ head $ map ((!! 2) . words) (filter (isInfixOf str) $ lines cpp_out) + header <- readFile headerfile + return (headerfile, header) + +genKeysyms :: IO [Dec] +genKeysyms = do + (headerFilename, keysyms_header) <- readHeader "xkbcommon/xkbcommon-keysyms.h" + (_, defs) <- macroPassReturningSymTab [] defaultBoolOptions [(newfile headerFilename, keysyms_header)] + let exclude_defs = ["XKB_KEY_VoidSymbol", "XKB_KEY_NoSymbol"] + let filtered_defs = filter (\ (name, _) -> isPrefixOf "XKB_KEY" name && notElem name exclude_defs) defs + let parsed_defs = map (drop 8 *** read) filtered_defs + return $ map (\ (name, val) -> ValD (VarP $ mkName ("keysym_" ++ name)) (NormalB (AppE (VarE $ mkName "toKeysym") (AppE (ConE $ mkName "CKeysym") $ LitE (IntegerL val)))) []) parsed_defs + +genKeycodes :: IO [Dec] +-- genKeycodes = return [] +genKeycodes = do + (headerFilename, keysyms_header) <- readHeader "linux/input.h" + (_, defs) <- macroPassReturningSymTab [] defaultBoolOptions [(newfile headerFilename, keysyms_header)] + let exclude_defs = [] + let filtered_defs = filter (\ (name, val) -> isPrefixOf "KEY_" name && notElem name exclude_defs && isJust (maybeRead val :: Maybe Int)) defs + let parsed_defs = map (drop 4 *** read) filtered_defs + return $ map (\ (name, val) -> ValD (VarP $ mkName ("keycode_" ++ lowerCase name)) (NormalB (AppE (ConE $ mkName "CKeycode") $ LitE (IntegerL (8 + val)))) []) parsed_defs + +genModnames :: IO [Dec] +-- genKeycodes = return [] +genModnames = do + (headerFilename, keysyms_header) <- readHeader "xkbcommon/xkbcommon-names.h" + (_, defs) <- macroPassReturningSymTab [] defaultBoolOptions [(newfile headerFilename, keysyms_header)] + let exclude_defs = [] + let mod_defs = filter (\ (name, val) -> isPrefixOf "XKB_MOD_" name && notElem name exclude_defs && isJust (maybeRead val :: Maybe String)) defs + let led_defs = filter (\ (name, val) -> isPrefixOf "XKB_LED_" name && notElem name exclude_defs && isJust (maybeRead val :: Maybe String)) defs + let parsed_mods = map ((\ name -> "modname_" ++ lowerCase (drop 13 name)) *** read) mod_defs + let parsed_leds = map ((\ name -> "ledname_" ++ lowerCase (drop 13 name)) *** read) led_defs + return $ map (\ (name, val) -> ValD (VarP $ mkName name) (NormalB (LitE (StringL val))) []) (parsed_mods ++ parsed_leds) + +maybeRead :: Read a => String -> Maybe a +maybeRead s = case reads s of + [(x, "")] -> Just x + _ -> Nothing + +lowerCase :: String -> String +lowerCase = unpack . toLower . pack diff --git a/Text/XkbCommon/Types.hs b/Text/XkbCommon/Types.hs new file mode 100644 --- /dev/null +++ b/Text/XkbCommon/Types.hs @@ -0,0 +1,12 @@ +module Text.XkbCommon.Types + ( Direction, keyUp, keyDown, + + CLogLevel, CKeycode(..), CLayoutIndex(..), CModIndex(..), CLevelIndex(..), + CLedIndex(..), Keysym(..), StateComponent, CModMask(..), + + stateModDepressed, stateModLatched, stateModLocked, stateModEffective, + stateLayoutDepressed, stateLayoutLatched, stateLayoutLocked, + stateLayoutEffective, stateLeds, + ) where + +import Text.XkbCommon.InternalTypes diff --git a/tests/Common.hs b/tests/Common.hs new file mode 100644 --- /dev/null +++ b/tests/Common.hs @@ -0,0 +1,46 @@ +module Common (assert, datadir, getTestContext, KeyDirections(..), testKeySeq, ks) where + +import Data.Maybe +import Control.Monad + +import Text.XkbCommon + +assert :: Bool -> String -> IO () +assert False str = ioError (userError str) +assert _ _ = return () + +datadir = "data/" + +getTestContext :: IO Context +getTestContext = do + ctx <- liftM fromJust $ newContext pureFlags + appendIncludePath ctx datadir + return ctx + +data KeyDirections = Down | Up | Both | Repeat deriving (Show, Eq) + +testKeySeq :: Keymap -> [(CKeycode, KeyDirections, Keysym)] -> IO [()] +testKeySeq km tests = do + st <- newKeyboardState km + return =<< mapM (testOne st) (zip tests [1..]) where + testOne st ((kc, dir, ks),n) = do + syms <- getStateSyms st kc + + when (dir == Down || dir == Both) $ void (updateKeyboardStateKey st kc keyDown) + when (dir == Up || dir == Both) $ void (updateKeyboardStateKey st kc keyUp) + + -- in this test, we always get exactly one keysym + assert (length syms == 1) "did not get right amount of keysyms" + + assert (head syms == ks) ("did not get correct keysym " ++ show ks + ++ " for keycode " ++ show kc + ++ ", got " ++ show (head syms) + ++ " in test " ++ show n) + + -- this probably doesn't do anything since if we came this far, head syms == ks + assert (keysymName (head syms) == keysymName ks) ("keysym names differ: " ++ keysymName (head syms) ++ " and " ++ keysymName ks) + putStrLn $ keysymName ks + return () + + +ks = fromJust.keysymFromName diff --git a/tests/bench-key-proc.hs b/tests/bench-key-proc.hs new file mode 100644 --- /dev/null +++ b/tests/bench-key-proc.hs @@ -0,0 +1,39 @@ +import Data.Maybe +import qualified Data.Vector.Unboxed as V +import Control.Monad +import System.Random +import Data.Time.Clock + +import Text.XkbCommon + +import Common + +benchmarkIterations = 20000000 + +--updateHead :: a -> V.Vector a -> V.Vector a +--updateHead a xs = a:V.tail xs +--update i a xs = V.take i xs ++ updateHead a (V.drop i xs) + +update i a xs = xs V.// [(i,a)] + +bench :: KeyboardState -> Int -> V.Vector Bool -> IO () +bench st n keys = unless (n == 0) $ do + rand <- getStdRandom (randomR (9,255)) + updateKeyboardStateKey st (CKeycode $ fromIntegral rand) + (if keys V.! rand then keyUp else keyDown) + return =<< bench st (n-1) $ Main.update rand (not $ keys V.! rand) keys -- keys // [(rand,(not $ keys V.! rand))] + +main = do + start <- getCurrentTime + + ctx <- getTestContext + km <- liftM fromJust $ newKeymapFromNames ctx (RMLVO (Just "evdev") (Just "pc104") (Just "us,ru,il,de") (Just ",,,neo") (Just "grp:menu_toggle")) + st <- newKeyboardState km + + bench st benchmarkIterations (V.replicate 256 False) + + end <- getCurrentTime + + putStrLn $ "bench-key-proc took " ++ show (diffUTCTime end start) + + return () diff --git a/tests/context.hs b/tests/context.hs new file mode 100644 --- /dev/null +++ b/tests/context.hs @@ -0,0 +1,16 @@ +import Data.Maybe +import Control.Monad + +import Text.XkbCommon + +import Common + +main = do + ctx <- liftM fromJust $ newContext pureFlags + + appendIncludePath ctx "data/" + num <- numIncludePaths ctx + assert (num == 1) "did not find data/ dir" + appendIncludePath ctx "¡NONSENSE!" + num <- numIncludePaths ctx + assert (num == 1) "loaded nonsene dir" diff --git a/tests/filecomp.hs b/tests/filecomp.hs new file mode 100644 --- /dev/null +++ b/tests/filecomp.hs @@ -0,0 +1,26 @@ +import Control.Monad +import Data.Maybe +import Data.Functor + +import Text.XkbCommon + +import Common + +xor :: Bool -> Bool -> Bool +xor x y = (x || y) && not (x && y) + +testFile :: Context -> String -> Bool -> IO () +testFile ctx path shouldwork = do + str <- readFile (datadir++path) + let keymap = newKeymapFromString ctx str + assert (shouldwork `xor` isNothing keymap) "file load failure" + +main = do + ctx <- getTestContext + mapM_ (\ path -> testFile ctx path True) [ + "keymaps/basic.xkb", + "keymaps/comprehensive-plus-geom.xkb", + "keymaps/no-types.xkb"] + mapM_ (\ path -> testFile ctx path False) [ + "keymaps/divide-by-zero.xkb", + "keymaps/bad.xkb"] diff --git a/tests/keyseq.hs b/tests/keyseq.hs new file mode 100644 --- /dev/null +++ b/tests/keyseq.hs @@ -0,0 +1,306 @@ +import Control.Monad +import Data.Maybe + +import Text.XkbCommon +import Text.XkbCommon.Constants +import Text.XkbCommon.KeycodeList + +import Common + + +main = do + ctx <- getTestContext + km <- liftM fromJust $ newKeymapFromNames ctx (RMLVO + (Just "evdev") + (Just "evdev") + (Just "us,il,ru,de") + (Just ",,phonetic,neo") + (Just "grp:alt_shift_toggle,grp:menu_toggle")) + + testKeySeq km [ + (keycode_h, Both, keysym_h), + (keycode_e, Both, keysym_e), + (keycode_l, Both, keysym_l), + (keycode_l, Both, keysym_l), + (keycode_o, Both, keysym_o)] + testKeySeq km [ + (keycode_h, Both, keysym_h), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_e, Both, keysym_E), + (keycode_l, Both, keysym_L), + (keycode_leftshift, Up, keysym_Shift_L), + (keycode_l, Both, keysym_l), + (keycode_o, Both, keysym_o)] + testKeySeq km [ + (keycode_h, Down, keysym_h), + (keycode_h, Repeat, keysym_h), + (keycode_h, Repeat, keysym_h), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_h, Repeat, keysym_H), + (keycode_h, Repeat, keysym_H), + (keycode_leftshift, Up, keysym_Shift_L), + (keycode_h, Repeat, keysym_h), + (keycode_h, Repeat, keysym_h), + (keycode_h, Up, keysym_h), + (keycode_h, Both, keysym_h)] + testKeySeq km [ + (keycode_h, Both, keysym_h), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_e, Both, keysym_E), + (keycode_l, Both, keysym_L), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_l, Both, keysym_L), + (keycode_o, Both, keysym_O)] + testKeySeq km [ + (keycode_h, Both, keysym_h), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_e, Both, keysym_E), + (keycode_l, Both, keysym_L), + (keycode_rightshift, Up, keysym_Shift_R), + (keycode_l, Both, keysym_L), + (keycode_o, Both, keysym_O)] + testKeySeq km [ + (keycode_h, Both, keysym_h), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_e, Both, keysym_E), + (keycode_rightshift, Down, keysym_Shift_R), + (keycode_l, Both, keysym_L), + (keycode_rightshift, Up, keysym_Shift_R), + (keycode_l, Both, keysym_L), + (keycode_leftshift, Up, keysym_Shift_L), + (keycode_o, Both, keysym_o)] + testKeySeq km [ + (keycode_h, Both, keysym_h), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_h, Both, keysym_H), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_h, Both, keysym_H), + (keycode_leftshift, Up, keysym_Shift_L), + (keycode_h, Both, keysym_H), + (keycode_leftshift, Up, keysym_Shift_L), + (keycode_h, Both, keysym_h)] + testKeySeq km [ + (keycode_h, Both, keysym_h), + (keycode_capslock, Down, keysym_Caps_Lock), + (keycode_h, Both, keysym_H), + (keycode_capslock, Down, keysym_Caps_Lock), + (keycode_h, Both, keysym_H), + (keycode_capslock, Up, keysym_Caps_Lock), + (keycode_h, Both, keysym_H), + (keycode_capslock, Up, keysym_Caps_Lock), + (keycode_h, Both, keysym_H), + (keycode_capslock, Both, keysym_Caps_Lock), + (keycode_h, Both, keysym_h)] + testKeySeq km [ + (keycode_h, Both, keysym_h), + (keycode_e, Both, keysym_e), + (keycode_compose, Both, keysym_ISO_Next_Group), + (keycode_k, Both, keysym_hebrew_lamed), + (keycode_f, Both, keysym_hebrew_kaph), + (keycode_compose, Both, keysym_ISO_Next_Group), + (keycode_compose, Both, keysym_ISO_Next_Group), + (keycode_compose, Both, keysym_ISO_Next_Group), + (keycode_o, Both, keysym_o)] + testKeySeq km [ + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_leftalt, Down, keysym_ISO_Next_Group), + (keycode_leftalt, Up, keysym_ISO_Next_Group), + (keycode_leftshift, Up, keysym_Shift_L)] + testKeySeq km [ + (keycode_leftalt, Down, keysym_Alt_L), + (keycode_leftshift, Down, keysym_ISO_Next_Group), + (keycode_leftshift, Up, keysym_ISO_Next_Group), + (keycode_leftalt, Up, keysym_Alt_L)] + testKeySeq km [ + (keycode_capslock, Both, keysym_Caps_Lock), + (keycode_h, Both, keysym_H), + (keycode_e, Both, keysym_E), + (keycode_l, Both, keysym_L), + (keycode_l, Both, keysym_L), + (keycode_o, Both, keysym_O)] + testKeySeq km [ + (keycode_h, Both, keysym_h), + (keycode_e, Both, keysym_e), + (keycode_capslock, Both, keysym_Caps_Lock), + (keycode_l, Both, keysym_L), + (keycode_l, Both, keysym_L), + (keycode_capslock, Both, keysym_Caps_Lock), + (keycode_o, Both, keysym_o)] + testKeySeq km [ + (keycode_h, Both, keysym_h), + (keycode_capslock, Down, keysym_Caps_Lock), + (keycode_e, Both, keysym_E), + (keycode_l, Both, keysym_L), + (keycode_l, Both, keysym_L), + (keycode_capslock, Up, keysym_Caps_Lock), + (keycode_o, Both, keysym_O)] + testKeySeq km [ + (keycode_h, Both, keysym_h), + (keycode_e, Both, keysym_e), + (keycode_capslock, Up, keysym_Caps_Lock), + (keycode_l, Both, keysym_l), + (keycode_l, Both, keysym_l), + (keycode_o, Both, keysym_o)] + testKeySeq km [ + (keycode_kp1, Both, keysym_KP_End), + (keycode_numlock, Both, keysym_Num_Lock), + (keycode_kp1, Both, keysym_KP_1), + (keycode_kp2, Both, keysym_KP_2), + (keycode_numlock, Both, keysym_Num_Lock), + (keycode_kp2, Both, keysym_KP_Down)] + testKeySeq km [ + (keycode_compose, Both, keysym_ISO_Next_Group), + (keycode_compose, Both, keysym_ISO_Next_Group), + (keycode_1, Both, keysym_1), + (keycode_q, Both, keysym_Cyrillic_ya), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_1, Both, keysym_exclam), + (keycode_q, Both, keysym_Cyrillic_YA), + (keycode_leftshift, Up, keysym_Shift_L), + (keycode_v, Both, keysym_Cyrillic_zhe), + (keycode_capslock, Both, keysym_Caps_Lock), + (keycode_1, Both, keysym_1), + (keycode_v, Both, keysym_Cyrillic_ZHE), + (keycode_rightshift, Down, keysym_Shift_R), + (keycode_v, Both, keysym_Cyrillic_zhe), + (keycode_rightshift, Up, keysym_Shift_R), + (keycode_v, Both, keysym_Cyrillic_ZHE)] + testKeySeq km [ + (keycode_compose, Both, keysym_ISO_Next_Group), + (keycode_compose, Both, keysym_ISO_Next_Group), + (keycode_compose, Both, keysym_ISO_Next_Group), + (keycode_1, Both, keysym_1), + (keycode_q, Both, keysym_x), + (keycode_kp7, Both, keysym_KP_7), + (keycode_esc, Both, keysym_Escape), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_1, Both, keysym_degree), + (keycode_q, Both, keysym_X), + (keycode_kp7, Both, ks "U2714"), + (keycode_esc, Both, keysym_Escape), + (keycode_leftshift, Up, keysym_Caps_Lock), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_rightshift, Both, keysym_Caps_Lock), + (keycode_leftshift, Up, keysym_Caps_Lock), + (keycode_6, Both, keysym_6), + (keycode_h, Both, keysym_S), + (keycode_kp3, Both, keysym_KP_3), + (keycode_esc, Both, keysym_Escape), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_rightshift, Both, keysym_Caps_Lock), + (keycode_leftshift, Up, keysym_Caps_Lock), + (keycode_capslock, Down, keysym_ISO_Level3_Shift), + (keycode_6, Both, keysym_cent), + (keycode_q, Both, keysym_ellipsis), + (keycode_kp7, Both, ks "U2195"), + (keycode_esc, Both, keysym_Escape), + (keycode_capslock, Up, keysym_ISO_Level3_Shift), + (keycode_capslock, Down, keysym_ISO_Level3_Shift), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_5, Both, keysym_malesymbol), + (keycode_e, Both, keysym_Greek_lambda), + (keycode_space, Both, keysym_nobreakspace), + (keycode_kp8, Both, keysym_intersection), + (keycode_esc, Both, keysym_Escape), + (keycode_leftshift, Up, keysym_Caps_Lock), + (keycode_capslock, Up, keysym_ISO_Level3_Shift), + (keycode_rightalt, Down, keysym_ISO_Level5_Shift), + (keycode_5, Both, keysym_periodcentered), + (keycode_e, Both, keysym_Up), + (keycode_space, Both, keysym_KP_0), + (keycode_kp8, Both, keysym_KP_Up), + (keycode_esc, Both, keysym_Escape), + (keycode_rightalt, Up, keysym_ISO_Level5_Shift), + (keycode_v, Both, keysym_p)] + + km2 <- liftM fromJust $ newKeymapFromNames ctx (RMLVO + (Just "evdev") + (Just "") + (Just "us,il,ru") + (Just "") + (Just "grp:alt_shift_toggle_bidir,grp:menu_toggle")) + + testKeySeq km2 [ + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_leftalt, Down, keysym_ISO_Prev_Group), + (keycode_leftalt, Up, keysym_ISO_Prev_Group), + (keycode_leftshift, Up, keysym_Shift_L)] + + testKeySeq km2 [ + (keycode_leftalt, Down, keysym_Alt_L), + (keycode_leftshift, Down, keysym_ISO_Prev_Group), + (keycode_leftshift, Up, keysym_ISO_Prev_Group), + (keycode_leftalt, Up, keysym_Alt_L)] + + testKeySeq km2 [ + (keycode_h, Both, keysym_h), + (keycode_compose, Both, keysym_ISO_Next_Group), + (keycode_h, Both, keysym_hebrew_yod), + (keycode_compose, Both, keysym_ISO_Next_Group), + (keycode_h, Both, keysym_Cyrillic_er), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_leftalt, Both, keysym_ISO_Prev_Group), + (keycode_leftshift, Up, keysym_Shift_L), + (keycode_h, Both, keysym_hebrew_yod), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_leftalt, Both, keysym_ISO_Prev_Group), + (keycode_leftshift, Up, keysym_Shift_L), + (keycode_h, Both, keysym_h), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_leftalt, Both, keysym_ISO_Prev_Group), + (keycode_leftshift, Up, keysym_Shift_L), + (keycode_h, Both, keysym_Cyrillic_er), + (keycode_compose, Both, keysym_ISO_Next_Group), + (keycode_h, Both, keysym_h)] + + km3 <- liftM fromJust $ newKeymapFromNames ctx (RMLVO + (Just "evdev") + (Just "") + (Just "us,il,ru") + (Just "") + (Just "grp:switch,grp:lswitch,grp:menu_toggle")) + + testKeySeq km3 [ + (keycode_h, Both, keysym_h), + (keycode_rightalt, Down, keysym_Mode_switch), + (keycode_h, Both, keysym_hebrew_yod), + (keycode_rightalt, Up, keysym_ISO_Level3_Shift), + (keycode_h, Both, keysym_h), + (keycode_rightalt, Down, keysym_Mode_switch), + (keycode_h, Both, keysym_hebrew_yod), + (keycode_rightalt, Up, keysym_ISO_Level3_Shift), + (keycode_h, Both, keysym_h)] + + testKeySeq km3 [ + (keycode_h, Both, keysym_h), + (keycode_compose, Both, keysym_ISO_Next_Group), + (keycode_leftalt, Down, keysym_Mode_switch), + (keycode_h, Both, keysym_Cyrillic_er), + (keycode_leftalt, Up, keysym_Mode_switch), + (keycode_h, Both, keysym_hebrew_yod), + (keycode_compose, Both, keysym_ISO_Next_Group), + (keycode_leftalt, Down, keysym_Mode_switch), + (keycode_h, Both, keysym_h), + (keycode_leftalt, Up, keysym_Mode_switch), + (keycode_h, Both, keysym_Cyrillic_er), + (keycode_compose, Both, keysym_ISO_Next_Group), + (keycode_h, Both, keysym_h), + (keycode_rightalt, Down, keysym_Mode_switch), + (keycode_h, Both, keysym_hebrew_yod), + (keycode_leftalt, Down, keysym_Mode_switch), + (keycode_h, Both, keysym_Cyrillic_er), + (keycode_leftalt, Up, keysym_Mode_switch), + (keycode_h, Both, keysym_hebrew_yod), + (keycode_rightalt, Up, keysym_ISO_Level3_Shift), + (keycode_h, Both, keysym_h)] + + kmFile <- readFile (datadir++"keymaps/unbound-vmod.xkb") + let km4 = fromJust $ newKeymapFromString ctx kmFile + + testKeySeq km4 [ + (keycode_h, Both, keysym_h), + (keycode_z, Both, keysym_y), + (keycode_minus, Both, keysym_ssharp), + (keycode_z, Both, keysym_y)] + + return () diff --git a/tests/keysym.hs b/tests/keysym.hs new file mode 100644 --- /dev/null +++ b/tests/keysym.hs @@ -0,0 +1,97 @@ +import Control.Monad +import Data.Maybe + +import Text.XkbCommon +import Text.XkbCommon.KeysymList + +import Common + +testString :: String -> Maybe Keysym -> IO () +testString str ck = do + print $ keysymFromName str + assert (keysymFromName str == ck) ("Name " ++ str ++ " returned " ++ + show (keysymFromName str) ++" instead of expected keysym " ++ show ck) + +testCaselessString :: String -> Maybe Keysym -> IO () +testCaselessString str ck = assert (keysymFromNameCaseInsensitive str == ck) ("Caseless name " ++ str ++ " returned " ++ + show (keysymFromNameCaseInsensitive str) ++" instead of expected keysym " ++ show ck) + +testKeysym :: Keysym -> String -> IO () +testKeysym ks str = assert (keysymName ks == str) ("Keysym name " ++ keysymName ks ++ + " for keysym " ++ show ks ++ " did not match expected value " ++ str) + +testUtf8 :: Keysym -> String -> IO () +testUtf8 ks str = do + print $ keysymUtf8 ks + assert (keysymUtf8 ks == str) ("Keysym " ++ keysymUtf8 ks ++ + " for " ++ show ks ++ " did not match expected value " ++ str) + +main = do + testString "Undo" (Just $ Keysym 0xFF65) + testString "ThisKeyShouldNotExist" Nothing + testString "XF86_Switch_VT_5" (Just $ Keysym 0x1008FE05) + testString "VoidSymbol" (Just $ Keysym 0xFFFFFF) + testString "U4567" (Just $ Keysym 0x1004567) + testString "0x10203040" (Just $ Keysym 0x10203040) + testString "a" (Just $ Keysym 0x61) + testString "A" (Just $ Keysym 0x41) + testString "ch" (Just $ Keysym 0xfea0) + testString "Ch" (Just $ Keysym 0xfea1) + testString "CH" (Just $ Keysym 0xfea2) + testString "THORN" (Just $ Keysym 0x00de) + testString "Thorn" (Just $ Keysym 0x00de) + testString "thorn" (Just $ Keysym 0x00fe) + + testKeysym (Keysym 0x1008FF56) "XF86Close" + testKeysym (Keysym 0x1008FE20) "XF86Ungrab" + testKeysym (Keysym 0x01001234) "U1234" + testKeysym (Keysym 0x010002DE) "U02DE" + testKeysym (Keysym 0x0101F4A9) "U0001F4A9" + + testCaselessString "Undo" (Just $ Keysym 0xFF65) + testCaselessString "UNDO" (Just $ Keysym 0xFF65) + testCaselessString "A" (Just $ Keysym 0x61) + testCaselessString "a" (Just $ Keysym 0x61) + testCaselessString "ThisKeyShouldNotExist" Nothing + testCaselessString "XF86_Switch_vT_5" (Just $ Keysym 0x1008FE05) + testCaselessString "xF86_SwitcH_VT_5" (Just $ Keysym 0x1008FE05) + testCaselessString "xF86SwiTch_VT_5" (Just $ Keysym 0x1008FE05) + testCaselessString "xF86Switch_vt_5" (Just $ Keysym 0x1008FE05) + testCaselessString "VoidSymbol" (Just $ Keysym 0xFFFFFF) + testCaselessString "vOIDsymBol" (Just $ Keysym 0xFFFFFF) + testCaselessString "U4567" (Just $ Keysym 0x1004567) + testCaselessString "u4567" (Just $ Keysym 0x1004567) + testCaselessString "0x10203040" (Just $ Keysym 0x10203040) + testCaselessString "0X10203040" (Just $ Keysym 0x10203040) + testCaselessString "THORN" (Just $ Keysym 0x00fe) + testCaselessString "Thorn" (Just $ Keysym 0x00fe) + testCaselessString "thorn" (Just $ Keysym 0x00fe) + + testUtf8 keysym_y "y" + testUtf8 keysym_u "u" + testUtf8 keysym_m "m" + testUtf8 keysym_Cyrillic_em "м" + testUtf8 keysym_Cyrillic_u "у" + testUtf8 keysym_exclam "!" + testUtf8 keysym_oslash "ø" + testUtf8 keysym_hebrew_aleph "א" + testUtf8 keysym_Arabic_sheen "ش" + + testUtf8 keysym_space " " + testUtf8 keysym_KP_Space " " + testUtf8 keysym_BackSpace "\b" + --testUtf8 keysym_Escape "\033" + testUtf8 keysym_KP_Separator "," + testUtf8 keysym_KP_Decimal "." + testUtf8 keysym_Tab "\t" + testUtf8 keysym_KP_Tab "\t" + testUtf8 keysym_hyphen "\173" -- "­" + testUtf8 keysym_Linefeed "\n" + testUtf8 keysym_Return "\r" + testUtf8 keysym_KP_Enter "\r" + testUtf8 keysym_KP_Equal "=" + testUtf8 keysym_9 "9" + testUtf8 keysym_KP_9 "9" + testUtf8 keysym_KP_Multiply "*" + testUtf8 keysym_KP_Subtract "-" + diff --git a/tests/rulescomp.hs b/tests/rulescomp.hs new file mode 100644 --- /dev/null +++ b/tests/rulescomp.hs @@ -0,0 +1,163 @@ +import Control.Monad +import Data.Maybe +import Data.Functor +import System.Posix.Env + +import Text.XkbCommon +import Text.XkbCommon.Constants +import Text.XkbCommon.KeycodeList + +import Common + + +setRmlvoEnv :: RMLVO -> IO () +setRmlvoEnv rmlvo = do + procEnv "XKB_DEFAULT_RULES" rules + procEnv "XKB_DEFAULT_MODEL" model + procEnv "XKB_DEFAULT_LAYOUT" layout + procEnv "XKB_DEFAULT_VARIANT" variant + procEnv "XKB_DEFAULT_OPTIONS" options + where + procEnv :: String -> (RMLVO -> Maybe String) -> IO () + procEnv envName getter = case getter rmlvo of + Just x -> setEnv envName x True + Nothing -> unsetEnv envName + +main = do + ctx <- getTestContext + envCtx <- liftM fromJust $ newContext contextNoDefaultIncludes + appendIncludePath envCtx datadir + setRmlvoEnv noPrefs + + km <- liftM fromJust $ newKeymapFromNames ctx (RMLVO + (Just "evdev") + (Just "pc105") + (Just "us,il,ru,ca") + (Just ",,,multix") + (Just "grp:alts_toggle,ctrl:nocaps,compose:rwin")) + testKeySeq km [ + (keycode_q, Both, keysym_q), + (keycode_leftalt, Down, keysym_Alt_L), + (keycode_rightalt, Down, keysym_ISO_Next_Group), + (keycode_rightalt, Up, keysym_ISO_Level3_Shift), + (keycode_leftalt, Up, keysym_Alt_L), + (keycode_q, Both, keysym_slash), + (keycode_leftshift, Down, keysym_Shift_L), + (keycode_q, Both, keysym_Q), + (keycode_rightmeta, Both, keysym_Multi_key)] + + km <- liftM fromJust $ newKeymapFromNames ctx (RMLVO + (Just "evdev") + (Just "pc105") + (Just "us,in") + Nothing + (Just "grp:alts_toggle")) + testKeySeq km [ + (keycode_a, Both, keysym_a), + (keycode_leftalt, Down, keysym_Alt_L), + (keycode_rightalt, Down, keysym_ISO_Next_Group), + (keycode_rightalt, Up, keysym_ISO_Level3_Shift), + (keycode_leftalt, Up, keysym_Alt_L), + (keycode_a, Both, ks "U094b")] + + km <- liftM fromJust $ newKeymapFromNames ctx (RMLVO + (Just "evdev") + (Just "pc105") + (Just "us") + (Just "intl") + Nothing) + testKeySeq km [ + (keycode_grave, Both, keysym_dead_grave)] + + km <- liftM fromJust $ newKeymapFromNames ctx (RMLVO + (Just "evdev") + (Just "pc105") + (Just "us") + (Just "intl") + (Just "grp:alts_toggle")) + testKeySeq km [ + (keycode_grave, Both, keysym_dead_grave)] + + km <- liftM fromJust $ newKeymapFromNames ctx (RMLVO + (Just "evdev") + Nothing + (Just "us:20") + Nothing + Nothing) + testKeySeq km [ + (keycode_a, Both, keysym_a)] + + km <- liftM fromJust $ newKeymapFromNames ctx (RMLVO + (Just "evdev") + Nothing + (Just "us,,ca") + Nothing + (Just "grp:alts_toggle")) + testKeySeq km [ + (keycode_a, Both, keysym_a), + (keycode_leftalt, Down, keysym_Alt_L), + (keycode_rightalt, Down, keysym_ISO_Next_Group), + (keycode_rightalt, Up, keysym_ISO_Next_Group), + (keycode_leftalt, Up, keysym_Alt_L), + (keycode_leftalt, Down, keysym_Alt_L), + (keycode_rightalt, Down, keysym_ISO_Next_Group), + (keycode_rightalt, Up, keysym_ISO_Level3_Shift), + (keycode_leftalt, Up, keysym_Alt_L), + (keycode_apostrophe, Both, keysym_dead_grave)] + + km <- liftM fromJust $ newKeymapFromNames ctx noPrefs + testKeySeq km [ + (keycode_a, Both, keysym_a)] + + km <- newKeymapFromNames ctx (RMLVO + (Just "does-not-exist") + Nothing + Nothing + Nothing + Nothing) + assert (isNothing km) "compiled nonexistent keymap" + + setRmlvoEnv (RMLVO + (Just "evdev") + Nothing + (Just "us") + Nothing + Nothing) + km <- liftM fromJust $ newKeymapFromNames envCtx noPrefs + testKeySeq km [ + (keycode_a, Both, keysym_a)] + + setRmlvoEnv (RMLVO + (Just "evdev") + Nothing + (Just "us") + Nothing + (Just "ctrl:nocaps")) + km <- liftM fromJust $ newKeymapFromNames envCtx noPrefs + testKeySeq km [ + (keycode_capslock, Both, keysym_Control_L)] + + setRmlvoEnv (RMLVO + (Just "evdev") + Nothing + (Just "us,ca") + (Just ",,,multix") + (Just "grp:alts_toggle")) + km <- liftM fromJust $ newKeymapFromNames envCtx noPrefs + testKeySeq km [ + (keycode_a, Both, keysym_a), + (keycode_leftalt, Down, keysym_Alt_L), + (keycode_rightalt, Down, keysym_ISO_Next_Group), + (keycode_rightalt, Up, keysym_ISO_Level3_Shift), + (keycode_leftalt, Up, keysym_Alt_L), + (keycode_grave, Up, keysym_numbersign)] + + setRmlvoEnv (RMLVO + (Just "broken") + (Just "what-on-earth") + (Just "invalid") + Nothing + Nothing) + km <- newKeymapFromNames envCtx noPrefs + assert (isNothing km) "compiled nonexistent keymap" + diff --git a/tests/state.hs b/tests/state.hs new file mode 100644 --- /dev/null +++ b/tests/state.hs @@ -0,0 +1,197 @@ +import Control.Monad +import Data.Maybe +import Data.Functor + +import Text.XkbCommon +import Text.XkbCommon.Constants +import Text.XkbCommon.KeycodeList + +import Common + +blergh :: IO Bool -> IO () +blergh iob = do + b <- iob + assert b "err" + +testUpdateKey :: Keymap -> IO () +testUpdateKey km = do + st <- newKeyboardState km + + updateKeyboardStateKey st keycode_leftctrl keyDown + blergh (stateModNameIsActive st modname_ctrl stateModDepressed) + + updateKeyboardStateKey st keycode_rightalt keyDown + blergh (stateModNameIsActive st modname_ctrl stateModDepressed) + blergh (stateModNameIsActive st modname_alt stateModDepressed) + + updateKeyboardStateKey st keycode_leftctrl keyUp + blergh (liftM not $ stateModNameIsActive st modname_ctrl stateModDepressed) + blergh (stateModNameIsActive st modname_alt stateModDepressed) + + updateKeyboardStateKey st keycode_rightalt keyUp + blergh (liftM not $ stateModNameIsActive st modname_alt stateModDepressed) + + updateKeyboardStateKey st keycode_capslock keyDown + blergh (stateModNameIsActive st modname_caps stateModDepressed) + updateKeyboardStateKey st keycode_capslock keyUp + blergh (liftM not $ stateModNameIsActive st modname_caps stateModDepressed) + blergh (stateModNameIsActive st modname_caps stateModLocked) + blergh (stateLedNameIsActive st ledname_caps) + out <- getStateSyms st keycode_q + assert (1 == length out) "err" + assert (head out == keysym_Q) "err" + + updateKeyboardStateKey st keycode_numlock keyDown + updateKeyboardStateKey st keycode_numlock keyUp + blergh (stateModNameIsActive st modname_caps stateModLocked) + blergh (stateModNameIsActive st "Mod2" stateModLocked) + out <- getStateSyms st keycode_kp1 + assert (1 == length out) "err" + assert (head out == keysym_KP_1) "err" + blergh (stateLedNameIsActive st ledname_num) + + updateKeyboardStateKey st keycode_numlock keyDown + updateKeyboardStateKey st keycode_numlock keyUp + + updateKeyboardStateKey st keycode_compose keyDown + updateKeyboardStateKey st keycode_compose keyUp + + blergh (stateLedNameIsActive st "Group 2") + out <- stateLedNameIsActive st ledname_num + assert (not out) "err" + + updateKeyboardStateKey st keycode_compose keyDown + updateKeyboardStateKey st keycode_compose keyUp + + updateKeyboardStateKey st keycode_capslock keyDown + updateKeyboardStateKey st keycode_capslock keyUp + blergh (liftM not $ stateModNameIsActive st modname_caps stateModEffective) + blergh (liftM not $ stateLedNameIsActive st ledname_caps) + out <- getStateSyms st keycode_q + assert (1 == length out) "err" + assert (head out == keysym_q) "err" + + + out <- getStateSyms st keycode_6 + assert (5 == length out) "err" + assert (head out == keysym_H) "err" + assert (out !! 1 == keysym_E) "err" + assert (out !! 2 == keysym_L) "err" + assert (out !! 3 == keysym_L) "err" + assert (out !! 4 == keysym_O) "err" + + out <- getOneKeySym st keycode_6 + assert (isNothing out) "err" + updateKeyboardStateKey st keycode_6 keyDown + updateKeyboardStateKey st keycode_6 keyUp + + out <- getOneKeySym st keycode_5 + assert (out == Just keysym_5) "err" + + +testSerialisation :: Keymap -> IO () +testSerialisation km = do + st <- newKeyboardState km + + let caps = fromJust $ keymapModIdx km modname_caps + let shift = fromJust $ keymapModIdx km modname_shift + let ctrl = fromJust $ keymapModIdx km modname_ctrl + + updateKeyboardStateKey st keycode_capslock keyDown + updateKeyboardStateKey st keycode_capslock keyUp + + baseMods <- stateSerializeMods st stateModDepressed + latchedMods <- stateSerializeMods st stateModLatched + lockedMods <- stateSerializeMods st stateModLocked + effectiveMods <- stateSerializeMods st stateModEffective + + assert (baseMods == 0) "baseMods invalid" + assert (latchedMods == 0) "latchedMods invalid" + assert (lockedMods == (2^unCModIndex caps)) "lockedMods invalid" + assert (effectiveMods == lockedMods) "effectiveMods invalid" + + updateKeyboardStateKey st keycode_leftshift keyDown + + baseMods <- stateSerializeMods st stateModDepressed + latchedMods <- stateSerializeMods st stateModLatched + lockedMods <- stateSerializeMods st stateModLocked + effectiveMods <- stateSerializeMods st stateModEffective + + assert (baseMods == (2^unCModIndex shift)) "baseMods invalid" + assert (latchedMods == 0) "latchedMods invalid" + assert (lockedMods == (2^unCModIndex caps)) "lockedMods invalid" + assert (effectiveMods == (2^unCModIndex shift) + (2^unCModIndex caps)) "effectiveMods invalid" + + let baseModsWithCtrl = baseMods + 2^unCModIndex ctrl + let layout0 = CLayoutIndex 0 + updateKeyboardStateMask st (baseModsWithCtrl, latchedMods, lockedMods) (layout0, layout0, layout0) + + blergh $ stateModIndexIsActive st ctrl stateModDepressed + blergh $ stateModIndexIsActive st ctrl stateModEffective + +testRepeat :: Keymap -> IO () +testRepeat km = do + assert (not $ keymapKeyRepeats km keycode_leftshift) "shift key repeat error" + assert (keymapKeyRepeats km keycode_a) "a key repeat error" + assert (keymapKeyRepeats km keycode_8) "8 key repeat error" + assert (keymapKeyRepeats km keycode_down) "down key repeat error" + assert (keymapKeyRepeats km keycode_kbdillumdown) "kbdillumdown key repeat error" + +testConsume :: Keymap -> IO () +testConsume km = do + st <- newKeyboardState km + + let alt = fromJust $ keymapModIdx km modname_alt + let shift = fromJust $ keymapModIdx km modname_shift + + updateKeyboardStateKey st keycode_leftalt keyDown + updateKeyboardStateKey st keycode_leftshift keyDown + updateKeyboardStateKey st keycode_equal keyDown + + mask <- stateSerializeMods st stateModEffective + assert (mask == 2^unCModIndex alt + 2^unCModIndex shift) "err" + + newMask <- stateRemoveConsumed st keycode_equal mask + assert (newMask == 2^unCModIndex alt) $ + "consumed error: mask " ++ show mask + ++ ", newMask " ++ show newMask + ++ ", expected " ++ show (2^unCModIndex alt) + +{- UNSUPPORTED AT THIS STAGE +static void +key_iter(struct xkb_keymap *keymap, xkb_keycode_t key, void *data) +{ + int *counter = (int *) data; + + assert(*counter == key); + (*counter)++; +} + +static void +test_range(struct xkb_keymap *keymap) +{ + int counter; + + assert(xkb_keymap_min_keycode(keymap) == 9); + assert(xkb_keymap_max_keycode(keymap) == 253); + + counter = xkb_keymap_min_keycode(keymap); + xkb_keymap_key_for_each(keymap, key_iter, &counter); + assert(counter == xkb_keymap_max_keycode(keymap) + 1); +} +-} + +main = do + ctx <- getTestContext + km <- liftM fromJust $ newKeymapFromNames ctx (RMLVO + (Just "evdev") + (Just "pc104") + (Just "us,ru") + Nothing + (Just "grp:menu_toggle")) + + testUpdateKey km + testSerialisation km + testRepeat km + testConsume km +{- testRange km-} diff --git a/tests/stringcomp.hs b/tests/stringcomp.hs new file mode 100644 --- /dev/null +++ b/tests/stringcomp.hs @@ -0,0 +1,27 @@ +import Control.Monad +import Data.Maybe + +import Text.XkbCommon + +import Common + +main = do + ctx <- liftM fromJust $ newContext defaultFlags + + original <- readFile (datadir++"keymaps/stringcomp.data") + + let keymap = newKeymapFromString ctx original + case keymap of + Nothing -> assert False "Could not read keymap string!" + Just _ -> assert True undefined + + let dump = keymapAsString $ fromJust keymap + + assert (dump == original) "original and dump not equal!" + + let keymap2 = newKeymapFromString ctx dump + let dump2 = keymapAsString $ fromJust keymap2 + + assert (dump2 == dump) "dump and dump2 not equal!" + + return () diff --git a/xkbcommon.cabal b/xkbcommon.cabal new file mode 100644 --- /dev/null +++ b/xkbcommon.cabal @@ -0,0 +1,123 @@ +-- Initial xkbcommon.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: xkbcommon +version: 0.0.0 +synopsis: Haskell bindings for libxkbcommon +description: + Wrapper library for libxkbcommon, which is the new alternative for the X11 XKB.h keyboard input + API. Specifically, it finds keymap files from disk based on Rule\/Model\/Layout\/Variant\/Option + specifications, and compiles them into a 'Keymap'. From this 'Keymap', a 'KeyboardState' can be + constructed which represents the states of various physical buttons such as the shift/alt/ctrl + keys, and can give the correct key symbol based on keyboard events. E.g., pressing the @\@ key + while @\@ is pressed produces the @H@ symbol in the common QWERTY keymaps, but in e.g. + the Dvorak keymap, it produces the D symbol. + . + After keymap creation, which libxkbcommon can do based on locale preferences and enviroment + variables, this is all handled by routing keyboard events through libxkbcommon. + . + At this stage, these haskell bindings do not make libxkbcommon look much like a haskell library. + For example, in principle the entire libxkbcommon library is just a stateful processor, and has + nothing to do with the IO monad. + However, because I am not yet a very good haskell programmer, and because + in most realistic use cases input data comes from the IO monad anyway, the stateful operations + are encoded in the IO monad anyway. + . + Note that these bindings load the keysym constants from the libxkbcommon C header files at + compile time using TH, and similarly keycodes from the Linux header files. + These should be present for correct compilation. +license: MIT +license-file: LICENSE +author: Auke Booij +maintainer: auke@tulcod.com +category: Text +build-type: Simple +cabal-version: >=1.8 + +source-repository head + type: git + location: https://github.com/tulcod/haskell-xkbcommon.git + +library + exposed-modules: + Text.XkbCommon, + Text.XkbCommon.KeysymList, + Text.XkbCommon.KeycodeList, + Text.XkbCommon.ModList, + Text.XkbCommon.Constants, + Text.XkbCommon.Types, + Text.XkbCommon.Context, + Text.XkbCommon.Keymap, + Text.XkbCommon.KeyboardState, + Text.XkbCommon.Keysym + other-modules: + Text.XkbCommon.ParseDefines, + Text.XkbCommon.InternalTypes + -- other-modules: + build-depends: base ==4.6.*, transformers, storable-record, process, cpphs, template-haskell, text, bytestring, data-flags, filepath + -- build-tools: c2hs + +-- this is actually not a test but a benchmark +Benchmark bench-key-proc + type: exitcode-stdio-1.0 + hs-source-dirs: tests + other-modules: Common + main-is: bench-key-proc.hs + build-depends : base, xkbcommon, random, vector, time + extra-libraries: xkbcommon + +Test-Suite context + type: exitcode-stdio-1.0 + hs-source-dirs: tests + other-modules: Common + main-is: context.hs + build-depends : base, xkbcommon + extra-libraries: xkbcommon + +Test-Suite filecomp + type: exitcode-stdio-1.0 + hs-source-dirs: tests + other-modules: Common + main-is: filecomp.hs + build-depends : base, xkbcommon + extra-libraries: xkbcommon + +Test-Suite keyseq + type: exitcode-stdio-1.0 + hs-source-dirs: tests + other-modules: Common + main-is: keyseq.hs + build-depends : base, xkbcommon + extra-libraries: xkbcommon + +Test-Suite keysym + type: exitcode-stdio-1.0 + hs-source-dirs: tests + other-modules: Common + main-is: keysym.hs + build-depends : base, xkbcommon + extra-libraries: xkbcommon + +Test-Suite rulescomp + type: exitcode-stdio-1.0 + hs-source-dirs: tests + other-modules: Common + main-is: rulescomp.hs + build-depends : base, xkbcommon, unix + extra-libraries: xkbcommon + +Test-Suite state + type: exitcode-stdio-1.0 + hs-source-dirs: tests + other-modules: Common + main-is: state.hs + build-depends : base, xkbcommon + extra-libraries: xkbcommon + +Test-Suite stringcomp + type: exitcode-stdio-1.0 + hs-source-dirs: tests + other-modules: Common + main-is: stringcomp.hs + build-depends : base, xkbcommon + extra-libraries: xkbcommon