{-# 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.Selection.Selection' should be implemented by UI components with children
-- which are exposed by @/atk_object_ref_child/@ and
-- @/atk_object_get_n_children/@, if the use of the parent UI component
-- ordinarily involves selection of one or more of the objects
-- corresponding to those t'GI.Atk.Objects.Object.Object' children - for example,
-- selectable lists.
-- 
-- Note that other types of \"selection\" (for instance text selection)
-- are accomplished a other ATK interfaces - t'GI.Atk.Interfaces.Selection.Selection' is limited
-- to the selection\/deselection of children.

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

module GI.Atk.Interfaces.Selection
    ( 

-- * Exported types
    Selection(..)                           ,
    IsSelection                             ,
    toSelection                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addSelection]("GI.Atk.Interfaces.Selection#g:method:addSelection"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [clearSelection]("GI.Atk.Interfaces.Selection#g:method:clearSelection"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isChildSelected]("GI.Atk.Interfaces.Selection#g:method:isChildSelected"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSelection]("GI.Atk.Interfaces.Selection#g:method:refSelection"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeSelection]("GI.Atk.Interfaces.Selection#g:method:removeSelection"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [selectAllSelection]("GI.Atk.Interfaces.Selection#g:method:selectAllSelection"), [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
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSelectionCount]("GI.Atk.Interfaces.Selection#g:method:getSelectionCount").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveSelectionMethod                  ,
#endif

-- ** addSelection #method:addSelection#

#if defined(ENABLE_OVERLOADING)
    SelectionAddSelectionMethodInfo         ,
#endif
    selectionAddSelection                   ,


-- ** clearSelection #method:clearSelection#

#if defined(ENABLE_OVERLOADING)
    SelectionClearSelectionMethodInfo       ,
#endif
    selectionClearSelection                 ,


-- ** getSelectionCount #method:getSelectionCount#

#if defined(ENABLE_OVERLOADING)
    SelectionGetSelectionCountMethodInfo    ,
#endif
    selectionGetSelectionCount              ,


-- ** isChildSelected #method:isChildSelected#

#if defined(ENABLE_OVERLOADING)
    SelectionIsChildSelectedMethodInfo      ,
#endif
    selectionIsChildSelected                ,


-- ** refSelection #method:refSelection#

#if defined(ENABLE_OVERLOADING)
    SelectionRefSelectionMethodInfo         ,
#endif
    selectionRefSelection                   ,


-- ** removeSelection #method:removeSelection#

#if defined(ENABLE_OVERLOADING)
    SelectionRemoveSelectionMethodInfo      ,
#endif
    selectionRemoveSelection                ,


-- ** selectAllSelection #method:selectAllSelection#

#if defined(ENABLE_OVERLOADING)
    SelectionSelectAllSelectionMethodInfo   ,
#endif
    selectionSelectAllSelection             ,




 -- * Signals


-- ** selectionChanged #signal:selectionChanged#

    SelectionSelectionChangedCallback       ,
#if defined(ENABLE_OVERLOADING)
    SelectionSelectionChangedSignalInfo     ,
#endif
    afterSelectionSelectionChanged          ,
    onSelectionSelectionChanged             ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.Atk.Objects.Object as Atk.Object
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "atk_selection_get_type"
    c_atk_selection_get_type :: IO B.Types.GType

instance B.Types.TypedObject Selection where
    glibType :: IO GType
glibType = IO GType
c_atk_selection_get_type

instance B.Types.GObject Selection

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSelectionMethod (t :: Symbol) (o :: *) :: * where
    ResolveSelectionMethod "addSelection" o = SelectionAddSelectionMethodInfo
    ResolveSelectionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSelectionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSelectionMethod "clearSelection" o = SelectionClearSelectionMethodInfo
    ResolveSelectionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSelectionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSelectionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSelectionMethod "isChildSelected" o = SelectionIsChildSelectedMethodInfo
    ResolveSelectionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSelectionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSelectionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSelectionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSelectionMethod "refSelection" o = SelectionRefSelectionMethodInfo
    ResolveSelectionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSelectionMethod "removeSelection" o = SelectionRemoveSelectionMethodInfo
    ResolveSelectionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSelectionMethod "selectAllSelection" o = SelectionSelectAllSelectionMethodInfo
    ResolveSelectionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSelectionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSelectionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSelectionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSelectionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSelectionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSelectionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSelectionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSelectionMethod "getSelectionCount" o = SelectionGetSelectionCountMethodInfo
    ResolveSelectionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSelectionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSelectionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSelectionMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- method Selection::add_selection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "selection"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "Selection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GObject instance that implements AtkSelectionIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "i"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint specifying the child index."
--                 , 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_selection_add_selection" atk_selection_add_selection :: 
    Ptr Selection ->                        -- selection : TInterface (Name {namespace = "Atk", name = "Selection"})
    Int32 ->                                -- i : TBasicType TInt
    IO CInt

-- | Adds the specified accessible child of the object to the
-- object\'s selection.
selectionAddSelection ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelection a) =>
    a
    -- ^ /@selection@/: a t'GI.GObject.Objects.Object.Object' instance that implements AtkSelectionIface
    -> Int32
    -- ^ /@i@/: a @/gint/@ specifying the child index.
    -> m Bool
    -- ^ __Returns:__ TRUE if success, FALSE otherwise.
selectionAddSelection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelection a) =>
a -> Int32 -> m Bool
selectionAddSelection a
selection Int32
i = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Selection
selection' <- a -> IO (Ptr Selection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
    CInt
result <- Ptr Selection -> Int32 -> IO CInt
atk_selection_add_selection Ptr Selection
selection' Int32
i
    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
selection
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

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


#endif

-- method Selection::clear_selection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "selection"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "Selection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GObject instance that implements AtkSelectionIface"
--                 , 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_selection_clear_selection" atk_selection_clear_selection :: 
    Ptr Selection ->                        -- selection : TInterface (Name {namespace = "Atk", name = "Selection"})
    IO CInt

-- | Clears the selection in the object so that no children in the object
-- are selected.
selectionClearSelection ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelection a) =>
    a
    -- ^ /@selection@/: a t'GI.GObject.Objects.Object.Object' instance that implements AtkSelectionIface
    -> m Bool
    -- ^ __Returns:__ TRUE if success, FALSE otherwise.
selectionClearSelection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelection a) =>
a -> m Bool
selectionClearSelection a
selection = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Selection
selection' <- a -> IO (Ptr Selection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
    CInt
result <- Ptr Selection -> IO CInt
atk_selection_clear_selection Ptr Selection
selection'
    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
selection
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SelectionClearSelectionMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSelection a) => O.OverloadedMethod SelectionClearSelectionMethodInfo a signature where
    overloadedMethod = selectionClearSelection

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


#endif

-- method Selection::get_selection_count
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "selection"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "Selection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GObject instance that implements AtkSelectionIface"
--                 , 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_selection_get_selection_count" atk_selection_get_selection_count :: 
    Ptr Selection ->                        -- selection : TInterface (Name {namespace = "Atk", name = "Selection"})
    IO Int32

-- | Gets the number of accessible children currently selected.
-- Note: callers should not rely on 'P.Nothing' or on a zero value for
-- indication of whether AtkSelectionIface is implemented, they should
-- use type checking\/interface checking macros or the
-- @/atk_get_accessible_value()/@ convenience method.
selectionGetSelectionCount ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelection a) =>
    a
    -- ^ /@selection@/: a t'GI.GObject.Objects.Object.Object' instance that implements AtkSelectionIface
    -> m Int32
    -- ^ __Returns:__ a gint representing the number of items selected, or 0
    -- if /@selection@/ does not implement this interface.
selectionGetSelectionCount :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelection a) =>
a -> m Int32
selectionGetSelectionCount a
selection = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Selection
selection' <- a -> IO (Ptr Selection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
    Int32
result <- Ptr Selection -> IO Int32
atk_selection_get_selection_count Ptr Selection
selection'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
selection
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data SelectionGetSelectionCountMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsSelection a) => O.OverloadedMethod SelectionGetSelectionCountMethodInfo a signature where
    overloadedMethod = selectionGetSelectionCount

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


#endif

-- method Selection::is_child_selected
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "selection"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "Selection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GObject instance that implements AtkSelectionIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "i"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gint specifying the child index."
--                 , 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_selection_is_child_selected" atk_selection_is_child_selected :: 
    Ptr Selection ->                        -- selection : TInterface (Name {namespace = "Atk", name = "Selection"})
    Int32 ->                                -- i : TBasicType TInt
    IO CInt

-- | Determines if the current child of this object is selected
-- Note: callers should not rely on 'P.Nothing' or on a zero value for
-- indication of whether AtkSelectionIface is implemented, they should
-- use type checking\/interface checking macros or the
-- @/atk_get_accessible_value()/@ convenience method.
selectionIsChildSelected ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelection a) =>
    a
    -- ^ /@selection@/: a t'GI.GObject.Objects.Object.Object' instance that implements AtkSelectionIface
    -> Int32
    -- ^ /@i@/: a @/gint/@ specifying the child index.
    -> m Bool
    -- ^ __Returns:__ a gboolean representing the specified child is selected, or 0
    -- if /@selection@/ does not implement this interface.
selectionIsChildSelected :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelection a) =>
a -> Int32 -> m Bool
selectionIsChildSelected a
selection Int32
i = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Selection
selection' <- a -> IO (Ptr Selection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
    CInt
result <- Ptr Selection -> Int32 -> IO CInt
atk_selection_is_child_selected Ptr Selection
selection' Int32
i
    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
selection
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

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


#endif

-- method Selection::ref_selection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "selection"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "Selection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GObject instance that implements AtkSelectionIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "i"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #gint specifying the index in the selection set.  (e.g. the\nith selection as opposed to the ith child)."
--                 , 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_selection_ref_selection" atk_selection_ref_selection :: 
    Ptr Selection ->                        -- selection : TInterface (Name {namespace = "Atk", name = "Selection"})
    Int32 ->                                -- i : TBasicType TInt
    IO (Ptr Atk.Object.Object)

-- | Gets a reference to the accessible object representing the specified
-- selected child of the object.
-- Note: callers should not rely on 'P.Nothing' or on a zero value for
-- indication of whether AtkSelectionIface is implemented, they should
-- use type checking\/interface checking macros or the
-- @/atk_get_accessible_value()/@ convenience method.
selectionRefSelection ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelection a) =>
    a
    -- ^ /@selection@/: a t'GI.GObject.Objects.Object.Object' instance that implements AtkSelectionIface
    -> Int32
    -- ^ /@i@/: a @/gint/@ specifying the index in the selection set.  (e.g. the
    -- ith selection as opposed to the ith child).
    -> m (Maybe Atk.Object.Object)
    -- ^ __Returns:__ an t'GI.Atk.Objects.Object.Object' representing the
    -- selected accessible, or 'P.Nothing' if /@selection@/ does not implement this
    -- interface.
selectionRefSelection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelection a) =>
a -> Int32 -> m (Maybe Object)
selectionRefSelection a
selection Int32
i = IO (Maybe Object) -> m (Maybe Object)
forall a. IO a -> m a
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 Selection
selection' <- a -> IO (Ptr Selection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
    Ptr Object
result <- Ptr Selection -> Int32 -> IO (Ptr Object)
atk_selection_ref_selection Ptr Selection
selection' Int32
i
    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
wrapObject ManagedPtr Object -> Object
Atk.Object.Object) Ptr Object
result'
        Object -> IO Object
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
selection
    Maybe Object -> IO (Maybe Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Object
maybeResult

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

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


#endif

-- method Selection::remove_selection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "selection"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "Selection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GObject instance that implements AtkSelectionIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "i"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #gint specifying the index in the selection set.  (e.g. the\nith selection as opposed to the ith child)."
--                 , 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_selection_remove_selection" atk_selection_remove_selection :: 
    Ptr Selection ->                        -- selection : TInterface (Name {namespace = "Atk", name = "Selection"})
    Int32 ->                                -- i : TBasicType TInt
    IO CInt

-- | Removes the specified child of the object from the object\'s selection.
selectionRemoveSelection ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelection a) =>
    a
    -- ^ /@selection@/: a t'GI.GObject.Objects.Object.Object' instance that implements AtkSelectionIface
    -> Int32
    -- ^ /@i@/: a @/gint/@ specifying the index in the selection set.  (e.g. the
    -- ith selection as opposed to the ith child).
    -> m Bool
    -- ^ __Returns:__ TRUE if success, FALSE otherwise.
selectionRemoveSelection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelection a) =>
a -> Int32 -> m Bool
selectionRemoveSelection a
selection Int32
i = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Selection
selection' <- a -> IO (Ptr Selection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
    CInt
result <- Ptr Selection -> Int32 -> IO CInt
atk_selection_remove_selection Ptr Selection
selection' Int32
i
    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
selection
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

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


#endif

-- method Selection::select_all_selection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "selection"
--           , argType =
--               TInterface Name { namespace = "Atk" , name = "Selection" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GObject instance that implements AtkSelectionIface"
--                 , 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_selection_select_all_selection" atk_selection_select_all_selection :: 
    Ptr Selection ->                        -- selection : TInterface (Name {namespace = "Atk", name = "Selection"})
    IO CInt

-- | Causes every child of the object to be selected if the object
-- supports multiple selections.
selectionSelectAllSelection ::
    (B.CallStack.HasCallStack, MonadIO m, IsSelection a) =>
    a
    -- ^ /@selection@/: a t'GI.GObject.Objects.Object.Object' instance that implements AtkSelectionIface
    -> m Bool
    -- ^ __Returns:__ TRUE if success, FALSE otherwise.
selectionSelectAllSelection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSelection a) =>
a -> m Bool
selectionSelectAllSelection a
selection = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Selection
selection' <- a -> IO (Ptr Selection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
    CInt
result <- Ptr Selection -> IO CInt
atk_selection_select_all_selection Ptr Selection
selection'
    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
selection
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SelectionSelectAllSelectionMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSelection a) => O.OverloadedMethod SelectionSelectAllSelectionMethodInfo a signature where
    overloadedMethod = selectionSelectAllSelection

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


#endif

-- signal Selection::selection-changed
-- | The \"selection-changed\" signal is emitted by an object which
-- implements AtkSelection interface when the selection changes.
type SelectionSelectionChangedCallback =
    IO ()

type C_SelectionSelectionChangedCallback =
    Ptr Selection ->                        -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_SelectionSelectionChangedCallback :: 
    GObject a => (a -> SelectionSelectionChangedCallback) ->
    C_SelectionSelectionChangedCallback
wrap_SelectionSelectionChangedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_SelectionSelectionChangedCallback
wrap_SelectionSelectionChangedCallback a -> IO ()
gi'cb Ptr Selection
gi'selfPtr Ptr ()
_ = do
    Ptr Selection -> (Selection -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Selection
gi'selfPtr ((Selection -> IO ()) -> IO ()) -> (Selection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Selection
gi'self -> a -> IO ()
gi'cb (Selection -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Selection
gi'self) 


-- | Connect a signal handler for the [selectionChanged](#signal:selectionChanged) 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' selection #selectionChanged callback
-- @
-- 
-- 
onSelectionSelectionChanged :: (IsSelection a, MonadIO m) => a -> ((?self :: a) => SelectionSelectionChangedCallback) -> m SignalHandlerId
onSelectionSelectionChanged :: forall a (m :: * -> *).
(IsSelection a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onSelectionSelectionChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_SelectionSelectionChangedCallback
wrapped' = (a -> IO ()) -> C_SelectionSelectionChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_SelectionSelectionChangedCallback
wrap_SelectionSelectionChangedCallback a -> IO ()
wrapped
    FunPtr C_SelectionSelectionChangedCallback
wrapped'' <- C_SelectionSelectionChangedCallback
-> IO (FunPtr C_SelectionSelectionChangedCallback)
mk_SelectionSelectionChangedCallback C_SelectionSelectionChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_SelectionSelectionChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"selection-changed" FunPtr C_SelectionSelectionChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [selectionChanged](#signal:selectionChanged) 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' selection #selectionChanged 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.
-- 
afterSelectionSelectionChanged :: (IsSelection a, MonadIO m) => a -> ((?self :: a) => SelectionSelectionChangedCallback) -> m SignalHandlerId
afterSelectionSelectionChanged :: forall a (m :: * -> *).
(IsSelection a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterSelectionSelectionChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_SelectionSelectionChangedCallback
wrapped' = (a -> IO ()) -> C_SelectionSelectionChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_SelectionSelectionChangedCallback
wrap_SelectionSelectionChangedCallback a -> IO ()
wrapped
    FunPtr C_SelectionSelectionChangedCallback
wrapped'' <- C_SelectionSelectionChangedCallback
-> IO (FunPtr C_SelectionSelectionChangedCallback)
mk_SelectionSelectionChangedCallback C_SelectionSelectionChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_SelectionSelectionChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"selection-changed" FunPtr C_SelectionSelectionChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data SelectionSelectionChangedSignalInfo
instance SignalInfo SelectionSelectionChangedSignalInfo where
    type HaskellCallbackType SelectionSelectionChangedSignalInfo = SelectionSelectionChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_SelectionSelectionChangedCallback cb
        cb'' <- mk_SelectionSelectionChangedCallback cb'
        connectSignalFunPtr obj "selection-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Atk.Interfaces.Selection::selection-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-atk-2.0.25/docs/GI-Atk-Interfaces-Selection.html#g:signal:selectionChanged"})

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Selection = SelectionSignalList
type SelectionSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo), '("selectionChanged", SelectionSelectionChangedSignalInfo)] :: [(Symbol, *)])

#endif