{-# LINE 2 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
module Graphics.UI.Gtk.Layout.Expander (
Expander,
ExpanderClass,
castToExpander, gTypeExpander,
toExpander,
expanderNew,
expanderNewWithMnemonic,
expanderSetExpanded,
expanderGetExpanded,
expanderSetSpacing,
expanderGetSpacing,
expanderSetLabel,
expanderGetLabel,
expanderSetUseUnderline,
expanderGetUseUnderline,
expanderSetUseMarkup,
expanderGetUseMarkup,
expanderSetLabelWidget,
expanderGetLabelWidget,
expanderExpanded,
expanderLabel,
expanderUseUnderline,
expanderUseMarkup,
expanderSpacing,
expanderLabelWidget,
expanderLabelFill,
onActivate,
afterActivate,
) where
import Control.Monad (liftM)
import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object
import Graphics.UI.Gtk.Types
{-# LINE 103 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 106 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
expanderNew :: GlibString string => string -> IO Expander
expanderNew :: forall string. GlibString string => string -> IO Expander
expanderNew string
label =
(ForeignPtr Expander -> Expander, FinalizerPtr Expander)
-> IO (Ptr Expander) -> IO Expander
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Expander -> Expander, FinalizerPtr Expander)
forall {a}. (ForeignPtr Expander -> Expander, FinalizerPtr a)
mkExpander (IO (Ptr Expander) -> IO Expander)
-> IO (Ptr Expander) -> IO Expander
forall a b. (a -> b) -> a -> b
$
(Ptr Widget -> Ptr Expander)
-> IO (Ptr Widget) -> IO (Ptr Expander)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Expander
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Expander) (IO (Ptr Widget) -> IO (Ptr Expander))
-> IO (Ptr Widget) -> IO (Ptr Expander)
forall a b. (a -> b) -> a -> b
$
string -> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
label ((CString -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \CString
labelPtr ->
CString -> IO (Ptr Widget)
gtk_expander_new
{-# LINE 119 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
labelPtr
expanderNewWithMnemonic :: GlibString string
=> string
-> IO Expander
expanderNewWithMnemonic :: forall string. GlibString string => string -> IO Expander
expanderNewWithMnemonic string
label =
(ForeignPtr Expander -> Expander, FinalizerPtr Expander)
-> IO (Ptr Expander) -> IO Expander
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Expander -> Expander, FinalizerPtr Expander)
forall {a}. (ForeignPtr Expander -> Expander, FinalizerPtr a)
mkExpander (IO (Ptr Expander) -> IO Expander)
-> IO (Ptr Expander) -> IO Expander
forall a b. (a -> b) -> a -> b
$
(Ptr Widget -> Ptr Expander)
-> IO (Ptr Widget) -> IO (Ptr Expander)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Expander
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Expander) (IO (Ptr Widget) -> IO (Ptr Expander))
-> IO (Ptr Widget) -> IO (Ptr Expander)
forall a b. (a -> b) -> a -> b
$
string -> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
label ((CString -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \CString
labelPtr ->
CString -> IO (Ptr Widget)
gtk_expander_new_with_mnemonic
{-# LINE 137 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
labelPtr
expanderSetExpanded :: Expander -> Bool -> IO ()
expanderSetExpanded :: Expander -> Bool -> IO ()
expanderSetExpanded Expander
self Bool
expanded =
(\(Expander ForeignPtr Expander
arg1) CInt
arg2 -> ForeignPtr Expander -> (Ptr Expander -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Expander
arg1 ((Ptr Expander -> IO ()) -> IO ())
-> (Ptr Expander -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Expander
argPtr1 ->Ptr Expander -> CInt -> IO ()
gtk_expander_set_expanded Ptr Expander
argPtr1 CInt
arg2)
{-# LINE 149 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
self
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
expanded)
expanderGetExpanded :: Expander -> IO Bool
expanderGetExpanded :: Expander -> IO Bool
expanderGetExpanded Expander
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Expander ForeignPtr Expander
arg1) -> ForeignPtr Expander -> (Ptr Expander -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Expander
arg1 ((Ptr Expander -> IO CInt) -> IO CInt)
-> (Ptr Expander -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Expander
argPtr1 ->Ptr Expander -> IO CInt
gtk_expander_get_expanded Ptr Expander
argPtr1)
{-# LINE 161 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
self
expanderSetSpacing :: Expander -> Int -> IO ()
expanderSetSpacing :: Expander -> Int -> IO ()
expanderSetSpacing Expander
self Int
spacing =
(\(Expander ForeignPtr Expander
arg1) CInt
arg2 -> ForeignPtr Expander -> (Ptr Expander -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Expander
arg1 ((Ptr Expander -> IO ()) -> IO ())
-> (Ptr Expander -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Expander
argPtr1 ->Ptr Expander -> CInt -> IO ()
gtk_expander_set_spacing Ptr Expander
argPtr1 CInt
arg2)
{-# LINE 169 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
self
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
spacing)
expanderGetSpacing :: Expander
-> IO Int
expanderGetSpacing :: Expander -> IO Int
expanderGetSpacing Expander
self =
(CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
(\(Expander ForeignPtr Expander
arg1) -> ForeignPtr Expander -> (Ptr Expander -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Expander
arg1 ((Ptr Expander -> IO CInt) -> IO CInt)
-> (Ptr Expander -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Expander
argPtr1 ->Ptr Expander -> IO CInt
gtk_expander_get_spacing Ptr Expander
argPtr1)
{-# LINE 179 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
self
expanderSetLabel :: GlibString string => Expander -> string -> IO ()
expanderSetLabel :: forall string. GlibString string => Expander -> string -> IO ()
expanderSetLabel Expander
self string
label =
string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
label ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
labelPtr ->
(\(Expander ForeignPtr Expander
arg1) CString
arg2 -> ForeignPtr Expander -> (Ptr Expander -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Expander
arg1 ((Ptr Expander -> IO ()) -> IO ())
-> (Ptr Expander -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Expander
argPtr1 ->Ptr Expander -> CString -> IO ()
gtk_expander_set_label Ptr Expander
argPtr1 CString
arg2)
{-# LINE 189 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
self
CString
labelPtr
expanderGetLabel :: GlibString string => Expander -> IO string
expanderGetLabel :: forall string. GlibString string => Expander -> IO string
expanderGetLabel Expander
self =
(\(Expander ForeignPtr Expander
arg1) -> ForeignPtr Expander -> (Ptr Expander -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Expander
arg1 ((Ptr Expander -> IO CString) -> IO CString)
-> (Ptr Expander -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr Expander
argPtr1 ->Ptr Expander -> IO CString
gtk_expander_get_label Ptr Expander
argPtr1)
{-# LINE 198 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
self
IO CString -> (CString -> IO string) -> IO string
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO string
forall s. GlibString s => CString -> IO s
peekUTFString
expanderSetUseUnderline :: Expander
-> Bool
-> IO ()
expanderSetUseUnderline :: Expander -> Bool -> IO ()
expanderSetUseUnderline Expander
self Bool
useUnderline =
(\(Expander ForeignPtr Expander
arg1) CInt
arg2 -> ForeignPtr Expander -> (Ptr Expander -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Expander
arg1 ((Ptr Expander -> IO ()) -> IO ())
-> (Ptr Expander -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Expander
argPtr1 ->Ptr Expander -> CInt -> IO ()
gtk_expander_set_use_underline Ptr Expander
argPtr1 CInt
arg2)
{-# LINE 210 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
self
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
useUnderline)
expanderGetUseUnderline :: Expander
-> IO Bool
expanderGetUseUnderline :: Expander -> IO Bool
expanderGetUseUnderline Expander
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Expander ForeignPtr Expander
arg1) -> ForeignPtr Expander -> (Ptr Expander -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Expander
arg1 ((Ptr Expander -> IO CInt) -> IO CInt)
-> (Ptr Expander -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Expander
argPtr1 ->Ptr Expander -> IO CInt
gtk_expander_get_use_underline Ptr Expander
argPtr1)
{-# LINE 222 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
self
expanderSetUseMarkup :: Expander
-> Bool
-> IO ()
expanderSetUseMarkup :: Expander -> Bool -> IO ()
expanderSetUseMarkup Expander
self Bool
useMarkup =
(\(Expander ForeignPtr Expander
arg1) CInt
arg2 -> ForeignPtr Expander -> (Ptr Expander -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Expander
arg1 ((Ptr Expander -> IO ()) -> IO ())
-> (Ptr Expander -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Expander
argPtr1 ->Ptr Expander -> CInt -> IO ()
gtk_expander_set_use_markup Ptr Expander
argPtr1 CInt
arg2)
{-# LINE 233 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
self
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
useMarkup)
expanderGetUseMarkup :: Expander -> IO Bool
expanderGetUseMarkup :: Expander -> IO Bool
expanderGetUseMarkup Expander
self =
(CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
(\(Expander ForeignPtr Expander
arg1) -> ForeignPtr Expander -> (Ptr Expander -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Expander
arg1 ((Ptr Expander -> IO CInt) -> IO CInt)
-> (Ptr Expander -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Expander
argPtr1 ->Ptr Expander -> IO CInt
gtk_expander_get_use_markup Ptr Expander
argPtr1)
{-# LINE 243 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
self
expanderSetLabelWidget :: WidgetClass labelWidget => Expander
-> labelWidget
-> IO ()
expanderSetLabelWidget :: forall labelWidget.
WidgetClass labelWidget =>
Expander -> labelWidget -> IO ()
expanderSetLabelWidget Expander
self labelWidget
labelWidget =
(\(Expander ForeignPtr Expander
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Expander -> (Ptr Expander -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Expander
arg1 ((Ptr Expander -> IO ()) -> IO ())
-> (Ptr Expander -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Expander
argPtr1 ->ForeignPtr Widget -> (Ptr Widget -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg2 ((Ptr Widget -> IO ()) -> IO ()) -> (Ptr Widget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr2 ->Ptr Expander -> Ptr Widget -> IO ()
gtk_expander_set_label_widget Ptr Expander
argPtr1 Ptr Widget
argPtr2)
{-# LINE 253 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
self
(labelWidget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget labelWidget
labelWidget)
expanderGetLabelWidget :: Expander
-> IO Widget
expanderGetLabelWidget :: Expander -> IO Widget
expanderGetLabelWidget Expander
self =
(ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
forall {a}. (ForeignPtr Widget -> Widget, FinalizerPtr a)
mkWidget (IO (Ptr Widget) -> IO Widget) -> IO (Ptr Widget) -> IO Widget
forall a b. (a -> b) -> a -> b
$
(\(Expander ForeignPtr Expander
arg1) -> ForeignPtr Expander
-> (Ptr Expander -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Expander
arg1 ((Ptr Expander -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Expander -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Expander
argPtr1 ->Ptr Expander -> IO (Ptr Widget)
gtk_expander_get_label_widget Ptr Expander
argPtr1)
{-# LINE 263 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
self
expanderExpanded :: Attr Expander Bool
expanderExpanded :: Attr Expander Bool
expanderExpanded = (Expander -> IO Bool)
-> (Expander -> Bool -> IO ()) -> Attr Expander Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
Expander -> IO Bool
expanderGetExpanded
Expander -> Bool -> IO ()
expanderSetExpanded
expanderLabel :: GlibString string => Attr Expander string
expanderLabel :: forall string. GlibString string => Attr Expander string
expanderLabel = (Expander -> IO string)
-> (Expander -> string -> IO ())
-> ReadWriteAttr Expander string string
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
Expander -> IO string
forall string. GlibString string => Expander -> IO string
expanderGetLabel
Expander -> string -> IO ()
forall string. GlibString string => Expander -> string -> IO ()
expanderSetLabel
expanderUseUnderline :: Attr Expander Bool
expanderUseUnderline :: Attr Expander Bool
expanderUseUnderline = (Expander -> IO Bool)
-> (Expander -> Bool -> IO ()) -> Attr Expander Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
Expander -> IO Bool
expanderGetUseUnderline
Expander -> Bool -> IO ()
expanderSetUseUnderline
expanderUseMarkup :: Attr Expander Bool
expanderUseMarkup :: Attr Expander Bool
expanderUseMarkup = (Expander -> IO Bool)
-> (Expander -> Bool -> IO ()) -> Attr Expander Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
Expander -> IO Bool
expanderGetUseMarkup
Expander -> Bool -> IO ()
expanderSetUseMarkup
expanderSpacing :: Attr Expander Int
expanderSpacing :: Attr Expander Int
expanderSpacing = (Expander -> IO Int)
-> (Expander -> Int -> IO ()) -> Attr Expander Int
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
Expander -> IO Int
expanderGetSpacing
Expander -> Int -> IO ()
expanderSetSpacing
expanderLabelWidget :: WidgetClass labelWidget => ReadWriteAttr Expander Widget labelWidget
expanderLabelWidget :: forall labelWidget.
WidgetClass labelWidget =>
ReadWriteAttr Expander Widget labelWidget
expanderLabelWidget = (Expander -> IO Widget)
-> (Expander -> labelWidget -> IO ())
-> ReadWriteAttr Expander Widget labelWidget
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
Expander -> IO Widget
expanderGetLabelWidget
Expander -> labelWidget -> IO ()
forall labelWidget.
WidgetClass labelWidget =>
Expander -> labelWidget -> IO ()
expanderSetLabelWidget
expanderLabelFill :: Attr Expander Bool
expanderLabelFill :: Attr Expander Bool
expanderLabelFill = String -> Attr Expander Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"label-fill"
onActivate, afterActivate :: Expander
-> IO ()
-> IO (ConnectId Expander)
onActivate :: Expander -> IO () -> IO (ConnectId Expander)
onActivate = String -> Bool -> Expander -> IO () -> IO (ConnectId Expander)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"activate" Bool
False
afterActivate :: Expander -> IO () -> IO (ConnectId Expander)
afterActivate = String -> Bool -> Expander -> IO () -> IO (ConnectId Expander)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"activate" Bool
True
foreign import ccall safe "gtk_expander_new"
gtk_expander_new :: ((Ptr CChar) -> (IO (Ptr Widget)))
foreign import ccall safe "gtk_expander_new_with_mnemonic"
gtk_expander_new_with_mnemonic :: ((Ptr CChar) -> (IO (Ptr Widget)))
foreign import ccall safe "gtk_expander_set_expanded"
gtk_expander_set_expanded :: ((Ptr Expander) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_expander_get_expanded"
gtk_expander_get_expanded :: ((Ptr Expander) -> (IO CInt))
foreign import ccall safe "gtk_expander_set_spacing"
gtk_expander_set_spacing :: ((Ptr Expander) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_expander_get_spacing"
gtk_expander_get_spacing :: ((Ptr Expander) -> (IO CInt))
foreign import ccall safe "gtk_expander_set_label"
gtk_expander_set_label :: ((Ptr Expander) -> ((Ptr CChar) -> (IO ())))
foreign import ccall safe "gtk_expander_get_label"
gtk_expander_get_label :: ((Ptr Expander) -> (IO (Ptr CChar)))
foreign import ccall safe "gtk_expander_set_use_underline"
gtk_expander_set_use_underline :: ((Ptr Expander) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_expander_get_use_underline"
gtk_expander_get_use_underline :: ((Ptr Expander) -> (IO CInt))
foreign import ccall safe "gtk_expander_set_use_markup"
gtk_expander_set_use_markup :: ((Ptr Expander) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_expander_get_use_markup"
gtk_expander_get_use_markup :: ((Ptr Expander) -> (IO CInt))
foreign import ccall safe "gtk_expander_set_label_widget"
gtk_expander_set_label_widget :: ((Ptr Expander) -> ((Ptr Widget) -> (IO ())))
foreign import ccall safe "gtk_expander_get_label_widget"
gtk_expander_get_label_widget :: ((Ptr Expander) -> (IO (Ptr Widget)))