{-# LINE 2 "./Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs" #-}
module Graphics.UI.Gtk.MenuComboToolbar.ComboBoxEntry (
ComboBoxEntry,
ComboBoxEntryClass,
castToComboBoxEntry, gTypeComboBoxEntry,
toComboBoxEntry,
comboBoxEntryNew,
comboBoxEntryNewText,
comboBoxEntryNewWithModel,
comboBoxEntrySetModelText,
comboBoxEntrySetTextColumn,
comboBoxEntryGetTextColumn,
comboBoxEntryGetActiveText,
comboBoxEntryTextColumn,
) where
import Control.Monad (liftM)
import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types hiding ( ListStore )
import Graphics.UI.Gtk.ModelView.Types
import Graphics.UI.Gtk.MenuComboToolbar.ComboBox
import Graphics.UI.Gtk.ModelView.CustomStore
{-# LINE 106 "./Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs" #-}
import Graphics.UI.Gtk.ModelView.TreeModel
{-# LINE 107 "./Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs" #-}
import Graphics.UI.Gtk.ModelView.ListStore ( ListStore, listStoreNew )
{-# LINE 110 "./Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs" #-}
comboBoxEntryNew :: IO ComboBoxEntry
comboBoxEntryNew :: IO ComboBoxEntry
comboBoxEntryNew =
(ForeignPtr ComboBoxEntry -> ComboBoxEntry,
FinalizerPtr ComboBoxEntry)
-> IO (Ptr ComboBoxEntry) -> IO ComboBoxEntry
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr ComboBoxEntry -> ComboBoxEntry,
FinalizerPtr ComboBoxEntry)
forall {a}.
(ForeignPtr ComboBoxEntry -> ComboBoxEntry, FinalizerPtr a)
mkComboBoxEntry (IO (Ptr ComboBoxEntry) -> IO ComboBoxEntry)
-> IO (Ptr ComboBoxEntry) -> IO ComboBoxEntry
forall a b. (a -> b) -> a -> b
$
(Ptr Widget -> Ptr ComboBoxEntry)
-> IO (Ptr Widget) -> IO (Ptr ComboBoxEntry)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr ComboBoxEntry
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr ComboBoxEntry) (IO (Ptr Widget) -> IO (Ptr ComboBoxEntry))
-> IO (Ptr Widget) -> IO (Ptr ComboBoxEntry)
forall a b. (a -> b) -> a -> b
$
IO (Ptr Widget)
gtk_combo_box_entry_new
{-# LINE 124 "./Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs" #-}
comboBoxEntryNewText :: IO ComboBoxEntry
comboBoxEntryNewText :: IO ComboBoxEntry
comboBoxEntryNewText = do
ComboBoxEntry
combo <- IO ComboBoxEntry
comboBoxEntryNew
ComboBoxEntry -> IO (ListStore String)
forall self.
ComboBoxEntryClass self =>
self -> IO (ListStore String)
comboBoxEntrySetModelText ComboBoxEntry
combo
ComboBoxEntry -> IO ComboBoxEntry
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ComboBoxEntry
combo
comboBoxEntryNewWithModel :: TreeModelClass model =>
model
-> IO ComboBoxEntry
comboBoxEntryNewWithModel :: forall model. TreeModelClass model => model -> IO ComboBoxEntry
comboBoxEntryNewWithModel model
model = do
ComboBoxEntry
combo <- IO ComboBoxEntry
comboBoxEntryNew
ComboBoxEntry -> Maybe model -> IO ()
forall self model.
(ComboBoxClass self, TreeModelClass model) =>
self -> Maybe model -> IO ()
comboBoxSetModel ComboBoxEntry
combo (model -> Maybe model
forall a. a -> Maybe a
Just model
model)
ComboBoxEntry -> IO ComboBoxEntry
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ComboBoxEntry
combo
comboBoxEntrySetModelText :: ComboBoxEntryClass self => self ->
IO (ListStore String)
comboBoxEntrySetModelText :: forall self.
ComboBoxEntryClass self =>
self -> IO (ListStore String)
comboBoxEntrySetModelText self
combo = do
ListStore String
store <- [String] -> IO (ListStore String)
forall a. [a] -> IO (ListStore a)
listStoreNew ([] :: [String])
self -> Maybe (ListStore String) -> IO ()
forall self model.
(ComboBoxClass self, TreeModelClass model) =>
self -> Maybe model -> IO ()
comboBoxSetModel self
combo (ListStore String -> Maybe (ListStore String)
forall a. a -> Maybe a
Just ListStore String
store)
let colId :: ColumnId row String
colId = Int -> ColumnId row String
forall string row. GlibString string => Int -> ColumnId row string
makeColumnIdString Int
0
ListStore String
-> ColumnId String String -> (String -> String) -> IO ()
forall (model :: * -> *) row ty.
TypedTreeModelClass model =>
model row -> ColumnId row ty -> (row -> ty) -> IO ()
customStoreSetColumn ListStore String
store ColumnId String String
forall {row}. ColumnId row String
colId String -> String
forall a. a -> a
id
ComboBoxEntry -> ColumnId Any String -> IO ()
forall self string row.
(ComboBoxEntryClass self, GlibString string) =>
self -> ColumnId row string -> IO ()
comboBoxEntrySetTextColumn (self -> ComboBoxEntry
forall o. ComboBoxEntryClass o => o -> ComboBoxEntry
toComboBoxEntry self
combo) ColumnId Any String
forall {row}. ColumnId row String
colId
Quark -> ComboBoxEntry -> Maybe (ListStore String) -> IO ()
forall o a. GObjectClass o => Quark -> o -> Maybe a -> IO ()
objectSetAttribute Quark
comboQuark (self -> ComboBoxEntry
forall o. ComboBoxEntryClass o => o -> ComboBoxEntry
toComboBoxEntry self
combo) (ListStore String -> Maybe (ListStore String)
forall a. a -> Maybe a
Just ListStore String
store)
ListStore String -> IO (ListStore String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListStore String
store
comboBoxEntrySetTextColumn :: (ComboBoxEntryClass self, GlibString string) => self
-> ColumnId row string
-> IO ()
comboBoxEntrySetTextColumn :: forall self string row.
(ComboBoxEntryClass self, GlibString string) =>
self -> ColumnId row string -> IO ()
comboBoxEntrySetTextColumn self
self ColumnId row string
textColumn =
(\(ComboBoxEntry ForeignPtr ComboBoxEntry
arg1) CInt
arg2 -> ForeignPtr ComboBoxEntry -> (Ptr ComboBoxEntry -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ComboBoxEntry
arg1 ((Ptr ComboBoxEntry -> IO ()) -> IO ())
-> (Ptr ComboBoxEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ComboBoxEntry
argPtr1 ->Ptr ComboBoxEntry -> CInt -> IO ()
gtk_combo_box_entry_set_text_column Ptr ComboBoxEntry
argPtr1 CInt
arg2)
{-# LINE 188 "./Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs" #-}
(toComboBoxEntry self)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ColumnId row string -> Int
forall row ty. ColumnId row ty -> Int
columnIdToNumber ColumnId row string
textColumn))
comboBoxEntryGetTextColumn :: (ComboBoxEntryClass self, GlibString string) => self
-> IO (ColumnId row string)
comboBoxEntryGetTextColumn :: forall self string row.
(ComboBoxEntryClass self, GlibString string) =>
self -> IO (ColumnId row string)
comboBoxEntryGetTextColumn self
self =
(CInt -> ColumnId row string)
-> IO CInt -> IO (ColumnId row string)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ColumnId row string
forall string row. GlibString string => Int -> ColumnId row string
makeColumnIdString (Int -> ColumnId row string)
-> (CInt -> Int) -> CInt -> ColumnId row string
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO (ColumnId row string))
-> IO CInt -> IO (ColumnId row string)
forall a b. (a -> b) -> a -> b
$
(\(ComboBoxEntry ForeignPtr ComboBoxEntry
arg1) -> ForeignPtr ComboBoxEntry
-> (Ptr ComboBoxEntry -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ComboBoxEntry
arg1 ((Ptr ComboBoxEntry -> IO CInt) -> IO CInt)
-> (Ptr ComboBoxEntry -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr ComboBoxEntry
argPtr1 ->Ptr ComboBoxEntry -> IO CInt
gtk_combo_box_entry_get_text_column Ptr ComboBoxEntry
argPtr1)
{-# LINE 199 "./Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs" #-}
(toComboBoxEntry self)
comboBoxEntryGetActiveText :: (ComboBoxEntryClass self, GlibString string) => self
-> IO (Maybe string)
comboBoxEntryGetActiveText :: forall self string.
(ComboBoxEntryClass self, GlibString string) =>
self -> IO (Maybe string)
comboBoxEntryGetActiveText self
self = do
Ptr CChar
strPtr <- (\(ComboBox ForeignPtr ComboBox
arg1) -> ForeignPtr ComboBox
-> (Ptr ComboBox -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ComboBox
arg1 ((Ptr ComboBox -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (Ptr ComboBox -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr ComboBox
argPtr1 ->Ptr ComboBox -> IO (Ptr CChar)
gtk_combo_box_get_active_text Ptr ComboBox
argPtr1) (self -> ComboBox
forall o. ComboBoxClass o => o -> ComboBox
toComboBox self
self)
if Ptr CChar
strPtr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr then Maybe string -> IO (Maybe string)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe string
forall a. Maybe a
Nothing else (string -> Maybe string) -> IO string -> IO (Maybe string)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM string -> Maybe string
forall a. a -> Maybe a
Just (IO string -> IO (Maybe string)) -> IO string -> IO (Maybe string)
forall a b. (a -> b) -> a -> b
$
Ptr CChar -> IO string
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
strPtr)
comboBoxEntryTextColumn :: (ComboBoxEntryClass self, GlibString string) => Attr self (ColumnId row string)
comboBoxEntryTextColumn :: forall self string row.
(ComboBoxEntryClass self, GlibString string) =>
Attr self (ColumnId row string)
comboBoxEntryTextColumn = (self -> IO (ColumnId row string))
-> (self -> ColumnId row string -> IO ())
-> ReadWriteAttr self (ColumnId row string) (ColumnId row string)
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO (ColumnId row string)
forall self string row.
(ComboBoxEntryClass self, GlibString string) =>
self -> IO (ColumnId row string)
comboBoxEntryGetTextColumn
self -> ColumnId row string -> IO ()
forall self string row.
(ComboBoxEntryClass self, GlibString string) =>
self -> ColumnId row string -> IO ()
comboBoxEntrySetTextColumn
foreign import ccall safe "gtk_combo_box_entry_new"
gtk_combo_box_entry_new :: (IO (Ptr Widget))
foreign import ccall safe "gtk_combo_box_entry_set_text_column"
gtk_combo_box_entry_set_text_column :: ((Ptr ComboBoxEntry) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_combo_box_entry_get_text_column"
gtk_combo_box_entry_get_text_column :: ((Ptr ComboBoxEntry) -> (IO CInt))
foreign import ccall safe "gtk_combo_box_get_active_text"
gtk_combo_box_get_active_text :: ((Ptr ComboBox) -> (IO (Ptr CChar)))