{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Gtk.Objects.ListBox
    ( 

-- * Exported types
    ListBox(..)                             ,
    ListBoxK                                ,
    toListBox                               ,
    noListBox                               ,


 -- * Methods
-- ** listBoxBindModel
    listBoxBindModel                        ,


-- ** listBoxDragHighlightRow
    listBoxDragHighlightRow                 ,


-- ** listBoxDragUnhighlightRow
    listBoxDragUnhighlightRow               ,


-- ** listBoxGetActivateOnSingleClick
    listBoxGetActivateOnSingleClick         ,


-- ** listBoxGetAdjustment
    listBoxGetAdjustment                    ,


-- ** listBoxGetRowAtIndex
    listBoxGetRowAtIndex                    ,


-- ** listBoxGetRowAtY
    listBoxGetRowAtY                        ,


-- ** listBoxGetSelectedRow
    listBoxGetSelectedRow                   ,


-- ** listBoxGetSelectedRows
    listBoxGetSelectedRows                  ,


-- ** listBoxGetSelectionMode
    listBoxGetSelectionMode                 ,


-- ** listBoxInsert
    listBoxInsert                           ,


-- ** listBoxInvalidateFilter
    listBoxInvalidateFilter                 ,


-- ** listBoxInvalidateHeaders
    listBoxInvalidateHeaders                ,


-- ** listBoxInvalidateSort
    listBoxInvalidateSort                   ,


-- ** listBoxNew
    listBoxNew                              ,


-- ** listBoxPrepend
    listBoxPrepend                          ,


-- ** listBoxSelectAll
    listBoxSelectAll                        ,


-- ** listBoxSelectRow
    listBoxSelectRow                        ,


-- ** listBoxSelectedForeach
    listBoxSelectedForeach                  ,


-- ** listBoxSetActivateOnSingleClick
    listBoxSetActivateOnSingleClick         ,


-- ** listBoxSetAdjustment
    listBoxSetAdjustment                    ,


-- ** listBoxSetFilterFunc
    listBoxSetFilterFunc                    ,


-- ** listBoxSetHeaderFunc
    listBoxSetHeaderFunc                    ,


-- ** listBoxSetPlaceholder
    listBoxSetPlaceholder                   ,


-- ** listBoxSetSelectionMode
    listBoxSetSelectionMode                 ,


-- ** listBoxSetSortFunc
    listBoxSetSortFunc                      ,


-- ** listBoxUnselectAll
    listBoxUnselectAll                      ,


-- ** listBoxUnselectRow
    listBoxUnselectRow                      ,




 -- * Properties
-- ** ActivateOnSingleClick
    ListBoxActivateOnSingleClickPropertyInfo,
    constructListBoxActivateOnSingleClick   ,
    getListBoxActivateOnSingleClick         ,
    setListBoxActivateOnSingleClick         ,


-- ** SelectionMode
    ListBoxSelectionModePropertyInfo        ,
    constructListBoxSelectionMode           ,
    getListBoxSelectionMode                 ,
    setListBoxSelectionMode                 ,




 -- * Signals
-- ** ActivateCursorRow
    ListBoxActivateCursorRowCallback        ,
    ListBoxActivateCursorRowCallbackC       ,
    ListBoxActivateCursorRowSignalInfo      ,
    afterListBoxActivateCursorRow           ,
    listBoxActivateCursorRowCallbackWrapper ,
    listBoxActivateCursorRowClosure         ,
    mkListBoxActivateCursorRowCallback      ,
    noListBoxActivateCursorRowCallback      ,
    onListBoxActivateCursorRow              ,


-- ** MoveCursor
    ListBoxMoveCursorCallback               ,
    ListBoxMoveCursorCallbackC              ,
    ListBoxMoveCursorSignalInfo             ,
    afterListBoxMoveCursor                  ,
    listBoxMoveCursorCallbackWrapper        ,
    listBoxMoveCursorClosure                ,
    mkListBoxMoveCursorCallback             ,
    noListBoxMoveCursorCallback             ,
    onListBoxMoveCursor                     ,


-- ** RowActivated
    ListBoxRowActivatedCallback             ,
    ListBoxRowActivatedCallbackC            ,
    ListBoxRowActivatedSignalInfo           ,
    afterListBoxRowActivated                ,
    listBoxRowActivatedCallbackWrapper      ,
    listBoxRowActivatedClosure              ,
    mkListBoxRowActivatedCallback           ,
    noListBoxRowActivatedCallback           ,
    onListBoxRowActivated                   ,


-- ** RowSelected
    ListBoxRowSelectedCallback              ,
    ListBoxRowSelectedCallbackC             ,
    ListBoxRowSelectedSignalInfo            ,
    afterListBoxRowSelected                 ,
    listBoxRowSelectedCallbackWrapper       ,
    listBoxRowSelectedClosure               ,
    mkListBoxRowSelectedCallback            ,
    noListBoxRowSelectedCallback            ,
    onListBoxRowSelected                    ,


-- ** SelectAll
    ListBoxSelectAllCallback                ,
    ListBoxSelectAllCallbackC               ,
    ListBoxSelectAllSignalInfo              ,
    afterListBoxSelectAll                   ,
    listBoxSelectAllCallbackWrapper         ,
    listBoxSelectAllClosure                 ,
    mkListBoxSelectAllCallback              ,
    noListBoxSelectAllCallback              ,
    onListBoxSelectAll                      ,


-- ** SelectedRowsChanged
    ListBoxSelectedRowsChangedCallback      ,
    ListBoxSelectedRowsChangedCallbackC     ,
    ListBoxSelectedRowsChangedSignalInfo    ,
    afterListBoxSelectedRowsChanged         ,
    listBoxSelectedRowsChangedCallbackWrapper,
    listBoxSelectedRowsChangedClosure       ,
    mkListBoxSelectedRowsChangedCallback    ,
    noListBoxSelectedRowsChangedCallback    ,
    onListBoxSelectedRowsChanged            ,


-- ** ToggleCursorRow
    ListBoxToggleCursorRowCallback          ,
    ListBoxToggleCursorRowCallbackC         ,
    ListBoxToggleCursorRowSignalInfo        ,
    afterListBoxToggleCursorRow             ,
    listBoxToggleCursorRowCallbackWrapper   ,
    listBoxToggleCursorRowClosure           ,
    mkListBoxToggleCursorRowCallback        ,
    noListBoxToggleCursorRowCallback        ,
    onListBoxToggleCursorRow                ,


-- ** UnselectAll
    ListBoxUnselectAllCallback              ,
    ListBoxUnselectAllCallbackC             ,
    ListBoxUnselectAllSignalInfo            ,
    afterListBoxUnselectAll                 ,
    listBoxUnselectAllCallbackWrapper       ,
    listBoxUnselectAllClosure               ,
    mkListBoxUnselectAllCallback            ,
    noListBoxUnselectAllCallback            ,
    onListBoxUnselectAll                    ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gtk.Types
import GI.Gtk.Callbacks
import qualified GI.Atk as Atk
import qualified GI.GLib as GLib
import qualified GI.GObject as GObject
import qualified GI.Gio as Gio

newtype ListBox = ListBox (ForeignPtr ListBox)
foreign import ccall "gtk_list_box_get_type"
    c_gtk_list_box_get_type :: IO GType

type instance ParentTypes ListBox = ListBoxParentTypes
type ListBoxParentTypes = '[Container, Widget, GObject.Object, Atk.ImplementorIface, Buildable]

instance GObject ListBox where
    gobjectIsInitiallyUnowned _ = True
    gobjectType _ = c_gtk_list_box_get_type
    

class GObject o => ListBoxK o
instance (GObject o, IsDescendantOf ListBox o) => ListBoxK o

toListBox :: ListBoxK o => o -> IO ListBox
toListBox = unsafeCastTo ListBox

noListBox :: Maybe ListBox
noListBox = Nothing

-- signal ListBox::activate-cursor-row
type ListBoxActivateCursorRowCallback =
    IO ()

noListBoxActivateCursorRowCallback :: Maybe ListBoxActivateCursorRowCallback
noListBoxActivateCursorRowCallback = Nothing

type ListBoxActivateCursorRowCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkListBoxActivateCursorRowCallback :: ListBoxActivateCursorRowCallbackC -> IO (FunPtr ListBoxActivateCursorRowCallbackC)

listBoxActivateCursorRowClosure :: ListBoxActivateCursorRowCallback -> IO Closure
listBoxActivateCursorRowClosure cb = newCClosure =<< mkListBoxActivateCursorRowCallback wrapped
    where wrapped = listBoxActivateCursorRowCallbackWrapper cb

listBoxActivateCursorRowCallbackWrapper ::
    ListBoxActivateCursorRowCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
listBoxActivateCursorRowCallbackWrapper _cb _ _ = do
    _cb 

onListBoxActivateCursorRow :: (GObject a, MonadIO m) => a -> ListBoxActivateCursorRowCallback -> m SignalHandlerId
onListBoxActivateCursorRow obj cb = liftIO $ connectListBoxActivateCursorRow obj cb SignalConnectBefore
afterListBoxActivateCursorRow :: (GObject a, MonadIO m) => a -> ListBoxActivateCursorRowCallback -> m SignalHandlerId
afterListBoxActivateCursorRow obj cb = connectListBoxActivateCursorRow obj cb SignalConnectAfter

connectListBoxActivateCursorRow :: (GObject a, MonadIO m) =>
                                   a -> ListBoxActivateCursorRowCallback -> SignalConnectMode -> m SignalHandlerId
connectListBoxActivateCursorRow obj cb after = liftIO $ do
    cb' <- mkListBoxActivateCursorRowCallback (listBoxActivateCursorRowCallbackWrapper cb)
    connectSignalFunPtr obj "activate-cursor-row" cb' after

-- signal ListBox::move-cursor
type ListBoxMoveCursorCallback =
    MovementStep ->
    Int32 ->
    IO ()

noListBoxMoveCursorCallback :: Maybe ListBoxMoveCursorCallback
noListBoxMoveCursorCallback = Nothing

type ListBoxMoveCursorCallbackC =
    Ptr () ->                               -- object
    CUInt ->
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkListBoxMoveCursorCallback :: ListBoxMoveCursorCallbackC -> IO (FunPtr ListBoxMoveCursorCallbackC)

listBoxMoveCursorClosure :: ListBoxMoveCursorCallback -> IO Closure
listBoxMoveCursorClosure cb = newCClosure =<< mkListBoxMoveCursorCallback wrapped
    where wrapped = listBoxMoveCursorCallbackWrapper cb

listBoxMoveCursorCallbackWrapper ::
    ListBoxMoveCursorCallback ->
    Ptr () ->
    CUInt ->
    Int32 ->
    Ptr () ->
    IO ()
listBoxMoveCursorCallbackWrapper _cb _ object p0 _ = do
    let object' = (toEnum . fromIntegral) object
    _cb  object' p0

onListBoxMoveCursor :: (GObject a, MonadIO m) => a -> ListBoxMoveCursorCallback -> m SignalHandlerId
onListBoxMoveCursor obj cb = liftIO $ connectListBoxMoveCursor obj cb SignalConnectBefore
afterListBoxMoveCursor :: (GObject a, MonadIO m) => a -> ListBoxMoveCursorCallback -> m SignalHandlerId
afterListBoxMoveCursor obj cb = connectListBoxMoveCursor obj cb SignalConnectAfter

connectListBoxMoveCursor :: (GObject a, MonadIO m) =>
                            a -> ListBoxMoveCursorCallback -> SignalConnectMode -> m SignalHandlerId
connectListBoxMoveCursor obj cb after = liftIO $ do
    cb' <- mkListBoxMoveCursorCallback (listBoxMoveCursorCallbackWrapper cb)
    connectSignalFunPtr obj "move-cursor" cb' after

-- signal ListBox::row-activated
type ListBoxRowActivatedCallback =
    ListBoxRow ->
    IO ()

noListBoxRowActivatedCallback :: Maybe ListBoxRowActivatedCallback
noListBoxRowActivatedCallback = Nothing

type ListBoxRowActivatedCallbackC =
    Ptr () ->                               -- object
    Ptr ListBoxRow ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkListBoxRowActivatedCallback :: ListBoxRowActivatedCallbackC -> IO (FunPtr ListBoxRowActivatedCallbackC)

listBoxRowActivatedClosure :: ListBoxRowActivatedCallback -> IO Closure
listBoxRowActivatedClosure cb = newCClosure =<< mkListBoxRowActivatedCallback wrapped
    where wrapped = listBoxRowActivatedCallbackWrapper cb

listBoxRowActivatedCallbackWrapper ::
    ListBoxRowActivatedCallback ->
    Ptr () ->
    Ptr ListBoxRow ->
    Ptr () ->
    IO ()
listBoxRowActivatedCallbackWrapper _cb _ row _ = do
    row' <- (newObject ListBoxRow) row
    _cb  row'

onListBoxRowActivated :: (GObject a, MonadIO m) => a -> ListBoxRowActivatedCallback -> m SignalHandlerId
onListBoxRowActivated obj cb = liftIO $ connectListBoxRowActivated obj cb SignalConnectBefore
afterListBoxRowActivated :: (GObject a, MonadIO m) => a -> ListBoxRowActivatedCallback -> m SignalHandlerId
afterListBoxRowActivated obj cb = connectListBoxRowActivated obj cb SignalConnectAfter

connectListBoxRowActivated :: (GObject a, MonadIO m) =>
                              a -> ListBoxRowActivatedCallback -> SignalConnectMode -> m SignalHandlerId
connectListBoxRowActivated obj cb after = liftIO $ do
    cb' <- mkListBoxRowActivatedCallback (listBoxRowActivatedCallbackWrapper cb)
    connectSignalFunPtr obj "row-activated" cb' after

-- signal ListBox::row-selected
type ListBoxRowSelectedCallback =
    Maybe ListBoxRow ->
    IO ()

noListBoxRowSelectedCallback :: Maybe ListBoxRowSelectedCallback
noListBoxRowSelectedCallback = Nothing

type ListBoxRowSelectedCallbackC =
    Ptr () ->                               -- object
    Ptr ListBoxRow ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkListBoxRowSelectedCallback :: ListBoxRowSelectedCallbackC -> IO (FunPtr ListBoxRowSelectedCallbackC)

listBoxRowSelectedClosure :: ListBoxRowSelectedCallback -> IO Closure
listBoxRowSelectedClosure cb = newCClosure =<< mkListBoxRowSelectedCallback wrapped
    where wrapped = listBoxRowSelectedCallbackWrapper cb

listBoxRowSelectedCallbackWrapper ::
    ListBoxRowSelectedCallback ->
    Ptr () ->
    Ptr ListBoxRow ->
    Ptr () ->
    IO ()
listBoxRowSelectedCallbackWrapper _cb _ row _ = do
    maybeRow <-
        if row == nullPtr
        then return Nothing
        else do
            row' <- (newObject ListBoxRow) row
            return $ Just row'
    _cb  maybeRow

onListBoxRowSelected :: (GObject a, MonadIO m) => a -> ListBoxRowSelectedCallback -> m SignalHandlerId
onListBoxRowSelected obj cb = liftIO $ connectListBoxRowSelected obj cb SignalConnectBefore
afterListBoxRowSelected :: (GObject a, MonadIO m) => a -> ListBoxRowSelectedCallback -> m SignalHandlerId
afterListBoxRowSelected obj cb = connectListBoxRowSelected obj cb SignalConnectAfter

connectListBoxRowSelected :: (GObject a, MonadIO m) =>
                             a -> ListBoxRowSelectedCallback -> SignalConnectMode -> m SignalHandlerId
connectListBoxRowSelected obj cb after = liftIO $ do
    cb' <- mkListBoxRowSelectedCallback (listBoxRowSelectedCallbackWrapper cb)
    connectSignalFunPtr obj "row-selected" cb' after

-- signal ListBox::select-all
type ListBoxSelectAllCallback =
    IO ()

noListBoxSelectAllCallback :: Maybe ListBoxSelectAllCallback
noListBoxSelectAllCallback = Nothing

type ListBoxSelectAllCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkListBoxSelectAllCallback :: ListBoxSelectAllCallbackC -> IO (FunPtr ListBoxSelectAllCallbackC)

listBoxSelectAllClosure :: ListBoxSelectAllCallback -> IO Closure
listBoxSelectAllClosure cb = newCClosure =<< mkListBoxSelectAllCallback wrapped
    where wrapped = listBoxSelectAllCallbackWrapper cb

listBoxSelectAllCallbackWrapper ::
    ListBoxSelectAllCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
listBoxSelectAllCallbackWrapper _cb _ _ = do
    _cb 

onListBoxSelectAll :: (GObject a, MonadIO m) => a -> ListBoxSelectAllCallback -> m SignalHandlerId
onListBoxSelectAll obj cb = liftIO $ connectListBoxSelectAll obj cb SignalConnectBefore
afterListBoxSelectAll :: (GObject a, MonadIO m) => a -> ListBoxSelectAllCallback -> m SignalHandlerId
afterListBoxSelectAll obj cb = connectListBoxSelectAll obj cb SignalConnectAfter

connectListBoxSelectAll :: (GObject a, MonadIO m) =>
                           a -> ListBoxSelectAllCallback -> SignalConnectMode -> m SignalHandlerId
connectListBoxSelectAll obj cb after = liftIO $ do
    cb' <- mkListBoxSelectAllCallback (listBoxSelectAllCallbackWrapper cb)
    connectSignalFunPtr obj "select-all" cb' after

-- signal ListBox::selected-rows-changed
type ListBoxSelectedRowsChangedCallback =
    IO ()

noListBoxSelectedRowsChangedCallback :: Maybe ListBoxSelectedRowsChangedCallback
noListBoxSelectedRowsChangedCallback = Nothing

type ListBoxSelectedRowsChangedCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkListBoxSelectedRowsChangedCallback :: ListBoxSelectedRowsChangedCallbackC -> IO (FunPtr ListBoxSelectedRowsChangedCallbackC)

listBoxSelectedRowsChangedClosure :: ListBoxSelectedRowsChangedCallback -> IO Closure
listBoxSelectedRowsChangedClosure cb = newCClosure =<< mkListBoxSelectedRowsChangedCallback wrapped
    where wrapped = listBoxSelectedRowsChangedCallbackWrapper cb

listBoxSelectedRowsChangedCallbackWrapper ::
    ListBoxSelectedRowsChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
listBoxSelectedRowsChangedCallbackWrapper _cb _ _ = do
    _cb 

onListBoxSelectedRowsChanged :: (GObject a, MonadIO m) => a -> ListBoxSelectedRowsChangedCallback -> m SignalHandlerId
onListBoxSelectedRowsChanged obj cb = liftIO $ connectListBoxSelectedRowsChanged obj cb SignalConnectBefore
afterListBoxSelectedRowsChanged :: (GObject a, MonadIO m) => a -> ListBoxSelectedRowsChangedCallback -> m SignalHandlerId
afterListBoxSelectedRowsChanged obj cb = connectListBoxSelectedRowsChanged obj cb SignalConnectAfter

connectListBoxSelectedRowsChanged :: (GObject a, MonadIO m) =>
                                     a -> ListBoxSelectedRowsChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectListBoxSelectedRowsChanged obj cb after = liftIO $ do
    cb' <- mkListBoxSelectedRowsChangedCallback (listBoxSelectedRowsChangedCallbackWrapper cb)
    connectSignalFunPtr obj "selected-rows-changed" cb' after

-- signal ListBox::toggle-cursor-row
type ListBoxToggleCursorRowCallback =
    IO ()

noListBoxToggleCursorRowCallback :: Maybe ListBoxToggleCursorRowCallback
noListBoxToggleCursorRowCallback = Nothing

type ListBoxToggleCursorRowCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkListBoxToggleCursorRowCallback :: ListBoxToggleCursorRowCallbackC -> IO (FunPtr ListBoxToggleCursorRowCallbackC)

listBoxToggleCursorRowClosure :: ListBoxToggleCursorRowCallback -> IO Closure
listBoxToggleCursorRowClosure cb = newCClosure =<< mkListBoxToggleCursorRowCallback wrapped
    where wrapped = listBoxToggleCursorRowCallbackWrapper cb

listBoxToggleCursorRowCallbackWrapper ::
    ListBoxToggleCursorRowCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
listBoxToggleCursorRowCallbackWrapper _cb _ _ = do
    _cb 

onListBoxToggleCursorRow :: (GObject a, MonadIO m) => a -> ListBoxToggleCursorRowCallback -> m SignalHandlerId
onListBoxToggleCursorRow obj cb = liftIO $ connectListBoxToggleCursorRow obj cb SignalConnectBefore
afterListBoxToggleCursorRow :: (GObject a, MonadIO m) => a -> ListBoxToggleCursorRowCallback -> m SignalHandlerId
afterListBoxToggleCursorRow obj cb = connectListBoxToggleCursorRow obj cb SignalConnectAfter

connectListBoxToggleCursorRow :: (GObject a, MonadIO m) =>
                                 a -> ListBoxToggleCursorRowCallback -> SignalConnectMode -> m SignalHandlerId
connectListBoxToggleCursorRow obj cb after = liftIO $ do
    cb' <- mkListBoxToggleCursorRowCallback (listBoxToggleCursorRowCallbackWrapper cb)
    connectSignalFunPtr obj "toggle-cursor-row" cb' after

-- signal ListBox::unselect-all
type ListBoxUnselectAllCallback =
    IO ()

noListBoxUnselectAllCallback :: Maybe ListBoxUnselectAllCallback
noListBoxUnselectAllCallback = Nothing

type ListBoxUnselectAllCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkListBoxUnselectAllCallback :: ListBoxUnselectAllCallbackC -> IO (FunPtr ListBoxUnselectAllCallbackC)

listBoxUnselectAllClosure :: ListBoxUnselectAllCallback -> IO Closure
listBoxUnselectAllClosure cb = newCClosure =<< mkListBoxUnselectAllCallback wrapped
    where wrapped = listBoxUnselectAllCallbackWrapper cb

listBoxUnselectAllCallbackWrapper ::
    ListBoxUnselectAllCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
listBoxUnselectAllCallbackWrapper _cb _ _ = do
    _cb 

onListBoxUnselectAll :: (GObject a, MonadIO m) => a -> ListBoxUnselectAllCallback -> m SignalHandlerId
onListBoxUnselectAll obj cb = liftIO $ connectListBoxUnselectAll obj cb SignalConnectBefore
afterListBoxUnselectAll :: (GObject a, MonadIO m) => a -> ListBoxUnselectAllCallback -> m SignalHandlerId
afterListBoxUnselectAll obj cb = connectListBoxUnselectAll obj cb SignalConnectAfter

connectListBoxUnselectAll :: (GObject a, MonadIO m) =>
                             a -> ListBoxUnselectAllCallback -> SignalConnectMode -> m SignalHandlerId
connectListBoxUnselectAll obj cb after = liftIO $ do
    cb' <- mkListBoxUnselectAllCallback (listBoxUnselectAllCallbackWrapper cb)
    connectSignalFunPtr obj "unselect-all" cb' after

-- VVV Prop "activate-on-single-click"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getListBoxActivateOnSingleClick :: (MonadIO m, ListBoxK o) => o -> m Bool
getListBoxActivateOnSingleClick obj = liftIO $ getObjectPropertyBool obj "activate-on-single-click"

setListBoxActivateOnSingleClick :: (MonadIO m, ListBoxK o) => o -> Bool -> m ()
setListBoxActivateOnSingleClick obj val = liftIO $ setObjectPropertyBool obj "activate-on-single-click" val

constructListBoxActivateOnSingleClick :: Bool -> IO ([Char], GValue)
constructListBoxActivateOnSingleClick val = constructObjectPropertyBool "activate-on-single-click" val

data ListBoxActivateOnSingleClickPropertyInfo
instance AttrInfo ListBoxActivateOnSingleClickPropertyInfo where
    type AttrAllowedOps ListBoxActivateOnSingleClickPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ListBoxActivateOnSingleClickPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint ListBoxActivateOnSingleClickPropertyInfo = ListBoxK
    type AttrGetType ListBoxActivateOnSingleClickPropertyInfo = Bool
    type AttrLabel ListBoxActivateOnSingleClickPropertyInfo = "ListBox::activate-on-single-click"
    attrGet _ = getListBoxActivateOnSingleClick
    attrSet _ = setListBoxActivateOnSingleClick
    attrConstruct _ = constructListBoxActivateOnSingleClick

-- VVV Prop "selection-mode"
   -- Type: TInterface "Gtk" "SelectionMode"
   -- Flags: [PropertyReadable,PropertyWritable]

getListBoxSelectionMode :: (MonadIO m, ListBoxK o) => o -> m SelectionMode
getListBoxSelectionMode obj = liftIO $ getObjectPropertyEnum obj "selection-mode"

setListBoxSelectionMode :: (MonadIO m, ListBoxK o) => o -> SelectionMode -> m ()
setListBoxSelectionMode obj val = liftIO $ setObjectPropertyEnum obj "selection-mode" val

constructListBoxSelectionMode :: SelectionMode -> IO ([Char], GValue)
constructListBoxSelectionMode val = constructObjectPropertyEnum "selection-mode" val

data ListBoxSelectionModePropertyInfo
instance AttrInfo ListBoxSelectionModePropertyInfo where
    type AttrAllowedOps ListBoxSelectionModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ListBoxSelectionModePropertyInfo = (~) SelectionMode
    type AttrBaseTypeConstraint ListBoxSelectionModePropertyInfo = ListBoxK
    type AttrGetType ListBoxSelectionModePropertyInfo = SelectionMode
    type AttrLabel ListBoxSelectionModePropertyInfo = "ListBox::selection-mode"
    attrGet _ = getListBoxSelectionMode
    attrSet _ = setListBoxSelectionMode
    attrConstruct _ = constructListBoxSelectionMode

type instance AttributeList ListBox = ListBoxAttributeList
type ListBoxAttributeList = ('[ '("activate-on-single-click", ListBoxActivateOnSingleClickPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("selection-mode", ListBoxSelectionModePropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo)] :: [(Symbol, *)])

data ListBoxActivateCursorRowSignalInfo
instance SignalInfo ListBoxActivateCursorRowSignalInfo where
    type HaskellCallbackType ListBoxActivateCursorRowSignalInfo = ListBoxActivateCursorRowCallback
    connectSignal _ = connectListBoxActivateCursorRow

data ListBoxMoveCursorSignalInfo
instance SignalInfo ListBoxMoveCursorSignalInfo where
    type HaskellCallbackType ListBoxMoveCursorSignalInfo = ListBoxMoveCursorCallback
    connectSignal _ = connectListBoxMoveCursor

data ListBoxRowActivatedSignalInfo
instance SignalInfo ListBoxRowActivatedSignalInfo where
    type HaskellCallbackType ListBoxRowActivatedSignalInfo = ListBoxRowActivatedCallback
    connectSignal _ = connectListBoxRowActivated

data ListBoxRowSelectedSignalInfo
instance SignalInfo ListBoxRowSelectedSignalInfo where
    type HaskellCallbackType ListBoxRowSelectedSignalInfo = ListBoxRowSelectedCallback
    connectSignal _ = connectListBoxRowSelected

data ListBoxSelectAllSignalInfo
instance SignalInfo ListBoxSelectAllSignalInfo where
    type HaskellCallbackType ListBoxSelectAllSignalInfo = ListBoxSelectAllCallback
    connectSignal _ = connectListBoxSelectAll

data ListBoxSelectedRowsChangedSignalInfo
instance SignalInfo ListBoxSelectedRowsChangedSignalInfo where
    type HaskellCallbackType ListBoxSelectedRowsChangedSignalInfo = ListBoxSelectedRowsChangedCallback
    connectSignal _ = connectListBoxSelectedRowsChanged

data ListBoxToggleCursorRowSignalInfo
instance SignalInfo ListBoxToggleCursorRowSignalInfo where
    type HaskellCallbackType ListBoxToggleCursorRowSignalInfo = ListBoxToggleCursorRowCallback
    connectSignal _ = connectListBoxToggleCursorRow

data ListBoxUnselectAllSignalInfo
instance SignalInfo ListBoxUnselectAllSignalInfo where
    type HaskellCallbackType ListBoxUnselectAllSignalInfo = ListBoxUnselectAllCallback
    connectSignal _ = connectListBoxUnselectAll

type instance SignalList ListBox = ListBoxSignalList
type ListBoxSignalList = ('[ '("accel-closures-changed", WidgetAccelClosuresChangedSignalInfo), '("activate-cursor-row", ListBoxActivateCursorRowSignalInfo), '("add", ContainerAddSignalInfo), '("button-press-event", WidgetButtonPressEventSignalInfo), '("button-release-event", WidgetButtonReleaseEventSignalInfo), '("can-activate-accel", WidgetCanActivateAccelSignalInfo), '("check-resize", ContainerCheckResizeSignalInfo), '("child-notify", WidgetChildNotifySignalInfo), '("composited-changed", WidgetCompositedChangedSignalInfo), '("configure-event", WidgetConfigureEventSignalInfo), '("damage-event", WidgetDamageEventSignalInfo), '("delete-event", WidgetDeleteEventSignalInfo), '("destroy", WidgetDestroySignalInfo), '("destroy-event", WidgetDestroyEventSignalInfo), '("direction-changed", WidgetDirectionChangedSignalInfo), '("drag-begin", WidgetDragBeginSignalInfo), '("drag-data-delete", WidgetDragDataDeleteSignalInfo), '("drag-data-get", WidgetDragDataGetSignalInfo), '("drag-data-received", WidgetDragDataReceivedSignalInfo), '("drag-drop", WidgetDragDropSignalInfo), '("drag-end", WidgetDragEndSignalInfo), '("drag-failed", WidgetDragFailedSignalInfo), '("drag-leave", WidgetDragLeaveSignalInfo), '("drag-motion", WidgetDragMotionSignalInfo), '("draw", WidgetDrawSignalInfo), '("enter-notify-event", WidgetEnterNotifyEventSignalInfo), '("event", WidgetEventSignalInfo), '("event-after", WidgetEventAfterSignalInfo), '("focus", WidgetFocusSignalInfo), '("focus-in-event", WidgetFocusInEventSignalInfo), '("focus-out-event", WidgetFocusOutEventSignalInfo), '("grab-broken-event", WidgetGrabBrokenEventSignalInfo), '("grab-focus", WidgetGrabFocusSignalInfo), '("grab-notify", WidgetGrabNotifySignalInfo), '("hide", WidgetHideSignalInfo), '("hierarchy-changed", WidgetHierarchyChangedSignalInfo), '("key-press-event", WidgetKeyPressEventSignalInfo), '("key-release-event", WidgetKeyReleaseEventSignalInfo), '("keynav-failed", WidgetKeynavFailedSignalInfo), '("leave-notify-event", WidgetLeaveNotifyEventSignalInfo), '("map", WidgetMapSignalInfo), '("map-event", WidgetMapEventSignalInfo), '("mnemonic-activate", WidgetMnemonicActivateSignalInfo), '("motion-notify-event", WidgetMotionNotifyEventSignalInfo), '("move-cursor", ListBoxMoveCursorSignalInfo), '("move-focus", WidgetMoveFocusSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("parent-set", WidgetParentSetSignalInfo), '("popup-menu", WidgetPopupMenuSignalInfo), '("property-notify-event", WidgetPropertyNotifyEventSignalInfo), '("proximity-in-event", WidgetProximityInEventSignalInfo), '("proximity-out-event", WidgetProximityOutEventSignalInfo), '("query-tooltip", WidgetQueryTooltipSignalInfo), '("realize", WidgetRealizeSignalInfo), '("remove", ContainerRemoveSignalInfo), '("row-activated", ListBoxRowActivatedSignalInfo), '("row-selected", ListBoxRowSelectedSignalInfo), '("screen-changed", WidgetScreenChangedSignalInfo), '("scroll-event", WidgetScrollEventSignalInfo), '("select-all", ListBoxSelectAllSignalInfo), '("selected-rows-changed", ListBoxSelectedRowsChangedSignalInfo), '("selection-clear-event", WidgetSelectionClearEventSignalInfo), '("selection-get", WidgetSelectionGetSignalInfo), '("selection-notify-event", WidgetSelectionNotifyEventSignalInfo), '("selection-received", WidgetSelectionReceivedSignalInfo), '("selection-request-event", WidgetSelectionRequestEventSignalInfo), '("set-focus-child", ContainerSetFocusChildSignalInfo), '("show", WidgetShowSignalInfo), '("show-help", WidgetShowHelpSignalInfo), '("size-allocate", WidgetSizeAllocateSignalInfo), '("state-changed", WidgetStateChangedSignalInfo), '("state-flags-changed", WidgetStateFlagsChangedSignalInfo), '("style-set", WidgetStyleSetSignalInfo), '("style-updated", WidgetStyleUpdatedSignalInfo), '("toggle-cursor-row", ListBoxToggleCursorRowSignalInfo), '("touch-event", WidgetTouchEventSignalInfo), '("unmap", WidgetUnmapSignalInfo), '("unmap-event", WidgetUnmapEventSignalInfo), '("unrealize", WidgetUnrealizeSignalInfo), '("unselect-all", ListBoxUnselectAllSignalInfo), '("visibility-notify-event", WidgetVisibilityNotifyEventSignalInfo), '("window-state-event", WidgetWindowStateEventSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method ListBox::new
-- method type : Constructor
-- Args : []
-- Lengths : []
-- hInArgs : []
-- returnType : TInterface "Gtk" "ListBox"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_new" gtk_list_box_new :: 
    IO (Ptr ListBox)


listBoxNew ::
    (MonadIO m) =>
    m ListBox
listBoxNew  = liftIO $ do
    result <- gtk_list_box_new
    checkUnexpectedReturnNULL "gtk_list_box_new" result
    result' <- (newObject ListBox) result
    return result'

-- method ListBox::bind_model
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "model", argType = TInterface "Gio" "ListModel", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "create_widget_func", argType = TInterface "Gtk" "ListBoxCreateWidgetFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data_free_func", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "model", argType = TInterface "Gio" "ListModel", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "create_widget_func", argType = TInterface "Gtk" "ListBoxCreateWidgetFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 3, argDestroy = 4, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_bind_model" gtk_list_box_bind_model :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    Ptr Gio.ListModel ->                    -- model : TInterface "Gio" "ListModel"
    FunPtr ListBoxCreateWidgetFuncC ->      -- create_widget_func : TInterface "Gtk" "ListBoxCreateWidgetFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    FunPtr GLib.DestroyNotifyC ->           -- user_data_free_func : TInterface "GLib" "DestroyNotify"
    IO ()


listBoxBindModel ::
    (MonadIO m, ListBoxK a, Gio.ListModelK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- model
    Maybe (ListBoxCreateWidgetFunc) ->      -- create_widget_func
    m ()
listBoxBindModel _obj model create_widget_func = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeModel <- case model of
        Nothing -> return nullPtr
        Just jModel -> do
            let jModel' = unsafeManagedPtrCastPtr jModel
            return jModel'
    maybeCreate_widget_func <- case create_widget_func of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jCreate_widget_func -> do
            jCreate_widget_func' <- mkListBoxCreateWidgetFunc (listBoxCreateWidgetFuncWrapper Nothing jCreate_widget_func)
            return jCreate_widget_func'
    let user_data = castFunPtrToPtr maybeCreate_widget_func
    let user_data_free_func = safeFreeFunPtrPtr
    gtk_list_box_bind_model _obj' maybeModel maybeCreate_widget_func user_data user_data_free_func
    touchManagedPtr _obj
    whenJust model touchManagedPtr
    return ()

-- method ListBox::drag_highlight_row
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "row", argType = TInterface "Gtk" "ListBoxRow", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "row", argType = TInterface "Gtk" "ListBoxRow", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_drag_highlight_row" gtk_list_box_drag_highlight_row :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    Ptr ListBoxRow ->                       -- row : TInterface "Gtk" "ListBoxRow"
    IO ()


listBoxDragHighlightRow ::
    (MonadIO m, ListBoxK a, ListBoxRowK b) =>
    a ->                                    -- _obj
    b ->                                    -- row
    m ()
listBoxDragHighlightRow _obj row = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let row' = unsafeManagedPtrCastPtr row
    gtk_list_box_drag_highlight_row _obj' row'
    touchManagedPtr _obj
    touchManagedPtr row
    return ()

-- method ListBox::drag_unhighlight_row
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_drag_unhighlight_row" gtk_list_box_drag_unhighlight_row :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    IO ()


listBoxDragUnhighlightRow ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    m ()
listBoxDragUnhighlightRow _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_list_box_drag_unhighlight_row _obj'
    touchManagedPtr _obj
    return ()

-- method ListBox::get_activate_on_single_click
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_get_activate_on_single_click" gtk_list_box_get_activate_on_single_click :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    IO CInt


listBoxGetActivateOnSingleClick ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    m Bool
listBoxGetActivateOnSingleClick _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_list_box_get_activate_on_single_click _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method ListBox::get_adjustment
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Adjustment"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_get_adjustment" gtk_list_box_get_adjustment :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    IO (Ptr Adjustment)


listBoxGetAdjustment ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    m Adjustment
listBoxGetAdjustment _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_list_box_get_adjustment _obj'
    checkUnexpectedReturnNULL "gtk_list_box_get_adjustment" result
    result' <- (newObject Adjustment) result
    touchManagedPtr _obj
    return result'

-- method ListBox::get_row_at_index
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "ListBoxRow"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_get_row_at_index" gtk_list_box_get_row_at_index :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    Int32 ->                                -- index_ : TBasicType TInt32
    IO (Ptr ListBoxRow)


listBoxGetRowAtIndex ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- index_
    m ListBoxRow
listBoxGetRowAtIndex _obj index_ = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_list_box_get_row_at_index _obj' index_
    checkUnexpectedReturnNULL "gtk_list_box_get_row_at_index" result
    result' <- (newObject ListBoxRow) result
    touchManagedPtr _obj
    return result'

-- method ListBox::get_row_at_y
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "ListBoxRow"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_get_row_at_y" gtk_list_box_get_row_at_y :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    Int32 ->                                -- y : TBasicType TInt32
    IO (Ptr ListBoxRow)


listBoxGetRowAtY ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- y
    m ListBoxRow
listBoxGetRowAtY _obj y = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_list_box_get_row_at_y _obj' y
    checkUnexpectedReturnNULL "gtk_list_box_get_row_at_y" result
    result' <- (newObject ListBoxRow) result
    touchManagedPtr _obj
    return result'

-- method ListBox::get_selected_row
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "ListBoxRow"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_get_selected_row" gtk_list_box_get_selected_row :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    IO (Ptr ListBoxRow)


listBoxGetSelectedRow ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    m ListBoxRow
listBoxGetSelectedRow _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_list_box_get_selected_row _obj'
    checkUnexpectedReturnNULL "gtk_list_box_get_selected_row" result
    result' <- (newObject ListBoxRow) result
    touchManagedPtr _obj
    return result'

-- method ListBox::get_selected_rows
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TGList (TInterface "Gtk" "ListBoxRow")
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_get_selected_rows" gtk_list_box_get_selected_rows :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    IO (Ptr (GList (Ptr ListBoxRow)))


listBoxGetSelectedRows ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    m [ListBoxRow]
listBoxGetSelectedRows _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_list_box_get_selected_rows _obj'
    checkUnexpectedReturnNULL "gtk_list_box_get_selected_rows" result
    result' <- unpackGList result
    result'' <- mapM (newObject ListBoxRow) result'
    g_list_free result
    touchManagedPtr _obj
    return result''

-- method ListBox::get_selection_mode
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "SelectionMode"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_get_selection_mode" gtk_list_box_get_selection_mode :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    IO CUInt


listBoxGetSelectionMode ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    m SelectionMode
listBoxGetSelectionMode _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_list_box_get_selection_mode _obj'
    let result' = (toEnum . fromIntegral) result
    touchManagedPtr _obj
    return result'

-- method ListBox::insert
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "position", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_insert" gtk_list_box_insert :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    Ptr Widget ->                           -- child : TInterface "Gtk" "Widget"
    Int32 ->                                -- position : TBasicType TInt32
    IO ()


listBoxInsert ::
    (MonadIO m, ListBoxK a, WidgetK b) =>
    a ->                                    -- _obj
    b ->                                    -- child
    Int32 ->                                -- position
    m ()
listBoxInsert _obj child position = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let child' = unsafeManagedPtrCastPtr child
    gtk_list_box_insert _obj' child' position
    touchManagedPtr _obj
    touchManagedPtr child
    return ()

-- method ListBox::invalidate_filter
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_invalidate_filter" gtk_list_box_invalidate_filter :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    IO ()


listBoxInvalidateFilter ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    m ()
listBoxInvalidateFilter _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_list_box_invalidate_filter _obj'
    touchManagedPtr _obj
    return ()

-- method ListBox::invalidate_headers
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_invalidate_headers" gtk_list_box_invalidate_headers :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    IO ()


listBoxInvalidateHeaders ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    m ()
listBoxInvalidateHeaders _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_list_box_invalidate_headers _obj'
    touchManagedPtr _obj
    return ()

-- method ListBox::invalidate_sort
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_invalidate_sort" gtk_list_box_invalidate_sort :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    IO ()


listBoxInvalidateSort ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    m ()
listBoxInvalidateSort _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_list_box_invalidate_sort _obj'
    touchManagedPtr _obj
    return ()

-- method ListBox::prepend
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_prepend" gtk_list_box_prepend :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    Ptr Widget ->                           -- child : TInterface "Gtk" "Widget"
    IO ()


listBoxPrepend ::
    (MonadIO m, ListBoxK a, WidgetK b) =>
    a ->                                    -- _obj
    b ->                                    -- child
    m ()
listBoxPrepend _obj child = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let child' = unsafeManagedPtrCastPtr child
    gtk_list_box_prepend _obj' child'
    touchManagedPtr _obj
    touchManagedPtr child
    return ()

-- method ListBox::select_all
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_select_all" gtk_list_box_select_all :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    IO ()


listBoxSelectAll ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    m ()
listBoxSelectAll _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_list_box_select_all _obj'
    touchManagedPtr _obj
    return ()

-- method ListBox::select_row
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "row", argType = TInterface "Gtk" "ListBoxRow", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "row", argType = TInterface "Gtk" "ListBoxRow", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_select_row" gtk_list_box_select_row :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    Ptr ListBoxRow ->                       -- row : TInterface "Gtk" "ListBoxRow"
    IO ()


listBoxSelectRow ::
    (MonadIO m, ListBoxK a, ListBoxRowK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- row
    m ()
listBoxSelectRow _obj row = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeRow <- case row of
        Nothing -> return nullPtr
        Just jRow -> do
            let jRow' = unsafeManagedPtrCastPtr jRow
            return jRow'
    gtk_list_box_select_row _obj' maybeRow
    touchManagedPtr _obj
    whenJust row touchManagedPtr
    return ()

-- method ListBox::selected_foreach
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "Gtk" "ListBoxForeachFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = 2, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "Gtk" "ListBoxForeachFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeCall, argClosure = 2, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_selected_foreach" gtk_list_box_selected_foreach :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    FunPtr ListBoxForeachFuncC ->           -- func : TInterface "Gtk" "ListBoxForeachFunc"
    Ptr () ->                               -- data : TBasicType TVoid
    IO ()


listBoxSelectedForeach ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    ListBoxForeachFunc ->                   -- func
    m ()
listBoxSelectedForeach _obj func = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    func' <- mkListBoxForeachFunc (listBoxForeachFuncWrapper Nothing func)
    let data_ = nullPtr
    gtk_list_box_selected_foreach _obj' func' data_
    safeFreeFunPtr $ castFunPtrToPtr func'
    touchManagedPtr _obj
    return ()

-- method ListBox::set_activate_on_single_click
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "single", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "single", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_set_activate_on_single_click" gtk_list_box_set_activate_on_single_click :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    CInt ->                                 -- single : TBasicType TBoolean
    IO ()


listBoxSetActivateOnSingleClick ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- single
    m ()
listBoxSetActivateOnSingleClick _obj single = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let single' = (fromIntegral . fromEnum) single
    gtk_list_box_set_activate_on_single_click _obj' single'
    touchManagedPtr _obj
    return ()

-- method ListBox::set_adjustment
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "adjustment", argType = TInterface "Gtk" "Adjustment", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "adjustment", argType = TInterface "Gtk" "Adjustment", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_set_adjustment" gtk_list_box_set_adjustment :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    Ptr Adjustment ->                       -- adjustment : TInterface "Gtk" "Adjustment"
    IO ()


listBoxSetAdjustment ::
    (MonadIO m, ListBoxK a, AdjustmentK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- adjustment
    m ()
listBoxSetAdjustment _obj adjustment = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeAdjustment <- case adjustment of
        Nothing -> return nullPtr
        Just jAdjustment -> do
            let jAdjustment' = unsafeManagedPtrCastPtr jAdjustment
            return jAdjustment'
    gtk_list_box_set_adjustment _obj' maybeAdjustment
    touchManagedPtr _obj
    whenJust adjustment touchManagedPtr
    return ()

-- method ListBox::set_filter_func
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filter_func", argType = TInterface "Gtk" "ListBoxFilterFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "filter_func", argType = TInterface "Gtk" "ListBoxFilterFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_set_filter_func" gtk_list_box_set_filter_func :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    FunPtr ListBoxFilterFuncC ->            -- filter_func : TInterface "Gtk" "ListBoxFilterFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    FunPtr GLib.DestroyNotifyC ->           -- destroy : TInterface "GLib" "DestroyNotify"
    IO ()


listBoxSetFilterFunc ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    Maybe (ListBoxFilterFunc) ->            -- filter_func
    m ()
listBoxSetFilterFunc _obj filter_func = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeFilter_func <- case filter_func of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jFilter_func -> do
            jFilter_func' <- mkListBoxFilterFunc (listBoxFilterFuncWrapper Nothing jFilter_func)
            return jFilter_func'
    let user_data = castFunPtrToPtr maybeFilter_func
    let destroy = safeFreeFunPtrPtr
    gtk_list_box_set_filter_func _obj' maybeFilter_func user_data destroy
    touchManagedPtr _obj
    return ()

-- method ListBox::set_header_func
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "update_header", argType = TInterface "Gtk" "ListBoxUpdateHeaderFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "update_header", argType = TInterface "Gtk" "ListBoxUpdateHeaderFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_set_header_func" gtk_list_box_set_header_func :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    FunPtr ListBoxUpdateHeaderFuncC ->      -- update_header : TInterface "Gtk" "ListBoxUpdateHeaderFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    FunPtr GLib.DestroyNotifyC ->           -- destroy : TInterface "GLib" "DestroyNotify"
    IO ()


listBoxSetHeaderFunc ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    Maybe (ListBoxUpdateHeaderFunc) ->      -- update_header
    m ()
listBoxSetHeaderFunc _obj update_header = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeUpdate_header <- case update_header of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jUpdate_header -> do
            jUpdate_header' <- mkListBoxUpdateHeaderFunc (listBoxUpdateHeaderFuncWrapper Nothing jUpdate_header)
            return jUpdate_header'
    let user_data = castFunPtrToPtr maybeUpdate_header
    let destroy = safeFreeFunPtrPtr
    gtk_list_box_set_header_func _obj' maybeUpdate_header user_data destroy
    touchManagedPtr _obj
    return ()

-- method ListBox::set_placeholder
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "placeholder", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "placeholder", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_set_placeholder" gtk_list_box_set_placeholder :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    Ptr Widget ->                           -- placeholder : TInterface "Gtk" "Widget"
    IO ()


listBoxSetPlaceholder ::
    (MonadIO m, ListBoxK a, WidgetK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- placeholder
    m ()
listBoxSetPlaceholder _obj placeholder = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybePlaceholder <- case placeholder of
        Nothing -> return nullPtr
        Just jPlaceholder -> do
            let jPlaceholder' = unsafeManagedPtrCastPtr jPlaceholder
            return jPlaceholder'
    gtk_list_box_set_placeholder _obj' maybePlaceholder
    touchManagedPtr _obj
    whenJust placeholder touchManagedPtr
    return ()

-- method ListBox::set_selection_mode
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TInterface "Gtk" "SelectionMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TInterface "Gtk" "SelectionMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_set_selection_mode" gtk_list_box_set_selection_mode :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    CUInt ->                                -- mode : TInterface "Gtk" "SelectionMode"
    IO ()


listBoxSetSelectionMode ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    SelectionMode ->                        -- mode
    m ()
listBoxSetSelectionMode _obj mode = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let mode' = (fromIntegral . fromEnum) mode
    gtk_list_box_set_selection_mode _obj' mode'
    touchManagedPtr _obj
    return ()

-- method ListBox::set_sort_func
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "sort_func", argType = TInterface "Gtk" "ListBoxSortFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "destroy", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "sort_func", argType = TInterface "Gtk" "ListBoxSortFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_set_sort_func" gtk_list_box_set_sort_func :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    FunPtr ListBoxSortFuncC ->              -- sort_func : TInterface "Gtk" "ListBoxSortFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    FunPtr GLib.DestroyNotifyC ->           -- destroy : TInterface "GLib" "DestroyNotify"
    IO ()


listBoxSetSortFunc ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    Maybe (ListBoxSortFunc) ->              -- sort_func
    m ()
listBoxSetSortFunc _obj sort_func = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeSort_func <- case sort_func of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jSort_func -> do
            jSort_func' <- mkListBoxSortFunc (listBoxSortFuncWrapper Nothing jSort_func)
            return jSort_func'
    let user_data = castFunPtrToPtr maybeSort_func
    let destroy = safeFreeFunPtrPtr
    gtk_list_box_set_sort_func _obj' maybeSort_func user_data destroy
    touchManagedPtr _obj
    return ()

-- method ListBox::unselect_all
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_unselect_all" gtk_list_box_unselect_all :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    IO ()


listBoxUnselectAll ::
    (MonadIO m, ListBoxK a) =>
    a ->                                    -- _obj
    m ()
listBoxUnselectAll _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_list_box_unselect_all _obj'
    touchManagedPtr _obj
    return ()

-- method ListBox::unselect_row
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "row", argType = TInterface "Gtk" "ListBoxRow", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ListBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "row", argType = TInterface "Gtk" "ListBoxRow", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_list_box_unselect_row" gtk_list_box_unselect_row :: 
    Ptr ListBox ->                          -- _obj : TInterface "Gtk" "ListBox"
    Ptr ListBoxRow ->                       -- row : TInterface "Gtk" "ListBoxRow"
    IO ()


listBoxUnselectRow ::
    (MonadIO m, ListBoxK a, ListBoxRowK b) =>
    a ->                                    -- _obj
    b ->                                    -- row
    m ()
listBoxUnselectRow _obj row = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let row' = unsafeManagedPtrCastPtr row
    gtk_list_box_unselect_row _obj' row'
    touchManagedPtr _obj
    touchManagedPtr row
    return ()