{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Gtk.Objects.ScaleButton
    ( 

-- * Exported types
    ScaleButton(..)                         ,
    ScaleButtonK                            ,
    toScaleButton                           ,
    noScaleButton                           ,


 -- * Methods
-- ** scaleButtonGetAdjustment
    scaleButtonGetAdjustment                ,


-- ** scaleButtonGetMinusButton
    scaleButtonGetMinusButton               ,


-- ** scaleButtonGetPlusButton
    scaleButtonGetPlusButton                ,


-- ** scaleButtonGetPopup
    scaleButtonGetPopup                     ,


-- ** scaleButtonGetValue
    scaleButtonGetValue                     ,


-- ** scaleButtonNew
    scaleButtonNew                          ,


-- ** scaleButtonSetAdjustment
    scaleButtonSetAdjustment                ,


-- ** scaleButtonSetIcons
    scaleButtonSetIcons                     ,


-- ** scaleButtonSetValue
    scaleButtonSetValue                     ,




 -- * Properties
-- ** Adjustment
    ScaleButtonAdjustmentPropertyInfo       ,
    constructScaleButtonAdjustment          ,
    getScaleButtonAdjustment                ,
    setScaleButtonAdjustment                ,


-- ** Icons
    ScaleButtonIconsPropertyInfo            ,
    constructScaleButtonIcons               ,
    getScaleButtonIcons                     ,
    setScaleButtonIcons                     ,


-- ** Size
    ScaleButtonSizePropertyInfo             ,
    constructScaleButtonSize                ,
    getScaleButtonSize                      ,
    setScaleButtonSize                      ,


-- ** Value
    ScaleButtonValuePropertyInfo            ,
    constructScaleButtonValue               ,
    getScaleButtonValue                     ,
    setScaleButtonValue                     ,




 -- * Signals
-- ** Popdown
    ScaleButtonPopdownCallback              ,
    ScaleButtonPopdownCallbackC             ,
    ScaleButtonPopdownSignalInfo            ,
    afterScaleButtonPopdown                 ,
    mkScaleButtonPopdownCallback            ,
    noScaleButtonPopdownCallback            ,
    onScaleButtonPopdown                    ,
    scaleButtonPopdownCallbackWrapper       ,
    scaleButtonPopdownClosure               ,


-- ** Popup
    ScaleButtonPopupCallback                ,
    ScaleButtonPopupCallbackC               ,
    ScaleButtonPopupSignalInfo              ,
    afterScaleButtonPopup                   ,
    mkScaleButtonPopupCallback              ,
    noScaleButtonPopupCallback              ,
    onScaleButtonPopup                      ,
    scaleButtonPopupCallbackWrapper         ,
    scaleButtonPopupClosure                 ,


-- ** ValueChanged
    ScaleButtonValueChangedCallback         ,
    ScaleButtonValueChangedCallbackC        ,
    ScaleButtonValueChangedSignalInfo       ,
    afterScaleButtonValueChanged            ,
    mkScaleButtonValueChangedCallback       ,
    noScaleButtonValueChangedCallback       ,
    onScaleButtonValueChanged               ,
    scaleButtonValueChangedCallbackWrapper  ,
    scaleButtonValueChangedClosure          ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gtk.Types
import GI.Gtk.Callbacks
import qualified GI.Atk as Atk
import qualified GI.GObject as GObject

newtype ScaleButton = ScaleButton (ForeignPtr ScaleButton)
foreign import ccall "gtk_scale_button_get_type"
    c_gtk_scale_button_get_type :: IO GType

type instance ParentTypes ScaleButton = ScaleButtonParentTypes
type ScaleButtonParentTypes = '[Button, Bin, Container, Widget, GObject.Object, Atk.ImplementorIface, Actionable, Activatable, Buildable, Orientable]

instance GObject ScaleButton where
    gobjectIsInitiallyUnowned _ = True
    gobjectType _ = c_gtk_scale_button_get_type
    

class GObject o => ScaleButtonK o
instance (GObject o, IsDescendantOf ScaleButton o) => ScaleButtonK o

toScaleButton :: ScaleButtonK o => o -> IO ScaleButton
toScaleButton = unsafeCastTo ScaleButton

noScaleButton :: Maybe ScaleButton
noScaleButton = Nothing

-- signal ScaleButton::popdown
type ScaleButtonPopdownCallback =
    IO ()

noScaleButtonPopdownCallback :: Maybe ScaleButtonPopdownCallback
noScaleButtonPopdownCallback = Nothing

type ScaleButtonPopdownCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkScaleButtonPopdownCallback :: ScaleButtonPopdownCallbackC -> IO (FunPtr ScaleButtonPopdownCallbackC)

scaleButtonPopdownClosure :: ScaleButtonPopdownCallback -> IO Closure
scaleButtonPopdownClosure cb = newCClosure =<< mkScaleButtonPopdownCallback wrapped
    where wrapped = scaleButtonPopdownCallbackWrapper cb

scaleButtonPopdownCallbackWrapper ::
    ScaleButtonPopdownCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
scaleButtonPopdownCallbackWrapper _cb _ _ = do
    _cb 

onScaleButtonPopdown :: (GObject a, MonadIO m) => a -> ScaleButtonPopdownCallback -> m SignalHandlerId
onScaleButtonPopdown obj cb = liftIO $ connectScaleButtonPopdown obj cb SignalConnectBefore
afterScaleButtonPopdown :: (GObject a, MonadIO m) => a -> ScaleButtonPopdownCallback -> m SignalHandlerId
afterScaleButtonPopdown obj cb = connectScaleButtonPopdown obj cb SignalConnectAfter

connectScaleButtonPopdown :: (GObject a, MonadIO m) =>
                             a -> ScaleButtonPopdownCallback -> SignalConnectMode -> m SignalHandlerId
connectScaleButtonPopdown obj cb after = liftIO $ do
    cb' <- mkScaleButtonPopdownCallback (scaleButtonPopdownCallbackWrapper cb)
    connectSignalFunPtr obj "popdown" cb' after

-- signal ScaleButton::popup
type ScaleButtonPopupCallback =
    IO ()

noScaleButtonPopupCallback :: Maybe ScaleButtonPopupCallback
noScaleButtonPopupCallback = Nothing

type ScaleButtonPopupCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkScaleButtonPopupCallback :: ScaleButtonPopupCallbackC -> IO (FunPtr ScaleButtonPopupCallbackC)

scaleButtonPopupClosure :: ScaleButtonPopupCallback -> IO Closure
scaleButtonPopupClosure cb = newCClosure =<< mkScaleButtonPopupCallback wrapped
    where wrapped = scaleButtonPopupCallbackWrapper cb

scaleButtonPopupCallbackWrapper ::
    ScaleButtonPopupCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
scaleButtonPopupCallbackWrapper _cb _ _ = do
    _cb 

onScaleButtonPopup :: (GObject a, MonadIO m) => a -> ScaleButtonPopupCallback -> m SignalHandlerId
onScaleButtonPopup obj cb = liftIO $ connectScaleButtonPopup obj cb SignalConnectBefore
afterScaleButtonPopup :: (GObject a, MonadIO m) => a -> ScaleButtonPopupCallback -> m SignalHandlerId
afterScaleButtonPopup obj cb = connectScaleButtonPopup obj cb SignalConnectAfter

connectScaleButtonPopup :: (GObject a, MonadIO m) =>
                           a -> ScaleButtonPopupCallback -> SignalConnectMode -> m SignalHandlerId
connectScaleButtonPopup obj cb after = liftIO $ do
    cb' <- mkScaleButtonPopupCallback (scaleButtonPopupCallbackWrapper cb)
    connectSignalFunPtr obj "popup" cb' after

-- signal ScaleButton::value-changed
type ScaleButtonValueChangedCallback =
    Double ->
    IO ()

noScaleButtonValueChangedCallback :: Maybe ScaleButtonValueChangedCallback
noScaleButtonValueChangedCallback = Nothing

type ScaleButtonValueChangedCallbackC =
    Ptr () ->                               -- object
    CDouble ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkScaleButtonValueChangedCallback :: ScaleButtonValueChangedCallbackC -> IO (FunPtr ScaleButtonValueChangedCallbackC)

scaleButtonValueChangedClosure :: ScaleButtonValueChangedCallback -> IO Closure
scaleButtonValueChangedClosure cb = newCClosure =<< mkScaleButtonValueChangedCallback wrapped
    where wrapped = scaleButtonValueChangedCallbackWrapper cb

scaleButtonValueChangedCallbackWrapper ::
    ScaleButtonValueChangedCallback ->
    Ptr () ->
    CDouble ->
    Ptr () ->
    IO ()
scaleButtonValueChangedCallbackWrapper _cb _ value _ = do
    let value' = realToFrac value
    _cb  value'

onScaleButtonValueChanged :: (GObject a, MonadIO m) => a -> ScaleButtonValueChangedCallback -> m SignalHandlerId
onScaleButtonValueChanged obj cb = liftIO $ connectScaleButtonValueChanged obj cb SignalConnectBefore
afterScaleButtonValueChanged :: (GObject a, MonadIO m) => a -> ScaleButtonValueChangedCallback -> m SignalHandlerId
afterScaleButtonValueChanged obj cb = connectScaleButtonValueChanged obj cb SignalConnectAfter

connectScaleButtonValueChanged :: (GObject a, MonadIO m) =>
                                  a -> ScaleButtonValueChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectScaleButtonValueChanged obj cb after = liftIO $ do
    cb' <- mkScaleButtonValueChangedCallback (scaleButtonValueChangedCallbackWrapper cb)
    connectSignalFunPtr obj "value-changed" cb' after

-- VVV Prop "adjustment"
   -- Type: TInterface "Gtk" "Adjustment"
   -- Flags: [PropertyReadable,PropertyWritable]

getScaleButtonAdjustment :: (MonadIO m, ScaleButtonK o) => o -> m Adjustment
getScaleButtonAdjustment obj = liftIO $ getObjectPropertyObject obj "adjustment" Adjustment

setScaleButtonAdjustment :: (MonadIO m, ScaleButtonK o, AdjustmentK a) => o -> a -> m ()
setScaleButtonAdjustment obj val = liftIO $ setObjectPropertyObject obj "adjustment" val

constructScaleButtonAdjustment :: (AdjustmentK a) => a -> IO ([Char], GValue)
constructScaleButtonAdjustment val = constructObjectPropertyObject "adjustment" val

data ScaleButtonAdjustmentPropertyInfo
instance AttrInfo ScaleButtonAdjustmentPropertyInfo where
    type AttrAllowedOps ScaleButtonAdjustmentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ScaleButtonAdjustmentPropertyInfo = AdjustmentK
    type AttrBaseTypeConstraint ScaleButtonAdjustmentPropertyInfo = ScaleButtonK
    type AttrGetType ScaleButtonAdjustmentPropertyInfo = Adjustment
    type AttrLabel ScaleButtonAdjustmentPropertyInfo = "ScaleButton::adjustment"
    attrGet _ = getScaleButtonAdjustment
    attrSet _ = setScaleButtonAdjustment
    attrConstruct _ = constructScaleButtonAdjustment

-- VVV Prop "icons"
   -- Type: TCArray True (-1) (-1) (TBasicType TUTF8)
   -- Flags: [PropertyReadable,PropertyWritable]

getScaleButtonIcons :: (MonadIO m, ScaleButtonK o) => o -> m [T.Text]
getScaleButtonIcons obj = liftIO $ getObjectPropertyStringArray obj "icons"

setScaleButtonIcons :: (MonadIO m, ScaleButtonK o) => o -> [T.Text] -> m ()
setScaleButtonIcons obj val = liftIO $ setObjectPropertyStringArray obj "icons" val

constructScaleButtonIcons :: [T.Text] -> IO ([Char], GValue)
constructScaleButtonIcons val = constructObjectPropertyStringArray "icons" val

data ScaleButtonIconsPropertyInfo
instance AttrInfo ScaleButtonIconsPropertyInfo where
    type AttrAllowedOps ScaleButtonIconsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ScaleButtonIconsPropertyInfo = (~) [T.Text]
    type AttrBaseTypeConstraint ScaleButtonIconsPropertyInfo = ScaleButtonK
    type AttrGetType ScaleButtonIconsPropertyInfo = [T.Text]
    type AttrLabel ScaleButtonIconsPropertyInfo = "ScaleButton::icons"
    attrGet _ = getScaleButtonIcons
    attrSet _ = setScaleButtonIcons
    attrConstruct _ = constructScaleButtonIcons

-- VVV Prop "size"
   -- Type: TInterface "Gtk" "IconSize"
   -- Flags: [PropertyReadable,PropertyWritable]

getScaleButtonSize :: (MonadIO m, ScaleButtonK o) => o -> m IconSize
getScaleButtonSize obj = liftIO $ getObjectPropertyEnum obj "size"

setScaleButtonSize :: (MonadIO m, ScaleButtonK o) => o -> IconSize -> m ()
setScaleButtonSize obj val = liftIO $ setObjectPropertyEnum obj "size" val

constructScaleButtonSize :: IconSize -> IO ([Char], GValue)
constructScaleButtonSize val = constructObjectPropertyEnum "size" val

data ScaleButtonSizePropertyInfo
instance AttrInfo ScaleButtonSizePropertyInfo where
    type AttrAllowedOps ScaleButtonSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ScaleButtonSizePropertyInfo = (~) IconSize
    type AttrBaseTypeConstraint ScaleButtonSizePropertyInfo = ScaleButtonK
    type AttrGetType ScaleButtonSizePropertyInfo = IconSize
    type AttrLabel ScaleButtonSizePropertyInfo = "ScaleButton::size"
    attrGet _ = getScaleButtonSize
    attrSet _ = setScaleButtonSize
    attrConstruct _ = constructScaleButtonSize

-- VVV Prop "value"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]

getScaleButtonValue :: (MonadIO m, ScaleButtonK o) => o -> m Double
getScaleButtonValue obj = liftIO $ getObjectPropertyDouble obj "value"

setScaleButtonValue :: (MonadIO m, ScaleButtonK o) => o -> Double -> m ()
setScaleButtonValue obj val = liftIO $ setObjectPropertyDouble obj "value" val

constructScaleButtonValue :: Double -> IO ([Char], GValue)
constructScaleButtonValue val = constructObjectPropertyDouble "value" val

data ScaleButtonValuePropertyInfo
instance AttrInfo ScaleButtonValuePropertyInfo where
    type AttrAllowedOps ScaleButtonValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ScaleButtonValuePropertyInfo = (~) Double
    type AttrBaseTypeConstraint ScaleButtonValuePropertyInfo = ScaleButtonK
    type AttrGetType ScaleButtonValuePropertyInfo = Double
    type AttrLabel ScaleButtonValuePropertyInfo = "ScaleButton::value"
    attrGet _ = getScaleButtonValue
    attrSet _ = setScaleButtonValue
    attrConstruct _ = constructScaleButtonValue

type instance AttributeList ScaleButton = ScaleButtonAttributeList
type ScaleButtonAttributeList = ('[ '("action-name", ActionableActionNamePropertyInfo), '("action-target", ActionableActionTargetPropertyInfo), '("adjustment", ScaleButtonAdjustmentPropertyInfo), '("always-show-image", ButtonAlwaysShowImagePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("border-width", ContainerBorderWidthPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("child", ContainerChildPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("focus-on-click", ButtonFocusOnClickPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("icons", ScaleButtonIconsPropertyInfo), '("image", ButtonImagePropertyInfo), '("image-position", ButtonImagePositionPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("label", ButtonLabelPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("orientation", OrientableOrientationPropertyInfo), '("parent", WidgetParentPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("related-action", ActivatableRelatedActionPropertyInfo), '("relief", ButtonReliefPropertyInfo), '("resize-mode", ContainerResizeModePropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("size", ScaleButtonSizePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("use-action-appearance", ActivatableUseActionAppearancePropertyInfo), '("use-stock", ButtonUseStockPropertyInfo), '("use-underline", ButtonUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("value", ScaleButtonValuePropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("xalign", ButtonXalignPropertyInfo), '("yalign", ButtonYalignPropertyInfo)] :: [(Symbol, *)])

data ScaleButtonPopdownSignalInfo
instance SignalInfo ScaleButtonPopdownSignalInfo where
    type HaskellCallbackType ScaleButtonPopdownSignalInfo = ScaleButtonPopdownCallback
    connectSignal _ = connectScaleButtonPopdown

data ScaleButtonPopupSignalInfo
instance SignalInfo ScaleButtonPopupSignalInfo where
    type HaskellCallbackType ScaleButtonPopupSignalInfo = ScaleButtonPopupCallback
    connectSignal _ = connectScaleButtonPopup

data ScaleButtonValueChangedSignalInfo
instance SignalInfo ScaleButtonValueChangedSignalInfo where
    type HaskellCallbackType ScaleButtonValueChangedSignalInfo = ScaleButtonValueChangedCallback
    connectSignal _ = connectScaleButtonValueChanged

type instance SignalList ScaleButton = ScaleButtonSignalList
type ScaleButtonSignalList = ('[ '("accel-closures-changed", WidgetAccelClosuresChangedSignalInfo), '("activate", ButtonActivateSignalInfo), '("add", ContainerAddSignalInfo), '("button-press-event", WidgetButtonPressEventSignalInfo), '("button-release-event", WidgetButtonReleaseEventSignalInfo), '("can-activate-accel", WidgetCanActivateAccelSignalInfo), '("check-resize", ContainerCheckResizeSignalInfo), '("child-notify", WidgetChildNotifySignalInfo), '("clicked", ButtonClickedSignalInfo), '("composited-changed", WidgetCompositedChangedSignalInfo), '("configure-event", WidgetConfigureEventSignalInfo), '("damage-event", WidgetDamageEventSignalInfo), '("delete-event", WidgetDeleteEventSignalInfo), '("destroy", WidgetDestroySignalInfo), '("destroy-event", WidgetDestroyEventSignalInfo), '("direction-changed", WidgetDirectionChangedSignalInfo), '("drag-begin", WidgetDragBeginSignalInfo), '("drag-data-delete", WidgetDragDataDeleteSignalInfo), '("drag-data-get", WidgetDragDataGetSignalInfo), '("drag-data-received", WidgetDragDataReceivedSignalInfo), '("drag-drop", WidgetDragDropSignalInfo), '("drag-end", WidgetDragEndSignalInfo), '("drag-failed", WidgetDragFailedSignalInfo), '("drag-leave", WidgetDragLeaveSignalInfo), '("drag-motion", WidgetDragMotionSignalInfo), '("draw", WidgetDrawSignalInfo), '("enter", ButtonEnterSignalInfo), '("enter-notify-event", WidgetEnterNotifyEventSignalInfo), '("event", WidgetEventSignalInfo), '("event-after", WidgetEventAfterSignalInfo), '("focus", WidgetFocusSignalInfo), '("focus-in-event", WidgetFocusInEventSignalInfo), '("focus-out-event", WidgetFocusOutEventSignalInfo), '("grab-broken-event", WidgetGrabBrokenEventSignalInfo), '("grab-focus", WidgetGrabFocusSignalInfo), '("grab-notify", WidgetGrabNotifySignalInfo), '("hide", WidgetHideSignalInfo), '("hierarchy-changed", WidgetHierarchyChangedSignalInfo), '("key-press-event", WidgetKeyPressEventSignalInfo), '("key-release-event", WidgetKeyReleaseEventSignalInfo), '("keynav-failed", WidgetKeynavFailedSignalInfo), '("leave", ButtonLeaveSignalInfo), '("leave-notify-event", WidgetLeaveNotifyEventSignalInfo), '("map", WidgetMapSignalInfo), '("map-event", WidgetMapEventSignalInfo), '("mnemonic-activate", WidgetMnemonicActivateSignalInfo), '("motion-notify-event", WidgetMotionNotifyEventSignalInfo), '("move-focus", WidgetMoveFocusSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("parent-set", WidgetParentSetSignalInfo), '("popdown", ScaleButtonPopdownSignalInfo), '("popup", ScaleButtonPopupSignalInfo), '("popup-menu", WidgetPopupMenuSignalInfo), '("pressed", ButtonPressedSignalInfo), '("property-notify-event", WidgetPropertyNotifyEventSignalInfo), '("proximity-in-event", WidgetProximityInEventSignalInfo), '("proximity-out-event", WidgetProximityOutEventSignalInfo), '("query-tooltip", WidgetQueryTooltipSignalInfo), '("realize", WidgetRealizeSignalInfo), '("released", ButtonReleasedSignalInfo), '("remove", ContainerRemoveSignalInfo), '("screen-changed", WidgetScreenChangedSignalInfo), '("scroll-event", WidgetScrollEventSignalInfo), '("selection-clear-event", WidgetSelectionClearEventSignalInfo), '("selection-get", WidgetSelectionGetSignalInfo), '("selection-notify-event", WidgetSelectionNotifyEventSignalInfo), '("selection-received", WidgetSelectionReceivedSignalInfo), '("selection-request-event", WidgetSelectionRequestEventSignalInfo), '("set-focus-child", ContainerSetFocusChildSignalInfo), '("show", WidgetShowSignalInfo), '("show-help", WidgetShowHelpSignalInfo), '("size-allocate", WidgetSizeAllocateSignalInfo), '("state-changed", WidgetStateChangedSignalInfo), '("state-flags-changed", WidgetStateFlagsChangedSignalInfo), '("style-set", WidgetStyleSetSignalInfo), '("style-updated", WidgetStyleUpdatedSignalInfo), '("touch-event", WidgetTouchEventSignalInfo), '("unmap", WidgetUnmapSignalInfo), '("unmap-event", WidgetUnmapEventSignalInfo), '("unrealize", WidgetUnrealizeSignalInfo), '("value-changed", ScaleButtonValueChangedSignalInfo), '("visibility-notify-event", WidgetVisibilityNotifyEventSignalInfo), '("window-state-event", WidgetWindowStateEventSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method ScaleButton::new
-- method type : Constructor
-- Args : [Arg {argName = "size", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "min", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "step", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "icons", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "size", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "min", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "max", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "step", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "icons", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "ScaleButton"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_button_new" gtk_scale_button_new :: 
    Int32 ->                                -- size : TBasicType TInt32
    CDouble ->                              -- min : TBasicType TDouble
    CDouble ->                              -- max : TBasicType TDouble
    CDouble ->                              -- step : TBasicType TDouble
    Ptr CString ->                          -- icons : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO (Ptr ScaleButton)


scaleButtonNew ::
    (MonadIO m) =>
    Int32 ->                                -- size
    Double ->                               -- min
    Double ->                               -- max
    Double ->                               -- step
    Maybe ([T.Text]) ->                     -- icons
    m ScaleButton
scaleButtonNew size min max step icons = liftIO $ do
    let min' = realToFrac min
    let max' = realToFrac max
    let step' = realToFrac step
    maybeIcons <- case icons of
        Nothing -> return nullPtr
        Just jIcons -> do
            jIcons' <- packZeroTerminatedUTF8CArray jIcons
            return jIcons'
    result <- gtk_scale_button_new size min' max' step' maybeIcons
    checkUnexpectedReturnNULL "gtk_scale_button_new" result
    result' <- (newObject ScaleButton) result
    mapZeroTerminatedCArray freeMem maybeIcons
    freeMem maybeIcons
    return result'

-- method ScaleButton::get_adjustment
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Adjustment"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_button_get_adjustment" gtk_scale_button_get_adjustment :: 
    Ptr ScaleButton ->                      -- _obj : TInterface "Gtk" "ScaleButton"
    IO (Ptr Adjustment)


scaleButtonGetAdjustment ::
    (MonadIO m, ScaleButtonK a) =>
    a ->                                    -- _obj
    m Adjustment
scaleButtonGetAdjustment _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_scale_button_get_adjustment _obj'
    checkUnexpectedReturnNULL "gtk_scale_button_get_adjustment" result
    result' <- (newObject Adjustment) result
    touchManagedPtr _obj
    return result'

-- method ScaleButton::get_minus_button
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Widget"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_button_get_minus_button" gtk_scale_button_get_minus_button :: 
    Ptr ScaleButton ->                      -- _obj : TInterface "Gtk" "ScaleButton"
    IO (Ptr Widget)


scaleButtonGetMinusButton ::
    (MonadIO m, ScaleButtonK a) =>
    a ->                                    -- _obj
    m Widget
scaleButtonGetMinusButton _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_scale_button_get_minus_button _obj'
    checkUnexpectedReturnNULL "gtk_scale_button_get_minus_button" result
    result' <- (newObject Widget) result
    touchManagedPtr _obj
    return result'

-- method ScaleButton::get_plus_button
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Widget"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_button_get_plus_button" gtk_scale_button_get_plus_button :: 
    Ptr ScaleButton ->                      -- _obj : TInterface "Gtk" "ScaleButton"
    IO (Ptr Widget)


scaleButtonGetPlusButton ::
    (MonadIO m, ScaleButtonK a) =>
    a ->                                    -- _obj
    m Widget
scaleButtonGetPlusButton _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_scale_button_get_plus_button _obj'
    checkUnexpectedReturnNULL "gtk_scale_button_get_plus_button" result
    result' <- (newObject Widget) result
    touchManagedPtr _obj
    return result'

-- method ScaleButton::get_popup
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Widget"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_button_get_popup" gtk_scale_button_get_popup :: 
    Ptr ScaleButton ->                      -- _obj : TInterface "Gtk" "ScaleButton"
    IO (Ptr Widget)


scaleButtonGetPopup ::
    (MonadIO m, ScaleButtonK a) =>
    a ->                                    -- _obj
    m Widget
scaleButtonGetPopup _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_scale_button_get_popup _obj'
    checkUnexpectedReturnNULL "gtk_scale_button_get_popup" result
    result' <- (newObject Widget) result
    touchManagedPtr _obj
    return result'

-- method ScaleButton::get_value
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TDouble
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_button_get_value" gtk_scale_button_get_value :: 
    Ptr ScaleButton ->                      -- _obj : TInterface "Gtk" "ScaleButton"
    IO CDouble


scaleButtonGetValue ::
    (MonadIO m, ScaleButtonK a) =>
    a ->                                    -- _obj
    m Double
scaleButtonGetValue _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_scale_button_get_value _obj'
    let result' = realToFrac result
    touchManagedPtr _obj
    return result'

-- method ScaleButton::set_adjustment
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "adjustment", argType = TInterface "Gtk" "Adjustment", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "adjustment", argType = TInterface "Gtk" "Adjustment", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_button_set_adjustment" gtk_scale_button_set_adjustment :: 
    Ptr ScaleButton ->                      -- _obj : TInterface "Gtk" "ScaleButton"
    Ptr Adjustment ->                       -- adjustment : TInterface "Gtk" "Adjustment"
    IO ()


scaleButtonSetAdjustment ::
    (MonadIO m, ScaleButtonK a, AdjustmentK b) =>
    a ->                                    -- _obj
    b ->                                    -- adjustment
    m ()
scaleButtonSetAdjustment _obj adjustment = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let adjustment' = unsafeManagedPtrCastPtr adjustment
    gtk_scale_button_set_adjustment _obj' adjustment'
    touchManagedPtr _obj
    touchManagedPtr adjustment
    return ()

-- method ScaleButton::set_icons
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "icons", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "icons", argType = TCArray True (-1) (-1) (TBasicType TUTF8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_button_set_icons" gtk_scale_button_set_icons :: 
    Ptr ScaleButton ->                      -- _obj : TInterface "Gtk" "ScaleButton"
    Ptr CString ->                          -- icons : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO ()


scaleButtonSetIcons ::
    (MonadIO m, ScaleButtonK a) =>
    a ->                                    -- _obj
    [T.Text] ->                             -- icons
    m ()
scaleButtonSetIcons _obj icons = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    icons' <- packZeroTerminatedUTF8CArray icons
    gtk_scale_button_set_icons _obj' icons'
    touchManagedPtr _obj
    mapZeroTerminatedCArray freeMem icons'
    freeMem icons'
    return ()

-- method ScaleButton::set_value
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "ScaleButton", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "value", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_scale_button_set_value" gtk_scale_button_set_value :: 
    Ptr ScaleButton ->                      -- _obj : TInterface "Gtk" "ScaleButton"
    CDouble ->                              -- value : TBasicType TDouble
    IO ()


scaleButtonSetValue ::
    (MonadIO m, ScaleButtonK a) =>
    a ->                                    -- _obj
    Double ->                               -- value
    m ()
scaleButtonSetValue _obj value = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let value' = realToFrac value
    gtk_scale_button_set_value _obj' value'
    touchManagedPtr _obj
    return ()