{-# LINE 2 "./Graphics/UI/Gtk/Gdk/Keymap.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Keymap
--
-- Author : Andy Stewart
--
-- Created: 30 Mar 2010
--
-- Copyright (C) 2010 Andy Stewart
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- Functions for manipulating keyboard codes
--
module Graphics.UI.Gtk.Gdk.Keymap (

-- * Details
--
-- | Key values are the codes which are sent whenever a key is pressed or released. They appear in the
-- keyval field of the 'EventKey' structure, which is passed to signal handlers for the
-- 'keyPressEvent' and 'keyReleaseEvent' signals.
--
-- Key values are regularly updated from the upstream X.org X11 implementation, so new values are added
-- regularly. They will be prefixed with GDK_ rather than XF86XK_ or ' (for older symbols)'.
--
-- Key values can be converted into a string representation using 'keyvalName'. The reverse
-- function, converting a string to a key value, is provided by 'keyvalFromName'.
--
-- The case of key values can be determined using 'keyvalIsUpper'. Key
-- values can be converted to upper or lower case using 'keyvalToUpper' and
-- 'keyvalToLower'.
--
-- When it makes sense, key values can be converted to and from Unicode characters with
-- 'keyvalToUnicode'.
--
-- One 'Keymap' object exists for each user display. 'keymapGetDefault' returns the 'Keymap'
-- for the default display; to obtain keymaps for other displays, use 'keymapGetForDisplay'. A
-- keymap is a mapping from 'KeymapKey' to key values. You can think of a 'KeymapKey' as a
-- representation of a symbol printed on a physical keyboard key. That is, it contains three pieces of
-- information. First, it contains the hardware keycode; this is an identifying number for a physical
-- key. Second, it contains the level of the key. The level indicates which symbol on the key will be
-- used, in a vertical direction. So on a standard US keyboard, the key with the number \"1\" on it also
-- has the exclamation point \"!\" character on it. The level indicates whether to use the \"1\" or the
-- \"!\" symbol. The letter keys are considered to have a lowercase letter at level 0, and an uppercase
-- letter at level 1, though only the uppercase letter is printed. Third, the 'KeymapKey' contains a
-- group; groups are not used on standard US keyboards, but are used in many other countries. On a
-- keyboard with groups, there can be 3 or 4 symbols printed on a single key. The group indicates
-- movement in a horizontal direction. Usually groups are used for two different languages. In group 0,
-- a key might have two English characters, and in group 1 it might have two Hebrew characters. The
-- Hebrew characters will be printed on the key next to the English characters.
--
-- In order to use a keymap to interpret a key event, it's necessary to first convert the keyboard
-- state into an effective group and level. This is done via a set of rules that varies widely
-- according to type of keyboard and user configuration. The function
-- 'keymapTranslateKeyboardState' accepts a keyboard state -- consisting of hardware keycode
-- pressed, active modifiers, and active group -- applies the appropriate rules, and returns the
-- group/level to be used to index the keymap, along with the modifiers which did not affect the group
-- and level. i.e. it returns "unconsumed modifiers." The keyboard group may differ from the effective
-- group used for keymap lookups because some keys don't have multiple groups - e.g. the Enter key is
-- always in group 0 regardless of keyboard state.
--
-- Note that 'keymapTranslateKeyboardState' also returns the keyval, i.e. it goes ahead and
-- performs the keymap lookup in addition to telling you which effective group/level values were used
-- for the lookup. 'EventKey' already contains this keyval, however, so you don't normally need to
-- call 'keymapTranslateKeyboardState' just to get the keyval.

-- * Class Hierarchy
--
-- |
-- @
-- | 'GObject'
-- | +----Keymap
-- @

-- * Types
  Keymap,
  KeymapClass,
  castToKeymap,
  toKeymap,
  KeymapKey,

-- * Methods
  keymapGetDefault,

  keymapGetForDisplay,

  keymapLookupKey,
  keymapTranslateKeyboardState,
  keymapGetEntriesForKeyval,
  keymapGetEntriesForKeycode,
  keymapGetDirection,

  keymapHaveBidiLayouts,


  keymapGetCapsLockState,


-- * Signals

  keymapDirectionChanged,

  keymapKeysChanged,

  keymapStateChanged,



  ) where

import Control.Monad (liftM)
import System.Glib.FFI
import Graphics.UI.Gtk.Gdk.Enums (Modifier(..))
import Graphics.UI.Gtk.Gdk.Keys (KeyVal (..))
import Graphics.Rendering.Pango.Enums
{-# LINE 129 "./Graphics/UI/Gtk/Gdk/Keymap.chs" #-}
import Graphics.UI.Gtk.Types
{-# LINE 130 "./Graphics/UI/Gtk/Gdk/Keymap.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 131 "./Graphics/UI/Gtk/Gdk/Keymap.chs" #-}
import Graphics.UI.Gtk.General.Structs (KeymapKey (..))


{-# LINE 134 "./Graphics/UI/Gtk/Gdk/Keymap.chs" #-}

--------------------
-- Methods

-- | Returns the 'Keymap' attached to the default display.
--
keymapGetDefault ::
    IO Keymap -- ^ returns the 'Keymap' attached to the default display.
keymapGetDefault :: IO Keymap
keymapGetDefault =
  (ForeignPtr Keymap -> Keymap, FinalizerPtr Keymap)
-> IO (Ptr Keymap) -> IO Keymap
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr Keymap -> Keymap, FinalizerPtr Keymap)
forall {a}. (ForeignPtr Keymap -> Keymap, FinalizerPtr a)
mkKeymap (IO (Ptr Keymap) -> IO Keymap) -> IO (Ptr Keymap) -> IO Keymap
forall a b. (a -> b) -> a -> b
$
  IO (Ptr Keymap)
gdk_keymap_get_default
{-# LINE 145 "./Graphics/UI/Gtk/Gdk/Keymap.chs" #-}


-- | Returns the 'Keymap' attached to @display@.
--
-- * Available since Gdk version 2.2
--
keymapGetForDisplay ::
    Display -- ^ @display@ - the 'Display'.
 -> IO Keymap -- ^ returns the 'Keymap' attached to @display@.
keymapGetForDisplay :: Display -> IO Keymap
keymapGetForDisplay Display
display =
  (ForeignPtr Keymap -> Keymap, FinalizerPtr Keymap)
-> IO (Ptr Keymap) -> IO Keymap
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr Keymap -> Keymap, FinalizerPtr Keymap)
forall {a}. (ForeignPtr Keymap -> Keymap, FinalizerPtr a)
mkKeymap (IO (Ptr Keymap) -> IO Keymap) -> IO (Ptr Keymap) -> IO Keymap
forall a b. (a -> b) -> a -> b
$
  (\(Display ForeignPtr Display
arg1) -> ForeignPtr Display
-> (Ptr Display -> IO (Ptr Keymap)) -> IO (Ptr Keymap)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Display
arg1 ((Ptr Display -> IO (Ptr Keymap)) -> IO (Ptr Keymap))
-> (Ptr Display -> IO (Ptr Keymap)) -> IO (Ptr Keymap)
forall a b. (a -> b) -> a -> b
$ \Ptr Display
argPtr1 ->Ptr Display -> IO (Ptr Keymap)
gdk_keymap_get_for_display Ptr Display
argPtr1)
{-# LINE 157 "./Graphics/UI/Gtk/Gdk/Keymap.chs" #-}
    display


-- | Looks up the keyval mapped to a keycode\/group\/level triplet. If no
-- keyval is bound to @key@, returns 0. For normal user input, you want to use
-- 'keymapTranslateKeyboardState' instead of this function, since the effective
-- group\/level may not be the same as the current keyboard state.
--
keymapLookupKey :: KeymapClass self
                => (Maybe self) -- ^ @keymap@ a 'Keymap' or 'Nothing' to use the default keymap
                -> KeymapKey -- ^ @key@ - a 'KeymapKey'
                            -- with keycode, group, and level initialized
                -> IO Int -- ^ returns a keyval, or 0 if none was mapped to
                            -- the given @key@
keymapLookupKey :: forall self. KeymapClass self => Maybe self -> KeymapKey -> IO Int
keymapLookupKey Maybe self
Nothing KeymapKey
key =
  (CUInt -> Int) -> IO CUInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Int) -> IO CUInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  Int -> (Ptr KeymapKey -> IO CUInt) -> IO CUInt
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
12 ((Ptr KeymapKey -> IO CUInt) -> IO CUInt)
-> (Ptr KeymapKey -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \ Ptr KeymapKey
keyPtr -> do
    Ptr KeymapKey -> KeymapKey -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr KeymapKey
keyPtr KeymapKey
key
    (\(Keymap ForeignPtr Keymap
arg1) Ptr ()
arg2 -> ForeignPtr Keymap -> (Ptr Keymap -> IO CUInt) -> IO CUInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Keymap
arg1 ((Ptr Keymap -> IO CUInt) -> IO CUInt)
-> (Ptr Keymap -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \Ptr Keymap
argPtr1 ->Ptr Keymap -> Ptr () -> IO CUInt
gdk_keymap_lookup_key Ptr Keymap
argPtr1 Ptr ()
arg2)
{-# LINE 176 "./Graphics/UI/Gtk/Gdk/Keymap.chs" #-}
      (Keymap nullForeignPtr)
      (Ptr KeymapKey -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr KeymapKey
keyPtr)
keymapLookupKey (Just self
self) KeymapKey
key =
  (CUInt -> Int) -> IO CUInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Int) -> IO CUInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  Int -> (Ptr KeymapKey -> IO CUInt) -> IO CUInt
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
12 ((Ptr KeymapKey -> IO CUInt) -> IO CUInt)
-> (Ptr KeymapKey -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \ Ptr KeymapKey
keyPtr -> do
    Ptr KeymapKey -> KeymapKey -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr KeymapKey
keyPtr KeymapKey
key
    (\(Keymap ForeignPtr Keymap
arg1) Ptr ()
arg2 -> ForeignPtr Keymap -> (Ptr Keymap -> IO CUInt) -> IO CUInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Keymap
arg1 ((Ptr Keymap -> IO CUInt) -> IO CUInt)
-> (Ptr Keymap -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \Ptr Keymap
argPtr1 ->Ptr Keymap -> Ptr () -> IO CUInt
gdk_keymap_lookup_key Ptr Keymap
argPtr1 Ptr ()
arg2)
{-# LINE 183 "./Graphics/UI/Gtk/Gdk/Keymap.chs" #-}
      (toKeymap self)
      (Ptr KeymapKey -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr KeymapKey
keyPtr)

-- | Translates the contents of a 'EventKey' into a
-- keyval, effective group, and level. Modifiers that affected the translation
-- and are thus unavailable for application use are returned in
-- @consumedModifiers@. See 'keyvalGetKeys' for an explanation of groups and
-- levels. The @effectiveGroup@ is the group that was actually used for the
-- translation; some keys such as Enter are not affected by the active keyboard
-- group. The @level@ is derived from @state@. For convenience, 'EventKey'
-- already contains the translated keyval, so this function
-- isn't as useful as you might think.
--
keymapTranslateKeyboardState :: KeymapClass self => self
 -> Int -- ^ @hardwareKeycode@ - a keycode
 -> Modifier -- ^ @state@ - a modifier state
 -> Int -- ^ @group@ - active keyboard group
 -> IO (Maybe (Int, Int, Int, Modifier))
keymapTranslateKeyboardState :: forall self.
KeymapClass self =>
self
-> Int -> Modifier -> Int -> IO (Maybe (Int, Int, Int, Modifier))
keymapTranslateKeyboardState self
self Int
hardwareKeycode Modifier
state Int
group =
  (Ptr CUInt -> IO (Maybe (Int, Int, Int, Modifier)))
-> IO (Maybe (Int, Int, Int, Modifier))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO (Maybe (Int, Int, Int, Modifier)))
 -> IO (Maybe (Int, Int, Int, Modifier)))
-> (Ptr CUInt -> IO (Maybe (Int, Int, Int, Modifier)))
-> IO (Maybe (Int, Int, Int, Modifier))
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
keyvalPtr ->
  (Ptr CInt -> IO (Maybe (Int, Int, Int, Modifier)))
-> IO (Maybe (Int, Int, Int, Modifier))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (Int, Int, Int, Modifier)))
 -> IO (Maybe (Int, Int, Int, Modifier)))
-> (Ptr CInt -> IO (Maybe (Int, Int, Int, Modifier)))
-> IO (Maybe (Int, Int, Int, Modifier))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
effectiveGroupPtr ->
  (Ptr CInt -> IO (Maybe (Int, Int, Int, Modifier)))
-> IO (Maybe (Int, Int, Int, Modifier))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (Int, Int, Int, Modifier)))
 -> IO (Maybe (Int, Int, Int, Modifier)))
-> (Ptr CInt -> IO (Maybe (Int, Int, Int, Modifier)))
-> IO (Maybe (Int, Int, Int, Modifier))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
levelPtr ->
  (Ptr CInt -> IO (Maybe (Int, Int, Int, Modifier)))
-> IO (Maybe (Int, Int, Int, Modifier))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (Int, Int, Int, Modifier)))
 -> IO (Maybe (Int, Int, Int, Modifier)))
-> (Ptr CInt -> IO (Maybe (Int, Int, Int, Modifier)))
-> IO (Maybe (Int, Int, Int, Modifier))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
modifierPtr -> do
    Bool
success <- (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
              (\(Keymap ForeignPtr Keymap
arg1) CUInt
arg2 CInt
arg3 CInt
arg4 Ptr CUInt
arg5 Ptr CInt
arg6 Ptr CInt
arg7 Ptr CInt
arg8 -> ForeignPtr Keymap -> (Ptr Keymap -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Keymap
arg1 ((Ptr Keymap -> IO CInt) -> IO CInt)
-> (Ptr Keymap -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Keymap
argPtr1 ->Ptr Keymap
-> CUInt
-> CInt
-> CInt
-> Ptr CUInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> IO CInt
gdk_keymap_translate_keyboard_state Ptr Keymap
argPtr1 CUInt
arg2 CInt
arg3 CInt
arg4 Ptr CUInt
arg5 Ptr CInt
arg6 Ptr CInt
arg7 Ptr CInt
arg8)
{-# LINE 208 "./Graphics/UI/Gtk/Gdk/Keymap.chs" #-}
                (self -> Keymap
forall o. KeymapClass o => o -> Keymap
toKeymap self
self)
                (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hardwareKeycode)
                ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Modifier -> Int) -> Modifier -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Modifier -> Int
forall a. Enum a => a -> Int
fromEnum) Modifier
state)
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
group)
                Ptr CUInt
keyvalPtr
                Ptr CInt
effectiveGroupPtr
                Ptr CInt
levelPtr
                Ptr CInt
modifierPtr
    if Bool
success
       then do
         CUInt
keyval <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
keyvalPtr
         CInt
effectiveGroup <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
effectiveGroupPtr
         CInt
level <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
levelPtr
         CInt
modifier <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
modifierPtr
         Maybe (Int, Int, Int, Modifier)
-> IO (Maybe (Int, Int, Int, Modifier))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Int, Int, Modifier) -> Maybe (Int, Int, Int, Modifier)
forall a. a -> Maybe a
Just (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
keyval
                      ,CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
effectiveGroup
                      ,CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
level
                      ,Int -> Modifier
forall a. Enum a => Int -> a
toEnum (Int -> Modifier) -> Int -> Modifier
forall a b. (a -> b) -> a -> b
$ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
modifier))
       else Maybe (Int, Int, Int, Modifier)
-> IO (Maybe (Int, Int, Int, Modifier))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Int, Int, Modifier)
forall a. Maybe a
Nothing

-- | Obtains a list of keycode\/group\/level combinations that will generate
-- @keyval@. Groups and levels are two kinds of keyboard mode; in general, the
-- level determines whether the top or bottom symbol on a key is used, and the
-- group determines whether the left or right symbol is used. On US keyboards,
-- the shift key changes the keyboard level, and there are no groups. A group
-- switch key might convert a keyboard between Hebrew to English modes, for
-- example. 'EventKey' contains a @group@ field that
-- indicates the active keyboard group. The level is computed from the modifier
-- mask.
--
keymapGetEntriesForKeyval :: KeymapClass self => self
 -> KeyVal -- ^ @keyval@ - a keyval, such as @GDK_a@, @GDK_Up@,
                       -- @GDK_Return@, etc.
 -> IO (Maybe [KeymapKey])
keymapGetEntriesForKeyval :: forall self.
KeymapClass self =>
self -> KeyVal -> IO (Maybe [KeymapKey])
keymapGetEntriesForKeyval self
self KeyVal
keyval =
  (Ptr CInt -> IO (Maybe [KeymapKey])) -> IO (Maybe [KeymapKey])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe [KeymapKey])) -> IO (Maybe [KeymapKey]))
-> (Ptr CInt -> IO (Maybe [KeymapKey])) -> IO (Maybe [KeymapKey])
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
nKeysPtr ->
  Int
-> (Ptr (Ptr KeymapKey) -> IO (Maybe [KeymapKey]))
-> IO (Maybe [KeymapKey])
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
0 ((Ptr (Ptr KeymapKey) -> IO (Maybe [KeymapKey]))
 -> IO (Maybe [KeymapKey]))
-> (Ptr (Ptr KeymapKey) -> IO (Maybe [KeymapKey]))
-> IO (Maybe [KeymapKey])
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr KeymapKey)
keysPtr -> do
    Bool
success <- (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
              (\(Keymap ForeignPtr Keymap
arg1) CUInt
arg2 Ptr (Ptr ())
arg3 Ptr CInt
arg4 -> ForeignPtr Keymap -> (Ptr Keymap -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Keymap
arg1 ((Ptr Keymap -> IO CInt) -> IO CInt)
-> (Ptr Keymap -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Keymap
argPtr1 ->Ptr Keymap -> CUInt -> Ptr (Ptr ()) -> Ptr CInt -> IO CInt
gdk_keymap_get_entries_for_keyval Ptr Keymap
argPtr1 CUInt
arg2 Ptr (Ptr ())
arg3 Ptr CInt
arg4)
{-# LINE 247 "./Graphics/UI/Gtk/Gdk/Keymap.chs" #-}
                (self -> Keymap
forall o. KeymapClass o => o -> Keymap
toKeymap self
self)
                (KeyVal -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral KeyVal
keyval)
                (Ptr (Ptr KeymapKey) -> Ptr (Ptr ())
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr KeymapKey)
keysPtr)
                Ptr CInt
nKeysPtr
    if Bool
success
       then do
         Int
nKeys <- (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
nKeysPtr
         [Ptr KeymapKey]
keys <- Int -> Ptr (Ptr KeymapKey) -> IO [Ptr KeymapKey]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
nKeys Ptr (Ptr KeymapKey)
keysPtr
         [KeymapKey]
keyList <- (Ptr KeymapKey -> IO KeymapKey)
-> [Ptr KeymapKey] -> IO [KeymapKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ptr KeymapKey -> IO KeymapKey
forall a. Storable a => Ptr a -> IO a
peek [Ptr KeymapKey]
keys
         Ptr () -> IO ()
g_free (Ptr (Ptr KeymapKey) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr KeymapKey)
keysPtr)
         Maybe [KeymapKey] -> IO (Maybe [KeymapKey])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([KeymapKey] -> Maybe [KeymapKey]
forall a. a -> Maybe a
Just [KeymapKey]
keyList)
       else Maybe [KeymapKey] -> IO (Maybe [KeymapKey])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [KeymapKey]
forall a. Maybe a
Nothing

-- | Returns the keyvals bound to @hardwareKeycode@. The Nth 'KeymapKey'
-- in @keys@ is bound to the Nth keyval in @keyvals@.
-- When a keycode is pressed by the user, the
-- keyval from this list of entries is selected by considering the effective
-- keyboard group and level. See 'keymapTranslateKeyboardState'.
--
keymapGetEntriesForKeycode :: KeymapClass self => self
 -> Int -- ^ @hardwareKeycode@ - a keycode
 -> IO (Maybe ([KeymapKey], [KeyVal]))
keymapGetEntriesForKeycode :: forall self.
KeymapClass self =>
self -> Int -> IO (Maybe ([KeymapKey], [KeyVal]))
keymapGetEntriesForKeycode self
self Int
hardwareKeycode =
  (Ptr CInt -> IO (Maybe ([KeymapKey], [KeyVal])))
-> IO (Maybe ([KeymapKey], [KeyVal]))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe ([KeymapKey], [KeyVal])))
 -> IO (Maybe ([KeymapKey], [KeyVal])))
-> (Ptr CInt -> IO (Maybe ([KeymapKey], [KeyVal])))
-> IO (Maybe ([KeymapKey], [KeyVal]))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
nEntriesPtr ->
  Int
-> (Ptr (Ptr KeymapKey) -> IO (Maybe ([KeymapKey], [KeyVal])))
-> IO (Maybe ([KeymapKey], [KeyVal]))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
0 ((Ptr (Ptr KeymapKey) -> IO (Maybe ([KeymapKey], [KeyVal])))
 -> IO (Maybe ([KeymapKey], [KeyVal])))
-> (Ptr (Ptr KeymapKey) -> IO (Maybe ([KeymapKey], [KeyVal])))
-> IO (Maybe ([KeymapKey], [KeyVal]))
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr KeymapKey)
keysPtr ->
  Int
-> (Ptr (Ptr CUInt) -> IO (Maybe ([KeymapKey], [KeyVal])))
-> IO (Maybe ([KeymapKey], [KeyVal]))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
0 ((Ptr (Ptr CUInt) -> IO (Maybe ([KeymapKey], [KeyVal])))
 -> IO (Maybe ([KeymapKey], [KeyVal])))
-> (Ptr (Ptr CUInt) -> IO (Maybe ([KeymapKey], [KeyVal])))
-> IO (Maybe ([KeymapKey], [KeyVal]))
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr CUInt)
keyvalsPtr -> do
    Bool
success <- (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
              (\(Keymap ForeignPtr Keymap
arg1) CUInt
arg2 Ptr (Ptr ())
arg3 Ptr (Ptr CUInt)
arg4 Ptr CInt
arg5 -> ForeignPtr Keymap -> (Ptr Keymap -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Keymap
arg1 ((Ptr Keymap -> IO CInt) -> IO CInt)
-> (Ptr Keymap -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Keymap
argPtr1 ->Ptr Keymap
-> CUInt -> Ptr (Ptr ()) -> Ptr (Ptr CUInt) -> Ptr CInt -> IO CInt
gdk_keymap_get_entries_for_keycode Ptr Keymap
argPtr1 CUInt
arg2 Ptr (Ptr ())
arg3 Ptr (Ptr CUInt)
arg4 Ptr CInt
arg5)
{-# LINE 275 "./Graphics/UI/Gtk/Gdk/Keymap.chs" #-}
                (self -> Keymap
forall o. KeymapClass o => o -> Keymap
toKeymap self
self)
                (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hardwareKeycode)
                (Ptr (Ptr KeymapKey) -> Ptr (Ptr ())
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr KeymapKey)
keysPtr)
                Ptr (Ptr CUInt)
keyvalsPtr
                Ptr CInt
nEntriesPtr
    if Bool
success
       then do
         Int
nEntries <- (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
nEntriesPtr
         [Ptr KeymapKey]
keys <- Int -> Ptr (Ptr KeymapKey) -> IO [Ptr KeymapKey]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
nEntries Ptr (Ptr KeymapKey)
keysPtr
         [Ptr CUInt]
keyvals <- Int -> Ptr (Ptr CUInt) -> IO [Ptr CUInt]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
nEntries Ptr (Ptr CUInt)
keyvalsPtr
         [KeyVal]
keyvalsList <- (Ptr CUInt -> IO KeyVal) -> [Ptr CUInt] -> IO [KeyVal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Ptr CUInt
x -> (CUInt -> KeyVal) -> IO CUInt -> IO KeyVal
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> KeyVal
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO KeyVal) -> IO CUInt -> IO KeyVal
forall a b. (a -> b) -> a -> b
$ Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
x) [Ptr CUInt]
keyvals
         [KeymapKey]
keysList <- (Ptr KeymapKey -> IO KeymapKey)
-> [Ptr KeymapKey] -> IO [KeymapKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ptr KeymapKey -> IO KeymapKey
forall a. Storable a => Ptr a -> IO a
peek [Ptr KeymapKey]
keys
         Ptr () -> IO ()
g_free (Ptr (Ptr KeymapKey) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr KeymapKey)
keysPtr)
         Ptr () -> IO ()
g_free (Ptr (Ptr CUInt) -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr CUInt)
keyvalsPtr)
         Maybe ([KeymapKey], [KeyVal]) -> IO (Maybe ([KeymapKey], [KeyVal]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (([KeymapKey], [KeyVal]) -> Maybe ([KeymapKey], [KeyVal])
forall a. a -> Maybe a
Just ([KeymapKey]
keysList, [KeyVal]
keyvalsList))
       else Maybe ([KeymapKey], [KeyVal]) -> IO (Maybe ([KeymapKey], [KeyVal]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ([KeymapKey], [KeyVal])
forall a. Maybe a
Nothing

-- | Returns the direction of effective layout of the keymap.
--
-- Returns the direction of the keymap.
--
keymapGetDirection :: KeymapClass self => self
 -> IO PangoDirection -- ^ returns 'DirectionLtr' or 'DirectionRtl' if it can
                 -- determine the direction. 'DirectionNeutral' otherwise.
keymapGetDirection :: forall self. KeymapClass self => self -> IO PangoDirection
keymapGetDirection self
self =
  (CInt -> PangoDirection) -> IO CInt -> IO PangoDirection
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> PangoDirection
forall a. Enum a => Int -> a
toEnum (Int -> PangoDirection) -> (CInt -> Int) -> CInt -> PangoDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO PangoDirection) -> IO CInt -> IO PangoDirection
forall a b. (a -> b) -> a -> b
$
  (\(Keymap ForeignPtr Keymap
arg1) -> ForeignPtr Keymap -> (Ptr Keymap -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Keymap
arg1 ((Ptr Keymap -> IO CInt) -> IO CInt)
-> (Ptr Keymap -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Keymap
argPtr1 ->Ptr Keymap -> IO CInt
gdk_keymap_get_direction Ptr Keymap
argPtr1)
{-# LINE 302 "./Graphics/UI/Gtk/Gdk/Keymap.chs" #-}
    (toKeymap self)


-- | Determines if keyboard layouts for both right-to-left and left-to-right
-- languages are in use.
--
-- * Available since Gdk version 2.12
--
keymapHaveBidiLayouts :: KeymapClass self => self
 -> IO Bool -- ^ returns @True@ if there are layouts in both directions,
            -- @False@ otherwise
keymapHaveBidiLayouts :: forall self. KeymapClass self => self -> IO Bool
keymapHaveBidiLayouts self
self =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(Keymap ForeignPtr Keymap
arg1) -> ForeignPtr Keymap -> (Ptr Keymap -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Keymap
arg1 ((Ptr Keymap -> IO CInt) -> IO CInt)
-> (Ptr Keymap -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Keymap
argPtr1 ->Ptr Keymap -> IO CInt
gdk_keymap_have_bidi_layouts Ptr Keymap
argPtr1)
{-# LINE 316 "./Graphics/UI/Gtk/Gdk/Keymap.chs" #-}
    (toKeymap self)



-- | Returns whether the Caps Lock modifer is locked.
--
-- * Available since Gdk version 2.16
--
keymapGetCapsLockState :: KeymapClass self => self
 -> IO Bool -- ^ returns @True@ if Caps Lock is on
keymapGetCapsLockState :: forall self. KeymapClass self => self -> IO Bool
keymapGetCapsLockState self
self =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(Keymap ForeignPtr Keymap
arg1) -> ForeignPtr Keymap -> (Ptr Keymap -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Keymap
arg1 ((Ptr Keymap -> IO CInt) -> IO CInt)
-> (Ptr Keymap -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Keymap
argPtr1 ->Ptr Keymap -> IO CInt
gdk_keymap_get_caps_lock_state Ptr Keymap
argPtr1)
{-# LINE 329 "./Graphics/UI/Gtk/Gdk/Keymap.chs" #-}
    (toKeymap self)


--------------------
-- Signals


-- | The 'keymapDirectionChanged' signal gets emitted when the direction of the
-- keymap changes.
--
-- * Available since Gdk version 2.0
--
keymapDirectionChanged :: KeymapClass self => Signal self (IO ())
keymapDirectionChanged :: forall self. KeymapClass self => Signal self (IO ())
keymapDirectionChanged = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (SignalName -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
SignalName -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE SignalName
"direction_changed")


-- | The 'keymapKeysChanged' signal is emitted when the mapping represented by
-- @keymap@ changes.
--
-- * Available since Gdk version 2.2
--
keymapKeysChanged :: KeymapClass self => Signal self (IO ())
keymapKeysChanged :: forall self. KeymapClass self => Signal self (IO ())
keymapKeysChanged = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (SignalName -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
SignalName -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE SignalName
"keys_changed")


-- | The 'keymapStateChanged' signal is emitted when the state of the keyboard
-- changes, e.g when Caps Lock is turned on or off. See
-- 'keymapGetCapsLockState'.
--
-- * Available since Gdk version 2.16
--
keymapStateChanged :: KeymapClass self => Signal self (IO ())
keymapStateChanged :: forall self. KeymapClass self => Signal self (IO ())
keymapStateChanged = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (SignalName -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
SignalName -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE SignalName
"state_changed")

foreign import ccall safe "gdk_keymap_get_default"
  gdk_keymap_get_default :: (IO (Ptr Keymap))

foreign import ccall safe "gdk_keymap_get_for_display"
  gdk_keymap_get_for_display :: ((Ptr Display) -> (IO (Ptr Keymap)))

foreign import ccall safe "gdk_keymap_lookup_key"
  gdk_keymap_lookup_key :: ((Ptr Keymap) -> ((Ptr ()) -> (IO CUInt)))

foreign import ccall safe "gdk_keymap_translate_keyboard_state"
  gdk_keymap_translate_keyboard_state :: ((Ptr Keymap) -> (CUInt -> (CInt -> (CInt -> ((Ptr CUInt) -> ((Ptr CInt) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO CInt)))))))))

foreign import ccall safe "gdk_keymap_get_entries_for_keyval"
  gdk_keymap_get_entries_for_keyval :: ((Ptr Keymap) -> (CUInt -> ((Ptr (Ptr ())) -> ((Ptr CInt) -> (IO CInt)))))

foreign import ccall unsafe "g_free"
  g_free :: ((Ptr ()) -> (IO ()))

foreign import ccall safe "gdk_keymap_get_entries_for_keycode"
  gdk_keymap_get_entries_for_keycode :: ((Ptr Keymap) -> (CUInt -> ((Ptr (Ptr ())) -> ((Ptr (Ptr CUInt)) -> ((Ptr CInt) -> (IO CInt))))))

foreign import ccall safe "gdk_keymap_get_direction"
  gdk_keymap_get_direction :: ((Ptr Keymap) -> (IO CInt))

foreign import ccall safe "gdk_keymap_have_bidi_layouts"
  gdk_keymap_have_bidi_layouts :: ((Ptr Keymap) -> (IO CInt))

foreign import ccall safe "gdk_keymap_get_caps_lock_state"
  gdk_keymap_get_caps_lock_state :: ((Ptr Keymap) -> (IO CInt))