{-# LINE 2 "./Graphics/UI/Gtk/ModelView/CellLayout.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Interface CellLayout
--
-- Author : Axel Simon
--
-- Created: 23 January 2006
--
-- Copyright (C) 2006 Axel Simon
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- An interface for packing cells
--
-- * Module available since Gtk+ version 2.4
--
module Graphics.UI.Gtk.ModelView.CellLayout (
-- * Detail
--
-- | 'CellLayout' is an interface which is implemented by all objects which
-- provide a 'TreeViewColumn' API for packing cells, setting attributes and data funcs.

-- * Class Hierarchy
-- |
-- @
-- | Interface CellLayout
-- | +----'TreeViewColumn'
-- | +----'CellView'
-- | +----'IconView'
-- | +----'EntryCompletion'
-- | +----'ComboBox'
-- | +----'ComboBoxEntry'
-- @


-- * Types
  CellLayoutClass,
  toCellLayout,

-- * Methods
  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

instance CellLayoutClass ComboBoxEntry


--------------------
-- Methods

-- | Packs the @cell@ into the beginning of the cell layout. If @expand@ is
-- @False@, then the @cell@ is allocated no more space than it needs. Any
-- unused space is divided evenly between cells for which @expand@ is @True@.
--
-- Note that reusing the same cell renderer is not supported.
--
cellLayoutPackStart :: (CellLayoutClass self, CellRendererClass cell) => self
 -> cell -- ^ @cell@ - A 'CellRenderer'.
 -> Bool -- ^ @expand@ - @True@ if @cell@ is to be given extra space
          -- allocated to @cellLayout@.
 -> 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)

-- | Adds the @cell@ to the end of @cellLayout@. If @expand@ is @False@, then
-- the @cell@ is allocated no more space than it needs. Any unused space is
-- divided evenly between cells for which @expand@ is @True@.
--
-- Note that reusing the same cell renderer is not supported.
--
cellLayoutPackEnd :: (CellLayoutClass self, CellRendererClass cell) => self
 -> cell -- ^ @cell@ - A 'CellRenderer'.
 -> Bool -- ^ @expand@ - @True@ if @cell@ is to be given extra space
          -- allocated to @cellLayout@.
 -> 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)

-- | Re-inserts @cell@ at @position@. Note that @cell@ has already to be
-- packed into @cellLayout@ for this to function properly.
--
cellLayoutReorder :: (CellLayoutClass self, CellRendererClass cell) => self
 -> cell -- ^ @cell@ - A 'CellRenderer' to reorder.
 -> Int -- ^ @position@ - New position to insert @cell@ at.
 -> 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)

-- | Remove all renderers from the cell layout.
--
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)


-- | Returns the cell renderers which have been added to @cellLayout@.
--
-- * Available since Gtk+ version 2.12
--
cellLayoutGetCells :: CellLayoutClass self => self
 -> IO [CellRenderer] -- ^ returns a list of cell renderers
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)


-- | Adds an attribute mapping to the renderer @cell@. The @column@ is
-- the 'ColumnId' of the model to get a value from, and the @attribute@ is the
-- parameter on @cell@ to be set from the value. So for example if column 2 of
-- the model contains strings, you could have the \"text\" attribute of a
-- 'CellRendererText' get its values from column 2.
--
cellLayoutAddColumnAttribute :: (CellLayoutClass self, CellRendererClass cell) => self
 -> cell -- ^ @cell@ - A 'CellRenderer'.
 -> ReadWriteAttr cell a v -- ^ @attribute@ - An attribute of a renderer.
 -> ColumnId row v -- ^ @column@ - The virtual column of the model from which to
                      -- retrieve the attribute.
 -> 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))


-- | Specify how a row of the @model@ defines the
-- attributes of the 'CellRenderer' @cell@. This is a convenience wrapper
-- around 'cellLayoutSetAttributeFunc' in that it sets the cells of the @cell@
-- with the data retrieved from the model.
--
-- * Note on using 'Graphics.UI.Gtk.ModelView.TreeModelSort.TreeModelSort' and
-- 'Graphics.UI.Gtk.ModelView.TreeModelFilter.TreeModelFilter': These two models
-- wrap another model, the so-called child model, instead of storing their own
-- data. This raises the problem that the data of cell renderers must be set
-- using the child model, while the 'TreeIter's that the view works with refer to
-- the model that encapsulates the child model. For convenience, this function
-- transparently translates an iterator to the child model before extracting the
-- data using e.g. 'Graphics.UI.Gtk.TreeModel.TreeModelSort.treeModelSortConvertIterToChildIter'.
-- Hence, it is possible to install the encapsulating model in the view and to
-- pass the child model to this function.
--
cellLayoutSetAttributes :: (CellLayoutClass self,
                             CellRendererClass cell,
                             TreeModelClass (model row),
                             TypedTreeModelClass model)
 => self
 -> cell -- ^ @cell@ - A 'CellRenderer'.
 -> model row -- ^ @model@ - A model containing rows of type @row@.
 -> (row -> [AttrOp cell]) -- ^ Function to set attributes on the cell renderer.
 -> 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)

-- | Install a function that looks up a row in the model and sets the
-- attributes of the 'CellRenderer' @cell@ using the row's content.
--
cellLayoutSetAttributeFunc :: (CellLayoutClass self,
                               CellRendererClass cell,
                               TreeModelClass model)
 => self
 -> cell -- ^ @cell@ - A 'CellRenderer'.
 -> model -- ^ @model@ - A model from which to draw data.
 -> (TreeIter -> IO ()) -- ^ Function to set attributes on the cell renderer.
 -> 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

-- Given a 'TreeModelFilter' or a 'TreeModelSort' and a 'TreeIter', get the
-- child model of these models and convert the iter to an iter of the child
-- model. This is an ugly internal function that is needed for some widgets
-- which pass iterators to the callback function of set_cell_data_func that
-- refer to some internal TreeModelFilter models that they create around the
-- user model. This is a bug but since C programs mostly use the columns
-- rather than the cell_layout way to extract attributes, this bug does not
-- show up in many programs. Reported in the case of EntryCompletion as bug
-- \#551202.
--
convertIterFromParentToChildModel ::
     Ptr TreeIter -- ^ the iterator
  -> Ptr TreeModel -- ^ the model that we got from the all back
  -> TreeModel -- ^ the model that we actually want
  -> 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 ()

-- | Clears all existing attributes previously set with
-- 'cellLayoutSetAttributes'.
--
cellLayoutClearAttributes :: (CellLayoutClass self, CellRendererClass cell) => self
 -> cell -- ^ @cell@ - A 'CellRenderer' to clear the attribute mapping on.
 -> 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 ())))