{-# LINE 2 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
{-# LANGUAGE OverloadedStrings #-}

{-# LINE 3 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Button
--
-- Author : Axel Simon
--
-- Created: 15 May 2001
--
-- Copyright (C) 1999-2005 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)
--
-- A widget that creates a signal when clicked on
--
module Graphics.UI.Gtk.Buttons.Button (
-- * Detail
--
-- | The 'Button' widget is generally used to attach a function to that is
-- called when the button is pressed. The various signals and how to use them
-- are outlined below.
--
-- The 'Button' widget can hold any valid child widget. That is it can hold
-- most any other standard 'Widget'. The most commonly used child is the
-- 'Label'.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----'Container'
-- | +----'Bin'
-- | +----Button
-- | +----'ToggleButton'
-- | +----'ColorButton'
-- | +----'FontButton'
-- | +----'OptionMenu'
-- @

-- * Types
  Button,
  ButtonClass,
  castToButton, gTypeButton,
  toButton,

-- * Constructors
  buttonNew,
  buttonNewWithLabel,
  buttonNewWithMnemonic,
  buttonNewFromStock,

-- * Methods
  buttonPressed,
  buttonReleased,
  buttonClicked,
  buttonEnter,
  buttonLeave,
  ReliefStyle(..),
  buttonSetRelief,
  buttonGetRelief,
  buttonSetLabel,
  buttonGetLabel,
  buttonSetUseStock,
  buttonGetUseStock,
  buttonSetUseUnderline,
  buttonGetUseUnderline,

  buttonSetFocusOnClick,
  buttonGetFocusOnClick,
  buttonSetAlignment,
  buttonGetAlignment,


  buttonGetImage,
  buttonSetImage,


  PositionType(..),
  buttonSetImagePosition,
  buttonGetImagePosition,


  buttonGetEventWindow,


-- * Attributes
  buttonLabel,
  buttonUseUnderline,
  buttonUseStock,

  buttonFocusOnClick,

  buttonRelief,

  buttonXalign,
  buttonYalign,


  buttonImage,


  buttonImagePosition,


-- * Signals
  buttonActivated,

-- * Deprecated

  onButtonActivate,
  afterButtonActivate,
  onClicked,
  afterClicked,
  onEnter,
  afterEnter,
  onLeave,
  afterLeave,
  onPressed,
  afterPressed,
  onReleased,
  afterReleased

  ) 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 (makeNewObject)
import Graphics.UI.Gtk.Types
{-# LINE 148 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 149 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
import Graphics.UI.Gtk.General.Enums (ReliefStyle(..), PositionType(..))
import Graphics.UI.Gtk.General.StockItems


{-# LINE 153 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}

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

-- | Creates a new 'Button' widget. To add a child widget to the button, use
-- 'Graphics.UI.Gtk.Abstract.Container.containerAdd'.
--
buttonNew :: IO Button
buttonNew :: IO Button
buttonNew =
  (ForeignPtr Button -> Button, FinalizerPtr Button)
-> IO (Ptr Button) -> IO Button
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Button -> Button, FinalizerPtr Button)
forall {a}. (ForeignPtr Button -> Button, FinalizerPtr a)
mkButton (IO (Ptr Button) -> IO Button) -> IO (Ptr Button) -> IO Button
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Button) -> IO (Ptr Widget) -> IO (Ptr Button)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Button
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Button) (IO (Ptr Widget) -> IO (Ptr Button))
-> IO (Ptr Widget) -> IO (Ptr Button)
forall a b. (a -> b) -> a -> b
$
  IO (Ptr Widget)
gtk_button_new
{-# LINE 165 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}

-- | Creates a 'Button' widget with a 'Label' child containing the given text.
--
buttonNewWithLabel :: GlibString string
 => string -- ^ @label@ - The text you want the 'Label' to hold.
 -> IO Button
buttonNewWithLabel :: forall string. GlibString string => string -> IO Button
buttonNewWithLabel string
label =
  (ForeignPtr Button -> Button, FinalizerPtr Button)
-> IO (Ptr Button) -> IO Button
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Button -> Button, FinalizerPtr Button)
forall {a}. (ForeignPtr Button -> Button, FinalizerPtr a)
mkButton (IO (Ptr Button) -> IO Button) -> IO (Ptr Button) -> IO Button
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Button) -> IO (Ptr Widget) -> IO (Ptr Button)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Button
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Button) (IO (Ptr Widget) -> IO (Ptr Button))
-> IO (Ptr Widget) -> IO (Ptr Button)
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_button_new_with_label
{-# LINE 176 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    labelPtr

-- | Creates a new 'Button' containing a 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.
--
buttonNewWithMnemonic :: GlibString string
 => string -- ^ @label@ - The text of the button, with an underscore in
              -- front of the mnemonic character
 -> IO Button
buttonNewWithMnemonic :: forall string. GlibString string => string -> IO Button
buttonNewWithMnemonic string
label =
  (ForeignPtr Button -> Button, FinalizerPtr Button)
-> IO (Ptr Button) -> IO Button
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Button -> Button, FinalizerPtr Button)
forall {a}. (ForeignPtr Button -> Button, FinalizerPtr a)
mkButton (IO (Ptr Button) -> IO Button) -> IO (Ptr Button) -> IO Button
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Button) -> IO (Ptr Widget) -> IO (Ptr Button)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Button
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Button) (IO (Ptr Widget) -> IO (Ptr Button))
-> IO (Ptr Widget) -> IO (Ptr Button)
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_button_new_with_mnemonic
{-# LINE 193 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    labelPtr

-- | Creates a new 'Button' containing the image and text from a stock item.
--
-- If @stockId@ is unknown, then it will be treated as a mnemonic label (as
-- for 'buttonNewWithMnemonic').
--
buttonNewFromStock ::
    StockId -- ^ @stockId@ - the name of the stock item
 -> IO Button
buttonNewFromStock :: StockId -> IO Button
buttonNewFromStock StockId
stockId =
  (ForeignPtr Button -> Button, FinalizerPtr Button)
-> IO (Ptr Button) -> IO Button
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Button -> Button, FinalizerPtr Button)
forall {a}. (ForeignPtr Button -> Button, FinalizerPtr a)
mkButton (IO (Ptr Button) -> IO Button) -> IO (Ptr Button) -> IO Button
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Button) -> IO (Ptr Widget) -> IO (Ptr Button)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Button
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Button) (IO (Ptr Widget) -> IO (Ptr Button))
-> IO (Ptr Widget) -> IO (Ptr Button)
forall a b. (a -> b) -> a -> b
$
  StockId -> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
forall a. StockId -> (CString -> IO a) -> IO a
withUTFString StockId
stockId ((CString -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (CString -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \CString
stockIdPtr ->
  String -> IO (Ptr Widget) -> IO (Ptr Widget)
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwIfNull String
"buttonNewFromStock: Invalid stock identifier." (IO (Ptr Widget) -> IO (Ptr Widget))
-> IO (Ptr Widget) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$
  CString -> IO (Ptr Widget)
gtk_button_new_from_stock
{-# LINE 209 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    stockIdPtr

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

-- | Emits the button pressed signal for the given 'Button'.
--
buttonPressed :: ButtonClass self => self -> IO ()
buttonPressed :: forall self. ButtonClass self => self -> IO ()
buttonPressed self
self =
  (\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO ()
gtk_button_pressed Ptr Button
argPtr1)
{-# LINE 219 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)

-- | Emits the button released signal for the given 'Button'.
--
buttonReleased :: ButtonClass self => self -> IO ()
buttonReleased :: forall self. ButtonClass self => self -> IO ()
buttonReleased self
self =
  (\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO ()
gtk_button_released Ptr Button
argPtr1)
{-# LINE 226 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)

-- | Emits the button clicked signal for the given 'Button'.
--
-- This is similar to calling 'buttonPressed' and 'buttonReleased' in sequence.
--
buttonClicked :: ButtonClass self => self -> IO ()
buttonClicked :: forall self. ButtonClass self => self -> IO ()
buttonClicked self
self =
  (\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO ()
gtk_button_clicked Ptr Button
argPtr1)
{-# LINE 235 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)

-- | Emit the cursor enters signal to the button.
--
buttonEnter :: ButtonClass self => self -> IO ()
buttonEnter :: forall self. ButtonClass self => self -> IO ()
buttonEnter self
self =
  (\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO ()
gtk_button_enter Ptr Button
argPtr1)
{-# LINE 242 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)

-- | Emit the cursor leaves signal to the button.
--
buttonLeave :: ButtonClass self => self -> IO ()
buttonLeave :: forall self. ButtonClass self => self -> IO ()
buttonLeave self
self =
  (\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO ()
gtk_button_leave Ptr Button
argPtr1)
{-# LINE 249 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)

-- | Sets the relief style of the edges of the given 'Button' widget. Three
-- styles exist, 'ReliefNormal', 'ReliefHalf', 'ReliefNone'. The default style
-- is, as one can guess, 'ReliefNormal'.
--
buttonSetRelief :: ButtonClass self => self
 -> ReliefStyle -- ^ @newstyle@ - The 'ReliefStyle' as described above.
 -> IO ()
buttonSetRelief :: forall self. ButtonClass self => self -> ReliefStyle -> IO ()
buttonSetRelief self
self ReliefStyle
newstyle =
  (\(Button ForeignPtr Button
arg1) CInt
arg2 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> CInt -> IO ()
gtk_button_set_relief Ptr Button
argPtr1 CInt
arg2)
{-# LINE 260 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (ReliefStyle -> Int) -> ReliefStyle -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReliefStyle -> Int
forall a. Enum a => a -> Int
fromEnum) ReliefStyle
newstyle)

-- | Returns the current relief style of the given 'Button'.
--
buttonGetRelief :: ButtonClass self => self
 -> IO ReliefStyle -- ^ returns The current 'ReliefStyle'
buttonGetRelief :: forall self. ButtonClass self => self -> IO ReliefStyle
buttonGetRelief self
self =
  (CInt -> ReliefStyle) -> IO CInt -> IO ReliefStyle
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ReliefStyle
forall a. Enum a => Int -> a
toEnum (Int -> ReliefStyle) -> (CInt -> Int) -> CInt -> ReliefStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO ReliefStyle) -> IO CInt -> IO ReliefStyle
forall a b. (a -> b) -> a -> b
$
  (\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO CInt) -> IO CInt)
-> (Ptr Button -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO CInt
gtk_button_get_relief Ptr Button
argPtr1)
{-# LINE 270 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)

-- | Sets the text of the label of the button. This text is also used
-- to select the stock item if 'buttonSetUseStock' is used.
--
-- This will also clear any previously set labels.
--
buttonSetLabel :: (ButtonClass self, GlibString string) => self -> string -> IO ()
buttonSetLabel :: forall self string.
(ButtonClass self, GlibString string) =>
self -> string -> IO ()
buttonSetLabel self
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 ->
  (\(Button ForeignPtr Button
arg1) CString
arg2 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> CString -> IO ()
gtk_button_set_label Ptr Button
argPtr1 CString
arg2)
{-# LINE 281 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)
    CString
labelPtr

-- | Gets the text from the label of the button, as set by
-- 'buttonSetLabel'. If the label text has not been set the return value will
-- be @\"\"@.
-- This will be the case if you create an empty button with 'buttonNew' to use
-- as a container.
--
buttonGetLabel :: (ButtonClass self, GlibString string) => self -> IO string
buttonGetLabel :: forall self string.
(ButtonClass self, GlibString string) =>
self -> IO string
buttonGetLabel self
self = do
  CString
strPtr <- (\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO CString) -> IO CString)
-> (Ptr Button -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO CString
gtk_button_get_label Ptr Button
argPtr1)
{-# LINE 293 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)
  if CString
strPtrCString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
==CString
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 CString -> IO string
forall s. GlibString s => CString -> IO s
peekUTFString CString
strPtr

-- | If true, the label set on the button is used as a stock id to select the
-- stock item for the button.
--
-- Setting this property to @True@ will make the button lookup its label in
-- the table of stock items. If there is a match, the button will use the
-- stock item instead of the label. You need to set this flag before you
-- change the label.
--
buttonSetUseStock :: ButtonClass self => self
 -> Bool -- ^ @useStock@ - @True@ if the button should use a stock item
 -> IO ()
buttonSetUseStock :: forall self. ButtonClass self => self -> Bool -> IO ()
buttonSetUseStock self
self Bool
useStock =
  (\(Button ForeignPtr Button
arg1) CInt
arg2 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> CInt -> IO ()
gtk_button_set_use_stock Ptr Button
argPtr1 CInt
arg2)
{-# LINE 309 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
useStock)

-- | Returns whether the button label is a stock item.
--
buttonGetUseStock :: ButtonClass self => self
 -> IO Bool -- ^ returns @True@ if the button label is used to select a stock
            -- item instead of being used directly as the label text.
buttonGetUseStock :: forall self. ButtonClass self => self -> IO Bool
buttonGetUseStock 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
$
  (\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO CInt) -> IO CInt)
-> (Ptr Button -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO CInt
gtk_button_get_use_stock Ptr Button
argPtr1)
{-# LINE 320 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)

-- | If true, an underline in the text of the button label indicates the next
-- character should be used for the mnemonic accelerator key.
--
-- Setting this property will make the button join any underline character
-- into the following letter and inserting this letter as a keyboard shortcut.
-- You need to set this flag before you change the label.
--
buttonSetUseUnderline :: ButtonClass self => self
 -> Bool -- ^ @useUnderline@ - @True@ if underlines in the text indicate
          -- mnemonics
 -> IO ()
buttonSetUseUnderline :: forall self. ButtonClass self => self -> Bool -> IO ()
buttonSetUseUnderline self
self Bool
useUnderline =
  (\(Button ForeignPtr Button
arg1) CInt
arg2 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> CInt -> IO ()
gtk_button_set_use_underline Ptr Button
argPtr1 CInt
arg2)
{-# LINE 335 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
useUnderline)

-- | Returns whether an embedded underline in the button label indicates a
-- mnemonic. See 'buttonSetUseUnderline'.
--
buttonGetUseUnderline :: ButtonClass self => self
 -> IO Bool -- ^ returns @True@ if an embedded underline in the button label
            -- indicates the mnemonic accelerator keys.
buttonGetUseUnderline :: forall self. ButtonClass self => self -> IO Bool
buttonGetUseUnderline 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
$
  (\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO CInt) -> IO CInt)
-> (Ptr Button -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO CInt
gtk_button_get_use_underline Ptr Button
argPtr1)
{-# LINE 347 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)


-- | Sets whether the button will grab focus when it is clicked with the
-- mouse. Making mouse clicks not grab focus is useful in places like toolbars
-- where you don't want the keyboard focus removed from the main area of the
-- application.
--
-- * Available since Gtk version 2.4
--
buttonSetFocusOnClick :: ButtonClass self => self
 -> Bool -- ^ @focusOnClick@ - whether the button grabs focus when clicked
          -- with the mouse
 -> IO ()
buttonSetFocusOnClick :: forall self. ButtonClass self => self -> Bool -> IO ()
buttonSetFocusOnClick self
self Bool
focusOnClick =
  (\(Button ForeignPtr Button
arg1) CInt
arg2 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> CInt -> IO ()
gtk_button_set_focus_on_click Ptr Button
argPtr1 CInt
arg2)
{-# LINE 363 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
focusOnClick)

-- | Returns whether the button grabs focus when it is clicked with the mouse.
-- See 'buttonSetFocusOnClick'.
--
-- * Available since Gtk version 2.4
--
buttonGetFocusOnClick :: ButtonClass self => self
 -> IO Bool -- ^ returns @True@ if the button grabs focus when it is clicked
            -- with the mouse.
buttonGetFocusOnClick :: forall self. ButtonClass self => self -> IO Bool
buttonGetFocusOnClick 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
$
  (\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO CInt) -> IO CInt)
-> (Ptr Button -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO CInt
gtk_button_get_focus_on_click Ptr Button
argPtr1)
{-# LINE 377 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)

-- | Sets the alignment of the child. This has no effect unless the child
-- derives from 'Misc' or 'Alignment'.
--
-- * Available since Gtk version 2.4
--
buttonSetAlignment :: ButtonClass self => self
 -> (Float, Float) -- ^ @(xalign, yalign)@ - the horizontal position of the
                   -- child (0.0 is left aligned, 1.0 is right aligned) and
                   -- the vertical position of the child (0.0 is top aligned,
                   -- 1.0 is bottom aligned)
 -> IO ()
buttonSetAlignment :: forall self. ButtonClass self => self -> (Float, Float) -> IO ()
buttonSetAlignment self
self (Float
xalign, Float
yalign) =
  (\(Button ForeignPtr Button
arg1) CFloat
arg2 CFloat
arg3 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> CFloat -> CFloat -> IO ()
gtk_button_set_alignment Ptr Button
argPtr1 CFloat
arg2 CFloat
arg3)
{-# LINE 392 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)
    (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
xalign)
    (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
yalign)

-- | Gets the alignment of the child in the button.
--
-- * Available since Gtk version 2.4
--
buttonGetAlignment :: ButtonClass self => self
 -> IO (Float, Float) -- ^ @(xalign, yalign)@ - horizontal and vertical
                      -- alignment
buttonGetAlignment :: forall self. ButtonClass self => self -> IO (Float, Float)
buttonGetAlignment self
self =
  (Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float))
-> (Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
xalignPtr ->
  (Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float))
-> (Ptr CFloat -> IO (Float, Float)) -> IO (Float, Float)
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
yalignPtr -> do
  (\(Button ForeignPtr Button
arg1) Ptr CFloat
arg2 Ptr CFloat
arg3 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> Ptr CFloat -> Ptr CFloat -> IO ()
gtk_button_get_alignment Ptr Button
argPtr1 Ptr CFloat
arg2 Ptr CFloat
arg3)
{-# LINE 407 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)
    Ptr CFloat
xalignPtr
    Ptr CFloat
yalignPtr
  CFloat
xalign <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
xalignPtr
  CFloat
yalign <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
yalignPtr
  (Float, Float) -> IO (Float, Float)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
xalign, CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
yalign)



-- | Gets the widget that is currenty set as the image of the button. This may
-- have been explicitly set by 'buttonSetImage' or constructed by
-- 'buttonNewFromStock'.
--
-- * Available since Gtk+ version 2.6
--
buttonGetImage :: ButtonClass self => self
 -> IO (Maybe Widget) -- ^ a 'Widget' or @Nothing@ in case there is no image
buttonGetImage :: forall self. ButtonClass self => self -> IO (Maybe Widget)
buttonGetImage 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.
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 (Maybe Widget))
-> IO (Ptr Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$
  (\(Button ForeignPtr Button
arg1) -> ForeignPtr Button
-> (Ptr Button -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr Button -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO (Ptr Widget)
gtk_button_get_image Ptr Button
argPtr1)
{-# LINE 427 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)

-- | Set the image of the button to the given widget. Note that it depends on
-- the \"gtk-button-images\" setting whether the image will be displayed or not.
--
-- * Available since Gtk+ version 2.6
--
buttonSetImage :: (ButtonClass self, WidgetClass image) => self
 -> image -- ^ a widget to set as the image for the button
 -> IO ()
buttonSetImage :: forall self image.
(ButtonClass self, WidgetClass image) =>
self -> image -> IO ()
buttonSetImage self
self image
image =
  (\(Button ForeignPtr Button
arg1) (Widget ForeignPtr Widget
arg2) -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
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 Button -> Ptr Widget -> IO ()
gtk_button_set_image Ptr Button
argPtr1 Ptr Widget
argPtr2)
{-# LINE 439 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)
    (image -> Widget
forall o. WidgetClass o => o -> Widget
toWidget image
image)



-- %hash c:e7a6 d:7a76
-- | Sets the position of the image relative to the text inside the button.
--
-- * Available since Gtk+ version 2.10
--
buttonSetImagePosition :: ButtonClass self => self
 -> PositionType -- ^ @position@ - the position
 -> IO ()
buttonSetImagePosition :: forall self. ButtonClass self => self -> PositionType -> IO ()
buttonSetImagePosition self
self PositionType
position =
  (\(Button ForeignPtr Button
arg1) CInt
arg2 -> ForeignPtr Button -> (Ptr Button -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO ()) -> IO ()) -> (Ptr Button -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> CInt -> IO ()
gtk_button_set_image_position Ptr Button
argPtr1 CInt
arg2)
{-# LINE 454 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (PositionType -> Int) -> PositionType -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionType -> Int
forall a. Enum a => a -> Int
fromEnum) PositionType
position)

-- %hash c:3841 d:1f6a
-- | Gets the position of the image relative to the text inside the button.
--
-- * Available since Gtk+ version 2.10
--
buttonGetImagePosition :: ButtonClass self => self
 -> IO PositionType -- ^ returns the position
buttonGetImagePosition :: forall self. ButtonClass self => self -> IO PositionType
buttonGetImagePosition self
self =
  (CInt -> PositionType) -> IO CInt -> IO PositionType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> PositionType
forall a. Enum a => Int -> a
toEnum (Int -> PositionType) -> (CInt -> Int) -> CInt -> PositionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO PositionType) -> IO CInt -> IO PositionType
forall a b. (a -> b) -> a -> b
$
  (\(Button ForeignPtr Button
arg1) -> ForeignPtr Button -> (Ptr Button -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO CInt) -> IO CInt)
-> (Ptr Button -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO CInt
gtk_button_get_image_position Ptr Button
argPtr1)
{-# LINE 467 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)



-- | Returns the button's event window if it is realized, 'Nothing' otherwise.
--
-- * Available since Gtk+ version 2.22
--
buttonGetEventWindow :: ButtonClass self => self
                       -> IO (Maybe DrawWindow) -- ^ returns button's event window or 'Nothing'
buttonGetEventWindow :: forall self. ButtonClass self => self -> IO (Maybe DrawWindow)
buttonGetEventWindow self
self =
  (IO (Ptr DrawWindow) -> IO DrawWindow)
-> IO (Ptr DrawWindow) -> IO (Maybe DrawWindow)
forall a. (IO (Ptr a) -> IO a) -> IO (Ptr a) -> IO (Maybe a)
maybeNull ((ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
-> IO (Ptr DrawWindow) -> IO DrawWindow
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr DrawWindow)
forall {a}. (ForeignPtr DrawWindow -> DrawWindow, FinalizerPtr a)
mkDrawWindow) (IO (Ptr DrawWindow) -> IO (Maybe DrawWindow))
-> IO (Ptr DrawWindow) -> IO (Maybe DrawWindow)
forall a b. (a -> b) -> a -> b
$
  (\(Button ForeignPtr Button
arg1) -> ForeignPtr Button
-> (Ptr Button -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Button
arg1 ((Ptr Button -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow))
-> (Ptr Button -> IO (Ptr DrawWindow)) -> IO (Ptr DrawWindow)
forall a b. (a -> b) -> a -> b
$ \Ptr Button
argPtr1 ->Ptr Button -> IO (Ptr DrawWindow)
gtk_button_get_event_window Ptr Button
argPtr1)
{-# LINE 480 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}
    (toButton self)


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

-- | Text of the label widget inside the button, if the button contains a
-- label widget.
--
-- Default value: @\"\"@
--
buttonLabel :: (ButtonClass self, GlibString string) => Attr self string
buttonLabel :: forall self string.
(ButtonClass self, GlibString string) =>
Attr self string
buttonLabel = (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.
(ButtonClass self, GlibString string) =>
self -> IO string
buttonGetLabel
  self -> string -> IO ()
forall self string.
(ButtonClass self, GlibString string) =>
self -> string -> IO ()
buttonSetLabel

-- | If set, an underline in the text indicates the next character should be
-- used for the mnemonic accelerator key.
--
-- Default value: @False@
--
buttonUseUnderline :: ButtonClass self => Attr self Bool
buttonUseUnderline :: forall self. ButtonClass self => Attr self Bool
buttonUseUnderline = (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. ButtonClass self => self -> IO Bool
buttonGetUseUnderline
  self -> Bool -> IO ()
forall self. ButtonClass self => self -> Bool -> IO ()
buttonSetUseUnderline

-- | If set, the label is used to pick a stock item instead of being
-- displayed.
--
-- Default value: @False@
--
buttonUseStock :: ButtonClass self => Attr self Bool
buttonUseStock :: forall self. ButtonClass self => Attr self Bool
buttonUseStock = (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. ButtonClass self => self -> IO Bool
buttonGetUseStock
  self -> Bool -> IO ()
forall self. ButtonClass self => self -> Bool -> IO ()
buttonSetUseStock


-- | Whether the button grabs focus when it is clicked with the mouse.
--
-- Default value: @True@
--
buttonFocusOnClick :: ButtonClass self => Attr self Bool
buttonFocusOnClick :: forall self. ButtonClass self => Attr self Bool
buttonFocusOnClick = (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. ButtonClass self => self -> IO Bool
buttonGetFocusOnClick
  self -> Bool -> IO ()
forall self. ButtonClass self => self -> Bool -> IO ()
buttonSetFocusOnClick


-- | The border relief style.
--
-- Default value: 'ReliefNormal'
--
buttonRelief :: ButtonClass self => Attr self ReliefStyle
buttonRelief :: forall self. ButtonClass self => Attr self ReliefStyle
buttonRelief = (self -> IO ReliefStyle)
-> (self -> ReliefStyle -> IO ())
-> ReadWriteAttr self ReliefStyle ReliefStyle
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO ReliefStyle
forall self. ButtonClass self => self -> IO ReliefStyle
buttonGetRelief
  self -> ReliefStyle -> IO ()
forall self. ButtonClass self => self -> ReliefStyle -> IO ()
buttonSetRelief


-- | If the child of the button is a 'Misc' or 'Alignment', this property can
-- be used to control it's horizontal alignment. 0.0 is left aligned, 1.0 is
-- right aligned.
--
-- Allowed values: [0,1]
--
-- Default value: 0.5
--
buttonXalign :: ButtonClass self => Attr self Float
buttonXalign :: forall self. ButtonClass self => Attr self Float
buttonXalign = String -> Attr self Float
forall gobj. GObjectClass gobj => String -> Attr gobj Float
newAttrFromFloatProperty String
"xalign"

-- | If the child of the button is a 'Misc' or 'Alignment', this property can
-- be used to control it's vertical alignment. 0.0 is top aligned, 1.0 is
-- bottom aligned.
--
-- Allowed values: [0,1]
--
-- Default value: 0.5
--
buttonYalign :: ButtonClass self => Attr self Float
buttonYalign :: forall self. ButtonClass self => Attr self Float
buttonYalign = String -> Attr self Float
forall gobj. GObjectClass gobj => String -> Attr gobj Float
newAttrFromFloatProperty String
"yalign"



-- | Child widget to appear next to the button text.
--
-- * Available since Gtk version 2.6
--
buttonImage :: (ButtonClass self, WidgetClass image) => ReadWriteAttr self (Maybe Widget) image
buttonImage :: forall self image.
(ButtonClass self, WidgetClass image) =>
ReadWriteAttr self (Maybe Widget) image
buttonImage = (self -> IO (Maybe Widget))
-> (self -> image -> IO ())
-> ReadWriteAttr self (Maybe Widget) image
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO (Maybe Widget)
forall self. ButtonClass self => self -> IO (Maybe Widget)
buttonGetImage
  self -> image -> IO ()
forall self image.
(ButtonClass self, WidgetClass image) =>
self -> image -> IO ()
buttonSetImage



-- %hash c:20f4 d:8ca6
-- | The position of the image relative to the text inside the button.
--
-- Default value: 'PosLeft'
--
-- * Available since Gtk+ version 2.10
--
buttonImagePosition :: ButtonClass self => Attr self PositionType
buttonImagePosition :: forall self. ButtonClass self => Attr self PositionType
buttonImagePosition = String -> GType -> Attr self PositionType
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
String -> GType -> Attr gobj enum
newAttrFromEnumProperty String
"image-position"
                        GType
gtk_position_type_get_type
{-# LINE 582 "./Graphics/UI/Gtk/Buttons/Button.chs" #-}


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

-- %hash c:b660 d:ab72
-- | Emitted when the button has been activated (pressed and released).
--
buttonActivated :: ButtonClass self => Signal self (IO ())
buttonActivated :: forall self. ButtonClass self => Signal self (IO ())
buttonActivated = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"clicked")


--------------------
-- Deprecated Signals


-- | The button has been depressed (but not
-- necessarily released yet). See @clicked@ signal.
--
onButtonActivate, afterButtonActivate :: ButtonClass b => b -> IO () ->
                                         IO (ConnectId b)
onButtonActivate :: forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
onButtonActivate = String -> Bool -> b -> IO () -> IO (ConnectId b)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"activate" Bool
False
afterButtonActivate :: forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
afterButtonActivate = String -> Bool -> b -> IO () -> IO (ConnectId b)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"activate" Bool
True

-- | The button was clicked. This is only emitted if
-- the mouse cursor was over the button when it was released.
--
onClicked, afterClicked :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onClicked :: forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
onClicked = String -> Bool -> b -> IO () -> IO (ConnectId b)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"clicked" Bool
False
afterClicked :: forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
afterClicked = String -> Bool -> b -> IO () -> IO (ConnectId b)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"clicked" Bool
True

-- | The cursor enters the button box.
--
onEnter, afterEnter :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onEnter :: forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
onEnter = String -> Bool -> b -> IO () -> IO (ConnectId b)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"enter" Bool
False
afterEnter :: forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
afterEnter = String -> Bool -> b -> IO () -> IO (ConnectId b)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"enter" Bool
True

-- | The cursor leaves the button box.
--
onLeave, afterLeave :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onLeave :: forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
onLeave = String -> Bool -> b -> IO () -> IO (ConnectId b)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"leave" Bool
False
afterLeave :: forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
afterLeave = String -> Bool -> b -> IO () -> IO (ConnectId b)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"leave" Bool
True

-- | The button is pressed.
--
onPressed, afterPressed :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onPressed :: forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
onPressed = String -> Bool -> b -> IO () -> IO (ConnectId b)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"pressed" Bool
False
afterPressed :: forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
afterPressed = String -> Bool -> b -> IO () -> IO (ConnectId b)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"pressed" Bool
True

-- | The button is released.
--
onReleased, afterReleased :: ButtonClass b => b -> IO () -> IO (ConnectId b)
onReleased :: forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
onReleased = String -> Bool -> b -> IO () -> IO (ConnectId b)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"released" Bool
False
afterReleased :: forall b. ButtonClass b => b -> IO () -> IO (ConnectId b)
afterReleased = String -> Bool -> b -> IO () -> IO (ConnectId b)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"released" Bool
True

foreign import ccall unsafe "gtk_button_new"
  gtk_button_new :: (IO (Ptr Widget))

foreign import ccall unsafe "gtk_button_new_with_label"
  gtk_button_new_with_label :: ((Ptr CChar) -> (IO (Ptr Widget)))

foreign import ccall unsafe "gtk_button_new_with_mnemonic"
  gtk_button_new_with_mnemonic :: ((Ptr CChar) -> (IO (Ptr Widget)))

foreign import ccall unsafe "gtk_button_new_from_stock"
  gtk_button_new_from_stock :: ((Ptr CChar) -> (IO (Ptr Widget)))

foreign import ccall safe "gtk_button_pressed"
  gtk_button_pressed :: ((Ptr Button) -> (IO ()))

foreign import ccall safe "gtk_button_released"
  gtk_button_released :: ((Ptr Button) -> (IO ()))

foreign import ccall safe "gtk_button_clicked"
  gtk_button_clicked :: ((Ptr Button) -> (IO ()))

foreign import ccall safe "gtk_button_enter"
  gtk_button_enter :: ((Ptr Button) -> (IO ()))

foreign import ccall safe "gtk_button_leave"
  gtk_button_leave :: ((Ptr Button) -> (IO ()))

foreign import ccall safe "gtk_button_set_relief"
  gtk_button_set_relief :: ((Ptr Button) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_button_get_relief"
  gtk_button_get_relief :: ((Ptr Button) -> (IO CInt))

foreign import ccall safe "gtk_button_set_label"
  gtk_button_set_label :: ((Ptr Button) -> ((Ptr CChar) -> (IO ())))

foreign import ccall unsafe "gtk_button_get_label"
  gtk_button_get_label :: ((Ptr Button) -> (IO (Ptr CChar)))

foreign import ccall safe "gtk_button_set_use_stock"
  gtk_button_set_use_stock :: ((Ptr Button) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_button_get_use_stock"
  gtk_button_get_use_stock :: ((Ptr Button) -> (IO CInt))

foreign import ccall safe "gtk_button_set_use_underline"
  gtk_button_set_use_underline :: ((Ptr Button) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_button_get_use_underline"
  gtk_button_get_use_underline :: ((Ptr Button) -> (IO CInt))

foreign import ccall unsafe "gtk_button_set_focus_on_click"
  gtk_button_set_focus_on_click :: ((Ptr Button) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_button_get_focus_on_click"
  gtk_button_get_focus_on_click :: ((Ptr Button) -> (IO CInt))

foreign import ccall unsafe "gtk_button_set_alignment"
  gtk_button_set_alignment :: ((Ptr Button) -> (CFloat -> (CFloat -> (IO ()))))

foreign import ccall unsafe "gtk_button_get_alignment"
  gtk_button_get_alignment :: ((Ptr Button) -> ((Ptr CFloat) -> ((Ptr CFloat) -> (IO ()))))

foreign import ccall safe "gtk_button_get_image"
  gtk_button_get_image :: ((Ptr Button) -> (IO (Ptr Widget)))

foreign import ccall safe "gtk_button_set_image"
  gtk_button_set_image :: ((Ptr Button) -> ((Ptr Widget) -> (IO ())))

foreign import ccall safe "gtk_button_set_image_position"
  gtk_button_set_image_position :: ((Ptr Button) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_button_get_image_position"
  gtk_button_get_image_position :: ((Ptr Button) -> (IO CInt))

foreign import ccall safe "gtk_button_get_event_window"
  gtk_button_get_event_window :: ((Ptr Button) -> (IO (Ptr DrawWindow)))

foreign import ccall unsafe "gtk_position_type_get_type"
  gtk_position_type_get_type :: CULong