{- | 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 ()