{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gtk.Objects.Range.Range' is the common base class for widgets which visualize an
-- adjustment, e.g t'GI.Gtk.Objects.Scale.Scale' or t'GI.Gtk.Objects.Scrollbar.Scrollbar'.
-- 
-- Apart from signals for monitoring the parameters of the adjustment,
-- t'GI.Gtk.Objects.Range.Range' provides properties and methods for setting a
-- “fill level” on range widgets. See 'GI.Gtk.Objects.Range.rangeSetFillLevel'.

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Gtk.Objects.Range
    ( 

-- * Exported types
    Range(..)                               ,
    IsRange                                 ,
    toRange                                 ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveRangeMethod                      ,
#endif


-- ** getAdjustment #method:getAdjustment#

#if defined(ENABLE_OVERLOADING)
    RangeGetAdjustmentMethodInfo            ,
#endif
    rangeGetAdjustment                      ,


-- ** getFillLevel #method:getFillLevel#

#if defined(ENABLE_OVERLOADING)
    RangeGetFillLevelMethodInfo             ,
#endif
    rangeGetFillLevel                       ,


-- ** getFlippable #method:getFlippable#

#if defined(ENABLE_OVERLOADING)
    RangeGetFlippableMethodInfo             ,
#endif
    rangeGetFlippable                       ,


-- ** getInverted #method:getInverted#

#if defined(ENABLE_OVERLOADING)
    RangeGetInvertedMethodInfo              ,
#endif
    rangeGetInverted                        ,


-- ** getRangeRect #method:getRangeRect#

#if defined(ENABLE_OVERLOADING)
    RangeGetRangeRectMethodInfo             ,
#endif
    rangeGetRangeRect                       ,


-- ** getRestrictToFillLevel #method:getRestrictToFillLevel#

#if defined(ENABLE_OVERLOADING)
    RangeGetRestrictToFillLevelMethodInfo   ,
#endif
    rangeGetRestrictToFillLevel             ,


-- ** getRoundDigits #method:getRoundDigits#

#if defined(ENABLE_OVERLOADING)
    RangeGetRoundDigitsMethodInfo           ,
#endif
    rangeGetRoundDigits                     ,


-- ** getShowFillLevel #method:getShowFillLevel#

#if defined(ENABLE_OVERLOADING)
    RangeGetShowFillLevelMethodInfo         ,
#endif
    rangeGetShowFillLevel                   ,


-- ** getSliderRange #method:getSliderRange#

#if defined(ENABLE_OVERLOADING)
    RangeGetSliderRangeMethodInfo           ,
#endif
    rangeGetSliderRange                     ,


-- ** getSliderSizeFixed #method:getSliderSizeFixed#

#if defined(ENABLE_OVERLOADING)
    RangeGetSliderSizeFixedMethodInfo       ,
#endif
    rangeGetSliderSizeFixed                 ,


-- ** getValue #method:getValue#

#if defined(ENABLE_OVERLOADING)
    RangeGetValueMethodInfo                 ,
#endif
    rangeGetValue                           ,


-- ** setAdjustment #method:setAdjustment#

#if defined(ENABLE_OVERLOADING)
    RangeSetAdjustmentMethodInfo            ,
#endif
    rangeSetAdjustment                      ,


-- ** setFillLevel #method:setFillLevel#

#if defined(ENABLE_OVERLOADING)
    RangeSetFillLevelMethodInfo             ,
#endif
    rangeSetFillLevel                       ,


-- ** setFlippable #method:setFlippable#

#if defined(ENABLE_OVERLOADING)
    RangeSetFlippableMethodInfo             ,
#endif
    rangeSetFlippable                       ,


-- ** setIncrements #method:setIncrements#

#if defined(ENABLE_OVERLOADING)
    RangeSetIncrementsMethodInfo            ,
#endif
    rangeSetIncrements                      ,


-- ** setInverted #method:setInverted#

#if defined(ENABLE_OVERLOADING)
    RangeSetInvertedMethodInfo              ,
#endif
    rangeSetInverted                        ,


-- ** setRange #method:setRange#

#if defined(ENABLE_OVERLOADING)
    RangeSetRangeMethodInfo                 ,
#endif
    rangeSetRange                           ,


-- ** setRestrictToFillLevel #method:setRestrictToFillLevel#

#if defined(ENABLE_OVERLOADING)
    RangeSetRestrictToFillLevelMethodInfo   ,
#endif
    rangeSetRestrictToFillLevel             ,


-- ** setRoundDigits #method:setRoundDigits#

#if defined(ENABLE_OVERLOADING)
    RangeSetRoundDigitsMethodInfo           ,
#endif
    rangeSetRoundDigits                     ,


-- ** setShowFillLevel #method:setShowFillLevel#

#if defined(ENABLE_OVERLOADING)
    RangeSetShowFillLevelMethodInfo         ,
#endif
    rangeSetShowFillLevel                   ,


-- ** setSliderSizeFixed #method:setSliderSizeFixed#

#if defined(ENABLE_OVERLOADING)
    RangeSetSliderSizeFixedMethodInfo       ,
#endif
    rangeSetSliderSizeFixed                 ,


-- ** setValue #method:setValue#

#if defined(ENABLE_OVERLOADING)
    RangeSetValueMethodInfo                 ,
#endif
    rangeSetValue                           ,




 -- * Properties
-- ** adjustment #attr:adjustment#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    RangeAdjustmentPropertyInfo             ,
#endif
    constructRangeAdjustment                ,
    getRangeAdjustment                      ,
#if defined(ENABLE_OVERLOADING)
    rangeAdjustment                         ,
#endif
    setRangeAdjustment                      ,


-- ** fillLevel #attr:fillLevel#
-- | The fill level (e.g. prebuffering of a network stream).
-- See 'GI.Gtk.Objects.Range.rangeSetFillLevel'.

#if defined(ENABLE_OVERLOADING)
    RangeFillLevelPropertyInfo              ,
#endif
    constructRangeFillLevel                 ,
    getRangeFillLevel                       ,
#if defined(ENABLE_OVERLOADING)
    rangeFillLevel                          ,
#endif
    setRangeFillLevel                       ,


-- ** inverted #attr:inverted#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    RangeInvertedPropertyInfo               ,
#endif
    constructRangeInverted                  ,
    getRangeInverted                        ,
#if defined(ENABLE_OVERLOADING)
    rangeInverted                           ,
#endif
    setRangeInverted                        ,


-- ** restrictToFillLevel #attr:restrictToFillLevel#
-- | The restrict-to-fill-level property controls whether slider
-- movement is restricted to an upper boundary set by the
-- fill level. See 'GI.Gtk.Objects.Range.rangeSetRestrictToFillLevel'.

#if defined(ENABLE_OVERLOADING)
    RangeRestrictToFillLevelPropertyInfo    ,
#endif
    constructRangeRestrictToFillLevel       ,
    getRangeRestrictToFillLevel             ,
#if defined(ENABLE_OVERLOADING)
    rangeRestrictToFillLevel                ,
#endif
    setRangeRestrictToFillLevel             ,


-- ** roundDigits #attr:roundDigits#
-- | The number of digits to round the value to when
-- it changes, or -1. See [changeValue]("GI.Gtk.Objects.Range#g:signal:changeValue").

#if defined(ENABLE_OVERLOADING)
    RangeRoundDigitsPropertyInfo            ,
#endif
    constructRangeRoundDigits               ,
    getRangeRoundDigits                     ,
#if defined(ENABLE_OVERLOADING)
    rangeRoundDigits                        ,
#endif
    setRangeRoundDigits                     ,


-- ** showFillLevel #attr:showFillLevel#
-- | The show-fill-level property controls whether fill level indicator
-- graphics are displayed on the trough. See
-- 'GI.Gtk.Objects.Range.rangeSetShowFillLevel'.

#if defined(ENABLE_OVERLOADING)
    RangeShowFillLevelPropertyInfo          ,
#endif
    constructRangeShowFillLevel             ,
    getRangeShowFillLevel                   ,
#if defined(ENABLE_OVERLOADING)
    rangeShowFillLevel                      ,
#endif
    setRangeShowFillLevel                   ,




 -- * Signals
-- ** adjustBounds #signal:adjustBounds#

    C_RangeAdjustBoundsCallback             ,
    RangeAdjustBoundsCallback               ,
#if defined(ENABLE_OVERLOADING)
    RangeAdjustBoundsSignalInfo             ,
#endif
    afterRangeAdjustBounds                  ,
    genClosure_RangeAdjustBounds            ,
    mk_RangeAdjustBoundsCallback            ,
    noRangeAdjustBoundsCallback             ,
    onRangeAdjustBounds                     ,
    wrap_RangeAdjustBoundsCallback          ,


-- ** changeValue #signal:changeValue#

    C_RangeChangeValueCallback              ,
    RangeChangeValueCallback                ,
#if defined(ENABLE_OVERLOADING)
    RangeChangeValueSignalInfo              ,
#endif
    afterRangeChangeValue                   ,
    genClosure_RangeChangeValue             ,
    mk_RangeChangeValueCallback             ,
    noRangeChangeValueCallback              ,
    onRangeChangeValue                      ,
    wrap_RangeChangeValueCallback           ,


-- ** moveSlider #signal:moveSlider#

    C_RangeMoveSliderCallback               ,
    RangeMoveSliderCallback                 ,
#if defined(ENABLE_OVERLOADING)
    RangeMoveSliderSignalInfo               ,
#endif
    afterRangeMoveSlider                    ,
    genClosure_RangeMoveSlider              ,
    mk_RangeMoveSliderCallback              ,
    noRangeMoveSliderCallback               ,
    onRangeMoveSlider                       ,
    wrap_RangeMoveSliderCallback            ,


-- ** valueChanged #signal:valueChanged#

    C_RangeValueChangedCallback             ,
    RangeValueChangedCallback               ,
#if defined(ENABLE_OVERLOADING)
    RangeValueChangedSignalInfo             ,
#endif
    afterRangeValueChanged                  ,
    genClosure_RangeValueChanged            ,
    mk_RangeValueChangedCallback            ,
    noRangeValueChangedCallback             ,
    onRangeValueChanged                     ,
    wrap_RangeValueChangedCallback          ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Orientable as Gtk.Orientable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Adjustment as Gtk.Adjustment
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

-- | Memory-managed wrapper type.
newtype Range = Range (SP.ManagedPtr Range)
    deriving (Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c== :: Range -> Range -> Bool
Eq)

instance SP.ManagedPtrNewtype Range where
    toManagedPtr :: Range -> ManagedPtr Range
toManagedPtr (Range ManagedPtr Range
p) = ManagedPtr Range
p

foreign import ccall "gtk_range_get_type"
    c_gtk_range_get_type :: IO B.Types.GType

instance B.Types.TypedObject Range where
    glibType :: IO GType
glibType = IO GType
c_gtk_range_get_type

instance B.Types.GObject Range

-- | Convert 'Range' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Range where
    toGValue :: Range -> IO GValue
toGValue Range
o = do
        GType
gtype <- IO GType
c_gtk_range_get_type
        Range -> (Ptr Range -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Range
o (GType -> (GValue -> Ptr Range -> IO ()) -> Ptr Range -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Range -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Range
fromGValue GValue
gv = do
        Ptr Range
ptr <- GValue -> IO (Ptr Range)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Range)
        (ManagedPtr Range -> Range) -> Ptr Range -> IO Range
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Range -> Range
Range Ptr Range
ptr
        
    

-- | Type class for types which can be safely cast to `Range`, for instance with `toRange`.
class (SP.GObject o, O.IsDescendantOf Range o) => IsRange o
instance (SP.GObject o, O.IsDescendantOf Range o) => IsRange o

instance O.HasParentTypes Range
type instance O.ParentTypes Range = '[Gtk.Widget.Widget, GObject.Object.Object, Atk.ImplementorIface.ImplementorIface, Gtk.Buildable.Buildable, Gtk.ConstraintTarget.ConstraintTarget, Gtk.Orientable.Orientable]

-- | Cast to `Range`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toRange :: (MonadIO m, IsRange o) => o -> m Range
toRange :: o -> m Range
toRange = IO Range -> m Range
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Range -> m Range) -> (o -> IO Range) -> o -> m Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Range -> Range) -> o -> IO Range
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Range -> Range
Range

#if defined(ENABLE_OVERLOADING)
type family ResolveRangeMethod (t :: Symbol) (o :: *) :: * where
    ResolveRangeMethod "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
    ResolveRangeMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveRangeMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveRangeMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveRangeMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveRangeMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveRangeMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
    ResolveRangeMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveRangeMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveRangeMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveRangeMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveRangeMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveRangeMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveRangeMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveRangeMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveRangeMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveRangeMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveRangeMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveRangeMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveRangeMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveRangeMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveRangeMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveRangeMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveRangeMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveRangeMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
    ResolveRangeMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveRangeMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveRangeMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveRangeMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveRangeMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveRangeMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveRangeMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
    ResolveRangeMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveRangeMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveRangeMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolveRangeMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolveRangeMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolveRangeMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolveRangeMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolveRangeMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolveRangeMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolveRangeMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolveRangeMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolveRangeMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveRangeMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolveRangeMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolveRangeMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveRangeMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveRangeMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolveRangeMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolveRangeMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolveRangeMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolveRangeMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveRangeMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveRangeMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolveRangeMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolveRangeMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveRangeMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveRangeMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveRangeMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveRangeMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveRangeMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveRangeMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveRangeMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveRangeMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveRangeMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
    ResolveRangeMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveRangeMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveRangeMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveRangeMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
    ResolveRangeMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolveRangeMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolveRangeMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolveRangeMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveRangeMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveRangeMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveRangeMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolveRangeMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolveRangeMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolveRangeMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolveRangeMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolveRangeMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveRangeMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveRangeMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveRangeMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
    ResolveRangeMethod "getAdjustment" o = RangeGetAdjustmentMethodInfo
    ResolveRangeMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolveRangeMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolveRangeMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolveRangeMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolveRangeMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolveRangeMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolveRangeMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolveRangeMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolveRangeMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolveRangeMethod "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
    ResolveRangeMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
    ResolveRangeMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveRangeMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveRangeMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveRangeMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveRangeMethod "getFillLevel" o = RangeGetFillLevelMethodInfo
    ResolveRangeMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveRangeMethod "getFlippable" o = RangeGetFlippableMethodInfo
    ResolveRangeMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveRangeMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveRangeMethod "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
    ResolveRangeMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolveRangeMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolveRangeMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolveRangeMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolveRangeMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveRangeMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveRangeMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveRangeMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolveRangeMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveRangeMethod "getInverted" o = RangeGetInvertedMethodInfo
    ResolveRangeMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveRangeMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveRangeMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolveRangeMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolveRangeMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolveRangeMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolveRangeMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolveRangeMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveRangeMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
    ResolveRangeMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolveRangeMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolveRangeMethod "getOrientation" o = Gtk.Orientable.OrientableGetOrientationMethodInfo
    ResolveRangeMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolveRangeMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolveRangeMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolveRangeMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolveRangeMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolveRangeMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolveRangeMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveRangeMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveRangeMethod "getRangeRect" o = RangeGetRangeRectMethodInfo
    ResolveRangeMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolveRangeMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolveRangeMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolveRangeMethod "getRestrictToFillLevel" o = RangeGetRestrictToFillLevelMethodInfo
    ResolveRangeMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolveRangeMethod "getRoundDigits" o = RangeGetRoundDigitsMethodInfo
    ResolveRangeMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolveRangeMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolveRangeMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolveRangeMethod "getShowFillLevel" o = RangeGetShowFillLevelMethodInfo
    ResolveRangeMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveRangeMethod "getSliderRange" o = RangeGetSliderRangeMethodInfo
    ResolveRangeMethod "getSliderSizeFixed" o = RangeGetSliderSizeFixedMethodInfo
    ResolveRangeMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveRangeMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveRangeMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
    ResolveRangeMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveRangeMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveRangeMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolveRangeMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolveRangeMethod "getValue" o = RangeGetValueMethodInfo
    ResolveRangeMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolveRangeMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolveRangeMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolveRangeMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolveRangeMethod "setAdjustment" o = RangeSetAdjustmentMethodInfo
    ResolveRangeMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveRangeMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveRangeMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveRangeMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveRangeMethod "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
    ResolveRangeMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolveRangeMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolveRangeMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveRangeMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveRangeMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolveRangeMethod "setFillLevel" o = RangeSetFillLevelMethodInfo
    ResolveRangeMethod "setFlippable" o = RangeSetFlippableMethodInfo
    ResolveRangeMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveRangeMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveRangeMethod "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
    ResolveRangeMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveRangeMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveRangeMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveRangeMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolveRangeMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolveRangeMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolveRangeMethod "setIncrements" o = RangeSetIncrementsMethodInfo
    ResolveRangeMethod "setInverted" o = RangeSetInvertedMethodInfo
    ResolveRangeMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolveRangeMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolveRangeMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolveRangeMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolveRangeMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolveRangeMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolveRangeMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolveRangeMethod "setOrientation" o = Gtk.Orientable.OrientableSetOrientationMethodInfo
    ResolveRangeMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolveRangeMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolveRangeMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveRangeMethod "setRange" o = RangeSetRangeMethodInfo
    ResolveRangeMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolveRangeMethod "setRestrictToFillLevel" o = RangeSetRestrictToFillLevelMethodInfo
    ResolveRangeMethod "setRoundDigits" o = RangeSetRoundDigitsMethodInfo
    ResolveRangeMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolveRangeMethod "setShowFillLevel" o = RangeSetShowFillLevelMethodInfo
    ResolveRangeMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolveRangeMethod "setSliderSizeFixed" o = RangeSetSliderSizeFixedMethodInfo
    ResolveRangeMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolveRangeMethod "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
    ResolveRangeMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveRangeMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveRangeMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolveRangeMethod "setValue" o = RangeSetValueMethodInfo
    ResolveRangeMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolveRangeMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolveRangeMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolveRangeMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveRangeMethod t Range, O.MethodInfo info Range p) => OL.IsLabel t (Range -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

-- signal Range::adjust-bounds
-- | Emitted before clamping a value, to give the application a
-- chance to adjust the bounds.
type RangeAdjustBoundsCallback =
    Double
    -- ^ /@value@/: the value before we clamp
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `RangeAdjustBoundsCallback`@.
noRangeAdjustBoundsCallback :: Maybe RangeAdjustBoundsCallback
noRangeAdjustBoundsCallback :: Maybe RangeAdjustBoundsCallback
noRangeAdjustBoundsCallback = Maybe RangeAdjustBoundsCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_RangeAdjustBoundsCallback =
    Ptr () ->                               -- object
    CDouble ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_RangeAdjustBoundsCallback`.
foreign import ccall "wrapper"
    mk_RangeAdjustBoundsCallback :: C_RangeAdjustBoundsCallback -> IO (FunPtr C_RangeAdjustBoundsCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_RangeAdjustBounds :: MonadIO m => RangeAdjustBoundsCallback -> m (GClosure C_RangeAdjustBoundsCallback)
genClosure_RangeAdjustBounds :: RangeAdjustBoundsCallback
-> m (GClosure C_RangeAdjustBoundsCallback)
genClosure_RangeAdjustBounds RangeAdjustBoundsCallback
cb = IO (GClosure C_RangeAdjustBoundsCallback)
-> m (GClosure C_RangeAdjustBoundsCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_RangeAdjustBoundsCallback)
 -> m (GClosure C_RangeAdjustBoundsCallback))
-> IO (GClosure C_RangeAdjustBoundsCallback)
-> m (GClosure C_RangeAdjustBoundsCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_RangeAdjustBoundsCallback
cb' = RangeAdjustBoundsCallback -> C_RangeAdjustBoundsCallback
wrap_RangeAdjustBoundsCallback RangeAdjustBoundsCallback
cb
    C_RangeAdjustBoundsCallback
-> IO (FunPtr C_RangeAdjustBoundsCallback)
mk_RangeAdjustBoundsCallback C_RangeAdjustBoundsCallback
cb' IO (FunPtr C_RangeAdjustBoundsCallback)
-> (FunPtr C_RangeAdjustBoundsCallback
    -> IO (GClosure C_RangeAdjustBoundsCallback))
-> IO (GClosure C_RangeAdjustBoundsCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_RangeAdjustBoundsCallback
-> IO (GClosure C_RangeAdjustBoundsCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `RangeAdjustBoundsCallback` into a `C_RangeAdjustBoundsCallback`.
wrap_RangeAdjustBoundsCallback ::
    RangeAdjustBoundsCallback ->
    C_RangeAdjustBoundsCallback
wrap_RangeAdjustBoundsCallback :: RangeAdjustBoundsCallback -> C_RangeAdjustBoundsCallback
wrap_RangeAdjustBoundsCallback RangeAdjustBoundsCallback
_cb Ptr ()
_ CDouble
value Ptr ()
_ = do
    let value' :: Double
value' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
value
    RangeAdjustBoundsCallback
_cb  Double
value'


-- | Connect a signal handler for the [adjustBounds](#signal:adjustBounds) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' range #adjustBounds callback
-- @
-- 
-- 
onRangeAdjustBounds :: (IsRange a, MonadIO m) => a -> RangeAdjustBoundsCallback -> m SignalHandlerId
onRangeAdjustBounds :: a -> RangeAdjustBoundsCallback -> m SignalHandlerId
onRangeAdjustBounds a
obj RangeAdjustBoundsCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_RangeAdjustBoundsCallback
cb' = RangeAdjustBoundsCallback -> C_RangeAdjustBoundsCallback
wrap_RangeAdjustBoundsCallback RangeAdjustBoundsCallback
cb
    FunPtr C_RangeAdjustBoundsCallback
cb'' <- C_RangeAdjustBoundsCallback
-> IO (FunPtr C_RangeAdjustBoundsCallback)
mk_RangeAdjustBoundsCallback C_RangeAdjustBoundsCallback
cb'
    a
-> Text
-> FunPtr C_RangeAdjustBoundsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"adjust-bounds" FunPtr C_RangeAdjustBoundsCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [adjustBounds](#signal:adjustBounds) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' range #adjustBounds callback
-- @
-- 
-- 
afterRangeAdjustBounds :: (IsRange a, MonadIO m) => a -> RangeAdjustBoundsCallback -> m SignalHandlerId
afterRangeAdjustBounds :: a -> RangeAdjustBoundsCallback -> m SignalHandlerId
afterRangeAdjustBounds a
obj RangeAdjustBoundsCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_RangeAdjustBoundsCallback
cb' = RangeAdjustBoundsCallback -> C_RangeAdjustBoundsCallback
wrap_RangeAdjustBoundsCallback RangeAdjustBoundsCallback
cb
    FunPtr C_RangeAdjustBoundsCallback
cb'' <- C_RangeAdjustBoundsCallback
-> IO (FunPtr C_RangeAdjustBoundsCallback)
mk_RangeAdjustBoundsCallback C_RangeAdjustBoundsCallback
cb'
    a
-> Text
-> FunPtr C_RangeAdjustBoundsCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"adjust-bounds" FunPtr C_RangeAdjustBoundsCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data RangeAdjustBoundsSignalInfo
instance SignalInfo RangeAdjustBoundsSignalInfo where
    type HaskellCallbackType RangeAdjustBoundsSignalInfo = RangeAdjustBoundsCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_RangeAdjustBoundsCallback cb
        cb'' <- mk_RangeAdjustBoundsCallback cb'
        connectSignalFunPtr obj "adjust-bounds" cb'' connectMode detail

#endif

-- signal Range::change-value
-- | The [changeValue]("GI.Gtk.Objects.Range#g:signal:changeValue") signal is emitted when a scroll action is
-- performed on a range.  It allows an application to determine the
-- type of scroll event that occurred and the resultant new value.
-- The application can handle the event itself and return 'P.True' to
-- prevent further processing.  Or, by returning 'P.False', it can pass
-- the event to other handlers until the default GTK+ handler is
-- reached.
-- 
-- The value parameter is unrounded.  An application that overrides
-- the GtkRange[changeValue](#g:signal:changeValue) signal is responsible for clamping the
-- value to the desired number of decimal digits; the default GTK+
-- handler clamps the value based on t'GI.Gtk.Objects.Range.Range':@/round-digits/@.
type RangeChangeValueCallback =
    Gtk.Enums.ScrollType
    -- ^ /@scroll@/: the type of scroll action that was performed
    -> Double
    -- ^ /@value@/: the new value resulting from the scroll action
    -> IO Bool
    -- ^ __Returns:__ 'P.True' to prevent other handlers from being invoked for
    --     the signal, 'P.False' to propagate the signal further

-- | A convenience synonym for @`Nothing` :: `Maybe` `RangeChangeValueCallback`@.
noRangeChangeValueCallback :: Maybe RangeChangeValueCallback
noRangeChangeValueCallback :: Maybe RangeChangeValueCallback
noRangeChangeValueCallback = Maybe RangeChangeValueCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_RangeChangeValueCallback =
    Ptr () ->                               -- object
    CUInt ->
    CDouble ->
    Ptr () ->                               -- user_data
    IO CInt

-- | Generate a function pointer callable from C code, from a `C_RangeChangeValueCallback`.
foreign import ccall "wrapper"
    mk_RangeChangeValueCallback :: C_RangeChangeValueCallback -> IO (FunPtr C_RangeChangeValueCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_RangeChangeValue :: MonadIO m => RangeChangeValueCallback -> m (GClosure C_RangeChangeValueCallback)
genClosure_RangeChangeValue :: RangeChangeValueCallback -> m (GClosure C_RangeChangeValueCallback)
genClosure_RangeChangeValue RangeChangeValueCallback
cb = IO (GClosure C_RangeChangeValueCallback)
-> m (GClosure C_RangeChangeValueCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_RangeChangeValueCallback)
 -> m (GClosure C_RangeChangeValueCallback))
-> IO (GClosure C_RangeChangeValueCallback)
-> m (GClosure C_RangeChangeValueCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_RangeChangeValueCallback
cb' = RangeChangeValueCallback -> C_RangeChangeValueCallback
wrap_RangeChangeValueCallback RangeChangeValueCallback
cb
    C_RangeChangeValueCallback
-> IO (FunPtr C_RangeChangeValueCallback)
mk_RangeChangeValueCallback C_RangeChangeValueCallback
cb' IO (FunPtr C_RangeChangeValueCallback)
-> (FunPtr C_RangeChangeValueCallback
    -> IO (GClosure C_RangeChangeValueCallback))
-> IO (GClosure C_RangeChangeValueCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_RangeChangeValueCallback
-> IO (GClosure C_RangeChangeValueCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `RangeChangeValueCallback` into a `C_RangeChangeValueCallback`.
wrap_RangeChangeValueCallback ::
    RangeChangeValueCallback ->
    C_RangeChangeValueCallback
wrap_RangeChangeValueCallback :: RangeChangeValueCallback -> C_RangeChangeValueCallback
wrap_RangeChangeValueCallback RangeChangeValueCallback
_cb Ptr ()
_ CUInt
scroll CDouble
value Ptr ()
_ = do
    let scroll' :: ScrollType
scroll' = (Int -> ScrollType
forall a. Enum a => Int -> a
toEnum (Int -> ScrollType) -> (CUInt -> Int) -> CUInt -> ScrollType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
scroll
    let value' :: Double
value' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
value
    Bool
result <- RangeChangeValueCallback
_cb  ScrollType
scroll' Double
value'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [changeValue](#signal:changeValue) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' range #changeValue callback
-- @
-- 
-- 
onRangeChangeValue :: (IsRange a, MonadIO m) => a -> RangeChangeValueCallback -> m SignalHandlerId
onRangeChangeValue :: a -> RangeChangeValueCallback -> m SignalHandlerId
onRangeChangeValue a
obj RangeChangeValueCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_RangeChangeValueCallback
cb' = RangeChangeValueCallback -> C_RangeChangeValueCallback
wrap_RangeChangeValueCallback RangeChangeValueCallback
cb
    FunPtr C_RangeChangeValueCallback
cb'' <- C_RangeChangeValueCallback
-> IO (FunPtr C_RangeChangeValueCallback)
mk_RangeChangeValueCallback C_RangeChangeValueCallback
cb'
    a
-> Text
-> FunPtr C_RangeChangeValueCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"change-value" FunPtr C_RangeChangeValueCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [changeValue](#signal:changeValue) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' range #changeValue callback
-- @
-- 
-- 
afterRangeChangeValue :: (IsRange a, MonadIO m) => a -> RangeChangeValueCallback -> m SignalHandlerId
afterRangeChangeValue :: a -> RangeChangeValueCallback -> m SignalHandlerId
afterRangeChangeValue a
obj RangeChangeValueCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_RangeChangeValueCallback
cb' = RangeChangeValueCallback -> C_RangeChangeValueCallback
wrap_RangeChangeValueCallback RangeChangeValueCallback
cb
    FunPtr C_RangeChangeValueCallback
cb'' <- C_RangeChangeValueCallback
-> IO (FunPtr C_RangeChangeValueCallback)
mk_RangeChangeValueCallback C_RangeChangeValueCallback
cb'
    a
-> Text
-> FunPtr C_RangeChangeValueCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"change-value" FunPtr C_RangeChangeValueCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data RangeChangeValueSignalInfo
instance SignalInfo RangeChangeValueSignalInfo where
    type HaskellCallbackType RangeChangeValueSignalInfo = RangeChangeValueCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_RangeChangeValueCallback cb
        cb'' <- mk_RangeChangeValueCallback cb'
        connectSignalFunPtr obj "change-value" cb'' connectMode detail

#endif

-- signal Range::move-slider
-- | Virtual function that moves the slider. Used for keybindings.
type RangeMoveSliderCallback =
    Gtk.Enums.ScrollType
    -- ^ /@step@/: how to move the slider
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `RangeMoveSliderCallback`@.
noRangeMoveSliderCallback :: Maybe RangeMoveSliderCallback
noRangeMoveSliderCallback :: Maybe RangeMoveSliderCallback
noRangeMoveSliderCallback = Maybe RangeMoveSliderCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_RangeMoveSliderCallback =
    Ptr () ->                               -- object
    CUInt ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_RangeMoveSliderCallback`.
foreign import ccall "wrapper"
    mk_RangeMoveSliderCallback :: C_RangeMoveSliderCallback -> IO (FunPtr C_RangeMoveSliderCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_RangeMoveSlider :: MonadIO m => RangeMoveSliderCallback -> m (GClosure C_RangeMoveSliderCallback)
genClosure_RangeMoveSlider :: RangeMoveSliderCallback -> m (GClosure C_RangeMoveSliderCallback)
genClosure_RangeMoveSlider RangeMoveSliderCallback
cb = IO (GClosure C_RangeMoveSliderCallback)
-> m (GClosure C_RangeMoveSliderCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_RangeMoveSliderCallback)
 -> m (GClosure C_RangeMoveSliderCallback))
-> IO (GClosure C_RangeMoveSliderCallback)
-> m (GClosure C_RangeMoveSliderCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_RangeMoveSliderCallback
cb' = RangeMoveSliderCallback -> C_RangeMoveSliderCallback
wrap_RangeMoveSliderCallback RangeMoveSliderCallback
cb
    C_RangeMoveSliderCallback -> IO (FunPtr C_RangeMoveSliderCallback)
mk_RangeMoveSliderCallback C_RangeMoveSliderCallback
cb' IO (FunPtr C_RangeMoveSliderCallback)
-> (FunPtr C_RangeMoveSliderCallback
    -> IO (GClosure C_RangeMoveSliderCallback))
-> IO (GClosure C_RangeMoveSliderCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_RangeMoveSliderCallback
-> IO (GClosure C_RangeMoveSliderCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `RangeMoveSliderCallback` into a `C_RangeMoveSliderCallback`.
wrap_RangeMoveSliderCallback ::
    RangeMoveSliderCallback ->
    C_RangeMoveSliderCallback
wrap_RangeMoveSliderCallback :: RangeMoveSliderCallback -> C_RangeMoveSliderCallback
wrap_RangeMoveSliderCallback RangeMoveSliderCallback
_cb Ptr ()
_ CUInt
step Ptr ()
_ = do
    let step' :: ScrollType
step' = (Int -> ScrollType
forall a. Enum a => Int -> a
toEnum (Int -> ScrollType) -> (CUInt -> Int) -> CUInt -> ScrollType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
step
    RangeMoveSliderCallback
_cb  ScrollType
step'


-- | Connect a signal handler for the [moveSlider](#signal:moveSlider) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' range #moveSlider callback
-- @
-- 
-- 
onRangeMoveSlider :: (IsRange a, MonadIO m) => a -> RangeMoveSliderCallback -> m SignalHandlerId
onRangeMoveSlider :: a -> RangeMoveSliderCallback -> m SignalHandlerId
onRangeMoveSlider a
obj RangeMoveSliderCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_RangeMoveSliderCallback
cb' = RangeMoveSliderCallback -> C_RangeMoveSliderCallback
wrap_RangeMoveSliderCallback RangeMoveSliderCallback
cb
    FunPtr C_RangeMoveSliderCallback
cb'' <- C_RangeMoveSliderCallback -> IO (FunPtr C_RangeMoveSliderCallback)
mk_RangeMoveSliderCallback C_RangeMoveSliderCallback
cb'
    a
-> Text
-> FunPtr C_RangeMoveSliderCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"move-slider" FunPtr C_RangeMoveSliderCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [moveSlider](#signal:moveSlider) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' range #moveSlider callback
-- @
-- 
-- 
afterRangeMoveSlider :: (IsRange a, MonadIO m) => a -> RangeMoveSliderCallback -> m SignalHandlerId
afterRangeMoveSlider :: a -> RangeMoveSliderCallback -> m SignalHandlerId
afterRangeMoveSlider a
obj RangeMoveSliderCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_RangeMoveSliderCallback
cb' = RangeMoveSliderCallback -> C_RangeMoveSliderCallback
wrap_RangeMoveSliderCallback RangeMoveSliderCallback
cb
    FunPtr C_RangeMoveSliderCallback
cb'' <- C_RangeMoveSliderCallback -> IO (FunPtr C_RangeMoveSliderCallback)
mk_RangeMoveSliderCallback C_RangeMoveSliderCallback
cb'
    a
-> Text
-> FunPtr C_RangeMoveSliderCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"move-slider" FunPtr C_RangeMoveSliderCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data RangeMoveSliderSignalInfo
instance SignalInfo RangeMoveSliderSignalInfo where
    type HaskellCallbackType RangeMoveSliderSignalInfo = RangeMoveSliderCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_RangeMoveSliderCallback cb
        cb'' <- mk_RangeMoveSliderCallback cb'
        connectSignalFunPtr obj "move-slider" cb'' connectMode detail

#endif

-- signal Range::value-changed
-- | Emitted when the range value changes.
type RangeValueChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `RangeValueChangedCallback`@.
noRangeValueChangedCallback :: Maybe RangeValueChangedCallback
noRangeValueChangedCallback :: Maybe (IO ())
noRangeValueChangedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_RangeValueChangedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_RangeValueChangedCallback`.
foreign import ccall "wrapper"
    mk_RangeValueChangedCallback :: C_RangeValueChangedCallback -> IO (FunPtr C_RangeValueChangedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_RangeValueChanged :: MonadIO m => RangeValueChangedCallback -> m (GClosure C_RangeValueChangedCallback)
genClosure_RangeValueChanged :: IO () -> m (GClosure C_RangeValueChangedCallback)
genClosure_RangeValueChanged IO ()
cb = IO (GClosure C_RangeValueChangedCallback)
-> m (GClosure C_RangeValueChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_RangeValueChangedCallback)
 -> m (GClosure C_RangeValueChangedCallback))
-> IO (GClosure C_RangeValueChangedCallback)
-> m (GClosure C_RangeValueChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_RangeValueChangedCallback
cb' = IO () -> C_RangeValueChangedCallback
wrap_RangeValueChangedCallback IO ()
cb
    C_RangeValueChangedCallback
-> IO (FunPtr C_RangeValueChangedCallback)
mk_RangeValueChangedCallback C_RangeValueChangedCallback
cb' IO (FunPtr C_RangeValueChangedCallback)
-> (FunPtr C_RangeValueChangedCallback
    -> IO (GClosure C_RangeValueChangedCallback))
-> IO (GClosure C_RangeValueChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_RangeValueChangedCallback
-> IO (GClosure C_RangeValueChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `RangeValueChangedCallback` into a `C_RangeValueChangedCallback`.
wrap_RangeValueChangedCallback ::
    RangeValueChangedCallback ->
    C_RangeValueChangedCallback
wrap_RangeValueChangedCallback :: IO () -> C_RangeValueChangedCallback
wrap_RangeValueChangedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [valueChanged](#signal:valueChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' range #valueChanged callback
-- @
-- 
-- 
onRangeValueChanged :: (IsRange a, MonadIO m) => a -> RangeValueChangedCallback -> m SignalHandlerId
onRangeValueChanged :: a -> IO () -> m SignalHandlerId
onRangeValueChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_RangeValueChangedCallback
cb' = IO () -> C_RangeValueChangedCallback
wrap_RangeValueChangedCallback IO ()
cb
    FunPtr C_RangeValueChangedCallback
cb'' <- C_RangeValueChangedCallback
-> IO (FunPtr C_RangeValueChangedCallback)
mk_RangeValueChangedCallback C_RangeValueChangedCallback
cb'
    a
-> Text
-> FunPtr C_RangeValueChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"value-changed" FunPtr C_RangeValueChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [valueChanged](#signal:valueChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' range #valueChanged callback
-- @
-- 
-- 
afterRangeValueChanged :: (IsRange a, MonadIO m) => a -> RangeValueChangedCallback -> m SignalHandlerId
afterRangeValueChanged :: a -> IO () -> m SignalHandlerId
afterRangeValueChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_RangeValueChangedCallback
cb' = IO () -> C_RangeValueChangedCallback
wrap_RangeValueChangedCallback IO ()
cb
    FunPtr C_RangeValueChangedCallback
cb'' <- C_RangeValueChangedCallback
-> IO (FunPtr C_RangeValueChangedCallback)
mk_RangeValueChangedCallback C_RangeValueChangedCallback
cb'
    a
-> Text
-> FunPtr C_RangeValueChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"value-changed" FunPtr C_RangeValueChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data RangeValueChangedSignalInfo
instance SignalInfo RangeValueChangedSignalInfo where
    type HaskellCallbackType RangeValueChangedSignalInfo = RangeValueChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_RangeValueChangedCallback cb
        cb'' <- mk_RangeValueChangedCallback cb'
        connectSignalFunPtr obj "value-changed" cb'' connectMode detail

#endif

-- VVV Prop "adjustment"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Adjustment"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@adjustment@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' range #adjustment
-- @
getRangeAdjustment :: (MonadIO m, IsRange o) => o -> m Gtk.Adjustment.Adjustment
getRangeAdjustment :: o -> m Adjustment
getRangeAdjustment o
obj = IO Adjustment -> m Adjustment
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Adjustment -> m Adjustment) -> IO Adjustment -> m Adjustment
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Adjustment) -> IO Adjustment
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getRangeAdjustment" (IO (Maybe Adjustment) -> IO Adjustment)
-> IO (Maybe Adjustment) -> IO Adjustment
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr Adjustment -> Adjustment)
-> IO (Maybe Adjustment)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"adjustment" ManagedPtr Adjustment -> Adjustment
Gtk.Adjustment.Adjustment

-- | Set the value of the “@adjustment@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' range [ #adjustment 'Data.GI.Base.Attributes.:=' value ]
-- @
setRangeAdjustment :: (MonadIO m, IsRange o, Gtk.Adjustment.IsAdjustment a) => o -> a -> m ()
setRangeAdjustment :: o -> a -> m ()
setRangeAdjustment o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"adjustment" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@adjustment@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructRangeAdjustment :: (IsRange o, MIO.MonadIO m, Gtk.Adjustment.IsAdjustment a) => a -> m (GValueConstruct o)
constructRangeAdjustment :: a -> m (GValueConstruct o)
constructRangeAdjustment a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"adjustment" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data RangeAdjustmentPropertyInfo
instance AttrInfo RangeAdjustmentPropertyInfo where
    type AttrAllowedOps RangeAdjustmentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint RangeAdjustmentPropertyInfo = IsRange
    type AttrSetTypeConstraint RangeAdjustmentPropertyInfo = Gtk.Adjustment.IsAdjustment
    type AttrTransferTypeConstraint RangeAdjustmentPropertyInfo = Gtk.Adjustment.IsAdjustment
    type AttrTransferType RangeAdjustmentPropertyInfo = Gtk.Adjustment.Adjustment
    type AttrGetType RangeAdjustmentPropertyInfo = Gtk.Adjustment.Adjustment
    type AttrLabel RangeAdjustmentPropertyInfo = "adjustment"
    type AttrOrigin RangeAdjustmentPropertyInfo = Range
    attrGet = getRangeAdjustment
    attrSet = setRangeAdjustment
    attrTransfer _ v = do
        unsafeCastTo Gtk.Adjustment.Adjustment v
    attrConstruct = constructRangeAdjustment
    attrClear = undefined
#endif

-- VVV Prop "fill-level"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@fill-level@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' range #fillLevel
-- @
getRangeFillLevel :: (MonadIO m, IsRange o) => o -> m Double
getRangeFillLevel :: o -> m Double
getRangeFillLevel o
obj = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Double
forall a. GObject a => a -> String -> IO Double
B.Properties.getObjectPropertyDouble o
obj String
"fill-level"

-- | Set the value of the “@fill-level@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' range [ #fillLevel 'Data.GI.Base.Attributes.:=' value ]
-- @
setRangeFillLevel :: (MonadIO m, IsRange o) => o -> Double -> m ()
setRangeFillLevel :: o -> Double -> m ()
setRangeFillLevel o
obj Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> RangeAdjustBoundsCallback
forall a. GObject a => a -> String -> RangeAdjustBoundsCallback
B.Properties.setObjectPropertyDouble o
obj String
"fill-level" Double
val

-- | Construct a `GValueConstruct` with valid value for the “@fill-level@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructRangeFillLevel :: (IsRange o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructRangeFillLevel :: Double -> m (GValueConstruct o)
constructRangeFillLevel Double
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Double -> IO (GValueConstruct o)
forall o. String -> Double -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyDouble String
"fill-level" Double
val

#if defined(ENABLE_OVERLOADING)
data RangeFillLevelPropertyInfo
instance AttrInfo RangeFillLevelPropertyInfo where
    type AttrAllowedOps RangeFillLevelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint RangeFillLevelPropertyInfo = IsRange
    type AttrSetTypeConstraint RangeFillLevelPropertyInfo = (~) Double
    type AttrTransferTypeConstraint RangeFillLevelPropertyInfo = (~) Double
    type AttrTransferType RangeFillLevelPropertyInfo = Double
    type AttrGetType RangeFillLevelPropertyInfo = Double
    type AttrLabel RangeFillLevelPropertyInfo = "fill-level"
    type AttrOrigin RangeFillLevelPropertyInfo = Range
    attrGet = getRangeFillLevel
    attrSet = setRangeFillLevel
    attrTransfer _ v = do
        return v
    attrConstruct = constructRangeFillLevel
    attrClear = undefined
#endif

-- VVV Prop "inverted"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@inverted@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' range #inverted
-- @
getRangeInverted :: (MonadIO m, IsRange o) => o -> m Bool
getRangeInverted :: o -> m Bool
getRangeInverted o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"inverted"

-- | Set the value of the “@inverted@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' range [ #inverted 'Data.GI.Base.Attributes.:=' value ]
-- @
setRangeInverted :: (MonadIO m, IsRange o) => o -> Bool -> m ()
setRangeInverted :: o -> Bool -> m ()
setRangeInverted o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"inverted" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@inverted@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructRangeInverted :: (IsRange o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructRangeInverted :: Bool -> m (GValueConstruct o)
constructRangeInverted Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"inverted" Bool
val

#if defined(ENABLE_OVERLOADING)
data RangeInvertedPropertyInfo
instance AttrInfo RangeInvertedPropertyInfo where
    type AttrAllowedOps RangeInvertedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint RangeInvertedPropertyInfo = IsRange
    type AttrSetTypeConstraint RangeInvertedPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint RangeInvertedPropertyInfo = (~) Bool
    type AttrTransferType RangeInvertedPropertyInfo = Bool
    type AttrGetType RangeInvertedPropertyInfo = Bool
    type AttrLabel RangeInvertedPropertyInfo = "inverted"
    type AttrOrigin RangeInvertedPropertyInfo = Range
    attrGet = getRangeInverted
    attrSet = setRangeInverted
    attrTransfer _ v = do
        return v
    attrConstruct = constructRangeInverted
    attrClear = undefined
#endif

-- VVV Prop "restrict-to-fill-level"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@restrict-to-fill-level@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' range #restrictToFillLevel
-- @
getRangeRestrictToFillLevel :: (MonadIO m, IsRange o) => o -> m Bool
getRangeRestrictToFillLevel :: o -> m Bool
getRangeRestrictToFillLevel o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"restrict-to-fill-level"

-- | Set the value of the “@restrict-to-fill-level@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' range [ #restrictToFillLevel 'Data.GI.Base.Attributes.:=' value ]
-- @
setRangeRestrictToFillLevel :: (MonadIO m, IsRange o) => o -> Bool -> m ()
setRangeRestrictToFillLevel :: o -> Bool -> m ()
setRangeRestrictToFillLevel o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"restrict-to-fill-level" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@restrict-to-fill-level@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructRangeRestrictToFillLevel :: (IsRange o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructRangeRestrictToFillLevel :: Bool -> m (GValueConstruct o)
constructRangeRestrictToFillLevel Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"restrict-to-fill-level" Bool
val

#if defined(ENABLE_OVERLOADING)
data RangeRestrictToFillLevelPropertyInfo
instance AttrInfo RangeRestrictToFillLevelPropertyInfo where
    type AttrAllowedOps RangeRestrictToFillLevelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint RangeRestrictToFillLevelPropertyInfo = IsRange
    type AttrSetTypeConstraint RangeRestrictToFillLevelPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint RangeRestrictToFillLevelPropertyInfo = (~) Bool
    type AttrTransferType RangeRestrictToFillLevelPropertyInfo = Bool
    type AttrGetType RangeRestrictToFillLevelPropertyInfo = Bool
    type AttrLabel RangeRestrictToFillLevelPropertyInfo = "restrict-to-fill-level"
    type AttrOrigin RangeRestrictToFillLevelPropertyInfo = Range
    attrGet = getRangeRestrictToFillLevel
    attrSet = setRangeRestrictToFillLevel
    attrTransfer _ v = do
        return v
    attrConstruct = constructRangeRestrictToFillLevel
    attrClear = undefined
#endif

-- VVV Prop "round-digits"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@round-digits@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' range #roundDigits
-- @
getRangeRoundDigits :: (MonadIO m, IsRange o) => o -> m Int32
getRangeRoundDigits :: o -> m Int32
getRangeRoundDigits o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"round-digits"

-- | Set the value of the “@round-digits@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' range [ #roundDigits 'Data.GI.Base.Attributes.:=' value ]
-- @
setRangeRoundDigits :: (MonadIO m, IsRange o) => o -> Int32 -> m ()
setRangeRoundDigits :: o -> Int32 -> m ()
setRangeRoundDigits o
obj Int32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"round-digits" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@round-digits@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructRangeRoundDigits :: (IsRange o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructRangeRoundDigits :: Int32 -> m (GValueConstruct o)
constructRangeRoundDigits Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"round-digits" Int32
val

#if defined(ENABLE_OVERLOADING)
data RangeRoundDigitsPropertyInfo
instance AttrInfo RangeRoundDigitsPropertyInfo where
    type AttrAllowedOps RangeRoundDigitsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint RangeRoundDigitsPropertyInfo = IsRange
    type AttrSetTypeConstraint RangeRoundDigitsPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint RangeRoundDigitsPropertyInfo = (~) Int32
    type AttrTransferType RangeRoundDigitsPropertyInfo = Int32
    type AttrGetType RangeRoundDigitsPropertyInfo = Int32
    type AttrLabel RangeRoundDigitsPropertyInfo = "round-digits"
    type AttrOrigin RangeRoundDigitsPropertyInfo = Range
    attrGet = getRangeRoundDigits
    attrSet = setRangeRoundDigits
    attrTransfer _ v = do
        return v
    attrConstruct = constructRangeRoundDigits
    attrClear = undefined
#endif

-- VVV Prop "show-fill-level"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@show-fill-level@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' range #showFillLevel
-- @
getRangeShowFillLevel :: (MonadIO m, IsRange o) => o -> m Bool
getRangeShowFillLevel :: o -> m Bool
getRangeShowFillLevel o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"show-fill-level"

-- | Set the value of the “@show-fill-level@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' range [ #showFillLevel 'Data.GI.Base.Attributes.:=' value ]
-- @
setRangeShowFillLevel :: (MonadIO m, IsRange o) => o -> Bool -> m ()
setRangeShowFillLevel :: o -> Bool -> m ()
setRangeShowFillLevel o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"show-fill-level" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@show-fill-level@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructRangeShowFillLevel :: (IsRange o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructRangeShowFillLevel :: Bool -> m (GValueConstruct o)
constructRangeShowFillLevel Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"show-fill-level" Bool
val

#if defined(ENABLE_OVERLOADING)
data RangeShowFillLevelPropertyInfo
instance AttrInfo RangeShowFillLevelPropertyInfo where
    type AttrAllowedOps RangeShowFillLevelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint RangeShowFillLevelPropertyInfo = IsRange
    type AttrSetTypeConstraint RangeShowFillLevelPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint RangeShowFillLevelPropertyInfo = (~) Bool
    type AttrTransferType RangeShowFillLevelPropertyInfo = Bool
    type AttrGetType RangeShowFillLevelPropertyInfo = Bool
    type AttrLabel RangeShowFillLevelPropertyInfo = "show-fill-level"
    type AttrOrigin RangeShowFillLevelPropertyInfo = Range
    attrGet = getRangeShowFillLevel
    attrSet = setRangeShowFillLevel
    attrTransfer _ v = do
        return v
    attrConstruct = constructRangeShowFillLevel
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Range
type instance O.AttributeList Range = RangeAttributeList
type RangeAttributeList = ('[ '("adjustment", RangeAdjustmentPropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("fillLevel", RangeFillLevelPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("inverted", RangeInvertedPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("orientation", Gtk.Orientable.OrientableOrientationPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("restrictToFillLevel", RangeRestrictToFillLevelPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("roundDigits", RangeRoundDigitsPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("showFillLevel", RangeShowFillLevelPropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
rangeAdjustment :: AttrLabelProxy "adjustment"
rangeAdjustment = AttrLabelProxy

rangeFillLevel :: AttrLabelProxy "fillLevel"
rangeFillLevel = AttrLabelProxy

rangeInverted :: AttrLabelProxy "inverted"
rangeInverted = AttrLabelProxy

rangeRestrictToFillLevel :: AttrLabelProxy "restrictToFillLevel"
rangeRestrictToFillLevel = AttrLabelProxy

rangeRoundDigits :: AttrLabelProxy "roundDigits"
rangeRoundDigits = AttrLabelProxy

rangeShowFillLevel :: AttrLabelProxy "showFillLevel"
rangeShowFillLevel = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Range = RangeSignalList
type RangeSignalList = ('[ '("adjustBounds", RangeAdjustBoundsSignalInfo), '("changeValue", RangeChangeValueSignalInfo), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("grabNotify", Gtk.Widget.WidgetGrabNotifySignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("moveSlider", RangeMoveSliderSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo), '("valueChanged", RangeValueChangedSignalInfo)] :: [(Symbol, *)])

#endif

-- method Range::get_adjustment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Adjustment" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_get_adjustment" gtk_range_get_adjustment :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    IO (Ptr Gtk.Adjustment.Adjustment)

-- | Get the t'GI.Gtk.Objects.Adjustment.Adjustment' which is the “model” object for t'GI.Gtk.Objects.Range.Range'.
-- See 'GI.Gtk.Objects.Range.rangeSetAdjustment' for details.
-- The return value does not have a reference added, so should not
-- be unreferenced.
rangeGetAdjustment ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> m Gtk.Adjustment.Adjustment
    -- ^ __Returns:__ a t'GI.Gtk.Objects.Adjustment.Adjustment'
rangeGetAdjustment :: a -> m Adjustment
rangeGetAdjustment a
range = IO Adjustment -> m Adjustment
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Adjustment -> m Adjustment) -> IO Adjustment -> m Adjustment
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    Ptr Adjustment
result <- Ptr Range -> IO (Ptr Adjustment)
gtk_range_get_adjustment Ptr Range
range'
    Text -> Ptr Adjustment -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"rangeGetAdjustment" Ptr Adjustment
result
    Adjustment
result' <- ((ManagedPtr Adjustment -> Adjustment)
-> Ptr Adjustment -> IO Adjustment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Adjustment -> Adjustment
Gtk.Adjustment.Adjustment) Ptr Adjustment
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    Adjustment -> IO Adjustment
forall (m :: * -> *) a. Monad m => a -> m a
return Adjustment
result'

#if defined(ENABLE_OVERLOADING)
data RangeGetAdjustmentMethodInfo
instance (signature ~ (m Gtk.Adjustment.Adjustment), MonadIO m, IsRange a) => O.MethodInfo RangeGetAdjustmentMethodInfo a signature where
    overloadedMethod = rangeGetAdjustment

#endif

-- method Range::get_fill_level
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_get_fill_level" gtk_range_get_fill_level :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    IO CDouble

-- | Gets the current position of the fill level indicator.
rangeGetFillLevel ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: A t'GI.Gtk.Objects.Range.Range'
    -> m Double
    -- ^ __Returns:__ The current fill level
rangeGetFillLevel :: a -> m Double
rangeGetFillLevel a
range = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    CDouble
result <- Ptr Range -> IO CDouble
gtk_range_get_fill_level Ptr Range
range'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data RangeGetFillLevelMethodInfo
instance (signature ~ (m Double), MonadIO m, IsRange a) => O.MethodInfo RangeGetFillLevelMethodInfo a signature where
    overloadedMethod = rangeGetFillLevel

#endif

-- method Range::get_flippable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_get_flippable" gtk_range_get_flippable :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    IO CInt

-- | Gets the value set by 'GI.Gtk.Objects.Range.rangeSetFlippable'.
rangeGetFlippable ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the range is flippable
rangeGetFlippable :: a -> m Bool
rangeGetFlippable a
range = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    CInt
result <- Ptr Range -> IO CInt
gtk_range_get_flippable Ptr Range
range'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RangeGetFlippableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsRange a) => O.MethodInfo RangeGetFlippableMethodInfo a signature where
    overloadedMethod = rangeGetFlippable

#endif

-- method Range::get_inverted
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_get_inverted" gtk_range_get_inverted :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    IO CInt

-- | Gets the value set by 'GI.Gtk.Objects.Range.rangeSetInverted'.
rangeGetInverted ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the range is inverted
rangeGetInverted :: a -> m Bool
rangeGetInverted a
range = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    CInt
result <- Ptr Range -> IO CInt
gtk_range_get_inverted Ptr Range
range'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RangeGetInvertedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsRange a) => O.MethodInfo RangeGetInvertedMethodInfo a signature where
    overloadedMethod = rangeGetInverted

#endif

-- method Range::get_range_rect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "range_rect"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the range rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_get_range_rect" gtk_range_get_range_rect :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    Ptr Gdk.Rectangle.Rectangle ->          -- range_rect : TInterface (Name {namespace = "Gdk", name = "Rectangle"})
    IO ()

-- | This function returns the area that contains the range’s trough,
-- in coordinates relative to /@range@/\'s origin.
-- 
-- This function is useful mainly for t'GI.Gtk.Objects.Range.Range' subclasses.
rangeGetRangeRect ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> m (Gdk.Rectangle.Rectangle)
rangeGetRangeRect :: a -> m Rectangle
rangeGetRangeRect a
range = IO Rectangle -> m Rectangle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rectangle -> m Rectangle) -> IO Rectangle -> m Rectangle
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    Ptr Rectangle
rangeRect <- Int -> IO (Ptr Rectangle)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Gdk.Rectangle.Rectangle)
    Ptr Range -> Ptr Rectangle -> IO ()
gtk_range_get_range_rect Ptr Range
range' Ptr Rectangle
rangeRect
    Rectangle
rangeRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rectangle -> Rectangle
Gdk.Rectangle.Rectangle) Ptr Rectangle
rangeRect
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    Rectangle -> IO Rectangle
forall (m :: * -> *) a. Monad m => a -> m a
return Rectangle
rangeRect'

#if defined(ENABLE_OVERLOADING)
data RangeGetRangeRectMethodInfo
instance (signature ~ (m (Gdk.Rectangle.Rectangle)), MonadIO m, IsRange a) => O.MethodInfo RangeGetRangeRectMethodInfo a signature where
    overloadedMethod = rangeGetRangeRect

#endif

-- method Range::get_restrict_to_fill_level
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_get_restrict_to_fill_level" gtk_range_get_restrict_to_fill_level :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    IO CInt

-- | Gets whether the range is restricted to the fill level.
rangeGetRestrictToFillLevel ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: A t'GI.Gtk.Objects.Range.Range'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@range@/ is restricted to the fill level.
rangeGetRestrictToFillLevel :: a -> m Bool
rangeGetRestrictToFillLevel a
range = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    CInt
result <- Ptr Range -> IO CInt
gtk_range_get_restrict_to_fill_level Ptr Range
range'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RangeGetRestrictToFillLevelMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsRange a) => O.MethodInfo RangeGetRestrictToFillLevelMethodInfo a signature where
    overloadedMethod = rangeGetRestrictToFillLevel

#endif

-- method Range::get_round_digits
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_get_round_digits" gtk_range_get_round_digits :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    IO Int32

-- | Gets the number of digits to round the value to when
-- it changes. See [changeValue]("GI.Gtk.Objects.Range#g:signal:changeValue").
rangeGetRoundDigits ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> m Int32
    -- ^ __Returns:__ the number of digits to round to
rangeGetRoundDigits :: a -> m Int32
rangeGetRoundDigits a
range = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    Int32
result <- Ptr Range -> IO Int32
gtk_range_get_round_digits Ptr Range
range'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data RangeGetRoundDigitsMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsRange a) => O.MethodInfo RangeGetRoundDigitsMethodInfo a signature where
    overloadedMethod = rangeGetRoundDigits

#endif

-- method Range::get_show_fill_level
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_get_show_fill_level" gtk_range_get_show_fill_level :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    IO CInt

-- | Gets whether the range displays the fill level graphically.
rangeGetShowFillLevel ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: A t'GI.Gtk.Objects.Range.Range'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@range@/ shows the fill level.
rangeGetShowFillLevel :: a -> m Bool
rangeGetShowFillLevel a
range = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    CInt
result <- Ptr Range -> IO CInt
gtk_range_get_show_fill_level Ptr Range
range'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RangeGetShowFillLevelMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsRange a) => O.MethodInfo RangeGetShowFillLevelMethodInfo a signature where
    overloadedMethod = rangeGetShowFillLevel

#endif

-- method Range::get_slider_range
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "slider_start"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the slider's\n    start, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "slider_end"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the slider's\n    end, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_get_slider_range" gtk_range_get_slider_range :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    Ptr Int32 ->                            -- slider_start : TBasicType TInt
    Ptr Int32 ->                            -- slider_end : TBasicType TInt
    IO ()

-- | This function returns sliders range along the long dimension,
-- in widget->window coordinates.
-- 
-- This function is useful mainly for t'GI.Gtk.Objects.Range.Range' subclasses.
rangeGetSliderRange ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> m ((Int32, Int32))
rangeGetSliderRange :: a -> m (Int32, Int32)
rangeGetSliderRange a
range = IO (Int32, Int32) -> m (Int32, Int32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32) -> m (Int32, Int32))
-> IO (Int32, Int32) -> m (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    Ptr Int32
sliderStart <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
sliderEnd <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Range -> Ptr Int32 -> Ptr Int32 -> IO ()
gtk_range_get_slider_range Ptr Range
range' Ptr Int32
sliderStart Ptr Int32
sliderEnd
    Int32
sliderStart' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
sliderStart
    Int32
sliderEnd' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
sliderEnd
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
sliderStart
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
sliderEnd
    (Int32, Int32) -> IO (Int32, Int32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
sliderStart', Int32
sliderEnd')

#if defined(ENABLE_OVERLOADING)
data RangeGetSliderRangeMethodInfo
instance (signature ~ (m ((Int32, Int32))), MonadIO m, IsRange a) => O.MethodInfo RangeGetSliderRangeMethodInfo a signature where
    overloadedMethod = rangeGetSliderRange

#endif

-- method Range::get_slider_size_fixed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_get_slider_size_fixed" gtk_range_get_slider_size_fixed :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    IO CInt

-- | This function is useful mainly for t'GI.Gtk.Objects.Range.Range' subclasses.
-- 
-- See 'GI.Gtk.Objects.Range.rangeSetSliderSizeFixed'.
rangeGetSliderSizeFixed ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> m Bool
    -- ^ __Returns:__ whether the range’s slider has a fixed size.
rangeGetSliderSizeFixed :: a -> m Bool
rangeGetSliderSizeFixed a
range = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    CInt
result <- Ptr Range -> IO CInt
gtk_range_get_slider_size_fixed Ptr Range
range'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RangeGetSliderSizeFixedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsRange a) => O.MethodInfo RangeGetSliderSizeFixedMethodInfo a signature where
    overloadedMethod = rangeGetSliderSizeFixed

#endif

-- method Range::get_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_get_value" gtk_range_get_value :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    IO CDouble

-- | Gets the current value of the range.
rangeGetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> m Double
    -- ^ __Returns:__ current value of the range.
rangeGetValue :: a -> m Double
rangeGetValue a
range = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    CDouble
result <- Ptr Range -> IO CDouble
gtk_range_get_value Ptr Range
range'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data RangeGetValueMethodInfo
instance (signature ~ (m Double), MonadIO m, IsRange a) => O.MethodInfo RangeGetValueMethodInfo a signature where
    overloadedMethod = rangeGetValue

#endif

-- method Range::set_adjustment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAdjustment" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_set_adjustment" gtk_range_set_adjustment :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    Ptr Gtk.Adjustment.Adjustment ->        -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    IO ()

-- | Sets the adjustment to be used as the “model” object for this range
-- widget. The adjustment indicates the current range value, the
-- minimum and maximum range values, the step\/page increments used
-- for keybindings and scrolling, and the page size. The page size
-- is normally 0 for t'GI.Gtk.Objects.Scale.Scale' and nonzero for t'GI.Gtk.Objects.Scrollbar.Scrollbar', and
-- indicates the size of the visible area of the widget being scrolled.
-- The page size affects the size of the scrollbar slider.
rangeSetAdjustment ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a, Gtk.Adjustment.IsAdjustment b) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> b
    -- ^ /@adjustment@/: a t'GI.Gtk.Objects.Adjustment.Adjustment'
    -> m ()
rangeSetAdjustment :: a -> b -> m ()
rangeSetAdjustment a
range b
adjustment = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    Ptr Adjustment
adjustment' <- b -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
adjustment
    Ptr Range -> Ptr Adjustment -> IO ()
gtk_range_set_adjustment Ptr Range
range' Ptr Adjustment
adjustment'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
adjustment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RangeSetAdjustmentMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsRange a, Gtk.Adjustment.IsAdjustment b) => O.MethodInfo RangeSetAdjustmentMethodInfo a signature where
    overloadedMethod = rangeSetAdjustment

#endif

-- method Range::set_fill_level
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fill_level"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new position of the fill level indicator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_set_fill_level" gtk_range_set_fill_level :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    CDouble ->                              -- fill_level : TBasicType TDouble
    IO ()

-- | Set the new position of the fill level indicator.
-- 
-- The “fill level” is probably best described by its most prominent
-- use case, which is an indicator for the amount of pre-buffering in
-- a streaming media player. In that use case, the value of the range
-- would indicate the current play position, and the fill level would
-- be the position up to which the file\/stream has been downloaded.
-- 
-- This amount of prebuffering can be displayed on the range’s trough
-- and is themeable separately from the trough. To enable fill level
-- display, use 'GI.Gtk.Objects.Range.rangeSetShowFillLevel'. The range defaults
-- to not showing the fill level.
-- 
-- Additionally, it’s possible to restrict the range’s slider position
-- to values which are smaller than the fill level. This is controller
-- by 'GI.Gtk.Objects.Range.rangeSetRestrictToFillLevel' and is by default
-- enabled.
rangeSetFillLevel ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> Double
    -- ^ /@fillLevel@/: the new position of the fill level indicator
    -> m ()
rangeSetFillLevel :: a -> Double -> m ()
rangeSetFillLevel a
range Double
fillLevel = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    let fillLevel' :: CDouble
fillLevel' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
fillLevel
    Ptr Range -> CDouble -> IO ()
gtk_range_set_fill_level Ptr Range
range' CDouble
fillLevel'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RangeSetFillLevelMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsRange a) => O.MethodInfo RangeSetFillLevelMethodInfo a signature where
    overloadedMethod = rangeSetFillLevel

#endif

-- method Range::set_flippable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flippable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to make the range flippable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_set_flippable" gtk_range_set_flippable :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    CInt ->                                 -- flippable : TBasicType TBoolean
    IO ()

-- | If a range is flippable, it will switch its direction if it is
-- horizontal and its direction is 'GI.Gtk.Enums.TextDirectionRtl'.
-- 
-- See 'GI.Gtk.Objects.Widget.widgetGetDirection'.
rangeSetFlippable ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> Bool
    -- ^ /@flippable@/: 'P.True' to make the range flippable
    -> m ()
rangeSetFlippable :: a -> Bool -> m ()
rangeSetFlippable a
range Bool
flippable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    let flippable' :: CInt
flippable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
flippable
    Ptr Range -> CInt -> IO ()
gtk_range_set_flippable Ptr Range
range' CInt
flippable'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RangeSetFlippableMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsRange a) => O.MethodInfo RangeSetFlippableMethodInfo a signature where
    overloadedMethod = rangeSetFlippable

#endif

-- method Range::set_increments
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "step"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "step size" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "page size" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_set_increments" gtk_range_set_increments :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    CDouble ->                              -- step : TBasicType TDouble
    CDouble ->                              -- page : TBasicType TDouble
    IO ()

-- | Sets the step and page sizes for the range.
-- The step size is used when the user clicks the t'GI.Gtk.Objects.Scrollbar.Scrollbar'
-- arrows or moves t'GI.Gtk.Objects.Scale.Scale' via arrow keys. The page size
-- is used for example when moving via Page Up or Page Down keys.
rangeSetIncrements ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> Double
    -- ^ /@step@/: step size
    -> Double
    -- ^ /@page@/: page size
    -> m ()
rangeSetIncrements :: a -> Double -> Double -> m ()
rangeSetIncrements a
range Double
step Double
page = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    let step' :: CDouble
step' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
step
    let page' :: CDouble
page' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
page
    Ptr Range -> CDouble -> CDouble -> IO ()
gtk_range_set_increments Ptr Range
range' CDouble
step' CDouble
page'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RangeSetIncrementsMethodInfo
instance (signature ~ (Double -> Double -> m ()), MonadIO m, IsRange a) => O.MethodInfo RangeSetIncrementsMethodInfo a signature where
    overloadedMethod = rangeSetIncrements

#endif

-- method Range::set_inverted
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "setting"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to invert the range"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_set_inverted" gtk_range_set_inverted :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    CInt ->                                 -- setting : TBasicType TBoolean
    IO ()

-- | Ranges normally move from lower to higher values as the
-- slider moves from top to bottom or left to right. Inverted
-- ranges have higher values at the top or on the right rather than
-- on the bottom or left.
rangeSetInverted ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> Bool
    -- ^ /@setting@/: 'P.True' to invert the range
    -> m ()
rangeSetInverted :: a -> Bool -> m ()
rangeSetInverted a
range Bool
setting = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    let setting' :: CInt
setting' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
setting
    Ptr Range -> CInt -> IO ()
gtk_range_set_inverted Ptr Range
range' CInt
setting'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RangeSetInvertedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsRange a) => O.MethodInfo RangeSetInvertedMethodInfo a signature where
    overloadedMethod = rangeSetInverted

#endif

-- method Range::set_range
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "minimum range value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "max"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "maximum range value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_set_range" gtk_range_set_range :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    CDouble ->                              -- min : TBasicType TDouble
    CDouble ->                              -- max : TBasicType TDouble
    IO ()

-- | Sets the allowable values in the t'GI.Gtk.Objects.Range.Range', and clamps the range
-- value to be between /@min@/ and /@max@/. (If the range has a non-zero
-- page size, it is clamped between /@min@/ and /@max@/ - page-size.)
rangeSetRange ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> Double
    -- ^ /@min@/: minimum range value
    -> Double
    -- ^ /@max@/: maximum range value
    -> m ()
rangeSetRange :: a -> Double -> Double -> m ()
rangeSetRange a
range Double
min Double
max = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    let min' :: CDouble
min' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
min
    let max' :: CDouble
max' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
max
    Ptr Range -> CDouble -> CDouble -> IO ()
gtk_range_set_range Ptr Range
range' CDouble
min' CDouble
max'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RangeSetRangeMethodInfo
instance (signature ~ (Double -> Double -> m ()), MonadIO m, IsRange a) => O.MethodInfo RangeSetRangeMethodInfo a signature where
    overloadedMethod = rangeSetRange

#endif

-- method Range::set_restrict_to_fill_level
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "restrict_to_fill_level"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Whether the fill level restricts slider movement."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_set_restrict_to_fill_level" gtk_range_set_restrict_to_fill_level :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    CInt ->                                 -- restrict_to_fill_level : TBasicType TBoolean
    IO ()

-- | Sets whether the slider is restricted to the fill level. See
-- 'GI.Gtk.Objects.Range.rangeSetFillLevel' for a general description of the fill
-- level concept.
rangeSetRestrictToFillLevel ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: A t'GI.Gtk.Objects.Range.Range'
    -> Bool
    -- ^ /@restrictToFillLevel@/: Whether the fill level restricts slider movement.
    -> m ()
rangeSetRestrictToFillLevel :: a -> Bool -> m ()
rangeSetRestrictToFillLevel a
range Bool
restrictToFillLevel = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    let restrictToFillLevel' :: CInt
restrictToFillLevel' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
restrictToFillLevel
    Ptr Range -> CInt -> IO ()
gtk_range_set_restrict_to_fill_level Ptr Range
range' CInt
restrictToFillLevel'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RangeSetRestrictToFillLevelMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsRange a) => O.MethodInfo RangeSetRestrictToFillLevelMethodInfo a signature where
    overloadedMethod = rangeSetRestrictToFillLevel

#endif

-- method Range::set_round_digits
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "round_digits"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the precision in digits, or -1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_set_round_digits" gtk_range_set_round_digits :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    Int32 ->                                -- round_digits : TBasicType TInt
    IO ()

-- | Sets the number of digits to round the value to when
-- it changes. See [changeValue]("GI.Gtk.Objects.Range#g:signal:changeValue").
rangeSetRoundDigits ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> Int32
    -- ^ /@roundDigits@/: the precision in digits, or -1
    -> m ()
rangeSetRoundDigits :: a -> Int32 -> m ()
rangeSetRoundDigits a
range Int32
roundDigits = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    Ptr Range -> Int32 -> IO ()
gtk_range_set_round_digits Ptr Range
range' Int32
roundDigits
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RangeSetRoundDigitsMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsRange a) => O.MethodInfo RangeSetRoundDigitsMethodInfo a signature where
    overloadedMethod = rangeSetRoundDigits

#endif

-- method Range::set_show_fill_level
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "show_fill_level"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Whether a fill level indicator graphics is shown."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_set_show_fill_level" gtk_range_set_show_fill_level :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    CInt ->                                 -- show_fill_level : TBasicType TBoolean
    IO ()

-- | Sets whether a graphical fill level is show on the trough. See
-- 'GI.Gtk.Objects.Range.rangeSetFillLevel' for a general description of the fill
-- level concept.
rangeSetShowFillLevel ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: A t'GI.Gtk.Objects.Range.Range'
    -> Bool
    -- ^ /@showFillLevel@/: Whether a fill level indicator graphics is shown.
    -> m ()
rangeSetShowFillLevel :: a -> Bool -> m ()
rangeSetShowFillLevel a
range Bool
showFillLevel = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    let showFillLevel' :: CInt
showFillLevel' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
showFillLevel
    Ptr Range -> CInt -> IO ()
gtk_range_set_show_fill_level Ptr Range
range' CInt
showFillLevel'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RangeSetShowFillLevelMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsRange a) => O.MethodInfo RangeSetShowFillLevelMethodInfo a signature where
    overloadedMethod = rangeSetShowFillLevel

#endif

-- method Range::set_slider_size_fixed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size_fixed"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to make the slider size constant"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_set_slider_size_fixed" gtk_range_set_slider_size_fixed :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    CInt ->                                 -- size_fixed : TBasicType TBoolean
    IO ()

-- | Sets whether the range’s slider has a fixed size, or a size that
-- depends on its adjustment’s page size.
-- 
-- This function is useful mainly for t'GI.Gtk.Objects.Range.Range' subclasses.
rangeSetSliderSizeFixed ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> Bool
    -- ^ /@sizeFixed@/: 'P.True' to make the slider size constant
    -> m ()
rangeSetSliderSizeFixed :: a -> Bool -> m ()
rangeSetSliderSizeFixed a
range Bool
sizeFixed = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    let sizeFixed' :: CInt
sizeFixed' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
sizeFixed
    Ptr Range -> CInt -> IO ()
gtk_range_set_slider_size_fixed Ptr Range
range' CInt
sizeFixed'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RangeSetSliderSizeFixedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsRange a) => O.MethodInfo RangeSetSliderSizeFixedMethodInfo a signature where
    overloadedMethod = rangeSetSliderSizeFixed

#endif

-- method Range::set_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "range"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Range" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkRange" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new value of the range"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_range_set_value" gtk_range_set_value :: 
    Ptr Range ->                            -- range : TInterface (Name {namespace = "Gtk", name = "Range"})
    CDouble ->                              -- value : TBasicType TDouble
    IO ()

-- | Sets the current value of the range; if the value is outside the
-- minimum or maximum range values, it will be clamped to fit inside
-- them. The range emits the [valueChanged]("GI.Gtk.Objects.Range#g:signal:valueChanged") signal if the
-- value changes.
rangeSetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsRange a) =>
    a
    -- ^ /@range@/: a t'GI.Gtk.Objects.Range.Range'
    -> Double
    -- ^ /@value@/: new value of the range
    -> m ()
rangeSetValue :: a -> Double -> m ()
rangeSetValue a
range Double
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Range
range' <- a -> IO (Ptr Range)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
range
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    Ptr Range -> CDouble -> IO ()
gtk_range_set_value Ptr Range
range' CDouble
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
range
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RangeSetValueMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsRange a) => O.MethodInfo RangeSetValueMethodInfo a signature where
    overloadedMethod = rangeSetValue

#endif