{-# LINE 2 "./Graphics/UI/Gtk/Layout/Expander.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Expander
--
-- Author : Duncan Coutts
--
-- Created: 24 April 2004
--
-- Copyright (C) 2004-2005 Duncan Coutts
--
-- 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)
--
-- A container which can hide its child
--
-- * Module available since Gtk+ version 2.4
--
module Graphics.UI.Gtk.Layout.Expander (
-- * Detail
--
-- | A 'Expander' allows the user to hide or show its child by clicking on an
-- expander triangle similar to the triangles used in a 'TreeView'.
--
-- Normally you use an expander as you would use any other descendant of
-- 'Bin'; you create the child widget and use
-- 'Graphics.UI.Gtk.Abstract.Container.containerAdd' to add it to the
-- expander. When the expander is toggled, it will take care of showing and
-- hiding the child automatically.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----'Container'
-- | +----'Bin'
-- | +----Expander
-- @


-- * Types
  Expander,
  ExpanderClass,
  castToExpander, gTypeExpander,
  toExpander,

-- * Constructors
  expanderNew,
  expanderNewWithMnemonic,

-- * Methods
  expanderSetExpanded,
  expanderGetExpanded,
  expanderSetSpacing,
  expanderGetSpacing,
  expanderSetLabel,
  expanderGetLabel,
  expanderSetUseUnderline,
  expanderGetUseUnderline,
  expanderSetUseMarkup,
  expanderGetUseMarkup,
  expanderSetLabelWidget,
  expanderGetLabelWidget,

-- * Attributes
  expanderExpanded,
  expanderLabel,
  expanderUseUnderline,
  expanderUseMarkup,
  expanderSpacing,
  expanderLabelWidget,

  expanderLabelFill,


-- * Signals
  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" #-}


--------------------
-- Constructors

-- | Creates a new expander using the given string as the text of the label.
--
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.
ObjectClass 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

-- | Creates a new expander using @label@ as the text of the label. If
-- characters in @label@ are preceded by an underscore, they are underlined. If
-- you need a literal underscore character in a label, use \'__\' (two
-- underscores). The first underlined character represents a keyboard
-- accelerator called a mnemonic. Pressing Alt and that key activates the
-- button.
--
expanderNewWithMnemonic :: GlibString string
 => string -- ^ @label@ - the text of the label with an underscore in
                -- front of the mnemonic character
 -> 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.
ObjectClass 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

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

-- | Sets the state of the expander. Set to @True@, if you want the child
-- widget to be revealed, and @False@ if you want the child widget to be
-- hidden.
--
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)

-- | Queries a 'Expander' and returns its current state. Returns @True@ if the
-- child widget is revealed.
--
-- See 'expanderSetExpanded'.
--
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

-- | Sets the spacing field of @expander@, which is the number of pixels to
-- place between expander and the child.
--
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)

-- | Gets the value set by 'expanderSetSpacing'.
--
expanderGetSpacing :: Expander
 -> IO Int -- ^ returns spacing between the expander and child.
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

-- | Sets the text of the label of the expander to @label@.
--
-- This will also clear any previously set labels.
--
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

-- | Fetches the text from the label of the expander, as set by
-- 'expanderSetLabel'.
--
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

-- | If true, an underline in the text of the expander label indicates the
-- next character should be used for the mnemonic accelerator key.
--
expanderSetUseUnderline :: Expander
 -> Bool -- ^ @useUnderline@ - @True@ if underlines in the text indicate
             -- mnemonics
 -> 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)

-- | Returns whether an embedded underline in the expander label indicates a
-- mnemonic. See 'expanderSetUseUnderline'.
--
expanderGetUseUnderline :: Expander
 -> IO Bool -- ^ returns @True@ if an embedded underline in the expander
             -- label indicates the mnemonic accelerator keys.
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

-- | Sets whether the text of the label contains markup in Pango's text markup
-- language. See 'Graphics.UI.Gtk.Display.Label.labelSetMarkup'.
--
expanderSetUseMarkup :: Expander
 -> Bool -- ^ @useMarkup@ - @True@ if the label's text should be parsed
             -- for markup
 -> 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)

-- | Returns whether the label's text is interpreted as marked up with the
-- Pango text markup language. See 'expanderSetUseMarkup'.
--
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

-- | Set the label widget for the expander. This is the widget that will
-- appear embedded alongside the expander arrow.
--
expanderSetLabelWidget :: WidgetClass labelWidget => Expander
 -> labelWidget -- ^ @labelWidget@ - the new label widget
 -> 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)

-- | Retrieves the label widget for the frame. See 'expanderSetLabelWidget'.
--
expanderGetLabelWidget :: Expander
 -> IO Widget -- ^ returns the label widget
expanderGetLabelWidget :: Expander -> IO Widget
expanderGetLabelWidget Expander
self =
  (ForeignPtr Widget -> Widget, FinalizerPtr Widget)
-> IO (Ptr Widget) -> IO Widget
forall obj.
ObjectClass 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

--------------------
-- Attributes

-- | Whether the expander has been opened to reveal the child widget.
--
-- Default value: @False@
--
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

-- | Text of the expander's label.
--
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

-- | If set, an underline in the text indicates the next character should be
-- used for the mnemonic accelerator key.
--
-- Default value: @False@
--
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

-- | The text of the label includes XML markup. See pango_parse_markup().
--
-- Default value: @False@
--
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

-- | Space to put between the label and the child.
--
-- Allowed values: >= 0
--
-- Default value: 0
--
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

-- | A widget to display in place of the usual expander label.
--
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


-- | Whether the label widget should fill all available horizontal space.
--
-- Default value: 'False'
--
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"


--------------------
-- Signals

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)))