{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An IBusLookuptable stores the candidate words or phrases for users to
-- choose from.
-- 
-- Use 'GI.IBus.Objects.Engine.engineUpdateLookupTable', 'GI.IBus.Objects.Engine.engineShowLookupTable',
-- and 'GI.IBus.Objects.Engine.engineHideLookupTable' to update, show and hide the lookup
-- table.
-- 
-- see_also: t'GI.IBus.Objects.Engine.Engine'

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

module GI.IBus.Objects.LookupTable
    ( 

-- * Exported types
    LookupTable(..)                         ,
    IsLookupTable                           ,
    toLookupTable                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [appendCandidate]("GI.IBus.Objects.LookupTable#g:method:appendCandidate"), [appendLabel]("GI.IBus.Objects.LookupTable#g:method:appendLabel"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [clear]("GI.IBus.Objects.LookupTable#g:method:clear"), [copy]("GI.IBus.Objects.Serializable#g:method:copy"), [cursorDown]("GI.IBus.Objects.LookupTable#g:method:cursorDown"), [cursorUp]("GI.IBus.Objects.LookupTable#g:method:cursorUp"), [destroy]("GI.IBus.Objects.Object#g:method:destroy"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isCursorVisible]("GI.IBus.Objects.LookupTable#g:method:isCursorVisible"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isRound]("GI.IBus.Objects.LookupTable#g:method:isRound"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [pageDown]("GI.IBus.Objects.LookupTable#g:method:pageDown"), [pageUp]("GI.IBus.Objects.LookupTable#g:method:pageUp"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeQattachment]("GI.IBus.Objects.Serializable#g:method:removeQattachment"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [serializeObject]("GI.IBus.Objects.Serializable#g:method:serializeObject"), [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"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCandidate]("GI.IBus.Objects.LookupTable#g:method:getCandidate"), [getCursorInPage]("GI.IBus.Objects.LookupTable#g:method:getCursorInPage"), [getCursorPos]("GI.IBus.Objects.LookupTable#g:method:getCursorPos"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getLabel]("GI.IBus.Objects.LookupTable#g:method:getLabel"), [getNumberOfCandidates]("GI.IBus.Objects.LookupTable#g:method:getNumberOfCandidates"), [getOrientation]("GI.IBus.Objects.LookupTable#g:method:getOrientation"), [getPageSize]("GI.IBus.Objects.LookupTable#g:method:getPageSize"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQattachment]("GI.IBus.Objects.Serializable#g:method:getQattachment"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setCursorPos]("GI.IBus.Objects.LookupTable#g:method:setCursorPos"), [setCursorVisible]("GI.IBus.Objects.LookupTable#g:method:setCursorVisible"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setLabel]("GI.IBus.Objects.LookupTable#g:method:setLabel"), [setOrientation]("GI.IBus.Objects.LookupTable#g:method:setOrientation"), [setPageSize]("GI.IBus.Objects.LookupTable#g:method:setPageSize"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setQattachment]("GI.IBus.Objects.Serializable#g:method:setQattachment"), [setRound]("GI.IBus.Objects.LookupTable#g:method:setRound").

#if defined(ENABLE_OVERLOADING)
    ResolveLookupTableMethod                ,
#endif

-- ** appendCandidate #method:appendCandidate#

#if defined(ENABLE_OVERLOADING)
    LookupTableAppendCandidateMethodInfo    ,
#endif
    lookupTableAppendCandidate              ,


-- ** appendLabel #method:appendLabel#

#if defined(ENABLE_OVERLOADING)
    LookupTableAppendLabelMethodInfo        ,
#endif
    lookupTableAppendLabel                  ,


-- ** clear #method:clear#

#if defined(ENABLE_OVERLOADING)
    LookupTableClearMethodInfo              ,
#endif
    lookupTableClear                        ,


-- ** cursorDown #method:cursorDown#

#if defined(ENABLE_OVERLOADING)
    LookupTableCursorDownMethodInfo         ,
#endif
    lookupTableCursorDown                   ,


-- ** cursorUp #method:cursorUp#

#if defined(ENABLE_OVERLOADING)
    LookupTableCursorUpMethodInfo           ,
#endif
    lookupTableCursorUp                     ,


-- ** getCandidate #method:getCandidate#

#if defined(ENABLE_OVERLOADING)
    LookupTableGetCandidateMethodInfo       ,
#endif
    lookupTableGetCandidate                 ,


-- ** getCursorInPage #method:getCursorInPage#

#if defined(ENABLE_OVERLOADING)
    LookupTableGetCursorInPageMethodInfo    ,
#endif
    lookupTableGetCursorInPage              ,


-- ** getCursorPos #method:getCursorPos#

#if defined(ENABLE_OVERLOADING)
    LookupTableGetCursorPosMethodInfo       ,
#endif
    lookupTableGetCursorPos                 ,


-- ** getLabel #method:getLabel#

#if defined(ENABLE_OVERLOADING)
    LookupTableGetLabelMethodInfo           ,
#endif
    lookupTableGetLabel                     ,


-- ** getNumberOfCandidates #method:getNumberOfCandidates#

#if defined(ENABLE_OVERLOADING)
    LookupTableGetNumberOfCandidatesMethodInfo,
#endif
    lookupTableGetNumberOfCandidates        ,


-- ** getOrientation #method:getOrientation#

#if defined(ENABLE_OVERLOADING)
    LookupTableGetOrientationMethodInfo     ,
#endif
    lookupTableGetOrientation               ,


-- ** getPageSize #method:getPageSize#

#if defined(ENABLE_OVERLOADING)
    LookupTableGetPageSizeMethodInfo        ,
#endif
    lookupTableGetPageSize                  ,


-- ** isCursorVisible #method:isCursorVisible#

#if defined(ENABLE_OVERLOADING)
    LookupTableIsCursorVisibleMethodInfo    ,
#endif
    lookupTableIsCursorVisible              ,


-- ** isRound #method:isRound#

#if defined(ENABLE_OVERLOADING)
    LookupTableIsRoundMethodInfo            ,
#endif
    lookupTableIsRound                      ,


-- ** new #method:new#

    lookupTableNew                          ,


-- ** pageDown #method:pageDown#

#if defined(ENABLE_OVERLOADING)
    LookupTablePageDownMethodInfo           ,
#endif
    lookupTablePageDown                     ,


-- ** pageUp #method:pageUp#

#if defined(ENABLE_OVERLOADING)
    LookupTablePageUpMethodInfo             ,
#endif
    lookupTablePageUp                       ,


-- ** setCursorPos #method:setCursorPos#

#if defined(ENABLE_OVERLOADING)
    LookupTableSetCursorPosMethodInfo       ,
#endif
    lookupTableSetCursorPos                 ,


-- ** setCursorVisible #method:setCursorVisible#

#if defined(ENABLE_OVERLOADING)
    LookupTableSetCursorVisibleMethodInfo   ,
#endif
    lookupTableSetCursorVisible             ,


-- ** setLabel #method:setLabel#

#if defined(ENABLE_OVERLOADING)
    LookupTableSetLabelMethodInfo           ,
#endif
    lookupTableSetLabel                     ,


-- ** setOrientation #method:setOrientation#

#if defined(ENABLE_OVERLOADING)
    LookupTableSetOrientationMethodInfo     ,
#endif
    lookupTableSetOrientation               ,


-- ** setPageSize #method:setPageSize#

#if defined(ENABLE_OVERLOADING)
    LookupTableSetPageSizeMethodInfo        ,
#endif
    lookupTableSetPageSize                  ,


-- ** setRound #method:setRound#

#if defined(ENABLE_OVERLOADING)
    LookupTableSetRoundMethodInfo           ,
#endif
    lookupTableSetRound                     ,




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

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

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

foreign import ccall "ibus_lookup_table_get_type"
    c_ibus_lookup_table_get_type :: IO B.Types.GType

instance B.Types.TypedObject LookupTable where
    glibType :: IO GType
glibType = IO GType
c_ibus_lookup_table_get_type

instance B.Types.GObject LookupTable

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

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

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

-- | Convert 'LookupTable' 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 LookupTable) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ibus_lookup_table_get_type
    gvalueSet_ :: Ptr GValue -> Maybe LookupTable -> IO ()
gvalueSet_ Ptr GValue
gv Maybe LookupTable
P.Nothing = Ptr GValue -> Ptr LookupTable -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr LookupTable
forall a. Ptr a
FP.nullPtr :: FP.Ptr LookupTable)
    gvalueSet_ Ptr GValue
gv (P.Just LookupTable
obj) = LookupTable -> (Ptr LookupTable -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr LookupTable
obj (Ptr GValue -> Ptr LookupTable -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe LookupTable)
gvalueGet_ Ptr GValue
gv = do
        Ptr LookupTable
ptr <- Ptr GValue -> IO (Ptr LookupTable)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr LookupTable)
        if Ptr LookupTable
ptr Ptr LookupTable -> Ptr LookupTable -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr LookupTable
forall a. Ptr a
FP.nullPtr
        then LookupTable -> Maybe LookupTable
forall a. a -> Maybe a
P.Just (LookupTable -> Maybe LookupTable)
-> IO LookupTable -> IO (Maybe LookupTable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr LookupTable -> LookupTable)
-> Ptr LookupTable -> IO LookupTable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr LookupTable -> LookupTable
LookupTable Ptr LookupTable
ptr
        else Maybe LookupTable -> IO (Maybe LookupTable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LookupTable
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveLookupTableMethod (t :: Symbol) (o :: *) :: * where
    ResolveLookupTableMethod "appendCandidate" o = LookupTableAppendCandidateMethodInfo
    ResolveLookupTableMethod "appendLabel" o = LookupTableAppendLabelMethodInfo
    ResolveLookupTableMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveLookupTableMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveLookupTableMethod "clear" o = LookupTableClearMethodInfo
    ResolveLookupTableMethod "copy" o = IBus.Serializable.SerializableCopyMethodInfo
    ResolveLookupTableMethod "cursorDown" o = LookupTableCursorDownMethodInfo
    ResolveLookupTableMethod "cursorUp" o = LookupTableCursorUpMethodInfo
    ResolveLookupTableMethod "destroy" o = IBus.Object.ObjectDestroyMethodInfo
    ResolveLookupTableMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveLookupTableMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveLookupTableMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveLookupTableMethod "isCursorVisible" o = LookupTableIsCursorVisibleMethodInfo
    ResolveLookupTableMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveLookupTableMethod "isRound" o = LookupTableIsRoundMethodInfo
    ResolveLookupTableMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveLookupTableMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveLookupTableMethod "pageDown" o = LookupTablePageDownMethodInfo
    ResolveLookupTableMethod "pageUp" o = LookupTablePageUpMethodInfo
    ResolveLookupTableMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveLookupTableMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveLookupTableMethod "removeQattachment" o = IBus.Serializable.SerializableRemoveQattachmentMethodInfo
    ResolveLookupTableMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveLookupTableMethod "serializeObject" o = IBus.Serializable.SerializableSerializeObjectMethodInfo
    ResolveLookupTableMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveLookupTableMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveLookupTableMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveLookupTableMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveLookupTableMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveLookupTableMethod "getCandidate" o = LookupTableGetCandidateMethodInfo
    ResolveLookupTableMethod "getCursorInPage" o = LookupTableGetCursorInPageMethodInfo
    ResolveLookupTableMethod "getCursorPos" o = LookupTableGetCursorPosMethodInfo
    ResolveLookupTableMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveLookupTableMethod "getLabel" o = LookupTableGetLabelMethodInfo
    ResolveLookupTableMethod "getNumberOfCandidates" o = LookupTableGetNumberOfCandidatesMethodInfo
    ResolveLookupTableMethod "getOrientation" o = LookupTableGetOrientationMethodInfo
    ResolveLookupTableMethod "getPageSize" o = LookupTableGetPageSizeMethodInfo
    ResolveLookupTableMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveLookupTableMethod "getQattachment" o = IBus.Serializable.SerializableGetQattachmentMethodInfo
    ResolveLookupTableMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveLookupTableMethod "setCursorPos" o = LookupTableSetCursorPosMethodInfo
    ResolveLookupTableMethod "setCursorVisible" o = LookupTableSetCursorVisibleMethodInfo
    ResolveLookupTableMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveLookupTableMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveLookupTableMethod "setLabel" o = LookupTableSetLabelMethodInfo
    ResolveLookupTableMethod "setOrientation" o = LookupTableSetOrientationMethodInfo
    ResolveLookupTableMethod "setPageSize" o = LookupTableSetPageSizeMethodInfo
    ResolveLookupTableMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveLookupTableMethod "setQattachment" o = IBus.Serializable.SerializableSetQattachmentMethodInfo
    ResolveLookupTableMethod "setRound" o = LookupTableSetRoundMethodInfo
    ResolveLookupTableMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveLookupTableMethod t LookupTable, O.OverloadedMethod info LookupTable p) => OL.IsLabel t (LookupTable -> 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 ~ ResolveLookupTableMethod t LookupTable, O.OverloadedMethod info LookupTable p, R.HasField t LookupTable p) => R.HasField t LookupTable p where
    getField = O.overloadedMethod @info

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method LookupTable::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "page_size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "number of candidate shown per page, the max value is 16."
--                 , 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 "position index of cursor."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cursor_visible"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether the cursor is visible."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "round"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "TRUE for lookup table wrap around."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "IBus" , name = "LookupTable" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_new" ibus_lookup_table_new :: 
    Word32 ->                               -- page_size : TBasicType TUInt
    Word32 ->                               -- cursor_pos : TBasicType TUInt
    CInt ->                                 -- cursor_visible : TBasicType TBoolean
    CInt ->                                 -- round : TBasicType TBoolean
    IO (Ptr LookupTable)

-- | Craetes a new t'GI.IBus.Objects.LookupTable.LookupTable'.
lookupTableNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@pageSize@/: number of candidate shown per page, the max value is 16.
    -> Word32
    -- ^ /@cursorPos@/: position index of cursor.
    -> Bool
    -- ^ /@cursorVisible@/: whether the cursor is visible.
    -> Bool
    -- ^ /@round@/: TRUE for lookup table wrap around.
    -> m LookupTable
    -- ^ __Returns:__ A newly allocated t'GI.IBus.Objects.LookupTable.LookupTable'.
lookupTableNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> Word32 -> Bool -> Bool -> m LookupTable
lookupTableNew Word32
pageSize Word32
cursorPos Bool
cursorVisible Bool
round = IO LookupTable -> m LookupTable
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LookupTable -> m LookupTable)
-> IO LookupTable -> m LookupTable
forall a b. (a -> b) -> a -> b
$ do
    let cursorVisible' :: CInt
cursorVisible' = (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
cursorVisible
    let round' :: CInt
round' = (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
round
    Ptr LookupTable
result <- Word32 -> Word32 -> CInt -> CInt -> IO (Ptr LookupTable)
ibus_lookup_table_new Word32
pageSize Word32
cursorPos CInt
cursorVisible' CInt
round'
    Text -> Ptr LookupTable -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"lookupTableNew" Ptr LookupTable
result
    LookupTable
result' <- ((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
LookupTable) Ptr LookupTable
result
    LookupTable -> IO LookupTable
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LookupTable
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method LookupTable::append_candidate
-- method type : OrdinaryMethod
-- Args: [ 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 = "text"
--           , argType = TInterface Name { namespace = "IBus" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "candidate word/phrase to be appended (in IBusText format)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_append_candidate" ibus_lookup_table_append_candidate :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    Ptr IBus.Text.Text ->                   -- text : TInterface (Name {namespace = "IBus", name = "Text"})
    IO ()

-- | Append a candidate word\/phrase to IBusLookupTable, and increase reference.
lookupTableAppendCandidate ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a, IBus.Text.IsText b) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> b
    -- ^ /@text@/: candidate word\/phrase to be appended (in IBusText format).
    -> m ()
lookupTableAppendCandidate :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLookupTable a, IsText b) =>
a -> b -> m ()
lookupTableAppendCandidate a
table 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 LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr Text
text' <- b -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
text
    Ptr LookupTable -> Ptr Text -> IO ()
ibus_lookup_table_append_candidate Ptr LookupTable
table' Ptr Text
text'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    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 LookupTableAppendCandidateMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsLookupTable a, IBus.Text.IsText b) => O.OverloadedMethod LookupTableAppendCandidateMethodInfo a signature where
    overloadedMethod = lookupTableAppendCandidate

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


#endif

-- method LookupTable::append_label
-- method type : OrdinaryMethod
-- Args: [ 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 = "text"
--           , argType = TInterface Name { namespace = "IBus" , name = "Text" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A candidate label to be appended (in IBusText format)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_append_label" ibus_lookup_table_append_label :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    Ptr IBus.Text.Text ->                   -- text : TInterface (Name {namespace = "IBus", name = "Text"})
    IO ()

-- | Append a candidate word\/phrase to IBusLookupTable, and increase reference.
-- This function is needed if the input method select candidate with
-- non-numeric keys such as \"asdfghjkl;\".
lookupTableAppendLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a, IBus.Text.IsText b) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> b
    -- ^ /@text@/: A candidate label to be appended (in IBusText format).
    -> m ()
lookupTableAppendLabel :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLookupTable a, IsText b) =>
a -> b -> m ()
lookupTableAppendLabel a
table 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 LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr Text
text' <- b -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
text
    Ptr LookupTable -> Ptr Text -> IO ()
ibus_lookup_table_append_label Ptr LookupTable
table' Ptr Text
text'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    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 LookupTableAppendLabelMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsLookupTable a, IBus.Text.IsText b) => O.OverloadedMethod LookupTableAppendLabelMethodInfo a signature where
    overloadedMethod = lookupTableAppendLabel

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


#endif

-- method LookupTable::clear
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_clear" ibus_lookup_table_clear :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    IO ()

-- | Clear and remove all candidate from an IBusLookupTable.
lookupTableClear ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> m ()
lookupTableClear :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> m ()
lookupTableClear a
table = 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 LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr LookupTable -> IO ()
ibus_lookup_table_clear Ptr LookupTable
table'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LookupTableClearMethodInfo
instance (signature ~ (m ()), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableClearMethodInfo a signature where
    overloadedMethod = lookupTableClear

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


#endif

-- method LookupTable::cursor_down
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_cursor_down" ibus_lookup_table_cursor_down :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    IO CInt

-- | Go to next candidate of an t'GI.IBus.Objects.LookupTable.LookupTable'.
-- 
-- It returns FALSE if it is already at the last candidate,
-- unless  \<code>table&gt;-round==TRUE\<\/code>, where it will go
-- to the first candidate.
lookupTableCursorDown ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if succeed.
lookupTableCursorDown :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> m Bool
lookupTableCursorDown a
table = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CInt
result <- Ptr LookupTable -> IO CInt
ibus_lookup_table_cursor_down Ptr LookupTable
table'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LookupTableCursorDownMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableCursorDownMethodInfo a signature where
    overloadedMethod = lookupTableCursorDown

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


#endif

-- method LookupTable::cursor_up
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_cursor_up" ibus_lookup_table_cursor_up :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    IO CInt

-- | Go to previous candidate of an t'GI.IBus.Objects.LookupTable.LookupTable'.
-- 
-- It returns FALSE if it is already at the first candidate,
-- unless  \<code>table&gt;-round==TRUE\<\/code>, where it will go
-- to the last candidate.
lookupTableCursorUp ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if succeed.
lookupTableCursorUp :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> m Bool
lookupTableCursorUp a
table = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CInt
result <- Ptr LookupTable -> IO CInt
ibus_lookup_table_cursor_up Ptr LookupTable
table'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LookupTableCursorUpMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableCursorUpMethodInfo a signature where
    overloadedMethod = lookupTableCursorUp

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


#endif

-- method LookupTable::get_candidate
-- method type : OrdinaryMethod
-- Args: [ 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 = "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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "IBus" , name = "Text" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_get_candidate" ibus_lookup_table_get_candidate :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    Word32 ->                               -- index : TBasicType TUInt
    IO (Ptr IBus.Text.Text)

-- | Return t'GI.IBus.Objects.Text.Text' at the given index. Borrowed reference.
lookupTableGetCandidate ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> Word32
    -- ^ /@index@/: Index in the Lookup table.
    -> m IBus.Text.Text
    -- ^ __Returns:__ IBusText at the given index; NULL if no such
    --         t'GI.IBus.Objects.Text.Text'.
lookupTableGetCandidate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> Word32 -> m Text
lookupTableGetCandidate a
table Word32
index = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr Text
result <- Ptr LookupTable -> Word32 -> IO (Ptr Text)
ibus_lookup_table_get_candidate Ptr LookupTable
table' Word32
index
    Text -> Ptr Text -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"lookupTableGetCandidate" Ptr Text
result
    Text
result' <- ((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
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data LookupTableGetCandidateMethodInfo
instance (signature ~ (Word32 -> m IBus.Text.Text), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableGetCandidateMethodInfo a signature where
    overloadedMethod = lookupTableGetCandidate

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


#endif

-- method LookupTable::get_cursor_in_page
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_get_cursor_in_page" ibus_lookup_table_get_cursor_in_page :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    IO Word32

-- | Gets the cursor position in current page of t'GI.IBus.Objects.LookupTable.LookupTable'.
lookupTableGetCursorInPage ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> m Word32
    -- ^ __Returns:__ The position of cursor in current page.
lookupTableGetCursorInPage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> m Word32
lookupTableGetCursorInPage a
table = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Word32
result <- Ptr LookupTable -> IO Word32
ibus_lookup_table_get_cursor_in_page Ptr LookupTable
table'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data LookupTableGetCursorInPageMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableGetCursorInPageMethodInfo a signature where
    overloadedMethod = lookupTableGetCursorInPage

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


#endif

-- method LookupTable::get_cursor_pos
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_get_cursor_pos" ibus_lookup_table_get_cursor_pos :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    IO Word32

-- | Gets the cursor position of t'GI.IBus.Objects.LookupTable.LookupTable'.
lookupTableGetCursorPos ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> m Word32
    -- ^ __Returns:__ The position of cursor.
lookupTableGetCursorPos :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> m Word32
lookupTableGetCursorPos a
table = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Word32
result <- Ptr LookupTable -> IO Word32
ibus_lookup_table_get_cursor_pos Ptr LookupTable
table'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data LookupTableGetCursorPosMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableGetCursorPosMethodInfo a signature where
    overloadedMethod = lookupTableGetCursorPos

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


#endif

-- method LookupTable::get_label
-- method type : OrdinaryMethod
-- Args: [ 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 = "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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "IBus" , name = "Text" })
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_get_label" ibus_lookup_table_get_label :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    Word32 ->                               -- index : TBasicType TUInt
    IO (Ptr IBus.Text.Text)

-- | Return t'GI.IBus.Objects.Text.Text' at the given index. Borrowed reference.
lookupTableGetLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> Word32
    -- ^ /@index@/: Index in the Lookup table.
    -> m IBus.Text.Text
    -- ^ __Returns:__ t'GI.IBus.Objects.Text.Text' at the given index; 'P.Nothing' if no such
    --         t'GI.IBus.Objects.Text.Text'.
lookupTableGetLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> Word32 -> m Text
lookupTableGetLabel a
table Word32
index = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr Text
result <- Ptr LookupTable -> Word32 -> IO (Ptr Text)
ibus_lookup_table_get_label Ptr LookupTable
table' Word32
index
    Text -> Ptr Text -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"lookupTableGetLabel" Ptr Text
result
    Text
result' <- ((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
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data LookupTableGetLabelMethodInfo
instance (signature ~ (Word32 -> m IBus.Text.Text), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableGetLabelMethodInfo a signature where
    overloadedMethod = lookupTableGetLabel

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


#endif

-- method LookupTable::get_number_of_candidates
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_get_number_of_candidates" ibus_lookup_table_get_number_of_candidates :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    IO Word32

-- | Return the number of candidate in the table.
lookupTableGetNumberOfCandidates ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> m Word32
    -- ^ __Returns:__ The number of candidates in the table
lookupTableGetNumberOfCandidates :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> m Word32
lookupTableGetNumberOfCandidates a
table = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Word32
result <- Ptr LookupTable -> IO Word32
ibus_lookup_table_get_number_of_candidates Ptr LookupTable
table'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data LookupTableGetNumberOfCandidatesMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableGetNumberOfCandidatesMethodInfo a signature where
    overloadedMethod = lookupTableGetNumberOfCandidates

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


#endif

-- method LookupTable::get_orientation
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_get_orientation" ibus_lookup_table_get_orientation :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    IO Int32

-- | Returns the orientation of the t'GI.IBus.Objects.LookupTable.LookupTable'.
lookupTableGetOrientation ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> m Int32
    -- ^ __Returns:__ The orientation of the /@table@/.
lookupTableGetOrientation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> m Int32
lookupTableGetOrientation a
table = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Int32
result <- Ptr LookupTable -> IO Int32
ibus_lookup_table_get_orientation Ptr LookupTable
table'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data LookupTableGetOrientationMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableGetOrientationMethodInfo a signature where
    overloadedMethod = lookupTableGetOrientation

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


#endif

-- method LookupTable::get_page_size
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_get_page_size" ibus_lookup_table_get_page_size :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    IO Word32

-- | Gets the number of candidate shown per page.
lookupTableGetPageSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> m Word32
    -- ^ __Returns:__ Page size, i.e., number of candidate shown per page.
    -- dd
lookupTableGetPageSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> m Word32
lookupTableGetPageSize a
table = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Word32
result <- Ptr LookupTable -> IO Word32
ibus_lookup_table_get_page_size Ptr LookupTable
table'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data LookupTableGetPageSizeMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableGetPageSizeMethodInfo a signature where
    overloadedMethod = lookupTableGetPageSize

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


#endif

-- method LookupTable::is_cursor_visible
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_is_cursor_visible" ibus_lookup_table_is_cursor_visible :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    IO CInt

-- | Returns whether the cursor of an t'GI.IBus.Objects.LookupTable.LookupTable' is visible.
lookupTableIsCursorVisible ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An t'GI.IBus.Objects.LookupTable.LookupTable'.
    -> m Bool
    -- ^ __Returns:__ Whether the cursor of /@table@/ is visible.
lookupTableIsCursorVisible :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> m Bool
lookupTableIsCursorVisible a
table = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CInt
result <- Ptr LookupTable -> IO CInt
ibus_lookup_table_is_cursor_visible Ptr LookupTable
table'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LookupTableIsCursorVisibleMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableIsCursorVisibleMethodInfo a signature where
    overloadedMethod = lookupTableIsCursorVisible

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


#endif

-- method LookupTable::is_round
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_is_round" ibus_lookup_table_is_round :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    IO CInt

-- | Returns whether the t'GI.IBus.Objects.LookupTable.LookupTable' is round.
lookupTableIsRound ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> m Bool
    -- ^ __Returns:__ Whether the /@table@/ is round.
lookupTableIsRound :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> m Bool
lookupTableIsRound a
table = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CInt
result <- Ptr LookupTable -> IO CInt
ibus_lookup_table_is_round Ptr LookupTable
table'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LookupTableIsRoundMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableIsRoundMethodInfo a signature where
    overloadedMethod = lookupTableIsRound

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


#endif

-- method LookupTable::page_down
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_page_down" ibus_lookup_table_page_down :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    IO CInt

-- | Go to next page of an t'GI.IBus.Objects.LookupTable.LookupTable'.
-- 
-- It returns FALSE if it is already at the last page,
-- unless  \<code>table&gt;-round==TRUE\<\/code>, where it will go
-- to the first page.
lookupTablePageDown ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if succeed.
lookupTablePageDown :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> m Bool
lookupTablePageDown a
table = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CInt
result <- Ptr LookupTable -> IO CInt
ibus_lookup_table_page_down Ptr LookupTable
table'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LookupTablePageDownMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTablePageDownMethodInfo a signature where
    overloadedMethod = lookupTablePageDown

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


#endif

-- method LookupTable::page_up
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_page_up" ibus_lookup_table_page_up :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    IO CInt

-- | Go to previous page of an t'GI.IBus.Objects.LookupTable.LookupTable'.
-- 
-- It returns FALSE if it is already at the first page,
-- unless  \<code>table&gt;-round==TRUE\<\/code>, where it will go
-- to the last page.
lookupTablePageUp ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if succeed.
lookupTablePageUp :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> m Bool
lookupTablePageUp a
table = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CInt
result <- Ptr LookupTable -> IO CInt
ibus_lookup_table_page_up Ptr LookupTable
table'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data LookupTablePageUpMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTablePageUpMethodInfo a signature where
    overloadedMethod = lookupTablePageUp

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


#endif

-- method LookupTable::set_cursor_pos
-- method type : OrdinaryMethod
-- Args: [ 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 = "cursor_pos"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The position of cursor."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_set_cursor_pos" ibus_lookup_table_set_cursor_pos :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    Word32 ->                               -- cursor_pos : TBasicType TUInt
    IO ()

-- | Set the cursor position of IBusLookupTable.
lookupTableSetCursorPos ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> Word32
    -- ^ /@cursorPos@/: The position of cursor.
    -> m ()
lookupTableSetCursorPos :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> Word32 -> m ()
lookupTableSetCursorPos a
table Word32
cursorPos = 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 LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr LookupTable -> Word32 -> IO ()
ibus_lookup_table_set_cursor_pos Ptr LookupTable
table' Word32
cursorPos
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LookupTableSetCursorPosMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableSetCursorPosMethodInfo a signature where
    overloadedMethod = lookupTableSetCursorPos

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


#endif

-- method LookupTable::set_cursor_visible
-- method type : OrdinaryMethod
-- Args: [ 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 to make the cursor of @table 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_lookup_table_set_cursor_visible" ibus_lookup_table_set_cursor_visible :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    CInt ->                                 -- visible : TBasicType TBoolean
    IO ()

-- | Set whether to make the cursor of an IBusLookupTable visible or not.
lookupTableSetCursorVisible ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> Bool
    -- ^ /@visible@/: Whether to make the cursor of /@table@/ visible.
    -> m ()
lookupTableSetCursorVisible :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> Bool -> m ()
lookupTableSetCursorVisible a
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 LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
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 LookupTable -> CInt -> IO ()
ibus_lookup_table_set_cursor_visible Ptr LookupTable
table' CInt
visible'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LookupTableSetCursorVisibleMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableSetCursorVisibleMethodInfo a signature where
    overloadedMethod = lookupTableSetCursorVisible

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


#endif

-- method LookupTable::set_label
-- method type : OrdinaryMethod
-- Args: [ 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 = "index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Intex in the Lookup table."
--                 , 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 "A candidate label to be appended (in IBusText format)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_set_label" ibus_lookup_table_set_label :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    Word32 ->                               -- index : TBasicType TUInt
    Ptr IBus.Text.Text ->                   -- text : TInterface (Name {namespace = "IBus", name = "Text"})
    IO ()

-- | Append a candidate word\/phrase to IBusLookupTable, and increase reference.
-- This function is needed if the input method select candidate with
-- non-numeric keys such as \"asdfghjkl;\".
lookupTableSetLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a, IBus.Text.IsText b) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> Word32
    -- ^ /@index@/: Intex in the Lookup table.
    -> b
    -- ^ /@text@/: A candidate label to be appended (in IBusText format).
    -> m ()
lookupTableSetLabel :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLookupTable a, IsText b) =>
a -> Word32 -> b -> m ()
lookupTableSetLabel a
table Word32
index 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 LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr Text
text' <- b -> IO (Ptr Text)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
text
    Ptr LookupTable -> Word32 -> Ptr Text -> IO ()
ibus_lookup_table_set_label Ptr LookupTable
table' Word32
index Ptr Text
text'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    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 LookupTableSetLabelMethodInfo
instance (signature ~ (Word32 -> b -> m ()), MonadIO m, IsLookupTable a, IBus.Text.IsText b) => O.OverloadedMethod LookupTableSetLabelMethodInfo a signature where
    overloadedMethod = lookupTableSetLabel

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


#endif

-- method LookupTable::set_orientation
-- method type : OrdinaryMethod
-- Args: [ 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 = "orientation"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_set_orientation" ibus_lookup_table_set_orientation :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    Int32 ->                                -- orientation : TBasicType TInt
    IO ()

-- | Set the orientation.
lookupTableSetOrientation ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> Int32
    -- ^ /@orientation@/: .
    -> m ()
lookupTableSetOrientation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> Int32 -> m ()
lookupTableSetOrientation a
table Int32
orientation = 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 LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr LookupTable -> Int32 -> IO ()
ibus_lookup_table_set_orientation Ptr LookupTable
table' Int32
orientation
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LookupTableSetOrientationMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableSetOrientationMethodInfo a signature where
    overloadedMethod = lookupTableSetOrientation

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


#endif

-- method LookupTable::set_page_size
-- method type : OrdinaryMethod
-- Args: [ 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 = "page_size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of candidate shown per page."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_set_page_size" ibus_lookup_table_set_page_size :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    Word32 ->                               -- page_size : TBasicType TUInt
    IO ()

-- | Set the number of candidate shown per page.
lookupTableSetPageSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> Word32
    -- ^ /@pageSize@/: number of candidate shown per page.
    -> m ()
lookupTableSetPageSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> Word32 -> m ()
lookupTableSetPageSize a
table Word32
pageSize = 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 LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr LookupTable -> Word32 -> IO ()
ibus_lookup_table_set_page_size Ptr LookupTable
table' Word32
pageSize
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LookupTableSetPageSizeMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableSetPageSizeMethodInfo a signature where
    overloadedMethod = lookupTableSetPageSize

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


#endif

-- method LookupTable::set_round
-- method type : OrdinaryMethod
-- Args: [ 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 = "round"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether to make @table round."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ibus_lookup_table_set_round" ibus_lookup_table_set_round :: 
    Ptr LookupTable ->                      -- table : TInterface (Name {namespace = "IBus", name = "LookupTable"})
    CInt ->                                 -- round : TBasicType TBoolean
    IO ()

-- | Set whether to make the IBusLookupTable round or not.
lookupTableSetRound ::
    (B.CallStack.HasCallStack, MonadIO m, IsLookupTable a) =>
    a
    -- ^ /@table@/: An IBusLookupTable.
    -> Bool
    -- ^ /@round@/: Whether to make /@table@/ round.
    -> m ()
lookupTableSetRound :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLookupTable a) =>
a -> Bool -> m ()
lookupTableSetRound a
table Bool
round = 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 LookupTable
table' <- a -> IO (Ptr LookupTable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    let round' :: CInt
round' = (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
round
    Ptr LookupTable -> CInt -> IO ()
ibus_lookup_table_set_round Ptr LookupTable
table' CInt
round'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data LookupTableSetRoundMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsLookupTable a) => O.OverloadedMethod LookupTableSetRoundMethodInfo a signature where
    overloadedMethod = lookupTableSetRound

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


#endif