xkbcommon (empty) → 0.0.0
raw patch · 24 files changed
+2100/−0 lines, 24 filesdep +basedep +bytestringdep +cpphssetup-changed
Dependencies added: base, bytestring, cpphs, data-flags, filepath, process, random, storable-record, template-haskell, text, time, transformers, unix, vector, xkbcommon
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- Text/XkbCommon.hs +12/−0
- Text/XkbCommon/Constants.hs +6/−0
- Text/XkbCommon/Context.hsc +176/−0
- Text/XkbCommon/InternalTypes.hsc +237/−0
- Text/XkbCommon/KeyboardState.hsc +213/−0
- Text/XkbCommon/KeycodeList.hs +16/−0
- Text/XkbCommon/Keymap.hsc +205/−0
- Text/XkbCommon/Keysym.hsc +82/−0
- Text/XkbCommon/KeysymList.hs +11/−0
- Text/XkbCommon/ModList.hs +10/−0
- Text/XkbCommon/ParseDefines.hs +58/−0
- Text/XkbCommon/Types.hs +12/−0
- tests/Common.hs +46/−0
- tests/bench-key-proc.hs +39/−0
- tests/context.hs +16/−0
- tests/filecomp.hs +26/−0
- tests/keyseq.hs +306/−0
- tests/keysym.hs +97/−0
- tests/rulescomp.hs +163/−0
- tests/state.hs +197/−0
- tests/stringcomp.hs +27/−0
- xkbcommon.cabal +123/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/XkbCommon.hs view
@@ -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
+ Text/XkbCommon/Constants.hs view
@@ -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
+ Text/XkbCommon/Context.hsc view
@@ -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 <xkbcommon/xkbcommon.h>++++-- | 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 ()+
+ Text/XkbCommon/InternalTypes.hsc view
@@ -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 <xkbcommon/xkbcommon.h>++-- | @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
+ Text/XkbCommon/KeyboardState.hsc view
@@ -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 <xkbcommon/xkbcommon.h>+++-- | 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+
+ Text/XkbCommon/KeycodeList.hs view
@@ -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)
+ Text/XkbCommon/Keymap.hsc view
@@ -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 <xkbcommon/xkbcommon.h>+++-- | 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+
+ Text/XkbCommon/Keysym.hsc view
@@ -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 <xkbcommon/xkbcommon.h>+++-- | 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}+
+ Text/XkbCommon/KeysymList.hs view
@@ -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)
+ Text/XkbCommon/ModList.hs view
@@ -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)
+ Text/XkbCommon/ParseDefines.hs view
@@ -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
+ Text/XkbCommon/Types.hs view
@@ -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
+ tests/Common.hs view
@@ -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
+ tests/bench-key-proc.hs view
@@ -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 ()
+ tests/context.hs view
@@ -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"
+ tests/filecomp.hs view
@@ -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"]
+ tests/keyseq.hs view
@@ -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 ()
+ tests/keysym.hs view
@@ -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 "-"+
+ tests/rulescomp.hs view
@@ -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"+
+ tests/state.hs view
@@ -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-}
+ tests/stringcomp.hs view
@@ -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 ()
+ xkbcommon.cabal view
@@ -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 @\<h\>@ key+ while @\<shift\>@ 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