{-# LINE 2 "./Graphics/UI/Gtk/ModelView/CellLayout.chs" #-}
module Graphics.UI.Gtk.ModelView.CellLayout (
CellLayoutClass,
toCellLayout,
cellLayoutPackStart,
cellLayoutPackEnd,
cellLayoutReorder,
cellLayoutClear,
cellLayoutClearAttributes,
cellLayoutGetCells,
cellLayoutAddColumnAttribute,
cellLayoutSetAttributes,
cellLayoutSetAttributeFunc,
) where
import System.Glib.FFI
import System.Glib.GList
import System.Glib.Attributes
import System.Glib.GType
import Graphics.UI.Gtk.Types
{-# LINE 73 "./Graphics/UI/Gtk/ModelView/CellLayout.chs" #-}
import Graphics.UI.Gtk.ModelView.Types
{-# LINE 74 "./Graphics/UI/Gtk/ModelView/CellLayout.chs" #-}
import Graphics.UI.Gtk.ModelView.TreeModel
{-# LINE 75 "./Graphics/UI/Gtk/ModelView/CellLayout.chs" #-}
import Graphics.UI.Gtk.ModelView.CustomStore (treeModelGetRow)
{-# LINE 78 "./Graphics/UI/Gtk/ModelView/CellLayout.chs" #-}
instance CellLayoutClass CellView
instance CellLayoutClass IconView
instance CellLayoutClass EntryCompletion
instance CellLayoutClass TreeViewColumn
instance CellLayoutClass ComboBox
cellLayoutPackStart :: (CellLayoutClass self, CellRendererClass cell) => self
-> cell
-> Bool
-> IO ()
cellLayoutPackStart :: forall self cell.
(CellLayoutClass self, CellRendererClass cell) =>
self -> cell -> Bool -> IO ()
cellLayoutPackStart self
self cell
cell Bool
expand =
(\(CellLayout ForeignPtr CellLayout
arg1) (CellRenderer ForeignPtr CellRenderer
arg2) CInt
arg3 -> ForeignPtr CellLayout -> (Ptr CellLayout -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CellLayout
arg1 ((Ptr CellLayout -> IO ()) -> IO ())
-> (Ptr CellLayout -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CellLayout
argPtr1 ->ForeignPtr CellRenderer -> (Ptr CellRenderer -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CellRenderer
arg2 ((Ptr CellRenderer -> IO ()) -> IO ())
-> (Ptr CellRenderer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CellRenderer
argPtr2 ->Ptr CellLayout -> Ptr CellRenderer -> CInt -> IO ()
gtk_cell_layout_pack_start Ptr CellLayout
argPtr1 Ptr CellRenderer
argPtr2 CInt
arg3)
{-# LINE 109 "./Graphics/UI/Gtk/ModelView/CellLayout.chs" #-}
(toCellLayout self)
(cell -> CellRenderer
forall o. CellRendererClass o => o -> CellRenderer
toCellRenderer cell
cell)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
expand)
cellLayoutPackEnd :: (CellLayoutClass self, CellRendererClass cell) => self
-> cell
-> Bool
-> IO ()
cellLayoutPackEnd :: forall self cell.
(CellLayoutClass self, CellRendererClass cell) =>
self -> cell -> Bool -> IO ()
cellLayoutPackEnd self
self cell
cell Bool
expand =
(\(CellLayout ForeignPtr CellLayout
arg1) (CellRenderer ForeignPtr CellRenderer
arg2) CInt
arg3 -> ForeignPtr CellLayout -> (Ptr CellLayout -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CellLayout
arg1 ((Ptr CellLayout -> IO ()) -> IO ())
-> (Ptr CellLayout -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CellLayout
argPtr1 ->ForeignPtr CellRenderer -> (Ptr CellRenderer -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CellRenderer
arg2 ((Ptr CellRenderer -> IO ()) -> IO ())
-> (Ptr CellRenderer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CellRenderer
argPtr2 ->Ptr CellLayout -> Ptr CellRenderer -> CInt -> IO ()
gtk_cell_layout_pack_end Ptr CellLayout
argPtr1 Ptr CellRenderer
argPtr2 CInt
arg3)
{-# LINE 126 "./Graphics/UI/Gtk/ModelView/CellLayout.chs" #-}
(toCellLayout self)
(cell -> CellRenderer
forall o. CellRendererClass o => o -> CellRenderer
toCellRenderer cell
cell)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
expand)
cellLayoutReorder :: (CellLayoutClass self, CellRendererClass cell) => self
-> cell
-> Int
-> IO ()
cellLayoutReorder :: forall self cell.
(CellLayoutClass self, CellRendererClass cell) =>
self -> cell -> Int -> IO ()
cellLayoutReorder self
self cell
cell Int
position =
(\(CellLayout ForeignPtr CellLayout
arg1) (CellRenderer ForeignPtr CellRenderer
arg2) CInt
arg3 -> ForeignPtr CellLayout -> (Ptr CellLayout -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CellLayout
arg1 ((Ptr CellLayout -> IO ()) -> IO ())
-> (Ptr CellLayout -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CellLayout
argPtr1 ->ForeignPtr CellRenderer -> (Ptr CellRenderer -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CellRenderer
arg2 ((Ptr CellRenderer -> IO ()) -> IO ())
-> (Ptr CellRenderer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CellRenderer
argPtr2 ->Ptr CellLayout -> Ptr CellRenderer -> CInt -> IO ()
gtk_cell_layout_reorder Ptr CellLayout
argPtr1 Ptr CellRenderer
argPtr2 CInt
arg3)
{-# LINE 139 "./Graphics/UI/Gtk/ModelView/CellLayout.chs" #-}
(toCellLayout self)
(cell -> CellRenderer
forall o. CellRendererClass o => o -> CellRenderer
toCellRenderer cell
cell)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
position)
cellLayoutClear :: CellLayoutClass self => self -> IO ()
cellLayoutClear :: forall self. CellLayoutClass self => self -> IO ()
cellLayoutClear self
self =
(\(CellLayout ForeignPtr CellLayout
arg1) -> ForeignPtr CellLayout -> (Ptr CellLayout -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CellLayout
arg1 ((Ptr CellLayout -> IO ()) -> IO ())
-> (Ptr CellLayout -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CellLayout
argPtr1 ->Ptr CellLayout -> IO ()
gtk_cell_layout_clear Ptr CellLayout
argPtr1)
{-# LINE 148 "./Graphics/UI/Gtk/ModelView/CellLayout.chs" #-}
(toCellLayout self)
cellLayoutGetCells :: CellLayoutClass self => self
-> IO [CellRenderer]
cellLayoutGetCells :: forall self. CellLayoutClass self => self -> IO [CellRenderer]
cellLayoutGetCells self
self =
(\(CellLayout ForeignPtr CellLayout
arg1) -> ForeignPtr CellLayout
-> (Ptr CellLayout -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CellLayout
arg1 ((Ptr CellLayout -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr CellLayout -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr CellLayout
argPtr1 ->Ptr CellLayout -> IO (Ptr ())
gtk_cell_layout_get_cells Ptr CellLayout
argPtr1)
{-# LINE 159 "./Graphics/UI/Gtk/ModelView/CellLayout.chs" #-}
(toCellLayout self)
IO (Ptr ())
-> (Ptr () -> IO [Ptr CellRenderer]) -> IO [Ptr CellRenderer]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr () -> IO [Ptr CellRenderer]
forall a. Ptr () -> IO [Ptr a]
fromGList
IO [Ptr CellRenderer]
-> ([Ptr CellRenderer] -> IO [CellRenderer]) -> IO [CellRenderer]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr CellRenderer -> IO CellRenderer)
-> [Ptr CellRenderer] -> IO [CellRenderer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ForeignPtr CellRenderer -> CellRenderer,
FinalizerPtr CellRenderer)
-> IO (Ptr CellRenderer) -> IO CellRenderer
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr CellRenderer -> CellRenderer,
FinalizerPtr CellRenderer)
forall {a}.
(ForeignPtr CellRenderer -> CellRenderer, FinalizerPtr a)
mkCellRenderer (IO (Ptr CellRenderer) -> IO CellRenderer)
-> (Ptr CellRenderer -> IO (Ptr CellRenderer))
-> Ptr CellRenderer
-> IO CellRenderer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CellRenderer -> IO (Ptr CellRenderer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return)
cellLayoutAddColumnAttribute :: (CellLayoutClass self, CellRendererClass cell) => self
-> cell
-> ReadWriteAttr cell a v
-> ColumnId row v
-> IO ()
cellLayoutAddColumnAttribute :: forall self cell a v row.
(CellLayoutClass self, CellRendererClass cell) =>
self -> cell -> ReadWriteAttr cell a v -> ColumnId row v -> IO ()
cellLayoutAddColumnAttribute self
self cell
cell ReadWriteAttr cell a v
attr ColumnId row v
column =
String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString (ReadWriteAttr cell a v -> String
forall a. Show a => a -> String
show ReadWriteAttr cell a v
attr) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
attributePtr ->
(\(CellLayout ForeignPtr CellLayout
arg1) (CellRenderer ForeignPtr CellRenderer
arg2) CString
arg3 CInt
arg4 -> ForeignPtr CellLayout -> (Ptr CellLayout -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CellLayout
arg1 ((Ptr CellLayout -> IO ()) -> IO ())
-> (Ptr CellLayout -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CellLayout
argPtr1 ->ForeignPtr CellRenderer -> (Ptr CellRenderer -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CellRenderer
arg2 ((Ptr CellRenderer -> IO ()) -> IO ())
-> (Ptr CellRenderer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CellRenderer
argPtr2 ->Ptr CellLayout -> Ptr CellRenderer -> CString -> CInt -> IO ()
gtk_cell_layout_add_attribute Ptr CellLayout
argPtr1 Ptr CellRenderer
argPtr2 CString
arg3 CInt
arg4)
{-# LINE 179 "./Graphics/UI/Gtk/ModelView/CellLayout.chs" #-}
(toCellLayout self)
(cell -> CellRenderer
forall o. CellRendererClass o => o -> CellRenderer
toCellRenderer cell
cell)
CString
attributePtr
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ColumnId row v -> Int
forall row ty. ColumnId row ty -> Int
columnIdToNumber ColumnId row v
column))
cellLayoutSetAttributes :: (CellLayoutClass self,
CellRendererClass cell,
TreeModelClass (model row),
TypedTreeModelClass model)
=> self
-> cell
-> model row
-> (row -> [AttrOp cell])
-> IO ()
cellLayoutSetAttributes :: forall self cell (model :: * -> *) row.
(CellLayoutClass self, CellRendererClass cell,
TreeModelClass (model row), TypedTreeModelClass model) =>
self -> cell -> model row -> (row -> [AttrOp cell]) -> IO ()
cellLayoutSetAttributes self
self cell
cell model row
model row -> [AttrOp cell]
attributes =
self -> cell -> model row -> (TreeIter -> IO ()) -> IO ()
forall self cell model.
(CellLayoutClass self, CellRendererClass cell,
TreeModelClass model) =>
self -> cell -> model -> (TreeIter -> IO ()) -> IO ()
cellLayoutSetAttributeFunc self
self cell
cell model row
model ((TreeIter -> IO ()) -> IO ()) -> (TreeIter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TreeIter
iter -> do
row
row <- model row -> TreeIter -> IO row
forall (model :: * -> *) row.
TypedTreeModelClass model =>
model row -> TreeIter -> IO row
treeModelGetRow model row
model TreeIter
iter
cell -> [AttrOp cell] -> IO ()
forall o. o -> [AttrOp o] -> IO ()
set cell
cell (row -> [AttrOp cell]
attributes row
row)
cellLayoutSetAttributeFunc :: (CellLayoutClass self,
CellRendererClass cell,
TreeModelClass model)
=> self
-> cell
-> model
-> (TreeIter -> IO ())
-> IO ()
cellLayoutSetAttributeFunc :: forall self cell model.
(CellLayoutClass self, CellRendererClass cell,
TreeModelClass model) =>
self -> cell -> model -> (TreeIter -> IO ()) -> IO ()
cellLayoutSetAttributeFunc self
self cell
cell model
model TreeIter -> IO ()
func = do
CellLayoutDataFunc
fPtr <- (Ptr CellLayout
-> Ptr CellRenderer
-> Ptr TreeModel
-> Ptr TreeIter
-> Ptr ()
-> IO ())
-> IO CellLayoutDataFunc
mkSetAttributeFunc ((Ptr CellLayout
-> Ptr CellRenderer
-> Ptr TreeModel
-> Ptr TreeIter
-> Ptr ()
-> IO ())
-> IO CellLayoutDataFunc)
-> (Ptr CellLayout
-> Ptr CellRenderer
-> Ptr TreeModel
-> Ptr TreeIter
-> Ptr ()
-> IO ())
-> IO CellLayoutDataFunc
forall a b. (a -> b) -> a -> b
$ \Ptr CellLayout
_ Ptr CellRenderer
cellPtr' Ptr TreeModel
modelPtr' Ptr TreeIter
iterPtr Ptr ()
_ -> do
TreeIter
iter <- Ptr TreeIter -> Ptr TreeModel -> TreeModel -> IO TreeIter
convertIterFromParentToChildModel Ptr TreeIter
iterPtr Ptr TreeModel
modelPtr'
(model -> TreeModel
forall o. TreeModelClass o => o -> TreeModel
toTreeModel model
model)
let (CellRenderer ForeignPtr CellRenderer
cellPtr) = cell -> CellRenderer
forall o. CellRendererClass o => o -> CellRenderer
toCellRenderer cell
cell
if ForeignPtr CellRenderer -> Ptr CellRenderer
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr CellRenderer
cellPtr Ptr CellRenderer -> Ptr CellRenderer -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr CellRenderer
cellPtr' then
String -> IO ()
forall a. HasCallStack => String -> a
error (String
"cellLayoutSetAttributeFunc: attempt to set attributes of "String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"a different CellRenderer.")
else TreeIter -> IO ()
func TreeIter
iter
(\(CellLayout ForeignPtr CellLayout
arg1) (CellRenderer ForeignPtr CellRenderer
arg2) CellLayoutDataFunc
arg3 Ptr ()
arg4 FunPtr (Ptr () -> IO ())
arg5 -> ForeignPtr CellLayout -> (Ptr CellLayout -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CellLayout
arg1 ((Ptr CellLayout -> IO ()) -> IO ())
-> (Ptr CellLayout -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CellLayout
argPtr1 ->ForeignPtr CellRenderer -> (Ptr CellRenderer -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CellRenderer
arg2 ((Ptr CellRenderer -> IO ()) -> IO ())
-> (Ptr CellRenderer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CellRenderer
argPtr2 ->Ptr CellLayout
-> Ptr CellRenderer
-> CellLayoutDataFunc
-> Ptr ()
-> FunPtr (Ptr () -> IO ())
-> IO ()
gtk_cell_layout_set_cell_data_func Ptr CellLayout
argPtr1 Ptr CellRenderer
argPtr2 CellLayoutDataFunc
arg3 Ptr ()
arg4 FunPtr (Ptr () -> IO ())
arg5) (self -> CellLayout
forall o. CellLayoutClass o => o -> CellLayout
toCellLayout self
self)
(cell -> CellRenderer
forall o. CellRendererClass o => o -> CellRenderer
toCellRenderer cell
cell) CellLayoutDataFunc
fPtr (CellLayoutDataFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr CellLayoutDataFunc
fPtr) FunPtr (Ptr () -> IO ())
destroyFunPtr
type CellLayoutDataFunc = FunPtr (((Ptr CellLayout) -> ((Ptr CellRenderer) -> ((Ptr TreeModel) -> ((Ptr TreeIter) -> ((Ptr ()) -> (IO ())))))))
{-# LINE 239 "./Graphics/UI/Gtk/ModelView/CellLayout.chs" #-}
foreign import ccall "wrapper" mkSetAttributeFunc ::
(Ptr CellLayout -> Ptr CellRenderer -> Ptr TreeModel -> Ptr TreeIter ->
Ptr () -> IO ()) -> IO CellLayoutDataFunc
convertIterFromParentToChildModel ::
Ptr TreeIter
-> Ptr TreeModel
-> TreeModel
-> IO TreeIter
convertIterFromParentToChildModel :: Ptr TreeIter -> Ptr TreeModel -> TreeModel -> IO TreeIter
convertIterFromParentToChildModel Ptr TreeIter
iterPtr Ptr TreeModel
parentModelPtr TreeModel
childModel =
let (TreeModel ForeignPtr TreeModel
modelFPtr) = TreeModel
childModel
modelPtr :: Ptr TreeModel
modelPtr = ForeignPtr TreeModel -> Ptr TreeModel
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr TreeModel
modelFPtr in
if Ptr TreeModel
modelPtrPtr TreeModel -> Ptr TreeModel -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr TreeModel
parentModelPtr then Ptr TreeIter -> IO TreeIter
forall a. Storable a => Ptr a -> IO a
peek Ptr TreeIter
iterPtr else
if Ptr () -> GType -> Bool
typeInstanceIsA (Ptr TreeModel -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr TreeModel
parentModelPtr) GType
gTypeTreeModelFilter then
(Ptr TreeIter -> IO TreeIter) -> IO TreeIter
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TreeIter -> IO TreeIter) -> IO TreeIter)
-> (Ptr TreeIter -> IO TreeIter) -> IO TreeIter
forall a b. (a -> b) -> a -> b
$ \Ptr TreeIter
childIterPtr -> do
Ptr TreeModel -> Ptr TreeIter -> Ptr TreeIter -> IO ()
treeModelFilterConvertIterToChildIter Ptr TreeModel
parentModelPtr Ptr TreeIter
childIterPtr Ptr TreeIter
iterPtr
Ptr TreeModel
childPtr <- Ptr TreeModel -> IO (Ptr TreeModel)
treeModelFilterGetModel Ptr TreeModel
parentModelPtr
if Ptr TreeModel
childPtrPtr TreeModel -> Ptr TreeModel -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr TreeModel
modelPtr then Ptr TreeIter -> IO TreeIter
forall a. Storable a => Ptr a -> IO a
peek Ptr TreeIter
childIterPtr else
Ptr TreeIter -> Ptr TreeModel -> TreeModel -> IO TreeIter
convertIterFromParentToChildModel Ptr TreeIter
childIterPtr Ptr TreeModel
childPtr TreeModel
childModel
else if Ptr () -> GType -> Bool
typeInstanceIsA (Ptr TreeModel -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr TreeModel
parentModelPtr) GType
gTypeTreeModelSort then
(Ptr TreeIter -> IO TreeIter) -> IO TreeIter
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr TreeIter -> IO TreeIter) -> IO TreeIter)
-> (Ptr TreeIter -> IO TreeIter) -> IO TreeIter
forall a b. (a -> b) -> a -> b
$ \Ptr TreeIter
childIterPtr -> do
Ptr TreeModel -> Ptr TreeIter -> Ptr TreeIter -> IO ()
treeModelSortConvertIterToChildIter Ptr TreeModel
parentModelPtr Ptr TreeIter
childIterPtr Ptr TreeIter
iterPtr
Ptr TreeModel
childPtr <- Ptr TreeModel -> IO (Ptr TreeModel)
treeModelSortGetModel Ptr TreeModel
parentModelPtr
if Ptr TreeModel
childPtrPtr TreeModel -> Ptr TreeModel -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr TreeModel
modelPtr then Ptr TreeIter -> IO TreeIter
forall a. Storable a => Ptr a -> IO a
peek Ptr TreeIter
childIterPtr else
Ptr TreeIter -> Ptr TreeModel -> TreeModel -> IO TreeIter
convertIterFromParentToChildModel Ptr TreeIter
childIterPtr Ptr TreeModel
childPtr TreeModel
childModel
else do
TreeIter
iter <- Ptr TreeIter -> IO TreeIter
forall a. Storable a => Ptr a -> IO a
peek Ptr TreeIter
iterPtr
String -> IO TreeIter
forall a. HasCallStack => String -> a
error (String
"CellLayout: don't know how to convert iter "String -> String -> String
forall a. [a] -> [a] -> [a]
++TreeIter -> String
forall a. Show a => a -> String
show TreeIter
iterString -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" from model "String -> String -> String
forall a. [a] -> [a] -> [a]
++Ptr TreeModel -> String
forall a. Show a => a -> String
show Ptr TreeModel
parentModelPtrString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" to model "String -> String -> String
forall a. [a] -> [a] -> [a]
++
Ptr TreeModel -> String
forall a. Show a => a -> String
show Ptr TreeModel
modelPtrString -> String -> String
forall a. [a] -> [a] -> [a]
++String
". Is it possible that you are setting the "String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"attributes of a CellRenderer using a different model than "String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"that which was set in the view?")
foreign import ccall unsafe "gtk_tree_model_filter_get_model"
treeModelFilterGetModel :: Ptr TreeModel -> IO (Ptr TreeModel)
foreign import ccall safe "gtk_tree_model_filter_convert_iter_to_child_iter"
treeModelFilterConvertIterToChildIter :: Ptr TreeModel -> Ptr TreeIter ->
Ptr TreeIter -> IO ()
foreign import ccall unsafe "gtk_tree_model_sort_get_model"
treeModelSortGetModel :: Ptr TreeModel -> IO (Ptr TreeModel)
foreign import ccall safe "gtk_tree_model_sort_convert_iter_to_child_iter"
treeModelSortConvertIterToChildIter :: Ptr TreeModel -> Ptr TreeIter ->
Ptr TreeIter -> IO ()
cellLayoutClearAttributes :: (CellLayoutClass self, CellRendererClass cell) => self
-> cell
-> IO ()
cellLayoutClearAttributes :: forall self cell.
(CellLayoutClass self, CellRendererClass cell) =>
self -> cell -> IO ()
cellLayoutClearAttributes self
self cell
cell =
(\(CellLayout ForeignPtr CellLayout
arg1) (CellRenderer ForeignPtr CellRenderer
arg2) -> ForeignPtr CellLayout -> (Ptr CellLayout -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CellLayout
arg1 ((Ptr CellLayout -> IO ()) -> IO ())
-> (Ptr CellLayout -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CellLayout
argPtr1 ->ForeignPtr CellRenderer -> (Ptr CellRenderer -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CellRenderer
arg2 ((Ptr CellRenderer -> IO ()) -> IO ())
-> (Ptr CellRenderer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CellRenderer
argPtr2 ->Ptr CellLayout -> Ptr CellRenderer -> IO ()
gtk_cell_layout_clear_attributes Ptr CellLayout
argPtr1 Ptr CellRenderer
argPtr2)
{-# LINE 305 "./Graphics/UI/Gtk/ModelView/CellLayout.chs" #-}
(toCellLayout self)
(cell -> CellRenderer
forall o. CellRendererClass o => o -> CellRenderer
toCellRenderer cell
cell)
foreign import ccall safe "gtk_cell_layout_pack_start"
gtk_cell_layout_pack_start :: ((Ptr CellLayout) -> ((Ptr CellRenderer) -> (CInt -> (IO ()))))
foreign import ccall safe "gtk_cell_layout_pack_end"
gtk_cell_layout_pack_end :: ((Ptr CellLayout) -> ((Ptr CellRenderer) -> (CInt -> (IO ()))))
foreign import ccall safe "gtk_cell_layout_reorder"
gtk_cell_layout_reorder :: ((Ptr CellLayout) -> ((Ptr CellRenderer) -> (CInt -> (IO ()))))
foreign import ccall safe "gtk_cell_layout_clear"
gtk_cell_layout_clear :: ((Ptr CellLayout) -> (IO ()))
foreign import ccall safe "gtk_cell_layout_get_cells"
gtk_cell_layout_get_cells :: ((Ptr CellLayout) -> (IO (Ptr ())))
foreign import ccall safe "gtk_cell_layout_add_attribute"
gtk_cell_layout_add_attribute :: ((Ptr CellLayout) -> ((Ptr CellRenderer) -> ((Ptr CChar) -> (CInt -> (IO ())))))
foreign import ccall safe "gtk_cell_layout_set_cell_data_func"
gtk_cell_layout_set_cell_data_func :: ((Ptr CellLayout) -> ((Ptr CellRenderer) -> ((FunPtr ((Ptr CellLayout) -> ((Ptr CellRenderer) -> ((Ptr TreeModel) -> ((Ptr TreeIter) -> ((Ptr ()) -> (IO ()))))))) -> ((Ptr ()) -> ((FunPtr ((Ptr ()) -> (IO ()))) -> (IO ()))))))
foreign import ccall safe "gtk_cell_layout_clear_attributes"
gtk_cell_layout_clear_attributes :: ((Ptr CellLayout) -> ((Ptr CellRenderer) -> (IO ())))