{- |
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.ComboBox
    ( 

-- * Exported types
    ComboBox(..)                            ,
    ComboBoxK                               ,
    toComboBox                              ,
    noComboBox                              ,


 -- * Methods
-- ** comboBoxGetActive
    comboBoxGetActive                       ,


-- ** comboBoxGetActiveId
    comboBoxGetActiveId                     ,


-- ** comboBoxGetActiveIter
    comboBoxGetActiveIter                   ,


-- ** comboBoxGetAddTearoffs
    comboBoxGetAddTearoffs                  ,


-- ** comboBoxGetButtonSensitivity
    comboBoxGetButtonSensitivity            ,


-- ** comboBoxGetColumnSpanColumn
    comboBoxGetColumnSpanColumn             ,


-- ** comboBoxGetEntryTextColumn
    comboBoxGetEntryTextColumn              ,


-- ** comboBoxGetFocusOnClick
    comboBoxGetFocusOnClick                 ,


-- ** comboBoxGetHasEntry
    comboBoxGetHasEntry                     ,


-- ** comboBoxGetIdColumn
    comboBoxGetIdColumn                     ,


-- ** comboBoxGetModel
    comboBoxGetModel                        ,


-- ** comboBoxGetPopupAccessible
    comboBoxGetPopupAccessible              ,


-- ** comboBoxGetPopupFixedWidth
    comboBoxGetPopupFixedWidth              ,


-- ** comboBoxGetRowSpanColumn
    comboBoxGetRowSpanColumn                ,


-- ** comboBoxGetTitle
    comboBoxGetTitle                        ,


-- ** comboBoxGetWrapWidth
    comboBoxGetWrapWidth                    ,


-- ** comboBoxNew
    comboBoxNew                             ,


-- ** comboBoxNewWithArea
    comboBoxNewWithArea                     ,


-- ** comboBoxNewWithAreaAndEntry
    comboBoxNewWithAreaAndEntry             ,


-- ** comboBoxNewWithEntry
    comboBoxNewWithEntry                    ,


-- ** comboBoxNewWithModel
    comboBoxNewWithModel                    ,


-- ** comboBoxNewWithModelAndEntry
    comboBoxNewWithModelAndEntry            ,


-- ** comboBoxPopdown
    comboBoxPopdown                         ,


-- ** comboBoxPopup
    comboBoxPopup                           ,


-- ** comboBoxPopupForDevice
    comboBoxPopupForDevice                  ,


-- ** comboBoxSetActive
    comboBoxSetActive                       ,


-- ** comboBoxSetActiveId
    comboBoxSetActiveId                     ,


-- ** comboBoxSetActiveIter
    comboBoxSetActiveIter                   ,


-- ** comboBoxSetAddTearoffs
    comboBoxSetAddTearoffs                  ,


-- ** comboBoxSetButtonSensitivity
    comboBoxSetButtonSensitivity            ,


-- ** comboBoxSetColumnSpanColumn
    comboBoxSetColumnSpanColumn             ,


-- ** comboBoxSetEntryTextColumn
    comboBoxSetEntryTextColumn              ,


-- ** comboBoxSetFocusOnClick
    comboBoxSetFocusOnClick                 ,


-- ** comboBoxSetIdColumn
    comboBoxSetIdColumn                     ,


-- ** comboBoxSetModel
    comboBoxSetModel                        ,


-- ** comboBoxSetPopupFixedWidth
    comboBoxSetPopupFixedWidth              ,


-- ** comboBoxSetRowSeparatorFunc
    comboBoxSetRowSeparatorFunc             ,


-- ** comboBoxSetRowSpanColumn
    comboBoxSetRowSpanColumn                ,


-- ** comboBoxSetTitle
    comboBoxSetTitle                        ,


-- ** comboBoxSetWrapWidth
    comboBoxSetWrapWidth                    ,




 -- * Properties
-- ** Active
    ComboBoxActivePropertyInfo              ,
    constructComboBoxActive                 ,
    getComboBoxActive                       ,
    setComboBoxActive                       ,


-- ** ActiveId
    ComboBoxActiveIdPropertyInfo            ,
    constructComboBoxActiveId               ,
    getComboBoxActiveId                     ,
    setComboBoxActiveId                     ,


-- ** AddTearoffs
    ComboBoxAddTearoffsPropertyInfo         ,
    constructComboBoxAddTearoffs            ,
    getComboBoxAddTearoffs                  ,
    setComboBoxAddTearoffs                  ,


-- ** ButtonSensitivity
    ComboBoxButtonSensitivityPropertyInfo   ,
    constructComboBoxButtonSensitivity      ,
    getComboBoxButtonSensitivity            ,
    setComboBoxButtonSensitivity            ,


-- ** CellArea
    ComboBoxCellAreaPropertyInfo            ,
    constructComboBoxCellArea               ,
    getComboBoxCellArea                     ,


-- ** ColumnSpanColumn
    ComboBoxColumnSpanColumnPropertyInfo    ,
    constructComboBoxColumnSpanColumn       ,
    getComboBoxColumnSpanColumn             ,
    setComboBoxColumnSpanColumn             ,


-- ** EntryTextColumn
    ComboBoxEntryTextColumnPropertyInfo     ,
    constructComboBoxEntryTextColumn        ,
    getComboBoxEntryTextColumn              ,
    setComboBoxEntryTextColumn              ,


-- ** FocusOnClick
    ComboBoxFocusOnClickPropertyInfo        ,
    constructComboBoxFocusOnClick           ,
    getComboBoxFocusOnClick                 ,
    setComboBoxFocusOnClick                 ,


-- ** HasEntry
    ComboBoxHasEntryPropertyInfo            ,
    constructComboBoxHasEntry               ,
    getComboBoxHasEntry                     ,


-- ** HasFrame
    ComboBoxHasFramePropertyInfo            ,
    constructComboBoxHasFrame               ,
    getComboBoxHasFrame                     ,
    setComboBoxHasFrame                     ,


-- ** IdColumn
    ComboBoxIdColumnPropertyInfo            ,
    constructComboBoxIdColumn               ,
    getComboBoxIdColumn                     ,
    setComboBoxIdColumn                     ,


-- ** Model
    ComboBoxModelPropertyInfo               ,
    constructComboBoxModel                  ,
    getComboBoxModel                        ,
    setComboBoxModel                        ,


-- ** PopupFixedWidth
    ComboBoxPopupFixedWidthPropertyInfo     ,
    constructComboBoxPopupFixedWidth        ,
    getComboBoxPopupFixedWidth              ,
    setComboBoxPopupFixedWidth              ,


-- ** PopupShown
    ComboBoxPopupShownPropertyInfo          ,
    getComboBoxPopupShown                   ,


-- ** RowSpanColumn
    ComboBoxRowSpanColumnPropertyInfo       ,
    constructComboBoxRowSpanColumn          ,
    getComboBoxRowSpanColumn                ,
    setComboBoxRowSpanColumn                ,


-- ** TearoffTitle
    ComboBoxTearoffTitlePropertyInfo        ,
    constructComboBoxTearoffTitle           ,
    getComboBoxTearoffTitle                 ,
    setComboBoxTearoffTitle                 ,


-- ** WrapWidth
    ComboBoxWrapWidthPropertyInfo           ,
    constructComboBoxWrapWidth              ,
    getComboBoxWrapWidth                    ,
    setComboBoxWrapWidth                    ,




 -- * Signals
-- ** Changed
    ComboBoxChangedCallback                 ,
    ComboBoxChangedCallbackC                ,
    ComboBoxChangedSignalInfo               ,
    afterComboBoxChanged                    ,
    comboBoxChangedCallbackWrapper          ,
    comboBoxChangedClosure                  ,
    mkComboBoxChangedCallback               ,
    noComboBoxChangedCallback               ,
    onComboBoxChanged                       ,


-- ** FormatEntryText
    ComboBoxFormatEntryTextCallback         ,
    ComboBoxFormatEntryTextCallbackC        ,
    ComboBoxFormatEntryTextSignalInfo       ,
    afterComboBoxFormatEntryText            ,
    comboBoxFormatEntryTextCallbackWrapper  ,
    comboBoxFormatEntryTextClosure          ,
    mkComboBoxFormatEntryTextCallback       ,
    noComboBoxFormatEntryTextCallback       ,
    onComboBoxFormatEntryText               ,


-- ** MoveActive
    ComboBoxMoveActiveCallback              ,
    ComboBoxMoveActiveCallbackC             ,
    ComboBoxMoveActiveSignalInfo            ,
    afterComboBoxMoveActive                 ,
    comboBoxMoveActiveCallbackWrapper       ,
    comboBoxMoveActiveClosure               ,
    mkComboBoxMoveActiveCallback            ,
    noComboBoxMoveActiveCallback            ,
    onComboBoxMoveActive                    ,


-- ** Popdown
    ComboBoxPopdownCallback                 ,
    ComboBoxPopdownCallbackC                ,
    ComboBoxPopdownSignalInfo               ,
    afterComboBoxPopdown                    ,
    comboBoxPopdownCallbackWrapper          ,
    comboBoxPopdownClosure                  ,
    mkComboBoxPopdownCallback               ,
    noComboBoxPopdownCallback               ,
    onComboBoxPopdown                       ,


-- ** Popup
    ComboBoxPopupCallback                   ,
    ComboBoxPopupCallbackC                  ,
    ComboBoxPopupSignalInfo                 ,
    afterComboBoxPopup                      ,
    comboBoxPopupCallbackWrapper            ,
    comboBoxPopupClosure                    ,
    mkComboBoxPopupCallback                 ,
    noComboBoxPopupCallback                 ,
    onComboBoxPopup                         ,




    ) 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.Gdk as Gdk

newtype ComboBox = ComboBox (ForeignPtr ComboBox)
foreign import ccall "gtk_combo_box_get_type"
    c_gtk_combo_box_get_type :: IO GType

type instance ParentTypes ComboBox = ComboBoxParentTypes
type ComboBoxParentTypes = '[Bin, Container, Widget, GObject.Object, Atk.ImplementorIface, Buildable, CellEditable, CellLayout]

instance GObject ComboBox where
    gobjectIsInitiallyUnowned _ = True
    gobjectType _ = c_gtk_combo_box_get_type
    

class GObject o => ComboBoxK o
instance (GObject o, IsDescendantOf ComboBox o) => ComboBoxK o

toComboBox :: ComboBoxK o => o -> IO ComboBox
toComboBox = unsafeCastTo ComboBox

noComboBox :: Maybe ComboBox
noComboBox = Nothing

-- signal ComboBox::changed
type ComboBoxChangedCallback =
    IO ()

noComboBoxChangedCallback :: Maybe ComboBoxChangedCallback
noComboBoxChangedCallback = Nothing

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

foreign import ccall "wrapper"
    mkComboBoxChangedCallback :: ComboBoxChangedCallbackC -> IO (FunPtr ComboBoxChangedCallbackC)

comboBoxChangedClosure :: ComboBoxChangedCallback -> IO Closure
comboBoxChangedClosure cb = newCClosure =<< mkComboBoxChangedCallback wrapped
    where wrapped = comboBoxChangedCallbackWrapper cb

comboBoxChangedCallbackWrapper ::
    ComboBoxChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
comboBoxChangedCallbackWrapper _cb _ _ = do
    _cb 

onComboBoxChanged :: (GObject a, MonadIO m) => a -> ComboBoxChangedCallback -> m SignalHandlerId
onComboBoxChanged obj cb = liftIO $ connectComboBoxChanged obj cb SignalConnectBefore
afterComboBoxChanged :: (GObject a, MonadIO m) => a -> ComboBoxChangedCallback -> m SignalHandlerId
afterComboBoxChanged obj cb = connectComboBoxChanged obj cb SignalConnectAfter

connectComboBoxChanged :: (GObject a, MonadIO m) =>
                          a -> ComboBoxChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectComboBoxChanged obj cb after = liftIO $ do
    cb' <- mkComboBoxChangedCallback (comboBoxChangedCallbackWrapper cb)
    connectSignalFunPtr obj "changed" cb' after

-- signal ComboBox::format-entry-text
type ComboBoxFormatEntryTextCallback =
    T.Text ->
    IO T.Text

noComboBoxFormatEntryTextCallback :: Maybe ComboBoxFormatEntryTextCallback
noComboBoxFormatEntryTextCallback = Nothing

type ComboBoxFormatEntryTextCallbackC =
    Ptr () ->                               -- object
    CString ->
    Ptr () ->                               -- user_data
    IO CString

foreign import ccall "wrapper"
    mkComboBoxFormatEntryTextCallback :: ComboBoxFormatEntryTextCallbackC -> IO (FunPtr ComboBoxFormatEntryTextCallbackC)

comboBoxFormatEntryTextClosure :: ComboBoxFormatEntryTextCallback -> IO Closure
comboBoxFormatEntryTextClosure cb = newCClosure =<< mkComboBoxFormatEntryTextCallback wrapped
    where wrapped = comboBoxFormatEntryTextCallbackWrapper cb

comboBoxFormatEntryTextCallbackWrapper ::
    ComboBoxFormatEntryTextCallback ->
    Ptr () ->
    CString ->
    Ptr () ->
    IO CString
comboBoxFormatEntryTextCallbackWrapper _cb _ path _ = do
    path' <- cstringToText path
    result <- _cb  path'
    result' <- textToCString result
    return result'

onComboBoxFormatEntryText :: (GObject a, MonadIO m) => a -> ComboBoxFormatEntryTextCallback -> m SignalHandlerId
onComboBoxFormatEntryText obj cb = liftIO $ connectComboBoxFormatEntryText obj cb SignalConnectBefore
afterComboBoxFormatEntryText :: (GObject a, MonadIO m) => a -> ComboBoxFormatEntryTextCallback -> m SignalHandlerId
afterComboBoxFormatEntryText obj cb = connectComboBoxFormatEntryText obj cb SignalConnectAfter

connectComboBoxFormatEntryText :: (GObject a, MonadIO m) =>
                                  a -> ComboBoxFormatEntryTextCallback -> SignalConnectMode -> m SignalHandlerId
connectComboBoxFormatEntryText obj cb after = liftIO $ do
    cb' <- mkComboBoxFormatEntryTextCallback (comboBoxFormatEntryTextCallbackWrapper cb)
    connectSignalFunPtr obj "format-entry-text" cb' after

-- signal ComboBox::move-active
type ComboBoxMoveActiveCallback =
    ScrollType ->
    IO ()

noComboBoxMoveActiveCallback :: Maybe ComboBoxMoveActiveCallback
noComboBoxMoveActiveCallback = Nothing

type ComboBoxMoveActiveCallbackC =
    Ptr () ->                               -- object
    CUInt ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkComboBoxMoveActiveCallback :: ComboBoxMoveActiveCallbackC -> IO (FunPtr ComboBoxMoveActiveCallbackC)

comboBoxMoveActiveClosure :: ComboBoxMoveActiveCallback -> IO Closure
comboBoxMoveActiveClosure cb = newCClosure =<< mkComboBoxMoveActiveCallback wrapped
    where wrapped = comboBoxMoveActiveCallbackWrapper cb

comboBoxMoveActiveCallbackWrapper ::
    ComboBoxMoveActiveCallback ->
    Ptr () ->
    CUInt ->
    Ptr () ->
    IO ()
comboBoxMoveActiveCallbackWrapper _cb _ scroll_type _ = do
    let scroll_type' = (toEnum . fromIntegral) scroll_type
    _cb  scroll_type'

onComboBoxMoveActive :: (GObject a, MonadIO m) => a -> ComboBoxMoveActiveCallback -> m SignalHandlerId
onComboBoxMoveActive obj cb = liftIO $ connectComboBoxMoveActive obj cb SignalConnectBefore
afterComboBoxMoveActive :: (GObject a, MonadIO m) => a -> ComboBoxMoveActiveCallback -> m SignalHandlerId
afterComboBoxMoveActive obj cb = connectComboBoxMoveActive obj cb SignalConnectAfter

connectComboBoxMoveActive :: (GObject a, MonadIO m) =>
                             a -> ComboBoxMoveActiveCallback -> SignalConnectMode -> m SignalHandlerId
connectComboBoxMoveActive obj cb after = liftIO $ do
    cb' <- mkComboBoxMoveActiveCallback (comboBoxMoveActiveCallbackWrapper cb)
    connectSignalFunPtr obj "move-active" cb' after

-- signal ComboBox::popdown
type ComboBoxPopdownCallback =
    IO Bool

noComboBoxPopdownCallback :: Maybe ComboBoxPopdownCallback
noComboBoxPopdownCallback = Nothing

type ComboBoxPopdownCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO CInt

foreign import ccall "wrapper"
    mkComboBoxPopdownCallback :: ComboBoxPopdownCallbackC -> IO (FunPtr ComboBoxPopdownCallbackC)

comboBoxPopdownClosure :: ComboBoxPopdownCallback -> IO Closure
comboBoxPopdownClosure cb = newCClosure =<< mkComboBoxPopdownCallback wrapped
    where wrapped = comboBoxPopdownCallbackWrapper cb

comboBoxPopdownCallbackWrapper ::
    ComboBoxPopdownCallback ->
    Ptr () ->
    Ptr () ->
    IO CInt
comboBoxPopdownCallbackWrapper _cb _ _ = do
    result <- _cb 
    let result' = (fromIntegral . fromEnum) result
    return result'

onComboBoxPopdown :: (GObject a, MonadIO m) => a -> ComboBoxPopdownCallback -> m SignalHandlerId
onComboBoxPopdown obj cb = liftIO $ connectComboBoxPopdown obj cb SignalConnectBefore
afterComboBoxPopdown :: (GObject a, MonadIO m) => a -> ComboBoxPopdownCallback -> m SignalHandlerId
afterComboBoxPopdown obj cb = connectComboBoxPopdown obj cb SignalConnectAfter

connectComboBoxPopdown :: (GObject a, MonadIO m) =>
                          a -> ComboBoxPopdownCallback -> SignalConnectMode -> m SignalHandlerId
connectComboBoxPopdown obj cb after = liftIO $ do
    cb' <- mkComboBoxPopdownCallback (comboBoxPopdownCallbackWrapper cb)
    connectSignalFunPtr obj "popdown" cb' after

-- signal ComboBox::popup
type ComboBoxPopupCallback =
    IO ()

noComboBoxPopupCallback :: Maybe ComboBoxPopupCallback
noComboBoxPopupCallback = Nothing

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

foreign import ccall "wrapper"
    mkComboBoxPopupCallback :: ComboBoxPopupCallbackC -> IO (FunPtr ComboBoxPopupCallbackC)

comboBoxPopupClosure :: ComboBoxPopupCallback -> IO Closure
comboBoxPopupClosure cb = newCClosure =<< mkComboBoxPopupCallback wrapped
    where wrapped = comboBoxPopupCallbackWrapper cb

comboBoxPopupCallbackWrapper ::
    ComboBoxPopupCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
comboBoxPopupCallbackWrapper _cb _ _ = do
    _cb 

onComboBoxPopup :: (GObject a, MonadIO m) => a -> ComboBoxPopupCallback -> m SignalHandlerId
onComboBoxPopup obj cb = liftIO $ connectComboBoxPopup obj cb SignalConnectBefore
afterComboBoxPopup :: (GObject a, MonadIO m) => a -> ComboBoxPopupCallback -> m SignalHandlerId
afterComboBoxPopup obj cb = connectComboBoxPopup obj cb SignalConnectAfter

connectComboBoxPopup :: (GObject a, MonadIO m) =>
                        a -> ComboBoxPopupCallback -> SignalConnectMode -> m SignalHandlerId
connectComboBoxPopup obj cb after = liftIO $ do
    cb' <- mkComboBoxPopupCallback (comboBoxPopupCallbackWrapper cb)
    connectSignalFunPtr obj "popup" cb' after

-- VVV Prop "active"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getComboBoxActive :: (MonadIO m, ComboBoxK o) => o -> m Int32
getComboBoxActive obj = liftIO $ getObjectPropertyCInt obj "active"

setComboBoxActive :: (MonadIO m, ComboBoxK o) => o -> Int32 -> m ()
setComboBoxActive obj val = liftIO $ setObjectPropertyCInt obj "active" val

constructComboBoxActive :: Int32 -> IO ([Char], GValue)
constructComboBoxActive val = constructObjectPropertyCInt "active" val

data ComboBoxActivePropertyInfo
instance AttrInfo ComboBoxActivePropertyInfo where
    type AttrAllowedOps ComboBoxActivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxActivePropertyInfo = (~) Int32
    type AttrBaseTypeConstraint ComboBoxActivePropertyInfo = ComboBoxK
    type AttrGetType ComboBoxActivePropertyInfo = Int32
    type AttrLabel ComboBoxActivePropertyInfo = "ComboBox::active"
    attrGet _ = getComboBoxActive
    attrSet _ = setComboBoxActive
    attrConstruct _ = constructComboBoxActive

-- VVV Prop "active-id"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getComboBoxActiveId :: (MonadIO m, ComboBoxK o) => o -> m T.Text
getComboBoxActiveId obj = liftIO $ getObjectPropertyString obj "active-id"

setComboBoxActiveId :: (MonadIO m, ComboBoxK o) => o -> T.Text -> m ()
setComboBoxActiveId obj val = liftIO $ setObjectPropertyString obj "active-id" val

constructComboBoxActiveId :: T.Text -> IO ([Char], GValue)
constructComboBoxActiveId val = constructObjectPropertyString "active-id" val

data ComboBoxActiveIdPropertyInfo
instance AttrInfo ComboBoxActiveIdPropertyInfo where
    type AttrAllowedOps ComboBoxActiveIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxActiveIdPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint ComboBoxActiveIdPropertyInfo = ComboBoxK
    type AttrGetType ComboBoxActiveIdPropertyInfo = T.Text
    type AttrLabel ComboBoxActiveIdPropertyInfo = "ComboBox::active-id"
    attrGet _ = getComboBoxActiveId
    attrSet _ = setComboBoxActiveId
    attrConstruct _ = constructComboBoxActiveId

-- VVV Prop "add-tearoffs"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getComboBoxAddTearoffs :: (MonadIO m, ComboBoxK o) => o -> m Bool
getComboBoxAddTearoffs obj = liftIO $ getObjectPropertyBool obj "add-tearoffs"

setComboBoxAddTearoffs :: (MonadIO m, ComboBoxK o) => o -> Bool -> m ()
setComboBoxAddTearoffs obj val = liftIO $ setObjectPropertyBool obj "add-tearoffs" val

constructComboBoxAddTearoffs :: Bool -> IO ([Char], GValue)
constructComboBoxAddTearoffs val = constructObjectPropertyBool "add-tearoffs" val

data ComboBoxAddTearoffsPropertyInfo
instance AttrInfo ComboBoxAddTearoffsPropertyInfo where
    type AttrAllowedOps ComboBoxAddTearoffsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxAddTearoffsPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint ComboBoxAddTearoffsPropertyInfo = ComboBoxK
    type AttrGetType ComboBoxAddTearoffsPropertyInfo = Bool
    type AttrLabel ComboBoxAddTearoffsPropertyInfo = "ComboBox::add-tearoffs"
    attrGet _ = getComboBoxAddTearoffs
    attrSet _ = setComboBoxAddTearoffs
    attrConstruct _ = constructComboBoxAddTearoffs

-- VVV Prop "button-sensitivity"
   -- Type: TInterface "Gtk" "SensitivityType"
   -- Flags: [PropertyReadable,PropertyWritable]

getComboBoxButtonSensitivity :: (MonadIO m, ComboBoxK o) => o -> m SensitivityType
getComboBoxButtonSensitivity obj = liftIO $ getObjectPropertyEnum obj "button-sensitivity"

setComboBoxButtonSensitivity :: (MonadIO m, ComboBoxK o) => o -> SensitivityType -> m ()
setComboBoxButtonSensitivity obj val = liftIO $ setObjectPropertyEnum obj "button-sensitivity" val

constructComboBoxButtonSensitivity :: SensitivityType -> IO ([Char], GValue)
constructComboBoxButtonSensitivity val = constructObjectPropertyEnum "button-sensitivity" val

data ComboBoxButtonSensitivityPropertyInfo
instance AttrInfo ComboBoxButtonSensitivityPropertyInfo where
    type AttrAllowedOps ComboBoxButtonSensitivityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxButtonSensitivityPropertyInfo = (~) SensitivityType
    type AttrBaseTypeConstraint ComboBoxButtonSensitivityPropertyInfo = ComboBoxK
    type AttrGetType ComboBoxButtonSensitivityPropertyInfo = SensitivityType
    type AttrLabel ComboBoxButtonSensitivityPropertyInfo = "ComboBox::button-sensitivity"
    attrGet _ = getComboBoxButtonSensitivity
    attrSet _ = setComboBoxButtonSensitivity
    attrConstruct _ = constructComboBoxButtonSensitivity

-- VVV Prop "cell-area"
   -- Type: TInterface "Gtk" "CellArea"
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getComboBoxCellArea :: (MonadIO m, ComboBoxK o) => o -> m CellArea
getComboBoxCellArea obj = liftIO $ getObjectPropertyObject obj "cell-area" CellArea

constructComboBoxCellArea :: (CellAreaK a) => a -> IO ([Char], GValue)
constructComboBoxCellArea val = constructObjectPropertyObject "cell-area" val

data ComboBoxCellAreaPropertyInfo
instance AttrInfo ComboBoxCellAreaPropertyInfo where
    type AttrAllowedOps ComboBoxCellAreaPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxCellAreaPropertyInfo = CellAreaK
    type AttrBaseTypeConstraint ComboBoxCellAreaPropertyInfo = ComboBoxK
    type AttrGetType ComboBoxCellAreaPropertyInfo = CellArea
    type AttrLabel ComboBoxCellAreaPropertyInfo = "ComboBox::cell-area"
    attrGet _ = getComboBoxCellArea
    attrSet _ = undefined
    attrConstruct _ = constructComboBoxCellArea

-- VVV Prop "column-span-column"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getComboBoxColumnSpanColumn :: (MonadIO m, ComboBoxK o) => o -> m Int32
getComboBoxColumnSpanColumn obj = liftIO $ getObjectPropertyCInt obj "column-span-column"

setComboBoxColumnSpanColumn :: (MonadIO m, ComboBoxK o) => o -> Int32 -> m ()
setComboBoxColumnSpanColumn obj val = liftIO $ setObjectPropertyCInt obj "column-span-column" val

constructComboBoxColumnSpanColumn :: Int32 -> IO ([Char], GValue)
constructComboBoxColumnSpanColumn val = constructObjectPropertyCInt "column-span-column" val

data ComboBoxColumnSpanColumnPropertyInfo
instance AttrInfo ComboBoxColumnSpanColumnPropertyInfo where
    type AttrAllowedOps ComboBoxColumnSpanColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxColumnSpanColumnPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint ComboBoxColumnSpanColumnPropertyInfo = ComboBoxK
    type AttrGetType ComboBoxColumnSpanColumnPropertyInfo = Int32
    type AttrLabel ComboBoxColumnSpanColumnPropertyInfo = "ComboBox::column-span-column"
    attrGet _ = getComboBoxColumnSpanColumn
    attrSet _ = setComboBoxColumnSpanColumn
    attrConstruct _ = constructComboBoxColumnSpanColumn

-- VVV Prop "entry-text-column"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getComboBoxEntryTextColumn :: (MonadIO m, ComboBoxK o) => o -> m Int32
getComboBoxEntryTextColumn obj = liftIO $ getObjectPropertyCInt obj "entry-text-column"

setComboBoxEntryTextColumn :: (MonadIO m, ComboBoxK o) => o -> Int32 -> m ()
setComboBoxEntryTextColumn obj val = liftIO $ setObjectPropertyCInt obj "entry-text-column" val

constructComboBoxEntryTextColumn :: Int32 -> IO ([Char], GValue)
constructComboBoxEntryTextColumn val = constructObjectPropertyCInt "entry-text-column" val

data ComboBoxEntryTextColumnPropertyInfo
instance AttrInfo ComboBoxEntryTextColumnPropertyInfo where
    type AttrAllowedOps ComboBoxEntryTextColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxEntryTextColumnPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint ComboBoxEntryTextColumnPropertyInfo = ComboBoxK
    type AttrGetType ComboBoxEntryTextColumnPropertyInfo = Int32
    type AttrLabel ComboBoxEntryTextColumnPropertyInfo = "ComboBox::entry-text-column"
    attrGet _ = getComboBoxEntryTextColumn
    attrSet _ = setComboBoxEntryTextColumn
    attrConstruct _ = constructComboBoxEntryTextColumn

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

getComboBoxFocusOnClick :: (MonadIO m, ComboBoxK o) => o -> m Bool
getComboBoxFocusOnClick obj = liftIO $ getObjectPropertyBool obj "focus-on-click"

setComboBoxFocusOnClick :: (MonadIO m, ComboBoxK o) => o -> Bool -> m ()
setComboBoxFocusOnClick obj val = liftIO $ setObjectPropertyBool obj "focus-on-click" val

constructComboBoxFocusOnClick :: Bool -> IO ([Char], GValue)
constructComboBoxFocusOnClick val = constructObjectPropertyBool "focus-on-click" val

data ComboBoxFocusOnClickPropertyInfo
instance AttrInfo ComboBoxFocusOnClickPropertyInfo where
    type AttrAllowedOps ComboBoxFocusOnClickPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxFocusOnClickPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint ComboBoxFocusOnClickPropertyInfo = ComboBoxK
    type AttrGetType ComboBoxFocusOnClickPropertyInfo = Bool
    type AttrLabel ComboBoxFocusOnClickPropertyInfo = "ComboBox::focus-on-click"
    attrGet _ = getComboBoxFocusOnClick
    attrSet _ = setComboBoxFocusOnClick
    attrConstruct _ = constructComboBoxFocusOnClick

-- VVV Prop "has-entry"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getComboBoxHasEntry :: (MonadIO m, ComboBoxK o) => o -> m Bool
getComboBoxHasEntry obj = liftIO $ getObjectPropertyBool obj "has-entry"

constructComboBoxHasEntry :: Bool -> IO ([Char], GValue)
constructComboBoxHasEntry val = constructObjectPropertyBool "has-entry" val

data ComboBoxHasEntryPropertyInfo
instance AttrInfo ComboBoxHasEntryPropertyInfo where
    type AttrAllowedOps ComboBoxHasEntryPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxHasEntryPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint ComboBoxHasEntryPropertyInfo = ComboBoxK
    type AttrGetType ComboBoxHasEntryPropertyInfo = Bool
    type AttrLabel ComboBoxHasEntryPropertyInfo = "ComboBox::has-entry"
    attrGet _ = getComboBoxHasEntry
    attrSet _ = undefined
    attrConstruct _ = constructComboBoxHasEntry

-- VVV Prop "has-frame"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getComboBoxHasFrame :: (MonadIO m, ComboBoxK o) => o -> m Bool
getComboBoxHasFrame obj = liftIO $ getObjectPropertyBool obj "has-frame"

setComboBoxHasFrame :: (MonadIO m, ComboBoxK o) => o -> Bool -> m ()
setComboBoxHasFrame obj val = liftIO $ setObjectPropertyBool obj "has-frame" val

constructComboBoxHasFrame :: Bool -> IO ([Char], GValue)
constructComboBoxHasFrame val = constructObjectPropertyBool "has-frame" val

data ComboBoxHasFramePropertyInfo
instance AttrInfo ComboBoxHasFramePropertyInfo where
    type AttrAllowedOps ComboBoxHasFramePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxHasFramePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint ComboBoxHasFramePropertyInfo = ComboBoxK
    type AttrGetType ComboBoxHasFramePropertyInfo = Bool
    type AttrLabel ComboBoxHasFramePropertyInfo = "ComboBox::has-frame"
    attrGet _ = getComboBoxHasFrame
    attrSet _ = setComboBoxHasFrame
    attrConstruct _ = constructComboBoxHasFrame

-- VVV Prop "id-column"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getComboBoxIdColumn :: (MonadIO m, ComboBoxK o) => o -> m Int32
getComboBoxIdColumn obj = liftIO $ getObjectPropertyCInt obj "id-column"

setComboBoxIdColumn :: (MonadIO m, ComboBoxK o) => o -> Int32 -> m ()
setComboBoxIdColumn obj val = liftIO $ setObjectPropertyCInt obj "id-column" val

constructComboBoxIdColumn :: Int32 -> IO ([Char], GValue)
constructComboBoxIdColumn val = constructObjectPropertyCInt "id-column" val

data ComboBoxIdColumnPropertyInfo
instance AttrInfo ComboBoxIdColumnPropertyInfo where
    type AttrAllowedOps ComboBoxIdColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxIdColumnPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint ComboBoxIdColumnPropertyInfo = ComboBoxK
    type AttrGetType ComboBoxIdColumnPropertyInfo = Int32
    type AttrLabel ComboBoxIdColumnPropertyInfo = "ComboBox::id-column"
    attrGet _ = getComboBoxIdColumn
    attrSet _ = setComboBoxIdColumn
    attrConstruct _ = constructComboBoxIdColumn

-- VVV Prop "model"
   -- Type: TInterface "Gtk" "TreeModel"
   -- Flags: [PropertyReadable,PropertyWritable]

getComboBoxModel :: (MonadIO m, ComboBoxK o) => o -> m TreeModel
getComboBoxModel obj = liftIO $ getObjectPropertyObject obj "model" TreeModel

setComboBoxModel :: (MonadIO m, ComboBoxK o, TreeModelK a) => o -> a -> m ()
setComboBoxModel obj val = liftIO $ setObjectPropertyObject obj "model" val

constructComboBoxModel :: (TreeModelK a) => a -> IO ([Char], GValue)
constructComboBoxModel val = constructObjectPropertyObject "model" val

data ComboBoxModelPropertyInfo
instance AttrInfo ComboBoxModelPropertyInfo where
    type AttrAllowedOps ComboBoxModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxModelPropertyInfo = TreeModelK
    type AttrBaseTypeConstraint ComboBoxModelPropertyInfo = ComboBoxK
    type AttrGetType ComboBoxModelPropertyInfo = TreeModel
    type AttrLabel ComboBoxModelPropertyInfo = "ComboBox::model"
    attrGet _ = getComboBoxModel
    attrSet _ = setComboBoxModel
    attrConstruct _ = constructComboBoxModel

-- VVV Prop "popup-fixed-width"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getComboBoxPopupFixedWidth :: (MonadIO m, ComboBoxK o) => o -> m Bool
getComboBoxPopupFixedWidth obj = liftIO $ getObjectPropertyBool obj "popup-fixed-width"

setComboBoxPopupFixedWidth :: (MonadIO m, ComboBoxK o) => o -> Bool -> m ()
setComboBoxPopupFixedWidth obj val = liftIO $ setObjectPropertyBool obj "popup-fixed-width" val

constructComboBoxPopupFixedWidth :: Bool -> IO ([Char], GValue)
constructComboBoxPopupFixedWidth val = constructObjectPropertyBool "popup-fixed-width" val

data ComboBoxPopupFixedWidthPropertyInfo
instance AttrInfo ComboBoxPopupFixedWidthPropertyInfo where
    type AttrAllowedOps ComboBoxPopupFixedWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxPopupFixedWidthPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint ComboBoxPopupFixedWidthPropertyInfo = ComboBoxK
    type AttrGetType ComboBoxPopupFixedWidthPropertyInfo = Bool
    type AttrLabel ComboBoxPopupFixedWidthPropertyInfo = "ComboBox::popup-fixed-width"
    attrGet _ = getComboBoxPopupFixedWidth
    attrSet _ = setComboBoxPopupFixedWidth
    attrConstruct _ = constructComboBoxPopupFixedWidth

-- VVV Prop "popup-shown"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]

getComboBoxPopupShown :: (MonadIO m, ComboBoxK o) => o -> m Bool
getComboBoxPopupShown obj = liftIO $ getObjectPropertyBool obj "popup-shown"

data ComboBoxPopupShownPropertyInfo
instance AttrInfo ComboBoxPopupShownPropertyInfo where
    type AttrAllowedOps ComboBoxPopupShownPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ComboBoxPopupShownPropertyInfo = (~) ()
    type AttrBaseTypeConstraint ComboBoxPopupShownPropertyInfo = ComboBoxK
    type AttrGetType ComboBoxPopupShownPropertyInfo = Bool
    type AttrLabel ComboBoxPopupShownPropertyInfo = "ComboBox::popup-shown"
    attrGet _ = getComboBoxPopupShown
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "row-span-column"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getComboBoxRowSpanColumn :: (MonadIO m, ComboBoxK o) => o -> m Int32
getComboBoxRowSpanColumn obj = liftIO $ getObjectPropertyCInt obj "row-span-column"

setComboBoxRowSpanColumn :: (MonadIO m, ComboBoxK o) => o -> Int32 -> m ()
setComboBoxRowSpanColumn obj val = liftIO $ setObjectPropertyCInt obj "row-span-column" val

constructComboBoxRowSpanColumn :: Int32 -> IO ([Char], GValue)
constructComboBoxRowSpanColumn val = constructObjectPropertyCInt "row-span-column" val

data ComboBoxRowSpanColumnPropertyInfo
instance AttrInfo ComboBoxRowSpanColumnPropertyInfo where
    type AttrAllowedOps ComboBoxRowSpanColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxRowSpanColumnPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint ComboBoxRowSpanColumnPropertyInfo = ComboBoxK
    type AttrGetType ComboBoxRowSpanColumnPropertyInfo = Int32
    type AttrLabel ComboBoxRowSpanColumnPropertyInfo = "ComboBox::row-span-column"
    attrGet _ = getComboBoxRowSpanColumn
    attrSet _ = setComboBoxRowSpanColumn
    attrConstruct _ = constructComboBoxRowSpanColumn

-- VVV Prop "tearoff-title"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getComboBoxTearoffTitle :: (MonadIO m, ComboBoxK o) => o -> m T.Text
getComboBoxTearoffTitle obj = liftIO $ getObjectPropertyString obj "tearoff-title"

setComboBoxTearoffTitle :: (MonadIO m, ComboBoxK o) => o -> T.Text -> m ()
setComboBoxTearoffTitle obj val = liftIO $ setObjectPropertyString obj "tearoff-title" val

constructComboBoxTearoffTitle :: T.Text -> IO ([Char], GValue)
constructComboBoxTearoffTitle val = constructObjectPropertyString "tearoff-title" val

data ComboBoxTearoffTitlePropertyInfo
instance AttrInfo ComboBoxTearoffTitlePropertyInfo where
    type AttrAllowedOps ComboBoxTearoffTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxTearoffTitlePropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint ComboBoxTearoffTitlePropertyInfo = ComboBoxK
    type AttrGetType ComboBoxTearoffTitlePropertyInfo = T.Text
    type AttrLabel ComboBoxTearoffTitlePropertyInfo = "ComboBox::tearoff-title"
    attrGet _ = getComboBoxTearoffTitle
    attrSet _ = setComboBoxTearoffTitle
    attrConstruct _ = constructComboBoxTearoffTitle

-- VVV Prop "wrap-width"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getComboBoxWrapWidth :: (MonadIO m, ComboBoxK o) => o -> m Int32
getComboBoxWrapWidth obj = liftIO $ getObjectPropertyCInt obj "wrap-width"

setComboBoxWrapWidth :: (MonadIO m, ComboBoxK o) => o -> Int32 -> m ()
setComboBoxWrapWidth obj val = liftIO $ setObjectPropertyCInt obj "wrap-width" val

constructComboBoxWrapWidth :: Int32 -> IO ([Char], GValue)
constructComboBoxWrapWidth val = constructObjectPropertyCInt "wrap-width" val

data ComboBoxWrapWidthPropertyInfo
instance AttrInfo ComboBoxWrapWidthPropertyInfo where
    type AttrAllowedOps ComboBoxWrapWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ComboBoxWrapWidthPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint ComboBoxWrapWidthPropertyInfo = ComboBoxK
    type AttrGetType ComboBoxWrapWidthPropertyInfo = Int32
    type AttrLabel ComboBoxWrapWidthPropertyInfo = "ComboBox::wrap-width"
    attrGet _ = getComboBoxWrapWidth
    attrSet _ = setComboBoxWrapWidth
    attrConstruct _ = constructComboBoxWrapWidth

type instance AttributeList ComboBox = ComboBoxAttributeList
type ComboBoxAttributeList = ('[ '("active", ComboBoxActivePropertyInfo), '("active-id", ComboBoxActiveIdPropertyInfo), '("add-tearoffs", ComboBoxAddTearoffsPropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("button-sensitivity", ComboBoxButtonSensitivityPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("cell-area", ComboBoxCellAreaPropertyInfo), '("child", ContainerChildPropertyInfo), '("column-span-column", ComboBoxColumnSpanColumnPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("editing-canceled", CellEditableEditingCanceledPropertyInfo), '("entry-text-column", ComboBoxEntryTextColumnPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ComboBoxFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-entry", ComboBoxHasEntryPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-frame", ComboBoxHasFramePropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("id-column", ComboBoxIdColumnPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("model", ComboBoxModelPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("popup-fixed-width", ComboBoxPopupFixedWidthPropertyInfo), '("popup-shown", ComboBoxPopupShownPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("row-span-column", ComboBoxRowSpanColumnPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("style", WidgetStylePropertyInfo), '("tearoff-title", ComboBoxTearoffTitlePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("wrap-width", ComboBoxWrapWidthPropertyInfo)] :: [(Symbol, *)])

data ComboBoxChangedSignalInfo
instance SignalInfo ComboBoxChangedSignalInfo where
    type HaskellCallbackType ComboBoxChangedSignalInfo = ComboBoxChangedCallback
    connectSignal _ = connectComboBoxChanged

data ComboBoxFormatEntryTextSignalInfo
instance SignalInfo ComboBoxFormatEntryTextSignalInfo where
    type HaskellCallbackType ComboBoxFormatEntryTextSignalInfo = ComboBoxFormatEntryTextCallback
    connectSignal _ = connectComboBoxFormatEntryText

data ComboBoxMoveActiveSignalInfo
instance SignalInfo ComboBoxMoveActiveSignalInfo where
    type HaskellCallbackType ComboBoxMoveActiveSignalInfo = ComboBoxMoveActiveCallback
    connectSignal _ = connectComboBoxMoveActive

data ComboBoxPopdownSignalInfo
instance SignalInfo ComboBoxPopdownSignalInfo where
    type HaskellCallbackType ComboBoxPopdownSignalInfo = ComboBoxPopdownCallback
    connectSignal _ = connectComboBoxPopdown

data ComboBoxPopupSignalInfo
instance SignalInfo ComboBoxPopupSignalInfo where
    type HaskellCallbackType ComboBoxPopupSignalInfo = ComboBoxPopupCallback
    connectSignal _ = connectComboBoxPopup

type instance SignalList ComboBox = ComboBoxSignalList
type ComboBoxSignalList = ('[ '("accel-closures-changed", WidgetAccelClosuresChangedSignalInfo), '("add", ContainerAddSignalInfo), '("button-press-event", WidgetButtonPressEventSignalInfo), '("button-release-event", WidgetButtonReleaseEventSignalInfo), '("can-activate-accel", WidgetCanActivateAccelSignalInfo), '("changed", ComboBoxChangedSignalInfo), '("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), '("editing-done", CellEditableEditingDoneSignalInfo), '("enter-notify-event", WidgetEnterNotifyEventSignalInfo), '("event", WidgetEventSignalInfo), '("event-after", WidgetEventAfterSignalInfo), '("focus", WidgetFocusSignalInfo), '("focus-in-event", WidgetFocusInEventSignalInfo), '("focus-out-event", WidgetFocusOutEventSignalInfo), '("format-entry-text", ComboBoxFormatEntryTextSignalInfo), '("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-active", ComboBoxMoveActiveSignalInfo), '("move-focus", WidgetMoveFocusSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("parent-set", WidgetParentSetSignalInfo), '("popdown", ComboBoxPopdownSignalInfo), '("popup", ComboBoxPopupSignalInfo), '("popup-menu", WidgetPopupMenuSignalInfo), '("property-notify-event", WidgetPropertyNotifyEventSignalInfo), '("proximity-in-event", WidgetProximityInEventSignalInfo), '("proximity-out-event", WidgetProximityOutEventSignalInfo), '("query-tooltip", WidgetQueryTooltipSignalInfo), '("realize", WidgetRealizeSignalInfo), '("remove", ContainerRemoveSignalInfo), '("remove-widget", CellEditableRemoveWidgetSignalInfo), '("screen-changed", WidgetScreenChangedSignalInfo), '("scroll-event", WidgetScrollEventSignalInfo), '("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), '("touch-event", WidgetTouchEventSignalInfo), '("unmap", WidgetUnmapSignalInfo), '("unmap-event", WidgetUnmapEventSignalInfo), '("unrealize", WidgetUnrealizeSignalInfo), '("visibility-notify-event", WidgetVisibilityNotifyEventSignalInfo), '("window-state-event", WidgetWindowStateEventSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

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

foreign import ccall "gtk_combo_box_new" gtk_combo_box_new :: 
    IO (Ptr ComboBox)


comboBoxNew ::
    (MonadIO m) =>
    m ComboBox
comboBoxNew  = liftIO $ do
    result <- gtk_combo_box_new
    checkUnexpectedReturnNULL "gtk_combo_box_new" result
    result' <- (newObject ComboBox) result
    return result'

-- method ComboBox::new_with_area
-- method type : Constructor
-- Args : [Arg {argName = "area", argType = TInterface "Gtk" "CellArea", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "area", argType = TInterface "Gtk" "CellArea", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "ComboBox"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_combo_box_new_with_area" gtk_combo_box_new_with_area :: 
    Ptr CellArea ->                         -- area : TInterface "Gtk" "CellArea"
    IO (Ptr ComboBox)


comboBoxNewWithArea ::
    (MonadIO m, CellAreaK a) =>
    a ->                                    -- area
    m ComboBox
comboBoxNewWithArea area = liftIO $ do
    let area' = unsafeManagedPtrCastPtr area
    result <- gtk_combo_box_new_with_area area'
    checkUnexpectedReturnNULL "gtk_combo_box_new_with_area" result
    result' <- (newObject ComboBox) result
    touchManagedPtr area
    return result'

-- method ComboBox::new_with_area_and_entry
-- method type : Constructor
-- Args : [Arg {argName = "area", argType = TInterface "Gtk" "CellArea", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "area", argType = TInterface "Gtk" "CellArea", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "ComboBox"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_combo_box_new_with_area_and_entry" gtk_combo_box_new_with_area_and_entry :: 
    Ptr CellArea ->                         -- area : TInterface "Gtk" "CellArea"
    IO (Ptr ComboBox)


comboBoxNewWithAreaAndEntry ::
    (MonadIO m, CellAreaK a) =>
    a ->                                    -- area
    m ComboBox
comboBoxNewWithAreaAndEntry area = liftIO $ do
    let area' = unsafeManagedPtrCastPtr area
    result <- gtk_combo_box_new_with_area_and_entry area'
    checkUnexpectedReturnNULL "gtk_combo_box_new_with_area_and_entry" result
    result' <- (newObject ComboBox) result
    touchManagedPtr area
    return result'

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

foreign import ccall "gtk_combo_box_new_with_entry" gtk_combo_box_new_with_entry :: 
    IO (Ptr ComboBox)


comboBoxNewWithEntry ::
    (MonadIO m) =>
    m ComboBox
comboBoxNewWithEntry  = liftIO $ do
    result <- gtk_combo_box_new_with_entry
    checkUnexpectedReturnNULL "gtk_combo_box_new_with_entry" result
    result' <- (newObject ComboBox) result
    return result'

-- method ComboBox::new_with_model
-- method type : Constructor
-- Args : [Arg {argName = "model", argType = TInterface "Gtk" "TreeModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "model", argType = TInterface "Gtk" "TreeModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "ComboBox"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_combo_box_new_with_model" gtk_combo_box_new_with_model :: 
    Ptr TreeModel ->                        -- model : TInterface "Gtk" "TreeModel"
    IO (Ptr ComboBox)


comboBoxNewWithModel ::
    (MonadIO m, TreeModelK a) =>
    a ->                                    -- model
    m ComboBox
comboBoxNewWithModel model = liftIO $ do
    let model' = unsafeManagedPtrCastPtr model
    result <- gtk_combo_box_new_with_model model'
    checkUnexpectedReturnNULL "gtk_combo_box_new_with_model" result
    result' <- (newObject ComboBox) result
    touchManagedPtr model
    return result'

-- method ComboBox::new_with_model_and_entry
-- method type : Constructor
-- Args : [Arg {argName = "model", argType = TInterface "Gtk" "TreeModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "model", argType = TInterface "Gtk" "TreeModel", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "ComboBox"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_combo_box_new_with_model_and_entry" gtk_combo_box_new_with_model_and_entry :: 
    Ptr TreeModel ->                        -- model : TInterface "Gtk" "TreeModel"
    IO (Ptr ComboBox)


comboBoxNewWithModelAndEntry ::
    (MonadIO m, TreeModelK a) =>
    a ->                                    -- model
    m ComboBox
comboBoxNewWithModelAndEntry model = liftIO $ do
    let model' = unsafeManagedPtrCastPtr model
    result <- gtk_combo_box_new_with_model_and_entry model'
    checkUnexpectedReturnNULL "gtk_combo_box_new_with_model_and_entry" result
    result' <- (newObject ComboBox) result
    touchManagedPtr model
    return result'

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

foreign import ccall "gtk_combo_box_get_active" gtk_combo_box_get_active :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO Int32


comboBoxGetActive ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    m Int32
comboBoxGetActive _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_combo_box_get_active _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "gtk_combo_box_get_active_id" gtk_combo_box_get_active_id :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO CString


comboBoxGetActiveId ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    m T.Text
comboBoxGetActiveId _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_combo_box_get_active_id _obj'
    checkUnexpectedReturnNULL "gtk_combo_box_get_active_id" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "gtk_combo_box_get_active_iter" gtk_combo_box_get_active_iter :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    Ptr TreeIter ->                         -- iter : TInterface "Gtk" "TreeIter"
    IO CInt


comboBoxGetActiveIter ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    m (Bool,TreeIter)
comboBoxGetActiveIter _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    iter <- callocBoxedBytes 32 :: IO (Ptr TreeIter)
    result <- gtk_combo_box_get_active_iter _obj' iter
    let result' = (/= 0) result
    iter' <- (wrapBoxed TreeIter) iter
    touchManagedPtr _obj
    return (result', iter')

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

foreign import ccall "gtk_combo_box_get_add_tearoffs" gtk_combo_box_get_add_tearoffs :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO CInt

{-# DEPRECATED comboBoxGetAddTearoffs ["(Since version 3.10)"]#-}
comboBoxGetAddTearoffs ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    m Bool
comboBoxGetAddTearoffs _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_combo_box_get_add_tearoffs _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "gtk_combo_box_get_button_sensitivity" gtk_combo_box_get_button_sensitivity :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO CUInt


comboBoxGetButtonSensitivity ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    m SensitivityType
comboBoxGetButtonSensitivity _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_combo_box_get_button_sensitivity _obj'
    let result' = (toEnum . fromIntegral) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "gtk_combo_box_get_column_span_column" gtk_combo_box_get_column_span_column :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO Int32


comboBoxGetColumnSpanColumn ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    m Int32
comboBoxGetColumnSpanColumn _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_combo_box_get_column_span_column _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "gtk_combo_box_get_entry_text_column" gtk_combo_box_get_entry_text_column :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO Int32


comboBoxGetEntryTextColumn ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    m Int32
comboBoxGetEntryTextColumn _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_combo_box_get_entry_text_column _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "gtk_combo_box_get_focus_on_click" gtk_combo_box_get_focus_on_click :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO CInt


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

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

foreign import ccall "gtk_combo_box_get_has_entry" gtk_combo_box_get_has_entry :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO CInt


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

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

foreign import ccall "gtk_combo_box_get_id_column" gtk_combo_box_get_id_column :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO Int32


comboBoxGetIdColumn ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    m Int32
comboBoxGetIdColumn _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_combo_box_get_id_column _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "gtk_combo_box_get_model" gtk_combo_box_get_model :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO (Ptr TreeModel)


comboBoxGetModel ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    m TreeModel
comboBoxGetModel _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_combo_box_get_model _obj'
    checkUnexpectedReturnNULL "gtk_combo_box_get_model" result
    result' <- (newObject TreeModel) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "gtk_combo_box_get_popup_accessible" gtk_combo_box_get_popup_accessible :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO (Ptr Atk.Object)


comboBoxGetPopupAccessible ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    m Atk.Object
comboBoxGetPopupAccessible _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_combo_box_get_popup_accessible _obj'
    checkUnexpectedReturnNULL "gtk_combo_box_get_popup_accessible" result
    result' <- (newObject Atk.Object) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "gtk_combo_box_get_popup_fixed_width" gtk_combo_box_get_popup_fixed_width :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO CInt


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

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

foreign import ccall "gtk_combo_box_get_row_span_column" gtk_combo_box_get_row_span_column :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO Int32


comboBoxGetRowSpanColumn ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    m Int32
comboBoxGetRowSpanColumn _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_combo_box_get_row_span_column _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "gtk_combo_box_get_title" gtk_combo_box_get_title :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO CString

{-# DEPRECATED comboBoxGetTitle ["(Since version 3.10)"]#-}
comboBoxGetTitle ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    m T.Text
comboBoxGetTitle _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_combo_box_get_title _obj'
    checkUnexpectedReturnNULL "gtk_combo_box_get_title" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "gtk_combo_box_get_wrap_width" gtk_combo_box_get_wrap_width :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO Int32


comboBoxGetWrapWidth ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    m Int32
comboBoxGetWrapWidth _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_combo_box_get_wrap_width _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "gtk_combo_box_popdown" gtk_combo_box_popdown :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO ()


comboBoxPopdown ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    m ()
comboBoxPopdown _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_combo_box_popdown _obj'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "gtk_combo_box_popup" gtk_combo_box_popup :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    IO ()


comboBoxPopup ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    m ()
comboBoxPopup _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_combo_box_popup _obj'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "gtk_combo_box_popup_for_device" gtk_combo_box_popup_for_device :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    Ptr Gdk.Device ->                       -- device : TInterface "Gdk" "Device"
    IO ()


comboBoxPopupForDevice ::
    (MonadIO m, ComboBoxK a, Gdk.DeviceK b) =>
    a ->                                    -- _obj
    b ->                                    -- device
    m ()
comboBoxPopupForDevice _obj device = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let device' = unsafeManagedPtrCastPtr device
    gtk_combo_box_popup_for_device _obj' device'
    touchManagedPtr _obj
    touchManagedPtr device
    return ()

-- method ComboBox::set_active
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", 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" "ComboBox", 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 : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_combo_box_set_active" gtk_combo_box_set_active :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    Int32 ->                                -- index_ : TBasicType TInt32
    IO ()


comboBoxSetActive ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- index_
    m ()
comboBoxSetActive _obj index_ = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_combo_box_set_active _obj' index_
    touchManagedPtr _obj
    return ()

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

foreign import ccall "gtk_combo_box_set_active_id" gtk_combo_box_set_active_id :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    CString ->                              -- active_id : TBasicType TUTF8
    IO CInt


comboBoxSetActiveId ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    Maybe (T.Text) ->                       -- active_id
    m Bool
comboBoxSetActiveId _obj active_id = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeActive_id <- case active_id of
        Nothing -> return nullPtr
        Just jActive_id -> do
            jActive_id' <- textToCString jActive_id
            return jActive_id'
    result <- gtk_combo_box_set_active_id _obj' maybeActive_id
    let result' = (/= 0) result
    touchManagedPtr _obj
    freeMem maybeActive_id
    return result'

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

foreign import ccall "gtk_combo_box_set_active_iter" gtk_combo_box_set_active_iter :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    Ptr TreeIter ->                         -- iter : TInterface "Gtk" "TreeIter"
    IO ()


comboBoxSetActiveIter ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    Maybe (TreeIter) ->                     -- iter
    m ()
comboBoxSetActiveIter _obj iter = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeIter <- case iter of
        Nothing -> return nullPtr
        Just jIter -> do
            let jIter' = unsafeManagedPtrGetPtr jIter
            return jIter'
    gtk_combo_box_set_active_iter _obj' maybeIter
    touchManagedPtr _obj
    whenJust iter touchManagedPtr
    return ()

-- method ComboBox::set_add_tearoffs
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "add_tearoffs", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "add_tearoffs", 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_combo_box_set_add_tearoffs" gtk_combo_box_set_add_tearoffs :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    CInt ->                                 -- add_tearoffs : TBasicType TBoolean
    IO ()

{-# DEPRECATED comboBoxSetAddTearoffs ["(Since version 3.10)"]#-}
comboBoxSetAddTearoffs ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- add_tearoffs
    m ()
comboBoxSetAddTearoffs _obj add_tearoffs = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let add_tearoffs' = (fromIntegral . fromEnum) add_tearoffs
    gtk_combo_box_set_add_tearoffs _obj' add_tearoffs'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "gtk_combo_box_set_button_sensitivity" gtk_combo_box_set_button_sensitivity :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    CUInt ->                                -- sensitivity : TInterface "Gtk" "SensitivityType"
    IO ()


comboBoxSetButtonSensitivity ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    SensitivityType ->                      -- sensitivity
    m ()
comboBoxSetButtonSensitivity _obj sensitivity = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let sensitivity' = (fromIntegral . fromEnum) sensitivity
    gtk_combo_box_set_button_sensitivity _obj' sensitivity'
    touchManagedPtr _obj
    return ()

-- method ComboBox::set_column_span_column
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "column_span", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "column_span", 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_combo_box_set_column_span_column" gtk_combo_box_set_column_span_column :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    Int32 ->                                -- column_span : TBasicType TInt32
    IO ()


comboBoxSetColumnSpanColumn ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- column_span
    m ()
comboBoxSetColumnSpanColumn _obj column_span = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_combo_box_set_column_span_column _obj' column_span
    touchManagedPtr _obj
    return ()

-- method ComboBox::set_entry_text_column
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text_column", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text_column", 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_combo_box_set_entry_text_column" gtk_combo_box_set_entry_text_column :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    Int32 ->                                -- text_column : TBasicType TInt32
    IO ()


comboBoxSetEntryTextColumn ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- text_column
    m ()
comboBoxSetEntryTextColumn _obj text_column = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_combo_box_set_entry_text_column _obj' text_column
    touchManagedPtr _obj
    return ()

-- method ComboBox::set_focus_on_click
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "focus_on_click", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "focus_on_click", 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_combo_box_set_focus_on_click" gtk_combo_box_set_focus_on_click :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    CInt ->                                 -- focus_on_click : TBasicType TBoolean
    IO ()


comboBoxSetFocusOnClick ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- focus_on_click
    m ()
comboBoxSetFocusOnClick _obj focus_on_click = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let focus_on_click' = (fromIntegral . fromEnum) focus_on_click
    gtk_combo_box_set_focus_on_click _obj' focus_on_click'
    touchManagedPtr _obj
    return ()

-- method ComboBox::set_id_column
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "id_column", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "id_column", 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_combo_box_set_id_column" gtk_combo_box_set_id_column :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    Int32 ->                                -- id_column : TBasicType TInt32
    IO ()


comboBoxSetIdColumn ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- id_column
    m ()
comboBoxSetIdColumn _obj id_column = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_combo_box_set_id_column _obj' id_column
    touchManagedPtr _obj
    return ()

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

foreign import ccall "gtk_combo_box_set_model" gtk_combo_box_set_model :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    Ptr TreeModel ->                        -- model : TInterface "Gtk" "TreeModel"
    IO ()


comboBoxSetModel ::
    (MonadIO m, ComboBoxK a, TreeModelK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- model
    m ()
comboBoxSetModel _obj model = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeModel <- case model of
        Nothing -> return nullPtr
        Just jModel -> do
            let jModel' = unsafeManagedPtrCastPtr jModel
            return jModel'
    gtk_combo_box_set_model _obj' maybeModel
    touchManagedPtr _obj
    whenJust model touchManagedPtr
    return ()

-- method ComboBox::set_popup_fixed_width
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fixed", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "fixed", 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_combo_box_set_popup_fixed_width" gtk_combo_box_set_popup_fixed_width :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    CInt ->                                 -- fixed : TBasicType TBoolean
    IO ()


comboBoxSetPopupFixedWidth ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- fixed
    m ()
comboBoxSetPopupFixedWidth _obj fixed = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let fixed' = (fromIntegral . fromEnum) fixed
    gtk_combo_box_set_popup_fixed_width _obj' fixed'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "gtk_combo_box_set_row_separator_func" gtk_combo_box_set_row_separator_func :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    FunPtr TreeViewRowSeparatorFuncC ->     -- func : TInterface "Gtk" "TreeViewRowSeparatorFunc"
    Ptr () ->                               -- data : TBasicType TVoid
    FunPtr GLib.DestroyNotifyC ->           -- destroy : TInterface "GLib" "DestroyNotify"
    IO ()


comboBoxSetRowSeparatorFunc ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    TreeViewRowSeparatorFunc ->             -- func
    m ()
comboBoxSetRowSeparatorFunc _obj func = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    func' <- mkTreeViewRowSeparatorFunc (treeViewRowSeparatorFuncWrapper Nothing func)
    let data_ = castFunPtrToPtr func'
    let destroy = safeFreeFunPtrPtr
    gtk_combo_box_set_row_separator_func _obj' func' data_ destroy
    touchManagedPtr _obj
    return ()

-- method ComboBox::set_row_span_column
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "row_span", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "row_span", 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_combo_box_set_row_span_column" gtk_combo_box_set_row_span_column :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    Int32 ->                                -- row_span : TBasicType TInt32
    IO ()


comboBoxSetRowSpanColumn ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- row_span
    m ()
comboBoxSetRowSpanColumn _obj row_span = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_combo_box_set_row_span_column _obj' row_span
    touchManagedPtr _obj
    return ()

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

foreign import ccall "gtk_combo_box_set_title" gtk_combo_box_set_title :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    CString ->                              -- title : TBasicType TUTF8
    IO ()

{-# DEPRECATED comboBoxSetTitle ["(Since version 3.10)"]#-}
comboBoxSetTitle ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- title
    m ()
comboBoxSetTitle _obj title = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    title' <- textToCString title
    gtk_combo_box_set_title _obj' title'
    touchManagedPtr _obj
    freeMem title'
    return ()

-- method ComboBox::set_wrap_width
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ComboBox", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", 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_combo_box_set_wrap_width" gtk_combo_box_set_wrap_width :: 
    Ptr ComboBox ->                         -- _obj : TInterface "Gtk" "ComboBox"
    Int32 ->                                -- width : TBasicType TInt32
    IO ()


comboBoxSetWrapWidth ::
    (MonadIO m, ComboBoxK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- width
    m ()
comboBoxSetWrapWidth _obj width = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_combo_box_set_wrap_width _obj' width
    touchManagedPtr _obj
    return ()