{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An IBusXEvent provides a wrapper of XEvent.
-- 
-- see_also: t'GI.IBus.Objects.Component.Component', t'GI.IBus.Objects.EngineDesc.EngineDesc'

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.IBus.Objects.XEvent
    ( 

-- * Exported types
    XEvent(..)                              ,
    IsXEvent                                ,
    toXEvent                                ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveXEventMethod                     ,
#endif


-- ** getEventType #method:getEventType#

#if defined(ENABLE_OVERLOADING)
    XEventGetEventTypeMethodInfo            ,
#endif
    xEventGetEventType                      ,


-- ** getGroup #method:getGroup#

#if defined(ENABLE_OVERLOADING)
    XEventGetGroupMethodInfo                ,
#endif
    xEventGetGroup                          ,


-- ** getHardwareKeycode #method:getHardwareKeycode#

#if defined(ENABLE_OVERLOADING)
    XEventGetHardwareKeycodeMethodInfo      ,
#endif
    xEventGetHardwareKeycode                ,


-- ** getIsModifier #method:getIsModifier#

#if defined(ENABLE_OVERLOADING)
    XEventGetIsModifierMethodInfo           ,
#endif
    xEventGetIsModifier                     ,


-- ** getKeyval #method:getKeyval#

#if defined(ENABLE_OVERLOADING)
    XEventGetKeyvalMethodInfo               ,
#endif
    xEventGetKeyval                         ,


-- ** getLength #method:getLength#

#if defined(ENABLE_OVERLOADING)
    XEventGetLengthMethodInfo               ,
#endif
    xEventGetLength                         ,


-- ** getPurpose #method:getPurpose#

#if defined(ENABLE_OVERLOADING)
    XEventGetPurposeMethodInfo              ,
#endif
    xEventGetPurpose                        ,


-- ** getRoot #method:getRoot#

#if defined(ENABLE_OVERLOADING)
    XEventGetRootMethodInfo                 ,
#endif
    xEventGetRoot                           ,


-- ** getSameScreen #method:getSameScreen#

#if defined(ENABLE_OVERLOADING)
    XEventGetSameScreenMethodInfo           ,
#endif
    xEventGetSameScreen                     ,


-- ** getSendEvent #method:getSendEvent#

#if defined(ENABLE_OVERLOADING)
    XEventGetSendEventMethodInfo            ,
#endif
    xEventGetSendEvent                      ,


-- ** getSerial #method:getSerial#

#if defined(ENABLE_OVERLOADING)
    XEventGetSerialMethodInfo               ,
#endif
    xEventGetSerial                         ,


-- ** getState #method:getState#

#if defined(ENABLE_OVERLOADING)
    XEventGetStateMethodInfo                ,
#endif
    xEventGetState                          ,


-- ** getString #method:getString#

#if defined(ENABLE_OVERLOADING)
    XEventGetStringMethodInfo               ,
#endif
    xEventGetString                         ,


-- ** getSubwindow #method:getSubwindow#

#if defined(ENABLE_OVERLOADING)
    XEventGetSubwindowMethodInfo            ,
#endif
    xEventGetSubwindow                      ,


-- ** getTime #method:getTime#

#if defined(ENABLE_OVERLOADING)
    XEventGetTimeMethodInfo                 ,
#endif
    xEventGetTime                           ,


-- ** getVersion #method:getVersion#

#if defined(ENABLE_OVERLOADING)
    XEventGetVersionMethodInfo              ,
#endif
    xEventGetVersion                        ,


-- ** getWindow #method:getWindow#

#if defined(ENABLE_OVERLOADING)
    XEventGetWindowMethodInfo               ,
#endif
    xEventGetWindow                         ,


-- ** getX #method:getX#

#if defined(ENABLE_OVERLOADING)
    XEventGetXMethodInfo                    ,
#endif
    xEventGetX                              ,


-- ** getXRoot #method:getXRoot#

#if defined(ENABLE_OVERLOADING)
    XEventGetXRootMethodInfo                ,
#endif
    xEventGetXRoot                          ,


-- ** getY #method:getY#

#if defined(ENABLE_OVERLOADING)
    XEventGetYMethodInfo                    ,
#endif
    xEventGetY                              ,


-- ** getYRoot #method:getYRoot#

#if defined(ENABLE_OVERLOADING)
    XEventGetYRootMethodInfo                ,
#endif
    xEventGetYRoot                          ,




 -- * Properties
-- ** eventType #attr:eventType#
-- | IBusXEventType of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventEventTypePropertyInfo             ,
#endif
    constructXEventEventType                ,
    getXEventEventType                      ,
#if defined(ENABLE_OVERLOADING)
    xEventEventType                         ,
#endif


-- ** group #attr:group#
-- | group of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventGroupPropertyInfo                 ,
#endif
    constructXEventGroup                    ,
    getXEventGroup                          ,
#if defined(ENABLE_OVERLOADING)
    xEventGroup                             ,
#endif


-- ** hardwareKeycode #attr:hardwareKeycode#
-- | hardware keycode of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventHardwareKeycodePropertyInfo       ,
#endif
    constructXEventHardwareKeycode          ,
    getXEventHardwareKeycode                ,
#if defined(ENABLE_OVERLOADING)
    xEventHardwareKeycode                   ,
#endif


-- ** isModifier #attr:isModifier#
-- | is_modifier of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventIsModifierPropertyInfo            ,
#endif
    constructXEventIsModifier               ,
    getXEventIsModifier                     ,
#if defined(ENABLE_OVERLOADING)
    xEventIsModifier                        ,
#endif


-- ** keyval #attr:keyval#
-- | keyval of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventKeyvalPropertyInfo                ,
#endif
    constructXEventKeyval                   ,
    getXEventKeyval                         ,
#if defined(ENABLE_OVERLOADING)
    xEventKeyval                            ,
#endif


-- ** length #attr:length#
-- | keyval of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventLengthPropertyInfo                ,
#endif
    constructXEventLength                   ,
    getXEventLength                         ,
#if defined(ENABLE_OVERLOADING)
    xEventLength                            ,
#endif


-- ** purpose #attr:purpose#
-- | purpose of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventPurposePropertyInfo               ,
#endif
    constructXEventPurpose                  ,
    getXEventPurpose                        ,
#if defined(ENABLE_OVERLOADING)
    xEventPurpose                           ,
#endif


-- ** root #attr:root#
-- | root window of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventRootPropertyInfo                  ,
#endif
    constructXEventRoot                     ,
    getXEventRoot                           ,
#if defined(ENABLE_OVERLOADING)
    xEventRoot                              ,
#endif


-- ** sameScreen #attr:sameScreen#
-- | same_screen of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventSameScreenPropertyInfo            ,
#endif
    constructXEventSameScreen               ,
    getXEventSameScreen                     ,
#if defined(ENABLE_OVERLOADING)
    xEventSameScreen                        ,
#endif


-- ** sendEvent #attr:sendEvent#
-- | send_event of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventSendEventPropertyInfo             ,
#endif
    constructXEventSendEvent                ,
    getXEventSendEvent                      ,
#if defined(ENABLE_OVERLOADING)
    xEventSendEvent                         ,
#endif


-- ** serial #attr:serial#
-- | serial of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventSerialPropertyInfo                ,
#endif
    constructXEventSerial                   ,
    getXEventSerial                         ,
#if defined(ENABLE_OVERLOADING)
    xEventSerial                            ,
#endif


-- ** state #attr:state#
-- | state of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventStatePropertyInfo                 ,
#endif
    constructXEventState                    ,
    getXEventState                          ,
#if defined(ENABLE_OVERLOADING)
    xEventState                             ,
#endif


-- ** string #attr:string#
-- | string of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventStringPropertyInfo                ,
#endif
    constructXEventString                   ,
    getXEventString                         ,
#if defined(ENABLE_OVERLOADING)
    xEventString                            ,
#endif


-- ** subwindow #attr:subwindow#
-- | subwindow of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventSubwindowPropertyInfo             ,
#endif
    constructXEventSubwindow                ,
    getXEventSubwindow                      ,
#if defined(ENABLE_OVERLOADING)
    xEventSubwindow                         ,
#endif


-- ** time #attr:time#
-- | time of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventTimePropertyInfo                  ,
#endif
    constructXEventTime                     ,
    getXEventTime                           ,
#if defined(ENABLE_OVERLOADING)
    xEventTime                              ,
#endif


-- ** version #attr:version#
-- | Version of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventVersionPropertyInfo               ,
#endif
    getXEventVersion                        ,
#if defined(ENABLE_OVERLOADING)
    xEventVersion                           ,
#endif


-- ** window #attr:window#
-- | window of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventWindowPropertyInfo                ,
#endif
    constructXEventWindow                   ,
    getXEventWindow                         ,
#if defined(ENABLE_OVERLOADING)
    xEventWindow                            ,
#endif


-- ** x #attr:x#
-- | x of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventXPropertyInfo                     ,
#endif
    constructXEventX                        ,
    getXEventX                              ,
#if defined(ENABLE_OVERLOADING)
    xEventX                                 ,
#endif


-- ** xRoot #attr:xRoot#
-- | root-x of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventXRootPropertyInfo                 ,
#endif
    constructXEventXRoot                    ,
    getXEventXRoot                          ,
#if defined(ENABLE_OVERLOADING)
    xEventXRoot                             ,
#endif


-- ** y #attr:y#
-- | x of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventYPropertyInfo                     ,
#endif
    constructXEventY                        ,
    getXEventY                              ,
#if defined(ENABLE_OVERLOADING)
    xEventY                                 ,
#endif


-- ** yRoot #attr:yRoot#
-- | root-y of this IBusXEvent.

#if defined(ENABLE_OVERLOADING)
    XEventYRootPropertyInfo                 ,
#endif
    constructXEventYRoot                    ,
    getXEventYRoot                          ,
#if defined(ENABLE_OVERLOADING)
    xEventYRoot                             ,
#endif




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.IBus.Enums as IBus.Enums
import {-# SOURCE #-} qualified GI.IBus.Objects.Object as IBus.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Serializable as IBus.Serializable

-- | Memory-managed wrapper type.
newtype XEvent = XEvent (SP.ManagedPtr XEvent)
    deriving (XEvent -> XEvent -> Bool
(XEvent -> XEvent -> Bool)
-> (XEvent -> XEvent -> Bool) -> Eq XEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XEvent -> XEvent -> Bool
$c/= :: XEvent -> XEvent -> Bool
== :: XEvent -> XEvent -> Bool
$c== :: XEvent -> XEvent -> Bool
Eq)

instance SP.ManagedPtrNewtype XEvent where
    toManagedPtr :: XEvent -> ManagedPtr XEvent
toManagedPtr (XEvent ManagedPtr XEvent
p) = ManagedPtr XEvent
p

foreign import ccall "ibus_x_event_get_type"
    c_ibus_x_event_get_type :: IO B.Types.GType

instance B.Types.TypedObject XEvent where
    glibType :: IO GType
glibType = IO GType
c_ibus_x_event_get_type

instance B.Types.GObject XEvent

-- | Convert 'XEvent' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue XEvent where
    toGValue :: XEvent -> IO GValue
toGValue XEvent
o = do
        GType
gtype <- IO GType
c_ibus_x_event_get_type
        XEvent -> (Ptr XEvent -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr XEvent
o (GType -> (GValue -> Ptr XEvent -> IO ()) -> Ptr XEvent -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr XEvent -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO XEvent
fromGValue GValue
gv = do
        Ptr XEvent
ptr <- GValue -> IO (Ptr XEvent)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr XEvent)
        (ManagedPtr XEvent -> XEvent) -> Ptr XEvent -> IO XEvent
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr XEvent -> XEvent
XEvent Ptr XEvent
ptr
        
    

-- | Type class for types which can be safely cast to `XEvent`, for instance with `toXEvent`.
class (SP.GObject o, O.IsDescendantOf XEvent o) => IsXEvent o
instance (SP.GObject o, O.IsDescendantOf XEvent o) => IsXEvent o

instance O.HasParentTypes XEvent
type instance O.ParentTypes XEvent = '[IBus.Serializable.Serializable, IBus.Object.Object, GObject.Object.Object]

-- | Cast to `XEvent`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toXEvent :: (MonadIO m, IsXEvent o) => o -> m XEvent
toXEvent :: o -> m XEvent
toXEvent = IO XEvent -> m XEvent
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO XEvent -> m XEvent) -> (o -> IO XEvent) -> o -> m XEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr XEvent -> XEvent) -> o -> IO XEvent
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr XEvent -> XEvent
XEvent

#if defined(ENABLE_OVERLOADING)
type family ResolveXEventMethod (t :: Symbol) (o :: *) :: * where
    ResolveXEventMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveXEventMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveXEventMethod "copy" o = IBus.Serializable.SerializableCopyMethodInfo
    ResolveXEventMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    ResolveXEventMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveXEventMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveXEventMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveXEventMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveXEventMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveXEventMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveXEventMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveXEventMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveXEventMethod "removeQattachment" o = IBus.Serializable.SerializableRemoveQattachmentMethodInfo
    ResolveXEventMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveXEventMethod "serializeObject" o = IBus.Serializable.SerializableSerializeObjectMethodInfo
    ResolveXEventMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveXEventMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveXEventMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveXEventMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveXEventMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveXEventMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveXEventMethod "getEventType" o = XEventGetEventTypeMethodInfo
    ResolveXEventMethod "getGroup" o = XEventGetGroupMethodInfo
    ResolveXEventMethod "getHardwareKeycode" o = XEventGetHardwareKeycodeMethodInfo
    ResolveXEventMethod "getIsModifier" o = XEventGetIsModifierMethodInfo
    ResolveXEventMethod "getKeyval" o = XEventGetKeyvalMethodInfo
    ResolveXEventMethod "getLength" o = XEventGetLengthMethodInfo
    ResolveXEventMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveXEventMethod "getPurpose" o = XEventGetPurposeMethodInfo
    ResolveXEventMethod "getQattachment" o = IBus.Serializable.SerializableGetQattachmentMethodInfo
    ResolveXEventMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveXEventMethod "getRoot" o = XEventGetRootMethodInfo
    ResolveXEventMethod "getSameScreen" o = XEventGetSameScreenMethodInfo
    ResolveXEventMethod "getSendEvent" o = XEventGetSendEventMethodInfo
    ResolveXEventMethod "getSerial" o = XEventGetSerialMethodInfo
    ResolveXEventMethod "getState" o = XEventGetStateMethodInfo
    ResolveXEventMethod "getString" o = XEventGetStringMethodInfo
    ResolveXEventMethod "getSubwindow" o = XEventGetSubwindowMethodInfo
    ResolveXEventMethod "getTime" o = XEventGetTimeMethodInfo
    ResolveXEventMethod "getVersion" o = XEventGetVersionMethodInfo
    ResolveXEventMethod "getWindow" o = XEventGetWindowMethodInfo
    ResolveXEventMethod "getX" o = XEventGetXMethodInfo
    ResolveXEventMethod "getXRoot" o = XEventGetXRootMethodInfo
    ResolveXEventMethod "getY" o = XEventGetYMethodInfo
    ResolveXEventMethod "getYRoot" o = XEventGetYRootMethodInfo
    ResolveXEventMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveXEventMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveXEventMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveXEventMethod "setQattachment" o = IBus.Serializable.SerializableSetQattachmentMethodInfo
    ResolveXEventMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveXEventMethod t XEvent, O.MethodInfo info XEvent p) => OL.IsLabel t (XEvent -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

-- VVV Prop "event-type"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@event-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #eventType
-- @
getXEventEventType :: (MonadIO m, IsXEvent o) => o -> m Int32
getXEventEventType :: o -> m Int32
getXEventEventType o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"event-type"

-- | Construct a `GValueConstruct` with valid value for the “@event-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventEventType :: (IsXEvent o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructXEventEventType :: Int32 -> m (GValueConstruct o)
constructXEventEventType Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"event-type" Int32
val

#if defined(ENABLE_OVERLOADING)
data XEventEventTypePropertyInfo
instance AttrInfo XEventEventTypePropertyInfo where
    type AttrAllowedOps XEventEventTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventEventTypePropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventEventTypePropertyInfo = (~) Int32
    type AttrTransferTypeConstraint XEventEventTypePropertyInfo = (~) Int32
    type AttrTransferType XEventEventTypePropertyInfo = Int32
    type AttrGetType XEventEventTypePropertyInfo = Int32
    type AttrLabel XEventEventTypePropertyInfo = "event-type"
    type AttrOrigin XEventEventTypePropertyInfo = XEvent
    attrGet = getXEventEventType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventEventType
    attrClear = undefined
#endif

-- VVV Prop "group"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@group@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #group
-- @
getXEventGroup :: (MonadIO m, IsXEvent o) => o -> m Word32
getXEventGroup :: o -> m Word32
getXEventGroup o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"group"

-- | Construct a `GValueConstruct` with valid value for the “@group@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventGroup :: (IsXEvent o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructXEventGroup :: Word32 -> m (GValueConstruct o)
constructXEventGroup Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"group" Word32
val

#if defined(ENABLE_OVERLOADING)
data XEventGroupPropertyInfo
instance AttrInfo XEventGroupPropertyInfo where
    type AttrAllowedOps XEventGroupPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventGroupPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventGroupPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint XEventGroupPropertyInfo = (~) Word32
    type AttrTransferType XEventGroupPropertyInfo = Word32
    type AttrGetType XEventGroupPropertyInfo = Word32
    type AttrLabel XEventGroupPropertyInfo = "group"
    type AttrOrigin XEventGroupPropertyInfo = XEvent
    attrGet = getXEventGroup
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventGroup
    attrClear = undefined
#endif

-- VVV Prop "hardware-keycode"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@hardware-keycode@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #hardwareKeycode
-- @
getXEventHardwareKeycode :: (MonadIO m, IsXEvent o) => o -> m Word32
getXEventHardwareKeycode :: o -> m Word32
getXEventHardwareKeycode o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"hardware-keycode"

-- | Construct a `GValueConstruct` with valid value for the “@hardware-keycode@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventHardwareKeycode :: (IsXEvent o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructXEventHardwareKeycode :: Word32 -> m (GValueConstruct o)
constructXEventHardwareKeycode Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"hardware-keycode" Word32
val

#if defined(ENABLE_OVERLOADING)
data XEventHardwareKeycodePropertyInfo
instance AttrInfo XEventHardwareKeycodePropertyInfo where
    type AttrAllowedOps XEventHardwareKeycodePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventHardwareKeycodePropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventHardwareKeycodePropertyInfo = (~) Word32
    type AttrTransferTypeConstraint XEventHardwareKeycodePropertyInfo = (~) Word32
    type AttrTransferType XEventHardwareKeycodePropertyInfo = Word32
    type AttrGetType XEventHardwareKeycodePropertyInfo = Word32
    type AttrLabel XEventHardwareKeycodePropertyInfo = "hardware-keycode"
    type AttrOrigin XEventHardwareKeycodePropertyInfo = XEvent
    attrGet = getXEventHardwareKeycode
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventHardwareKeycode
    attrClear = undefined
#endif

-- VVV Prop "is-modifier"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@is-modifier@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #isModifier
-- @
getXEventIsModifier :: (MonadIO m, IsXEvent o) => o -> m Bool
getXEventIsModifier :: o -> m Bool
getXEventIsModifier o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"is-modifier"

-- | Construct a `GValueConstruct` with valid value for the “@is-modifier@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventIsModifier :: (IsXEvent o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructXEventIsModifier :: Bool -> m (GValueConstruct o)
constructXEventIsModifier Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"is-modifier" Bool
val

#if defined(ENABLE_OVERLOADING)
data XEventIsModifierPropertyInfo
instance AttrInfo XEventIsModifierPropertyInfo where
    type AttrAllowedOps XEventIsModifierPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventIsModifierPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventIsModifierPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint XEventIsModifierPropertyInfo = (~) Bool
    type AttrTransferType XEventIsModifierPropertyInfo = Bool
    type AttrGetType XEventIsModifierPropertyInfo = Bool
    type AttrLabel XEventIsModifierPropertyInfo = "is-modifier"
    type AttrOrigin XEventIsModifierPropertyInfo = XEvent
    attrGet = getXEventIsModifier
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventIsModifier
    attrClear = undefined
#endif

-- VVV Prop "keyval"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@keyval@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #keyval
-- @
getXEventKeyval :: (MonadIO m, IsXEvent o) => o -> m Word32
getXEventKeyval :: o -> m Word32
getXEventKeyval o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"keyval"

-- | Construct a `GValueConstruct` with valid value for the “@keyval@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventKeyval :: (IsXEvent o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructXEventKeyval :: Word32 -> m (GValueConstruct o)
constructXEventKeyval Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"keyval" Word32
val

#if defined(ENABLE_OVERLOADING)
data XEventKeyvalPropertyInfo
instance AttrInfo XEventKeyvalPropertyInfo where
    type AttrAllowedOps XEventKeyvalPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventKeyvalPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventKeyvalPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint XEventKeyvalPropertyInfo = (~) Word32
    type AttrTransferType XEventKeyvalPropertyInfo = Word32
    type AttrGetType XEventKeyvalPropertyInfo = Word32
    type AttrLabel XEventKeyvalPropertyInfo = "keyval"
    type AttrOrigin XEventKeyvalPropertyInfo = XEvent
    attrGet = getXEventKeyval
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventKeyval
    attrClear = undefined
#endif

-- VVV Prop "length"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@length@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #length
-- @
getXEventLength :: (MonadIO m, IsXEvent o) => o -> m Int32
getXEventLength :: o -> m Int32
getXEventLength o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"length"

-- | Construct a `GValueConstruct` with valid value for the “@length@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventLength :: (IsXEvent o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructXEventLength :: Int32 -> m (GValueConstruct o)
constructXEventLength Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"length" Int32
val

#if defined(ENABLE_OVERLOADING)
data XEventLengthPropertyInfo
instance AttrInfo XEventLengthPropertyInfo where
    type AttrAllowedOps XEventLengthPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventLengthPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventLengthPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint XEventLengthPropertyInfo = (~) Int32
    type AttrTransferType XEventLengthPropertyInfo = Int32
    type AttrGetType XEventLengthPropertyInfo = Int32
    type AttrLabel XEventLengthPropertyInfo = "length"
    type AttrOrigin XEventLengthPropertyInfo = XEvent
    attrGet = getXEventLength
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventLength
    attrClear = undefined
#endif

-- VVV Prop "purpose"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@purpose@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #purpose
-- @
getXEventPurpose :: (MonadIO m, IsXEvent o) => o -> m T.Text
getXEventPurpose :: o -> m Text
getXEventPurpose o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getXEventPurpose" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"purpose"

-- | Construct a `GValueConstruct` with valid value for the “@purpose@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventPurpose :: (IsXEvent o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructXEventPurpose :: Text -> m (GValueConstruct o)
constructXEventPurpose Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"purpose" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data XEventPurposePropertyInfo
instance AttrInfo XEventPurposePropertyInfo where
    type AttrAllowedOps XEventPurposePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint XEventPurposePropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventPurposePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint XEventPurposePropertyInfo = (~) T.Text
    type AttrTransferType XEventPurposePropertyInfo = T.Text
    type AttrGetType XEventPurposePropertyInfo = T.Text
    type AttrLabel XEventPurposePropertyInfo = "purpose"
    type AttrOrigin XEventPurposePropertyInfo = XEvent
    attrGet = getXEventPurpose
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventPurpose
    attrClear = undefined
#endif

-- VVV Prop "root"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@root@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #root
-- @
getXEventRoot :: (MonadIO m, IsXEvent o) => o -> m Word32
getXEventRoot :: o -> m Word32
getXEventRoot o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"root"

-- | Construct a `GValueConstruct` with valid value for the “@root@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventRoot :: (IsXEvent o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructXEventRoot :: Word32 -> m (GValueConstruct o)
constructXEventRoot Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"root" Word32
val

#if defined(ENABLE_OVERLOADING)
data XEventRootPropertyInfo
instance AttrInfo XEventRootPropertyInfo where
    type AttrAllowedOps XEventRootPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventRootPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventRootPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint XEventRootPropertyInfo = (~) Word32
    type AttrTransferType XEventRootPropertyInfo = Word32
    type AttrGetType XEventRootPropertyInfo = Word32
    type AttrLabel XEventRootPropertyInfo = "root"
    type AttrOrigin XEventRootPropertyInfo = XEvent
    attrGet = getXEventRoot
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventRoot
    attrClear = undefined
#endif

-- VVV Prop "same-screen"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@same-screen@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #sameScreen
-- @
getXEventSameScreen :: (MonadIO m, IsXEvent o) => o -> m Bool
getXEventSameScreen :: o -> m Bool
getXEventSameScreen o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"same-screen"

-- | Construct a `GValueConstruct` with valid value for the “@same-screen@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventSameScreen :: (IsXEvent o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructXEventSameScreen :: Bool -> m (GValueConstruct o)
constructXEventSameScreen Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"same-screen" Bool
val

#if defined(ENABLE_OVERLOADING)
data XEventSameScreenPropertyInfo
instance AttrInfo XEventSameScreenPropertyInfo where
    type AttrAllowedOps XEventSameScreenPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventSameScreenPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventSameScreenPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint XEventSameScreenPropertyInfo = (~) Bool
    type AttrTransferType XEventSameScreenPropertyInfo = Bool
    type AttrGetType XEventSameScreenPropertyInfo = Bool
    type AttrLabel XEventSameScreenPropertyInfo = "same-screen"
    type AttrOrigin XEventSameScreenPropertyInfo = XEvent
    attrGet = getXEventSameScreen
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventSameScreen
    attrClear = undefined
#endif

-- VVV Prop "send-event"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@send-event@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #sendEvent
-- @
getXEventSendEvent :: (MonadIO m, IsXEvent o) => o -> m Int32
getXEventSendEvent :: o -> m Int32
getXEventSendEvent o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"send-event"

-- | Construct a `GValueConstruct` with valid value for the “@send-event@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventSendEvent :: (IsXEvent o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructXEventSendEvent :: Int32 -> m (GValueConstruct o)
constructXEventSendEvent Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"send-event" Int32
val

#if defined(ENABLE_OVERLOADING)
data XEventSendEventPropertyInfo
instance AttrInfo XEventSendEventPropertyInfo where
    type AttrAllowedOps XEventSendEventPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventSendEventPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventSendEventPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint XEventSendEventPropertyInfo = (~) Int32
    type AttrTransferType XEventSendEventPropertyInfo = Int32
    type AttrGetType XEventSendEventPropertyInfo = Int32
    type AttrLabel XEventSendEventPropertyInfo = "send-event"
    type AttrOrigin XEventSendEventPropertyInfo = XEvent
    attrGet = getXEventSendEvent
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventSendEvent
    attrClear = undefined
#endif

-- VVV Prop "serial"
   -- Type: TBasicType TULong
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@serial@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #serial
-- @
getXEventSerial :: (MonadIO m, IsXEvent o) => o -> m CULong
getXEventSerial :: o -> m CULong
getXEventSerial o
obj = IO CULong -> m CULong
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CULong -> m CULong) -> IO CULong -> m CULong
forall a b. (a -> b) -> a -> b
$ o -> String -> IO CULong
forall a. GObject a => a -> String -> IO CULong
B.Properties.getObjectPropertyULong o
obj String
"serial"

-- | Construct a `GValueConstruct` with valid value for the “@serial@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventSerial :: (IsXEvent o, MIO.MonadIO m) => CULong -> m (GValueConstruct o)
constructXEventSerial :: CULong -> m (GValueConstruct o)
constructXEventSerial CULong
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> CULong -> IO (GValueConstruct o)
forall o. String -> CULong -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyULong String
"serial" CULong
val

#if defined(ENABLE_OVERLOADING)
data XEventSerialPropertyInfo
instance AttrInfo XEventSerialPropertyInfo where
    type AttrAllowedOps XEventSerialPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventSerialPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventSerialPropertyInfo = (~) CULong
    type AttrTransferTypeConstraint XEventSerialPropertyInfo = (~) CULong
    type AttrTransferType XEventSerialPropertyInfo = CULong
    type AttrGetType XEventSerialPropertyInfo = CULong
    type AttrLabel XEventSerialPropertyInfo = "serial"
    type AttrOrigin XEventSerialPropertyInfo = XEvent
    attrGet = getXEventSerial
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventSerial
    attrClear = undefined
#endif

-- VVV Prop "state"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@state@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #state
-- @
getXEventState :: (MonadIO m, IsXEvent o) => o -> m Word32
getXEventState :: o -> m Word32
getXEventState o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"state"

-- | Construct a `GValueConstruct` with valid value for the “@state@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventState :: (IsXEvent o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructXEventState :: Word32 -> m (GValueConstruct o)
constructXEventState Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"state" Word32
val

#if defined(ENABLE_OVERLOADING)
data XEventStatePropertyInfo
instance AttrInfo XEventStatePropertyInfo where
    type AttrAllowedOps XEventStatePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventStatePropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventStatePropertyInfo = (~) Word32
    type AttrTransferTypeConstraint XEventStatePropertyInfo = (~) Word32
    type AttrTransferType XEventStatePropertyInfo = Word32
    type AttrGetType XEventStatePropertyInfo = Word32
    type AttrLabel XEventStatePropertyInfo = "state"
    type AttrOrigin XEventStatePropertyInfo = XEvent
    attrGet = getXEventState
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventState
    attrClear = undefined
#endif

-- VVV Prop "string"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@string@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #string
-- @
getXEventString :: (MonadIO m, IsXEvent o) => o -> m T.Text
getXEventString :: o -> m Text
getXEventString o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getXEventString" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"string"

-- | Construct a `GValueConstruct` with valid value for the “@string@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventString :: (IsXEvent o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructXEventString :: Text -> m (GValueConstruct o)
constructXEventString Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"string" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data XEventStringPropertyInfo
instance AttrInfo XEventStringPropertyInfo where
    type AttrAllowedOps XEventStringPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint XEventStringPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventStringPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint XEventStringPropertyInfo = (~) T.Text
    type AttrTransferType XEventStringPropertyInfo = T.Text
    type AttrGetType XEventStringPropertyInfo = T.Text
    type AttrLabel XEventStringPropertyInfo = "string"
    type AttrOrigin XEventStringPropertyInfo = XEvent
    attrGet = getXEventString
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventString
    attrClear = undefined
#endif

-- VVV Prop "subwindow"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@subwindow@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #subwindow
-- @
getXEventSubwindow :: (MonadIO m, IsXEvent o) => o -> m Word32
getXEventSubwindow :: o -> m Word32
getXEventSubwindow o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"subwindow"

-- | Construct a `GValueConstruct` with valid value for the “@subwindow@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventSubwindow :: (IsXEvent o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructXEventSubwindow :: Word32 -> m (GValueConstruct o)
constructXEventSubwindow Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"subwindow" Word32
val

#if defined(ENABLE_OVERLOADING)
data XEventSubwindowPropertyInfo
instance AttrInfo XEventSubwindowPropertyInfo where
    type AttrAllowedOps XEventSubwindowPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventSubwindowPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventSubwindowPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint XEventSubwindowPropertyInfo = (~) Word32
    type AttrTransferType XEventSubwindowPropertyInfo = Word32
    type AttrGetType XEventSubwindowPropertyInfo = Word32
    type AttrLabel XEventSubwindowPropertyInfo = "subwindow"
    type AttrOrigin XEventSubwindowPropertyInfo = XEvent
    attrGet = getXEventSubwindow
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventSubwindow
    attrClear = undefined
#endif

-- VVV Prop "time"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@time@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #time
-- @
getXEventTime :: (MonadIO m, IsXEvent o) => o -> m Word32
getXEventTime :: o -> m Word32
getXEventTime o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"time"

-- | Construct a `GValueConstruct` with valid value for the “@time@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventTime :: (IsXEvent o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructXEventTime :: Word32 -> m (GValueConstruct o)
constructXEventTime Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"time" Word32
val

#if defined(ENABLE_OVERLOADING)
data XEventTimePropertyInfo
instance AttrInfo XEventTimePropertyInfo where
    type AttrAllowedOps XEventTimePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventTimePropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventTimePropertyInfo = (~) Word32
    type AttrTransferTypeConstraint XEventTimePropertyInfo = (~) Word32
    type AttrTransferType XEventTimePropertyInfo = Word32
    type AttrGetType XEventTimePropertyInfo = Word32
    type AttrLabel XEventTimePropertyInfo = "time"
    type AttrOrigin XEventTimePropertyInfo = XEvent
    attrGet = getXEventTime
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventTime
    attrClear = undefined
#endif

-- VVV Prop "version"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@version@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #version
-- @
getXEventVersion :: (MonadIO m, IsXEvent o) => o -> m Word32
getXEventVersion :: o -> m Word32
getXEventVersion o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"version"

#if defined(ENABLE_OVERLOADING)
data XEventVersionPropertyInfo
instance AttrInfo XEventVersionPropertyInfo where
    type AttrAllowedOps XEventVersionPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint XEventVersionPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventVersionPropertyInfo = (~) ()
    type AttrTransferTypeConstraint XEventVersionPropertyInfo = (~) ()
    type AttrTransferType XEventVersionPropertyInfo = ()
    type AttrGetType XEventVersionPropertyInfo = Word32
    type AttrLabel XEventVersionPropertyInfo = "version"
    type AttrOrigin XEventVersionPropertyInfo = XEvent
    attrGet = getXEventVersion
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "window"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@window@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #window
-- @
getXEventWindow :: (MonadIO m, IsXEvent o) => o -> m Word32
getXEventWindow :: o -> m Word32
getXEventWindow o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"window"

-- | Construct a `GValueConstruct` with valid value for the “@window@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventWindow :: (IsXEvent o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructXEventWindow :: Word32 -> m (GValueConstruct o)
constructXEventWindow Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"window" Word32
val

#if defined(ENABLE_OVERLOADING)
data XEventWindowPropertyInfo
instance AttrInfo XEventWindowPropertyInfo where
    type AttrAllowedOps XEventWindowPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventWindowPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventWindowPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint XEventWindowPropertyInfo = (~) Word32
    type AttrTransferType XEventWindowPropertyInfo = Word32
    type AttrGetType XEventWindowPropertyInfo = Word32
    type AttrLabel XEventWindowPropertyInfo = "window"
    type AttrOrigin XEventWindowPropertyInfo = XEvent
    attrGet = getXEventWindow
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventWindow
    attrClear = undefined
#endif

-- VVV Prop "x"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@x@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #x
-- @
getXEventX :: (MonadIO m, IsXEvent o) => o -> m Int32
getXEventX :: o -> m Int32
getXEventX o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"x"

-- | Construct a `GValueConstruct` with valid value for the “@x@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventX :: (IsXEvent o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructXEventX :: Int32 -> m (GValueConstruct o)
constructXEventX Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"x" Int32
val

#if defined(ENABLE_OVERLOADING)
data XEventXPropertyInfo
instance AttrInfo XEventXPropertyInfo where
    type AttrAllowedOps XEventXPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventXPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventXPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint XEventXPropertyInfo = (~) Int32
    type AttrTransferType XEventXPropertyInfo = Int32
    type AttrGetType XEventXPropertyInfo = Int32
    type AttrLabel XEventXPropertyInfo = "x"
    type AttrOrigin XEventXPropertyInfo = XEvent
    attrGet = getXEventX
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventX
    attrClear = undefined
#endif

-- VVV Prop "x-root"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@x-root@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #xRoot
-- @
getXEventXRoot :: (MonadIO m, IsXEvent o) => o -> m Int32
getXEventXRoot :: o -> m Int32
getXEventXRoot o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"x-root"

-- | Construct a `GValueConstruct` with valid value for the “@x-root@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventXRoot :: (IsXEvent o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructXEventXRoot :: Int32 -> m (GValueConstruct o)
constructXEventXRoot Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"x-root" Int32
val

#if defined(ENABLE_OVERLOADING)
data XEventXRootPropertyInfo
instance AttrInfo XEventXRootPropertyInfo where
    type AttrAllowedOps XEventXRootPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventXRootPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventXRootPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint XEventXRootPropertyInfo = (~) Int32
    type AttrTransferType XEventXRootPropertyInfo = Int32
    type AttrGetType XEventXRootPropertyInfo = Int32
    type AttrLabel XEventXRootPropertyInfo = "x-root"
    type AttrOrigin XEventXRootPropertyInfo = XEvent
    attrGet = getXEventXRoot
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventXRoot
    attrClear = undefined
#endif

-- VVV Prop "y"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@y@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #y
-- @
getXEventY :: (MonadIO m, IsXEvent o) => o -> m Int32
getXEventY :: o -> m Int32
getXEventY o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"y"

-- | Construct a `GValueConstruct` with valid value for the “@y@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventY :: (IsXEvent o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructXEventY :: Int32 -> m (GValueConstruct o)
constructXEventY Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"y" Int32
val

#if defined(ENABLE_OVERLOADING)
data XEventYPropertyInfo
instance AttrInfo XEventYPropertyInfo where
    type AttrAllowedOps XEventYPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventYPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventYPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint XEventYPropertyInfo = (~) Int32
    type AttrTransferType XEventYPropertyInfo = Int32
    type AttrGetType XEventYPropertyInfo = Int32
    type AttrLabel XEventYPropertyInfo = "y"
    type AttrOrigin XEventYPropertyInfo = XEvent
    attrGet = getXEventY
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventY
    attrClear = undefined
#endif

-- VVV Prop "y-root"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@y-root@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' xEvent #yRoot
-- @
getXEventYRoot :: (MonadIO m, IsXEvent o) => o -> m Int32
getXEventYRoot :: o -> m Int32
getXEventYRoot o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"y-root"

-- | Construct a `GValueConstruct` with valid value for the “@y-root@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructXEventYRoot :: (IsXEvent o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructXEventYRoot :: Int32 -> m (GValueConstruct o)
constructXEventYRoot Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"y-root" Int32
val

#if defined(ENABLE_OVERLOADING)
data XEventYRootPropertyInfo
instance AttrInfo XEventYRootPropertyInfo where
    type AttrAllowedOps XEventYRootPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint XEventYRootPropertyInfo = IsXEvent
    type AttrSetTypeConstraint XEventYRootPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint XEventYRootPropertyInfo = (~) Int32
    type AttrTransferType XEventYRootPropertyInfo = Int32
    type AttrGetType XEventYRootPropertyInfo = Int32
    type AttrLabel XEventYRootPropertyInfo = "y-root"
    type AttrOrigin XEventYRootPropertyInfo = XEvent
    attrGet = getXEventYRoot
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructXEventYRoot
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList XEvent
type instance O.AttributeList XEvent = XEventAttributeList
type XEventAttributeList = ('[ '("eventType", XEventEventTypePropertyInfo), '("group", XEventGroupPropertyInfo), '("hardwareKeycode", XEventHardwareKeycodePropertyInfo), '("isModifier", XEventIsModifierPropertyInfo), '("keyval", XEventKeyvalPropertyInfo), '("length", XEventLengthPropertyInfo), '("purpose", XEventPurposePropertyInfo), '("root", XEventRootPropertyInfo), '("sameScreen", XEventSameScreenPropertyInfo), '("sendEvent", XEventSendEventPropertyInfo), '("serial", XEventSerialPropertyInfo), '("state", XEventStatePropertyInfo), '("string", XEventStringPropertyInfo), '("subwindow", XEventSubwindowPropertyInfo), '("time", XEventTimePropertyInfo), '("version", XEventVersionPropertyInfo), '("window", XEventWindowPropertyInfo), '("x", XEventXPropertyInfo), '("xRoot", XEventXRootPropertyInfo), '("y", XEventYPropertyInfo), '("yRoot", XEventYRootPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
xEventEventType :: AttrLabelProxy "eventType"
xEventEventType = AttrLabelProxy

xEventGroup :: AttrLabelProxy "group"
xEventGroup = AttrLabelProxy

xEventHardwareKeycode :: AttrLabelProxy "hardwareKeycode"
xEventHardwareKeycode = AttrLabelProxy

xEventIsModifier :: AttrLabelProxy "isModifier"
xEventIsModifier = AttrLabelProxy

xEventKeyval :: AttrLabelProxy "keyval"
xEventKeyval = AttrLabelProxy

xEventLength :: AttrLabelProxy "length"
xEventLength = AttrLabelProxy

xEventPurpose :: AttrLabelProxy "purpose"
xEventPurpose = AttrLabelProxy

xEventRoot :: AttrLabelProxy "root"
xEventRoot = AttrLabelProxy

xEventSameScreen :: AttrLabelProxy "sameScreen"
xEventSameScreen = AttrLabelProxy

xEventSendEvent :: AttrLabelProxy "sendEvent"
xEventSendEvent = AttrLabelProxy

xEventSerial :: AttrLabelProxy "serial"
xEventSerial = AttrLabelProxy

xEventState :: AttrLabelProxy "state"
xEventState = AttrLabelProxy

xEventString :: AttrLabelProxy "string"
xEventString = AttrLabelProxy

xEventSubwindow :: AttrLabelProxy "subwindow"
xEventSubwindow = AttrLabelProxy

xEventTime :: AttrLabelProxy "time"
xEventTime = AttrLabelProxy

xEventVersion :: AttrLabelProxy "version"
xEventVersion = AttrLabelProxy

xEventWindow :: AttrLabelProxy "window"
xEventWindow = AttrLabelProxy

xEventX :: AttrLabelProxy "x"
xEventX = AttrLabelProxy

xEventXRoot :: AttrLabelProxy "xRoot"
xEventXRoot = AttrLabelProxy

xEventY :: AttrLabelProxy "y"
xEventY = AttrLabelProxy

xEventYRoot :: AttrLabelProxy "yRoot"
xEventYRoot = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList XEvent = XEventSignalList
type XEventSignalList = ('[ '("destroy", IBus.Object.ObjectDestroySignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method XEvent::get_event_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "IBus" , name = "XEventType" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_event_type" ibus_x_event_get_event_type :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO CInt

-- | /No description available in the introspection data./
xEventGetEventType ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m IBus.Enums.XEventType
    -- ^ __Returns:__ IBusXEventType of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetEventType :: a -> m XEventType
xEventGetEventType a
event = IO XEventType -> m XEventType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO XEventType -> m XEventType) -> IO XEventType -> m XEventType
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CInt
result <- Ptr XEvent -> IO CInt
ibus_x_event_get_event_type Ptr XEvent
event'
    let result' :: XEventType
result' = (Int -> XEventType
forall a. Enum a => Int -> a
toEnum (Int -> XEventType) -> (CInt -> Int) -> CInt -> XEventType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    XEventType -> IO XEventType
forall (m :: * -> *) a. Monad m => a -> m a
return XEventType
result'

#if defined(ENABLE_OVERLOADING)
data XEventGetEventTypeMethodInfo
instance (signature ~ (m IBus.Enums.XEventType), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetEventTypeMethodInfo a signature where
    overloadedMethod = xEventGetEventType

#endif

-- method XEvent::get_group
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt8)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_group" ibus_x_event_get_group :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO Word8

-- | /No description available in the introspection data./
xEventGetGroup ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Word8
    -- ^ __Returns:__ group of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetGroup :: a -> m Word8
xEventGetGroup a
event = IO Word8 -> m Word8
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Word8
result <- Ptr XEvent -> IO Word8
ibus_x_event_get_group Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
result

#if defined(ENABLE_OVERLOADING)
data XEventGetGroupMethodInfo
instance (signature ~ (m Word8), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetGroupMethodInfo a signature where
    overloadedMethod = xEventGetGroup

#endif

-- method XEvent::get_hardware_keycode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt16)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_hardware_keycode" ibus_x_event_get_hardware_keycode :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO Word16

-- | /No description available in the introspection data./
xEventGetHardwareKeycode ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Word16
    -- ^ __Returns:__ hardware keycode of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetHardwareKeycode :: a -> m Word16
xEventGetHardwareKeycode a
event = IO Word16 -> m Word16
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word16 -> m Word16) -> IO Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Word16
result <- Ptr XEvent -> IO Word16
ibus_x_event_get_hardware_keycode Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Word16 -> IO Word16
forall (m :: * -> *) a. Monad m => a -> m a
return Word16
result

#if defined(ENABLE_OVERLOADING)
data XEventGetHardwareKeycodeMethodInfo
instance (signature ~ (m Word16), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetHardwareKeycodeMethodInfo a signature where
    overloadedMethod = xEventGetHardwareKeycode

#endif

-- method XEvent::get_is_modifier
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_is_modifier" ibus_x_event_get_is_modifier :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO CInt

-- | /No description available in the introspection data./
xEventGetIsModifier ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Bool
    -- ^ __Returns:__ is_modifier of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetIsModifier :: a -> m Bool
xEventGetIsModifier a
event = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CInt
result <- Ptr XEvent -> IO CInt
ibus_x_event_get_is_modifier Ptr XEvent
event'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data XEventGetIsModifierMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetIsModifierMethodInfo a signature where
    overloadedMethod = xEventGetIsModifier

#endif

-- method XEvent::get_keyval
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_keyval" ibus_x_event_get_keyval :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO Word32

-- | /No description available in the introspection data./
xEventGetKeyval ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Word32
    -- ^ __Returns:__ keyval of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetKeyval :: a -> m Word32
xEventGetKeyval a
event = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Word32
result <- Ptr XEvent -> IO Word32
ibus_x_event_get_keyval Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data XEventGetKeyvalMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetKeyvalMethodInfo a signature where
    overloadedMethod = xEventGetKeyval

#endif

-- method XEvent::get_length
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_length" ibus_x_event_get_length :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO Int32

-- | /No description available in the introspection data./
xEventGetLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Int32
    -- ^ __Returns:__ length of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetLength :: a -> m Int32
xEventGetLength a
event = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Int32
result <- Ptr XEvent -> IO Int32
ibus_x_event_get_length Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data XEventGetLengthMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetLengthMethodInfo a signature where
    overloadedMethod = xEventGetLength

#endif

-- method XEvent::get_purpose
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_purpose" ibus_x_event_get_purpose :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO CString

-- | /No description available in the introspection data./
xEventGetPurpose ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m T.Text
    -- ^ __Returns:__ purpose of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetPurpose :: a -> m Text
xEventGetPurpose a
event = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CString
result <- Ptr XEvent -> IO CString
ibus_x_event_get_purpose Ptr XEvent
event'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"xEventGetPurpose" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data XEventGetPurposeMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetPurposeMethodInfo a signature where
    overloadedMethod = xEventGetPurpose

#endif

-- method XEvent::get_root
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_root" ibus_x_event_get_root :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO Word32

-- | /No description available in the introspection data./
xEventGetRoot ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Word32
    -- ^ __Returns:__ root window of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetRoot :: a -> m Word32
xEventGetRoot a
event = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Word32
result <- Ptr XEvent -> IO Word32
ibus_x_event_get_root Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data XEventGetRootMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetRootMethodInfo a signature where
    overloadedMethod = xEventGetRoot

#endif

-- method XEvent::get_same_screen
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_same_screen" ibus_x_event_get_same_screen :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO CInt

-- | /No description available in the introspection data./
xEventGetSameScreen ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Bool
    -- ^ __Returns:__ same_screen of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetSameScreen :: a -> m Bool
xEventGetSameScreen a
event = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CInt
result <- Ptr XEvent -> IO CInt
ibus_x_event_get_same_screen Ptr XEvent
event'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data XEventGetSameScreenMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetSameScreenMethodInfo a signature where
    overloadedMethod = xEventGetSameScreen

#endif

-- method XEvent::get_send_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt8)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_send_event" ibus_x_event_get_send_event :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO Int8

-- | /No description available in the introspection data./
xEventGetSendEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Int8
    -- ^ __Returns:__ send_event of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetSendEvent :: a -> m Int8
xEventGetSendEvent a
event = IO Int8 -> m Int8
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int8 -> m Int8) -> IO Int8 -> m Int8
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Int8
result <- Ptr XEvent -> IO Int8
ibus_x_event_get_send_event Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Int8 -> IO Int8
forall (m :: * -> *) a. Monad m => a -> m a
return Int8
result

#if defined(ENABLE_OVERLOADING)
data XEventGetSendEventMethodInfo
instance (signature ~ (m Int8), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetSendEventMethodInfo a signature where
    overloadedMethod = xEventGetSendEvent

#endif

-- method XEvent::get_serial
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TULong)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_serial" ibus_x_event_get_serial :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO CULong

-- | /No description available in the introspection data./
xEventGetSerial ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m CULong
    -- ^ __Returns:__ serial of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetSerial :: a -> m CULong
xEventGetSerial a
event = IO CULong -> m CULong
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CULong -> m CULong) -> IO CULong -> m CULong
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CULong
result <- Ptr XEvent -> IO CULong
ibus_x_event_get_serial Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    CULong -> IO CULong
forall (m :: * -> *) a. Monad m => a -> m a
return CULong
result

#if defined(ENABLE_OVERLOADING)
data XEventGetSerialMethodInfo
instance (signature ~ (m CULong), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetSerialMethodInfo a signature where
    overloadedMethod = xEventGetSerial

#endif

-- method XEvent::get_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_state" ibus_x_event_get_state :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO Word32

-- | /No description available in the introspection data./
xEventGetState ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Word32
    -- ^ __Returns:__ state of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetState :: a -> m Word32
xEventGetState a
event = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Word32
result <- Ptr XEvent -> IO Word32
ibus_x_event_get_state Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data XEventGetStateMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetStateMethodInfo a signature where
    overloadedMethod = xEventGetState

#endif

-- method XEvent::get_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_string" ibus_x_event_get_string :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO CString

-- | /No description available in the introspection data./
xEventGetString ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m T.Text
    -- ^ __Returns:__ string of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetString :: a -> m Text
xEventGetString a
event = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CString
result <- Ptr XEvent -> IO CString
ibus_x_event_get_string Ptr XEvent
event'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"xEventGetString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data XEventGetStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetStringMethodInfo a signature where
    overloadedMethod = xEventGetString

#endif

-- method XEvent::get_subwindow
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_subwindow" ibus_x_event_get_subwindow :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO Word32

-- | /No description available in the introspection data./
xEventGetSubwindow ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Word32
    -- ^ __Returns:__ subwindow of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetSubwindow :: a -> m Word32
xEventGetSubwindow a
event = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Word32
result <- Ptr XEvent -> IO Word32
ibus_x_event_get_subwindow Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data XEventGetSubwindowMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetSubwindowMethodInfo a signature where
    overloadedMethod = xEventGetSubwindow

#endif

-- method XEvent::get_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_time" ibus_x_event_get_time :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO Word32

-- | /No description available in the introspection data./
xEventGetTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Word32
    -- ^ __Returns:__ time of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetTime :: a -> m Word32
xEventGetTime a
event = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Word32
result <- Ptr XEvent -> IO Word32
ibus_x_event_get_time Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data XEventGetTimeMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetTimeMethodInfo a signature where
    overloadedMethod = xEventGetTime

#endif

-- method XEvent::get_version
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_version" ibus_x_event_get_version :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO Word32

-- | /No description available in the introspection data./
xEventGetVersion ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Word32
    -- ^ __Returns:__ Version of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetVersion :: a -> m Word32
xEventGetVersion a
event = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Word32
result <- Ptr XEvent -> IO Word32
ibus_x_event_get_version Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data XEventGetVersionMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetVersionMethodInfo a signature where
    overloadedMethod = xEventGetVersion

#endif

-- method XEvent::get_window
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_window" ibus_x_event_get_window :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO Word32

-- | /No description available in the introspection data./
xEventGetWindow ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Word32
    -- ^ __Returns:__ XID of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetWindow :: a -> m Word32
xEventGetWindow a
event = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Word32
result <- Ptr XEvent -> IO Word32
ibus_x_event_get_window Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data XEventGetWindowMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetWindowMethodInfo a signature where
    overloadedMethod = xEventGetWindow

#endif

-- method XEvent::get_x
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_x" ibus_x_event_get_x :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO Int32

-- | /No description available in the introspection data./
xEventGetX ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Int32
    -- ^ __Returns:__ x of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetX :: a -> m Int32
xEventGetX a
event = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Int32
result <- Ptr XEvent -> IO Int32
ibus_x_event_get_x Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data XEventGetXMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetXMethodInfo a signature where
    overloadedMethod = xEventGetX

#endif

-- method XEvent::get_x_root
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_x_root" ibus_x_event_get_x_root :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO Int32

-- | /No description available in the introspection data./
xEventGetXRoot ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Int32
    -- ^ __Returns:__ x-root of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetXRoot :: a -> m Int32
xEventGetXRoot a
event = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Int32
result <- Ptr XEvent -> IO Int32
ibus_x_event_get_x_root Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data XEventGetXRootMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetXRootMethodInfo a signature where
    overloadedMethod = xEventGetXRoot

#endif

-- method XEvent::get_y
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_y" ibus_x_event_get_y :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO Int32

-- | /No description available in the introspection data./
xEventGetY ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Int32
    -- ^ __Returns:__ y of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetY :: a -> m Int32
xEventGetY a
event = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Int32
result <- Ptr XEvent -> IO Int32
ibus_x_event_get_y Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data XEventGetYMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetYMethodInfo a signature where
    overloadedMethod = xEventGetY

#endif

-- method XEvent::get_y_root
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "XEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusXEvent." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_x_event_get_y_root" ibus_x_event_get_y_root :: 
    Ptr XEvent ->                           -- event : TInterface (Name {namespace = "IBus", name = "XEvent"})
    IO Int32

-- | /No description available in the introspection data./
xEventGetYRoot ::
    (B.CallStack.HasCallStack, MonadIO m, IsXEvent a) =>
    a
    -- ^ /@event@/: An t'GI.IBus.Objects.XEvent.XEvent'.
    -> m Int32
    -- ^ __Returns:__ y-root of t'GI.IBus.Objects.XEvent.XEvent'
xEventGetYRoot :: a -> m Int32
xEventGetYRoot a
event = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr XEvent
event' <- a -> IO (Ptr XEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Int32
result <- Ptr XEvent -> IO Int32
ibus_x_event_get_y_root Ptr XEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data XEventGetYRootMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsXEvent a) => O.MethodInfo XEventGetYRootMethodInfo a signature where
    overloadedMethod = xEventGetYRoot

#endif