module Graphics.UI.Gtk.MenuComboToolbar.ComboBox (
ComboBox,
ComboBoxClass,
castToComboBox, gTypeComboBox,
toComboBox,
ComboBoxText,
comboBoxNew,
comboBoxNewWithEntry,
comboBoxNewText,
comboBoxNewWithModel,
comboBoxNewWithModelAndEntry,
comboBoxSetModelText,
comboBoxGetModelText,
comboBoxAppendText,
comboBoxInsertText,
comboBoxPrependText,
comboBoxRemoveText,
comboBoxGetActiveText,
comboBoxGetWrapWidth,
comboBoxSetWrapWidth,
comboBoxGetRowSpanColumn,
comboBoxSetRowSpanColumn,
comboBoxGetColumnSpanColumn,
comboBoxSetColumnSpanColumn,
comboBoxGetActive,
comboBoxSetActive,
comboBoxGetActiveIter,
comboBoxSetActiveIter,
comboBoxGetModel,
comboBoxSetModel,
comboBoxPopup,
comboBoxPopdown,
comboBoxSetRowSeparatorSource,
comboBoxSetAddTearoffs,
comboBoxGetAddTearoffs,
comboBoxSetTitle,
comboBoxGetTitle,
comboBoxSetFocusOnClick,
comboBoxGetFocusOnClick,
comboBoxModel,
comboBoxWrapWidth,
comboBoxRowSpanColumn,
comboBoxColumnSpanColumn,
comboBoxActive,
comboBoxAddTearoffs,
comboBoxHasFrame,
comboBoxFocusOnClick,
comboBoxTearoffTitle,
comboBoxPopupShown,
comboBoxTitle,
comboBoxGetHasEntry,
comboBoxSetEntryTextColumn,
comboBoxGetEntryTextColumn,
changed,
onChanged,
afterChanged,
) where
import Control.Monad (liftM)
import Data.Text (Text)
import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import System.Glib.GObject (makeNewGObject,
destroyFunPtr,
Quark, objectSetAttribute, objectGetAttributeUnsafe )
import Graphics.UI.Gtk.Types hiding (ListStore)
import Graphics.UI.Gtk.ModelView.Types (TypedTreeModelClass,
TreeIter,
receiveTreeIter,
comboQuark)
import Graphics.UI.Gtk.Signals
import Graphics.UI.Gtk.ModelView.CustomStore
import Graphics.UI.Gtk.ModelView.TreeModel
import Graphics.UI.Gtk.ModelView.ListStore ( ListStore, listStoreNew,
listStoreInsert, listStorePrepend, listStoreAppend, listStoreRemove,
listStoreSafeGetValue )
import Graphics.UI.Gtk.ModelView.CellLayout ( cellLayoutSetAttributes,
cellLayoutPackStart, cellLayoutClear )
import Graphics.UI.Gtk.ModelView.CellRendererText ( cellRendererTextNew,
cellText)
comboBoxNew :: IO ComboBox
comboBoxNew =
makeNewObject mkComboBox $
liftM (castPtr :: Ptr Widget -> Ptr ComboBox) $
gtk_combo_box_new
comboBoxNewWithEntry :: IO ComboBox
comboBoxNewWithEntry =
makeNewObject mkComboBox $
liftM (castPtr :: Ptr Widget -> Ptr ComboBox) $
gtk_combo_box_new_with_entry
comboBoxNewText :: IO ComboBox
comboBoxNewText = do
combo <- comboBoxNew
comboBoxSetModelText combo
return combo
comboBoxNewWithModel :: TreeModelClass model =>
model
-> IO ComboBox
comboBoxNewWithModel model =
makeNewObject mkComboBox $
liftM (castPtr :: Ptr Widget -> Ptr ComboBox) $
(\(TreeModel arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_new_with_model argPtr1)
(toTreeModel model)
comboBoxNewWithModelAndEntry :: TreeModelClass model =>
model
-> IO ComboBox
comboBoxNewWithModelAndEntry model =
makeNewObject mkComboBox $
liftM (castPtr :: Ptr Widget -> Ptr ComboBox) $
(\(TreeModel arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_new_with_model_and_entry argPtr1)
(toTreeModel model)
type ComboBoxText = Text
comboBoxSetModelText :: ComboBoxClass self => self -> IO (ListStore ComboBoxText)
comboBoxSetModelText combo = do
cellLayoutClear (toComboBox combo)
store <- listStoreNew ([] :: [ComboBoxText])
comboBoxSetModel combo (Just store)
let colId = makeColumnIdString 0
customStoreSetColumn store colId id
comboBoxSetEntryTextColumn (toComboBox combo) colId
ren <- cellRendererTextNew
cellLayoutPackStart (toComboBox combo) ren True
cellLayoutSetAttributes (toComboBox combo) ren store (\a -> [cellText := a])
objectSetAttribute comboQuark combo (Just store)
return store
comboBoxGetModelText :: ComboBoxClass self => self -> IO (ListStore ComboBoxText)
comboBoxGetModelText self = do
(Just store) <- objectGetAttributeUnsafe comboQuark (toComboBox self)
return store
comboBoxAppendText :: ComboBoxClass self => self -> ComboBoxText -> IO Int
comboBoxAppendText self text = do
store <- comboBoxGetModelText self
listStoreAppend store text
comboBoxInsertText :: ComboBoxClass self => self
-> Int
-> ComboBoxText
-> IO ()
comboBoxInsertText self position text = do
store <- comboBoxGetModelText self
listStoreInsert store position text
comboBoxPrependText :: ComboBoxClass self => self -> ComboBoxText -> IO ()
comboBoxPrependText self text = do
store <- comboBoxGetModelText self
listStorePrepend store text
comboBoxRemoveText :: ComboBoxClass self => self
-> Int
-> IO ()
comboBoxRemoveText self position = do
store <- comboBoxGetModelText self
listStoreRemove store position
comboBoxGetActiveText :: ComboBoxClass self => self -> IO (Maybe ComboBoxText)
comboBoxGetActiveText self = do
activeId <- comboBoxGetActive self
if activeId < 0
then return Nothing
else do
listStore <- comboBoxGetModelText self
listStoreSafeGetValue listStore activeId
comboBoxGetWrapWidth :: ComboBoxClass self => self -> IO Int
comboBoxGetWrapWidth self =
liftM fromIntegral $
(\(ComboBox arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_get_wrap_width argPtr1)
(toComboBox self)
comboBoxSetWrapWidth :: ComboBoxClass self => self -> Int -> IO ()
comboBoxSetWrapWidth self width =
(\(ComboBox arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_set_wrap_width argPtr1 arg2)
(toComboBox self)
(fromIntegral width)
comboBoxGetRowSpanColumn :: ComboBoxClass self => self -> IO (ColumnId row Int)
comboBoxGetRowSpanColumn self =
liftM (makeColumnIdInt . fromIntegral) $
(\(ComboBox arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_get_row_span_column argPtr1)
(toComboBox self)
comboBoxSetRowSpanColumn :: ComboBoxClass self => self -> ColumnId row Int -> IO ()
comboBoxSetRowSpanColumn self rowSpan =
(\(ComboBox arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_set_row_span_column argPtr1 arg2)
(toComboBox self)
((fromIntegral . columnIdToNumber) rowSpan)
comboBoxGetColumnSpanColumn :: ComboBoxClass self => self -> IO (ColumnId row Int)
comboBoxGetColumnSpanColumn self =
liftM (makeColumnIdInt . fromIntegral) $
(\(ComboBox arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_get_column_span_column argPtr1)
(toComboBox self)
comboBoxSetColumnSpanColumn :: ComboBoxClass self => self -> ColumnId row Int -> IO ()
comboBoxSetColumnSpanColumn self columnSpan =
(\(ComboBox arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_set_column_span_column argPtr1 arg2)
(toComboBox self)
((fromIntegral . columnIdToNumber) columnSpan)
comboBoxGetActive :: ComboBoxClass self => self
-> IO Int
comboBoxGetActive self =
liftM fromIntegral $
(\(ComboBox arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_get_active argPtr1)
(toComboBox self)
comboBoxSetActive :: ComboBoxClass self => self
-> Int
-> IO ()
comboBoxSetActive self index =
(\(ComboBox arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_set_active argPtr1 arg2)
(toComboBox self)
(fromIntegral index)
comboBoxGetActiveIter :: ComboBoxClass self => self -> IO (Maybe TreeIter)
comboBoxGetActiveIter self =
receiveTreeIter $ \iterPtr ->
(\(ComboBox arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_get_active_iter argPtr1 arg2)
(toComboBox self)
iterPtr
comboBoxSetActiveIter :: ComboBoxClass self => self
-> TreeIter
-> IO ()
comboBoxSetActiveIter self iter =
with iter $ \iterPtr ->
(\(ComboBox arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_set_active_iter argPtr1 arg2)
(toComboBox self)
iterPtr
comboBoxGetModel :: ComboBoxClass self
=> self
-> IO (Maybe TreeModel)
comboBoxGetModel self =
maybeNull (makeNewGObject mkTreeModel) $
(\(ComboBox arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_get_model argPtr1)
(toComboBox self)
comboBoxSetModel :: (ComboBoxClass self, TreeModelClass model) => self ->
Maybe model -> IO ()
comboBoxSetModel self model =
(\(ComboBox arg1) (TreeModel arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gtk_combo_box_set_model argPtr1 argPtr2)
(toComboBox self)
(maybe (TreeModel nullForeignPtr) toTreeModel model)
comboBoxPopup :: ComboBoxClass self => self -> IO ()
comboBoxPopup self =
(\(ComboBox arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_popup argPtr1)
(toComboBox self)
comboBoxPopdown :: ComboBoxClass self => self -> IO ()
comboBoxPopdown self =
(\(ComboBox arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_popdown argPtr1)
(toComboBox self)
comboBoxSetRowSeparatorSource :: (ComboBoxClass self,
TreeModelClass (model row),
TypedTreeModelClass model)
=> self
-> Maybe (model row, row -> Bool)
-> IO ()
comboBoxSetRowSeparatorSource self Nothing =
(\(ComboBox arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_set_row_separator_func argPtr1 arg2 arg3 arg4)
(toComboBox self) nullFunPtr nullPtr nullFunPtr
comboBoxSetRowSeparatorSource self (Just (model, extract)) = do
funPtr <- mkRowSeparatorFunc $ \_ iterPtr _ -> do
iter <- peek iterPtr
value <- customStoreGetRow model iter
return (fromBool $ extract value)
(\(ComboBox arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_set_row_separator_func argPtr1 arg2 arg3 arg4)
(toComboBox self) funPtr (castFunPtrToPtr funPtr) destroyFunPtr
type TreeViewRowSeparatorFunc = FunPtr (((Ptr TreeModel) -> ((Ptr TreeIter) -> ((Ptr ()) -> (IO CInt)))))
foreign import ccall "wrapper" mkRowSeparatorFunc ::
(Ptr TreeModel -> Ptr TreeIter -> Ptr () -> IO (CInt)) -> IO TreeViewRowSeparatorFunc
comboBoxSetAddTearoffs :: ComboBoxClass self => self
-> Bool
-> IO ()
comboBoxSetAddTearoffs self addTearoffs =
(\(ComboBox arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_set_add_tearoffs argPtr1 arg2)
(toComboBox self)
(fromBool addTearoffs)
comboBoxGetAddTearoffs :: ComboBoxClass self => self -> IO Bool
comboBoxGetAddTearoffs self =
liftM toBool $
(\(ComboBox arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_get_add_tearoffs argPtr1)
(toComboBox self)
comboBoxSetTitle :: (ComboBoxClass self, GlibString string) => self
-> string
-> IO ()
comboBoxSetTitle self title =
withUTFString title $ \titlePtr ->
(\(ComboBox arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_set_title argPtr1 arg2)
(toComboBox self)
titlePtr
comboBoxGetTitle :: (ComboBoxClass self, GlibString string) => self
-> IO string
comboBoxGetTitle self =
(\(ComboBox arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_get_title argPtr1)
(toComboBox self)
>>= peekUTFString
comboBoxGetHasEntry :: ComboBoxClass self => self
-> IO Bool
comboBoxGetHasEntry self =
liftM toBool $
(\(ComboBox arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_get_has_entry argPtr1)
(toComboBox self)
comboBoxSetEntryTextColumn :: ComboBoxClass comboBox => comboBox
-> ColumnId row ComboBoxText
-> IO ()
comboBoxSetEntryTextColumn comboBox textColumn =
(\(ComboBox arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_set_entry_text_column argPtr1 arg2)
(toComboBox comboBox)
((fromIntegral . columnIdToNumber) textColumn)
comboBoxGetEntryTextColumn :: ComboBoxClass comboBox => comboBox
-> IO (ColumnId row ComboBoxText)
comboBoxGetEntryTextColumn comboBox =
liftM (makeColumnIdString . fromIntegral) $
(\(ComboBox arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_get_entry_text_column argPtr1)
(toComboBox comboBox)
comboBoxSetFocusOnClick :: ComboBoxClass self => self
-> Bool
-> IO ()
comboBoxSetFocusOnClick self focusOnClick =
(\(ComboBox arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_set_focus_on_click argPtr1 arg2)
(toComboBox self)
(fromBool focusOnClick)
comboBoxGetFocusOnClick :: ComboBoxClass self => self
-> IO Bool
comboBoxGetFocusOnClick self =
liftM toBool $
(\(ComboBox arg1) -> withForeignPtr arg1 $ \argPtr1 ->gtk_combo_box_get_focus_on_click argPtr1)
(toComboBox self)
comboBoxModel :: (ComboBoxClass self, TreeModelClass treeModel) => ReadWriteAttr self TreeModel treeModel
comboBoxModel = newAttrFromObjectProperty "model"
gtk_tree_model_get_type
comboBoxWrapWidth :: ComboBoxClass self => Attr self Int
comboBoxWrapWidth = newAttrFromIntProperty "wrap-width"
comboBoxRowSpanColumn :: ComboBoxClass self => Attr self (ColumnId row Int)
comboBoxRowSpanColumn = newAttr
comboBoxGetRowSpanColumn
comboBoxSetRowSpanColumn
comboBoxColumnSpanColumn :: ComboBoxClass self => Attr self (ColumnId row Int)
comboBoxColumnSpanColumn = newAttr
comboBoxGetColumnSpanColumn
comboBoxSetColumnSpanColumn
comboBoxActive :: ComboBoxClass self => Attr self Int
comboBoxActive = newAttrFromIntProperty "active"
comboBoxAddTearoffs :: ComboBoxClass self => Attr self Bool
comboBoxAddTearoffs = newAttrFromBoolProperty "add-tearoffs"
comboBoxHasFrame :: ComboBoxClass self => Attr self Bool
comboBoxHasFrame = newAttrFromBoolProperty "has-frame"
comboBoxFocusOnClick :: ComboBoxClass self => Attr self Bool
comboBoxFocusOnClick = newAttrFromBoolProperty "focus-on-click"
comboBoxTearoffTitle :: (ComboBoxClass self, GlibString string) => Attr self string
comboBoxTearoffTitle = newAttrFromStringProperty "tearoff-title"
comboBoxPopupShown :: ComboBoxClass self => ReadAttr self Bool
comboBoxPopupShown = readAttrFromBoolProperty "popup-shown"
comboBoxTitle :: (ComboBoxClass self, GlibString string) => Attr self string
comboBoxTitle = newAttr
comboBoxGetTitle
comboBoxSetTitle
changed :: ComboBoxClass self => Signal self (IO ())
changed = Signal (connect_NONE__NONE "changed")
onChanged :: ComboBoxClass self => self
-> IO ()
-> IO (ConnectId self)
onChanged = connect_NONE__NONE "changed" False
afterChanged :: ComboBoxClass self => self
-> IO ()
-> IO (ConnectId self)
afterChanged = connect_NONE__NONE "changed" True
foreign import ccall safe "gtk_combo_box_new"
gtk_combo_box_new :: (IO (Ptr Widget))
foreign import ccall safe "gtk_combo_box_new_with_entry"
gtk_combo_box_new_with_entry :: (IO (Ptr Widget))
foreign import ccall safe "gtk_combo_box_new_with_model"
gtk_combo_box_new_with_model :: ((Ptr TreeModel) -> (IO (Ptr Widget)))
foreign import ccall safe "gtk_combo_box_new_with_model_and_entry"
gtk_combo_box_new_with_model_and_entry :: ((Ptr TreeModel) -> (IO (Ptr Widget)))
foreign import ccall safe "gtk_combo_box_get_wrap_width"
gtk_combo_box_get_wrap_width :: ((Ptr ComboBox) -> (IO CInt))
foreign import ccall safe "gtk_combo_box_set_wrap_width"
gtk_combo_box_set_wrap_width :: ((Ptr ComboBox) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_combo_box_get_row_span_column"
gtk_combo_box_get_row_span_column :: ((Ptr ComboBox) -> (IO CInt))
foreign import ccall safe "gtk_combo_box_set_row_span_column"
gtk_combo_box_set_row_span_column :: ((Ptr ComboBox) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_combo_box_get_column_span_column"
gtk_combo_box_get_column_span_column :: ((Ptr ComboBox) -> (IO CInt))
foreign import ccall safe "gtk_combo_box_set_column_span_column"
gtk_combo_box_set_column_span_column :: ((Ptr ComboBox) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_combo_box_get_active"
gtk_combo_box_get_active :: ((Ptr ComboBox) -> (IO CInt))
foreign import ccall safe "gtk_combo_box_set_active"
gtk_combo_box_set_active :: ((Ptr ComboBox) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_combo_box_get_active_iter"
gtk_combo_box_get_active_iter :: ((Ptr ComboBox) -> ((Ptr TreeIter) -> (IO CInt)))
foreign import ccall safe "gtk_combo_box_set_active_iter"
gtk_combo_box_set_active_iter :: ((Ptr ComboBox) -> ((Ptr TreeIter) -> (IO ())))
foreign import ccall unsafe "gtk_combo_box_get_model"
gtk_combo_box_get_model :: ((Ptr ComboBox) -> (IO (Ptr TreeModel)))
foreign import ccall safe "gtk_combo_box_set_model"
gtk_combo_box_set_model :: ((Ptr ComboBox) -> ((Ptr TreeModel) -> (IO ())))
foreign import ccall safe "gtk_combo_box_popup"
gtk_combo_box_popup :: ((Ptr ComboBox) -> (IO ()))
foreign import ccall safe "gtk_combo_box_popdown"
gtk_combo_box_popdown :: ((Ptr ComboBox) -> (IO ()))
foreign import ccall safe "gtk_combo_box_set_row_separator_func"
gtk_combo_box_set_row_separator_func :: ((Ptr ComboBox) -> ((FunPtr ((Ptr TreeModel) -> ((Ptr TreeIter) -> ((Ptr ()) -> (IO CInt))))) -> ((Ptr ()) -> ((FunPtr ((Ptr ()) -> (IO ()))) -> (IO ())))))
foreign import ccall safe "gtk_combo_box_set_add_tearoffs"
gtk_combo_box_set_add_tearoffs :: ((Ptr ComboBox) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_combo_box_get_add_tearoffs"
gtk_combo_box_get_add_tearoffs :: ((Ptr ComboBox) -> (IO CInt))
foreign import ccall safe "gtk_combo_box_set_title"
gtk_combo_box_set_title :: ((Ptr ComboBox) -> ((Ptr CChar) -> (IO ())))
foreign import ccall safe "gtk_combo_box_get_title"
gtk_combo_box_get_title :: ((Ptr ComboBox) -> (IO (Ptr CChar)))
foreign import ccall safe "gtk_combo_box_get_has_entry"
gtk_combo_box_get_has_entry :: ((Ptr ComboBox) -> (IO CInt))
foreign import ccall safe "gtk_combo_box_set_entry_text_column"
gtk_combo_box_set_entry_text_column :: ((Ptr ComboBox) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_combo_box_get_entry_text_column"
gtk_combo_box_get_entry_text_column :: ((Ptr ComboBox) -> (IO CInt))
foreign import ccall safe "gtk_combo_box_set_focus_on_click"
gtk_combo_box_set_focus_on_click :: ((Ptr ComboBox) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_combo_box_get_focus_on_click"
gtk_combo_box_get_focus_on_click :: ((Ptr ComboBox) -> (IO CInt))
foreign import ccall unsafe "gtk_tree_model_get_type"
gtk_tree_model_get_type :: CULong