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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Atk.Interfaces.Table.Table' should be implemented by components which present
-- elements ordered via rows and columns.  It may also be used to
-- present tree-structured information if the nodes of the trees can
-- be said to contain multiple \"columns\".  Individual elements of an
-- t'GI.Atk.Interfaces.Table.Table' are typically referred to as \"cells\". Those cells should
-- implement the interface t'GI.Atk.Interfaces.TableCell.TableCell', but @/Atk/@ doesn\'t require
-- them to be direct children of the current t'GI.Atk.Interfaces.Table.Table'. They can be
-- grand-children, grand-grand-children etc. t'GI.Atk.Interfaces.Table.Table' provides the
-- API needed to get a individual cell based on the row and column
-- numbers.
-- 
-- Children of t'GI.Atk.Interfaces.Table.Table' are frequently \"lightweight\" objects, that
-- is, they may not have backing widgets in the host UI toolkit.  They
-- are therefore often transient.
-- 
-- Since tables are often very complex, t'GI.Atk.Interfaces.Table.Table' includes provision
-- for offering simplified summary information, as well as row and
-- column headers and captions.  Headers and captions are @/AtkObjects/@
-- which may implement other interfaces (t'GI.Atk.Interfaces.Text.Text', t'GI.Atk.Interfaces.Image.Image', etc.) as
-- appropriate.  t'GI.Atk.Interfaces.Table.Table' summaries may themselves be (simplified)
-- @/AtkTables/@, etc.
-- 
-- Note for implementors: in the past, t'GI.Atk.Interfaces.Table.Table' required that all the
-- cells should be direct children of t'GI.Atk.Interfaces.Table.Table', and provided some
-- index based methods to request the cells. The practice showed that
-- that forcing made t'GI.Atk.Interfaces.Table.Table' implementation complex, and hard to
-- expose other kind of children, like rows or captions. Right now,
-- index-based methods are deprecated.

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

module GI.Atk.Interfaces.Table
    ( 

-- * Exported types
    Table(..)                               ,
    IsTable                                 ,
    toTable                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addColumnSelection]("GI.Atk.Interfaces.Table#g:method:addColumnSelection"), [addRowSelection]("GI.Atk.Interfaces.Table#g:method:addRowSelection"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isColumnSelected]("GI.Atk.Interfaces.Table#g:method:isColumnSelected"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isRowSelected]("GI.Atk.Interfaces.Table#g:method:isRowSelected"), [isSelected]("GI.Atk.Interfaces.Table#g:method:isSelected"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refAt]("GI.Atk.Interfaces.Table#g:method:refAt"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeColumnSelection]("GI.Atk.Interfaces.Table#g:method:removeColumnSelection"), [removeRowSelection]("GI.Atk.Interfaces.Table#g:method:removeRowSelection"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [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
-- [getCaption]("GI.Atk.Interfaces.Table#g:method:getCaption"), [getColumnAtIndex]("GI.Atk.Interfaces.Table#g:method:getColumnAtIndex"), [getColumnDescription]("GI.Atk.Interfaces.Table#g:method:getColumnDescription"), [getColumnExtentAt]("GI.Atk.Interfaces.Table#g:method:getColumnExtentAt"), [getColumnHeader]("GI.Atk.Interfaces.Table#g:method:getColumnHeader"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getIndexAt]("GI.Atk.Interfaces.Table#g:method:getIndexAt"), [getNColumns]("GI.Atk.Interfaces.Table#g:method:getNColumns"), [getNRows]("GI.Atk.Interfaces.Table#g:method:getNRows"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRowAtIndex]("GI.Atk.Interfaces.Table#g:method:getRowAtIndex"), [getRowDescription]("GI.Atk.Interfaces.Table#g:method:getRowDescription"), [getRowExtentAt]("GI.Atk.Interfaces.Table#g:method:getRowExtentAt"), [getRowHeader]("GI.Atk.Interfaces.Table#g:method:getRowHeader"), [getSelectedColumns]("GI.Atk.Interfaces.Table#g:method:getSelectedColumns"), [getSelectedRows]("GI.Atk.Interfaces.Table#g:method:getSelectedRows"), [getSummary]("GI.Atk.Interfaces.Table#g:method:getSummary").
-- 
-- ==== Setters
-- [setCaption]("GI.Atk.Interfaces.Table#g:method:setCaption"), [setColumnDescription]("GI.Atk.Interfaces.Table#g:method:setColumnDescription"), [setColumnHeader]("GI.Atk.Interfaces.Table#g:method:setColumnHeader"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setRowDescription]("GI.Atk.Interfaces.Table#g:method:setRowDescription"), [setRowHeader]("GI.Atk.Interfaces.Table#g:method:setRowHeader"), [setSummary]("GI.Atk.Interfaces.Table#g:method:setSummary").

#if defined(ENABLE_OVERLOADING)
    ResolveTableMethod                      ,
#endif

-- ** addColumnSelection #method:addColumnSelection#

#if defined(ENABLE_OVERLOADING)
    TableAddColumnSelectionMethodInfo       ,
#endif
    tableAddColumnSelection                 ,


-- ** addRowSelection #method:addRowSelection#

#if defined(ENABLE_OVERLOADING)
    TableAddRowSelectionMethodInfo          ,
#endif
    tableAddRowSelection                    ,


-- ** getCaption #method:getCaption#

#if defined(ENABLE_OVERLOADING)
    TableGetCaptionMethodInfo               ,
#endif
    tableGetCaption                         ,


-- ** getColumnAtIndex #method:getColumnAtIndex#

#if defined(ENABLE_OVERLOADING)
    TableGetColumnAtIndexMethodInfo         ,
#endif
    tableGetColumnAtIndex                   ,


-- ** getColumnDescription #method:getColumnDescription#

#if defined(ENABLE_OVERLOADING)
    TableGetColumnDescriptionMethodInfo     ,
#endif
    tableGetColumnDescription               ,


-- ** getColumnExtentAt #method:getColumnExtentAt#

#if defined(ENABLE_OVERLOADING)
    TableGetColumnExtentAtMethodInfo        ,
#endif
    tableGetColumnExtentAt                  ,


-- ** getColumnHeader #method:getColumnHeader#

#if defined(ENABLE_OVERLOADING)
    TableGetColumnHeaderMethodInfo          ,
#endif
    tableGetColumnHeader                    ,


-- ** getIndexAt #method:getIndexAt#

#if defined(ENABLE_OVERLOADING)
    TableGetIndexAtMethodInfo               ,
#endif
    tableGetIndexAt                         ,


-- ** getNColumns #method:getNColumns#

#if defined(ENABLE_OVERLOADING)
    TableGetNColumnsMethodInfo              ,
#endif
    tableGetNColumns                        ,


-- ** getNRows #method:getNRows#

#if defined(ENABLE_OVERLOADING)
    TableGetNRowsMethodInfo                 ,
#endif
    tableGetNRows                           ,


-- ** getRowAtIndex #method:getRowAtIndex#

#if defined(ENABLE_OVERLOADING)
    TableGetRowAtIndexMethodInfo            ,
#endif
    tableGetRowAtIndex                      ,


-- ** getRowDescription #method:getRowDescription#

#if defined(ENABLE_OVERLOADING)
    TableGetRowDescriptionMethodInfo        ,
#endif
    tableGetRowDescription                  ,


-- ** getRowExtentAt #method:getRowExtentAt#

#if defined(ENABLE_OVERLOADING)
    TableGetRowExtentAtMethodInfo           ,
#endif
    tableGetRowExtentAt                     ,


-- ** getRowHeader #method:getRowHeader#

#if defined(ENABLE_OVERLOADING)
    TableGetRowHeaderMethodInfo             ,
#endif
    tableGetRowHeader                       ,


-- ** getSelectedColumns #method:getSelectedColumns#

#if defined(ENABLE_OVERLOADING)
    TableGetSelectedColumnsMethodInfo       ,
#endif
    tableGetSelectedColumns                 ,


-- ** getSelectedRows #method:getSelectedRows#

#if defined(ENABLE_OVERLOADING)
    TableGetSelectedRowsMethodInfo          ,
#endif
    tableGetSelectedRows                    ,


-- ** getSummary #method:getSummary#

#if defined(ENABLE_OVERLOADING)
    TableGetSummaryMethodInfo               ,
#endif
    tableGetSummary                         ,


-- ** isColumnSelected #method:isColumnSelected#

#if defined(ENABLE_OVERLOADING)
    TableIsColumnSelectedMethodInfo         ,
#endif
    tableIsColumnSelected                   ,


-- ** isRowSelected #method:isRowSelected#

#if defined(ENABLE_OVERLOADING)
    TableIsRowSelectedMethodInfo            ,
#endif
    tableIsRowSelected                      ,


-- ** isSelected #method:isSelected#

#if defined(ENABLE_OVERLOADING)
    TableIsSelectedMethodInfo               ,
#endif
    tableIsSelected                         ,


-- ** refAt #method:refAt#

#if defined(ENABLE_OVERLOADING)
    TableRefAtMethodInfo                    ,
#endif
    tableRefAt                              ,


-- ** removeColumnSelection #method:removeColumnSelection#

#if defined(ENABLE_OVERLOADING)
    TableRemoveColumnSelectionMethodInfo    ,
#endif
    tableRemoveColumnSelection              ,


-- ** removeRowSelection #method:removeRowSelection#

#if defined(ENABLE_OVERLOADING)
    TableRemoveRowSelectionMethodInfo       ,
#endif
    tableRemoveRowSelection                 ,


-- ** setCaption #method:setCaption#

#if defined(ENABLE_OVERLOADING)
    TableSetCaptionMethodInfo               ,
#endif
    tableSetCaption                         ,


-- ** setColumnDescription #method:setColumnDescription#

#if defined(ENABLE_OVERLOADING)
    TableSetColumnDescriptionMethodInfo     ,
#endif
    tableSetColumnDescription               ,


-- ** setColumnHeader #method:setColumnHeader#

#if defined(ENABLE_OVERLOADING)
    TableSetColumnHeaderMethodInfo          ,
#endif
    tableSetColumnHeader                    ,


-- ** setRowDescription #method:setRowDescription#

#if defined(ENABLE_OVERLOADING)
    TableSetRowDescriptionMethodInfo        ,
#endif
    tableSetRowDescription                  ,


-- ** setRowHeader #method:setRowHeader#

#if defined(ENABLE_OVERLOADING)
    TableSetRowHeaderMethodInfo             ,
#endif
    tableSetRowHeader                       ,


-- ** setSummary #method:setSummary#

#if defined(ENABLE_OVERLOADING)
    TableSetSummaryMethodInfo               ,
#endif
    tableSetSummary                         ,




 -- * Signals


-- ** columnDeleted #signal:columnDeleted#

    TableColumnDeletedCallback              ,
#if defined(ENABLE_OVERLOADING)
    TableColumnDeletedSignalInfo            ,
#endif
    afterTableColumnDeleted                 ,
    onTableColumnDeleted                    ,


-- ** columnInserted #signal:columnInserted#

    TableColumnInsertedCallback             ,
#if defined(ENABLE_OVERLOADING)
    TableColumnInsertedSignalInfo           ,
#endif
    afterTableColumnInserted                ,
    onTableColumnInserted                   ,


-- ** columnReordered #signal:columnReordered#

    TableColumnReorderedCallback            ,
#if defined(ENABLE_OVERLOADING)
    TableColumnReorderedSignalInfo          ,
#endif
    afterTableColumnReordered               ,
    onTableColumnReordered                  ,


-- ** modelChanged #signal:modelChanged#

    TableModelChangedCallback               ,
#if defined(ENABLE_OVERLOADING)
    TableModelChangedSignalInfo             ,
#endif
    afterTableModelChanged                  ,
    onTableModelChanged                     ,


-- ** rowDeleted #signal:rowDeleted#

    TableRowDeletedCallback                 ,
#if defined(ENABLE_OVERLOADING)
    TableRowDeletedSignalInfo               ,
#endif
    afterTableRowDeleted                    ,
    onTableRowDeleted                       ,


-- ** rowInserted #signal:rowInserted#

    TableRowInsertedCallback                ,
#if defined(ENABLE_OVERLOADING)
    TableRowInsertedSignalInfo              ,
#endif
    afterTableRowInserted                   ,
    onTableRowInserted                      ,


-- ** rowReordered #signal:rowReordered#

    TableRowReorderedCallback               ,
#if defined(ENABLE_OVERLOADING)
    TableRowReorderedSignalInfo             ,
#endif
    afterTableRowReordered                  ,
    onTableRowReordered                     ,




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

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

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

foreign import ccall "atk_table_get_type"
    c_atk_table_get_type :: IO B.Types.GType

instance B.Types.TypedObject Table where
    glibType :: IO GType
glibType = IO GType
c_atk_table_get_type

instance B.Types.GObject Table

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

instance O.HasParentTypes Table
type instance O.ParentTypes Table = '[GObject.Object.Object]

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

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

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTableMethod (t :: Symbol) (o :: *) :: * where
    ResolveTableMethod "addColumnSelection" o = TableAddColumnSelectionMethodInfo
    ResolveTableMethod "addRowSelection" o = TableAddRowSelectionMethodInfo
    ResolveTableMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTableMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTableMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTableMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTableMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTableMethod "isColumnSelected" o = TableIsColumnSelectedMethodInfo
    ResolveTableMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTableMethod "isRowSelected" o = TableIsRowSelectedMethodInfo
    ResolveTableMethod "isSelected" o = TableIsSelectedMethodInfo
    ResolveTableMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTableMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTableMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTableMethod "refAt" o = TableRefAtMethodInfo
    ResolveTableMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTableMethod "removeColumnSelection" o = TableRemoveColumnSelectionMethodInfo
    ResolveTableMethod "removeRowSelection" o = TableRemoveRowSelectionMethodInfo
    ResolveTableMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTableMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTableMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTableMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTableMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTableMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTableMethod "getCaption" o = TableGetCaptionMethodInfo
    ResolveTableMethod "getColumnAtIndex" o = TableGetColumnAtIndexMethodInfo
    ResolveTableMethod "getColumnDescription" o = TableGetColumnDescriptionMethodInfo
    ResolveTableMethod "getColumnExtentAt" o = TableGetColumnExtentAtMethodInfo
    ResolveTableMethod "getColumnHeader" o = TableGetColumnHeaderMethodInfo
    ResolveTableMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTableMethod "getIndexAt" o = TableGetIndexAtMethodInfo
    ResolveTableMethod "getNColumns" o = TableGetNColumnsMethodInfo
    ResolveTableMethod "getNRows" o = TableGetNRowsMethodInfo
    ResolveTableMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTableMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTableMethod "getRowAtIndex" o = TableGetRowAtIndexMethodInfo
    ResolveTableMethod "getRowDescription" o = TableGetRowDescriptionMethodInfo
    ResolveTableMethod "getRowExtentAt" o = TableGetRowExtentAtMethodInfo
    ResolveTableMethod "getRowHeader" o = TableGetRowHeaderMethodInfo
    ResolveTableMethod "getSelectedColumns" o = TableGetSelectedColumnsMethodInfo
    ResolveTableMethod "getSelectedRows" o = TableGetSelectedRowsMethodInfo
    ResolveTableMethod "getSummary" o = TableGetSummaryMethodInfo
    ResolveTableMethod "setCaption" o = TableSetCaptionMethodInfo
    ResolveTableMethod "setColumnDescription" o = TableSetColumnDescriptionMethodInfo
    ResolveTableMethod "setColumnHeader" o = TableSetColumnHeaderMethodInfo
    ResolveTableMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTableMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTableMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTableMethod "setRowDescription" o = TableSetRowDescriptionMethodInfo
    ResolveTableMethod "setRowHeader" o = TableSetRowHeaderMethodInfo
    ResolveTableMethod "setSummary" o = TableSetSummaryMethodInfo
    ResolveTableMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- method Table::add_column_selection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a column in @table"
--                 , 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 "atk_table_add_column_selection" atk_table_add_column_selection :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- column : TBasicType TInt
    IO CInt

-- | Adds the specified /@column@/ to the selection.
tableAddColumnSelection ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@column@/: a @/gint/@ representing a column in /@table@/
    -> m Bool
    -- ^ __Returns:__ a gboolean representing if the column was successfully added to
    -- the selection, or 0 if value does not implement this interface.
tableAddColumnSelection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> m Bool
tableAddColumnSelection a
table Int32
column = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CInt
result <- Ptr Table -> Int32 -> IO CInt
atk_table_add_column_selection Ptr Table
table' Int32
column
    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 (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TableAddColumnSelectionMethodInfo
instance (signature ~ (Int32 -> m Bool), MonadIO m, IsTable a) => O.OverloadedMethod TableAddColumnSelectionMethodInfo a signature where
    overloadedMethod = tableAddColumnSelection

instance O.OverloadedMethodInfo TableAddColumnSelectionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableAddColumnSelection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableAddColumnSelection"
        })


#endif

-- method Table::add_row_selection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a row in @table"
--                 , 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 "atk_table_add_row_selection" atk_table_add_row_selection :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- row : TBasicType TInt
    IO CInt

-- | Adds the specified /@row@/ to the selection.
tableAddRowSelection ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@row@/: a @/gint/@ representing a row in /@table@/
    -> m Bool
    -- ^ __Returns:__ a gboolean representing if row was successfully added to selection,
    -- or 0 if value does not implement this interface.
tableAddRowSelection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> m Bool
tableAddRowSelection a
table Int32
row = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CInt
result <- Ptr Table -> Int32 -> IO CInt
atk_table_add_row_selection Ptr Table
table' Int32
row
    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 (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TableAddRowSelectionMethodInfo
instance (signature ~ (Int32 -> m Bool), MonadIO m, IsTable a) => O.OverloadedMethod TableAddRowSelectionMethodInfo a signature where
    overloadedMethod = tableAddRowSelection

instance O.OverloadedMethodInfo TableAddRowSelectionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableAddRowSelection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableAddRowSelection"
        })


#endif

-- method Table::get_caption
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableInterface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Atk" , name = "Object" })
-- throws : False
-- Skip return : False

foreign import ccall "atk_table_get_caption" atk_table_get_caption :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    IO (Ptr Atk.Object.Object)

-- | Gets the caption for the /@table@/.
tableGetCaption ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableInterface
    -> m (Maybe Atk.Object.Object)
    -- ^ __Returns:__ a AtkObject* representing the
    -- table caption, or 'P.Nothing' if value does not implement this interface.
tableGetCaption :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> m (Maybe Object)
tableGetCaption a
table = IO (Maybe Object) -> m (Maybe Object)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr Object
result <- Ptr Table -> IO (Ptr Object)
atk_table_get_caption Ptr Table
table'
    Maybe Object
maybeResult <- Ptr Object -> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Object
result ((Ptr Object -> IO Object) -> IO (Maybe Object))
-> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. (a -> b) -> a -> b
$ \Ptr Object
result' -> do
        Object
result'' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
Atk.Object.Object) Ptr Object
result'
        Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Maybe Object -> IO (Maybe Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Object
maybeResult

#if defined(ENABLE_OVERLOADING)
data TableGetCaptionMethodInfo
instance (signature ~ (m (Maybe Atk.Object.Object)), MonadIO m, IsTable a) => O.OverloadedMethod TableGetCaptionMethodInfo a signature where
    overloadedMethod = tableGetCaption

instance O.OverloadedMethodInfo TableGetCaptionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableGetCaption",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableGetCaption"
        })


#endif

-- method Table::get_column_at_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableInterface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing an index in @table"
--                 , 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 "atk_table_get_column_at_index" atk_table_get_column_at_index :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- index_ : TBasicType TInt
    IO Int32

{-# DEPRECATED tableGetColumnAtIndex ["Since 2.12."] #-}
-- | Gets a @/gint/@ representing the column at the specified /@index_@/.
tableGetColumnAtIndex ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableInterface
    -> Int32
    -- ^ /@index_@/: a @/gint/@ representing an index in /@table@/
    -> m Int32
    -- ^ __Returns:__ a gint representing the column at the specified index,
    -- or -1 if the table does not implement this method.
tableGetColumnAtIndex :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> m Int32
tableGetColumnAtIndex a
table Int32
index_ = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Int32
result <- Ptr Table -> Int32 -> IO Int32
atk_table_get_column_at_index Ptr Table
table' Int32
index_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TableGetColumnAtIndexMethodInfo
instance (signature ~ (Int32 -> m Int32), MonadIO m, IsTable a) => O.OverloadedMethod TableGetColumnAtIndexMethodInfo a signature where
    overloadedMethod = tableGetColumnAtIndex

instance O.OverloadedMethodInfo TableGetColumnAtIndexMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableGetColumnAtIndex",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableGetColumnAtIndex"
        })


#endif

-- method Table::get_column_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a column in @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "atk_table_get_column_description" atk_table_get_column_description :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- column : TBasicType TInt
    IO CString

-- | Gets the description text of the specified /@column@/ in the table
tableGetColumnDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@column@/: a @/gint/@ representing a column in /@table@/
    -> m T.Text
    -- ^ __Returns:__ a gchar* representing the column description, or 'P.Nothing'
    -- if value does not implement this interface.
tableGetColumnDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> m Text
tableGetColumnDescription a
table Int32
column = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CString
result <- Ptr Table -> Int32 -> IO CString
atk_table_get_column_description Ptr Table
table' Int32
column
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tableGetColumnDescription" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data TableGetColumnDescriptionMethodInfo
instance (signature ~ (Int32 -> m T.Text), MonadIO m, IsTable a) => O.OverloadedMethod TableGetColumnDescriptionMethodInfo a signature where
    overloadedMethod = tableGetColumnDescription

instance O.OverloadedMethodInfo TableGetColumnDescriptionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableGetColumnDescription",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableGetColumnDescription"
        })


#endif

-- method Table::get_column_extent_at
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a row in @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a column in @table"
--                 , 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 "atk_table_get_column_extent_at" atk_table_get_column_extent_at :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- row : TBasicType TInt
    Int32 ->                                -- column : TBasicType TInt
    IO Int32

-- | Gets the number of columns occupied by the accessible object
-- at the specified /@row@/ and /@column@/ in the /@table@/.
tableGetColumnExtentAt ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@row@/: a @/gint/@ representing a row in /@table@/
    -> Int32
    -- ^ /@column@/: a @/gint/@ representing a column in /@table@/
    -> m Int32
    -- ^ __Returns:__ a gint representing the column extent at specified position, or 0
    -- if value does not implement this interface.
tableGetColumnExtentAt :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> Int32 -> m Int32
tableGetColumnExtentAt a
table Int32
row Int32
column = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Int32
result <- Ptr Table -> Int32 -> Int32 -> IO Int32
atk_table_get_column_extent_at Ptr Table
table' Int32
row Int32
column
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TableGetColumnExtentAtMethodInfo
instance (signature ~ (Int32 -> Int32 -> m Int32), MonadIO m, IsTable a) => O.OverloadedMethod TableGetColumnExtentAtMethodInfo a signature where
    overloadedMethod = tableGetColumnExtentAt

instance O.OverloadedMethodInfo TableGetColumnExtentAtMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableGetColumnExtentAt",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableGetColumnExtentAt"
        })


#endif

-- method Table::get_column_header
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a column in the table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Atk" , name = "Object" })
-- throws : False
-- Skip return : False

foreign import ccall "atk_table_get_column_header" atk_table_get_column_header :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- column : TBasicType TInt
    IO (Ptr Atk.Object.Object)

-- | Gets the column header of a specified column in an accessible table.
tableGetColumnHeader ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@column@/: a @/gint/@ representing a column in the table
    -> m (Maybe Atk.Object.Object)
    -- ^ __Returns:__ a AtkObject* representing the
    -- specified column header, or 'P.Nothing' if value does not implement this
    -- interface.
tableGetColumnHeader :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> m (Maybe Object)
tableGetColumnHeader a
table Int32
column = IO (Maybe Object) -> m (Maybe Object)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr Object
result <- Ptr Table -> Int32 -> IO (Ptr Object)
atk_table_get_column_header Ptr Table
table' Int32
column
    Maybe Object
maybeResult <- Ptr Object -> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Object
result ((Ptr Object -> IO Object) -> IO (Maybe Object))
-> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. (a -> b) -> a -> b
$ \Ptr Object
result' -> do
        Object
result'' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
Atk.Object.Object) Ptr Object
result'
        Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Maybe Object -> IO (Maybe Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Object
maybeResult

#if defined(ENABLE_OVERLOADING)
data TableGetColumnHeaderMethodInfo
instance (signature ~ (Int32 -> m (Maybe Atk.Object.Object)), MonadIO m, IsTable a) => O.OverloadedMethod TableGetColumnHeaderMethodInfo a signature where
    overloadedMethod = tableGetColumnHeader

instance O.OverloadedMethodInfo TableGetColumnHeaderMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableGetColumnHeader",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableGetColumnHeader"
        })


#endif

-- method Table::get_index_at
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a row in @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a column in @table"
--                 , 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 "atk_table_get_index_at" atk_table_get_index_at :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- row : TBasicType TInt
    Int32 ->                                -- column : TBasicType TInt
    IO Int32

{-# DEPRECATED tableGetIndexAt ["Since 2.12. Use 'GI.Atk.Interfaces.Table.tableRefAt' in order to get the","accessible that represents the cell at (/@row@/, /@column@/)"] #-}
-- | Gets a @/gint/@ representing the index at the specified /@row@/ and
-- /@column@/.
tableGetIndexAt ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@row@/: a @/gint/@ representing a row in /@table@/
    -> Int32
    -- ^ /@column@/: a @/gint/@ representing a column in /@table@/
    -> m Int32
    -- ^ __Returns:__ a @/gint/@ representing the index at specified position.
    -- The value -1 is returned if the object at row,column is not a child
    -- of table or table does not implement this interface.
tableGetIndexAt :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> Int32 -> m Int32
tableGetIndexAt a
table Int32
row Int32
column = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Int32
result <- Ptr Table -> Int32 -> Int32 -> IO Int32
atk_table_get_index_at Ptr Table
table' Int32
row Int32
column
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TableGetIndexAtMethodInfo
instance (signature ~ (Int32 -> Int32 -> m Int32), MonadIO m, IsTable a) => O.OverloadedMethod TableGetIndexAtMethodInfo a signature where
    overloadedMethod = tableGetIndexAt

instance O.OverloadedMethodInfo TableGetIndexAtMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableGetIndexAt",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableGetIndexAt"
        })


#endif

-- method Table::get_n_columns
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , 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 "atk_table_get_n_columns" atk_table_get_n_columns :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    IO Int32

-- | Gets the number of columns in the table.
tableGetNColumns ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> m Int32
    -- ^ __Returns:__ a gint representing the number of columns, or 0
    -- if value does not implement this interface.
tableGetNColumns :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> m Int32
tableGetNColumns a
table = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Int32
result <- Ptr Table -> IO Int32
atk_table_get_n_columns Ptr Table
table'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TableGetNColumnsMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsTable a) => O.OverloadedMethod TableGetNColumnsMethodInfo a signature where
    overloadedMethod = tableGetNColumns

instance O.OverloadedMethodInfo TableGetNColumnsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableGetNColumns",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableGetNColumns"
        })


#endif

-- method Table::get_n_rows
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , 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 "atk_table_get_n_rows" atk_table_get_n_rows :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    IO Int32

-- | Gets the number of rows in the table.
tableGetNRows ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> m Int32
    -- ^ __Returns:__ a gint representing the number of rows, or 0
    -- if value does not implement this interface.
tableGetNRows :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> m Int32
tableGetNRows a
table = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Int32
result <- Ptr Table -> IO Int32
atk_table_get_n_rows Ptr Table
table'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TableGetNRowsMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsTable a) => O.OverloadedMethod TableGetNRowsMethodInfo a signature where
    overloadedMethod = tableGetNRows

instance O.OverloadedMethodInfo TableGetNRowsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableGetNRows",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableGetNRows"
        })


#endif

-- method Table::get_row_at_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableInterface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing an index in @table"
--                 , 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 "atk_table_get_row_at_index" atk_table_get_row_at_index :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- index_ : TBasicType TInt
    IO Int32

{-# DEPRECATED tableGetRowAtIndex ["since 2.12."] #-}
-- | Gets a @/gint/@ representing the row at the specified /@index_@/.
tableGetRowAtIndex ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableInterface
    -> Int32
    -- ^ /@index_@/: a @/gint/@ representing an index in /@table@/
    -> m Int32
    -- ^ __Returns:__ a gint representing the row at the specified index,
    -- or -1 if the table does not implement this method.
tableGetRowAtIndex :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> m Int32
tableGetRowAtIndex a
table Int32
index_ = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Int32
result <- Ptr Table -> Int32 -> IO Int32
atk_table_get_row_at_index Ptr Table
table' Int32
index_
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TableGetRowAtIndexMethodInfo
instance (signature ~ (Int32 -> m Int32), MonadIO m, IsTable a) => O.OverloadedMethod TableGetRowAtIndexMethodInfo a signature where
    overloadedMethod = tableGetRowAtIndex

instance O.OverloadedMethodInfo TableGetRowAtIndexMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableGetRowAtIndex",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableGetRowAtIndex"
        })


#endif

-- method Table::get_row_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a row in @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "atk_table_get_row_description" atk_table_get_row_description :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- row : TBasicType TInt
    IO CString

-- | Gets the description text of the specified row in the table
tableGetRowDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@row@/: a @/gint/@ representing a row in /@table@/
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a gchar* representing the row description, or
    -- 'P.Nothing' if value does not implement this interface.
tableGetRowDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> m (Maybe Text)
tableGetRowDescription a
table Int32
row = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CString
result <- Ptr Table -> Int32 -> IO CString
atk_table_get_row_description Ptr Table
table' Int32
row
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data TableGetRowDescriptionMethodInfo
instance (signature ~ (Int32 -> m (Maybe T.Text)), MonadIO m, IsTable a) => O.OverloadedMethod TableGetRowDescriptionMethodInfo a signature where
    overloadedMethod = tableGetRowDescription

instance O.OverloadedMethodInfo TableGetRowDescriptionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableGetRowDescription",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableGetRowDescription"
        })


#endif

-- method Table::get_row_extent_at
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a row in @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a column in @table"
--                 , 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 "atk_table_get_row_extent_at" atk_table_get_row_extent_at :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- row : TBasicType TInt
    Int32 ->                                -- column : TBasicType TInt
    IO Int32

-- | Gets the number of rows occupied by the accessible object
-- at a specified /@row@/ and /@column@/ in the /@table@/.
tableGetRowExtentAt ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@row@/: a @/gint/@ representing a row in /@table@/
    -> Int32
    -- ^ /@column@/: a @/gint/@ representing a column in /@table@/
    -> m Int32
    -- ^ __Returns:__ a gint representing the row extent at specified position, or 0
    -- if value does not implement this interface.
tableGetRowExtentAt :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> Int32 -> m Int32
tableGetRowExtentAt a
table Int32
row Int32
column = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Int32
result <- Ptr Table -> Int32 -> Int32 -> IO Int32
atk_table_get_row_extent_at Ptr Table
table' Int32
row Int32
column
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TableGetRowExtentAtMethodInfo
instance (signature ~ (Int32 -> Int32 -> m Int32), MonadIO m, IsTable a) => O.OverloadedMethod TableGetRowExtentAtMethodInfo a signature where
    overloadedMethod = tableGetRowExtentAt

instance O.OverloadedMethodInfo TableGetRowExtentAtMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableGetRowExtentAt",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableGetRowExtentAt"
        })


#endif

-- method Table::get_row_header
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a row in the table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Atk" , name = "Object" })
-- throws : False
-- Skip return : False

foreign import ccall "atk_table_get_row_header" atk_table_get_row_header :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- row : TBasicType TInt
    IO (Ptr Atk.Object.Object)

-- | Gets the row header of a specified row in an accessible table.
tableGetRowHeader ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@row@/: a @/gint/@ representing a row in the table
    -> m (Maybe Atk.Object.Object)
    -- ^ __Returns:__ a AtkObject* representing the
    -- specified row header, or 'P.Nothing' if value does not implement this
    -- interface.
tableGetRowHeader :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> m (Maybe Object)
tableGetRowHeader a
table Int32
row = IO (Maybe Object) -> m (Maybe Object)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr Object
result <- Ptr Table -> Int32 -> IO (Ptr Object)
atk_table_get_row_header Ptr Table
table' Int32
row
    Maybe Object
maybeResult <- Ptr Object -> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Object
result ((Ptr Object -> IO Object) -> IO (Maybe Object))
-> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. (a -> b) -> a -> b
$ \Ptr Object
result' -> do
        Object
result'' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
Atk.Object.Object) Ptr Object
result'
        Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Maybe Object -> IO (Maybe Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Object
maybeResult

#if defined(ENABLE_OVERLOADING)
data TableGetRowHeaderMethodInfo
instance (signature ~ (Int32 -> m (Maybe Atk.Object.Object)), MonadIO m, IsTable a) => O.OverloadedMethod TableGetRowHeaderMethodInfo a signature where
    overloadedMethod = tableGetRowHeader

instance O.OverloadedMethodInfo TableGetRowHeaderMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableGetRowHeader",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableGetRowHeader"
        })


#endif

-- method Table::get_selected_columns
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "selected"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #gint** that is to contain the selected columns numbers"
--                 , 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 "atk_table_get_selected_columns" atk_table_get_selected_columns :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- selected : TBasicType TInt
    IO Int32

-- | Gets the selected columns of the table by initializing **selected with
-- the selected column numbers. This array should be freed by the caller.
tableGetSelectedColumns ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@selected@/: a @/gint/@** that is to contain the selected columns numbers
    -> m Int32
    -- ^ __Returns:__ a gint representing the number of selected columns,
    -- or @/0/@ if value does not implement this interface.
tableGetSelectedColumns :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> m Int32
tableGetSelectedColumns a
table Int32
selected = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Int32
result <- Ptr Table -> Int32 -> IO Int32
atk_table_get_selected_columns Ptr Table
table' Int32
selected
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TableGetSelectedColumnsMethodInfo
instance (signature ~ (Int32 -> m Int32), MonadIO m, IsTable a) => O.OverloadedMethod TableGetSelectedColumnsMethodInfo a signature where
    overloadedMethod = tableGetSelectedColumns

instance O.OverloadedMethodInfo TableGetSelectedColumnsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableGetSelectedColumns",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableGetSelectedColumns"
        })


#endif

-- method Table::get_selected_rows
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "selected"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #gint** that is to contain the selected row numbers"
--                 , 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 "atk_table_get_selected_rows" atk_table_get_selected_rows :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- selected : TBasicType TInt
    IO Int32

-- | Gets the selected rows of the table by initializing **selected with
-- the selected row numbers. This array should be freed by the caller.
tableGetSelectedRows ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@selected@/: a @/gint/@** that is to contain the selected row numbers
    -> m Int32
    -- ^ __Returns:__ a gint representing the number of selected rows,
    -- or zero if value does not implement this interface.
tableGetSelectedRows :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> m Int32
tableGetSelectedRows a
table Int32
selected = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Int32
result <- Ptr Table -> Int32 -> IO Int32
atk_table_get_selected_rows Ptr Table
table' Int32
selected
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data TableGetSelectedRowsMethodInfo
instance (signature ~ (Int32 -> m Int32), MonadIO m, IsTable a) => O.OverloadedMethod TableGetSelectedRowsMethodInfo a signature where
    overloadedMethod = tableGetSelectedRows

instance O.OverloadedMethodInfo TableGetSelectedRowsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableGetSelectedRows",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableGetSelectedRows"
        })


#endif

-- method Table::get_summary
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Atk" , name = "Object" })
-- throws : False
-- Skip return : False

foreign import ccall "atk_table_get_summary" atk_table_get_summary :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    IO (Ptr Atk.Object.Object)

-- | Gets the summary description of the table.
tableGetSummary ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> m Atk.Object.Object
    -- ^ __Returns:__ a AtkObject* representing a summary description
    -- of the table, or zero if value does not implement this interface.
tableGetSummary :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> m Object
tableGetSummary a
table = IO Object -> m Object
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Object -> m Object) -> IO Object -> m Object
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr Object
result <- Ptr Table -> IO (Ptr Object)
atk_table_get_summary Ptr Table
table'
    Text -> Ptr Object -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tableGetSummary" Ptr Object
result
    Object
result' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Object -> Object
Atk.Object.Object) Ptr Object
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result'

#if defined(ENABLE_OVERLOADING)
data TableGetSummaryMethodInfo
instance (signature ~ (m Atk.Object.Object), MonadIO m, IsTable a) => O.OverloadedMethod TableGetSummaryMethodInfo a signature where
    overloadedMethod = tableGetSummary

instance O.OverloadedMethodInfo TableGetSummaryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableGetSummary",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableGetSummary"
        })


#endif

-- method Table::is_column_selected
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a column in @table"
--                 , 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 "atk_table_is_column_selected" atk_table_is_column_selected :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- column : TBasicType TInt
    IO CInt

-- | Gets a boolean value indicating whether the specified /@column@/
-- is selected
tableIsColumnSelected ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@column@/: a @/gint/@ representing a column in /@table@/
    -> m Bool
    -- ^ __Returns:__ a gboolean representing if the column is selected, or 0
    -- if value does not implement this interface.
tableIsColumnSelected :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> m Bool
tableIsColumnSelected a
table Int32
column = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CInt
result <- Ptr Table -> Int32 -> IO CInt
atk_table_is_column_selected Ptr Table
table' Int32
column
    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 (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TableIsColumnSelectedMethodInfo
instance (signature ~ (Int32 -> m Bool), MonadIO m, IsTable a) => O.OverloadedMethod TableIsColumnSelectedMethodInfo a signature where
    overloadedMethod = tableIsColumnSelected

instance O.OverloadedMethodInfo TableIsColumnSelectedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableIsColumnSelected",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableIsColumnSelected"
        })


#endif

-- method Table::is_row_selected
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a row in @table"
--                 , 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 "atk_table_is_row_selected" atk_table_is_row_selected :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- row : TBasicType TInt
    IO CInt

-- | Gets a boolean value indicating whether the specified /@row@/
-- is selected
tableIsRowSelected ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@row@/: a @/gint/@ representing a row in /@table@/
    -> m Bool
    -- ^ __Returns:__ a gboolean representing if the row is selected, or 0
    -- if value does not implement this interface.
tableIsRowSelected :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> m Bool
tableIsRowSelected a
table Int32
row = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CInt
result <- Ptr Table -> Int32 -> IO CInt
atk_table_is_row_selected Ptr Table
table' Int32
row
    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 (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TableIsRowSelectedMethodInfo
instance (signature ~ (Int32 -> m Bool), MonadIO m, IsTable a) => O.OverloadedMethod TableIsRowSelectedMethodInfo a signature where
    overloadedMethod = tableIsRowSelected

instance O.OverloadedMethodInfo TableIsRowSelectedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableIsRowSelected",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableIsRowSelected"
        })


#endif

-- method Table::is_selected
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a row in @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a column in @table"
--                 , 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 "atk_table_is_selected" atk_table_is_selected :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- row : TBasicType TInt
    Int32 ->                                -- column : TBasicType TInt
    IO CInt

-- | Gets a boolean value indicating whether the accessible object
-- at the specified /@row@/ and /@column@/ is selected
tableIsSelected ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@row@/: a @/gint/@ representing a row in /@table@/
    -> Int32
    -- ^ /@column@/: a @/gint/@ representing a column in /@table@/
    -> m Bool
    -- ^ __Returns:__ a gboolean representing if the cell is selected, or 0
    -- if value does not implement this interface.
tableIsSelected :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> Int32 -> m Bool
tableIsSelected a
table Int32
row Int32
column = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CInt
result <- Ptr Table -> Int32 -> Int32 -> IO CInt
atk_table_is_selected Ptr Table
table' Int32
row Int32
column
    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 (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TableIsSelectedMethodInfo
instance (signature ~ (Int32 -> Int32 -> m Bool), MonadIO m, IsTable a) => O.OverloadedMethod TableIsSelectedMethodInfo a signature where
    overloadedMethod = tableIsSelected

instance O.OverloadedMethodInfo TableIsSelectedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableIsSelected",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableIsSelected"
        })


#endif

-- method Table::ref_at
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a row in @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a column in @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Atk" , name = "Object" })
-- throws : False
-- Skip return : False

foreign import ccall "atk_table_ref_at" atk_table_ref_at :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- row : TBasicType TInt
    Int32 ->                                -- column : TBasicType TInt
    IO (Ptr Atk.Object.Object)

-- | Get a reference to the table cell at /@row@/, /@column@/. This cell
-- should implement the interface t'GI.Atk.Interfaces.TableCell.TableCell'
tableRefAt ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@row@/: a @/gint/@ representing a row in /@table@/
    -> Int32
    -- ^ /@column@/: a @/gint/@ representing a column in /@table@/
    -> m Atk.Object.Object
    -- ^ __Returns:__ an t'GI.Atk.Objects.Object.Object' representing the referred
    -- to accessible
tableRefAt :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> Int32 -> m Object
tableRefAt a
table Int32
row Int32
column = IO Object -> m Object
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Object -> m Object) -> IO Object -> m Object
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr Object
result <- Ptr Table -> Int32 -> Int32 -> IO (Ptr Object)
atk_table_ref_at Ptr Table
table' Int32
row Int32
column
    Text -> Ptr Object -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tableRefAt" Ptr Object
result
    Object
result' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Object -> Object
Atk.Object.Object) Ptr Object
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result'

#if defined(ENABLE_OVERLOADING)
data TableRefAtMethodInfo
instance (signature ~ (Int32 -> Int32 -> m Atk.Object.Object), MonadIO m, IsTable a) => O.OverloadedMethod TableRefAtMethodInfo a signature where
    overloadedMethod = tableRefAt

instance O.OverloadedMethodInfo TableRefAtMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableRefAt",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableRefAt"
        })


#endif

-- method Table::remove_column_selection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a column in @table"
--                 , 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 "atk_table_remove_column_selection" atk_table_remove_column_selection :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- column : TBasicType TInt
    IO CInt

-- | Adds the specified /@column@/ to the selection.
tableRemoveColumnSelection ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@column@/: a @/gint/@ representing a column in /@table@/
    -> m Bool
    -- ^ __Returns:__ a gboolean representing if the column was successfully removed from
    -- the selection, or 0 if value does not implement this interface.
tableRemoveColumnSelection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> m Bool
tableRemoveColumnSelection a
table Int32
column = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CInt
result <- Ptr Table -> Int32 -> IO CInt
atk_table_remove_column_selection Ptr Table
table' Int32
column
    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 (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TableRemoveColumnSelectionMethodInfo
instance (signature ~ (Int32 -> m Bool), MonadIO m, IsTable a) => O.OverloadedMethod TableRemoveColumnSelectionMethodInfo a signature where
    overloadedMethod = tableRemoveColumnSelection

instance O.OverloadedMethodInfo TableRemoveColumnSelectionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableRemoveColumnSelection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableRemoveColumnSelection"
        })


#endif

-- method Table::remove_row_selection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a row in @table"
--                 , 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 "atk_table_remove_row_selection" atk_table_remove_row_selection :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- row : TBasicType TInt
    IO CInt

-- | Removes the specified /@row@/ from the selection.
tableRemoveRowSelection ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@row@/: a @/gint/@ representing a row in /@table@/
    -> m Bool
    -- ^ __Returns:__ a gboolean representing if the row was successfully removed from
    -- the selection, or 0 if value does not implement this interface.
tableRemoveRowSelection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> m Bool
tableRemoveRowSelection a
table Int32
row = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CInt
result <- Ptr Table -> Int32 -> IO CInt
atk_table_remove_row_selection Ptr Table
table' Int32
row
    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 (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TableRemoveRowSelectionMethodInfo
instance (signature ~ (Int32 -> m Bool), MonadIO m, IsTable a) => O.OverloadedMethod TableRemoveRowSelectionMethodInfo a signature where
    overloadedMethod = tableRemoveRowSelection

instance O.OverloadedMethodInfo TableRemoveRowSelectionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableRemoveRowSelection",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableRemoveRowSelection"
        })


#endif

-- method Table::set_caption
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "caption"
--           , argType = TInterface Name { namespace = "Atk" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #AtkObject representing the caption to set for @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_table_set_caption" atk_table_set_caption :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Ptr Atk.Object.Object ->                -- caption : TInterface (Name {namespace = "Atk", name = "Object"})
    IO ()

-- | Sets the caption for the table.
tableSetCaption ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a, Atk.Object.IsObject b) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> b
    -- ^ /@caption@/: a t'GI.Atk.Objects.Object.Object' representing the caption to set for /@table@/
    -> m ()
tableSetCaption :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTable a, IsObject b) =>
a -> b -> m ()
tableSetCaption a
table b
caption = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr Object
caption' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
caption
    Ptr Table -> Ptr Object -> IO ()
atk_table_set_caption Ptr Table
table' Ptr Object
caption'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
caption
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TableSetCaptionMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsTable a, Atk.Object.IsObject b) => O.OverloadedMethod TableSetCaptionMethodInfo a signature where
    overloadedMethod = tableSetCaption

instance O.OverloadedMethodInfo TableSetCaptionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableSetCaption",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableSetCaption"
        })


#endif

-- method Table::set_column_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a column in @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "description"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #gchar representing the description text\nto set for the specified @column of the @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_table_set_column_description" atk_table_set_column_description :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- column : TBasicType TInt
    CString ->                              -- description : TBasicType TUTF8
    IO ()

-- | Sets the description text for the specified /@column@/ of the /@table@/.
tableSetColumnDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@column@/: a @/gint/@ representing a column in /@table@/
    -> T.Text
    -- ^ /@description@/: a @/gchar/@ representing the description text
    -- to set for the specified /@column@/ of the /@table@/
    -> m ()
tableSetColumnDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> Text -> m ()
tableSetColumnDescription a
table Int32
column Text
description = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CString
description' <- Text -> IO CString
textToCString Text
description
    Ptr Table -> Int32 -> CString -> IO ()
atk_table_set_column_description Ptr Table
table' Int32
column CString
description'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
description'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TableSetColumnDescriptionMethodInfo
instance (signature ~ (Int32 -> T.Text -> m ()), MonadIO m, IsTable a) => O.OverloadedMethod TableSetColumnDescriptionMethodInfo a signature where
    overloadedMethod = tableSetColumnDescription

instance O.OverloadedMethodInfo TableSetColumnDescriptionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableSetColumnDescription",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableSetColumnDescription"
        })


#endif

-- method Table::set_column_header
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "column"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a column in @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "header"
--           , argType = TInterface Name { namespace = "Atk" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkTable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_table_set_column_header" atk_table_set_column_header :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- column : TBasicType TInt
    Ptr Atk.Object.Object ->                -- header : TInterface (Name {namespace = "Atk", name = "Object"})
    IO ()

-- | Sets the specified column header to /@header@/.
tableSetColumnHeader ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a, Atk.Object.IsObject b) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@column@/: a @/gint/@ representing a column in /@table@/
    -> b
    -- ^ /@header@/: an t'GI.Atk.Interfaces.Table.Table'
    -> m ()
tableSetColumnHeader :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTable a, IsObject b) =>
a -> Int32 -> b -> m ()
tableSetColumnHeader a
table Int32
column b
header = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr Object
header' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
header
    Ptr Table -> Int32 -> Ptr Object -> IO ()
atk_table_set_column_header Ptr Table
table' Int32
column Ptr Object
header'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
header
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TableSetColumnHeaderMethodInfo
instance (signature ~ (Int32 -> b -> m ()), MonadIO m, IsTable a, Atk.Object.IsObject b) => O.OverloadedMethod TableSetColumnHeaderMethodInfo a signature where
    overloadedMethod = tableSetColumnHeader

instance O.OverloadedMethodInfo TableSetColumnHeaderMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableSetColumnHeader",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableSetColumnHeader"
        })


#endif

-- method Table::set_row_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a row in @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "description"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #gchar representing the description text\nto set for the specified @row of @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_table_set_row_description" atk_table_set_row_description :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- row : TBasicType TInt
    CString ->                              -- description : TBasicType TUTF8
    IO ()

-- | Sets the description text for the specified /@row@/ of /@table@/.
tableSetRowDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@row@/: a @/gint/@ representing a row in /@table@/
    -> T.Text
    -- ^ /@description@/: a @/gchar/@ representing the description text
    -- to set for the specified /@row@/ of /@table@/
    -> m ()
tableSetRowDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTable a) =>
a -> Int32 -> Text -> m ()
tableSetRowDescription a
table Int32
row Text
description = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    CString
description' <- Text -> IO CString
textToCString Text
description
    Ptr Table -> Int32 -> CString -> IO ()
atk_table_set_row_description Ptr Table
table' Int32
row CString
description'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
description'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TableSetRowDescriptionMethodInfo
instance (signature ~ (Int32 -> T.Text -> m ()), MonadIO m, IsTable a) => O.OverloadedMethod TableSetRowDescriptionMethodInfo a signature where
    overloadedMethod = tableSetRowDescription

instance O.OverloadedMethodInfo TableSetRowDescriptionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableSetRowDescription",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableSetRowDescription"
        })


#endif

-- method Table::set_row_header
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "row"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint representing a row in @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "header"
--           , argType = TInterface Name { namespace = "Atk" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #AtkTable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_table_set_row_header" atk_table_set_row_header :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Int32 ->                                -- row : TBasicType TInt
    Ptr Atk.Object.Object ->                -- header : TInterface (Name {namespace = "Atk", name = "Object"})
    IO ()

-- | Sets the specified row header to /@header@/.
tableSetRowHeader ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a, Atk.Object.IsObject b) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> Int32
    -- ^ /@row@/: a @/gint/@ representing a row in /@table@/
    -> b
    -- ^ /@header@/: an t'GI.Atk.Interfaces.Table.Table'
    -> m ()
tableSetRowHeader :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTable a, IsObject b) =>
a -> Int32 -> b -> m ()
tableSetRowHeader a
table Int32
row b
header = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr Object
header' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
header
    Ptr Table -> Int32 -> Ptr Object -> IO ()
atk_table_set_row_header Ptr Table
table' Int32
row Ptr Object
header'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
header
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TableSetRowHeaderMethodInfo
instance (signature ~ (Int32 -> b -> m ()), MonadIO m, IsTable a, Atk.Object.IsObject b) => O.OverloadedMethod TableSetRowHeaderMethodInfo a signature where
    overloadedMethod = tableSetRowHeader

instance O.OverloadedMethodInfo TableSetRowHeaderMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableSetRowHeader",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableSetRowHeader"
        })


#endif

-- method Table::set_summary
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "table"
--           , argType = TInterface Name { namespace = "Atk" , name = "Table" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkTableIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accessible"
--           , argType = TInterface Name { namespace = "Atk" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an #AtkObject representing the summary description\nto set for @table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_table_set_summary" atk_table_set_summary :: 
    Ptr Table ->                            -- table : TInterface (Name {namespace = "Atk", name = "Table"})
    Ptr Atk.Object.Object ->                -- accessible : TInterface (Name {namespace = "Atk", name = "Object"})
    IO ()

-- | Sets the summary description of the table.
tableSetSummary ::
    (B.CallStack.HasCallStack, MonadIO m, IsTable a, Atk.Object.IsObject b) =>
    a
    -- ^ /@table@/: a GObject instance that implements AtkTableIface
    -> b
    -- ^ /@accessible@/: an t'GI.Atk.Objects.Object.Object' representing the summary description
    -- to set for /@table@/
    -> m ()
tableSetSummary :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsTable a, IsObject b) =>
a -> b -> m ()
tableSetSummary a
table b
accessible = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Table
table' <- a -> IO (Ptr Table)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
table
    Ptr Object
accessible' <- b -> IO (Ptr Object)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
accessible
    Ptr Table -> Ptr Object -> IO ()
atk_table_set_summary Ptr Table
table' Ptr Object
accessible'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
table
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
accessible
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TableSetSummaryMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsTable a, Atk.Object.IsObject b) => O.OverloadedMethod TableSetSummaryMethodInfo a signature where
    overloadedMethod = tableSetSummary

instance O.OverloadedMethodInfo TableSetSummaryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table.tableSetSummary",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#v:tableSetSummary"
        })


#endif

-- signal Table::column-deleted
-- | The \"column-deleted\" signal is emitted by an object which
-- implements the AtkTable interface when a column is deleted.
type TableColumnDeletedCallback =
    Int32
    -- ^ /@arg1@/: The index of the first column deleted.
    -> Int32
    -- ^ /@arg2@/: The number of columns deleted.
    -> IO ()

type C_TableColumnDeletedCallback =
    Ptr Table ->                            -- object
    Int32 ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_TableColumnDeletedCallback :: 
    GObject a => (a -> TableColumnDeletedCallback) ->
    C_TableColumnDeletedCallback
wrap_TableColumnDeletedCallback :: forall a.
GObject a =>
(a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
wrap_TableColumnDeletedCallback a -> TableColumnDeletedCallback
gi'cb Ptr Table
gi'selfPtr Int32
arg1 Int32
arg2 Ptr ()
_ = do
    Ptr Table -> (Table -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Table
gi'selfPtr ((Table -> IO ()) -> IO ()) -> (Table -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Table
gi'self -> a -> TableColumnDeletedCallback
gi'cb (Table -> a
Coerce.coerce Table
gi'self)  Int32
arg1 Int32
arg2


-- | Connect a signal handler for the [columnDeleted](#signal:columnDeleted) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' table #columnDeleted callback
-- @
-- 
-- 
onTableColumnDeleted :: (IsTable a, MonadIO m) => a -> ((?self :: a) => TableColumnDeletedCallback) -> m SignalHandlerId
onTableColumnDeleted :: forall a (m :: * -> *).
(IsTable a, MonadIO m) =>
a
-> ((?self::a) => TableColumnDeletedCallback) -> m SignalHandlerId
onTableColumnDeleted a
obj (?self::a) => TableColumnDeletedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TableColumnDeletedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TableColumnDeletedCallback
TableColumnDeletedCallback
cb
    let wrapped' :: C_TableColumnDeletedCallback
wrapped' = (a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
forall a.
GObject a =>
(a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
wrap_TableColumnDeletedCallback a -> TableColumnDeletedCallback
wrapped
    FunPtr C_TableColumnDeletedCallback
wrapped'' <- C_TableColumnDeletedCallback
-> IO (FunPtr C_TableColumnDeletedCallback)
mk_TableColumnDeletedCallback C_TableColumnDeletedCallback
wrapped'
    a
-> Text
-> FunPtr C_TableColumnDeletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"column-deleted" FunPtr C_TableColumnDeletedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [columnDeleted](#signal:columnDeleted) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' table #columnDeleted callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTableColumnDeleted :: (IsTable a, MonadIO m) => a -> ((?self :: a) => TableColumnDeletedCallback) -> m SignalHandlerId
afterTableColumnDeleted :: forall a (m :: * -> *).
(IsTable a, MonadIO m) =>
a
-> ((?self::a) => TableColumnDeletedCallback) -> m SignalHandlerId
afterTableColumnDeleted a
obj (?self::a) => TableColumnDeletedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TableColumnDeletedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TableColumnDeletedCallback
TableColumnDeletedCallback
cb
    let wrapped' :: C_TableColumnDeletedCallback
wrapped' = (a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
forall a.
GObject a =>
(a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
wrap_TableColumnDeletedCallback a -> TableColumnDeletedCallback
wrapped
    FunPtr C_TableColumnDeletedCallback
wrapped'' <- C_TableColumnDeletedCallback
-> IO (FunPtr C_TableColumnDeletedCallback)
mk_TableColumnDeletedCallback C_TableColumnDeletedCallback
wrapped'
    a
-> Text
-> FunPtr C_TableColumnDeletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"column-deleted" FunPtr C_TableColumnDeletedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TableColumnDeletedSignalInfo
instance SignalInfo TableColumnDeletedSignalInfo where
    type HaskellCallbackType TableColumnDeletedSignalInfo = TableColumnDeletedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TableColumnDeletedCallback cb
        cb'' <- mk_TableColumnDeletedCallback cb'
        connectSignalFunPtr obj "column-deleted" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table::column-deleted"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#g:signal:columnDeleted"})

#endif

-- signal Table::column-inserted
-- | The \"column-inserted\" signal is emitted by an object which
-- implements the AtkTable interface when a column is inserted.
type TableColumnInsertedCallback =
    Int32
    -- ^ /@arg1@/: The index of the column inserted.
    -> Int32
    -- ^ /@arg2@/: The number of colums inserted.
    -> IO ()

type C_TableColumnInsertedCallback =
    Ptr Table ->                            -- object
    Int32 ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_TableColumnInsertedCallback :: 
    GObject a => (a -> TableColumnInsertedCallback) ->
    C_TableColumnInsertedCallback
wrap_TableColumnInsertedCallback :: forall a.
GObject a =>
(a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
wrap_TableColumnInsertedCallback a -> TableColumnDeletedCallback
gi'cb Ptr Table
gi'selfPtr Int32
arg1 Int32
arg2 Ptr ()
_ = do
    Ptr Table -> (Table -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Table
gi'selfPtr ((Table -> IO ()) -> IO ()) -> (Table -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Table
gi'self -> a -> TableColumnDeletedCallback
gi'cb (Table -> a
Coerce.coerce Table
gi'self)  Int32
arg1 Int32
arg2


-- | Connect a signal handler for the [columnInserted](#signal:columnInserted) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' table #columnInserted callback
-- @
-- 
-- 
onTableColumnInserted :: (IsTable a, MonadIO m) => a -> ((?self :: a) => TableColumnInsertedCallback) -> m SignalHandlerId
onTableColumnInserted :: forall a (m :: * -> *).
(IsTable a, MonadIO m) =>
a
-> ((?self::a) => TableColumnDeletedCallback) -> m SignalHandlerId
onTableColumnInserted a
obj (?self::a) => TableColumnDeletedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TableColumnDeletedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TableColumnDeletedCallback
TableColumnDeletedCallback
cb
    let wrapped' :: C_TableColumnDeletedCallback
wrapped' = (a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
forall a.
GObject a =>
(a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
wrap_TableColumnInsertedCallback a -> TableColumnDeletedCallback
wrapped
    FunPtr C_TableColumnDeletedCallback
wrapped'' <- C_TableColumnDeletedCallback
-> IO (FunPtr C_TableColumnDeletedCallback)
mk_TableColumnInsertedCallback C_TableColumnDeletedCallback
wrapped'
    a
-> Text
-> FunPtr C_TableColumnDeletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"column-inserted" FunPtr C_TableColumnDeletedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [columnInserted](#signal:columnInserted) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' table #columnInserted callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTableColumnInserted :: (IsTable a, MonadIO m) => a -> ((?self :: a) => TableColumnInsertedCallback) -> m SignalHandlerId
afterTableColumnInserted :: forall a (m :: * -> *).
(IsTable a, MonadIO m) =>
a
-> ((?self::a) => TableColumnDeletedCallback) -> m SignalHandlerId
afterTableColumnInserted a
obj (?self::a) => TableColumnDeletedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TableColumnDeletedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TableColumnDeletedCallback
TableColumnDeletedCallback
cb
    let wrapped' :: C_TableColumnDeletedCallback
wrapped' = (a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
forall a.
GObject a =>
(a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
wrap_TableColumnInsertedCallback a -> TableColumnDeletedCallback
wrapped
    FunPtr C_TableColumnDeletedCallback
wrapped'' <- C_TableColumnDeletedCallback
-> IO (FunPtr C_TableColumnDeletedCallback)
mk_TableColumnInsertedCallback C_TableColumnDeletedCallback
wrapped'
    a
-> Text
-> FunPtr C_TableColumnDeletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"column-inserted" FunPtr C_TableColumnDeletedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TableColumnInsertedSignalInfo
instance SignalInfo TableColumnInsertedSignalInfo where
    type HaskellCallbackType TableColumnInsertedSignalInfo = TableColumnInsertedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TableColumnInsertedCallback cb
        cb'' <- mk_TableColumnInsertedCallback cb'
        connectSignalFunPtr obj "column-inserted" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table::column-inserted"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#g:signal:columnInserted"})

#endif

-- signal Table::column-reordered
-- | The \"column-reordered\" signal is emitted by an object which
-- implements the AtkTable interface when the columns are
-- reordered.
type TableColumnReorderedCallback =
    IO ()

type C_TableColumnReorderedCallback =
    Ptr Table ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_TableColumnReorderedCallback :: 
    GObject a => (a -> TableColumnReorderedCallback) ->
    C_TableColumnReorderedCallback
wrap_TableColumnReorderedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_TableColumnReorderedCallback
wrap_TableColumnReorderedCallback a -> IO ()
gi'cb Ptr Table
gi'selfPtr Ptr ()
_ = do
    Ptr Table -> (Table -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Table
gi'selfPtr ((Table -> IO ()) -> IO ()) -> (Table -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Table
gi'self -> a -> IO ()
gi'cb (Table -> a
Coerce.coerce Table
gi'self) 


-- | Connect a signal handler for the [columnReordered](#signal:columnReordered) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' table #columnReordered callback
-- @
-- 
-- 
onTableColumnReordered :: (IsTable a, MonadIO m) => a -> ((?self :: a) => TableColumnReorderedCallback) -> m SignalHandlerId
onTableColumnReordered :: forall a (m :: * -> *).
(IsTable a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onTableColumnReordered a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TableColumnReorderedCallback
wrapped' = (a -> IO ()) -> C_TableColumnReorderedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_TableColumnReorderedCallback
wrap_TableColumnReorderedCallback a -> IO ()
wrapped
    FunPtr C_TableColumnReorderedCallback
wrapped'' <- C_TableColumnReorderedCallback
-> IO (FunPtr C_TableColumnReorderedCallback)
mk_TableColumnReorderedCallback C_TableColumnReorderedCallback
wrapped'
    a
-> Text
-> FunPtr C_TableColumnReorderedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"column-reordered" FunPtr C_TableColumnReorderedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [columnReordered](#signal:columnReordered) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' table #columnReordered callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTableColumnReordered :: (IsTable a, MonadIO m) => a -> ((?self :: a) => TableColumnReorderedCallback) -> m SignalHandlerId
afterTableColumnReordered :: forall a (m :: * -> *).
(IsTable a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterTableColumnReordered a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TableColumnReorderedCallback
wrapped' = (a -> IO ()) -> C_TableColumnReorderedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_TableColumnReorderedCallback
wrap_TableColumnReorderedCallback a -> IO ()
wrapped
    FunPtr C_TableColumnReorderedCallback
wrapped'' <- C_TableColumnReorderedCallback
-> IO (FunPtr C_TableColumnReorderedCallback)
mk_TableColumnReorderedCallback C_TableColumnReorderedCallback
wrapped'
    a
-> Text
-> FunPtr C_TableColumnReorderedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"column-reordered" FunPtr C_TableColumnReorderedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TableColumnReorderedSignalInfo
instance SignalInfo TableColumnReorderedSignalInfo where
    type HaskellCallbackType TableColumnReorderedSignalInfo = TableColumnReorderedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TableColumnReorderedCallback cb
        cb'' <- mk_TableColumnReorderedCallback cb'
        connectSignalFunPtr obj "column-reordered" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table::column-reordered"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#g:signal:columnReordered"})

#endif

-- signal Table::model-changed
-- | The \"model-changed\" signal is emitted by an object which
-- implements the AtkTable interface when the model displayed by
-- the table changes.
type TableModelChangedCallback =
    IO ()

type C_TableModelChangedCallback =
    Ptr Table ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_TableModelChangedCallback :: 
    GObject a => (a -> TableModelChangedCallback) ->
    C_TableModelChangedCallback
wrap_TableModelChangedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_TableColumnReorderedCallback
wrap_TableModelChangedCallback a -> IO ()
gi'cb Ptr Table
gi'selfPtr Ptr ()
_ = do
    Ptr Table -> (Table -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Table
gi'selfPtr ((Table -> IO ()) -> IO ()) -> (Table -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Table
gi'self -> a -> IO ()
gi'cb (Table -> a
Coerce.coerce Table
gi'self) 


-- | Connect a signal handler for the [modelChanged](#signal:modelChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' table #modelChanged callback
-- @
-- 
-- 
onTableModelChanged :: (IsTable a, MonadIO m) => a -> ((?self :: a) => TableModelChangedCallback) -> m SignalHandlerId
onTableModelChanged :: forall a (m :: * -> *).
(IsTable a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onTableModelChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TableColumnReorderedCallback
wrapped' = (a -> IO ()) -> C_TableColumnReorderedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_TableColumnReorderedCallback
wrap_TableModelChangedCallback a -> IO ()
wrapped
    FunPtr C_TableColumnReorderedCallback
wrapped'' <- C_TableColumnReorderedCallback
-> IO (FunPtr C_TableColumnReorderedCallback)
mk_TableModelChangedCallback C_TableColumnReorderedCallback
wrapped'
    a
-> Text
-> FunPtr C_TableColumnReorderedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"model-changed" FunPtr C_TableColumnReorderedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [modelChanged](#signal:modelChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' table #modelChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTableModelChanged :: (IsTable a, MonadIO m) => a -> ((?self :: a) => TableModelChangedCallback) -> m SignalHandlerId
afterTableModelChanged :: forall a (m :: * -> *).
(IsTable a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterTableModelChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TableColumnReorderedCallback
wrapped' = (a -> IO ()) -> C_TableColumnReorderedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_TableColumnReorderedCallback
wrap_TableModelChangedCallback a -> IO ()
wrapped
    FunPtr C_TableColumnReorderedCallback
wrapped'' <- C_TableColumnReorderedCallback
-> IO (FunPtr C_TableColumnReorderedCallback)
mk_TableModelChangedCallback C_TableColumnReorderedCallback
wrapped'
    a
-> Text
-> FunPtr C_TableColumnReorderedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"model-changed" FunPtr C_TableColumnReorderedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TableModelChangedSignalInfo
instance SignalInfo TableModelChangedSignalInfo where
    type HaskellCallbackType TableModelChangedSignalInfo = TableModelChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TableModelChangedCallback cb
        cb'' <- mk_TableModelChangedCallback cb'
        connectSignalFunPtr obj "model-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table::model-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#g:signal:modelChanged"})

#endif

-- signal Table::row-deleted
-- | The \"row-deleted\" signal is emitted by an object which
-- implements the AtkTable interface when a row is deleted.
type TableRowDeletedCallback =
    Int32
    -- ^ /@arg1@/: The index of the first row deleted.
    -> Int32
    -- ^ /@arg2@/: The number of rows deleted.
    -> IO ()

type C_TableRowDeletedCallback =
    Ptr Table ->                            -- object
    Int32 ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_TableRowDeletedCallback :: 
    GObject a => (a -> TableRowDeletedCallback) ->
    C_TableRowDeletedCallback
wrap_TableRowDeletedCallback :: forall a.
GObject a =>
(a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
wrap_TableRowDeletedCallback a -> TableColumnDeletedCallback
gi'cb Ptr Table
gi'selfPtr Int32
arg1 Int32
arg2 Ptr ()
_ = do
    Ptr Table -> (Table -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Table
gi'selfPtr ((Table -> IO ()) -> IO ()) -> (Table -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Table
gi'self -> a -> TableColumnDeletedCallback
gi'cb (Table -> a
Coerce.coerce Table
gi'self)  Int32
arg1 Int32
arg2


-- | Connect a signal handler for the [rowDeleted](#signal:rowDeleted) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' table #rowDeleted callback
-- @
-- 
-- 
onTableRowDeleted :: (IsTable a, MonadIO m) => a -> ((?self :: a) => TableRowDeletedCallback) -> m SignalHandlerId
onTableRowDeleted :: forall a (m :: * -> *).
(IsTable a, MonadIO m) =>
a
-> ((?self::a) => TableColumnDeletedCallback) -> m SignalHandlerId
onTableRowDeleted a
obj (?self::a) => TableColumnDeletedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TableColumnDeletedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TableColumnDeletedCallback
TableColumnDeletedCallback
cb
    let wrapped' :: C_TableColumnDeletedCallback
wrapped' = (a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
forall a.
GObject a =>
(a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
wrap_TableRowDeletedCallback a -> TableColumnDeletedCallback
wrapped
    FunPtr C_TableColumnDeletedCallback
wrapped'' <- C_TableColumnDeletedCallback
-> IO (FunPtr C_TableColumnDeletedCallback)
mk_TableRowDeletedCallback C_TableColumnDeletedCallback
wrapped'
    a
-> Text
-> FunPtr C_TableColumnDeletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"row-deleted" FunPtr C_TableColumnDeletedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [rowDeleted](#signal:rowDeleted) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' table #rowDeleted callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTableRowDeleted :: (IsTable a, MonadIO m) => a -> ((?self :: a) => TableRowDeletedCallback) -> m SignalHandlerId
afterTableRowDeleted :: forall a (m :: * -> *).
(IsTable a, MonadIO m) =>
a
-> ((?self::a) => TableColumnDeletedCallback) -> m SignalHandlerId
afterTableRowDeleted a
obj (?self::a) => TableColumnDeletedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TableColumnDeletedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TableColumnDeletedCallback
TableColumnDeletedCallback
cb
    let wrapped' :: C_TableColumnDeletedCallback
wrapped' = (a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
forall a.
GObject a =>
(a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
wrap_TableRowDeletedCallback a -> TableColumnDeletedCallback
wrapped
    FunPtr C_TableColumnDeletedCallback
wrapped'' <- C_TableColumnDeletedCallback
-> IO (FunPtr C_TableColumnDeletedCallback)
mk_TableRowDeletedCallback C_TableColumnDeletedCallback
wrapped'
    a
-> Text
-> FunPtr C_TableColumnDeletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"row-deleted" FunPtr C_TableColumnDeletedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TableRowDeletedSignalInfo
instance SignalInfo TableRowDeletedSignalInfo where
    type HaskellCallbackType TableRowDeletedSignalInfo = TableRowDeletedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TableRowDeletedCallback cb
        cb'' <- mk_TableRowDeletedCallback cb'
        connectSignalFunPtr obj "row-deleted" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table::row-deleted"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#g:signal:rowDeleted"})

#endif

-- signal Table::row-inserted
-- | The \"row-inserted\" signal is emitted by an object which
-- implements the AtkTable interface when a row is inserted.
type TableRowInsertedCallback =
    Int32
    -- ^ /@arg1@/: The index of the first row inserted.
    -> Int32
    -- ^ /@arg2@/: The number of rows inserted.
    -> IO ()

type C_TableRowInsertedCallback =
    Ptr Table ->                            -- object
    Int32 ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_TableRowInsertedCallback :: 
    GObject a => (a -> TableRowInsertedCallback) ->
    C_TableRowInsertedCallback
wrap_TableRowInsertedCallback :: forall a.
GObject a =>
(a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
wrap_TableRowInsertedCallback a -> TableColumnDeletedCallback
gi'cb Ptr Table
gi'selfPtr Int32
arg1 Int32
arg2 Ptr ()
_ = do
    Ptr Table -> (Table -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Table
gi'selfPtr ((Table -> IO ()) -> IO ()) -> (Table -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Table
gi'self -> a -> TableColumnDeletedCallback
gi'cb (Table -> a
Coerce.coerce Table
gi'self)  Int32
arg1 Int32
arg2


-- | Connect a signal handler for the [rowInserted](#signal:rowInserted) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' table #rowInserted callback
-- @
-- 
-- 
onTableRowInserted :: (IsTable a, MonadIO m) => a -> ((?self :: a) => TableRowInsertedCallback) -> m SignalHandlerId
onTableRowInserted :: forall a (m :: * -> *).
(IsTable a, MonadIO m) =>
a
-> ((?self::a) => TableColumnDeletedCallback) -> m SignalHandlerId
onTableRowInserted a
obj (?self::a) => TableColumnDeletedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TableColumnDeletedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TableColumnDeletedCallback
TableColumnDeletedCallback
cb
    let wrapped' :: C_TableColumnDeletedCallback
wrapped' = (a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
forall a.
GObject a =>
(a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
wrap_TableRowInsertedCallback a -> TableColumnDeletedCallback
wrapped
    FunPtr C_TableColumnDeletedCallback
wrapped'' <- C_TableColumnDeletedCallback
-> IO (FunPtr C_TableColumnDeletedCallback)
mk_TableRowInsertedCallback C_TableColumnDeletedCallback
wrapped'
    a
-> Text
-> FunPtr C_TableColumnDeletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"row-inserted" FunPtr C_TableColumnDeletedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [rowInserted](#signal:rowInserted) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' table #rowInserted callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTableRowInserted :: (IsTable a, MonadIO m) => a -> ((?self :: a) => TableRowInsertedCallback) -> m SignalHandlerId
afterTableRowInserted :: forall a (m :: * -> *).
(IsTable a, MonadIO m) =>
a
-> ((?self::a) => TableColumnDeletedCallback) -> m SignalHandlerId
afterTableRowInserted a
obj (?self::a) => TableColumnDeletedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> TableColumnDeletedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => TableColumnDeletedCallback
TableColumnDeletedCallback
cb
    let wrapped' :: C_TableColumnDeletedCallback
wrapped' = (a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
forall a.
GObject a =>
(a -> TableColumnDeletedCallback) -> C_TableColumnDeletedCallback
wrap_TableRowInsertedCallback a -> TableColumnDeletedCallback
wrapped
    FunPtr C_TableColumnDeletedCallback
wrapped'' <- C_TableColumnDeletedCallback
-> IO (FunPtr C_TableColumnDeletedCallback)
mk_TableRowInsertedCallback C_TableColumnDeletedCallback
wrapped'
    a
-> Text
-> FunPtr C_TableColumnDeletedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"row-inserted" FunPtr C_TableColumnDeletedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TableRowInsertedSignalInfo
instance SignalInfo TableRowInsertedSignalInfo where
    type HaskellCallbackType TableRowInsertedSignalInfo = TableRowInsertedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TableRowInsertedCallback cb
        cb'' <- mk_TableRowInsertedCallback cb'
        connectSignalFunPtr obj "row-inserted" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table::row-inserted"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#g:signal:rowInserted"})

#endif

-- signal Table::row-reordered
-- | The \"row-reordered\" signal is emitted by an object which
-- implements the AtkTable interface when the rows are
-- reordered.
type TableRowReorderedCallback =
    IO ()

type C_TableRowReorderedCallback =
    Ptr Table ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_TableRowReorderedCallback :: 
    GObject a => (a -> TableRowReorderedCallback) ->
    C_TableRowReorderedCallback
wrap_TableRowReorderedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_TableColumnReorderedCallback
wrap_TableRowReorderedCallback a -> IO ()
gi'cb Ptr Table
gi'selfPtr Ptr ()
_ = do
    Ptr Table -> (Table -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Table
gi'selfPtr ((Table -> IO ()) -> IO ()) -> (Table -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Table
gi'self -> a -> IO ()
gi'cb (Table -> a
Coerce.coerce Table
gi'self) 


-- | Connect a signal handler for the [rowReordered](#signal:rowReordered) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' table #rowReordered callback
-- @
-- 
-- 
onTableRowReordered :: (IsTable a, MonadIO m) => a -> ((?self :: a) => TableRowReorderedCallback) -> m SignalHandlerId
onTableRowReordered :: forall a (m :: * -> *).
(IsTable a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onTableRowReordered a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TableColumnReorderedCallback
wrapped' = (a -> IO ()) -> C_TableColumnReorderedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_TableColumnReorderedCallback
wrap_TableRowReorderedCallback a -> IO ()
wrapped
    FunPtr C_TableColumnReorderedCallback
wrapped'' <- C_TableColumnReorderedCallback
-> IO (FunPtr C_TableColumnReorderedCallback)
mk_TableRowReorderedCallback C_TableColumnReorderedCallback
wrapped'
    a
-> Text
-> FunPtr C_TableColumnReorderedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"row-reordered" FunPtr C_TableColumnReorderedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [rowReordered](#signal:rowReordered) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' table #rowReordered callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterTableRowReordered :: (IsTable a, MonadIO m) => a -> ((?self :: a) => TableRowReorderedCallback) -> m SignalHandlerId
afterTableRowReordered :: forall a (m :: * -> *).
(IsTable a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterTableRowReordered a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_TableColumnReorderedCallback
wrapped' = (a -> IO ()) -> C_TableColumnReorderedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_TableColumnReorderedCallback
wrap_TableRowReorderedCallback a -> IO ()
wrapped
    FunPtr C_TableColumnReorderedCallback
wrapped'' <- C_TableColumnReorderedCallback
-> IO (FunPtr C_TableColumnReorderedCallback)
mk_TableRowReorderedCallback C_TableColumnReorderedCallback
wrapped'
    a
-> Text
-> FunPtr C_TableColumnReorderedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"row-reordered" FunPtr C_TableColumnReorderedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data TableRowReorderedSignalInfo
instance SignalInfo TableRowReorderedSignalInfo where
    type HaskellCallbackType TableRowReorderedSignalInfo = TableRowReorderedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_TableRowReorderedCallback cb
        cb'' <- mk_TableRowReorderedCallback cb'
        connectSignalFunPtr obj "row-reordered" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Table::row-reordered"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.24/docs/GI-Atk-Interfaces-Table.html#g:signal:rowReordered"})

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Table = TableSignalList
type TableSignalList = ('[ '("columnDeleted", TableColumnDeletedSignalInfo), '("columnInserted", TableColumnInsertedSignalInfo), '("columnReordered", TableColumnReorderedSignalInfo), '("modelChanged", TableModelChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("rowDeleted", TableRowDeletedSignalInfo), '("rowInserted", TableRowInsertedSignalInfo), '("rowReordered", TableRowReorderedSignalInfo)] :: [(Symbol, *)])

#endif