{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An opaque data type representing an IBusHotkeyProfile.

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

module GI.IBus.Objects.HotkeyProfile
    ( 

-- * Exported types
    HotkeyProfile(..)                       ,
    IsHotkeyProfile                         ,
    toHotkeyProfile                         ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveHotkeyProfileMethod              ,
#endif


-- ** addHotkey #method:addHotkey#

#if defined(ENABLE_OVERLOADING)
    HotkeyProfileAddHotkeyMethodInfo        ,
#endif
    hotkeyProfileAddHotkey                  ,


-- ** addHotkeyFromString #method:addHotkeyFromString#

#if defined(ENABLE_OVERLOADING)
    HotkeyProfileAddHotkeyFromStringMethodInfo,
#endif
    hotkeyProfileAddHotkeyFromString        ,


-- ** filterKeyEvent #method:filterKeyEvent#

#if defined(ENABLE_OVERLOADING)
    HotkeyProfileFilterKeyEventMethodInfo   ,
#endif
    hotkeyProfileFilterKeyEvent             ,


-- ** lookupHotkey #method:lookupHotkey#

#if defined(ENABLE_OVERLOADING)
    HotkeyProfileLookupHotkeyMethodInfo     ,
#endif
    hotkeyProfileLookupHotkey               ,


-- ** new #method:new#

    hotkeyProfileNew                        ,


-- ** removeHotkey #method:removeHotkey#

#if defined(ENABLE_OVERLOADING)
    HotkeyProfileRemoveHotkeyMethodInfo     ,
#endif
    hotkeyProfileRemoveHotkey               ,


-- ** removeHotkeyByEvent #method:removeHotkeyByEvent#

#if defined(ENABLE_OVERLOADING)
    HotkeyProfileRemoveHotkeyByEventMethodInfo,
#endif
    hotkeyProfileRemoveHotkeyByEvent        ,




 -- * Signals
-- ** trigger #signal:trigger#

    C_HotkeyProfileTriggerCallback          ,
    HotkeyProfileTriggerCallback            ,
#if defined(ENABLE_OVERLOADING)
    HotkeyProfileTriggerSignalInfo          ,
#endif
    afterHotkeyProfileTrigger               ,
    genClosure_HotkeyProfileTrigger         ,
    mk_HotkeyProfileTriggerCallback         ,
    noHotkeyProfileTriggerCallback          ,
    onHotkeyProfileTrigger                  ,
    wrap_HotkeyProfileTriggerCallback       ,




    ) 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.Objects.Object as IBus.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.Serializable as IBus.Serializable

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

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

foreign import ccall "ibus_hotkey_profile_get_type"
    c_ibus_hotkey_profile_get_type :: IO B.Types.GType

instance B.Types.TypedObject HotkeyProfile where
    glibType :: IO GType
glibType = IO GType
c_ibus_hotkey_profile_get_type

instance B.Types.GObject HotkeyProfile

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveHotkeyProfileMethod (t :: Symbol) (o :: *) :: * where
    ResolveHotkeyProfileMethod "addHotkey" o = HotkeyProfileAddHotkeyMethodInfo
    ResolveHotkeyProfileMethod "addHotkeyFromString" o = HotkeyProfileAddHotkeyFromStringMethodInfo
    ResolveHotkeyProfileMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveHotkeyProfileMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveHotkeyProfileMethod "copy" o = IBus.Serializable.SerializableCopyMethodInfo
    ResolveHotkeyProfileMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    ResolveHotkeyProfileMethod "filterKeyEvent" o = HotkeyProfileFilterKeyEventMethodInfo
    ResolveHotkeyProfileMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveHotkeyProfileMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveHotkeyProfileMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveHotkeyProfileMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveHotkeyProfileMethod "lookupHotkey" o = HotkeyProfileLookupHotkeyMethodInfo
    ResolveHotkeyProfileMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveHotkeyProfileMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveHotkeyProfileMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveHotkeyProfileMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveHotkeyProfileMethod "removeHotkey" o = HotkeyProfileRemoveHotkeyMethodInfo
    ResolveHotkeyProfileMethod "removeHotkeyByEvent" o = HotkeyProfileRemoveHotkeyByEventMethodInfo
    ResolveHotkeyProfileMethod "removeQattachment" o = IBus.Serializable.SerializableRemoveQattachmentMethodInfo
    ResolveHotkeyProfileMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveHotkeyProfileMethod "serializeObject" o = IBus.Serializable.SerializableSerializeObjectMethodInfo
    ResolveHotkeyProfileMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveHotkeyProfileMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveHotkeyProfileMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveHotkeyProfileMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveHotkeyProfileMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveHotkeyProfileMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveHotkeyProfileMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveHotkeyProfileMethod "getQattachment" o = IBus.Serializable.SerializableGetQattachmentMethodInfo
    ResolveHotkeyProfileMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveHotkeyProfileMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveHotkeyProfileMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveHotkeyProfileMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveHotkeyProfileMethod "setQattachment" o = IBus.Serializable.SerializableSetQattachmentMethodInfo
    ResolveHotkeyProfileMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal HotkeyProfile::trigger
-- | Emitted when a hotkey is pressed and the hotkey is in profile.
-- Implement the member function @/trigger()/@ in extended class to receive this signal.
-- 
-- \<note>\<para>The last parameter, user_data is not actually a valid parameter. It is displayed because of GtkDoc bug.\<\/para>\<\/note>
type HotkeyProfileTriggerCallback =
    Word32
    -- ^ /@event@/: An event in GQuark.
    -> Ptr ()
    -- ^ /@userData@/: User data for callback.
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `HotkeyProfileTriggerCallback`@.
noHotkeyProfileTriggerCallback :: Maybe HotkeyProfileTriggerCallback
noHotkeyProfileTriggerCallback :: Maybe HotkeyProfileTriggerCallback
noHotkeyProfileTriggerCallback = Maybe HotkeyProfileTriggerCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_HotkeyProfileTriggerCallback =
    Ptr () ->                               -- object
    Word32 ->
    Ptr () ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_HotkeyProfileTriggerCallback`.
foreign import ccall "wrapper"
    mk_HotkeyProfileTriggerCallback :: C_HotkeyProfileTriggerCallback -> IO (FunPtr C_HotkeyProfileTriggerCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_HotkeyProfileTrigger :: MonadIO m => HotkeyProfileTriggerCallback -> m (GClosure C_HotkeyProfileTriggerCallback)
genClosure_HotkeyProfileTrigger :: HotkeyProfileTriggerCallback
-> m (GClosure C_HotkeyProfileTriggerCallback)
genClosure_HotkeyProfileTrigger HotkeyProfileTriggerCallback
cb = IO (GClosure C_HotkeyProfileTriggerCallback)
-> m (GClosure C_HotkeyProfileTriggerCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_HotkeyProfileTriggerCallback)
 -> m (GClosure C_HotkeyProfileTriggerCallback))
-> IO (GClosure C_HotkeyProfileTriggerCallback)
-> m (GClosure C_HotkeyProfileTriggerCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_HotkeyProfileTriggerCallback
cb' = HotkeyProfileTriggerCallback -> C_HotkeyProfileTriggerCallback
wrap_HotkeyProfileTriggerCallback HotkeyProfileTriggerCallback
cb
    C_HotkeyProfileTriggerCallback
-> IO (FunPtr C_HotkeyProfileTriggerCallback)
mk_HotkeyProfileTriggerCallback C_HotkeyProfileTriggerCallback
cb' IO (FunPtr C_HotkeyProfileTriggerCallback)
-> (FunPtr C_HotkeyProfileTriggerCallback
    -> IO (GClosure C_HotkeyProfileTriggerCallback))
-> IO (GClosure C_HotkeyProfileTriggerCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_HotkeyProfileTriggerCallback
-> IO (GClosure C_HotkeyProfileTriggerCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `HotkeyProfileTriggerCallback` into a `C_HotkeyProfileTriggerCallback`.
wrap_HotkeyProfileTriggerCallback ::
    HotkeyProfileTriggerCallback ->
    C_HotkeyProfileTriggerCallback
wrap_HotkeyProfileTriggerCallback :: HotkeyProfileTriggerCallback -> C_HotkeyProfileTriggerCallback
wrap_HotkeyProfileTriggerCallback HotkeyProfileTriggerCallback
_cb Ptr ()
_ Word32
event Ptr ()
userData Ptr ()
_ = do
    HotkeyProfileTriggerCallback
_cb  Word32
event Ptr ()
userData


-- | Connect a signal handler for the [trigger](#signal:trigger) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' hotkeyProfile #trigger callback
-- @
-- 
-- This signal admits a optional parameter @detail@.
-- If it's not @Nothing@, we will connect to “@trigger::detail@” instead.
-- 
onHotkeyProfileTrigger :: (IsHotkeyProfile a, MonadIO m) => a -> P.Maybe T.Text -> HotkeyProfileTriggerCallback -> m SignalHandlerId
onHotkeyProfileTrigger :: a
-> Maybe Text -> HotkeyProfileTriggerCallback -> m SignalHandlerId
onHotkeyProfileTrigger a
obj Maybe Text
detail HotkeyProfileTriggerCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_HotkeyProfileTriggerCallback
cb' = HotkeyProfileTriggerCallback -> C_HotkeyProfileTriggerCallback
wrap_HotkeyProfileTriggerCallback HotkeyProfileTriggerCallback
cb
    FunPtr C_HotkeyProfileTriggerCallback
cb'' <- C_HotkeyProfileTriggerCallback
-> IO (FunPtr C_HotkeyProfileTriggerCallback)
mk_HotkeyProfileTriggerCallback C_HotkeyProfileTriggerCallback
cb'
    a
-> Text
-> FunPtr C_HotkeyProfileTriggerCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"trigger" FunPtr C_HotkeyProfileTriggerCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
detail

-- | Connect a signal handler for the [trigger](#signal:trigger) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' hotkeyProfile #trigger callback
-- @
-- 
-- This signal admits a optional parameter @detail@.
-- If it's not @Nothing@, we will connect to “@trigger::detail@” instead.
-- 
afterHotkeyProfileTrigger :: (IsHotkeyProfile a, MonadIO m) => a -> P.Maybe T.Text -> HotkeyProfileTriggerCallback -> m SignalHandlerId
afterHotkeyProfileTrigger :: a
-> Maybe Text -> HotkeyProfileTriggerCallback -> m SignalHandlerId
afterHotkeyProfileTrigger a
obj Maybe Text
detail HotkeyProfileTriggerCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_HotkeyProfileTriggerCallback
cb' = HotkeyProfileTriggerCallback -> C_HotkeyProfileTriggerCallback
wrap_HotkeyProfileTriggerCallback HotkeyProfileTriggerCallback
cb
    FunPtr C_HotkeyProfileTriggerCallback
cb'' <- C_HotkeyProfileTriggerCallback
-> IO (FunPtr C_HotkeyProfileTriggerCallback)
mk_HotkeyProfileTriggerCallback C_HotkeyProfileTriggerCallback
cb'
    a
-> Text
-> FunPtr C_HotkeyProfileTriggerCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"trigger" FunPtr C_HotkeyProfileTriggerCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
detail


#if defined(ENABLE_OVERLOADING)
data HotkeyProfileTriggerSignalInfo
instance SignalInfo HotkeyProfileTriggerSignalInfo where
    type HaskellCallbackType HotkeyProfileTriggerSignalInfo = HotkeyProfileTriggerCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_HotkeyProfileTriggerCallback cb
        cb'' <- mk_HotkeyProfileTriggerCallback cb'
        connectSignalFunPtr obj "trigger" cb'' connectMode detail

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList HotkeyProfile
type instance O.AttributeList HotkeyProfile = HotkeyProfileAttributeList
type HotkeyProfileAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method HotkeyProfile::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "IBus" , name = "HotkeyProfile" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_hotkey_profile_new" ibus_hotkey_profile_new :: 
    IO (Ptr HotkeyProfile)

-- | Creates a new t'GI.IBus.Objects.HotkeyProfile.HotkeyProfile'.
hotkeyProfileNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m HotkeyProfile
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.HotkeyProfile.HotkeyProfile'.
hotkeyProfileNew :: m HotkeyProfile
hotkeyProfileNew  = IO HotkeyProfile -> m HotkeyProfile
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HotkeyProfile -> m HotkeyProfile)
-> IO HotkeyProfile -> m HotkeyProfile
forall a b. (a -> b) -> a -> b
$ do
    Ptr HotkeyProfile
result <- IO (Ptr HotkeyProfile)
ibus_hotkey_profile_new
    Text -> Ptr HotkeyProfile -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"hotkeyProfileNew" Ptr HotkeyProfile
result
    HotkeyProfile
result' <- ((ManagedPtr HotkeyProfile -> HotkeyProfile)
-> Ptr HotkeyProfile -> IO HotkeyProfile
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr HotkeyProfile -> HotkeyProfile
HotkeyProfile) Ptr HotkeyProfile
result
    HotkeyProfile -> IO HotkeyProfile
forall (m :: * -> *) a. Monad m => a -> m a
return HotkeyProfile
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method HotkeyProfile::add_hotkey
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "profile"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "HotkeyProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusHotkeyProfile."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Keycode of the hotkey."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifiers"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Modifiers of the hotkey."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The event to be associated."
--                 , 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_hotkey_profile_add_hotkey" ibus_hotkey_profile_add_hotkey :: 
    Ptr HotkeyProfile ->                    -- profile : TInterface (Name {namespace = "IBus", name = "HotkeyProfile"})
    Word32 ->                               -- keyval : TBasicType TUInt
    Word32 ->                               -- modifiers : TBasicType TUInt
    Word32 ->                               -- event : TBasicType TUInt32
    IO CInt

-- | Adds a hotkey and its associated event to an t'GI.IBus.Objects.HotkeyProfile.HotkeyProfile'.
hotkeyProfileAddHotkey ::
    (B.CallStack.HasCallStack, MonadIO m, IsHotkeyProfile a) =>
    a
    -- ^ /@profile@/: An IBusHotkeyProfile.
    -> Word32
    -- ^ /@keyval@/: Keycode of the hotkey.
    -> Word32
    -- ^ /@modifiers@/: Modifiers of the hotkey.
    -> Word32
    -- ^ /@event@/: The event to be associated.
    -> m Bool
    -- ^ __Returns:__ Always 'P.True'.
hotkeyProfileAddHotkey :: a -> Word32 -> Word32 -> Word32 -> m Bool
hotkeyProfileAddHotkey a
profile Word32
keyval Word32
modifiers Word32
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 HotkeyProfile
profile' <- a -> IO (Ptr HotkeyProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CInt
result <- Ptr HotkeyProfile -> Word32 -> Word32 -> Word32 -> IO CInt
ibus_hotkey_profile_add_hotkey Ptr HotkeyProfile
profile' Word32
keyval Word32
modifiers Word32
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
profile
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data HotkeyProfileAddHotkeyMethodInfo
instance (signature ~ (Word32 -> Word32 -> Word32 -> m Bool), MonadIO m, IsHotkeyProfile a) => O.MethodInfo HotkeyProfileAddHotkeyMethodInfo a signature where
    overloadedMethod = hotkeyProfileAddHotkey

#endif

-- method HotkeyProfile::add_hotkey_from_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "profile"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "HotkeyProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusHotkeyProfile."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "str"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Key in string representation.  '+' is the separator."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The event to be associated."
--                 , 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_hotkey_profile_add_hotkey_from_string" ibus_hotkey_profile_add_hotkey_from_string :: 
    Ptr HotkeyProfile ->                    -- profile : TInterface (Name {namespace = "IBus", name = "HotkeyProfile"})
    CString ->                              -- str : TBasicType TUTF8
    Word32 ->                               -- event : TBasicType TUInt32
    IO CInt

-- | Adds a hotkey and its associated event to an t'GI.IBus.Objects.HotkeyProfile.HotkeyProfile'.
-- The hotkey is in string format, such like
-- \<constant>Control+Shift+A\<\/constant>.
hotkeyProfileAddHotkeyFromString ::
    (B.CallStack.HasCallStack, MonadIO m, IsHotkeyProfile a) =>
    a
    -- ^ /@profile@/: An IBusHotkeyProfile.
    -> T.Text
    -- ^ /@str@/: Key in string representation.  \'+\' is the separator.
    -> Word32
    -- ^ /@event@/: The event to be associated.
    -> m Bool
    -- ^ __Returns:__ FALSE if /@str@/ contains invalid symbol; TRUE otherwise.
hotkeyProfileAddHotkeyFromString :: a -> Text -> Word32 -> m Bool
hotkeyProfileAddHotkeyFromString a
profile Text
str Word32
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 HotkeyProfile
profile' <- a -> IO (Ptr HotkeyProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CString
str' <- Text -> IO CString
textToCString Text
str
    CInt
result <- Ptr HotkeyProfile -> CString -> Word32 -> IO CInt
ibus_hotkey_profile_add_hotkey_from_string Ptr HotkeyProfile
profile' CString
str' Word32
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
profile
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
str'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data HotkeyProfileAddHotkeyFromStringMethodInfo
instance (signature ~ (T.Text -> Word32 -> m Bool), MonadIO m, IsHotkeyProfile a) => O.MethodInfo HotkeyProfileAddHotkeyFromStringMethodInfo a signature where
    overloadedMethod = hotkeyProfileAddHotkeyFromString

#endif

-- method HotkeyProfile::filter_key_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "profile"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "HotkeyProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusHotkeyProfile."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Keycode of the hotkey."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifiers"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Modifiers of the hotkey."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prev_keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Keycode of the hotkey."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prev_modifiers"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Modifiers of the hotkey."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data for signal \"trigger\"."
--                 , 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_hotkey_profile_filter_key_event" ibus_hotkey_profile_filter_key_event :: 
    Ptr HotkeyProfile ->                    -- profile : TInterface (Name {namespace = "IBus", name = "HotkeyProfile"})
    Word32 ->                               -- keyval : TBasicType TUInt
    Word32 ->                               -- modifiers : TBasicType TUInt
    Word32 ->                               -- prev_keyval : TBasicType TUInt
    Word32 ->                               -- prev_modifiers : TBasicType TUInt
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO Word32

-- | Emits a \<constant>[trigger](#g:signal:trigger)\<\/constant> signal when a hotkey is in a profile.
hotkeyProfileFilterKeyEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsHotkeyProfile a) =>
    a
    -- ^ /@profile@/: An IBusHotkeyProfile.
    -> Word32
    -- ^ /@keyval@/: Keycode of the hotkey.
    -> Word32
    -- ^ /@modifiers@/: Modifiers of the hotkey.
    -> Word32
    -- ^ /@prevKeyval@/: Keycode of the hotkey.
    -> Word32
    -- ^ /@prevModifiers@/: Modifiers of the hotkey.
    -> Ptr ()
    -- ^ /@userData@/: user data for signal \"trigger\".
    -> m Word32
    -- ^ __Returns:__ 0 if releasing a hotkey and the hotkey is not in the profile;
    -- an associated event otherwise.
    -- 
    -- See also: [trigger](#g:signal:trigger)
hotkeyProfileFilterKeyEvent :: a -> Word32 -> Word32 -> Word32 -> Word32 -> Ptr () -> m Word32
hotkeyProfileFilterKeyEvent a
profile Word32
keyval Word32
modifiers Word32
prevKeyval Word32
prevModifiers Ptr ()
userData = 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 HotkeyProfile
profile' <- a -> IO (Ptr HotkeyProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    Word32
result <- Ptr HotkeyProfile
-> Word32 -> Word32 -> Word32 -> Word32 -> Ptr () -> IO Word32
ibus_hotkey_profile_filter_key_event Ptr HotkeyProfile
profile' Word32
keyval Word32
modifiers Word32
prevKeyval Word32
prevModifiers Ptr ()
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data HotkeyProfileFilterKeyEventMethodInfo
instance (signature ~ (Word32 -> Word32 -> Word32 -> Word32 -> Ptr () -> m Word32), MonadIO m, IsHotkeyProfile a) => O.MethodInfo HotkeyProfileFilterKeyEventMethodInfo a signature where
    overloadedMethod = hotkeyProfileFilterKeyEvent

#endif

-- method HotkeyProfile::lookup_hotkey
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "profile"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "HotkeyProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusHotkeyProfile."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Keycode of the hotkey."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifiers"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Modifiers of the hotkey."
--                 , 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_hotkey_profile_lookup_hotkey" ibus_hotkey_profile_lookup_hotkey :: 
    Ptr HotkeyProfile ->                    -- profile : TInterface (Name {namespace = "IBus", name = "HotkeyProfile"})
    Word32 ->                               -- keyval : TBasicType TUInt
    Word32 ->                               -- modifiers : TBasicType TUInt
    IO Word32

-- | /No description available in the introspection data./
hotkeyProfileLookupHotkey ::
    (B.CallStack.HasCallStack, MonadIO m, IsHotkeyProfile a) =>
    a
    -- ^ /@profile@/: An IBusHotkeyProfile.
    -> Word32
    -- ^ /@keyval@/: Keycode of the hotkey.
    -> Word32
    -- ^ /@modifiers@/: Modifiers of the hotkey.
    -> m Word32
    -- ^ __Returns:__ The event associated to the hotkey or 0 if the hotkey is not in the
    -- profile.
hotkeyProfileLookupHotkey :: a -> Word32 -> Word32 -> m Word32
hotkeyProfileLookupHotkey a
profile Word32
keyval Word32
modifiers = 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 HotkeyProfile
profile' <- a -> IO (Ptr HotkeyProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    Word32
result <- Ptr HotkeyProfile -> Word32 -> Word32 -> IO Word32
ibus_hotkey_profile_lookup_hotkey Ptr HotkeyProfile
profile' Word32
keyval Word32
modifiers
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
profile
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data HotkeyProfileLookupHotkeyMethodInfo
instance (signature ~ (Word32 -> Word32 -> m Word32), MonadIO m, IsHotkeyProfile a) => O.MethodInfo HotkeyProfileLookupHotkeyMethodInfo a signature where
    overloadedMethod = hotkeyProfileLookupHotkey

#endif

-- method HotkeyProfile::remove_hotkey
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "profile"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "HotkeyProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusHotkeyProfile."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyval"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Keycode of the hotkey."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifiers"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Modifiers of the hotkey."
--                 , 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_hotkey_profile_remove_hotkey" ibus_hotkey_profile_remove_hotkey :: 
    Ptr HotkeyProfile ->                    -- profile : TInterface (Name {namespace = "IBus", name = "HotkeyProfile"})
    Word32 ->                               -- keyval : TBasicType TUInt
    Word32 ->                               -- modifiers : TBasicType TUInt
    IO CInt

-- | Removes the hotkey for an t'GI.IBus.Objects.HotkeyProfile.HotkeyProfile'.
hotkeyProfileRemoveHotkey ::
    (B.CallStack.HasCallStack, MonadIO m, IsHotkeyProfile a) =>
    a
    -- ^ /@profile@/: An IBusHotkeyProfile.
    -> Word32
    -- ^ /@keyval@/: Keycode of the hotkey.
    -> Word32
    -- ^ /@modifiers@/: Modifiers of the hotkey.
    -> m Bool
    -- ^ __Returns:__ 'P.False' if the key is not in /@profile@/, 'P.True' otherwise.
hotkeyProfileRemoveHotkey :: a -> Word32 -> Word32 -> m Bool
hotkeyProfileRemoveHotkey a
profile Word32
keyval Word32
modifiers = 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 HotkeyProfile
profile' <- a -> IO (Ptr HotkeyProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CInt
result <- Ptr HotkeyProfile -> Word32 -> Word32 -> IO CInt
ibus_hotkey_profile_remove_hotkey Ptr HotkeyProfile
profile' Word32
keyval Word32
modifiers
    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
profile
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data HotkeyProfileRemoveHotkeyMethodInfo
instance (signature ~ (Word32 -> Word32 -> m Bool), MonadIO m, IsHotkeyProfile a) => O.MethodInfo HotkeyProfileRemoveHotkeyMethodInfo a signature where
    overloadedMethod = hotkeyProfileRemoveHotkey

#endif

-- method HotkeyProfile::remove_hotkey_by_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "profile"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "HotkeyProfile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusHotkeyProfile."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The associated event."
--                 , 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_hotkey_profile_remove_hotkey_by_event" ibus_hotkey_profile_remove_hotkey_by_event :: 
    Ptr HotkeyProfile ->                    -- profile : TInterface (Name {namespace = "IBus", name = "HotkeyProfile"})
    Word32 ->                               -- event : TBasicType TUInt32
    IO CInt

-- | Removes the hotkey for an t'GI.IBus.Objects.HotkeyProfile.HotkeyProfile' by event.
hotkeyProfileRemoveHotkeyByEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsHotkeyProfile a) =>
    a
    -- ^ /@profile@/: An IBusHotkeyProfile.
    -> Word32
    -- ^ /@event@/: The associated event.
    -> m Bool
    -- ^ __Returns:__ 'P.False' if no such event in /@profile@/, 'P.True' otherwise.
hotkeyProfileRemoveHotkeyByEvent :: a -> Word32 -> m Bool
hotkeyProfileRemoveHotkeyByEvent a
profile Word32
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 HotkeyProfile
profile' <- a -> IO (Ptr HotkeyProfile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
profile
    CInt
result <- Ptr HotkeyProfile -> Word32 -> IO CInt
ibus_hotkey_profile_remove_hotkey_by_event Ptr HotkeyProfile
profile' Word32
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
profile
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data HotkeyProfileRemoveHotkeyByEventMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m, IsHotkeyProfile a) => O.MethodInfo HotkeyProfileRemoveHotkeyByEventMethodInfo a signature where
    overloadedMethod = hotkeyProfileRemoveHotkeyByEvent

#endif