{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An IBusPanelService is a base class for UI services.
-- Developers can \"extend\" this class for panel UI development.

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

module GI.IBus.Objects.PanelService
    ( 
#if defined(ENABLE_OVERLOADING)
    PanelServiceHidePreeditTextReceivedMethodInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    PanelServiceShowPreeditTextReceivedMethodInfo,
#endif

-- * Exported types
    PanelService(..)                        ,
    IsPanelService                          ,
    toPanelService                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [candidateClicked]("GI.IBus.Objects.PanelService#g:method:candidateClicked"), [commitText]("GI.IBus.Objects.PanelService#g:method:commitText"), [cursorDown]("GI.IBus.Objects.PanelService#g:method:cursorDown"), [cursorUp]("GI.IBus.Objects.PanelService#g:method:cursorUp"), [destroy]("GI.IBus.Objects.Object#g:method:destroy"), [emitSignal]("GI.IBus.Objects.Service#g:method:emitSignal"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hidePreeditTextReceived]("GI.IBus.Objects.PanelService#g:method:hidePreeditTextReceived"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [pageDown]("GI.IBus.Objects.PanelService#g:method:pageDown"), [pageUp]("GI.IBus.Objects.PanelService#g:method:pageUp"), [panelExtension]("GI.IBus.Objects.PanelService#g:method:panelExtension"), [propertyActivate]("GI.IBus.Objects.PanelService#g:method:propertyActivate"), [propertyHide]("GI.IBus.Objects.PanelService#g:method:propertyHide"), [propertyShow]("GI.IBus.Objects.PanelService#g:method:propertyShow"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [register]("GI.IBus.Objects.Service#g:method:register"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [showPreeditTextReceived]("GI.IBus.Objects.PanelService#g:method:showPreeditTextReceived"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [unregister]("GI.IBus.Objects.Service#g:method:unregister"), [updateAuxiliaryTextReceived]("GI.IBus.Objects.PanelService#g:method:updateAuxiliaryTextReceived"), [updateLookupTableReceived]("GI.IBus.Objects.PanelService#g:method:updateLookupTableReceived"), [updatePreeditTextReceived]("GI.IBus.Objects.PanelService#g:method:updatePreeditTextReceived"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getConnection]("GI.IBus.Objects.Service#g:method:getConnection"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getObjectPath]("GI.IBus.Objects.Service#g:method:getObjectPath"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolvePanelServiceMethod               ,
#endif

-- ** candidateClicked #method:candidateClicked#

#if defined(ENABLE_OVERLOADING)
    PanelServiceCandidateClickedMethodInfo  ,
#endif
    panelServiceCandidateClicked            ,


-- ** commitText #method:commitText#

#if defined(ENABLE_OVERLOADING)
    PanelServiceCommitTextMethodInfo        ,
#endif
    panelServiceCommitText                  ,


-- ** cursorDown #method:cursorDown#

#if defined(ENABLE_OVERLOADING)
    PanelServiceCursorDownMethodInfo        ,
#endif
    panelServiceCursorDown                  ,


-- ** cursorUp #method:cursorUp#

#if defined(ENABLE_OVERLOADING)
    PanelServiceCursorUpMethodInfo          ,
#endif
    panelServiceCursorUp                    ,


-- ** new #method:new#

    panelServiceNew                         ,


-- ** pageDown #method:pageDown#

#if defined(ENABLE_OVERLOADING)
    PanelServicePageDownMethodInfo          ,
#endif
    panelServicePageDown                    ,


-- ** pageUp #method:pageUp#

#if defined(ENABLE_OVERLOADING)
    PanelServicePageUpMethodInfo            ,
#endif
    panelServicePageUp                      ,


-- ** panelExtension #method:panelExtension#

#if defined(ENABLE_OVERLOADING)
    PanelServicePanelExtensionMethodInfo    ,
#endif
    panelServicePanelExtension              ,


-- ** propertyActivate #method:propertyActivate#

#if defined(ENABLE_OVERLOADING)
    PanelServicePropertyActivateMethodInfo  ,
#endif
    panelServicePropertyActivate            ,


-- ** propertyHide #method:propertyHide#

#if defined(ENABLE_OVERLOADING)
    PanelServicePropertyHideMethodInfo      ,
#endif
    panelServicePropertyHide                ,


-- ** propertyShow #method:propertyShow#

#if defined(ENABLE_OVERLOADING)
    PanelServicePropertyShowMethodInfo      ,
#endif
    panelServicePropertyShow                ,


-- ** updateAuxiliaryTextReceived #method:updateAuxiliaryTextReceived#

#if defined(ENABLE_OVERLOADING)
    PanelServiceUpdateAuxiliaryTextReceivedMethodInfo,
#endif
    panelServiceUpdateAuxiliaryTextReceived ,


-- ** updateLookupTableReceived #method:updateLookupTableReceived#

#if defined(ENABLE_OVERLOADING)
    PanelServiceUpdateLookupTableReceivedMethodInfo,
#endif
    panelServiceUpdateLookupTableReceived   ,


-- ** updatePreeditTextReceived #method:updatePreeditTextReceived#

#if defined(ENABLE_OVERLOADING)
    PanelServiceUpdatePreeditTextReceivedMethodInfo,
#endif
    panelServiceUpdatePreeditTextReceived   ,




 -- * Signals


-- ** candidateClickedLookupTable #signal:candidateClickedLookupTable#

    PanelServiceCandidateClickedLookupTableCallback,
#if defined(ENABLE_OVERLOADING)
    PanelServiceCandidateClickedLookupTableSignalInfo,
#endif
    afterPanelServiceCandidateClickedLookupTable,
    onPanelServiceCandidateClickedLookupTable,


-- ** commitTextReceived #signal:commitTextReceived#

    PanelServiceCommitTextReceivedCallback  ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceCommitTextReceivedSignalInfo,
#endif
    afterPanelServiceCommitTextReceived     ,
    onPanelServiceCommitTextReceived        ,


-- ** cursorDownLookupTable #signal:cursorDownLookupTable#

    PanelServiceCursorDownLookupTableCallback,
#if defined(ENABLE_OVERLOADING)
    PanelServiceCursorDownLookupTableSignalInfo,
#endif
    afterPanelServiceCursorDownLookupTable  ,
    onPanelServiceCursorDownLookupTable     ,


-- ** cursorUpLookupTable #signal:cursorUpLookupTable#

    PanelServiceCursorUpLookupTableCallback ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceCursorUpLookupTableSignalInfo,
#endif
    afterPanelServiceCursorUpLookupTable    ,
    onPanelServiceCursorUpLookupTable       ,


-- ** destroyContext #signal:destroyContext#

    PanelServiceDestroyContextCallback      ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceDestroyContextSignalInfo    ,
#endif
    afterPanelServiceDestroyContext         ,
    onPanelServiceDestroyContext            ,


-- ** focusIn #signal:focusIn#

    PanelServiceFocusInCallback             ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceFocusInSignalInfo           ,
#endif
    afterPanelServiceFocusIn                ,
    onPanelServiceFocusIn                   ,


-- ** focusOut #signal:focusOut#

    PanelServiceFocusOutCallback            ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceFocusOutSignalInfo          ,
#endif
    afterPanelServiceFocusOut               ,
    onPanelServiceFocusOut                  ,


-- ** hideAuxiliaryText #signal:hideAuxiliaryText#

    PanelServiceHideAuxiliaryTextCallback   ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceHideAuxiliaryTextSignalInfo ,
#endif
    afterPanelServiceHideAuxiliaryText      ,
    onPanelServiceHideAuxiliaryText         ,


-- ** hideLanguageBar #signal:hideLanguageBar#

    PanelServiceHideLanguageBarCallback     ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceHideLanguageBarSignalInfo   ,
#endif
    afterPanelServiceHideLanguageBar        ,
    onPanelServiceHideLanguageBar           ,


-- ** hideLookupTable #signal:hideLookupTable#

    PanelServiceHideLookupTableCallback     ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceHideLookupTableSignalInfo   ,
#endif
    afterPanelServiceHideLookupTable        ,
    onPanelServiceHideLookupTable           ,


-- ** hidePreeditText #signal:hidePreeditText#

    PanelServiceHidePreeditTextCallback     ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceHidePreeditTextSignalInfo   ,
#endif
    afterPanelServiceHidePreeditText        ,
    onPanelServiceHidePreeditText           ,


-- ** pageDownLookupTable #signal:pageDownLookupTable#

    PanelServicePageDownLookupTableCallback ,
#if defined(ENABLE_OVERLOADING)
    PanelServicePageDownLookupTableSignalInfo,
#endif
    afterPanelServicePageDownLookupTable    ,
    onPanelServicePageDownLookupTable       ,


-- ** pageUpLookupTable #signal:pageUpLookupTable#

    PanelServicePageUpLookupTableCallback   ,
#if defined(ENABLE_OVERLOADING)
    PanelServicePageUpLookupTableSignalInfo ,
#endif
    afterPanelServicePageUpLookupTable      ,
    onPanelServicePageUpLookupTable         ,


-- ** panelExtensionReceived #signal:panelExtensionReceived#

    PanelServicePanelExtensionReceivedCallback,
#if defined(ENABLE_OVERLOADING)
    PanelServicePanelExtensionReceivedSignalInfo,
#endif
    afterPanelServicePanelExtensionReceived ,
    onPanelServicePanelExtensionReceived    ,


-- ** processKeyEvent #signal:processKeyEvent#

    PanelServiceProcessKeyEventCallback     ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceProcessKeyEventSignalInfo   ,
#endif
    afterPanelServiceProcessKeyEvent        ,
    onPanelServiceProcessKeyEvent           ,


-- ** registerProperties #signal:registerProperties#

    PanelServiceRegisterPropertiesCallback  ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceRegisterPropertiesSignalInfo,
#endif
    afterPanelServiceRegisterProperties     ,
    onPanelServiceRegisterProperties        ,


-- ** reset #signal:reset#

    PanelServiceResetCallback               ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceResetSignalInfo             ,
#endif
    afterPanelServiceReset                  ,
    onPanelServiceReset                     ,


-- ** setContentType #signal:setContentType#

    PanelServiceSetContentTypeCallback      ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceSetContentTypeSignalInfo    ,
#endif
    afterPanelServiceSetContentType         ,
    onPanelServiceSetContentType            ,


-- ** setCursorLocation #signal:setCursorLocation#

    PanelServiceSetCursorLocationCallback   ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceSetCursorLocationSignalInfo ,
#endif
    afterPanelServiceSetCursorLocation      ,
    onPanelServiceSetCursorLocation         ,


-- ** setCursorLocationRelative #signal:setCursorLocationRelative#

    PanelServiceSetCursorLocationRelativeCallback,
#if defined(ENABLE_OVERLOADING)
    PanelServiceSetCursorLocationRelativeSignalInfo,
#endif
    afterPanelServiceSetCursorLocationRelative,
    onPanelServiceSetCursorLocationRelative ,


-- ** showAuxiliaryText #signal:showAuxiliaryText#

    PanelServiceShowAuxiliaryTextCallback   ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceShowAuxiliaryTextSignalInfo ,
#endif
    afterPanelServiceShowAuxiliaryText      ,
    onPanelServiceShowAuxiliaryText         ,


-- ** showLanguageBar #signal:showLanguageBar#

    PanelServiceShowLanguageBarCallback     ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceShowLanguageBarSignalInfo   ,
#endif
    afterPanelServiceShowLanguageBar        ,
    onPanelServiceShowLanguageBar           ,


-- ** showLookupTable #signal:showLookupTable#

    PanelServiceShowLookupTableCallback     ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceShowLookupTableSignalInfo   ,
#endif
    afterPanelServiceShowLookupTable        ,
    onPanelServiceShowLookupTable           ,


-- ** showPreeditText #signal:showPreeditText#

    PanelServiceShowPreeditTextCallback     ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceShowPreeditTextSignalInfo   ,
#endif
    afterPanelServiceShowPreeditText        ,
    onPanelServiceShowPreeditText           ,


-- ** startSetup #signal:startSetup#

    PanelServiceStartSetupCallback          ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceStartSetupSignalInfo        ,
#endif
    afterPanelServiceStartSetup             ,
    onPanelServiceStartSetup                ,


-- ** stateChanged #signal:stateChanged#

    PanelServiceStateChangedCallback        ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceStateChangedSignalInfo      ,
#endif
    afterPanelServiceStateChanged           ,
    onPanelServiceStateChanged              ,


-- ** updateAuxiliaryText #signal:updateAuxiliaryText#

    PanelServiceUpdateAuxiliaryTextCallback ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceUpdateAuxiliaryTextSignalInfo,
#endif
    afterPanelServiceUpdateAuxiliaryText    ,
    onPanelServiceUpdateAuxiliaryText       ,


-- ** updateLookupTable #signal:updateLookupTable#

    PanelServiceUpdateLookupTableCallback   ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceUpdateLookupTableSignalInfo ,
#endif
    afterPanelServiceUpdateLookupTable      ,
    onPanelServiceUpdateLookupTable         ,


-- ** updatePreeditText #signal:updatePreeditText#

    PanelServiceUpdatePreeditTextCallback   ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceUpdatePreeditTextSignalInfo ,
#endif
    afterPanelServiceUpdatePreeditText      ,
    onPanelServiceUpdatePreeditText         ,


-- ** updateProperty #signal:updateProperty#

    PanelServiceUpdatePropertyCallback      ,
#if defined(ENABLE_OVERLOADING)
    PanelServiceUpdatePropertySignalInfo    ,
#endif
    afterPanelServiceUpdateProperty         ,
    onPanelServiceUpdateProperty            ,




    ) 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.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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.Coerce as Coerce
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 GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Objects.DBusConnection as Gio.DBusConnection
import {-# SOURCE #-} qualified GI.IBus.Objects.ExtensionEvent as IBus.ExtensionEvent
import {-# SOURCE #-} qualified GI.IBus.Objects.LookupTable as IBus.LookupTable
import {-# SOURCE #-} qualified GI.IBus.Objects.Object as IBus.Object
import {-# SOURCE #-} qualified GI.IBus.Objects.PropList as IBus.PropList
import {-# SOURCE #-} qualified GI.IBus.Objects.Property as IBus.Property
import {-# SOURCE #-} qualified GI.IBus.Objects.Service as IBus.Service
import {-# SOURCE #-} qualified GI.IBus.Objects.Text as IBus.Text

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

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

foreign import ccall "ibus_panel_service_get_type"
    c_ibus_panel_service_get_type :: IO B.Types.GType

instance B.Types.TypedObject PanelService where
    glibType :: IO GType
glibType = IO GType
c_ibus_panel_service_get_type

instance B.Types.GObject PanelService

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

instance O.HasParentTypes PanelService
type instance O.ParentTypes PanelService = '[IBus.Service.Service, IBus.Object.Object, GObject.Object.Object]

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

-- | Convert 'PanelService' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe PanelService) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ibus_panel_service_get_type
    gvalueSet_ :: Ptr GValue -> Maybe PanelService -> IO ()
gvalueSet_ Ptr GValue
gv Maybe PanelService
P.Nothing = Ptr GValue -> Ptr PanelService -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr PanelService
forall a. Ptr a
FP.nullPtr :: FP.Ptr PanelService)
    gvalueSet_ Ptr GValue
gv (P.Just PanelService
obj) = PanelService -> (Ptr PanelService -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr PanelService
obj (Ptr GValue -> Ptr PanelService -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe PanelService)
gvalueGet_ Ptr GValue
gv = do
        Ptr PanelService
ptr <- Ptr GValue -> IO (Ptr PanelService)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr PanelService)
        if Ptr PanelService
ptr Ptr PanelService -> Ptr PanelService -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr PanelService
forall a. Ptr a
FP.nullPtr
        then PanelService -> Maybe PanelService
forall a. a -> Maybe a
P.Just (PanelService -> Maybe PanelService)
-> IO PanelService -> IO (Maybe PanelService)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr PanelService -> PanelService)
-> Ptr PanelService -> IO PanelService
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr PanelService -> PanelService
PanelService Ptr PanelService
ptr
        else Maybe PanelService -> IO (Maybe PanelService)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PanelService
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolvePanelServiceMethod (t :: Symbol) (o :: *) :: * where
    ResolvePanelServiceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePanelServiceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePanelServiceMethod "candidateClicked" o = PanelServiceCandidateClickedMethodInfo
    ResolvePanelServiceMethod "commitText" o = PanelServiceCommitTextMethodInfo
    ResolvePanelServiceMethod "cursorDown" o = PanelServiceCursorDownMethodInfo
    ResolvePanelServiceMethod "cursorUp" o = PanelServiceCursorUpMethodInfo
    ResolvePanelServiceMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    ResolvePanelServiceMethod "emitSignal" o = IBus.Service.ServiceEmitSignalMethodInfo
    ResolvePanelServiceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePanelServiceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePanelServiceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePanelServiceMethod "hidePreeditTextReceived" o = PanelServiceHidePreeditTextReceivedMethodInfo
    ResolvePanelServiceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePanelServiceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePanelServiceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePanelServiceMethod "pageDown" o = PanelServicePageDownMethodInfo
    ResolvePanelServiceMethod "pageUp" o = PanelServicePageUpMethodInfo
    ResolvePanelServiceMethod "panelExtension" o = PanelServicePanelExtensionMethodInfo
    ResolvePanelServiceMethod "propertyActivate" o = PanelServicePropertyActivateMethodInfo
    ResolvePanelServiceMethod "propertyHide" o = PanelServicePropertyHideMethodInfo
    ResolvePanelServiceMethod "propertyShow" o = PanelServicePropertyShowMethodInfo
    ResolvePanelServiceMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePanelServiceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePanelServiceMethod "register" o = IBus.Service.ServiceRegisterMethodInfo
    ResolvePanelServiceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePanelServiceMethod "showPreeditTextReceived" o = PanelServiceShowPreeditTextReceivedMethodInfo
    ResolvePanelServiceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePanelServiceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePanelServiceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePanelServiceMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePanelServiceMethod "unregister" o = IBus.Service.ServiceUnregisterMethodInfo
    ResolvePanelServiceMethod "updateAuxiliaryTextReceived" o = PanelServiceUpdateAuxiliaryTextReceivedMethodInfo
    ResolvePanelServiceMethod "updateLookupTableReceived" o = PanelServiceUpdateLookupTableReceivedMethodInfo
    ResolvePanelServiceMethod "updatePreeditTextReceived" o = PanelServiceUpdatePreeditTextReceivedMethodInfo
    ResolvePanelServiceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePanelServiceMethod "getConnection" o = IBus.Service.ServiceGetConnectionMethodInfo
    ResolvePanelServiceMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePanelServiceMethod "getObjectPath" o = IBus.Service.ServiceGetObjectPathMethodInfo
    ResolvePanelServiceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePanelServiceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePanelServiceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePanelServiceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePanelServiceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePanelServiceMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolvePanelServiceMethod t PanelService, O.OverloadedMethod info PanelService p, R.HasField t PanelService p) => R.HasField t PanelService p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolvePanelServiceMethod t PanelService, O.OverloadedMethodInfo info PanelService) => OL.IsLabel t (O.MethodProxy info PanelService) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- signal PanelService::candidate-clicked-lookup-table
-- | /No description available in the introspection data./
type PanelServiceCandidateClickedLookupTableCallback =
    Word32
    -> Word32
    -> Word32
    -> IO ()

type C_PanelServiceCandidateClickedLookupTableCallback =
    Ptr PanelService ->                     -- object
    Word32 ->
    Word32 ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceCandidateClickedLookupTableCallback :: 
    GObject a => (a -> PanelServiceCandidateClickedLookupTableCallback) ->
    C_PanelServiceCandidateClickedLookupTableCallback
wrap_PanelServiceCandidateClickedLookupTableCallback :: forall a.
GObject a =>
(a -> PanelServiceCandidateClickedLookupTableCallback)
-> C_PanelServiceCandidateClickedLookupTableCallback
wrap_PanelServiceCandidateClickedLookupTableCallback a -> PanelServiceCandidateClickedLookupTableCallback
gi'cb Ptr PanelService
gi'selfPtr Word32
object Word32
p0 Word32
p1 Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> PanelServiceCandidateClickedLookupTableCallback
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self)  Word32
object Word32
p0 Word32
p1


-- | Connect a signal handler for the [candidateClickedLookupTable](#signal:candidateClickedLookupTable) 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' panelService #candidateClickedLookupTable callback
-- @
-- 
-- 
onPanelServiceCandidateClickedLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceCandidateClickedLookupTableCallback) -> m SignalHandlerId
onPanelServiceCandidateClickedLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceCandidateClickedLookupTableCallback)
-> m SignalHandlerId
onPanelServiceCandidateClickedLookupTable a
obj (?self::a) => PanelServiceCandidateClickedLookupTableCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceCandidateClickedLookupTableCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceCandidateClickedLookupTableCallback
PanelServiceCandidateClickedLookupTableCallback
cb
    let wrapped' :: C_PanelServiceCandidateClickedLookupTableCallback
wrapped' = (a -> PanelServiceCandidateClickedLookupTableCallback)
-> C_PanelServiceCandidateClickedLookupTableCallback
forall a.
GObject a =>
(a -> PanelServiceCandidateClickedLookupTableCallback)
-> C_PanelServiceCandidateClickedLookupTableCallback
wrap_PanelServiceCandidateClickedLookupTableCallback a -> PanelServiceCandidateClickedLookupTableCallback
wrapped
    FunPtr C_PanelServiceCandidateClickedLookupTableCallback
wrapped'' <- C_PanelServiceCandidateClickedLookupTableCallback
-> IO (FunPtr C_PanelServiceCandidateClickedLookupTableCallback)
mk_PanelServiceCandidateClickedLookupTableCallback C_PanelServiceCandidateClickedLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCandidateClickedLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"candidate-clicked-lookup-table" FunPtr C_PanelServiceCandidateClickedLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [candidateClickedLookupTable](#signal:candidateClickedLookupTable) 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' panelService #candidateClickedLookupTable callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceCandidateClickedLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceCandidateClickedLookupTableCallback) -> m SignalHandlerId
afterPanelServiceCandidateClickedLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceCandidateClickedLookupTableCallback)
-> m SignalHandlerId
afterPanelServiceCandidateClickedLookupTable a
obj (?self::a) => PanelServiceCandidateClickedLookupTableCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceCandidateClickedLookupTableCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceCandidateClickedLookupTableCallback
PanelServiceCandidateClickedLookupTableCallback
cb
    let wrapped' :: C_PanelServiceCandidateClickedLookupTableCallback
wrapped' = (a -> PanelServiceCandidateClickedLookupTableCallback)
-> C_PanelServiceCandidateClickedLookupTableCallback
forall a.
GObject a =>
(a -> PanelServiceCandidateClickedLookupTableCallback)
-> C_PanelServiceCandidateClickedLookupTableCallback
wrap_PanelServiceCandidateClickedLookupTableCallback a -> PanelServiceCandidateClickedLookupTableCallback
wrapped
    FunPtr C_PanelServiceCandidateClickedLookupTableCallback
wrapped'' <- C_PanelServiceCandidateClickedLookupTableCallback
-> IO (FunPtr C_PanelServiceCandidateClickedLookupTableCallback)
mk_PanelServiceCandidateClickedLookupTableCallback C_PanelServiceCandidateClickedLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCandidateClickedLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"candidate-clicked-lookup-table" FunPtr C_PanelServiceCandidateClickedLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceCandidateClickedLookupTableSignalInfo
instance SignalInfo PanelServiceCandidateClickedLookupTableSignalInfo where
    type HaskellCallbackType PanelServiceCandidateClickedLookupTableSignalInfo = PanelServiceCandidateClickedLookupTableCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceCandidateClickedLookupTableCallback cb
        cb'' <- mk_PanelServiceCandidateClickedLookupTableCallback cb'
        connectSignalFunPtr obj "candidate-clicked-lookup-table" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::candidate-clicked-lookup-table"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:candidateClickedLookupTable"})

#endif

-- signal PanelService::commit-text-received
-- | Emitted when the client application get the [commitTextReceived](#g:signal:commitTextReceived).
-- Implement the member function
-- IBusPanelServiceClass[commit_text_received](#g:signal:commit_text_received) in extended class to
-- receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceCommitTextReceivedCallback =
    IBus.Text.Text
    -- ^ /@text@/: A t'GI.IBus.Objects.Text.Text'
    -> IO ()

type C_PanelServiceCommitTextReceivedCallback =
    Ptr PanelService ->                     -- object
    Ptr IBus.Text.Text ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceCommitTextReceivedCallback :: 
    GObject a => (a -> PanelServiceCommitTextReceivedCallback) ->
    C_PanelServiceCommitTextReceivedCallback
wrap_PanelServiceCommitTextReceivedCallback :: forall a.
GObject a =>
(a -> PanelServiceCommitTextReceivedCallback)
-> C_PanelServiceCommitTextReceivedCallback
wrap_PanelServiceCommitTextReceivedCallback a -> PanelServiceCommitTextReceivedCallback
gi'cb Ptr PanelService
gi'selfPtr Ptr Text
text Ptr ()
_ = do
    Text
text' <- ((ManagedPtr Text -> Text) -> Ptr Text -> IO Text
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Text -> Text
IBus.Text.Text) Ptr Text
text
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> PanelServiceCommitTextReceivedCallback
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self)  Text
text'


-- | Connect a signal handler for the [commitTextReceived](#signal:commitTextReceived) 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' panelService #commitTextReceived callback
-- @
-- 
-- 
onPanelServiceCommitTextReceived :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceCommitTextReceivedCallback) -> m SignalHandlerId
onPanelServiceCommitTextReceived :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceCommitTextReceivedCallback)
-> m SignalHandlerId
onPanelServiceCommitTextReceived a
obj (?self::a) => PanelServiceCommitTextReceivedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceCommitTextReceivedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceCommitTextReceivedCallback
PanelServiceCommitTextReceivedCallback
cb
    let wrapped' :: C_PanelServiceCommitTextReceivedCallback
wrapped' = (a -> PanelServiceCommitTextReceivedCallback)
-> C_PanelServiceCommitTextReceivedCallback
forall a.
GObject a =>
(a -> PanelServiceCommitTextReceivedCallback)
-> C_PanelServiceCommitTextReceivedCallback
wrap_PanelServiceCommitTextReceivedCallback a -> PanelServiceCommitTextReceivedCallback
wrapped
    FunPtr C_PanelServiceCommitTextReceivedCallback
wrapped'' <- C_PanelServiceCommitTextReceivedCallback
-> IO (FunPtr C_PanelServiceCommitTextReceivedCallback)
mk_PanelServiceCommitTextReceivedCallback C_PanelServiceCommitTextReceivedCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCommitTextReceivedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"commit-text-received" FunPtr C_PanelServiceCommitTextReceivedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [commitTextReceived](#signal:commitTextReceived) 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' panelService #commitTextReceived callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceCommitTextReceived :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceCommitTextReceivedCallback) -> m SignalHandlerId
afterPanelServiceCommitTextReceived :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceCommitTextReceivedCallback)
-> m SignalHandlerId
afterPanelServiceCommitTextReceived a
obj (?self::a) => PanelServiceCommitTextReceivedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceCommitTextReceivedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceCommitTextReceivedCallback
PanelServiceCommitTextReceivedCallback
cb
    let wrapped' :: C_PanelServiceCommitTextReceivedCallback
wrapped' = (a -> PanelServiceCommitTextReceivedCallback)
-> C_PanelServiceCommitTextReceivedCallback
forall a.
GObject a =>
(a -> PanelServiceCommitTextReceivedCallback)
-> C_PanelServiceCommitTextReceivedCallback
wrap_PanelServiceCommitTextReceivedCallback a -> PanelServiceCommitTextReceivedCallback
wrapped
    FunPtr C_PanelServiceCommitTextReceivedCallback
wrapped'' <- C_PanelServiceCommitTextReceivedCallback
-> IO (FunPtr C_PanelServiceCommitTextReceivedCallback)
mk_PanelServiceCommitTextReceivedCallback C_PanelServiceCommitTextReceivedCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCommitTextReceivedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"commit-text-received" FunPtr C_PanelServiceCommitTextReceivedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceCommitTextReceivedSignalInfo
instance SignalInfo PanelServiceCommitTextReceivedSignalInfo where
    type HaskellCallbackType PanelServiceCommitTextReceivedSignalInfo = PanelServiceCommitTextReceivedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceCommitTextReceivedCallback cb
        cb'' <- mk_PanelServiceCommitTextReceivedCallback cb'
        connectSignalFunPtr obj "commit-text-received" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::commit-text-received"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:commitTextReceived"})

#endif

-- signal PanelService::cursor-down-lookup-table
-- | Emitted when the client application get the [cursorDownLookupTable](#g:signal:cursorDownLookupTable).
-- Implement the member function
-- IBusPanelServiceClass[cursor_down_lookup_table](#g:signal:cursor_down_lookup_table) in extended
-- class to receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceCursorDownLookupTableCallback =
    IO ()

type C_PanelServiceCursorDownLookupTableCallback =
    Ptr PanelService ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceCursorDownLookupTableCallback :: 
    GObject a => (a -> PanelServiceCursorDownLookupTableCallback) ->
    C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceCursorDownLookupTableCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceCursorDownLookupTableCallback a -> IO ()
gi'cb Ptr PanelService
gi'selfPtr Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> IO ()
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self) 


-- | Connect a signal handler for the [cursorDownLookupTable](#signal:cursorDownLookupTable) 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' panelService #cursorDownLookupTable callback
-- @
-- 
-- 
onPanelServiceCursorDownLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceCursorDownLookupTableCallback) -> m SignalHandlerId
onPanelServiceCursorDownLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPanelServiceCursorDownLookupTable a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceCursorDownLookupTableCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceCursorDownLookupTableCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"cursor-down-lookup-table" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [cursorDownLookupTable](#signal:cursorDownLookupTable) 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' panelService #cursorDownLookupTable callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceCursorDownLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceCursorDownLookupTableCallback) -> m SignalHandlerId
afterPanelServiceCursorDownLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPanelServiceCursorDownLookupTable a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceCursorDownLookupTableCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceCursorDownLookupTableCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"cursor-down-lookup-table" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceCursorDownLookupTableSignalInfo
instance SignalInfo PanelServiceCursorDownLookupTableSignalInfo where
    type HaskellCallbackType PanelServiceCursorDownLookupTableSignalInfo = PanelServiceCursorDownLookupTableCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceCursorDownLookupTableCallback cb
        cb'' <- mk_PanelServiceCursorDownLookupTableCallback cb'
        connectSignalFunPtr obj "cursor-down-lookup-table" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::cursor-down-lookup-table"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:cursorDownLookupTable"})

#endif

-- signal PanelService::cursor-up-lookup-table
-- | Emitted when the client application get the [cursorUpLookupTable](#g:signal:cursorUpLookupTable).
-- Implement the member function
-- IBusPanelServiceClass[cursor_up_lookup_table](#g:signal:cursor_up_lookup_table) in extended
-- class to receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceCursorUpLookupTableCallback =
    IO ()

type C_PanelServiceCursorUpLookupTableCallback =
    Ptr PanelService ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceCursorUpLookupTableCallback :: 
    GObject a => (a -> PanelServiceCursorUpLookupTableCallback) ->
    C_PanelServiceCursorUpLookupTableCallback
wrap_PanelServiceCursorUpLookupTableCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceCursorUpLookupTableCallback a -> IO ()
gi'cb Ptr PanelService
gi'selfPtr Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> IO ()
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self) 


-- | Connect a signal handler for the [cursorUpLookupTable](#signal:cursorUpLookupTable) 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' panelService #cursorUpLookupTable callback
-- @
-- 
-- 
onPanelServiceCursorUpLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceCursorUpLookupTableCallback) -> m SignalHandlerId
onPanelServiceCursorUpLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPanelServiceCursorUpLookupTable a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceCursorUpLookupTableCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceCursorUpLookupTableCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"cursor-up-lookup-table" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [cursorUpLookupTable](#signal:cursorUpLookupTable) 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' panelService #cursorUpLookupTable callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceCursorUpLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceCursorUpLookupTableCallback) -> m SignalHandlerId
afterPanelServiceCursorUpLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPanelServiceCursorUpLookupTable a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceCursorUpLookupTableCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceCursorUpLookupTableCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"cursor-up-lookup-table" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceCursorUpLookupTableSignalInfo
instance SignalInfo PanelServiceCursorUpLookupTableSignalInfo where
    type HaskellCallbackType PanelServiceCursorUpLookupTableSignalInfo = PanelServiceCursorUpLookupTableCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceCursorUpLookupTableCallback cb
        cb'' <- mk_PanelServiceCursorUpLookupTableCallback cb'
        connectSignalFunPtr obj "cursor-up-lookup-table" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::cursor-up-lookup-table"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:cursorUpLookupTable"})

#endif

-- signal PanelService::destroy-context
-- | Emitted when the client application destroys.
-- Implement the member function
-- IBusPanelServiceClass[destroy_context](#g:signal:destroy_context) in extended class to
-- receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceDestroyContextCallback =
    T.Text
    -- ^ /@inputContextPath@/: Object path of InputContext.
    -> IO ()

type C_PanelServiceDestroyContextCallback =
    Ptr PanelService ->                     -- object
    CString ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceDestroyContextCallback :: 
    GObject a => (a -> PanelServiceDestroyContextCallback) ->
    C_PanelServiceDestroyContextCallback
wrap_PanelServiceDestroyContextCallback :: forall a.
GObject a =>
(a -> PanelServiceDestroyContextCallback)
-> C_PanelServiceDestroyContextCallback
wrap_PanelServiceDestroyContextCallback a -> PanelServiceDestroyContextCallback
gi'cb Ptr PanelService
gi'selfPtr CString
inputContextPath Ptr ()
_ = do
    Text
inputContextPath' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
inputContextPath
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> PanelServiceDestroyContextCallback
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self)  Text
inputContextPath'


-- | Connect a signal handler for the [destroyContext](#signal:destroyContext) 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' panelService #destroyContext callback
-- @
-- 
-- 
onPanelServiceDestroyContext :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceDestroyContextCallback) -> m SignalHandlerId
onPanelServiceDestroyContext :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceDestroyContextCallback)
-> m SignalHandlerId
onPanelServiceDestroyContext a
obj (?self::a) => PanelServiceDestroyContextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceDestroyContextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceDestroyContextCallback
PanelServiceDestroyContextCallback
cb
    let wrapped' :: C_PanelServiceDestroyContextCallback
wrapped' = (a -> PanelServiceDestroyContextCallback)
-> C_PanelServiceDestroyContextCallback
forall a.
GObject a =>
(a -> PanelServiceDestroyContextCallback)
-> C_PanelServiceDestroyContextCallback
wrap_PanelServiceDestroyContextCallback a -> PanelServiceDestroyContextCallback
wrapped
    FunPtr C_PanelServiceDestroyContextCallback
wrapped'' <- C_PanelServiceDestroyContextCallback
-> IO (FunPtr C_PanelServiceDestroyContextCallback)
mk_PanelServiceDestroyContextCallback C_PanelServiceDestroyContextCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceDestroyContextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"destroy-context" FunPtr C_PanelServiceDestroyContextCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [destroyContext](#signal:destroyContext) 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' panelService #destroyContext callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceDestroyContext :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceDestroyContextCallback) -> m SignalHandlerId
afterPanelServiceDestroyContext :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceDestroyContextCallback)
-> m SignalHandlerId
afterPanelServiceDestroyContext a
obj (?self::a) => PanelServiceDestroyContextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceDestroyContextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceDestroyContextCallback
PanelServiceDestroyContextCallback
cb
    let wrapped' :: C_PanelServiceDestroyContextCallback
wrapped' = (a -> PanelServiceDestroyContextCallback)
-> C_PanelServiceDestroyContextCallback
forall a.
GObject a =>
(a -> PanelServiceDestroyContextCallback)
-> C_PanelServiceDestroyContextCallback
wrap_PanelServiceDestroyContextCallback a -> PanelServiceDestroyContextCallback
wrapped
    FunPtr C_PanelServiceDestroyContextCallback
wrapped'' <- C_PanelServiceDestroyContextCallback
-> IO (FunPtr C_PanelServiceDestroyContextCallback)
mk_PanelServiceDestroyContextCallback C_PanelServiceDestroyContextCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceDestroyContextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"destroy-context" FunPtr C_PanelServiceDestroyContextCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceDestroyContextSignalInfo
instance SignalInfo PanelServiceDestroyContextSignalInfo where
    type HaskellCallbackType PanelServiceDestroyContextSignalInfo = PanelServiceDestroyContextCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceDestroyContextCallback cb
        cb'' <- mk_PanelServiceDestroyContextCallback cb'
        connectSignalFunPtr obj "destroy-context" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::destroy-context"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:destroyContext"})

#endif

-- signal PanelService::focus-in
-- | Emitted when the client application get the [focusIn](#g:signal:focusIn).
-- Implement the member function
-- IBusPanelServiceClass[focus_in](#g:signal:focus_in) in extended class to receive
-- this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceFocusInCallback =
    T.Text
    -- ^ /@inputContextPath@/: Object path of InputContext.
    -> IO ()

type C_PanelServiceFocusInCallback =
    Ptr PanelService ->                     -- object
    CString ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceFocusInCallback :: 
    GObject a => (a -> PanelServiceFocusInCallback) ->
    C_PanelServiceFocusInCallback
wrap_PanelServiceFocusInCallback :: forall a.
GObject a =>
(a -> PanelServiceDestroyContextCallback)
-> C_PanelServiceDestroyContextCallback
wrap_PanelServiceFocusInCallback a -> PanelServiceDestroyContextCallback
gi'cb Ptr PanelService
gi'selfPtr CString
inputContextPath Ptr ()
_ = do
    Text
inputContextPath' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
inputContextPath
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> PanelServiceDestroyContextCallback
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self)  Text
inputContextPath'


-- | Connect a signal handler for the [focusIn](#signal:focusIn) 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' panelService #focusIn callback
-- @
-- 
-- 
onPanelServiceFocusIn :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceFocusInCallback) -> m SignalHandlerId
onPanelServiceFocusIn :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceDestroyContextCallback)
-> m SignalHandlerId
onPanelServiceFocusIn a
obj (?self::a) => PanelServiceDestroyContextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceDestroyContextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceDestroyContextCallback
PanelServiceDestroyContextCallback
cb
    let wrapped' :: C_PanelServiceDestroyContextCallback
wrapped' = (a -> PanelServiceDestroyContextCallback)
-> C_PanelServiceDestroyContextCallback
forall a.
GObject a =>
(a -> PanelServiceDestroyContextCallback)
-> C_PanelServiceDestroyContextCallback
wrap_PanelServiceFocusInCallback a -> PanelServiceDestroyContextCallback
wrapped
    FunPtr C_PanelServiceDestroyContextCallback
wrapped'' <- C_PanelServiceDestroyContextCallback
-> IO (FunPtr C_PanelServiceDestroyContextCallback)
mk_PanelServiceFocusInCallback C_PanelServiceDestroyContextCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceDestroyContextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"focus-in" FunPtr C_PanelServiceDestroyContextCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [focusIn](#signal:focusIn) 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' panelService #focusIn callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceFocusIn :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceFocusInCallback) -> m SignalHandlerId
afterPanelServiceFocusIn :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceDestroyContextCallback)
-> m SignalHandlerId
afterPanelServiceFocusIn a
obj (?self::a) => PanelServiceDestroyContextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceDestroyContextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceDestroyContextCallback
PanelServiceDestroyContextCallback
cb
    let wrapped' :: C_PanelServiceDestroyContextCallback
wrapped' = (a -> PanelServiceDestroyContextCallback)
-> C_PanelServiceDestroyContextCallback
forall a.
GObject a =>
(a -> PanelServiceDestroyContextCallback)
-> C_PanelServiceDestroyContextCallback
wrap_PanelServiceFocusInCallback a -> PanelServiceDestroyContextCallback
wrapped
    FunPtr C_PanelServiceDestroyContextCallback
wrapped'' <- C_PanelServiceDestroyContextCallback
-> IO (FunPtr C_PanelServiceDestroyContextCallback)
mk_PanelServiceFocusInCallback C_PanelServiceDestroyContextCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceDestroyContextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"focus-in" FunPtr C_PanelServiceDestroyContextCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceFocusInSignalInfo
instance SignalInfo PanelServiceFocusInSignalInfo where
    type HaskellCallbackType PanelServiceFocusInSignalInfo = PanelServiceFocusInCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceFocusInCallback cb
        cb'' <- mk_PanelServiceFocusInCallback cb'
        connectSignalFunPtr obj "focus-in" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::focus-in"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:focusIn"})

#endif

-- signal PanelService::focus-out
-- | Emitted when the client application get the [focusOut](#g:signal:focusOut).
-- Implement the member function
-- IBusPanelServiceClass[focus_out](#g:signal:focus_out) in extended class to receive
-- this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceFocusOutCallback =
    T.Text
    -- ^ /@inputContextPath@/: Object path of InputContext.
    -> IO ()

type C_PanelServiceFocusOutCallback =
    Ptr PanelService ->                     -- object
    CString ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceFocusOutCallback :: 
    GObject a => (a -> PanelServiceFocusOutCallback) ->
    C_PanelServiceFocusOutCallback
wrap_PanelServiceFocusOutCallback :: forall a.
GObject a =>
(a -> PanelServiceDestroyContextCallback)
-> C_PanelServiceDestroyContextCallback
wrap_PanelServiceFocusOutCallback a -> PanelServiceDestroyContextCallback
gi'cb Ptr PanelService
gi'selfPtr CString
inputContextPath Ptr ()
_ = do
    Text
inputContextPath' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
inputContextPath
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> PanelServiceDestroyContextCallback
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self)  Text
inputContextPath'


-- | Connect a signal handler for the [focusOut](#signal:focusOut) 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' panelService #focusOut callback
-- @
-- 
-- 
onPanelServiceFocusOut :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceFocusOutCallback) -> m SignalHandlerId
onPanelServiceFocusOut :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceDestroyContextCallback)
-> m SignalHandlerId
onPanelServiceFocusOut a
obj (?self::a) => PanelServiceDestroyContextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceDestroyContextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceDestroyContextCallback
PanelServiceDestroyContextCallback
cb
    let wrapped' :: C_PanelServiceDestroyContextCallback
wrapped' = (a -> PanelServiceDestroyContextCallback)
-> C_PanelServiceDestroyContextCallback
forall a.
GObject a =>
(a -> PanelServiceDestroyContextCallback)
-> C_PanelServiceDestroyContextCallback
wrap_PanelServiceFocusOutCallback a -> PanelServiceDestroyContextCallback
wrapped
    FunPtr C_PanelServiceDestroyContextCallback
wrapped'' <- C_PanelServiceDestroyContextCallback
-> IO (FunPtr C_PanelServiceDestroyContextCallback)
mk_PanelServiceFocusOutCallback C_PanelServiceDestroyContextCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceDestroyContextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"focus-out" FunPtr C_PanelServiceDestroyContextCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [focusOut](#signal:focusOut) 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' panelService #focusOut callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceFocusOut :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceFocusOutCallback) -> m SignalHandlerId
afterPanelServiceFocusOut :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceDestroyContextCallback)
-> m SignalHandlerId
afterPanelServiceFocusOut a
obj (?self::a) => PanelServiceDestroyContextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceDestroyContextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceDestroyContextCallback
PanelServiceDestroyContextCallback
cb
    let wrapped' :: C_PanelServiceDestroyContextCallback
wrapped' = (a -> PanelServiceDestroyContextCallback)
-> C_PanelServiceDestroyContextCallback
forall a.
GObject a =>
(a -> PanelServiceDestroyContextCallback)
-> C_PanelServiceDestroyContextCallback
wrap_PanelServiceFocusOutCallback a -> PanelServiceDestroyContextCallback
wrapped
    FunPtr C_PanelServiceDestroyContextCallback
wrapped'' <- C_PanelServiceDestroyContextCallback
-> IO (FunPtr C_PanelServiceDestroyContextCallback)
mk_PanelServiceFocusOutCallback C_PanelServiceDestroyContextCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceDestroyContextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"focus-out" FunPtr C_PanelServiceDestroyContextCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceFocusOutSignalInfo
instance SignalInfo PanelServiceFocusOutSignalInfo where
    type HaskellCallbackType PanelServiceFocusOutSignalInfo = PanelServiceFocusOutCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceFocusOutCallback cb
        cb'' <- mk_PanelServiceFocusOutCallback cb'
        connectSignalFunPtr obj "focus-out" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::focus-out"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:focusOut"})

#endif

-- signal PanelService::hide-auxiliary-text
-- | Emitted when the client application get the [hideAuxiliaryText](#g:signal:hideAuxiliaryText).
-- Implement the member function
-- IBusPanelServiceClass[hide_auxiliary_text](#g:signal:hide_auxiliary_text) in extended class
-- to receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceHideAuxiliaryTextCallback =
    IO ()

type C_PanelServiceHideAuxiliaryTextCallback =
    Ptr PanelService ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceHideAuxiliaryTextCallback :: 
    GObject a => (a -> PanelServiceHideAuxiliaryTextCallback) ->
    C_PanelServiceHideAuxiliaryTextCallback
wrap_PanelServiceHideAuxiliaryTextCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceHideAuxiliaryTextCallback a -> IO ()
gi'cb Ptr PanelService
gi'selfPtr Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> IO ()
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self) 


-- | Connect a signal handler for the [hideAuxiliaryText](#signal:hideAuxiliaryText) 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' panelService #hideAuxiliaryText callback
-- @
-- 
-- 
onPanelServiceHideAuxiliaryText :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceHideAuxiliaryTextCallback) -> m SignalHandlerId
onPanelServiceHideAuxiliaryText :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPanelServiceHideAuxiliaryText a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceHideAuxiliaryTextCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceHideAuxiliaryTextCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"hide-auxiliary-text" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [hideAuxiliaryText](#signal:hideAuxiliaryText) 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' panelService #hideAuxiliaryText callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceHideAuxiliaryText :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceHideAuxiliaryTextCallback) -> m SignalHandlerId
afterPanelServiceHideAuxiliaryText :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPanelServiceHideAuxiliaryText a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceHideAuxiliaryTextCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceHideAuxiliaryTextCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"hide-auxiliary-text" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceHideAuxiliaryTextSignalInfo
instance SignalInfo PanelServiceHideAuxiliaryTextSignalInfo where
    type HaskellCallbackType PanelServiceHideAuxiliaryTextSignalInfo = PanelServiceHideAuxiliaryTextCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceHideAuxiliaryTextCallback cb
        cb'' <- mk_PanelServiceHideAuxiliaryTextCallback cb'
        connectSignalFunPtr obj "hide-auxiliary-text" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::hide-auxiliary-text"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:hideAuxiliaryText"})

#endif

-- signal PanelService::hide-language-bar
-- | Emitted when the client application get the [hideLanguageBar](#g:signal:hideLanguageBar).
-- Implement the member function
-- IBusPanelServiceClass[hide_language_bar](#g:signal:hide_language_bar) in extended class to
-- receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceHideLanguageBarCallback =
    IO ()

type C_PanelServiceHideLanguageBarCallback =
    Ptr PanelService ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceHideLanguageBarCallback :: 
    GObject a => (a -> PanelServiceHideLanguageBarCallback) ->
    C_PanelServiceHideLanguageBarCallback
wrap_PanelServiceHideLanguageBarCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceHideLanguageBarCallback a -> IO ()
gi'cb Ptr PanelService
gi'selfPtr Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> IO ()
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self) 


-- | Connect a signal handler for the [hideLanguageBar](#signal:hideLanguageBar) 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' panelService #hideLanguageBar callback
-- @
-- 
-- 
onPanelServiceHideLanguageBar :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceHideLanguageBarCallback) -> m SignalHandlerId
onPanelServiceHideLanguageBar :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPanelServiceHideLanguageBar a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceHideLanguageBarCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceHideLanguageBarCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"hide-language-bar" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [hideLanguageBar](#signal:hideLanguageBar) 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' panelService #hideLanguageBar callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceHideLanguageBar :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceHideLanguageBarCallback) -> m SignalHandlerId
afterPanelServiceHideLanguageBar :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPanelServiceHideLanguageBar a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceHideLanguageBarCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceHideLanguageBarCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"hide-language-bar" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceHideLanguageBarSignalInfo
instance SignalInfo PanelServiceHideLanguageBarSignalInfo where
    type HaskellCallbackType PanelServiceHideLanguageBarSignalInfo = PanelServiceHideLanguageBarCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceHideLanguageBarCallback cb
        cb'' <- mk_PanelServiceHideLanguageBarCallback cb'
        connectSignalFunPtr obj "hide-language-bar" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::hide-language-bar"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:hideLanguageBar"})

#endif

-- signal PanelService::hide-lookup-table
-- | Emitted when the client application get the [hideLookupTable](#g:signal:hideLookupTable).
-- Implement the member function
-- IBusPanelServiceClass[hide_lookup_table](#g:signal:hide_lookup_table) in extended class to
-- receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceHideLookupTableCallback =
    IO ()

type C_PanelServiceHideLookupTableCallback =
    Ptr PanelService ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceHideLookupTableCallback :: 
    GObject a => (a -> PanelServiceHideLookupTableCallback) ->
    C_PanelServiceHideLookupTableCallback
wrap_PanelServiceHideLookupTableCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceHideLookupTableCallback a -> IO ()
gi'cb Ptr PanelService
gi'selfPtr Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> IO ()
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self) 


-- | Connect a signal handler for the [hideLookupTable](#signal:hideLookupTable) 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' panelService #hideLookupTable callback
-- @
-- 
-- 
onPanelServiceHideLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceHideLookupTableCallback) -> m SignalHandlerId
onPanelServiceHideLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPanelServiceHideLookupTable a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceHideLookupTableCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceHideLookupTableCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"hide-lookup-table" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [hideLookupTable](#signal:hideLookupTable) 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' panelService #hideLookupTable callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceHideLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceHideLookupTableCallback) -> m SignalHandlerId
afterPanelServiceHideLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPanelServiceHideLookupTable a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceHideLookupTableCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceHideLookupTableCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"hide-lookup-table" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceHideLookupTableSignalInfo
instance SignalInfo PanelServiceHideLookupTableSignalInfo where
    type HaskellCallbackType PanelServiceHideLookupTableSignalInfo = PanelServiceHideLookupTableCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceHideLookupTableCallback cb
        cb'' <- mk_PanelServiceHideLookupTableCallback cb'
        connectSignalFunPtr obj "hide-lookup-table" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::hide-lookup-table"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:hideLookupTable"})

#endif

-- signal PanelService::hide-preedit-text
-- | Emitted when the client application get the [hidePreeditText](#g:signal:hidePreeditText).
-- Implement the member function
-- IBusPanelServiceClass[hide_preedit_text](#g:signal:hide_preedit_text) in extended class to
-- receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceHidePreeditTextCallback =
    IO ()

type C_PanelServiceHidePreeditTextCallback =
    Ptr PanelService ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceHidePreeditTextCallback :: 
    GObject a => (a -> PanelServiceHidePreeditTextCallback) ->
    C_PanelServiceHidePreeditTextCallback
wrap_PanelServiceHidePreeditTextCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceHidePreeditTextCallback a -> IO ()
gi'cb Ptr PanelService
gi'selfPtr Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> IO ()
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self) 


-- | Connect a signal handler for the [hidePreeditText](#signal:hidePreeditText) 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' panelService #hidePreeditText callback
-- @
-- 
-- 
onPanelServiceHidePreeditText :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceHidePreeditTextCallback) -> m SignalHandlerId
onPanelServiceHidePreeditText :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPanelServiceHidePreeditText a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceHidePreeditTextCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceHidePreeditTextCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"hide-preedit-text" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [hidePreeditText](#signal:hidePreeditText) 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' panelService #hidePreeditText callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceHidePreeditText :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceHidePreeditTextCallback) -> m SignalHandlerId
afterPanelServiceHidePreeditText :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPanelServiceHidePreeditText a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceHidePreeditTextCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceHidePreeditTextCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"hide-preedit-text" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceHidePreeditTextSignalInfo
instance SignalInfo PanelServiceHidePreeditTextSignalInfo where
    type HaskellCallbackType PanelServiceHidePreeditTextSignalInfo = PanelServiceHidePreeditTextCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceHidePreeditTextCallback cb
        cb'' <- mk_PanelServiceHidePreeditTextCallback cb'
        connectSignalFunPtr obj "hide-preedit-text" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::hide-preedit-text"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:hidePreeditText"})

#endif

-- signal PanelService::page-down-lookup-table
-- | Emitted when the client application get the [pageDownLookupTable](#g:signal:pageDownLookupTable).
-- Implement the member function
-- IBusPanelServiceClass[page_down_lookup_table](#g:signal:page_down_lookup_table) in extended
-- class to receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServicePageDownLookupTableCallback =
    IO ()

type C_PanelServicePageDownLookupTableCallback =
    Ptr PanelService ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServicePageDownLookupTableCallback :: 
    GObject a => (a -> PanelServicePageDownLookupTableCallback) ->
    C_PanelServicePageDownLookupTableCallback
wrap_PanelServicePageDownLookupTableCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServicePageDownLookupTableCallback a -> IO ()
gi'cb Ptr PanelService
gi'selfPtr Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> IO ()
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self) 


-- | Connect a signal handler for the [pageDownLookupTable](#signal:pageDownLookupTable) 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' panelService #pageDownLookupTable callback
-- @
-- 
-- 
onPanelServicePageDownLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServicePageDownLookupTableCallback) -> m SignalHandlerId
onPanelServicePageDownLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPanelServicePageDownLookupTable a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServicePageDownLookupTableCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServicePageDownLookupTableCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"page-down-lookup-table" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [pageDownLookupTable](#signal:pageDownLookupTable) 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' panelService #pageDownLookupTable callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServicePageDownLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServicePageDownLookupTableCallback) -> m SignalHandlerId
afterPanelServicePageDownLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPanelServicePageDownLookupTable a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServicePageDownLookupTableCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServicePageDownLookupTableCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"page-down-lookup-table" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServicePageDownLookupTableSignalInfo
instance SignalInfo PanelServicePageDownLookupTableSignalInfo where
    type HaskellCallbackType PanelServicePageDownLookupTableSignalInfo = PanelServicePageDownLookupTableCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServicePageDownLookupTableCallback cb
        cb'' <- mk_PanelServicePageDownLookupTableCallback cb'
        connectSignalFunPtr obj "page-down-lookup-table" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::page-down-lookup-table"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:pageDownLookupTable"})

#endif

-- signal PanelService::page-up-lookup-table
-- | Emitted when the client application get the [pageUpLookupTable](#g:signal:pageUpLookupTable).
-- Implement the member function
-- IBusPanelServiceClass[page_up_lookup_table](#g:signal:page_up_lookup_table) in extended class
-- to receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServicePageUpLookupTableCallback =
    IO ()

type C_PanelServicePageUpLookupTableCallback =
    Ptr PanelService ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServicePageUpLookupTableCallback :: 
    GObject a => (a -> PanelServicePageUpLookupTableCallback) ->
    C_PanelServicePageUpLookupTableCallback
wrap_PanelServicePageUpLookupTableCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServicePageUpLookupTableCallback a -> IO ()
gi'cb Ptr PanelService
gi'selfPtr Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> IO ()
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self) 


-- | Connect a signal handler for the [pageUpLookupTable](#signal:pageUpLookupTable) 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' panelService #pageUpLookupTable callback
-- @
-- 
-- 
onPanelServicePageUpLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServicePageUpLookupTableCallback) -> m SignalHandlerId
onPanelServicePageUpLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPanelServicePageUpLookupTable a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServicePageUpLookupTableCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServicePageUpLookupTableCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"page-up-lookup-table" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [pageUpLookupTable](#signal:pageUpLookupTable) 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' panelService #pageUpLookupTable callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServicePageUpLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServicePageUpLookupTableCallback) -> m SignalHandlerId
afterPanelServicePageUpLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPanelServicePageUpLookupTable a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServicePageUpLookupTableCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServicePageUpLookupTableCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"page-up-lookup-table" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServicePageUpLookupTableSignalInfo
instance SignalInfo PanelServicePageUpLookupTableSignalInfo where
    type HaskellCallbackType PanelServicePageUpLookupTableSignalInfo = PanelServicePageUpLookupTableCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServicePageUpLookupTableCallback cb
        cb'' <- mk_PanelServicePageUpLookupTableCallback cb'
        connectSignalFunPtr obj "page-up-lookup-table" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::page-up-lookup-table"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:pageUpLookupTable"})

#endif

-- signal PanelService::panel-extension-received
-- | Emitted when the client application get the [panelExtensionReceived](#g:signal:panelExtensionReceived).
-- Implement the member function
-- IBusPanelServiceClass[panel_extension_received](#g:signal:panel_extension_received) in extended class to
-- receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServicePanelExtensionReceivedCallback =
    IBus.ExtensionEvent.ExtensionEvent
    -- ^ /@data@/: A t'GVariant'
    -> IO ()

type C_PanelServicePanelExtensionReceivedCallback =
    Ptr PanelService ->                     -- object
    Ptr IBus.ExtensionEvent.ExtensionEvent ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServicePanelExtensionReceivedCallback :: 
    GObject a => (a -> PanelServicePanelExtensionReceivedCallback) ->
    C_PanelServicePanelExtensionReceivedCallback
wrap_PanelServicePanelExtensionReceivedCallback :: forall a.
GObject a =>
(a -> PanelServicePanelExtensionReceivedCallback)
-> C_PanelServicePanelExtensionReceivedCallback
wrap_PanelServicePanelExtensionReceivedCallback a -> PanelServicePanelExtensionReceivedCallback
gi'cb Ptr PanelService
gi'selfPtr Ptr ExtensionEvent
data_ Ptr ()
_ = do
    ExtensionEvent
data_' <- ((ManagedPtr ExtensionEvent -> ExtensionEvent)
-> Ptr ExtensionEvent -> IO ExtensionEvent
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ExtensionEvent -> ExtensionEvent
IBus.ExtensionEvent.ExtensionEvent) Ptr ExtensionEvent
data_
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> PanelServicePanelExtensionReceivedCallback
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self)  ExtensionEvent
data_'


-- | Connect a signal handler for the [panelExtensionReceived](#signal:panelExtensionReceived) 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' panelService #panelExtensionReceived callback
-- @
-- 
-- 
onPanelServicePanelExtensionReceived :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServicePanelExtensionReceivedCallback) -> m SignalHandlerId
onPanelServicePanelExtensionReceived :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServicePanelExtensionReceivedCallback)
-> m SignalHandlerId
onPanelServicePanelExtensionReceived a
obj (?self::a) => PanelServicePanelExtensionReceivedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServicePanelExtensionReceivedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServicePanelExtensionReceivedCallback
PanelServicePanelExtensionReceivedCallback
cb
    let wrapped' :: C_PanelServicePanelExtensionReceivedCallback
wrapped' = (a -> PanelServicePanelExtensionReceivedCallback)
-> C_PanelServicePanelExtensionReceivedCallback
forall a.
GObject a =>
(a -> PanelServicePanelExtensionReceivedCallback)
-> C_PanelServicePanelExtensionReceivedCallback
wrap_PanelServicePanelExtensionReceivedCallback a -> PanelServicePanelExtensionReceivedCallback
wrapped
    FunPtr C_PanelServicePanelExtensionReceivedCallback
wrapped'' <- C_PanelServicePanelExtensionReceivedCallback
-> IO (FunPtr C_PanelServicePanelExtensionReceivedCallback)
mk_PanelServicePanelExtensionReceivedCallback C_PanelServicePanelExtensionReceivedCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServicePanelExtensionReceivedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"panel-extension-received" FunPtr C_PanelServicePanelExtensionReceivedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [panelExtensionReceived](#signal:panelExtensionReceived) 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' panelService #panelExtensionReceived callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServicePanelExtensionReceived :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServicePanelExtensionReceivedCallback) -> m SignalHandlerId
afterPanelServicePanelExtensionReceived :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServicePanelExtensionReceivedCallback)
-> m SignalHandlerId
afterPanelServicePanelExtensionReceived a
obj (?self::a) => PanelServicePanelExtensionReceivedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServicePanelExtensionReceivedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServicePanelExtensionReceivedCallback
PanelServicePanelExtensionReceivedCallback
cb
    let wrapped' :: C_PanelServicePanelExtensionReceivedCallback
wrapped' = (a -> PanelServicePanelExtensionReceivedCallback)
-> C_PanelServicePanelExtensionReceivedCallback
forall a.
GObject a =>
(a -> PanelServicePanelExtensionReceivedCallback)
-> C_PanelServicePanelExtensionReceivedCallback
wrap_PanelServicePanelExtensionReceivedCallback a -> PanelServicePanelExtensionReceivedCallback
wrapped
    FunPtr C_PanelServicePanelExtensionReceivedCallback
wrapped'' <- C_PanelServicePanelExtensionReceivedCallback
-> IO (FunPtr C_PanelServicePanelExtensionReceivedCallback)
mk_PanelServicePanelExtensionReceivedCallback C_PanelServicePanelExtensionReceivedCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServicePanelExtensionReceivedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"panel-extension-received" FunPtr C_PanelServicePanelExtensionReceivedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServicePanelExtensionReceivedSignalInfo
instance SignalInfo PanelServicePanelExtensionReceivedSignalInfo where
    type HaskellCallbackType PanelServicePanelExtensionReceivedSignalInfo = PanelServicePanelExtensionReceivedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServicePanelExtensionReceivedCallback cb
        cb'' <- mk_PanelServicePanelExtensionReceivedCallback cb'
        connectSignalFunPtr obj "panel-extension-received" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::panel-extension-received"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:panelExtensionReceived"})

#endif

-- signal PanelService::process-key-event
-- | Emitted when a key event is received.
-- Implement the member function IBusPanelServiceClass[process_key_event](#g:signal:process_key_event)
-- in extended class to receive this signal.
-- Both the key symbol and keycode are passed to the member function.
-- See 'GI.IBus.Objects.InputContext.inputContextProcessKeyEvent' for further explanation of
-- key symbol, keycode and which to use.
type PanelServiceProcessKeyEventCallback =
    Word32
    -- ^ /@keyval@/: Key symbol of the key press.
    -> Word32
    -- ^ /@keycode@/: KeyCode of the key press.
    -> Word32
    -- ^ /@state@/: Key modifier flags.
    -> IO Bool
    -- ^ __Returns:__ 'P.True' for successfully process the key; 'P.False' otherwise.
    -- See also:  'GI.IBus.Objects.InputContext.inputContextProcessKeyEvent'.
    -- 
    -- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
    -- \<\/note>

type C_PanelServiceProcessKeyEventCallback =
    Ptr PanelService ->                     -- object
    Word32 ->
    Word32 ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO CInt

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

wrap_PanelServiceProcessKeyEventCallback :: 
    GObject a => (a -> PanelServiceProcessKeyEventCallback) ->
    C_PanelServiceProcessKeyEventCallback
wrap_PanelServiceProcessKeyEventCallback :: forall a.
GObject a =>
(a -> PanelServiceProcessKeyEventCallback)
-> C_PanelServiceProcessKeyEventCallback
wrap_PanelServiceProcessKeyEventCallback a -> PanelServiceProcessKeyEventCallback
gi'cb Ptr PanelService
gi'selfPtr Word32
keyval Word32
keycode Word32
state Ptr ()
_ = do
    Bool
result <- Ptr PanelService -> (PanelService -> IO Bool) -> IO Bool
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO Bool) -> IO Bool)
-> (PanelService -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> PanelServiceProcessKeyEventCallback
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self)  Word32
keyval Word32
keycode Word32
state
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [processKeyEvent](#signal:processKeyEvent) 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' panelService #processKeyEvent callback
-- @
-- 
-- 
onPanelServiceProcessKeyEvent :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceProcessKeyEventCallback) -> m SignalHandlerId
onPanelServiceProcessKeyEvent :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceProcessKeyEventCallback)
-> m SignalHandlerId
onPanelServiceProcessKeyEvent a
obj (?self::a) => PanelServiceProcessKeyEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceProcessKeyEventCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceProcessKeyEventCallback
PanelServiceProcessKeyEventCallback
cb
    let wrapped' :: C_PanelServiceProcessKeyEventCallback
wrapped' = (a -> PanelServiceProcessKeyEventCallback)
-> C_PanelServiceProcessKeyEventCallback
forall a.
GObject a =>
(a -> PanelServiceProcessKeyEventCallback)
-> C_PanelServiceProcessKeyEventCallback
wrap_PanelServiceProcessKeyEventCallback a -> PanelServiceProcessKeyEventCallback
wrapped
    FunPtr C_PanelServiceProcessKeyEventCallback
wrapped'' <- C_PanelServiceProcessKeyEventCallback
-> IO (FunPtr C_PanelServiceProcessKeyEventCallback)
mk_PanelServiceProcessKeyEventCallback C_PanelServiceProcessKeyEventCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceProcessKeyEventCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"process-key-event" FunPtr C_PanelServiceProcessKeyEventCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [processKeyEvent](#signal:processKeyEvent) 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' panelService #processKeyEvent callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceProcessKeyEvent :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceProcessKeyEventCallback) -> m SignalHandlerId
afterPanelServiceProcessKeyEvent :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceProcessKeyEventCallback)
-> m SignalHandlerId
afterPanelServiceProcessKeyEvent a
obj (?self::a) => PanelServiceProcessKeyEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceProcessKeyEventCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceProcessKeyEventCallback
PanelServiceProcessKeyEventCallback
cb
    let wrapped' :: C_PanelServiceProcessKeyEventCallback
wrapped' = (a -> PanelServiceProcessKeyEventCallback)
-> C_PanelServiceProcessKeyEventCallback
forall a.
GObject a =>
(a -> PanelServiceProcessKeyEventCallback)
-> C_PanelServiceProcessKeyEventCallback
wrap_PanelServiceProcessKeyEventCallback a -> PanelServiceProcessKeyEventCallback
wrapped
    FunPtr C_PanelServiceProcessKeyEventCallback
wrapped'' <- C_PanelServiceProcessKeyEventCallback
-> IO (FunPtr C_PanelServiceProcessKeyEventCallback)
mk_PanelServiceProcessKeyEventCallback C_PanelServiceProcessKeyEventCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceProcessKeyEventCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"process-key-event" FunPtr C_PanelServiceProcessKeyEventCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceProcessKeyEventSignalInfo
instance SignalInfo PanelServiceProcessKeyEventSignalInfo where
    type HaskellCallbackType PanelServiceProcessKeyEventSignalInfo = PanelServiceProcessKeyEventCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceProcessKeyEventCallback cb
        cb'' <- mk_PanelServiceProcessKeyEventCallback cb'
        connectSignalFunPtr obj "process-key-event" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::process-key-event"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:processKeyEvent"})

#endif

-- signal PanelService::register-properties
-- | Emitted when the client application get the [registerProperties](#g:signal:registerProperties).
-- Implement the member function
-- IBusPanelServiceClass[register_properties](#g:signal:register_properties) in extended class
-- to receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceRegisterPropertiesCallback =
    IBus.PropList.PropList
    -- ^ /@propList@/: An IBusPropList that contains properties.
    -> IO ()

type C_PanelServiceRegisterPropertiesCallback =
    Ptr PanelService ->                     -- object
    Ptr IBus.PropList.PropList ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceRegisterPropertiesCallback :: 
    GObject a => (a -> PanelServiceRegisterPropertiesCallback) ->
    C_PanelServiceRegisterPropertiesCallback
wrap_PanelServiceRegisterPropertiesCallback :: forall a.
GObject a =>
(a -> PanelServiceRegisterPropertiesCallback)
-> C_PanelServiceRegisterPropertiesCallback
wrap_PanelServiceRegisterPropertiesCallback a -> PanelServiceRegisterPropertiesCallback
gi'cb Ptr PanelService
gi'selfPtr Ptr PropList
propList Ptr ()
_ = do
    PropList
propList' <- ((ManagedPtr PropList -> PropList) -> Ptr PropList -> IO PropList
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr PropList -> PropList
IBus.PropList.PropList) Ptr PropList
propList
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> PanelServiceRegisterPropertiesCallback
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self)  PropList
propList'


-- | Connect a signal handler for the [registerProperties](#signal:registerProperties) 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' panelService #registerProperties callback
-- @
-- 
-- 
onPanelServiceRegisterProperties :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceRegisterPropertiesCallback) -> m SignalHandlerId
onPanelServiceRegisterProperties :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceRegisterPropertiesCallback)
-> m SignalHandlerId
onPanelServiceRegisterProperties a
obj (?self::a) => PanelServiceRegisterPropertiesCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceRegisterPropertiesCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceRegisterPropertiesCallback
PanelServiceRegisterPropertiesCallback
cb
    let wrapped' :: C_PanelServiceRegisterPropertiesCallback
wrapped' = (a -> PanelServiceRegisterPropertiesCallback)
-> C_PanelServiceRegisterPropertiesCallback
forall a.
GObject a =>
(a -> PanelServiceRegisterPropertiesCallback)
-> C_PanelServiceRegisterPropertiesCallback
wrap_PanelServiceRegisterPropertiesCallback a -> PanelServiceRegisterPropertiesCallback
wrapped
    FunPtr C_PanelServiceRegisterPropertiesCallback
wrapped'' <- C_PanelServiceRegisterPropertiesCallback
-> IO (FunPtr C_PanelServiceRegisterPropertiesCallback)
mk_PanelServiceRegisterPropertiesCallback C_PanelServiceRegisterPropertiesCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceRegisterPropertiesCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"register-properties" FunPtr C_PanelServiceRegisterPropertiesCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [registerProperties](#signal:registerProperties) 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' panelService #registerProperties callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceRegisterProperties :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceRegisterPropertiesCallback) -> m SignalHandlerId
afterPanelServiceRegisterProperties :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceRegisterPropertiesCallback)
-> m SignalHandlerId
afterPanelServiceRegisterProperties a
obj (?self::a) => PanelServiceRegisterPropertiesCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceRegisterPropertiesCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceRegisterPropertiesCallback
PanelServiceRegisterPropertiesCallback
cb
    let wrapped' :: C_PanelServiceRegisterPropertiesCallback
wrapped' = (a -> PanelServiceRegisterPropertiesCallback)
-> C_PanelServiceRegisterPropertiesCallback
forall a.
GObject a =>
(a -> PanelServiceRegisterPropertiesCallback)
-> C_PanelServiceRegisterPropertiesCallback
wrap_PanelServiceRegisterPropertiesCallback a -> PanelServiceRegisterPropertiesCallback
wrapped
    FunPtr C_PanelServiceRegisterPropertiesCallback
wrapped'' <- C_PanelServiceRegisterPropertiesCallback
-> IO (FunPtr C_PanelServiceRegisterPropertiesCallback)
mk_PanelServiceRegisterPropertiesCallback C_PanelServiceRegisterPropertiesCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceRegisterPropertiesCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"register-properties" FunPtr C_PanelServiceRegisterPropertiesCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceRegisterPropertiesSignalInfo
instance SignalInfo PanelServiceRegisterPropertiesSignalInfo where
    type HaskellCallbackType PanelServiceRegisterPropertiesSignalInfo = PanelServiceRegisterPropertiesCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceRegisterPropertiesCallback cb
        cb'' <- mk_PanelServiceRegisterPropertiesCallback cb'
        connectSignalFunPtr obj "register-properties" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::register-properties"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:registerProperties"})

#endif

-- signal PanelService::reset
-- | Emitted when the client application get the [reset](#g:signal:reset).
-- Implement the member function
-- IBusPanelServiceClass[reset](#g:signal:reset) in extended class to receive this
-- signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceResetCallback =
    IO ()

type C_PanelServiceResetCallback =
    Ptr PanelService ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceResetCallback :: 
    GObject a => (a -> PanelServiceResetCallback) ->
    C_PanelServiceResetCallback
wrap_PanelServiceResetCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceResetCallback a -> IO ()
gi'cb Ptr PanelService
gi'selfPtr Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> IO ()
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self) 


-- | Connect a signal handler for the [reset](#signal:reset) 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' panelService #reset callback
-- @
-- 
-- 
onPanelServiceReset :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceResetCallback) -> m SignalHandlerId
onPanelServiceReset :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPanelServiceReset a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceResetCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceResetCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"reset" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [reset](#signal:reset) 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' panelService #reset callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceReset :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceResetCallback) -> m SignalHandlerId
afterPanelServiceReset :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPanelServiceReset a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceResetCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceResetCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"reset" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceResetSignalInfo
instance SignalInfo PanelServiceResetSignalInfo where
    type HaskellCallbackType PanelServiceResetSignalInfo = PanelServiceResetCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceResetCallback cb
        cb'' <- mk_PanelServiceResetCallback cb'
        connectSignalFunPtr obj "reset" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::reset"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:reset"})

#endif

-- signal PanelService::set-content-type
-- | Emitted when the client application get the [setContentType](#g:signal:setContentType).
-- Implement the member function
-- IBusPanelServiceClass[set_content_type](#g:signal:set_content_type) in extended class to
-- receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceSetContentTypeCallback =
    Word32
    -- ^ /@purpose@/: Input purpose.
    -> Word32
    -- ^ /@hints@/: Input hints.
    -> IO ()

type C_PanelServiceSetContentTypeCallback =
    Ptr PanelService ->                     -- object
    Word32 ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceSetContentTypeCallback :: 
    GObject a => (a -> PanelServiceSetContentTypeCallback) ->
    C_PanelServiceSetContentTypeCallback
wrap_PanelServiceSetContentTypeCallback :: forall a.
GObject a =>
(a -> PanelServiceSetContentTypeCallback)
-> C_PanelServiceSetContentTypeCallback
wrap_PanelServiceSetContentTypeCallback a -> PanelServiceSetContentTypeCallback
gi'cb Ptr PanelService
gi'selfPtr Word32
purpose Word32
hints Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> PanelServiceSetContentTypeCallback
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self)  Word32
purpose Word32
hints


-- | Connect a signal handler for the [setContentType](#signal:setContentType) 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' panelService #setContentType callback
-- @
-- 
-- 
onPanelServiceSetContentType :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceSetContentTypeCallback) -> m SignalHandlerId
onPanelServiceSetContentType :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceSetContentTypeCallback)
-> m SignalHandlerId
onPanelServiceSetContentType a
obj (?self::a) => PanelServiceSetContentTypeCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceSetContentTypeCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceSetContentTypeCallback
PanelServiceSetContentTypeCallback
cb
    let wrapped' :: C_PanelServiceSetContentTypeCallback
wrapped' = (a -> PanelServiceSetContentTypeCallback)
-> C_PanelServiceSetContentTypeCallback
forall a.
GObject a =>
(a -> PanelServiceSetContentTypeCallback)
-> C_PanelServiceSetContentTypeCallback
wrap_PanelServiceSetContentTypeCallback a -> PanelServiceSetContentTypeCallback
wrapped
    FunPtr C_PanelServiceSetContentTypeCallback
wrapped'' <- C_PanelServiceSetContentTypeCallback
-> IO (FunPtr C_PanelServiceSetContentTypeCallback)
mk_PanelServiceSetContentTypeCallback C_PanelServiceSetContentTypeCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceSetContentTypeCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"set-content-type" FunPtr C_PanelServiceSetContentTypeCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [setContentType](#signal:setContentType) 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' panelService #setContentType callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceSetContentType :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceSetContentTypeCallback) -> m SignalHandlerId
afterPanelServiceSetContentType :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceSetContentTypeCallback)
-> m SignalHandlerId
afterPanelServiceSetContentType a
obj (?self::a) => PanelServiceSetContentTypeCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceSetContentTypeCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceSetContentTypeCallback
PanelServiceSetContentTypeCallback
cb
    let wrapped' :: C_PanelServiceSetContentTypeCallback
wrapped' = (a -> PanelServiceSetContentTypeCallback)
-> C_PanelServiceSetContentTypeCallback
forall a.
GObject a =>
(a -> PanelServiceSetContentTypeCallback)
-> C_PanelServiceSetContentTypeCallback
wrap_PanelServiceSetContentTypeCallback a -> PanelServiceSetContentTypeCallback
wrapped
    FunPtr C_PanelServiceSetContentTypeCallback
wrapped'' <- C_PanelServiceSetContentTypeCallback
-> IO (FunPtr C_PanelServiceSetContentTypeCallback)
mk_PanelServiceSetContentTypeCallback C_PanelServiceSetContentTypeCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceSetContentTypeCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"set-content-type" FunPtr C_PanelServiceSetContentTypeCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceSetContentTypeSignalInfo
instance SignalInfo PanelServiceSetContentTypeSignalInfo where
    type HaskellCallbackType PanelServiceSetContentTypeSignalInfo = PanelServiceSetContentTypeCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceSetContentTypeCallback cb
        cb'' <- mk_PanelServiceSetContentTypeCallback cb'
        connectSignalFunPtr obj "set-content-type" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::set-content-type"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:setContentType"})

#endif

-- signal PanelService::set-cursor-location
-- | Emitted when the client application get the [setCursorLocation](#g:signal:setCursorLocation).
-- Implement the member function
-- IBusPanelServiceClass[set_cursor_location](#g:signal:set_cursor_location) in extended class
-- to receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceSetCursorLocationCallback =
    Int32
    -- ^ /@x@/: X coordinate of the cursor.
    -> Int32
    -- ^ /@y@/: Y coordinate of the cursor.
    -> Int32
    -- ^ /@w@/: Width of the cursor.
    -> Int32
    -- ^ /@h@/: Height of the cursor.
    -> IO ()

type C_PanelServiceSetCursorLocationCallback =
    Ptr PanelService ->                     -- object
    Int32 ->
    Int32 ->
    Int32 ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceSetCursorLocationCallback :: 
    GObject a => (a -> PanelServiceSetCursorLocationCallback) ->
    C_PanelServiceSetCursorLocationCallback
wrap_PanelServiceSetCursorLocationCallback :: forall a.
GObject a =>
(a -> PanelServiceSetCursorLocationCallback)
-> C_PanelServiceSetCursorLocationCallback
wrap_PanelServiceSetCursorLocationCallback a -> PanelServiceSetCursorLocationCallback
gi'cb Ptr PanelService
gi'selfPtr Int32
x Int32
y Int32
w Int32
h Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> PanelServiceSetCursorLocationCallback
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self)  Int32
x Int32
y Int32
w Int32
h


-- | Connect a signal handler for the [setCursorLocation](#signal:setCursorLocation) 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' panelService #setCursorLocation callback
-- @
-- 
-- 
onPanelServiceSetCursorLocation :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceSetCursorLocationCallback) -> m SignalHandlerId
onPanelServiceSetCursorLocation :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceSetCursorLocationCallback)
-> m SignalHandlerId
onPanelServiceSetCursorLocation a
obj (?self::a) => PanelServiceSetCursorLocationCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceSetCursorLocationCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceSetCursorLocationCallback
PanelServiceSetCursorLocationCallback
cb
    let wrapped' :: C_PanelServiceSetCursorLocationCallback
wrapped' = (a -> PanelServiceSetCursorLocationCallback)
-> C_PanelServiceSetCursorLocationCallback
forall a.
GObject a =>
(a -> PanelServiceSetCursorLocationCallback)
-> C_PanelServiceSetCursorLocationCallback
wrap_PanelServiceSetCursorLocationCallback a -> PanelServiceSetCursorLocationCallback
wrapped
    FunPtr C_PanelServiceSetCursorLocationCallback
wrapped'' <- C_PanelServiceSetCursorLocationCallback
-> IO (FunPtr C_PanelServiceSetCursorLocationCallback)
mk_PanelServiceSetCursorLocationCallback C_PanelServiceSetCursorLocationCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceSetCursorLocationCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"set-cursor-location" FunPtr C_PanelServiceSetCursorLocationCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [setCursorLocation](#signal:setCursorLocation) 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' panelService #setCursorLocation callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceSetCursorLocation :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceSetCursorLocationCallback) -> m SignalHandlerId
afterPanelServiceSetCursorLocation :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceSetCursorLocationCallback)
-> m SignalHandlerId
afterPanelServiceSetCursorLocation a
obj (?self::a) => PanelServiceSetCursorLocationCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceSetCursorLocationCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceSetCursorLocationCallback
PanelServiceSetCursorLocationCallback
cb
    let wrapped' :: C_PanelServiceSetCursorLocationCallback
wrapped' = (a -> PanelServiceSetCursorLocationCallback)
-> C_PanelServiceSetCursorLocationCallback
forall a.
GObject a =>
(a -> PanelServiceSetCursorLocationCallback)
-> C_PanelServiceSetCursorLocationCallback
wrap_PanelServiceSetCursorLocationCallback a -> PanelServiceSetCursorLocationCallback
wrapped
    FunPtr C_PanelServiceSetCursorLocationCallback
wrapped'' <- C_PanelServiceSetCursorLocationCallback
-> IO (FunPtr C_PanelServiceSetCursorLocationCallback)
mk_PanelServiceSetCursorLocationCallback C_PanelServiceSetCursorLocationCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceSetCursorLocationCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"set-cursor-location" FunPtr C_PanelServiceSetCursorLocationCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceSetCursorLocationSignalInfo
instance SignalInfo PanelServiceSetCursorLocationSignalInfo where
    type HaskellCallbackType PanelServiceSetCursorLocationSignalInfo = PanelServiceSetCursorLocationCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceSetCursorLocationCallback cb
        cb'' <- mk_PanelServiceSetCursorLocationCallback cb'
        connectSignalFunPtr obj "set-cursor-location" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::set-cursor-location"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:setCursorLocation"})

#endif

-- signal PanelService::set-cursor-location-relative
-- | Emitted when the client application get the set-cursor-location-relative.
-- Implement the member function @/set_cursor_location_relative()/@ in
-- extended class to receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceSetCursorLocationRelativeCallback =
    Int32
    -- ^ /@x@/: X coordinate of the cursor.
    -> Int32
    -- ^ /@y@/: Y coordinate of the cursor.
    -> Int32
    -- ^ /@w@/: Width of the cursor.
    -> Int32
    -- ^ /@h@/: Height of the cursor.
    -> IO ()

type C_PanelServiceSetCursorLocationRelativeCallback =
    Ptr PanelService ->                     -- object
    Int32 ->
    Int32 ->
    Int32 ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceSetCursorLocationRelativeCallback :: 
    GObject a => (a -> PanelServiceSetCursorLocationRelativeCallback) ->
    C_PanelServiceSetCursorLocationRelativeCallback
wrap_PanelServiceSetCursorLocationRelativeCallback :: forall a.
GObject a =>
(a -> PanelServiceSetCursorLocationCallback)
-> C_PanelServiceSetCursorLocationCallback
wrap_PanelServiceSetCursorLocationRelativeCallback a -> PanelServiceSetCursorLocationCallback
gi'cb Ptr PanelService
gi'selfPtr Int32
x Int32
y Int32
w Int32
h Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> PanelServiceSetCursorLocationCallback
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self)  Int32
x Int32
y Int32
w Int32
h


-- | Connect a signal handler for the [setCursorLocationRelative](#signal:setCursorLocationRelative) 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' panelService #setCursorLocationRelative callback
-- @
-- 
-- 
onPanelServiceSetCursorLocationRelative :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceSetCursorLocationRelativeCallback) -> m SignalHandlerId
onPanelServiceSetCursorLocationRelative :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceSetCursorLocationCallback)
-> m SignalHandlerId
onPanelServiceSetCursorLocationRelative a
obj (?self::a) => PanelServiceSetCursorLocationCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceSetCursorLocationCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceSetCursorLocationCallback
PanelServiceSetCursorLocationCallback
cb
    let wrapped' :: C_PanelServiceSetCursorLocationCallback
wrapped' = (a -> PanelServiceSetCursorLocationCallback)
-> C_PanelServiceSetCursorLocationCallback
forall a.
GObject a =>
(a -> PanelServiceSetCursorLocationCallback)
-> C_PanelServiceSetCursorLocationCallback
wrap_PanelServiceSetCursorLocationRelativeCallback a -> PanelServiceSetCursorLocationCallback
wrapped
    FunPtr C_PanelServiceSetCursorLocationCallback
wrapped'' <- C_PanelServiceSetCursorLocationCallback
-> IO (FunPtr C_PanelServiceSetCursorLocationCallback)
mk_PanelServiceSetCursorLocationRelativeCallback C_PanelServiceSetCursorLocationCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceSetCursorLocationCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"set-cursor-location-relative" FunPtr C_PanelServiceSetCursorLocationCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [setCursorLocationRelative](#signal:setCursorLocationRelative) 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' panelService #setCursorLocationRelative callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceSetCursorLocationRelative :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceSetCursorLocationRelativeCallback) -> m SignalHandlerId
afterPanelServiceSetCursorLocationRelative :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceSetCursorLocationCallback)
-> m SignalHandlerId
afterPanelServiceSetCursorLocationRelative a
obj (?self::a) => PanelServiceSetCursorLocationCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceSetCursorLocationCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceSetCursorLocationCallback
PanelServiceSetCursorLocationCallback
cb
    let wrapped' :: C_PanelServiceSetCursorLocationCallback
wrapped' = (a -> PanelServiceSetCursorLocationCallback)
-> C_PanelServiceSetCursorLocationCallback
forall a.
GObject a =>
(a -> PanelServiceSetCursorLocationCallback)
-> C_PanelServiceSetCursorLocationCallback
wrap_PanelServiceSetCursorLocationRelativeCallback a -> PanelServiceSetCursorLocationCallback
wrapped
    FunPtr C_PanelServiceSetCursorLocationCallback
wrapped'' <- C_PanelServiceSetCursorLocationCallback
-> IO (FunPtr C_PanelServiceSetCursorLocationCallback)
mk_PanelServiceSetCursorLocationRelativeCallback C_PanelServiceSetCursorLocationCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceSetCursorLocationCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"set-cursor-location-relative" FunPtr C_PanelServiceSetCursorLocationCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceSetCursorLocationRelativeSignalInfo
instance SignalInfo PanelServiceSetCursorLocationRelativeSignalInfo where
    type HaskellCallbackType PanelServiceSetCursorLocationRelativeSignalInfo = PanelServiceSetCursorLocationRelativeCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceSetCursorLocationRelativeCallback cb
        cb'' <- mk_PanelServiceSetCursorLocationRelativeCallback cb'
        connectSignalFunPtr obj "set-cursor-location-relative" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::set-cursor-location-relative"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:setCursorLocationRelative"})

#endif

-- signal PanelService::show-auxiliary-text
-- | Emitted when the client application get the [showAuxiliaryText](#g:signal:showAuxiliaryText).
-- Implement the member function
-- IBusPanelServiceClass[show_auxiliary_text](#g:signal:show_auxiliary_text) in extended class
-- to receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceShowAuxiliaryTextCallback =
    IO ()

type C_PanelServiceShowAuxiliaryTextCallback =
    Ptr PanelService ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceShowAuxiliaryTextCallback :: 
    GObject a => (a -> PanelServiceShowAuxiliaryTextCallback) ->
    C_PanelServiceShowAuxiliaryTextCallback
wrap_PanelServiceShowAuxiliaryTextCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceShowAuxiliaryTextCallback a -> IO ()
gi'cb Ptr PanelService
gi'selfPtr Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> IO ()
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self) 


-- | Connect a signal handler for the [showAuxiliaryText](#signal:showAuxiliaryText) 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' panelService #showAuxiliaryText callback
-- @
-- 
-- 
onPanelServiceShowAuxiliaryText :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceShowAuxiliaryTextCallback) -> m SignalHandlerId
onPanelServiceShowAuxiliaryText :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPanelServiceShowAuxiliaryText a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceShowAuxiliaryTextCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceShowAuxiliaryTextCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"show-auxiliary-text" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [showAuxiliaryText](#signal:showAuxiliaryText) 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' panelService #showAuxiliaryText callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceShowAuxiliaryText :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceShowAuxiliaryTextCallback) -> m SignalHandlerId
afterPanelServiceShowAuxiliaryText :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPanelServiceShowAuxiliaryText a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceShowAuxiliaryTextCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceShowAuxiliaryTextCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"show-auxiliary-text" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceShowAuxiliaryTextSignalInfo
instance SignalInfo PanelServiceShowAuxiliaryTextSignalInfo where
    type HaskellCallbackType PanelServiceShowAuxiliaryTextSignalInfo = PanelServiceShowAuxiliaryTextCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceShowAuxiliaryTextCallback cb
        cb'' <- mk_PanelServiceShowAuxiliaryTextCallback cb'
        connectSignalFunPtr obj "show-auxiliary-text" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::show-auxiliary-text"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:showAuxiliaryText"})

#endif

-- signal PanelService::show-language-bar
-- | Emitted when the client application get the [showLanguageBar](#g:signal:showLanguageBar).
-- Implement the member function
-- IBusPanelServiceClass[show_language_bar](#g:signal:show_language_bar) in extended class to
-- receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceShowLanguageBarCallback =
    IO ()

type C_PanelServiceShowLanguageBarCallback =
    Ptr PanelService ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceShowLanguageBarCallback :: 
    GObject a => (a -> PanelServiceShowLanguageBarCallback) ->
    C_PanelServiceShowLanguageBarCallback
wrap_PanelServiceShowLanguageBarCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceShowLanguageBarCallback a -> IO ()
gi'cb Ptr PanelService
gi'selfPtr Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> IO ()
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self) 


-- | Connect a signal handler for the [showLanguageBar](#signal:showLanguageBar) 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' panelService #showLanguageBar callback
-- @
-- 
-- 
onPanelServiceShowLanguageBar :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceShowLanguageBarCallback) -> m SignalHandlerId
onPanelServiceShowLanguageBar :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPanelServiceShowLanguageBar a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceShowLanguageBarCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceShowLanguageBarCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"show-language-bar" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [showLanguageBar](#signal:showLanguageBar) 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' panelService #showLanguageBar callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceShowLanguageBar :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceShowLanguageBarCallback) -> m SignalHandlerId
afterPanelServiceShowLanguageBar :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPanelServiceShowLanguageBar a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceShowLanguageBarCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceShowLanguageBarCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"show-language-bar" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceShowLanguageBarSignalInfo
instance SignalInfo PanelServiceShowLanguageBarSignalInfo where
    type HaskellCallbackType PanelServiceShowLanguageBarSignalInfo = PanelServiceShowLanguageBarCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceShowLanguageBarCallback cb
        cb'' <- mk_PanelServiceShowLanguageBarCallback cb'
        connectSignalFunPtr obj "show-language-bar" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::show-language-bar"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:showLanguageBar"})

#endif

-- signal PanelService::show-lookup-table
-- | Emitted when the client application get the [showLookupTable](#g:signal:showLookupTable).
-- Implement the member function
-- IBusPanelServiceClass[show_lookup_table](#g:signal:show_lookup_table) in extended class to
-- receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceShowLookupTableCallback =
    IO ()

type C_PanelServiceShowLookupTableCallback =
    Ptr PanelService ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceShowLookupTableCallback :: 
    GObject a => (a -> PanelServiceShowLookupTableCallback) ->
    C_PanelServiceShowLookupTableCallback
wrap_PanelServiceShowLookupTableCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceShowLookupTableCallback a -> IO ()
gi'cb Ptr PanelService
gi'selfPtr Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> IO ()
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self) 


-- | Connect a signal handler for the [showLookupTable](#signal:showLookupTable) 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' panelService #showLookupTable callback
-- @
-- 
-- 
onPanelServiceShowLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceShowLookupTableCallback) -> m SignalHandlerId
onPanelServiceShowLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPanelServiceShowLookupTable a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceShowLookupTableCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceShowLookupTableCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"show-lookup-table" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [showLookupTable](#signal:showLookupTable) 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' panelService #showLookupTable callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceShowLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceShowLookupTableCallback) -> m SignalHandlerId
afterPanelServiceShowLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPanelServiceShowLookupTable a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceShowLookupTableCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceShowLookupTableCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"show-lookup-table" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceShowLookupTableSignalInfo
instance SignalInfo PanelServiceShowLookupTableSignalInfo where
    type HaskellCallbackType PanelServiceShowLookupTableSignalInfo = PanelServiceShowLookupTableCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceShowLookupTableCallback cb
        cb'' <- mk_PanelServiceShowLookupTableCallback cb'
        connectSignalFunPtr obj "show-lookup-table" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::show-lookup-table"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:showLookupTable"})

#endif

-- signal PanelService::show-preedit-text
-- | Emitted when the client application get the [showPreeditText](#g:signal:showPreeditText).
-- Implement the member function
-- IBusPanelServiceClass[show_preedit_text](#g:signal:show_preedit_text) in extended class to
-- receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceShowPreeditTextCallback =
    IO ()

type C_PanelServiceShowPreeditTextCallback =
    Ptr PanelService ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceShowPreeditTextCallback :: 
    GObject a => (a -> PanelServiceShowPreeditTextCallback) ->
    C_PanelServiceShowPreeditTextCallback
wrap_PanelServiceShowPreeditTextCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceShowPreeditTextCallback a -> IO ()
gi'cb Ptr PanelService
gi'selfPtr Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> IO ()
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self) 


-- | Connect a signal handler for the [showPreeditText](#signal:showPreeditText) 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' panelService #showPreeditText callback
-- @
-- 
-- 
onPanelServiceShowPreeditText :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceShowPreeditTextCallback) -> m SignalHandlerId
onPanelServiceShowPreeditText :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPanelServiceShowPreeditText a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceShowPreeditTextCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceShowPreeditTextCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"show-preedit-text" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [showPreeditText](#signal:showPreeditText) 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' panelService #showPreeditText callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceShowPreeditText :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceShowPreeditTextCallback) -> m SignalHandlerId
afterPanelServiceShowPreeditText :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPanelServiceShowPreeditText a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceShowPreeditTextCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceShowPreeditTextCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"show-preedit-text" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceShowPreeditTextSignalInfo
instance SignalInfo PanelServiceShowPreeditTextSignalInfo where
    type HaskellCallbackType PanelServiceShowPreeditTextSignalInfo = PanelServiceShowPreeditTextCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceShowPreeditTextCallback cb
        cb'' <- mk_PanelServiceShowPreeditTextCallback cb'
        connectSignalFunPtr obj "show-preedit-text" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::show-preedit-text"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:showPreeditText"})

#endif

-- signal PanelService::start-setup
-- | Emitted when the client application get the [startSetup](#g:signal:startSetup).
-- Implement the member function
-- IBusPanelServiceClass[start_setup](#g:signal:start_setup) in extended class to
-- receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceStartSetupCallback =
    IO ()

type C_PanelServiceStartSetupCallback =
    Ptr PanelService ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceStartSetupCallback :: 
    GObject a => (a -> PanelServiceStartSetupCallback) ->
    C_PanelServiceStartSetupCallback
wrap_PanelServiceStartSetupCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceStartSetupCallback a -> IO ()
gi'cb Ptr PanelService
gi'selfPtr Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> IO ()
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self) 


-- | Connect a signal handler for the [startSetup](#signal:startSetup) 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' panelService #startSetup callback
-- @
-- 
-- 
onPanelServiceStartSetup :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceStartSetupCallback) -> m SignalHandlerId
onPanelServiceStartSetup :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPanelServiceStartSetup a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceStartSetupCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceStartSetupCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"start-setup" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [startSetup](#signal:startSetup) 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' panelService #startSetup callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceStartSetup :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceStartSetupCallback) -> m SignalHandlerId
afterPanelServiceStartSetup :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPanelServiceStartSetup a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceStartSetupCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceStartSetupCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"start-setup" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceStartSetupSignalInfo
instance SignalInfo PanelServiceStartSetupSignalInfo where
    type HaskellCallbackType PanelServiceStartSetupSignalInfo = PanelServiceStartSetupCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceStartSetupCallback cb
        cb'' <- mk_PanelServiceStartSetupCallback cb'
        connectSignalFunPtr obj "start-setup" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::start-setup"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:startSetup"})

#endif

-- signal PanelService::state-changed
-- | Emitted when the client application get the [stateChanged](#g:signal:stateChanged).
-- Implement the member function
-- IBusPanelServiceClass[state_changed](#g:signal:state_changed) in extended class to
-- receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceStateChangedCallback =
    IO ()

type C_PanelServiceStateChangedCallback =
    Ptr PanelService ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceStateChangedCallback :: 
    GObject a => (a -> PanelServiceStateChangedCallback) ->
    C_PanelServiceStateChangedCallback
wrap_PanelServiceStateChangedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceStateChangedCallback a -> IO ()
gi'cb Ptr PanelService
gi'selfPtr Ptr ()
_ = do
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> IO ()
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self) 


-- | Connect a signal handler for the [stateChanged](#signal:stateChanged) 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' panelService #stateChanged callback
-- @
-- 
-- 
onPanelServiceStateChanged :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceStateChangedCallback) -> m SignalHandlerId
onPanelServiceStateChanged :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onPanelServiceStateChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceStateChangedCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceStateChangedCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"state-changed" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [stateChanged](#signal:stateChanged) 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' panelService #stateChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceStateChanged :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceStateChangedCallback) -> m SignalHandlerId
afterPanelServiceStateChanged :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterPanelServiceStateChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_PanelServiceCursorDownLookupTableCallback
wrapped' = (a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
forall a.
GObject a =>
(a -> IO ()) -> C_PanelServiceCursorDownLookupTableCallback
wrap_PanelServiceStateChangedCallback a -> IO ()
wrapped
    FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' <- C_PanelServiceCursorDownLookupTableCallback
-> IO (FunPtr C_PanelServiceCursorDownLookupTableCallback)
mk_PanelServiceStateChangedCallback C_PanelServiceCursorDownLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceCursorDownLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"state-changed" FunPtr C_PanelServiceCursorDownLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceStateChangedSignalInfo
instance SignalInfo PanelServiceStateChangedSignalInfo where
    type HaskellCallbackType PanelServiceStateChangedSignalInfo = PanelServiceStateChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceStateChangedCallback cb
        cb'' <- mk_PanelServiceStateChangedCallback cb'
        connectSignalFunPtr obj "state-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::state-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:stateChanged"})

#endif

-- signal PanelService::update-auxiliary-text
-- | Emitted when the client application get the [updateAuxiliaryText](#g:signal:updateAuxiliaryText).
-- Implement the member function
-- IBusPanelServiceClass[update_auxiliary_text](#g:signal:update_auxiliary_text) in extended class
-- to receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceUpdateAuxiliaryTextCallback =
    IBus.Text.Text
    -- ^ /@text@/: A preedit text to be updated.
    -> Bool
    -- ^ /@visible@/: Whether the update is visible.
    -> IO ()

type C_PanelServiceUpdateAuxiliaryTextCallback =
    Ptr PanelService ->                     -- object
    Ptr IBus.Text.Text ->
    CInt ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceUpdateAuxiliaryTextCallback :: 
    GObject a => (a -> PanelServiceUpdateAuxiliaryTextCallback) ->
    C_PanelServiceUpdateAuxiliaryTextCallback
wrap_PanelServiceUpdateAuxiliaryTextCallback :: forall a.
GObject a =>
(a -> PanelServiceUpdateAuxiliaryTextCallback)
-> C_PanelServiceUpdateAuxiliaryTextCallback
wrap_PanelServiceUpdateAuxiliaryTextCallback a -> PanelServiceUpdateAuxiliaryTextCallback
gi'cb Ptr PanelService
gi'selfPtr Ptr Text
text CInt
visible Ptr ()
_ = do
    Text
text' <- ((ManagedPtr Text -> Text) -> Ptr Text -> IO Text
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Text -> Text
IBus.Text.Text) Ptr Text
text
    let visible' :: Bool
visible' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
visible
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> PanelServiceUpdateAuxiliaryTextCallback
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self)  Text
text' Bool
visible'


-- | Connect a signal handler for the [updateAuxiliaryText](#signal:updateAuxiliaryText) 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' panelService #updateAuxiliaryText callback
-- @
-- 
-- 
onPanelServiceUpdateAuxiliaryText :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceUpdateAuxiliaryTextCallback) -> m SignalHandlerId
onPanelServiceUpdateAuxiliaryText :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceUpdateAuxiliaryTextCallback)
-> m SignalHandlerId
onPanelServiceUpdateAuxiliaryText a
obj (?self::a) => PanelServiceUpdateAuxiliaryTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceUpdateAuxiliaryTextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceUpdateAuxiliaryTextCallback
PanelServiceUpdateAuxiliaryTextCallback
cb
    let wrapped' :: C_PanelServiceUpdateAuxiliaryTextCallback
wrapped' = (a -> PanelServiceUpdateAuxiliaryTextCallback)
-> C_PanelServiceUpdateAuxiliaryTextCallback
forall a.
GObject a =>
(a -> PanelServiceUpdateAuxiliaryTextCallback)
-> C_PanelServiceUpdateAuxiliaryTextCallback
wrap_PanelServiceUpdateAuxiliaryTextCallback a -> PanelServiceUpdateAuxiliaryTextCallback
wrapped
    FunPtr C_PanelServiceUpdateAuxiliaryTextCallback
wrapped'' <- C_PanelServiceUpdateAuxiliaryTextCallback
-> IO (FunPtr C_PanelServiceUpdateAuxiliaryTextCallback)
mk_PanelServiceUpdateAuxiliaryTextCallback C_PanelServiceUpdateAuxiliaryTextCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceUpdateAuxiliaryTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"update-auxiliary-text" FunPtr C_PanelServiceUpdateAuxiliaryTextCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [updateAuxiliaryText](#signal:updateAuxiliaryText) 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' panelService #updateAuxiliaryText callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceUpdateAuxiliaryText :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceUpdateAuxiliaryTextCallback) -> m SignalHandlerId
afterPanelServiceUpdateAuxiliaryText :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceUpdateAuxiliaryTextCallback)
-> m SignalHandlerId
afterPanelServiceUpdateAuxiliaryText a
obj (?self::a) => PanelServiceUpdateAuxiliaryTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceUpdateAuxiliaryTextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceUpdateAuxiliaryTextCallback
PanelServiceUpdateAuxiliaryTextCallback
cb
    let wrapped' :: C_PanelServiceUpdateAuxiliaryTextCallback
wrapped' = (a -> PanelServiceUpdateAuxiliaryTextCallback)
-> C_PanelServiceUpdateAuxiliaryTextCallback
forall a.
GObject a =>
(a -> PanelServiceUpdateAuxiliaryTextCallback)
-> C_PanelServiceUpdateAuxiliaryTextCallback
wrap_PanelServiceUpdateAuxiliaryTextCallback a -> PanelServiceUpdateAuxiliaryTextCallback
wrapped
    FunPtr C_PanelServiceUpdateAuxiliaryTextCallback
wrapped'' <- C_PanelServiceUpdateAuxiliaryTextCallback
-> IO (FunPtr C_PanelServiceUpdateAuxiliaryTextCallback)
mk_PanelServiceUpdateAuxiliaryTextCallback C_PanelServiceUpdateAuxiliaryTextCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceUpdateAuxiliaryTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"update-auxiliary-text" FunPtr C_PanelServiceUpdateAuxiliaryTextCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceUpdateAuxiliaryTextSignalInfo
instance SignalInfo PanelServiceUpdateAuxiliaryTextSignalInfo where
    type HaskellCallbackType PanelServiceUpdateAuxiliaryTextSignalInfo = PanelServiceUpdateAuxiliaryTextCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceUpdateAuxiliaryTextCallback cb
        cb'' <- mk_PanelServiceUpdateAuxiliaryTextCallback cb'
        connectSignalFunPtr obj "update-auxiliary-text" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::update-auxiliary-text"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:updateAuxiliaryText"})

#endif

-- signal PanelService::update-lookup-table
-- | Emitted when the client application get the [updateLookupTable](#g:signal:updateLookupTable).
-- Implement the member function
-- IBusPanelServiceClass[update_lookup_table](#g:signal:update_lookup_table) in extended class
-- to receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceUpdateLookupTableCallback =
    IBus.LookupTable.LookupTable
    -- ^ /@lookupTable@/: A lookup table to be updated.
    -> Bool
    -- ^ /@visible@/: Whether the update is visible.
    -> IO ()

type C_PanelServiceUpdateLookupTableCallback =
    Ptr PanelService ->                     -- object
    Ptr IBus.LookupTable.LookupTable ->
    CInt ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceUpdateLookupTableCallback :: 
    GObject a => (a -> PanelServiceUpdateLookupTableCallback) ->
    C_PanelServiceUpdateLookupTableCallback
wrap_PanelServiceUpdateLookupTableCallback :: forall a.
GObject a =>
(a -> PanelServiceUpdateLookupTableCallback)
-> C_PanelServiceUpdateLookupTableCallback
wrap_PanelServiceUpdateLookupTableCallback a -> PanelServiceUpdateLookupTableCallback
gi'cb Ptr PanelService
gi'selfPtr Ptr LookupTable
lookupTable CInt
visible Ptr ()
_ = do
    LookupTable
lookupTable' <- ((ManagedPtr LookupTable -> LookupTable)
-> Ptr LookupTable -> IO LookupTable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr LookupTable -> LookupTable
IBus.LookupTable.LookupTable) Ptr LookupTable
lookupTable
    let visible' :: Bool
visible' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
visible
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> PanelServiceUpdateLookupTableCallback
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self)  LookupTable
lookupTable' Bool
visible'


-- | Connect a signal handler for the [updateLookupTable](#signal:updateLookupTable) 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' panelService #updateLookupTable callback
-- @
-- 
-- 
onPanelServiceUpdateLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceUpdateLookupTableCallback) -> m SignalHandlerId
onPanelServiceUpdateLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceUpdateLookupTableCallback)
-> m SignalHandlerId
onPanelServiceUpdateLookupTable a
obj (?self::a) => PanelServiceUpdateLookupTableCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceUpdateLookupTableCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceUpdateLookupTableCallback
PanelServiceUpdateLookupTableCallback
cb
    let wrapped' :: C_PanelServiceUpdateLookupTableCallback
wrapped' = (a -> PanelServiceUpdateLookupTableCallback)
-> C_PanelServiceUpdateLookupTableCallback
forall a.
GObject a =>
(a -> PanelServiceUpdateLookupTableCallback)
-> C_PanelServiceUpdateLookupTableCallback
wrap_PanelServiceUpdateLookupTableCallback a -> PanelServiceUpdateLookupTableCallback
wrapped
    FunPtr C_PanelServiceUpdateLookupTableCallback
wrapped'' <- C_PanelServiceUpdateLookupTableCallback
-> IO (FunPtr C_PanelServiceUpdateLookupTableCallback)
mk_PanelServiceUpdateLookupTableCallback C_PanelServiceUpdateLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceUpdateLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"update-lookup-table" FunPtr C_PanelServiceUpdateLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [updateLookupTable](#signal:updateLookupTable) 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' panelService #updateLookupTable callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceUpdateLookupTable :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceUpdateLookupTableCallback) -> m SignalHandlerId
afterPanelServiceUpdateLookupTable :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceUpdateLookupTableCallback)
-> m SignalHandlerId
afterPanelServiceUpdateLookupTable a
obj (?self::a) => PanelServiceUpdateLookupTableCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceUpdateLookupTableCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceUpdateLookupTableCallback
PanelServiceUpdateLookupTableCallback
cb
    let wrapped' :: C_PanelServiceUpdateLookupTableCallback
wrapped' = (a -> PanelServiceUpdateLookupTableCallback)
-> C_PanelServiceUpdateLookupTableCallback
forall a.
GObject a =>
(a -> PanelServiceUpdateLookupTableCallback)
-> C_PanelServiceUpdateLookupTableCallback
wrap_PanelServiceUpdateLookupTableCallback a -> PanelServiceUpdateLookupTableCallback
wrapped
    FunPtr C_PanelServiceUpdateLookupTableCallback
wrapped'' <- C_PanelServiceUpdateLookupTableCallback
-> IO (FunPtr C_PanelServiceUpdateLookupTableCallback)
mk_PanelServiceUpdateLookupTableCallback C_PanelServiceUpdateLookupTableCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceUpdateLookupTableCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"update-lookup-table" FunPtr C_PanelServiceUpdateLookupTableCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceUpdateLookupTableSignalInfo
instance SignalInfo PanelServiceUpdateLookupTableSignalInfo where
    type HaskellCallbackType PanelServiceUpdateLookupTableSignalInfo = PanelServiceUpdateLookupTableCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceUpdateLookupTableCallback cb
        cb'' <- mk_PanelServiceUpdateLookupTableCallback cb'
        connectSignalFunPtr obj "update-lookup-table" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::update-lookup-table"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:updateLookupTable"})

#endif

-- signal PanelService::update-preedit-text
-- | Emitted when the client application get the [updatePreeditText](#g:signal:updatePreeditText).
-- Implement the member function
-- IBusPanelServiceClass[update_preedit_text](#g:signal:update_preedit_text) in extended class
-- to receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceUpdatePreeditTextCallback =
    IBus.Text.Text
    -- ^ /@text@/: A preedit text to be updated.
    -> Word32
    -- ^ /@cursorPos@/: The cursor position of the text.
    -> Bool
    -- ^ /@visible@/: Whether the update is visible.
    -> IO ()

type C_PanelServiceUpdatePreeditTextCallback =
    Ptr PanelService ->                     -- object
    Ptr IBus.Text.Text ->
    Word32 ->
    CInt ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceUpdatePreeditTextCallback :: 
    GObject a => (a -> PanelServiceUpdatePreeditTextCallback) ->
    C_PanelServiceUpdatePreeditTextCallback
wrap_PanelServiceUpdatePreeditTextCallback :: forall a.
GObject a =>
(a -> PanelServiceUpdatePreeditTextCallback)
-> C_PanelServiceUpdatePreeditTextCallback
wrap_PanelServiceUpdatePreeditTextCallback a -> PanelServiceUpdatePreeditTextCallback
gi'cb Ptr PanelService
gi'selfPtr Ptr Text
text Word32
cursorPos CInt
visible Ptr ()
_ = do
    Text
text' <- ((ManagedPtr Text -> Text) -> Ptr Text -> IO Text
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Text -> Text
IBus.Text.Text) Ptr Text
text
    let visible' :: Bool
visible' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
visible
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> PanelServiceUpdatePreeditTextCallback
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self)  Text
text' Word32
cursorPos Bool
visible'


-- | Connect a signal handler for the [updatePreeditText](#signal:updatePreeditText) 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' panelService #updatePreeditText callback
-- @
-- 
-- 
onPanelServiceUpdatePreeditText :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceUpdatePreeditTextCallback) -> m SignalHandlerId
onPanelServiceUpdatePreeditText :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceUpdatePreeditTextCallback)
-> m SignalHandlerId
onPanelServiceUpdatePreeditText a
obj (?self::a) => PanelServiceUpdatePreeditTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceUpdatePreeditTextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceUpdatePreeditTextCallback
PanelServiceUpdatePreeditTextCallback
cb
    let wrapped' :: C_PanelServiceUpdatePreeditTextCallback
wrapped' = (a -> PanelServiceUpdatePreeditTextCallback)
-> C_PanelServiceUpdatePreeditTextCallback
forall a.
GObject a =>
(a -> PanelServiceUpdatePreeditTextCallback)
-> C_PanelServiceUpdatePreeditTextCallback
wrap_PanelServiceUpdatePreeditTextCallback a -> PanelServiceUpdatePreeditTextCallback
wrapped
    FunPtr C_PanelServiceUpdatePreeditTextCallback
wrapped'' <- C_PanelServiceUpdatePreeditTextCallback
-> IO (FunPtr C_PanelServiceUpdatePreeditTextCallback)
mk_PanelServiceUpdatePreeditTextCallback C_PanelServiceUpdatePreeditTextCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceUpdatePreeditTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"update-preedit-text" FunPtr C_PanelServiceUpdatePreeditTextCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [updatePreeditText](#signal:updatePreeditText) 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' panelService #updatePreeditText callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceUpdatePreeditText :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceUpdatePreeditTextCallback) -> m SignalHandlerId
afterPanelServiceUpdatePreeditText :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceUpdatePreeditTextCallback)
-> m SignalHandlerId
afterPanelServiceUpdatePreeditText a
obj (?self::a) => PanelServiceUpdatePreeditTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceUpdatePreeditTextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceUpdatePreeditTextCallback
PanelServiceUpdatePreeditTextCallback
cb
    let wrapped' :: C_PanelServiceUpdatePreeditTextCallback
wrapped' = (a -> PanelServiceUpdatePreeditTextCallback)
-> C_PanelServiceUpdatePreeditTextCallback
forall a.
GObject a =>
(a -> PanelServiceUpdatePreeditTextCallback)
-> C_PanelServiceUpdatePreeditTextCallback
wrap_PanelServiceUpdatePreeditTextCallback a -> PanelServiceUpdatePreeditTextCallback
wrapped
    FunPtr C_PanelServiceUpdatePreeditTextCallback
wrapped'' <- C_PanelServiceUpdatePreeditTextCallback
-> IO (FunPtr C_PanelServiceUpdatePreeditTextCallback)
mk_PanelServiceUpdatePreeditTextCallback C_PanelServiceUpdatePreeditTextCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceUpdatePreeditTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"update-preedit-text" FunPtr C_PanelServiceUpdatePreeditTextCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceUpdatePreeditTextSignalInfo
instance SignalInfo PanelServiceUpdatePreeditTextSignalInfo where
    type HaskellCallbackType PanelServiceUpdatePreeditTextSignalInfo = PanelServiceUpdatePreeditTextCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceUpdatePreeditTextCallback cb
        cb'' <- mk_PanelServiceUpdatePreeditTextCallback cb'
        connectSignalFunPtr obj "update-preedit-text" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::update-preedit-text"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:updatePreeditText"})

#endif

-- signal PanelService::update-property
-- | Emitted when the client application get the [updateProperty](#g:signal:updateProperty).
-- Implement the member function
-- IBusPanelServiceClass[update_property](#g:signal:update_property) in extended class to
-- receive this signal.
-- 
-- \<note>\<para>Argument /@userData@/ is ignored in this function.\<\/para>
-- \<\/note>
type PanelServiceUpdatePropertyCallback =
    IBus.Property.Property
    -- ^ /@prop@/: The IBusProperty to be updated.
    -> IO ()

type C_PanelServiceUpdatePropertyCallback =
    Ptr PanelService ->                     -- object
    Ptr IBus.Property.Property ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_PanelServiceUpdatePropertyCallback :: 
    GObject a => (a -> PanelServiceUpdatePropertyCallback) ->
    C_PanelServiceUpdatePropertyCallback
wrap_PanelServiceUpdatePropertyCallback :: forall a.
GObject a =>
(a -> PanelServiceUpdatePropertyCallback)
-> C_PanelServiceUpdatePropertyCallback
wrap_PanelServiceUpdatePropertyCallback a -> PanelServiceUpdatePropertyCallback
gi'cb Ptr PanelService
gi'selfPtr Ptr Property
prop Ptr ()
_ = do
    Property
prop' <- ((ManagedPtr Property -> Property) -> Ptr Property -> IO Property
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Property -> Property
IBus.Property.Property) Ptr Property
prop
    Ptr PanelService -> (PanelService -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr PanelService
gi'selfPtr ((PanelService -> IO ()) -> IO ())
-> (PanelService -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PanelService
gi'self -> a -> PanelServiceUpdatePropertyCallback
gi'cb (PanelService -> a
forall a b. Coercible a b => a -> b
Coerce.coerce PanelService
gi'self)  Property
prop'


-- | Connect a signal handler for the [updateProperty](#signal:updateProperty) 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' panelService #updateProperty callback
-- @
-- 
-- 
onPanelServiceUpdateProperty :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceUpdatePropertyCallback) -> m SignalHandlerId
onPanelServiceUpdateProperty :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceUpdatePropertyCallback)
-> m SignalHandlerId
onPanelServiceUpdateProperty a
obj (?self::a) => PanelServiceUpdatePropertyCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceUpdatePropertyCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceUpdatePropertyCallback
PanelServiceUpdatePropertyCallback
cb
    let wrapped' :: C_PanelServiceUpdatePropertyCallback
wrapped' = (a -> PanelServiceUpdatePropertyCallback)
-> C_PanelServiceUpdatePropertyCallback
forall a.
GObject a =>
(a -> PanelServiceUpdatePropertyCallback)
-> C_PanelServiceUpdatePropertyCallback
wrap_PanelServiceUpdatePropertyCallback a -> PanelServiceUpdatePropertyCallback
wrapped
    FunPtr C_PanelServiceUpdatePropertyCallback
wrapped'' <- C_PanelServiceUpdatePropertyCallback
-> IO (FunPtr C_PanelServiceUpdatePropertyCallback)
mk_PanelServiceUpdatePropertyCallback C_PanelServiceUpdatePropertyCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceUpdatePropertyCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"update-property" FunPtr C_PanelServiceUpdatePropertyCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [updateProperty](#signal:updateProperty) 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' panelService #updateProperty callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterPanelServiceUpdateProperty :: (IsPanelService a, MonadIO m) => a -> ((?self :: a) => PanelServiceUpdatePropertyCallback) -> m SignalHandlerId
afterPanelServiceUpdateProperty :: forall a (m :: * -> *).
(IsPanelService a, MonadIO m) =>
a
-> ((?self::a) => PanelServiceUpdatePropertyCallback)
-> m SignalHandlerId
afterPanelServiceUpdateProperty a
obj (?self::a) => PanelServiceUpdatePropertyCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 wrapped :: a -> PanelServiceUpdatePropertyCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => PanelServiceUpdatePropertyCallback
PanelServiceUpdatePropertyCallback
cb
    let wrapped' :: C_PanelServiceUpdatePropertyCallback
wrapped' = (a -> PanelServiceUpdatePropertyCallback)
-> C_PanelServiceUpdatePropertyCallback
forall a.
GObject a =>
(a -> PanelServiceUpdatePropertyCallback)
-> C_PanelServiceUpdatePropertyCallback
wrap_PanelServiceUpdatePropertyCallback a -> PanelServiceUpdatePropertyCallback
wrapped
    FunPtr C_PanelServiceUpdatePropertyCallback
wrapped'' <- C_PanelServiceUpdatePropertyCallback
-> IO (FunPtr C_PanelServiceUpdatePropertyCallback)
mk_PanelServiceUpdatePropertyCallback C_PanelServiceUpdatePropertyCallback
wrapped'
    a
-> Text
-> FunPtr C_PanelServiceUpdatePropertyCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"update-property" FunPtr C_PanelServiceUpdatePropertyCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanelServiceUpdatePropertySignalInfo
instance SignalInfo PanelServiceUpdatePropertySignalInfo where
    type HaskellCallbackType PanelServiceUpdatePropertySignalInfo = PanelServiceUpdatePropertyCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanelServiceUpdatePropertyCallback cb
        cb'' <- mk_PanelServiceUpdatePropertyCallback cb'
        connectSignalFunPtr obj "update-property" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService::update-property"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#g:signal:updateProperty"})

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PanelService
type instance O.AttributeList PanelService = PanelServiceAttributeList
type PanelServiceAttributeList = ('[ '("connection", IBus.Service.ServiceConnectionPropertyInfo), '("objectPath", IBus.Service.ServiceObjectPathPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList PanelService = PanelServiceSignalList
type PanelServiceSignalList = ('[ '("candidateClickedLookupTable", PanelServiceCandidateClickedLookupTableSignalInfo), '("commitTextReceived", PanelServiceCommitTextReceivedSignalInfo), '("cursorDownLookupTable", PanelServiceCursorDownLookupTableSignalInfo), '("cursorUpLookupTable", PanelServiceCursorUpLookupTableSignalInfo), '("destroy", IBus.Object.ObjectDestroySignalInfo), '("destroyContext", PanelServiceDestroyContextSignalInfo), '("focusIn", PanelServiceFocusInSignalInfo), '("focusOut", PanelServiceFocusOutSignalInfo), '("hideAuxiliaryText", PanelServiceHideAuxiliaryTextSignalInfo), '("hideLanguageBar", PanelServiceHideLanguageBarSignalInfo), '("hideLookupTable", PanelServiceHideLookupTableSignalInfo), '("hidePreeditText", PanelServiceHidePreeditTextSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("pageDownLookupTable", PanelServicePageDownLookupTableSignalInfo), '("pageUpLookupTable", PanelServicePageUpLookupTableSignalInfo), '("panelExtensionReceived", PanelServicePanelExtensionReceivedSignalInfo), '("processKeyEvent", PanelServiceProcessKeyEventSignalInfo), '("registerProperties", PanelServiceRegisterPropertiesSignalInfo), '("reset", PanelServiceResetSignalInfo), '("setContentType", PanelServiceSetContentTypeSignalInfo), '("setCursorLocation", PanelServiceSetCursorLocationSignalInfo), '("setCursorLocationRelative", PanelServiceSetCursorLocationRelativeSignalInfo), '("showAuxiliaryText", PanelServiceShowAuxiliaryTextSignalInfo), '("showLanguageBar", PanelServiceShowLanguageBarSignalInfo), '("showLookupTable", PanelServiceShowLookupTableSignalInfo), '("showPreeditText", PanelServiceShowPreeditTextSignalInfo), '("startSetup", PanelServiceStartSetupSignalInfo), '("stateChanged", PanelServiceStateChangedSignalInfo), '("updateAuxiliaryText", PanelServiceUpdateAuxiliaryTextSignalInfo), '("updateLookupTable", PanelServiceUpdateLookupTableSignalInfo), '("updatePreeditText", PanelServiceUpdatePreeditTextSignalInfo), '("updateProperty", PanelServiceUpdatePropertySignalInfo)] :: [(Symbol, *)])

#endif

-- method PanelService::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "connection"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DBusConnection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An GDBusConnection."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "IBus" , name = "PanelService" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_panel_service_new" ibus_panel_service_new :: 
    Ptr Gio.DBusConnection.DBusConnection -> -- connection : TInterface (Name {namespace = "Gio", name = "DBusConnection"})
    IO (Ptr PanelService)

-- | Creates a new t'GI.IBus.Objects.PanelService.PanelService' from an t'GI.Gio.Objects.DBusConnection.DBusConnection'.
panelServiceNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.DBusConnection.IsDBusConnection a) =>
    a
    -- ^ /@connection@/: An GDBusConnection.
    -> m PanelService
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.PanelService.PanelService'.
panelServiceNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDBusConnection a) =>
a -> m PanelService
panelServiceNew a
connection = IO PanelService -> m PanelService
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PanelService -> m PanelService)
-> IO PanelService -> m PanelService
forall a b. (a -> b) -> a -> b
$ do
    Ptr DBusConnection
connection' <- a -> IO (Ptr DBusConnection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
connection
    Ptr PanelService
result <- Ptr DBusConnection -> IO (Ptr PanelService)
ibus_panel_service_new Ptr DBusConnection
connection'
    Text -> Ptr PanelService -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"panelServiceNew" Ptr PanelService
result
    PanelService
result' <- ((ManagedPtr PanelService -> PanelService)
-> Ptr PanelService -> IO PanelService
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr PanelService -> PanelService
PanelService) Ptr PanelService
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
connection
    PanelService -> IO PanelService
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PanelService
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method PanelService::candidate_clicked
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "panel"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PanelService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusPanelService"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Index in the Lookup table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "button"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GdkEventButton::button (1: left button, etc.)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GdkEventButton::state (key modifier flags)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_panel_service_candidate_clicked" ibus_panel_service_candidate_clicked :: 
    Ptr PanelService ->                     -- panel : TInterface (Name {namespace = "IBus", name = "PanelService"})
    Word32 ->                               -- index : TBasicType TUInt
    Word32 ->                               -- button : TBasicType TUInt
    Word32 ->                               -- state : TBasicType TUInt
    IO ()

-- | Notify that a candidate is clicked
-- by sending a \"CandidateClicked\" to IBus service.
panelServiceCandidateClicked ::
    (B.CallStack.HasCallStack, MonadIO m, IsPanelService a) =>
    a
    -- ^ /@panel@/: An IBusPanelService
    -> Word32
    -- ^ /@index@/: Index in the Lookup table
    -> Word32
    -- ^ /@button@/: GdkEventButton[button](#g:signal:button) (1: left button, etc.)
    -> Word32
    -- ^ /@state@/: GdkEventButton[state](#g:signal:state) (key modifier flags)
    -> m ()
panelServiceCandidateClicked :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPanelService a) =>
a -> Word32 -> Word32 -> Word32 -> m ()
panelServiceCandidateClicked a
panel Word32
index Word32
button Word32
state = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PanelService
panel' <- a -> IO (Ptr PanelService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
panel
    Ptr PanelService -> PanelServiceCandidateClickedLookupTableCallback
ibus_panel_service_candidate_clicked Ptr PanelService
panel' Word32
index Word32
button Word32
state
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
panel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanelServiceCandidateClickedMethodInfo
instance (signature ~ (Word32 -> Word32 -> Word32 -> m ()), MonadIO m, IsPanelService a) => O.OverloadedMethod PanelServiceCandidateClickedMethodInfo a signature where
    overloadedMethod = panelServiceCandidateClicked

instance O.OverloadedMethodInfo PanelServiceCandidateClickedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService.panelServiceCandidateClicked",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#v:panelServiceCandidateClicked"
        })


#endif

-- method PanelService::commit_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "panel"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PanelService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusPanelService"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TInterface Name { namespace = "IBus" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusText" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_panel_service_commit_text" ibus_panel_service_commit_text :: 
    Ptr PanelService ->                     -- panel : TInterface (Name {namespace = "IBus", name = "PanelService"})
    Ptr IBus.Text.Text ->                   -- text : TInterface (Name {namespace = "IBus", name = "Text"})
    IO ()

-- | Notify that a text is sent
-- by sending a \"CommitText\" message to IBus service.
panelServiceCommitText ::
    (B.CallStack.HasCallStack, MonadIO m, IsPanelService a, IBus.Text.IsText b) =>
    a
    -- ^ /@panel@/: An t'GI.IBus.Objects.PanelService.PanelService'
    -> b
    -- ^ /@text@/: An t'GI.IBus.Objects.Text.Text'
    -> m ()
panelServiceCommitText :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPanelService a, IsText b) =>
a -> b -> m ()
panelServiceCommitText a
panel b
text = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PanelService
panel' <- a -> IO (Ptr PanelService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
panel
    Ptr Text
text' <- b -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
text
    Ptr PanelService -> Ptr Text -> IO ()
ibus_panel_service_commit_text Ptr PanelService
panel' Ptr Text
text'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
panel
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
text
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanelServiceCommitTextMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsPanelService a, IBus.Text.IsText b) => O.OverloadedMethod PanelServiceCommitTextMethodInfo a signature where
    overloadedMethod = panelServiceCommitText

instance O.OverloadedMethodInfo PanelServiceCommitTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService.panelServiceCommitText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#v:panelServiceCommitText"
        })


#endif

-- method PanelService::cursor_down
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "panel"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PanelService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusPanelService"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_panel_service_cursor_down" ibus_panel_service_cursor_down :: 
    Ptr PanelService ->                     -- panel : TInterface (Name {namespace = "IBus", name = "PanelService"})
    IO ()

-- | Notify that the cursor is down
-- by sending a \"CursorDown\" to IBus service.
panelServiceCursorDown ::
    (B.CallStack.HasCallStack, MonadIO m, IsPanelService a) =>
    a
    -- ^ /@panel@/: An IBusPanelService
    -> m ()
panelServiceCursorDown :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPanelService a) =>
a -> m ()
panelServiceCursorDown a
panel = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PanelService
panel' <- a -> IO (Ptr PanelService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
panel
    Ptr PanelService -> IO ()
ibus_panel_service_cursor_down Ptr PanelService
panel'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
panel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanelServiceCursorDownMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPanelService a) => O.OverloadedMethod PanelServiceCursorDownMethodInfo a signature where
    overloadedMethod = panelServiceCursorDown

instance O.OverloadedMethodInfo PanelServiceCursorDownMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService.panelServiceCursorDown",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#v:panelServiceCursorDown"
        })


#endif

-- method PanelService::cursor_up
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "panel"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PanelService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusPanelService"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_panel_service_cursor_up" ibus_panel_service_cursor_up :: 
    Ptr PanelService ->                     -- panel : TInterface (Name {namespace = "IBus", name = "PanelService"})
    IO ()

-- | Notify that the cursor is up
-- by sending a \"CursorUp\" to IBus service.
panelServiceCursorUp ::
    (B.CallStack.HasCallStack, MonadIO m, IsPanelService a) =>
    a
    -- ^ /@panel@/: An IBusPanelService
    -> m ()
panelServiceCursorUp :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPanelService a) =>
a -> m ()
panelServiceCursorUp a
panel = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PanelService
panel' <- a -> IO (Ptr PanelService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
panel
    Ptr PanelService -> IO ()
ibus_panel_service_cursor_up Ptr PanelService
panel'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
panel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanelServiceCursorUpMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPanelService a) => O.OverloadedMethod PanelServiceCursorUpMethodInfo a signature where
    overloadedMethod = panelServiceCursorUp

instance O.OverloadedMethodInfo PanelServiceCursorUpMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService.panelServiceCursorUp",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#v:panelServiceCursorUp"
        })


#endif

-- XXX Could not generate method PanelService::hide_preedit_text_received
-- Bad introspection data: Could not resolve the symbol “ibus_panel_service_hide_preedit_text_received” in the “IBus” namespace, ignoring.
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data PanelServiceHidePreeditTextReceivedMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "hidePreeditTextReceived" PanelService) => O.OverloadedMethod PanelServiceHidePreeditTextReceivedMethodInfo o p where
    overloadedMethod = undefined

instance (o ~ O.UnsupportedMethodError "hidePreeditTextReceived" PanelService) => O.OverloadedMethodInfo PanelServiceHidePreeditTextReceivedMethodInfo o where
    overloadedMethodInfo = undefined

#endif

-- method PanelService::page_down
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "panel"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PanelService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusPanelService"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_panel_service_page_down" ibus_panel_service_page_down :: 
    Ptr PanelService ->                     -- panel : TInterface (Name {namespace = "IBus", name = "PanelService"})
    IO ()

-- | Notify that the page is down
-- by sending a \"PageDown\" to IBus service.
panelServicePageDown ::
    (B.CallStack.HasCallStack, MonadIO m, IsPanelService a) =>
    a
    -- ^ /@panel@/: An IBusPanelService
    -> m ()
panelServicePageDown :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPanelService a) =>
a -> m ()
panelServicePageDown a
panel = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PanelService
panel' <- a -> IO (Ptr PanelService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
panel
    Ptr PanelService -> IO ()
ibus_panel_service_page_down Ptr PanelService
panel'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
panel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanelServicePageDownMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPanelService a) => O.OverloadedMethod PanelServicePageDownMethodInfo a signature where
    overloadedMethod = panelServicePageDown

instance O.OverloadedMethodInfo PanelServicePageDownMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService.panelServicePageDown",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#v:panelServicePageDown"
        })


#endif

-- method PanelService::page_up
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "panel"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PanelService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusPanelService"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_panel_service_page_up" ibus_panel_service_page_up :: 
    Ptr PanelService ->                     -- panel : TInterface (Name {namespace = "IBus", name = "PanelService"})
    IO ()

-- | Notify that the page is up
-- by sending a \"PageUp\" to IBus service.
panelServicePageUp ::
    (B.CallStack.HasCallStack, MonadIO m, IsPanelService a) =>
    a
    -- ^ /@panel@/: An IBusPanelService
    -> m ()
panelServicePageUp :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPanelService a) =>
a -> m ()
panelServicePageUp a
panel = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PanelService
panel' <- a -> IO (Ptr PanelService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
panel
    Ptr PanelService -> IO ()
ibus_panel_service_page_up Ptr PanelService
panel'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
panel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanelServicePageUpMethodInfo
instance (signature ~ (m ()), MonadIO m, IsPanelService a) => O.OverloadedMethod PanelServicePageUpMethodInfo a signature where
    overloadedMethod = panelServicePageUp

instance O.OverloadedMethodInfo PanelServicePageUpMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService.panelServicePageUp",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#v:panelServicePageUp"
        })


#endif

-- method PanelService::panel_extension
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "panel"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PanelService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusPanelService"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "ExtensionEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A #PanelExtensionEvent which is sent to a\n                         panel extension."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_panel_service_panel_extension" ibus_panel_service_panel_extension :: 
    Ptr PanelService ->                     -- panel : TInterface (Name {namespace = "IBus", name = "PanelService"})
    Ptr IBus.ExtensionEvent.ExtensionEvent -> -- event : TInterface (Name {namespace = "IBus", name = "ExtensionEvent"})
    IO ()

-- | Enable or disable a panel extension with t'GI.IBus.Objects.ExtensionEvent.ExtensionEvent'.
-- Notify that a data is sent
-- by sending a \"PanelExtension\" message to IBus panel extension service.
panelServicePanelExtension ::
    (B.CallStack.HasCallStack, MonadIO m, IsPanelService a, IBus.ExtensionEvent.IsExtensionEvent b) =>
    a
    -- ^ /@panel@/: An t'GI.IBus.Objects.PanelService.PanelService'
    -> b
    -- ^ /@event@/: A @/PanelExtensionEvent/@ which is sent to a
    --                          panel extension.
    -> m ()
panelServicePanelExtension :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPanelService a, IsExtensionEvent b) =>
a -> b -> m ()
panelServicePanelExtension a
panel b
event = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PanelService
panel' <- a -> IO (Ptr PanelService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
panel
    Ptr ExtensionEvent
event' <- b -> IO (Ptr ExtensionEvent)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject b
event
    Ptr PanelService -> Ptr ExtensionEvent -> IO ()
ibus_panel_service_panel_extension Ptr PanelService
panel' Ptr ExtensionEvent
event'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
panel
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
event
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanelServicePanelExtensionMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsPanelService a, IBus.ExtensionEvent.IsExtensionEvent b) => O.OverloadedMethod PanelServicePanelExtensionMethodInfo a signature where
    overloadedMethod = panelServicePanelExtension

instance O.OverloadedMethodInfo PanelServicePanelExtensionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService.panelServicePanelExtension",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#v:panelServicePanelExtension"
        })


#endif

-- method PanelService::property_activate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "panel"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PanelService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusPanelService"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prop_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A property name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prop_state"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "State of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_panel_service_property_activate" ibus_panel_service_property_activate :: 
    Ptr PanelService ->                     -- panel : TInterface (Name {namespace = "IBus", name = "PanelService"})
    CString ->                              -- prop_name : TBasicType TUTF8
    Word32 ->                               -- prop_state : TBasicType TUInt
    IO ()

-- | Notify that a property is active
-- by sending a \"PropertyActivate\" message to IBus service.
panelServicePropertyActivate ::
    (B.CallStack.HasCallStack, MonadIO m, IsPanelService a) =>
    a
    -- ^ /@panel@/: An IBusPanelService
    -> T.Text
    -- ^ /@propName@/: A property name
    -> Word32
    -- ^ /@propState@/: State of the property
    -> m ()
panelServicePropertyActivate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPanelService a) =>
a -> Text -> Word32 -> m ()
panelServicePropertyActivate a
panel Text
propName Word32
propState = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PanelService
panel' <- a -> IO (Ptr PanelService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
panel
    CString
propName' <- Text -> IO CString
textToCString Text
propName
    Ptr PanelService -> CString -> Word32 -> IO ()
ibus_panel_service_property_activate Ptr PanelService
panel' CString
propName' Word32
propState
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
panel
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanelServicePropertyActivateMethodInfo
instance (signature ~ (T.Text -> Word32 -> m ()), MonadIO m, IsPanelService a) => O.OverloadedMethod PanelServicePropertyActivateMethodInfo a signature where
    overloadedMethod = panelServicePropertyActivate

instance O.OverloadedMethodInfo PanelServicePropertyActivateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService.panelServicePropertyActivate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#v:panelServicePropertyActivate"
        })


#endif

-- method PanelService::property_hide
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "panel"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PanelService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusPanelService"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prop_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A property name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_panel_service_property_hide" ibus_panel_service_property_hide :: 
    Ptr PanelService ->                     -- panel : TInterface (Name {namespace = "IBus", name = "PanelService"})
    CString ->                              -- prop_name : TBasicType TUTF8
    IO ()

-- | Notify that a property is hidden
-- by sending a \"ValueChanged\" message to IBus service.
panelServicePropertyHide ::
    (B.CallStack.HasCallStack, MonadIO m, IsPanelService a) =>
    a
    -- ^ /@panel@/: An IBusPanelService
    -> T.Text
    -- ^ /@propName@/: A property name
    -> m ()
panelServicePropertyHide :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPanelService a) =>
a -> Text -> m ()
panelServicePropertyHide a
panel Text
propName = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PanelService
panel' <- a -> IO (Ptr PanelService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
panel
    CString
propName' <- Text -> IO CString
textToCString Text
propName
    Ptr PanelService -> CString -> IO ()
ibus_panel_service_property_hide Ptr PanelService
panel' CString
propName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
panel
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanelServicePropertyHideMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsPanelService a) => O.OverloadedMethod PanelServicePropertyHideMethodInfo a signature where
    overloadedMethod = panelServicePropertyHide

instance O.OverloadedMethodInfo PanelServicePropertyHideMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService.panelServicePropertyHide",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#v:panelServicePropertyHide"
        })


#endif

-- method PanelService::property_show
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "panel"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PanelService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An IBusPanelService"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prop_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A property name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_panel_service_property_show" ibus_panel_service_property_show :: 
    Ptr PanelService ->                     -- panel : TInterface (Name {namespace = "IBus", name = "PanelService"})
    CString ->                              -- prop_name : TBasicType TUTF8
    IO ()

-- | Notify that a property is shown
-- by sending a \"ValueChanged\" message to IBus service.
panelServicePropertyShow ::
    (B.CallStack.HasCallStack, MonadIO m, IsPanelService a) =>
    a
    -- ^ /@panel@/: An IBusPanelService
    -> T.Text
    -- ^ /@propName@/: A property name
    -> m ()
panelServicePropertyShow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPanelService a) =>
a -> Text -> m ()
panelServicePropertyShow a
panel Text
propName = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PanelService
panel' <- a -> IO (Ptr PanelService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
panel
    CString
propName' <- Text -> IO CString
textToCString Text
propName
    Ptr PanelService -> CString -> IO ()
ibus_panel_service_property_show Ptr PanelService
panel' CString
propName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
panel
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanelServicePropertyShowMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsPanelService a) => O.OverloadedMethod PanelServicePropertyShowMethodInfo a signature where
    overloadedMethod = panelServicePropertyShow

instance O.OverloadedMethodInfo PanelServicePropertyShowMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService.panelServicePropertyShow",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#v:panelServicePropertyShow"
        })


#endif

-- XXX Could not generate method PanelService::show_preedit_text_received
-- Bad introspection data: Could not resolve the symbol “ibus_panel_service_show_preedit_text_received” in the “IBus” namespace, ignoring.
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data PanelServiceShowPreeditTextReceivedMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "showPreeditTextReceived" PanelService) => O.OverloadedMethod PanelServiceShowPreeditTextReceivedMethodInfo o p where
    overloadedMethod = undefined

instance (o ~ O.UnsupportedMethodError "showPreeditTextReceived" PanelService) => O.OverloadedMethodInfo PanelServiceShowPreeditTextReceivedMethodInfo o where
    overloadedMethodInfo = undefined

#endif

-- method PanelService::update_auxiliary_text_received
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "panel"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PanelService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusPanelService"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TInterface Name { namespace = "IBus" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusText" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "visible"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether the auxilirary text is visible."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_panel_service_update_auxiliary_text_received" ibus_panel_service_update_auxiliary_text_received :: 
    Ptr PanelService ->                     -- panel : TInterface (Name {namespace = "IBus", name = "PanelService"})
    Ptr IBus.Text.Text ->                   -- text : TInterface (Name {namespace = "IBus", name = "Text"})
    CInt ->                                 -- visible : TBasicType TBoolean
    IO ()

-- | Notify that the auxilirary is updated by the panel extension.
-- 
-- (Note: The table object will be released, if it is floating.
--  If caller want to keep the object, caller should make the object
--  sink by g_object_ref_sink.)
panelServiceUpdateAuxiliaryTextReceived ::
    (B.CallStack.HasCallStack, MonadIO m, IsPanelService a, IBus.Text.IsText b) =>
    a
    -- ^ /@panel@/: An t'GI.IBus.Objects.PanelService.PanelService'
    -> b
    -- ^ /@text@/: An t'GI.IBus.Objects.Text.Text'
    -> Bool
    -- ^ /@visible@/: Whether the auxilirary text is visible.
    -> m ()
panelServiceUpdateAuxiliaryTextReceived :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPanelService a, IsText b) =>
a -> b -> Bool -> m ()
panelServiceUpdateAuxiliaryTextReceived a
panel b
text Bool
visible = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PanelService
panel' <- a -> IO (Ptr PanelService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
panel
    Ptr Text
text' <- b -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
text
    let visible' :: CInt
visible' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
visible
    Ptr PanelService -> Ptr Text -> CInt -> IO ()
ibus_panel_service_update_auxiliary_text_received Ptr PanelService
panel' Ptr Text
text' CInt
visible'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
panel
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
text
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanelServiceUpdateAuxiliaryTextReceivedMethodInfo
instance (signature ~ (b -> Bool -> m ()), MonadIO m, IsPanelService a, IBus.Text.IsText b) => O.OverloadedMethod PanelServiceUpdateAuxiliaryTextReceivedMethodInfo a signature where
    overloadedMethod = panelServiceUpdateAuxiliaryTextReceived

instance O.OverloadedMethodInfo PanelServiceUpdateAuxiliaryTextReceivedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService.panelServiceUpdateAuxiliaryTextReceived",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#v:panelServiceUpdateAuxiliaryTextReceived"
        })


#endif

-- method PanelService::update_lookup_table_received
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "panel"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PanelService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusPanelService"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "table"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "LookupTable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusLookupTable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "visible"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether the lookup table is visible."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_panel_service_update_lookup_table_received" ibus_panel_service_update_lookup_table_received :: 
    Ptr PanelService ->                     -- panel : TInterface (Name {namespace = "IBus", name = "PanelService"})
    Ptr IBus.LookupTable.LookupTable ->     -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    CInt ->                                 -- visible : TBasicType TBoolean
    IO ()

-- | Notify that the lookup table is updated by the panel extension.
-- 
-- (Note: The table object will be released, if it is floating.
--  If caller want to keep the object, caller should make the object
--  sink by g_object_ref_sink.)
panelServiceUpdateLookupTableReceived ::
    (B.CallStack.HasCallStack, MonadIO m, IsPanelService a, IBus.LookupTable.IsLookupTable b) =>
    a
    -- ^ /@panel@/: An t'GI.IBus.Objects.PanelService.PanelService'
    -> b
    -- ^ /@table@/: An t'GI.IBus.Objects.LookupTable.LookupTable'
    -> Bool
    -- ^ /@visible@/: Whether the lookup table is visible.
    -> m ()
panelServiceUpdateLookupTableReceived :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPanelService a, IsLookupTable b) =>
a -> b -> Bool -> m ()
panelServiceUpdateLookupTableReceived a
panel b
table Bool
visible = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PanelService
panel' <- a -> IO (Ptr PanelService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
panel
    Ptr LookupTable
table' <- b -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
table
    let visible' :: CInt
visible' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
visible
    Ptr PanelService -> Ptr LookupTable -> CInt -> IO ()
ibus_panel_service_update_lookup_table_received Ptr PanelService
panel' Ptr LookupTable
table' CInt
visible'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
panel
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
table
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanelServiceUpdateLookupTableReceivedMethodInfo
instance (signature ~ (b -> Bool -> m ()), MonadIO m, IsPanelService a, IBus.LookupTable.IsLookupTable b) => O.OverloadedMethod PanelServiceUpdateLookupTableReceivedMethodInfo a signature where
    overloadedMethod = panelServiceUpdateLookupTableReceived

instance O.OverloadedMethodInfo PanelServiceUpdateLookupTableReceivedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService.panelServiceUpdateLookupTableReceived",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#v:panelServiceUpdateLookupTableReceived"
        })


#endif

-- method PanelService::update_preedit_text_received
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "panel"
--           , argType =
--               TInterface Name { namespace = "IBus" , name = "PanelService" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #IBusPanelService"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TInterface Name { namespace = "IBus" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Update content." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cursor_pos"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Current position of cursor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "visible"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether the pre-edit buffer is visible."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_panel_service_update_preedit_text_received" ibus_panel_service_update_preedit_text_received :: 
    Ptr PanelService ->                     -- panel : TInterface (Name {namespace = "IBus", name = "PanelService"})
    Ptr IBus.Text.Text ->                   -- text : TInterface (Name {namespace = "IBus", name = "Text"})
    Word32 ->                               -- cursor_pos : TBasicType TUInt
    CInt ->                                 -- visible : TBasicType TBoolean
    IO ()

-- | Notify that the preedit is updated by the panel extension
-- 
-- (Note: The table object will be released, if it is floating.
--  If caller want to keep the object, caller should make the object
--  sink by g_object_ref_sink.)
panelServiceUpdatePreeditTextReceived ::
    (B.CallStack.HasCallStack, MonadIO m, IsPanelService a, IBus.Text.IsText b) =>
    a
    -- ^ /@panel@/: An t'GI.IBus.Objects.PanelService.PanelService'
    -> b
    -- ^ /@text@/: Update content.
    -> Word32
    -- ^ /@cursorPos@/: Current position of cursor
    -> Bool
    -- ^ /@visible@/: Whether the pre-edit buffer is visible.
    -> m ()
panelServiceUpdatePreeditTextReceived :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPanelService a, IsText b) =>
a -> b -> Word32 -> Bool -> m ()
panelServiceUpdatePreeditTextReceived a
panel b
text Word32
cursorPos Bool
visible = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr PanelService
panel' <- a -> IO (Ptr PanelService)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
panel
    Ptr Text
text' <- b -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
text
    let visible' :: CInt
visible' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
visible
    Ptr PanelService -> Ptr Text -> Word32 -> CInt -> IO ()
ibus_panel_service_update_preedit_text_received Ptr PanelService
panel' Ptr Text
text' Word32
cursorPos CInt
visible'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
panel
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
text
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanelServiceUpdatePreeditTextReceivedMethodInfo
instance (signature ~ (b -> Word32 -> Bool -> m ()), MonadIO m, IsPanelService a, IBus.Text.IsText b) => O.OverloadedMethod PanelServiceUpdatePreeditTextReceivedMethodInfo a signature where
    overloadedMethod = panelServiceUpdatePreeditTextReceived

instance O.OverloadedMethodInfo PanelServiceUpdatePreeditTextReceivedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.IBus.Objects.PanelService.panelServiceUpdatePreeditTextReceived",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ibus-1.5.5/docs/GI-IBus-Objects-PanelService.html#v:panelServiceUpdatePreeditTextReceived"
        })


#endif