{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeSynonymInstances       #-}
-- |
-- Module: WildBind.X11.Internal.Key
-- Description: types and functions related to key symbols and their conversion
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __This is an internal module. Package users should not rely on this.__
module WildBind.X11.Internal.Key
    ( -- * Key
      XKeyInput (..)
    , xKeyEventToXKeyInput
    , KeyEventType (..)
      -- * Modifiers
    , KeyMaskMap (..)
    , getKeyMaskMap
      -- * XKeyEvent
    , XKeyEvent (..)
    , XMod (..)
    , ToXKeyEvent (..)
    , addXMod
    , press
    , release
    , shift
    , ctrl
    , alt
    , super
      -- * Grabs
    , xGrabKey
    , xUngrabKey
      -- * Event generation
    , xSendKeyEvent
    ) where

import           Control.Applicative       ((<$>), (<*>), (<|>))
import           Control.Monad             (forM_)
import           Control.Monad.IO.Class    (liftIO)
import           Control.Monad.Trans.Maybe (MaybeT (MaybeT))
import           Data.Bits                 ((.&.), (.|.))
import qualified Data.Bits                 as Bits
import           Data.Foldable             (fold, foldr)
import           Data.List                 (nub)
import           Data.List.NonEmpty        (NonEmpty (..))
import qualified Data.Map                  as M
import           Data.Maybe                (listToMaybe, mapMaybe)
import           Data.Monoid               ((<>))
import qualified Data.Set                  as S
import qualified Data.Text                 as T
import qualified Foreign
import qualified Graphics.X11.Xlib         as Xlib
import qualified Graphics.X11.Xlib.Extras  as XlibE

import           WildBind.Description      (Describable (..))
import qualified WildBind.Input.NumPad     as NumPad

-- | Whether the key is pressed or released.
--
-- @since 0.2.0.0
data KeyEventType = KeyPress | KeyRelease deriving (KeyEventType
KeyEventType -> KeyEventType -> Bounded KeyEventType
forall a. a -> a -> Bounded a
$cminBound :: KeyEventType
minBound :: KeyEventType
$cmaxBound :: KeyEventType
maxBound :: KeyEventType
Bounded, Int -> KeyEventType
KeyEventType -> Int
KeyEventType -> [KeyEventType]
KeyEventType -> KeyEventType
KeyEventType -> KeyEventType -> [KeyEventType]
KeyEventType -> KeyEventType -> KeyEventType -> [KeyEventType]
(KeyEventType -> KeyEventType)
-> (KeyEventType -> KeyEventType)
-> (Int -> KeyEventType)
-> (KeyEventType -> Int)
-> (KeyEventType -> [KeyEventType])
-> (KeyEventType -> KeyEventType -> [KeyEventType])
-> (KeyEventType -> KeyEventType -> [KeyEventType])
-> (KeyEventType -> KeyEventType -> KeyEventType -> [KeyEventType])
-> Enum KeyEventType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: KeyEventType -> KeyEventType
succ :: KeyEventType -> KeyEventType
$cpred :: KeyEventType -> KeyEventType
pred :: KeyEventType -> KeyEventType
$ctoEnum :: Int -> KeyEventType
toEnum :: Int -> KeyEventType
$cfromEnum :: KeyEventType -> Int
fromEnum :: KeyEventType -> Int
$cenumFrom :: KeyEventType -> [KeyEventType]
enumFrom :: KeyEventType -> [KeyEventType]
$cenumFromThen :: KeyEventType -> KeyEventType -> [KeyEventType]
enumFromThen :: KeyEventType -> KeyEventType -> [KeyEventType]
$cenumFromTo :: KeyEventType -> KeyEventType -> [KeyEventType]
enumFromTo :: KeyEventType -> KeyEventType -> [KeyEventType]
$cenumFromThenTo :: KeyEventType -> KeyEventType -> KeyEventType -> [KeyEventType]
enumFromThenTo :: KeyEventType -> KeyEventType -> KeyEventType -> [KeyEventType]
Enum, KeyEventType -> KeyEventType -> Bool
(KeyEventType -> KeyEventType -> Bool)
-> (KeyEventType -> KeyEventType -> Bool) -> Eq KeyEventType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyEventType -> KeyEventType -> Bool
== :: KeyEventType -> KeyEventType -> Bool
$c/= :: KeyEventType -> KeyEventType -> Bool
/= :: KeyEventType -> KeyEventType -> Bool
Eq, Eq KeyEventType
Eq KeyEventType =>
(KeyEventType -> KeyEventType -> Ordering)
-> (KeyEventType -> KeyEventType -> Bool)
-> (KeyEventType -> KeyEventType -> Bool)
-> (KeyEventType -> KeyEventType -> Bool)
-> (KeyEventType -> KeyEventType -> Bool)
-> (KeyEventType -> KeyEventType -> KeyEventType)
-> (KeyEventType -> KeyEventType -> KeyEventType)
-> Ord KeyEventType
KeyEventType -> KeyEventType -> Bool
KeyEventType -> KeyEventType -> Ordering
KeyEventType -> KeyEventType -> KeyEventType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: KeyEventType -> KeyEventType -> Ordering
compare :: KeyEventType -> KeyEventType -> Ordering
$c< :: KeyEventType -> KeyEventType -> Bool
< :: KeyEventType -> KeyEventType -> Bool
$c<= :: KeyEventType -> KeyEventType -> Bool
<= :: KeyEventType -> KeyEventType -> Bool
$c> :: KeyEventType -> KeyEventType -> Bool
> :: KeyEventType -> KeyEventType -> Bool
$c>= :: KeyEventType -> KeyEventType -> Bool
>= :: KeyEventType -> KeyEventType -> Bool
$cmax :: KeyEventType -> KeyEventType -> KeyEventType
max :: KeyEventType -> KeyEventType -> KeyEventType
$cmin :: KeyEventType -> KeyEventType -> KeyEventType
min :: KeyEventType -> KeyEventType -> KeyEventType
Ord, Int -> KeyEventType -> ShowS
[KeyEventType] -> ShowS
KeyEventType -> [Char]
(Int -> KeyEventType -> ShowS)
-> (KeyEventType -> [Char])
-> ([KeyEventType] -> ShowS)
-> Show KeyEventType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyEventType -> ShowS
showsPrec :: Int -> KeyEventType -> ShowS
$cshow :: KeyEventType -> [Char]
show :: KeyEventType -> [Char]
$cshowList :: [KeyEventType] -> ShowS
showList :: [KeyEventType] -> ShowS
Show)

-- | 'Xlib.KeyMask' values assigned to each modifier keys/states. If
-- the modifier doesn't exist, the mask is 0.
--
-- @since 0.2.0.0
data KeyMaskMap
  = KeyMaskMap
      { KeyMaskMap -> KeyMask
maskShift      :: Xlib.KeyMask
      , KeyMaskMap -> KeyMask
maskControl    :: Xlib.KeyMask
      , KeyMaskMap -> KeyMask
maskAlt        :: Xlib.KeyMask
      , KeyMaskMap -> KeyMask
maskSuper      :: Xlib.KeyMask
      , KeyMaskMap -> KeyMask
maskNumLock    :: Xlib.KeyMask
      , KeyMaskMap -> KeyMask
maskCapsLock   :: Xlib.KeyMask
      , KeyMaskMap -> KeyMask
maskShiftLock  :: Xlib.KeyMask
      , KeyMaskMap -> KeyMask
maskScrollLock :: Xlib.KeyMask
      }
  deriving (KeyMaskMap -> KeyMaskMap -> Bool
(KeyMaskMap -> KeyMaskMap -> Bool)
-> (KeyMaskMap -> KeyMaskMap -> Bool) -> Eq KeyMaskMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyMaskMap -> KeyMaskMap -> Bool
== :: KeyMaskMap -> KeyMaskMap -> Bool
$c/= :: KeyMaskMap -> KeyMaskMap -> Bool
/= :: KeyMaskMap -> KeyMaskMap -> Bool
Eq, Eq KeyMaskMap
Eq KeyMaskMap =>
(KeyMaskMap -> KeyMaskMap -> Ordering)
-> (KeyMaskMap -> KeyMaskMap -> Bool)
-> (KeyMaskMap -> KeyMaskMap -> Bool)
-> (KeyMaskMap -> KeyMaskMap -> Bool)
-> (KeyMaskMap -> KeyMaskMap -> Bool)
-> (KeyMaskMap -> KeyMaskMap -> KeyMaskMap)
-> (KeyMaskMap -> KeyMaskMap -> KeyMaskMap)
-> Ord KeyMaskMap
KeyMaskMap -> KeyMaskMap -> Bool
KeyMaskMap -> KeyMaskMap -> Ordering
KeyMaskMap -> KeyMaskMap -> KeyMaskMap
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: KeyMaskMap -> KeyMaskMap -> Ordering
compare :: KeyMaskMap -> KeyMaskMap -> Ordering
$c< :: KeyMaskMap -> KeyMaskMap -> Bool
< :: KeyMaskMap -> KeyMaskMap -> Bool
$c<= :: KeyMaskMap -> KeyMaskMap -> Bool
<= :: KeyMaskMap -> KeyMaskMap -> Bool
$c> :: KeyMaskMap -> KeyMaskMap -> Bool
> :: KeyMaskMap -> KeyMaskMap -> Bool
$c>= :: KeyMaskMap -> KeyMaskMap -> Bool
>= :: KeyMaskMap -> KeyMaskMap -> Bool
$cmax :: KeyMaskMap -> KeyMaskMap -> KeyMaskMap
max :: KeyMaskMap -> KeyMaskMap -> KeyMaskMap
$cmin :: KeyMaskMap -> KeyMaskMap -> KeyMaskMap
min :: KeyMaskMap -> KeyMaskMap -> KeyMaskMap
Ord, Int -> KeyMaskMap -> ShowS
[KeyMaskMap] -> ShowS
KeyMaskMap -> [Char]
(Int -> KeyMaskMap -> ShowS)
-> (KeyMaskMap -> [Char])
-> ([KeyMaskMap] -> ShowS)
-> Show KeyMaskMap
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyMaskMap -> ShowS
showsPrec :: Int -> KeyMaskMap -> ShowS
$cshow :: KeyMaskMap -> [Char]
show :: KeyMaskMap -> [Char]
$cshowList :: [KeyMaskMap] -> ShowS
showList :: [KeyMaskMap] -> ShowS
Show)

isMasked :: KeyMaskMap -> (KeyMaskMap -> Xlib.KeyMask) -> Xlib.KeyMask -> Bool
isMasked :: KeyMaskMap -> (KeyMaskMap -> KeyMask) -> KeyMask -> Bool
isMasked KeyMaskMap
kmmap KeyMaskMap -> KeyMask
accessor KeyMask
target = if (KeyMask
target KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.&. KeyMaskMap -> KeyMask
accessor KeyMaskMap
kmmap) KeyMask -> KeyMask -> Bool
forall a. Eq a => a -> a -> Bool
== KeyMask
0
                                 then Bool
False
                                 else Bool
True

-- | Class of data types that can be handled by X11. The data type can
-- tell X11 to grab key with optional modifiers, and it can be
-- extracted from a X11 Event object.
--
-- @since 0.2.0.0
class XKeyInput k where
  toKeySym :: k -> Xlib.KeySym
  -- ^ Get the X11 keysym for this input.
  toModifierMasks :: KeyMaskMap -> k -> NonEmpty Xlib.KeyMask
  -- ^ Get modifer masks to grab the keysym. The grab action is
  -- repeated for all modifier masks. By default, it just returns 0.
  toModifierMasks KeyMaskMap
_ k
_ = KeyMask -> NonEmpty KeyMask
forall a. a -> NonEmpty a
forall (m :: * -> *) a. Monad m => a -> m a
return KeyMask
0
  fromKeyEvent :: KeyMaskMap -> KeyEventType -> Xlib.KeySym -> Xlib.KeyMask -> Maybe k
  -- ^ Create the input object from a key event type, a keysym and a
  -- modifier (got from XEvent.)

-- | Partial inverse of 'toKeySym'.
fromKeySymDef :: (Bounded k, Enum k) => (k -> Xlib.KeySym) -> Xlib.KeySym -> Maybe k
fromKeySymDef :: forall k. (Bounded k, Enum k) => (k -> KeySym) -> KeySym -> Maybe k
fromKeySymDef k -> KeySym
to_conv KeySym
ks = KeySym -> Map KeySym k -> Maybe k
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup KeySym
ks (Map KeySym k -> Maybe k) -> Map KeySym k -> Maybe k
forall a b. (a -> b) -> a -> b
$ [(KeySym, k)] -> Map KeySym k
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(KeySym, k)] -> Map KeySym k) -> [(KeySym, k)] -> Map KeySym k
forall a b. (a -> b) -> a -> b
$ (k -> (KeySym, k)) -> [k] -> [(KeySym, k)]
forall a b. (a -> b) -> [a] -> [b]
map (\k
n -> (k -> KeySym
to_conv k
n, k
n)) ([k] -> [(KeySym, k)]) -> [k] -> [(KeySym, k)]
forall a b. (a -> b) -> a -> b
$ k -> k -> [k]
forall a. Enum a => a -> a -> [a]
enumFromTo k
forall a. Bounded a => a
minBound k
forall a. Bounded a => a
maxBound

-- | This input event captures the 'KeyRelease' event only. That way,
-- you can deliver events to the window that originally has the
-- keyboard focus.
instance XKeyInput NumPad.NumPadUnlocked where
  toKeySym :: NumPadUnlocked -> KeySym
toKeySym NumPadUnlocked
n = case NumPadUnlocked
n of
    NumPadUnlocked
NumPad.NumUp       -> KeySym
Xlib.xK_KP_Up
    NumPadUnlocked
NumPad.NumDown     -> KeySym
Xlib.xK_KP_Down
    NumPadUnlocked
NumPad.NumLeft     -> KeySym
Xlib.xK_KP_Left
    NumPadUnlocked
NumPad.NumRight    -> KeySym
Xlib.xK_KP_Right
    NumPadUnlocked
NumPad.NumHome     -> KeySym
Xlib.xK_KP_Home
    NumPadUnlocked
NumPad.NumPageUp   -> KeySym
Xlib.xK_KP_Page_Up
    NumPadUnlocked
NumPad.NumPageDown -> KeySym
Xlib.xK_KP_Page_Down
    NumPadUnlocked
NumPad.NumEnd      -> KeySym
Xlib.xK_KP_End
    NumPadUnlocked
NumPad.NumCenter   -> KeySym
Xlib.xK_KP_Begin
    NumPadUnlocked
NumPad.NumInsert   -> KeySym
Xlib.xK_KP_Insert
    NumPadUnlocked
NumPad.NumDelete   -> KeySym
Xlib.xK_KP_Delete
    NumPadUnlocked
NumPad.NumEnter    -> KeySym
Xlib.xK_KP_Enter
    NumPadUnlocked
NumPad.NumDivide   -> KeySym
Xlib.xK_KP_Divide
    NumPadUnlocked
NumPad.NumMulti    -> KeySym
Xlib.xK_KP_Multiply
    NumPadUnlocked
NumPad.NumMinus    -> KeySym
Xlib.xK_KP_Subtract
    NumPadUnlocked
NumPad.NumPlus     -> KeySym
Xlib.xK_KP_Add
  fromKeyEvent :: KeyMaskMap
-> KeyEventType -> KeySym -> KeyMask -> Maybe NumPadUnlocked
fromKeyEvent KeyMaskMap
_ KeyEventType
KeyPress KeySym
_ KeyMask
_ = Maybe NumPadUnlocked
forall a. Maybe a
Nothing
  fromKeyEvent KeyMaskMap
kmmask KeyEventType
KeyRelease KeySym
keysym KeyMask
mask = if Bool
is_numlocked
                                               then Maybe NumPadUnlocked
forall a. Maybe a
Nothing
                                               else (NumPadUnlocked -> KeySym) -> KeySym -> Maybe NumPadUnlocked
forall k. (Bounded k, Enum k) => (k -> KeySym) -> KeySym -> Maybe k
fromKeySymDef NumPadUnlocked -> KeySym
forall k. XKeyInput k => k -> KeySym
toKeySym KeySym
keysym
    where
      is_numlocked :: Bool
is_numlocked = KeyMaskMap -> (KeyMaskMap -> KeyMask) -> KeyMask -> Bool
isMasked KeyMaskMap
kmmask KeyMaskMap -> KeyMask
maskNumLock KeyMask
mask

-- | This input event captures the 'KeyRelease' event only. That way,
-- you can deliver events to the window that originally has the
-- keyboard focus.
instance XKeyInput NumPad.NumPadLocked where
  toKeySym :: NumPadLocked -> KeySym
toKeySym NumPadLocked
n = case NumPadLocked
n of
    NumPadLocked
NumPad.NumL0      -> KeySym
Xlib.xK_KP_0
    NumPadLocked
NumPad.NumL1      -> KeySym
Xlib.xK_KP_1
    NumPadLocked
NumPad.NumL2      -> KeySym
Xlib.xK_KP_2
    NumPadLocked
NumPad.NumL3      -> KeySym
Xlib.xK_KP_3
    NumPadLocked
NumPad.NumL4      -> KeySym
Xlib.xK_KP_4
    NumPadLocked
NumPad.NumL5      -> KeySym
Xlib.xK_KP_5
    NumPadLocked
NumPad.NumL6      -> KeySym
Xlib.xK_KP_6
    NumPadLocked
NumPad.NumL7      -> KeySym
Xlib.xK_KP_7
    NumPadLocked
NumPad.NumL8      -> KeySym
Xlib.xK_KP_8
    NumPadLocked
NumPad.NumL9      -> KeySym
Xlib.xK_KP_9
    NumPadLocked
NumPad.NumLDivide -> KeySym
Xlib.xK_KP_Divide
    NumPadLocked
NumPad.NumLMulti  -> KeySym
Xlib.xK_KP_Multiply
    NumPadLocked
NumPad.NumLMinus  -> KeySym
Xlib.xK_KP_Subtract
    NumPadLocked
NumPad.NumLPlus   -> KeySym
Xlib.xK_KP_Add
    NumPadLocked
NumPad.NumLEnter  -> KeySym
Xlib.xK_KP_Enter
    NumPadLocked
NumPad.NumLPeriod -> KeySym
Xlib.xK_KP_Delete
    -- XKeysymToKeycode() didn't return the correct keycode for XK_KP_Decimal in numpaar code...

  toModifierMasks :: KeyMaskMap -> NumPadLocked -> NonEmpty KeyMask
toModifierMasks KeyMaskMap
kmmap NumPadLocked
_ = KeyMask -> NonEmpty KeyMask
forall a. a -> NonEmpty a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyMask -> NonEmpty KeyMask) -> KeyMask -> NonEmpty KeyMask
forall a b. (a -> b) -> a -> b
$ KeyMaskMap -> KeyMask
maskNumLock KeyMaskMap
kmmap

  -- Xlib handles the [(.) (Delete)] key in a weird way. In the input
  -- event, it brings XK_KP_Decimal when NumLock enabled, XK_KP_Delete
  -- when NumLock disabled. However, XKeysymToKeycode() function won't
  -- return the correct keycode for XK_KP_Decimal. (I'm not sure how
  -- much this behavior depends on user's environment...) As a
  -- workaround in this instance, we map NumLPeriod -> XK_KP_Delete,
  -- but in the reverse map, we also respond to XK_KP_Decimal.
  fromKeyEvent :: KeyMaskMap
-> KeyEventType -> KeySym -> KeyMask -> Maybe NumPadLocked
fromKeyEvent KeyMaskMap
_ KeyEventType
KeyPress KeySym
_ KeyMask
_ = Maybe NumPadLocked
forall a. Maybe a
Nothing
  fromKeyEvent KeyMaskMap
kmmap KeyEventType
KeyRelease KeySym
keysym KeyMask
mask =
    if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
is_num_locked
    then Maybe NumPadLocked
forall a. Maybe a
Nothing
    else if KeySym
keysym KeySym -> KeySym -> Bool
forall a. Eq a => a -> a -> Bool
== KeySym
Xlib.xK_KP_Decimal
         then NumPadLocked -> Maybe NumPadLocked
forall a. a -> Maybe a
Just NumPadLocked
NumPad.NumLPeriod
         else (NumPadLocked -> KeySym) -> KeySym -> Maybe NumPadLocked
forall k. (Bounded k, Enum k) => (k -> KeySym) -> KeySym -> Maybe k
fromKeySymDef NumPadLocked -> KeySym
forall k. XKeyInput k => k -> KeySym
toKeySym KeySym
keysym
    where
      is_num_locked :: Bool
is_num_locked = KeyMaskMap -> (KeyMaskMap -> KeyMask) -> KeyMask -> Bool
isMasked KeyMaskMap
kmmap KeyMaskMap -> KeyMask
maskNumLock KeyMask
mask

-- | 'fromKeyEvent' first tries to create 'Left' (type @a@). If it
-- fails, then it tries to create 'Right' (type @b@).
instance (XKeyInput a, XKeyInput b) => XKeyInput (Either a b) where
  toKeySym :: Either a b -> KeySym
toKeySym = (a -> KeySym) -> (b -> KeySym) -> Either a b -> KeySym
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> KeySym
forall k. XKeyInput k => k -> KeySym
toKeySym b -> KeySym
forall k. XKeyInput k => k -> KeySym
toKeySym
  toModifierMasks :: KeyMaskMap -> Either a b -> NonEmpty KeyMask
toModifierMasks KeyMaskMap
kmmap = (a -> NonEmpty KeyMask)
-> (b -> NonEmpty KeyMask) -> Either a b -> NonEmpty KeyMask
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (KeyMaskMap -> a -> NonEmpty KeyMask
forall k. XKeyInput k => KeyMaskMap -> k -> NonEmpty KeyMask
toModifierMasks KeyMaskMap
kmmap) (KeyMaskMap -> b -> NonEmpty KeyMask
forall k. XKeyInput k => KeyMaskMap -> k -> NonEmpty KeyMask
toModifierMasks KeyMaskMap
kmmap)
  fromKeyEvent :: KeyMaskMap
-> KeyEventType -> KeySym -> KeyMask -> Maybe (Either a b)
fromKeyEvent KeyMaskMap
kmmap KeyEventType
ev_type KeySym
keysym KeyMask
mask =
    ((a -> Either a b) -> Maybe a -> Maybe (Either a b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a b
forall a b. a -> Either a b
Left (Maybe a -> Maybe (Either a b)) -> Maybe a -> Maybe (Either a b)
forall a b. (a -> b) -> a -> b
$ KeyMaskMap -> KeyEventType -> KeySym -> KeyMask -> Maybe a
forall k.
XKeyInput k =>
KeyMaskMap -> KeyEventType -> KeySym -> KeyMask -> Maybe k
fromKeyEvent KeyMaskMap
kmmap KeyEventType
ev_type KeySym
keysym KeyMask
mask) Maybe (Either a b) -> Maybe (Either a b) -> Maybe (Either a b)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((b -> Either a b) -> Maybe b -> Maybe (Either a b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either a b
forall a b. b -> Either a b
Right (Maybe b -> Maybe (Either a b)) -> Maybe b -> Maybe (Either a b)
forall a b. (a -> b) -> a -> b
$ KeyMaskMap -> KeyEventType -> KeySym -> KeyMask -> Maybe b
forall k.
XKeyInput k =>
KeyMaskMap -> KeyEventType -> KeySym -> KeyMask -> Maybe k
fromKeyEvent KeyMaskMap
kmmap KeyEventType
ev_type KeySym
keysym KeyMask
mask)

-- | Extract the 'XKeyInput' from the XKeyEvent.
--
-- @since 0.2.0.0
xKeyEventToXKeyInput :: XKeyInput k => KeyMaskMap -> KeyEventType -> Xlib.XKeyEventPtr -> MaybeT IO k
xKeyEventToXKeyInput :: forall k.
XKeyInput k =>
KeyMaskMap -> KeyEventType -> XKeyEventPtr -> MaybeT IO k
xKeyEventToXKeyInput KeyMaskMap
kmmap KeyEventType
ev_type XKeyEventPtr
kev = do
  KeySym
keysym <- IO (Maybe KeySym) -> MaybeT IO KeySym
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ((Maybe KeySym, [Char]) -> Maybe KeySym
forall a b. (a, b) -> a
fst ((Maybe KeySym, [Char]) -> Maybe KeySym)
-> IO (Maybe KeySym, [Char]) -> IO (Maybe KeySym)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XKeyEventPtr -> IO (Maybe KeySym, [Char])
Xlib.lookupString XKeyEventPtr
kev)
  (KeySym
_, KeySym
_, KeySym
_, CInt
_, CInt
_, CInt
_, CInt
_, KeyMask
status, KeyCode
_, Bool
_) <- IO
  (KeySym, KeySym, KeySym, CInt, CInt, CInt, CInt, KeyMask, KeyCode,
   Bool)
-> MaybeT
     IO
     (KeySym, KeySym, KeySym, CInt, CInt, CInt, CInt, KeyMask, KeyCode,
      Bool)
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (KeySym, KeySym, KeySym, CInt, CInt, CInt, CInt, KeyMask, KeyCode,
    Bool)
 -> MaybeT
      IO
      (KeySym, KeySym, KeySym, CInt, CInt, CInt, CInt, KeyMask, KeyCode,
       Bool))
-> IO
     (KeySym, KeySym, KeySym, CInt, CInt, CInt, CInt, KeyMask, KeyCode,
      Bool)
-> MaybeT
     IO
     (KeySym, KeySym, KeySym, CInt, CInt, CInt, CInt, KeyMask, KeyCode,
      Bool)
forall a b. (a -> b) -> a -> b
$ XEventPtr
-> IO
     (KeySym, KeySym, KeySym, CInt, CInt, CInt, CInt, KeyMask, KeyCode,
      Bool)
Xlib.get_KeyEvent (XEventPtr
 -> IO
      (KeySym, KeySym, KeySym, CInt, CInt, CInt, CInt, KeyMask, KeyCode,
       Bool))
-> XEventPtr
-> IO
     (KeySym, KeySym, KeySym, CInt, CInt, CInt, CInt, KeyMask, KeyCode,
      Bool)
forall a b. (a -> b) -> a -> b
$ XKeyEventPtr -> XEventPtr
forall a b. Ptr a -> Ptr b
Foreign.castPtr XKeyEventPtr
kev
  IO (Maybe k) -> MaybeT IO k
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe k) -> MaybeT IO k) -> IO (Maybe k) -> MaybeT IO k
forall a b. (a -> b) -> a -> b
$ Maybe k -> IO (Maybe k)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe k -> IO (Maybe k)) -> Maybe k -> IO (Maybe k)
forall a b. (a -> b) -> a -> b
$ KeyMaskMap -> KeyEventType -> KeySym -> KeyMask -> Maybe k
forall k.
XKeyInput k =>
KeyMaskMap -> KeyEventType -> KeySym -> KeyMask -> Maybe k
fromKeyEvent KeyMaskMap
kmmap KeyEventType
ev_type KeySym
keysym KeyMask
status

type XModifierMap = [(Xlib.Modifier, [Xlib.KeyCode])]

-- | Get current 'KeyMaskMap'.
--
-- @since 0.2.0.0
getKeyMaskMap :: Xlib.Display -> IO KeyMaskMap
getKeyMaskMap :: Display -> IO KeyMaskMap
getKeyMaskMap Display
disp = do
  XModifierMap
xmodmap <- Display -> IO XModifierMap
getXModifierMap Display
disp
  let maskFor :: KeySym -> IO KeyMask
maskFor = Display -> XModifierMap -> KeySym -> IO KeyMask
lookupModifierKeyMask Display
disp XModifierMap
xmodmap
  KeyMask
numlock_mask <- KeySym -> IO KeyMask
maskFor KeySym
Xlib.xK_Num_Lock
  KeyMask
capslock_mask <- KeySym -> IO KeyMask
maskFor KeySym
Xlib.xK_Caps_Lock
  KeyMask
shiftlock_mask <- KeySym -> IO KeyMask
maskFor KeySym
Xlib.xK_Shift_Lock
  KeyMask
scrolllock_mask <- KeySym -> IO KeyMask
maskFor KeySym
Xlib.xK_Scroll_Lock
  KeyMask
alt_mask <- KeySym -> IO KeyMask
maskFor KeySym
Xlib.xK_Alt_L
  KeyMask
super_mask <- KeySym -> IO KeyMask
maskFor KeySym
Xlib.xK_Super_L
  KeyMaskMap -> IO KeyMaskMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return KeyMaskMap { maskShift :: KeyMask
maskShift = KeyMask
Xlib.shiftMask,
                      maskControl :: KeyMask
maskControl = KeyMask
Xlib.controlMask,
                      maskAlt :: KeyMask
maskAlt = KeyMask
alt_mask,
                      maskSuper :: KeyMask
maskSuper = KeyMask
super_mask,
                      maskNumLock :: KeyMask
maskNumLock = KeyMask
numlock_mask,
                      maskCapsLock :: KeyMask
maskCapsLock = KeyMask
capslock_mask,
                      maskShiftLock :: KeyMask
maskShiftLock = KeyMask
shiftlock_mask,
                      maskScrollLock :: KeyMask
maskScrollLock = KeyMask
scrolllock_mask
                    }

getXModifierMap :: Xlib.Display -> IO XModifierMap
getXModifierMap :: Display -> IO XModifierMap
getXModifierMap = Display -> IO XModifierMap
XlibE.getModifierMapping

-- | Look up a modifier keymask associated to the given keysym. This
-- is necessary especially for NumLock modifier, because it is highly
-- dynamic in KeyCode realm. If no modifier is associated with the
-- 'ModifierKey', it returns 0.
--
-- c.f:
--
-- * grab_key.c of xbindkey package
-- * http://tronche.com/gui/x/xlib/input/keyboard-grabbing.html
-- * http://tronche.com/gui/x/xlib/input/keyboard-encoding.html
lookupModifierKeyMask :: Xlib.Display -> XModifierMap -> Xlib.KeySym -> IO Xlib.KeyMask
lookupModifierKeyMask :: Display -> XModifierMap -> KeySym -> IO KeyMask
lookupModifierKeyMask Display
disp XModifierMap
xmmap KeySym
keysym = do
  KeyCode
keycode <- Display -> KeySym -> IO KeyCode
Xlib.keysymToKeycode Display
disp KeySym
keysym
  KeyMask -> IO KeyMask
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyMask -> IO KeyMask) -> KeyMask -> IO KeyMask
forall a b. (a -> b) -> a -> b
$ KeyMask -> (KeyMask -> KeyMask) -> Maybe KeyMask -> KeyMask
forall b a. b -> (a -> b) -> Maybe a -> b
maybe KeyMask
0 KeyMask -> KeyMask
modifierToKeyMask (Maybe KeyMask -> KeyMask) -> Maybe KeyMask -> KeyMask
forall a b. (a -> b) -> a -> b
$ [KeyMask] -> Maybe KeyMask
forall a. [a] -> Maybe a
listToMaybe ([KeyMask] -> Maybe KeyMask) -> [KeyMask] -> Maybe KeyMask
forall a b. (a -> b) -> a -> b
$ ((KeyMask, [KeyCode]) -> Maybe KeyMask)
-> XModifierMap -> [KeyMask]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (KeyCode -> (KeyMask, [KeyCode]) -> Maybe KeyMask
forall {t :: * -> *} {a} {a}.
(Foldable t, Eq a) =>
a -> (a, t a) -> Maybe a
lookupXMod' KeyCode
keycode) XModifierMap
xmmap
  where
    lookupXMod' :: a -> (a, t a) -> Maybe a
lookupXMod' a
key_code (a
xmod, t a
codes) = if a
key_code a -> t a -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
codes
                                         then a -> Maybe a
forall a. a -> Maybe a
Just a
xmod
                                         else Maybe a
forall a. Maybe a
Nothing

modifierToKeyMask :: Xlib.Modifier -> Xlib.KeyMask
modifierToKeyMask :: KeyMask -> KeyMask
modifierToKeyMask = KeyMask -> Int -> KeyMask
forall a. Bits a => a -> Int -> a
Bits.shift KeyMask
1 (Int -> KeyMask) -> (KeyMask -> Int) -> KeyMask -> KeyMask
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMask -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Grab the specified key on the specified window. The key is
-- captured from now on, so the window won't get that.
--
-- @since 0.2.0.0
xGrabKey :: Xlib.Display -> Xlib.Window -> Xlib.KeySym -> Xlib.KeyMask -> IO ()
xGrabKey :: Display -> KeySym -> KeySym -> KeyMask -> IO ()
xGrabKey Display
disp KeySym
win KeySym
key KeyMask
mask = do
  KeyCode
code <- Display -> KeySym -> IO KeyCode
Xlib.keysymToKeycode Display
disp KeySym
key
  Display
-> KeyCode -> KeyMask -> KeySym -> Bool -> CInt -> CInt -> IO ()
Xlib.grabKey Display
disp KeyCode
code KeyMask
mask KeySym
win Bool
False CInt
Xlib.grabModeAsync CInt
Xlib.grabModeAsync

-- grabKey throws an exception if that key for the window is already
-- grabbed by another X client. For now, we don't handle that
-- exception.

-- | Release the grab on the specified key.
--
-- @since 0.2.0.0
xUngrabKey :: Xlib.Display -> Xlib.Window -> Xlib.KeySym -> Xlib.KeyMask -> IO ()
xUngrabKey :: Display -> KeySym -> KeySym -> KeyMask -> IO ()
xUngrabKey Display
disp KeySym
win KeySym
key KeyMask
mask = do
  KeyCode
code <- Display -> KeySym -> IO KeyCode
Xlib.keysymToKeycode Display
disp KeySym
key
  Display -> KeyCode -> KeyMask -> KeySym -> IO ()
Xlib.ungrabKey Display
disp KeyCode
code KeyMask
mask KeySym
win

-- | X11 key modifiers.
--
-- @since 0.2.0.0
data XMod = Shift | Ctrl | Alt | Super deriving (XMod
XMod -> XMod -> Bounded XMod
forall a. a -> a -> Bounded a
$cminBound :: XMod
minBound :: XMod
$cmaxBound :: XMod
maxBound :: XMod
Bounded, Int -> XMod
XMod -> Int
XMod -> [XMod]
XMod -> XMod
XMod -> XMod -> [XMod]
XMod -> XMod -> XMod -> [XMod]
(XMod -> XMod)
-> (XMod -> XMod)
-> (Int -> XMod)
-> (XMod -> Int)
-> (XMod -> [XMod])
-> (XMod -> XMod -> [XMod])
-> (XMod -> XMod -> [XMod])
-> (XMod -> XMod -> XMod -> [XMod])
-> Enum XMod
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: XMod -> XMod
succ :: XMod -> XMod
$cpred :: XMod -> XMod
pred :: XMod -> XMod
$ctoEnum :: Int -> XMod
toEnum :: Int -> XMod
$cfromEnum :: XMod -> Int
fromEnum :: XMod -> Int
$cenumFrom :: XMod -> [XMod]
enumFrom :: XMod -> [XMod]
$cenumFromThen :: XMod -> XMod -> [XMod]
enumFromThen :: XMod -> XMod -> [XMod]
$cenumFromTo :: XMod -> XMod -> [XMod]
enumFromTo :: XMod -> XMod -> [XMod]
$cenumFromThenTo :: XMod -> XMod -> XMod -> [XMod]
enumFromThenTo :: XMod -> XMod -> XMod -> [XMod]
Enum, XMod -> XMod -> Bool
(XMod -> XMod -> Bool) -> (XMod -> XMod -> Bool) -> Eq XMod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XMod -> XMod -> Bool
== :: XMod -> XMod -> Bool
$c/= :: XMod -> XMod -> Bool
/= :: XMod -> XMod -> Bool
Eq, Eq XMod
Eq XMod =>
(XMod -> XMod -> Ordering)
-> (XMod -> XMod -> Bool)
-> (XMod -> XMod -> Bool)
-> (XMod -> XMod -> Bool)
-> (XMod -> XMod -> Bool)
-> (XMod -> XMod -> XMod)
-> (XMod -> XMod -> XMod)
-> Ord XMod
XMod -> XMod -> Bool
XMod -> XMod -> Ordering
XMod -> XMod -> XMod
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: XMod -> XMod -> Ordering
compare :: XMod -> XMod -> Ordering
$c< :: XMod -> XMod -> Bool
< :: XMod -> XMod -> Bool
$c<= :: XMod -> XMod -> Bool
<= :: XMod -> XMod -> Bool
$c> :: XMod -> XMod -> Bool
> :: XMod -> XMod -> Bool
$c>= :: XMod -> XMod -> Bool
>= :: XMod -> XMod -> Bool
$cmax :: XMod -> XMod -> XMod
max :: XMod -> XMod -> XMod
$cmin :: XMod -> XMod -> XMod
min :: XMod -> XMod -> XMod
Ord, Int -> XMod -> ShowS
[XMod] -> ShowS
XMod -> [Char]
(Int -> XMod -> ShowS)
-> (XMod -> [Char]) -> ([XMod] -> ShowS) -> Show XMod
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XMod -> ShowS
showsPrec :: Int -> XMod -> ShowS
$cshow :: XMod -> [Char]
show :: XMod -> [Char]
$cshowList :: [XMod] -> ShowS
showList :: [XMod] -> ShowS
Show)

-- | High-level X11 key event.
--
-- @since 0.2.0.0
data XKeyEvent
  = XKeyEvent
      { XKeyEvent -> KeyEventType
xKeyEventType   :: KeyEventType
      , XKeyEvent -> Set XMod
xKeyEventMods   :: S.Set XMod
        -- ^ set of key modifiers enabled.
      , XKeyEvent -> KeySym
xKeyEventKeySym :: Xlib.KeySym
        -- ^ X11 KeySym for the key. "WildBind.X11.KeySym" re-exports
        -- 'KeySym' values.
      }
  deriving (XKeyEvent -> XKeyEvent -> Bool
(XKeyEvent -> XKeyEvent -> Bool)
-> (XKeyEvent -> XKeyEvent -> Bool) -> Eq XKeyEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XKeyEvent -> XKeyEvent -> Bool
== :: XKeyEvent -> XKeyEvent -> Bool
$c/= :: XKeyEvent -> XKeyEvent -> Bool
/= :: XKeyEvent -> XKeyEvent -> Bool
Eq, Eq XKeyEvent
Eq XKeyEvent =>
(XKeyEvent -> XKeyEvent -> Ordering)
-> (XKeyEvent -> XKeyEvent -> Bool)
-> (XKeyEvent -> XKeyEvent -> Bool)
-> (XKeyEvent -> XKeyEvent -> Bool)
-> (XKeyEvent -> XKeyEvent -> Bool)
-> (XKeyEvent -> XKeyEvent -> XKeyEvent)
-> (XKeyEvent -> XKeyEvent -> XKeyEvent)
-> Ord XKeyEvent
XKeyEvent -> XKeyEvent -> Bool
XKeyEvent -> XKeyEvent -> Ordering
XKeyEvent -> XKeyEvent -> XKeyEvent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: XKeyEvent -> XKeyEvent -> Ordering
compare :: XKeyEvent -> XKeyEvent -> Ordering
$c< :: XKeyEvent -> XKeyEvent -> Bool
< :: XKeyEvent -> XKeyEvent -> Bool
$c<= :: XKeyEvent -> XKeyEvent -> Bool
<= :: XKeyEvent -> XKeyEvent -> Bool
$c> :: XKeyEvent -> XKeyEvent -> Bool
> :: XKeyEvent -> XKeyEvent -> Bool
$c>= :: XKeyEvent -> XKeyEvent -> Bool
>= :: XKeyEvent -> XKeyEvent -> Bool
$cmax :: XKeyEvent -> XKeyEvent -> XKeyEvent
max :: XKeyEvent -> XKeyEvent -> XKeyEvent
$cmin :: XKeyEvent -> XKeyEvent -> XKeyEvent
min :: XKeyEvent -> XKeyEvent -> XKeyEvent
Ord, Int -> XKeyEvent -> ShowS
[XKeyEvent] -> ShowS
XKeyEvent -> [Char]
(Int -> XKeyEvent -> ShowS)
-> (XKeyEvent -> [Char])
-> ([XKeyEvent] -> ShowS)
-> Show XKeyEvent
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XKeyEvent -> ShowS
showsPrec :: Int -> XKeyEvent -> ShowS
$cshow :: XKeyEvent -> [Char]
show :: XKeyEvent -> [Char]
$cshowList :: [XKeyEvent] -> ShowS
showList :: [XKeyEvent] -> ShowS
Show)

-- | 'fromKeyEvent' always returns 'Just'.
instance XKeyInput XKeyEvent where
  toKeySym :: XKeyEvent -> KeySym
toKeySym (XKeyEvent KeyEventType
_ Set XMod
_ KeySym
ks) = KeySym
ks
  toModifierMasks :: KeyMaskMap -> XKeyEvent -> NonEmpty KeyMask
toModifierMasks KeyMaskMap
kmmap (XKeyEvent KeyEventType
_ Set XMod
mods KeySym
_) =
    (KeyMask -> KeyMask) -> NonEmpty KeyMask -> NonEmpty KeyMask
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMaskMap -> Set XMod -> KeyMask
xModsToKeyMask KeyMaskMap
kmmap Set XMod
mods) (NonEmpty KeyMask -> NonEmpty KeyMask)
-> NonEmpty KeyMask -> NonEmpty KeyMask
forall a b. (a -> b) -> a -> b
$ KeyMaskMap -> NonEmpty KeyMask
lockVariations KeyMaskMap
kmmap
  fromKeyEvent :: KeyMaskMap -> KeyEventType -> KeySym -> KeyMask -> Maybe XKeyEvent
fromKeyEvent KeyMaskMap
kmmap KeyEventType
ev_type KeySym
keysym KeyMask
mask = XKeyEvent -> Maybe XKeyEvent
forall a. a -> Maybe a
Just (XKeyEvent -> Maybe XKeyEvent) -> XKeyEvent -> Maybe XKeyEvent
forall a b. (a -> b) -> a -> b
$ KeyEventType -> Set XMod -> KeySym -> XKeyEvent
XKeyEvent KeyEventType
ev_type (KeyMaskMap -> KeyMask -> Set XMod
keyMaskToXMods KeyMaskMap
kmmap KeyMask
mask) KeySym
keysym

-- | Something that can converted to 'XKeyEvent'.
--
-- @since 0.2.0.0
class ToXKeyEvent k where
  toXKeyEvent :: k -> XKeyEvent

instance ToXKeyEvent XKeyEvent where
  toXKeyEvent :: XKeyEvent -> XKeyEvent
toXKeyEvent = XKeyEvent -> XKeyEvent
forall a. a -> a
id

-- | 'KeyPress' event of KeySym with empty 'XMod' set.
instance ToXKeyEvent Xlib.KeySym where
  toXKeyEvent :: KeySym -> XKeyEvent
toXKeyEvent KeySym
keysym = KeyEventType -> Set XMod -> KeySym -> XKeyEvent
XKeyEvent KeyEventType
KeyPress Set XMod
forall a. Monoid a => a
mempty KeySym
keysym

instance (ToXKeyEvent a, ToXKeyEvent b) => ToXKeyEvent (Either a b) where
  toXKeyEvent :: Either a b -> XKeyEvent
toXKeyEvent = (a -> XKeyEvent) -> (b -> XKeyEvent) -> Either a b -> XKeyEvent
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> XKeyEvent
forall k. ToXKeyEvent k => k -> XKeyEvent
toXKeyEvent b -> XKeyEvent
forall k. ToXKeyEvent k => k -> XKeyEvent
toXKeyEvent

instance Describable XKeyEvent where
  describe :: XKeyEvent -> ActionDescription
describe (XKeyEvent KeyEventType
ev Set XMod
mods KeySym
keysym) = ActionDescription
ev_txt ActionDescription -> ActionDescription -> ActionDescription
forall a. Semigroup a => a -> a -> a
<> [Char] -> ActionDescription
T.pack ([Char]
mods_str [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ KeySym -> [Char]
Xlib.keysymToString KeySym
keysym)
    where
      mods_str :: [Char]
mods_str = Set [Char] -> [Char]
forall m. Monoid m => Set m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Set [Char] -> [Char]) -> Set [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ (XMod -> [Char]) -> Set XMod -> Set [Char]
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (\XMod
m -> XMod -> [Char]
forall a. Show a => a -> [Char]
show XMod
m [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"+") Set XMod
mods
      ev_txt :: ActionDescription
ev_txt = case KeyEventType
ev of
        KeyEventType
KeyPress   -> ActionDescription
"press "
        KeyEventType
KeyRelease -> ActionDescription
"release "

xModToKeyMask :: KeyMaskMap -> XMod -> Xlib.KeyMask
xModToKeyMask :: KeyMaskMap -> XMod -> KeyMask
xModToKeyMask KeyMaskMap
kmmap XMod
modi = case XMod
modi of
  XMod
Shift -> KeyMaskMap -> KeyMask
maskShift KeyMaskMap
kmmap
  XMod
Ctrl  -> KeyMaskMap -> KeyMask
maskControl KeyMaskMap
kmmap
  XMod
Alt   -> KeyMaskMap -> KeyMask
maskAlt KeyMaskMap
kmmap
  XMod
Super -> KeyMaskMap -> KeyMask
maskSuper KeyMaskMap
kmmap

xModsToKeyMask :: KeyMaskMap -> S.Set XMod -> Xlib.KeyMask
xModsToKeyMask :: KeyMaskMap -> Set XMod -> KeyMask
xModsToKeyMask KeyMaskMap
kmmap = (XMod -> KeyMask -> KeyMask) -> KeyMask -> Set XMod -> KeyMask
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr XMod -> KeyMask -> KeyMask
f KeyMask
0
  where
    f :: XMod -> KeyMask -> KeyMask
f XMod
modi KeyMask
mask = KeyMaskMap -> XMod -> KeyMask
xModToKeyMask KeyMaskMap
kmmap XMod
modi KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
mask

lockVariations :: KeyMaskMap -> NonEmpty Xlib.KeyMask
lockVariations :: KeyMaskMap -> NonEmpty KeyMask
lockVariations KeyMaskMap
kmmap = [KeyMask] -> NonEmpty KeyMask
forall {a}. Num a => [a] -> NonEmpty a
toNonEmpty ([KeyMask] -> NonEmpty KeyMask) -> [KeyMask] -> NonEmpty KeyMask
forall a b. (a -> b) -> a -> b
$ [KeyMask] -> [KeyMask]
forall a. Eq a => [a] -> [a]
nub ([KeyMask] -> [KeyMask]) -> [KeyMask] -> [KeyMask]
forall a b. (a -> b) -> a -> b
$ do
  KeyMask
numl <- [KeyMask
0, KeyMaskMap -> KeyMask
maskNumLock KeyMaskMap
kmmap]
  KeyMask
capsl <- [KeyMask
0, KeyMaskMap -> KeyMask
maskCapsLock KeyMaskMap
kmmap]
  KeyMask
shiftl <- [KeyMask
0, KeyMaskMap -> KeyMask
maskShiftLock KeyMaskMap
kmmap]
  KeyMask
scl <- [KeyMask
0, KeyMaskMap -> KeyMask
maskScrollLock KeyMaskMap
kmmap]
  KeyMask -> [KeyMask]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyMask
numl KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
capsl KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftl KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
scl)
  where
    toNonEmpty :: [a] -> NonEmpty a
toNonEmpty []       = a -> NonEmpty a
forall a. a -> NonEmpty a
forall (m :: * -> *) a. Monad m => a -> m a
return a
0
    -- the result should always include 0, so the above case is not really necessary.
    toNonEmpty (a
x:[a]
rest) = a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
rest

keyMaskToXMods :: KeyMaskMap -> Xlib.KeyMask -> S.Set XMod
keyMaskToXMods :: KeyMaskMap -> KeyMask -> Set XMod
keyMaskToXMods KeyMaskMap
kmmap KeyMask
mask = [XMod] -> Set XMod
forall a. Ord a => [a] -> Set a
S.fromList([XMod] -> Set XMod) -> [XMod] -> Set XMod
forall a b. (a -> b) -> a -> b
$ (KeyMaskMap -> KeyMask, XMod) -> [XMod]
forall {a}. (KeyMaskMap -> KeyMask, a) -> [a]
toXMod ((KeyMaskMap -> KeyMask, XMod) -> [XMod])
-> [(KeyMaskMap -> KeyMask, XMod)] -> [XMod]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ (KeyMaskMap -> KeyMask
maskShift, XMod
Shift),
                                                     (KeyMaskMap -> KeyMask
maskControl, XMod
Ctrl),
                                                     (KeyMaskMap -> KeyMask
maskAlt, XMod
Alt),
                                                     (KeyMaskMap -> KeyMask
maskSuper, XMod
Super)
                                                   ]
  where
    toXMod :: (KeyMaskMap -> KeyMask, a) -> [a]
toXMod (KeyMaskMap -> KeyMask
acc, a
mod_symbol) = if KeyMaskMap -> (KeyMaskMap -> KeyMask) -> KeyMask -> Bool
isMasked KeyMaskMap
kmmap KeyMaskMap -> KeyMask
acc KeyMask
mask
                               then [a
mod_symbol]
                               else []

-- | Add a 'XMod' to 'xKeyEventMods'.
--
-- @since 0.2.0.0
addXMod :: ToXKeyEvent k => XMod -> k -> XKeyEvent
addXMod :: forall k. ToXKeyEvent k => XMod -> k -> XKeyEvent
addXMod XMod
modi k
mkey = case k -> XKeyEvent
forall k. ToXKeyEvent k => k -> XKeyEvent
toXKeyEvent k
mkey of
  XKeyEvent KeyEventType
ev_type Set XMod
mods KeySym
ks -> KeyEventType -> Set XMod -> KeySym -> XKeyEvent
XKeyEvent KeyEventType
ev_type (XMod -> Set XMod -> Set XMod
forall a. Ord a => a -> Set a -> Set a
S.insert XMod
modi Set XMod
mods) KeySym
ks

-- | Set 'KeyPress' to 'xKeyEventType'.
--
-- @since 0.2.0.0
press :: ToXKeyEvent k => k -> XKeyEvent
press :: forall k. ToXKeyEvent k => k -> XKeyEvent
press k
k = (k -> XKeyEvent
forall k. ToXKeyEvent k => k -> XKeyEvent
toXKeyEvent k
k) { xKeyEventType = KeyPress }

-- | Set 'KeyRelease' to 'xKeyEventType'.
--
-- @since 0.2.0.0
release :: ToXKeyEvent k => k -> XKeyEvent
release :: forall k. ToXKeyEvent k => k -> XKeyEvent
release k
k = (k -> XKeyEvent
forall k. ToXKeyEvent k => k -> XKeyEvent
toXKeyEvent k
k) { xKeyEventType = KeyRelease }

-- | Add 'Shift' modifier to 'xKeyEventMods'.
--
-- @since 0.2.0.0
shift :: ToXKeyEvent k => k -> XKeyEvent
shift :: forall k. ToXKeyEvent k => k -> XKeyEvent
shift = XMod -> k -> XKeyEvent
forall k. ToXKeyEvent k => XMod -> k -> XKeyEvent
addXMod XMod
Shift

-- | Add 'Ctrl' modifier to 'xKeyEventMods'.
--
-- @since 0.2.0.0
ctrl :: ToXKeyEvent k => k -> XKeyEvent
ctrl :: forall k. ToXKeyEvent k => k -> XKeyEvent
ctrl = XMod -> k -> XKeyEvent
forall k. ToXKeyEvent k => XMod -> k -> XKeyEvent
addXMod XMod
Ctrl

-- | Add 'Alt' modifier to 'xKeyEventMods'.
--
-- @since 0.2.0.0
alt :: ToXKeyEvent k => k -> XKeyEvent
alt :: forall k. ToXKeyEvent k => k -> XKeyEvent
alt = XMod -> k -> XKeyEvent
forall k. ToXKeyEvent k => XMod -> k -> XKeyEvent
addXMod XMod
Alt

-- | Add 'Super' modifier to 'xKeyEventMods'.
--
-- @since 0.2.0.0
super :: ToXKeyEvent k => k -> XKeyEvent
super :: forall k. ToXKeyEvent k => k -> XKeyEvent
super = XMod -> k -> XKeyEvent
forall k. ToXKeyEvent k => XMod -> k -> XKeyEvent
addXMod XMod
Super

-- | Send a 'XKeyEvent' to the window.
--
-- @since 0.2.0.0
xSendKeyEvent :: KeyMaskMap -> Xlib.Display -> Xlib.Window -> XKeyEvent -> IO ()
xSendKeyEvent :: KeyMaskMap -> Display -> KeySym -> XKeyEvent -> IO ()
xSendKeyEvent KeyMaskMap
kmmap Display
disp KeySym
target_win XKeyEvent
key_event = (XEventPtr -> IO ()) -> IO ()
forall a. (XEventPtr -> IO a) -> IO a
Xlib.allocaXEvent ((XEventPtr -> IO ()) -> IO ()) -> (XEventPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \XEventPtr
xev -> do
  XEventPtr -> IO ()
setupXEvent XEventPtr
xev
  Display -> KeySym -> Bool -> KeySym -> XEventPtr -> IO ()
Xlib.sendEvent Display
disp KeySym
target_win Bool
propagate KeySym
event_mask XEventPtr
xev
  Display -> Bool -> IO ()
Xlib.sync Display
disp Bool
False
  where
    propagate :: Bool
propagate = Bool
True
    event_type :: KeyEventType
event_type = XKeyEvent -> KeyEventType
xKeyEventType XKeyEvent
key_event
    event_mask :: KeySym
event_mask = case KeyEventType
event_type of
      KeyEventType
KeyPress   -> KeySym
Xlib.keyPressMask
      KeyEventType
KeyRelease -> KeySym
Xlib.keyReleaseMask
    xevent_type :: EventType
xevent_type = case KeyEventType
event_type of
      KeyEventType
KeyPress   -> EventType
Xlib.keyPress
      KeyEventType
KeyRelease -> EventType
Xlib.keyRelease
    setupXEvent :: XEventPtr -> IO ()
setupXEvent XEventPtr
xev = do
      KeyCode
key_code <- Display -> KeySym -> IO KeyCode
Xlib.keysymToKeycode Display
disp (KeySym -> IO KeyCode) -> KeySym -> IO KeyCode
forall a b. (a -> b) -> a -> b
$ XKeyEvent -> KeySym
xKeyEventKeySym XKeyEvent
key_event
      XEventPtr -> EventType -> IO ()
XlibE.setEventType XEventPtr
xev EventType
xevent_type
      XEventPtr
-> KeySym
-> KeySym
-> KeySym
-> KeyMask
-> KeyCode
-> Bool
-> IO ()
XlibE.setKeyEvent XEventPtr
xev KeySym
target_win (Display -> KeySym
Xlib.defaultRootWindow Display
disp) KeySym
subwindow KeyMask
key_mask KeyCode
key_code Bool
is_same_screen
    subwindow :: KeySym
subwindow = KeySym
0 -- I mean, 'None' in Xlib. Graphics.X11 does not define 'None' window ID, I think...
    is_same_screen :: Bool
is_same_screen = Bool
True
    key_mask :: KeyMask
key_mask = KeyMaskMap -> Set XMod -> KeyMask
xModsToKeyMask KeyMaskMap
kmmap (Set XMod -> KeyMask) -> Set XMod -> KeyMask
forall a b. (a -> b) -> a -> b
$ XKeyEvent -> Set XMod
xKeyEventMods XKeyEvent
key_event

-- c.f. create_key_event function in xlib_wrapper.c from 'xremap'
-- https://github.com/k0kubun/xremap