{-# LANGUAGE MonoLocalBinds #-}
module Data.GI.Gtk.ComboBox (
module GI.Gtk.Objects.ComboBox,
comboBoxNewText,
comboBoxSetModelText,
comboBoxGetModelText,
comboBoxAppendText,
comboBoxInsertText,
comboBoxPrependText,
comboBoxRemoveText,
comboBoxGetActiveText,
) where
import Prelude ()
import Prelude.Compat
import Control.Monad (liftM)
import Control.Monad.IO.Class (MonadIO(..))
import Foreign.Ptr (FunPtr, Ptr, nullPtr)
import Foreign.StablePtr (newStablePtr, castStablePtrToPtr, deRefStablePtr, castPtrToStablePtr)
import Data.Text (Text)
import Data.Word (Word32)
import Data.Int (Int32)
import Data.GI.Base.BasicTypes (GObject)
import Data.GI.Base.ManagedPtr (unsafeManagedPtrCastPtr, touchManagedPtr, unsafeCastTo)
import Data.GI.Gtk.ModelView.Types (comboQuark)
import Data.GI.Gtk.ModelView.TreeModel (makeColumnIdString)
import Data.GI.Gtk.ModelView.CustomStore (customStoreSetColumn, customStoreGetRow)
import Data.GI.Gtk.ModelView.SeqStore ( SeqStore(..), seqStoreNew,
seqStoreInsert, seqStorePrepend, seqStoreAppend, seqStoreRemove,
seqStoreSafeGetValue )
import GI.Gtk.Objects.ComboBox
import Data.GI.Gtk.ModelView.CellLayout (CellLayout(..), cellLayoutClear, cellLayoutPackStart, cellLayoutSetDataFunction, cellLayoutGetCells)
import GI.Gtk.Objects.CellRendererText (CellRendererText(..), cellRendererTextNew, setCellRendererTextText)
import GI.GObject.Objects.Object (Object, toObject)
type GQuark = Word32
foreign import ccall unsafe "&hs_free_stable_ptr" destroyStablePtr :: FunPtr(Ptr () -> IO ())
foreign import ccall "g_object_set_qdata" g_object_set_qdata ::
Ptr Object -> GQuark -> Ptr () -> IO ()
foreign import ccall "g_object_set_qdata_full" g_object_set_qdata_full ::
Ptr Object -> GQuark -> Ptr () -> FunPtr(Ptr () -> IO ()) -> IO ()
objectSetAttribute :: (MonadIO m, GObject o) => o -> GQuark -> Maybe a -> m ()
objectSetAttribute obj attr Nothing = liftIO $ do
obj' <- unsafeManagedPtrCastPtr obj
g_object_set_qdata obj' (fromIntegral attr) nullPtr
touchManagedPtr obj
objectSetAttribute obj attr (Just val) = liftIO $ do
sPtr <- newStablePtr val
obj' <- unsafeManagedPtrCastPtr obj
g_object_set_qdata_full obj' attr (castStablePtrToPtr sPtr) destroyStablePtr
touchManagedPtr obj
foreign import ccall "g_object_get_qdata" g_object_get_qdata ::
Ptr Object -> GQuark -> IO (Ptr ())
objectGetAttributeUnsafe :: (MonadIO m, GObject o) => o -> GQuark -> m (Maybe a)
objectGetAttributeUnsafe obj attr = liftIO $ do
obj' <- unsafeManagedPtrCastPtr obj
sPtr <- g_object_get_qdata obj' attr
touchManagedPtr obj
if sPtr==nullPtr then return Nothing else
liftM Just $! deRefStablePtr (castPtrToStablePtr sPtr)
comboBoxNewText :: MonadIO m => m ComboBox
comboBoxNewText = do
combo <- comboBoxNew
comboBoxSetModelText combo
return combo
comboBoxSetModelText :: (MonadIO m, IsComboBox self) => self -> m (SeqStore Text)
comboBoxSetModelText combo = liftIO $ do
layout <- unsafeCastTo CellLayout combo
cellLayoutClear layout
store <- seqStoreNew ([] :: [Text])
comboBoxSetModel combo (Just store)
let colId = makeColumnIdString 0
customStoreSetColumn store colId id
comboBoxSetEntryTextColumn combo 0
ren <- cellRendererTextNew
cellLayoutPackStart layout ren True
cellLayoutSetDataFunction layout ren store (setCellRendererTextText ren)
objectSetAttribute combo comboQuark (Just store)
return store
comboBoxGetModelText :: (MonadIO m, IsComboBox self) => self -> m (SeqStore Text)
comboBoxGetModelText self = do
maybeStore <- objectGetAttributeUnsafe self comboQuark
case maybeStore of
Just store -> return store
Nothing -> error "Could not get required attribute"
comboBoxAppendText :: (MonadIO m, IsComboBox self) => self -> Text -> m Int32
comboBoxAppendText self text = do
store <- comboBoxGetModelText self
seqStoreAppend store text
comboBoxInsertText :: (MonadIO m, IsComboBox self) => self
-> Int32
-> Text
-> m ()
comboBoxInsertText self position text = do
store <- comboBoxGetModelText self
seqStoreInsert store position text
comboBoxPrependText :: (Applicative m, MonadIO m, IsComboBox self) => self -> Text -> m ()
comboBoxPrependText self text = do
store <- comboBoxGetModelText self
seqStorePrepend store text
comboBoxRemoveText :: (MonadIO m, IsComboBox self) => self
-> Int32
-> m ()
comboBoxRemoveText self position = do
store <- comboBoxGetModelText self
seqStoreRemove store position
comboBoxGetActiveText :: (MonadIO m, IsComboBox self) => self -> m (Maybe Text)
comboBoxGetActiveText self = do
activeId <- comboBoxGetActive self
if activeId < 0
then return Nothing
else do
seqStore <- comboBoxGetModelText self
seqStoreSafeGetValue seqStore (fromIntegral activeId)