{-# LINE 2 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LINE 3 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
module Graphics.UI.Gtk.MenuComboToolbar.ToolButton (
ToolButton,
ToolButtonClass,
castToToolButton, gTypeToolButton,
toToolButton,
toolButtonNew,
toolButtonNewFromStock,
toolButtonSetLabel,
toolButtonGetLabel,
toolButtonSetUseUnderline,
toolButtonGetUseUnderline,
toolButtonSetStockId,
toolButtonGetStockId,
toolButtonSetIconWidget,
toolButtonGetIconWidget,
toolButtonSetLabelWidget,
toolButtonGetLabelWidget,
toolButtonSetIconName,
toolButtonGetIconName,
toolButtonLabel,
toolButtonUseUnderline,
toolButtonLabelWidget,
toolButtonStockId,
toolButtonIconName,
toolButtonIconWidget,
onToolButtonClicked,
afterToolButtonClicked,
) where
import Control.Monad (liftM)
import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types
{-# LINE 118 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 119 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
import Graphics.UI.Gtk.General.StockItems
{-# LINE 122 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
toolButtonNew :: (WidgetClass iconWidget, GlibString string) =>
Maybe iconWidget
-> Maybe string
-> IO ToolButton
toolButtonNew :: forall iconWidget string.
(WidgetClass iconWidget, GlibString string) =>
Maybe iconWidget -> Maybe string -> IO ToolButton
toolButtonNew Maybe iconWidget
iconWidget Maybe string
label =
(ForeignPtr ToolButton -> ToolButton, FinalizerPtr ToolButton)
-> IO (Ptr ToolButton) -> IO ToolButton
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr ToolButton -> ToolButton, FinalizerPtr ToolButton)
forall {a}. (ForeignPtr ToolButton -> ToolButton, FinalizerPtr a)
mkToolButton (IO (Ptr ToolButton) -> IO ToolButton)
-> IO (Ptr ToolButton) -> IO ToolButton
forall a b. (a -> b) -> a -> b
$
(Ptr ToolItem -> Ptr ToolButton)
-> IO (Ptr ToolItem) -> IO (Ptr ToolButton)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr ToolItem -> Ptr ToolButton
forall a b. Ptr a -> Ptr b
castPtr :: Ptr ToolItem -> Ptr ToolButton) (IO (Ptr ToolItem) -> IO (Ptr ToolButton))
-> IO (Ptr ToolItem) -> IO (Ptr ToolButton)
forall a b. (a -> b) -> a -> b
$
(string -> (Ptr CChar -> IO (Ptr ToolItem)) -> IO (Ptr ToolItem))
-> Maybe string
-> (Ptr CChar -> IO (Ptr ToolItem))
-> IO (Ptr ToolItem)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith string -> (Ptr CChar -> IO (Ptr ToolItem)) -> IO (Ptr ToolItem)
forall a. string -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString Maybe string
label ((Ptr CChar -> IO (Ptr ToolItem)) -> IO (Ptr ToolItem))
-> (Ptr CChar -> IO (Ptr ToolItem)) -> IO (Ptr ToolItem)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
labelPtr ->
(\(Widget ForeignPtr Widget
arg1) Ptr CChar
arg2 -> ForeignPtr Widget
-> (Ptr Widget -> IO (Ptr ToolItem)) -> IO (Ptr ToolItem)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Widget
arg1 ((Ptr Widget -> IO (Ptr ToolItem)) -> IO (Ptr ToolItem))
-> (Ptr Widget -> IO (Ptr ToolItem)) -> IO (Ptr ToolItem)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
argPtr1 ->Ptr Widget -> Ptr CChar -> IO (Ptr ToolItem)
gtk_tool_button_new Ptr Widget
argPtr1 Ptr CChar
arg2)
{-# LINE 141 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
(maybe (Widget nullForeignPtr) toWidget iconWidget)
Ptr CChar
labelPtr
toolButtonNewFromStock ::
StockId
-> IO ToolButton
toolButtonNewFromStock :: StockId -> IO ToolButton
toolButtonNewFromStock StockId
stockId =
(ForeignPtr ToolButton -> ToolButton, FinalizerPtr ToolButton)
-> IO (Ptr ToolButton) -> IO ToolButton
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr ToolButton -> ToolButton, FinalizerPtr ToolButton)
forall {a}. (ForeignPtr ToolButton -> ToolButton, FinalizerPtr a)
mkToolButton (IO (Ptr ToolButton) -> IO ToolButton)
-> IO (Ptr ToolButton) -> IO ToolButton
forall a b. (a -> b) -> a -> b
$
(Ptr ToolItem -> Ptr ToolButton)
-> IO (Ptr ToolItem) -> IO (Ptr ToolButton)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr ToolItem -> Ptr ToolButton
forall a b. Ptr a -> Ptr b
castPtr :: Ptr ToolItem -> Ptr ToolButton) (IO (Ptr ToolItem) -> IO (Ptr ToolButton))
-> IO (Ptr ToolItem) -> IO (Ptr ToolButton)
forall a b. (a -> b) -> a -> b
$
StockId -> (Ptr CChar -> IO (Ptr ToolItem)) -> IO (Ptr ToolItem)
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
forall a. StockId -> (Ptr CChar -> IO a) -> IO a
withUTFString StockId
stockId ((Ptr CChar -> IO (Ptr ToolItem)) -> IO (Ptr ToolItem))
-> (Ptr CChar -> IO (Ptr ToolItem)) -> IO (Ptr ToolItem)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
stockIdPtr ->
Ptr CChar -> IO (Ptr ToolItem)
gtk_tool_button_new_from_stock
{-# LINE 157 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
stockIdPtr
toolButtonSetLabel :: (ToolButtonClass self, GlibString string) => self
-> Maybe string
-> IO ()
toolButtonSetLabel :: forall self string.
(ToolButtonClass self, GlibString string) =>
self -> Maybe string -> IO ()
toolButtonSetLabel self
self Maybe string
label =
(string -> (Ptr CChar -> IO ()) -> IO ())
-> Maybe string -> (Ptr CChar -> IO ()) -> IO ()
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith string -> (Ptr CChar -> IO ()) -> IO ()
forall a. string -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString Maybe string
label ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
labelPtr ->
(\(ToolButton ForeignPtr ToolButton
arg1) Ptr CChar
arg2 -> ForeignPtr ToolButton -> (Ptr ToolButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ToolButton
arg1 ((Ptr ToolButton -> IO ()) -> IO ())
-> (Ptr ToolButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ToolButton
argPtr1 ->Ptr ToolButton -> Ptr CChar -> IO ()
gtk_tool_button_set_label Ptr ToolButton
argPtr1 Ptr CChar
arg2)
{-# LINE 176 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
(toToolButton self)
Ptr CChar
labelPtr
toolButtonGetLabel :: (ToolButtonClass self, GlibString string) => self -> IO (Maybe string)
toolButtonGetLabel :: forall self string.
(ToolButtonClass self, GlibString string) =>
self -> IO (Maybe string)
toolButtonGetLabel self
self =
(\(ToolButton ForeignPtr ToolButton
arg1) -> ForeignPtr ToolButton
-> (Ptr ToolButton -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ToolButton
arg1 ((Ptr ToolButton -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (Ptr ToolButton -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr ToolButton
argPtr1 ->Ptr ToolButton -> IO (Ptr CChar)
gtk_tool_button_get_label Ptr ToolButton
argPtr1)
{-# LINE 185 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
(toToolButton self)
IO (Ptr CChar)
-> (Ptr CChar -> IO (Maybe string)) -> IO (Maybe string)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr CChar -> IO string) -> Ptr CChar -> IO (Maybe string)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO string
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString
toolButtonSetUseUnderline :: ToolButtonClass self => self -> Bool -> IO ()
toolButtonSetUseUnderline :: forall self. ToolButtonClass self => self -> Bool -> IO ()
toolButtonSetUseUnderline self
self Bool
useUnderline =
(\(ToolButton ForeignPtr ToolButton
arg1) CInt
arg2 -> ForeignPtr ToolButton -> (Ptr ToolButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ToolButton
arg1 ((Ptr ToolButton -> IO ()) -> IO ())
-> (Ptr ToolButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ToolButton
argPtr1 ->Ptr ToolButton -> CInt -> IO ()
gtk_tool_button_set_use_underline Ptr ToolButton
argPtr1 CInt
arg2)
{-# LINE 200 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
(toToolButton self)
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
useUnderline)
toolButtonGetUseUnderline :: ToolButtonClass self => self -> IO Bool
toolButtonGetUseUnderline :: forall self. ToolButtonClass self => self -> IO Bool
toolButtonGetUseUnderline self
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
$
(\(ToolButton ForeignPtr ToolButton
arg1) -> ForeignPtr ToolButton -> (Ptr ToolButton -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ToolButton
arg1 ((Ptr ToolButton -> IO CInt) -> IO CInt)
-> (Ptr ToolButton -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr ToolButton
argPtr1 ->Ptr ToolButton -> IO CInt
gtk_tool_button_get_use_underline Ptr ToolButton
argPtr1)
{-# LINE 210 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
(toToolButton self)
toolButtonSetStockId :: ToolButtonClass self => self
-> Maybe StockId
-> IO ()
toolButtonSetStockId :: forall self. ToolButtonClass self => self -> Maybe StockId -> IO ()
toolButtonSetStockId self
self Maybe StockId
stockId =
(StockId -> (Ptr CChar -> IO ()) -> IO ())
-> Maybe StockId -> (Ptr CChar -> IO ()) -> IO ()
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith StockId -> (Ptr CChar -> IO ()) -> IO ()
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
forall a. StockId -> (Ptr CChar -> IO a) -> IO a
withUTFString Maybe StockId
stockId ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
stockIdPtr ->
(\(ToolButton ForeignPtr ToolButton
arg1) Ptr CChar
arg2 -> ForeignPtr ToolButton -> (Ptr ToolButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ToolButton
arg1 ((Ptr ToolButton -> IO ()) -> IO ())
-> (Ptr ToolButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ToolButton
argPtr1 ->Ptr ToolButton -> Ptr CChar -> IO ()
gtk_tool_button_set_stock_id Ptr ToolButton
argPtr1 Ptr CChar
arg2)
{-# LINE 222 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
(toToolButton self)
Ptr CChar
stockIdPtr
toolButtonGetStockId :: ToolButtonClass self => self -> IO (Maybe StockId)
toolButtonGetStockId :: forall self. ToolButtonClass self => self -> IO (Maybe StockId)
toolButtonGetStockId self
self =
(\(ToolButton ForeignPtr ToolButton
arg1) -> ForeignPtr ToolButton
-> (Ptr ToolButton -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ToolButton
arg1 ((Ptr ToolButton -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (Ptr ToolButton -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr ToolButton
argPtr1 ->Ptr ToolButton -> IO (Ptr CChar)
gtk_tool_button_get_stock_id Ptr ToolButton
argPtr1)
{-# LINE 230 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
(toToolButton self)
IO (Ptr CChar)
-> (Ptr CChar -> IO (Maybe StockId)) -> IO (Maybe StockId)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr CChar -> IO StockId) -> Ptr CChar -> IO (Maybe StockId)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO StockId
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString
toolButtonSetIconWidget :: (ToolButtonClass self, WidgetClass iconWidget) => self
-> Maybe iconWidget
-> IO ()
toolButtonSetIconWidget :: forall self iconWidget.
(ToolButtonClass self, WidgetClass iconWidget) =>
self -> Maybe iconWidget -> IO ()
toolButtonSetIconWidget self
self Maybe iconWidget
iconWidget =
(\(ToolButton ForeignPtr ToolButton
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr ToolButton -> (Ptr ToolButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ToolButton
arg1 ((Ptr ToolButton -> IO ()) -> IO ())
-> (Ptr ToolButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ToolButton
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 ToolButton -> Ptr Widget -> IO ()
gtk_tool_button_set_icon_widget Ptr ToolButton
argPtr1 Ptr Widget
argPtr2)
{-# LINE 242 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
(toToolButton self)
(Widget -> (iconWidget -> Widget) -> Maybe iconWidget -> Widget
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ForeignPtr Widget -> Widget
Widget ForeignPtr Widget
forall a. ForeignPtr a
nullForeignPtr) iconWidget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget Maybe iconWidget
iconWidget)
toolButtonGetIconWidget :: ToolButtonClass self => self
-> IO (Maybe Widget)
toolButtonGetIconWidget :: forall self. ToolButtonClass self => self -> IO (Maybe Widget)
toolButtonGetIconWidget self
self =
(IO (Ptr Widget) -> IO Widget)
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((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 (Maybe Widget))
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$
(\(ToolButton ForeignPtr ToolButton
arg1) -> ForeignPtr ToolButton
-> (Ptr ToolButton -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ToolButton
arg1 ((Ptr ToolButton -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr ToolButton -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr ToolButton
argPtr1 ->Ptr ToolButton -> IO (Ptr Widget)
gtk_tool_button_get_icon_widget Ptr ToolButton
argPtr1)
{-# LINE 254 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
(toToolButton self)
toolButtonSetLabelWidget :: (ToolButtonClass self, WidgetClass labelWidget) => self
-> Maybe labelWidget
-> IO ()
toolButtonSetLabelWidget :: forall self iconWidget.
(ToolButtonClass self, WidgetClass iconWidget) =>
self -> Maybe iconWidget -> IO ()
toolButtonSetLabelWidget self
self Maybe labelWidget
labelWidget =
(\(ToolButton ForeignPtr ToolButton
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr ToolButton -> (Ptr ToolButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ToolButton
arg1 ((Ptr ToolButton -> IO ()) -> IO ())
-> (Ptr ToolButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ToolButton
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 ToolButton -> Ptr Widget -> IO ()
gtk_tool_button_set_label_widget Ptr ToolButton
argPtr1 Ptr Widget
argPtr2)
{-# LINE 268 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
(toToolButton self)
(Widget -> (labelWidget -> Widget) -> Maybe labelWidget -> Widget
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ForeignPtr Widget -> Widget
Widget ForeignPtr Widget
forall a. ForeignPtr a
nullForeignPtr) labelWidget -> Widget
forall o. WidgetClass o => o -> Widget
toWidget Maybe labelWidget
labelWidget)
toolButtonGetLabelWidget :: ToolButtonClass self => self
-> IO (Maybe Widget)
toolButtonGetLabelWidget :: forall self. ToolButtonClass self => self -> IO (Maybe Widget)
toolButtonGetLabelWidget self
self =
(IO (Ptr Widget) -> IO Widget)
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((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 (Maybe Widget))
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$
(\(ToolButton ForeignPtr ToolButton
arg1) -> ForeignPtr ToolButton
-> (Ptr ToolButton -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ToolButton
arg1 ((Ptr ToolButton -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr ToolButton -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr ToolButton
argPtr1 ->Ptr ToolButton -> IO (Ptr Widget)
gtk_tool_button_get_label_widget Ptr ToolButton
argPtr1)
{-# LINE 280 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
(toToolButton self)
toolButtonSetIconName :: (ToolButtonClass self, GlibString string) => self
-> string
-> IO ()
toolButtonSetIconName :: forall self string.
(ToolButtonClass self, GlibString string) =>
self -> string -> IO ()
toolButtonSetIconName self
self string
iconName =
string -> (Ptr CChar -> IO ()) -> IO ()
forall a. string -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString string
iconName ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
iconNamePtr ->
(\(ToolButton ForeignPtr ToolButton
arg1) Ptr CChar
arg2 -> ForeignPtr ToolButton -> (Ptr ToolButton -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ToolButton
arg1 ((Ptr ToolButton -> IO ()) -> IO ())
-> (Ptr ToolButton -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ToolButton
argPtr1 ->Ptr ToolButton -> Ptr CChar -> IO ()
gtk_tool_button_set_icon_name Ptr ToolButton
argPtr1 Ptr CChar
arg2)
{-# LINE 296 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
(toToolButton self)
Ptr CChar
iconNamePtr
toolButtonGetIconName :: (ToolButtonClass self, GlibString string) => self
-> IO string
toolButtonGetIconName :: forall self string.
(ToolButtonClass self, GlibString string) =>
self -> IO string
toolButtonGetIconName self
self =
(\(ToolButton ForeignPtr ToolButton
arg1) -> ForeignPtr ToolButton
-> (Ptr ToolButton -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ToolButton
arg1 ((Ptr ToolButton -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (Ptr ToolButton -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr ToolButton
argPtr1 ->Ptr ToolButton -> IO (Ptr CChar)
gtk_tool_button_get_icon_name Ptr ToolButton
argPtr1)
{-# LINE 309 "./Graphics/UI/Gtk/MenuComboToolbar/ToolButton.chs" #-}
(toToolButton self)
IO (Ptr CChar) -> (Ptr CChar -> 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
>>= \Ptr CChar
strPtr -> if Ptr CChar
strPtr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
then string -> IO string
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return string
""
else Ptr CChar -> IO string
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString Ptr CChar
strPtr
toolButtonLabel :: (ToolButtonClass self, GlibString string) => Attr self (Maybe string)
toolButtonLabel :: forall self string.
(ToolButtonClass self, GlibString string) =>
Attr self (Maybe string)
toolButtonLabel = (self -> IO (Maybe string))
-> (self -> Maybe string -> IO ())
-> ReadWriteAttr self (Maybe string) (Maybe string)
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO (Maybe string)
forall self string.
(ToolButtonClass self, GlibString string) =>
self -> IO (Maybe string)
toolButtonGetLabel
self -> Maybe string -> IO ()
forall self string.
(ToolButtonClass self, GlibString string) =>
self -> Maybe string -> IO ()
toolButtonSetLabel
toolButtonUseUnderline :: ToolButtonClass self => Attr self Bool
toolButtonUseUnderline :: forall self. ToolButtonClass self => Attr self Bool
toolButtonUseUnderline = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO Bool
forall self. ToolButtonClass self => self -> IO Bool
toolButtonGetUseUnderline
self -> Bool -> IO ()
forall self. ToolButtonClass self => self -> Bool -> IO ()
toolButtonSetUseUnderline
toolButtonLabelWidget :: (ToolButtonClass self, WidgetClass labelWidget) => ReadWriteAttr self (Maybe Widget) (Maybe labelWidget)
toolButtonLabelWidget :: forall self labelWidget.
(ToolButtonClass self, WidgetClass labelWidget) =>
ReadWriteAttr self (Maybe Widget) (Maybe labelWidget)
toolButtonLabelWidget = (self -> IO (Maybe Widget))
-> (self -> Maybe labelWidget -> IO ())
-> ReadWriteAttr self (Maybe Widget) (Maybe labelWidget)
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO (Maybe Widget)
forall self. ToolButtonClass self => self -> IO (Maybe Widget)
toolButtonGetLabelWidget
self -> Maybe labelWidget -> IO ()
forall self iconWidget.
(ToolButtonClass self, WidgetClass iconWidget) =>
self -> Maybe iconWidget -> IO ()
toolButtonSetLabelWidget
toolButtonStockId :: ToolButtonClass self => ReadWriteAttr self (Maybe StockId) (Maybe StockId)
toolButtonStockId :: forall self.
ToolButtonClass self =>
ReadWriteAttr self (Maybe StockId) (Maybe StockId)
toolButtonStockId = (self -> IO (Maybe StockId))
-> (self -> Maybe StockId -> IO ())
-> ReadWriteAttr self (Maybe StockId) (Maybe StockId)
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO (Maybe StockId)
forall self. ToolButtonClass self => self -> IO (Maybe StockId)
toolButtonGetStockId
self -> Maybe StockId -> IO ()
forall self. ToolButtonClass self => self -> Maybe StockId -> IO ()
toolButtonSetStockId
toolButtonIconName :: (ToolButtonClass self, GlibString string) => Attr self string
toolButtonIconName :: forall self string.
(ToolButtonClass self, GlibString string) =>
Attr self string
toolButtonIconName = (self -> IO string)
-> (self -> string -> IO ()) -> ReadWriteAttr self string string
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO string
forall self string.
(ToolButtonClass self, GlibString string) =>
self -> IO string
toolButtonGetIconName
self -> string -> IO ()
forall self string.
(ToolButtonClass self, GlibString string) =>
self -> string -> IO ()
toolButtonSetIconName
toolButtonIconWidget :: (ToolButtonClass self, WidgetClass iconWidget) => ReadWriteAttr self (Maybe Widget) (Maybe iconWidget)
toolButtonIconWidget :: forall self labelWidget.
(ToolButtonClass self, WidgetClass labelWidget) =>
ReadWriteAttr self (Maybe Widget) (Maybe labelWidget)
toolButtonIconWidget = (self -> IO (Maybe Widget))
-> (self -> Maybe iconWidget -> IO ())
-> ReadWriteAttr self (Maybe Widget) (Maybe iconWidget)
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
self -> IO (Maybe Widget)
forall self. ToolButtonClass self => self -> IO (Maybe Widget)
toolButtonGetIconWidget
self -> Maybe iconWidget -> IO ()
forall self iconWidget.
(ToolButtonClass self, WidgetClass iconWidget) =>
self -> Maybe iconWidget -> IO ()
toolButtonSetIconWidget
onToolButtonClicked, afterToolButtonClicked :: ToolButtonClass self => self
-> IO ()
-> IO (ConnectId self)
onToolButtonClicked :: forall self.
ToolButtonClass self =>
self -> IO () -> IO (ConnectId self)
onToolButtonClicked = SignalName -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
SignalName -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE SignalName
"clicked" Bool
False
afterToolButtonClicked :: forall self.
ToolButtonClass self =>
self -> IO () -> IO (ConnectId self)
afterToolButtonClicked = SignalName -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
SignalName -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE SignalName
"clicked" Bool
True
foreign import ccall safe "gtk_tool_button_new"
gtk_tool_button_new :: ((Ptr Widget) -> ((Ptr CChar) -> (IO (Ptr ToolItem))))
foreign import ccall safe "gtk_tool_button_new_from_stock"
gtk_tool_button_new_from_stock :: ((Ptr CChar) -> (IO (Ptr ToolItem)))
foreign import ccall safe "gtk_tool_button_set_label"
gtk_tool_button_set_label :: ((Ptr ToolButton) -> ((Ptr CChar) -> (IO ())))
foreign import ccall safe "gtk_tool_button_get_label"
gtk_tool_button_get_label :: ((Ptr ToolButton) -> (IO (Ptr CChar)))
foreign import ccall safe "gtk_tool_button_set_use_underline"
gtk_tool_button_set_use_underline :: ((Ptr ToolButton) -> (CInt -> (IO ())))
foreign import ccall safe "gtk_tool_button_get_use_underline"
gtk_tool_button_get_use_underline :: ((Ptr ToolButton) -> (IO CInt))
foreign import ccall safe "gtk_tool_button_set_stock_id"
gtk_tool_button_set_stock_id :: ((Ptr ToolButton) -> ((Ptr CChar) -> (IO ())))
foreign import ccall safe "gtk_tool_button_get_stock_id"
gtk_tool_button_get_stock_id :: ((Ptr ToolButton) -> (IO (Ptr CChar)))
foreign import ccall safe "gtk_tool_button_set_icon_widget"
gtk_tool_button_set_icon_widget :: ((Ptr ToolButton) -> ((Ptr Widget) -> (IO ())))
foreign import ccall safe "gtk_tool_button_get_icon_widget"
gtk_tool_button_get_icon_widget :: ((Ptr ToolButton) -> (IO (Ptr Widget)))
foreign import ccall safe "gtk_tool_button_set_label_widget"
gtk_tool_button_set_label_widget :: ((Ptr ToolButton) -> ((Ptr Widget) -> (IO ())))
foreign import ccall safe "gtk_tool_button_get_label_widget"
gtk_tool_button_get_label_widget :: ((Ptr ToolButton) -> (IO (Ptr Widget)))
foreign import ccall safe "gtk_tool_button_set_icon_name"
gtk_tool_button_set_icon_name :: ((Ptr ToolButton) -> ((Ptr CChar) -> (IO ())))
foreign import ccall safe "gtk_tool_button_get_icon_name"
gtk_tool_button_get_icon_name :: ((Ptr ToolButton) -> (IO (Ptr CChar)))