{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkViewport@ implements scrollability for widgets that lack their
-- own scrolling capabilities.
-- 
-- Use @GtkViewport@ to scroll child widgets such as @GtkGrid@,
-- @GtkBox@, and so on.
-- 
-- The @GtkViewport@ will start scrolling content only if allocated
-- less than the child widget’s minimum size in a given orientation.
-- 
-- = CSS nodes
-- 
-- @GtkViewport@ has a single CSS node with name @viewport@.
-- 
-- = Accessibility
-- 
-- @GtkViewport@ uses the 'GI.Gtk.Enums.AccessibleRoleGroup' role.

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

module GI.Gtk.Objects.Viewport
    ( 

-- * Exported types
    Viewport(..)                            ,
    IsViewport                              ,
    toViewport                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [actionSetEnabled]("GI.Gtk.Objects.Widget#g:method:actionSetEnabled"), [activate]("GI.Gtk.Objects.Widget#g:method:activate"), [activateAction]("GI.Gtk.Objects.Widget#g:method:activateAction"), [activateDefault]("GI.Gtk.Objects.Widget#g:method:activateDefault"), [addController]("GI.Gtk.Objects.Widget#g:method:addController"), [addCssClass]("GI.Gtk.Objects.Widget#g:method:addCssClass"), [addMnemonicLabel]("GI.Gtk.Objects.Widget#g:method:addMnemonicLabel"), [addTickCallback]("GI.Gtk.Objects.Widget#g:method:addTickCallback"), [allocate]("GI.Gtk.Objects.Widget#g:method:allocate"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [childFocus]("GI.Gtk.Objects.Widget#g:method:childFocus"), [computeBounds]("GI.Gtk.Objects.Widget#g:method:computeBounds"), [computeExpand]("GI.Gtk.Objects.Widget#g:method:computeExpand"), [computePoint]("GI.Gtk.Objects.Widget#g:method:computePoint"), [computeTransform]("GI.Gtk.Objects.Widget#g:method:computeTransform"), [contains]("GI.Gtk.Objects.Widget#g:method:contains"), [createPangoContext]("GI.Gtk.Objects.Widget#g:method:createPangoContext"), [createPangoLayout]("GI.Gtk.Objects.Widget#g:method:createPangoLayout"), [disposeTemplate]("GI.Gtk.Objects.Widget#g:method:disposeTemplate"), [dragCheckThreshold]("GI.Gtk.Objects.Widget#g:method:dragCheckThreshold"), [errorBell]("GI.Gtk.Objects.Widget#g:method:errorBell"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [grabFocus]("GI.Gtk.Objects.Widget#g:method:grabFocus"), [hasCssClass]("GI.Gtk.Objects.Widget#g:method:hasCssClass"), [hasDefault]("GI.Gtk.Objects.Widget#g:method:hasDefault"), [hasFocus]("GI.Gtk.Objects.Widget#g:method:hasFocus"), [hasVisibleFocus]("GI.Gtk.Objects.Widget#g:method:hasVisibleFocus"), [hide]("GI.Gtk.Objects.Widget#g:method:hide"), [inDestruction]("GI.Gtk.Objects.Widget#g:method:inDestruction"), [initTemplate]("GI.Gtk.Objects.Widget#g:method:initTemplate"), [insertActionGroup]("GI.Gtk.Objects.Widget#g:method:insertActionGroup"), [insertAfter]("GI.Gtk.Objects.Widget#g:method:insertAfter"), [insertBefore]("GI.Gtk.Objects.Widget#g:method:insertBefore"), [isAncestor]("GI.Gtk.Objects.Widget#g:method:isAncestor"), [isDrawable]("GI.Gtk.Objects.Widget#g:method:isDrawable"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isFocus]("GI.Gtk.Objects.Widget#g:method:isFocus"), [isSensitive]("GI.Gtk.Objects.Widget#g:method:isSensitive"), [isVisible]("GI.Gtk.Objects.Widget#g:method:isVisible"), [keynavFailed]("GI.Gtk.Objects.Widget#g:method:keynavFailed"), [listMnemonicLabels]("GI.Gtk.Objects.Widget#g:method:listMnemonicLabels"), [map]("GI.Gtk.Objects.Widget#g:method:map"), [measure]("GI.Gtk.Objects.Widget#g:method:measure"), [mnemonicActivate]("GI.Gtk.Objects.Widget#g:method:mnemonicActivate"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [observeChildren]("GI.Gtk.Objects.Widget#g:method:observeChildren"), [observeControllers]("GI.Gtk.Objects.Widget#g:method:observeControllers"), [pick]("GI.Gtk.Objects.Widget#g:method:pick"), [queueAllocate]("GI.Gtk.Objects.Widget#g:method:queueAllocate"), [queueDraw]("GI.Gtk.Objects.Widget#g:method:queueDraw"), [queueResize]("GI.Gtk.Objects.Widget#g:method:queueResize"), [realize]("GI.Gtk.Objects.Widget#g:method:realize"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeController]("GI.Gtk.Objects.Widget#g:method:removeController"), [removeCssClass]("GI.Gtk.Objects.Widget#g:method:removeCssClass"), [removeMnemonicLabel]("GI.Gtk.Objects.Widget#g:method:removeMnemonicLabel"), [removeTickCallback]("GI.Gtk.Objects.Widget#g:method:removeTickCallback"), [resetProperty]("GI.Gtk.Interfaces.Accessible#g:method:resetProperty"), [resetRelation]("GI.Gtk.Interfaces.Accessible#g:method:resetRelation"), [resetState]("GI.Gtk.Interfaces.Accessible#g:method:resetState"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [shouldLayout]("GI.Gtk.Objects.Widget#g:method:shouldLayout"), [show]("GI.Gtk.Objects.Widget#g:method:show"), [sizeAllocate]("GI.Gtk.Objects.Widget#g:method:sizeAllocate"), [snapshotChild]("GI.Gtk.Objects.Widget#g:method:snapshotChild"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [translateCoordinates]("GI.Gtk.Objects.Widget#g:method:translateCoordinates"), [triggerTooltipQuery]("GI.Gtk.Objects.Widget#g:method:triggerTooltipQuery"), [unmap]("GI.Gtk.Objects.Widget#g:method:unmap"), [unparent]("GI.Gtk.Objects.Widget#g:method:unparent"), [unrealize]("GI.Gtk.Objects.Widget#g:method:unrealize"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [unsetStateFlags]("GI.Gtk.Objects.Widget#g:method:unsetStateFlags"), [updateNextAccessibleSibling]("GI.Gtk.Interfaces.Accessible#g:method:updateNextAccessibleSibling"), [updateProperty]("GI.Gtk.Interfaces.Accessible#g:method:updateProperty"), [updateRelation]("GI.Gtk.Interfaces.Accessible#g:method:updateRelation"), [updateState]("GI.Gtk.Interfaces.Accessible#g:method:updateState"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAccessibleParent]("GI.Gtk.Interfaces.Accessible#g:method:getAccessibleParent"), [getAccessibleRole]("GI.Gtk.Interfaces.Accessible#g:method:getAccessibleRole"), [getAllocatedBaseline]("GI.Gtk.Objects.Widget#g:method:getAllocatedBaseline"), [getAllocatedHeight]("GI.Gtk.Objects.Widget#g:method:getAllocatedHeight"), [getAllocatedWidth]("GI.Gtk.Objects.Widget#g:method:getAllocatedWidth"), [getAllocation]("GI.Gtk.Objects.Widget#g:method:getAllocation"), [getAncestor]("GI.Gtk.Objects.Widget#g:method:getAncestor"), [getAtContext]("GI.Gtk.Interfaces.Accessible#g:method:getAtContext"), [getBorder]("GI.Gtk.Interfaces.Scrollable#g:method:getBorder"), [getBounds]("GI.Gtk.Interfaces.Accessible#g:method:getBounds"), [getBuildableId]("GI.Gtk.Interfaces.Buildable#g:method:getBuildableId"), [getCanFocus]("GI.Gtk.Objects.Widget#g:method:getCanFocus"), [getCanTarget]("GI.Gtk.Objects.Widget#g:method:getCanTarget"), [getChild]("GI.Gtk.Objects.Viewport#g:method:getChild"), [getChildVisible]("GI.Gtk.Objects.Widget#g:method:getChildVisible"), [getClipboard]("GI.Gtk.Objects.Widget#g:method:getClipboard"), [getColor]("GI.Gtk.Objects.Widget#g:method:getColor"), [getCssClasses]("GI.Gtk.Objects.Widget#g:method:getCssClasses"), [getCssName]("GI.Gtk.Objects.Widget#g:method:getCssName"), [getCursor]("GI.Gtk.Objects.Widget#g:method:getCursor"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDirection]("GI.Gtk.Objects.Widget#g:method:getDirection"), [getDisplay]("GI.Gtk.Objects.Widget#g:method:getDisplay"), [getFirstAccessibleChild]("GI.Gtk.Interfaces.Accessible#g:method:getFirstAccessibleChild"), [getFirstChild]("GI.Gtk.Objects.Widget#g:method:getFirstChild"), [getFocusChild]("GI.Gtk.Objects.Widget#g:method:getFocusChild"), [getFocusOnClick]("GI.Gtk.Objects.Widget#g:method:getFocusOnClick"), [getFocusable]("GI.Gtk.Objects.Widget#g:method:getFocusable"), [getFontMap]("GI.Gtk.Objects.Widget#g:method:getFontMap"), [getFontOptions]("GI.Gtk.Objects.Widget#g:method:getFontOptions"), [getFrameClock]("GI.Gtk.Objects.Widget#g:method:getFrameClock"), [getHadjustment]("GI.Gtk.Interfaces.Scrollable#g:method:getHadjustment"), [getHalign]("GI.Gtk.Objects.Widget#g:method:getHalign"), [getHasTooltip]("GI.Gtk.Objects.Widget#g:method:getHasTooltip"), [getHeight]("GI.Gtk.Objects.Widget#g:method:getHeight"), [getHexpand]("GI.Gtk.Objects.Widget#g:method:getHexpand"), [getHexpandSet]("GI.Gtk.Objects.Widget#g:method:getHexpandSet"), [getHscrollPolicy]("GI.Gtk.Interfaces.Scrollable#g:method:getHscrollPolicy"), [getLastChild]("GI.Gtk.Objects.Widget#g:method:getLastChild"), [getLayoutManager]("GI.Gtk.Objects.Widget#g:method:getLayoutManager"), [getMapped]("GI.Gtk.Objects.Widget#g:method:getMapped"), [getMarginBottom]("GI.Gtk.Objects.Widget#g:method:getMarginBottom"), [getMarginEnd]("GI.Gtk.Objects.Widget#g:method:getMarginEnd"), [getMarginStart]("GI.Gtk.Objects.Widget#g:method:getMarginStart"), [getMarginTop]("GI.Gtk.Objects.Widget#g:method:getMarginTop"), [getName]("GI.Gtk.Objects.Widget#g:method:getName"), [getNative]("GI.Gtk.Objects.Widget#g:method:getNative"), [getNextAccessibleSibling]("GI.Gtk.Interfaces.Accessible#g:method:getNextAccessibleSibling"), [getNextSibling]("GI.Gtk.Objects.Widget#g:method:getNextSibling"), [getOpacity]("GI.Gtk.Objects.Widget#g:method:getOpacity"), [getOverflow]("GI.Gtk.Objects.Widget#g:method:getOverflow"), [getPangoContext]("GI.Gtk.Objects.Widget#g:method:getPangoContext"), [getParent]("GI.Gtk.Objects.Widget#g:method:getParent"), [getPlatformState]("GI.Gtk.Interfaces.Accessible#g:method:getPlatformState"), [getPreferredSize]("GI.Gtk.Objects.Widget#g:method:getPreferredSize"), [getPrevSibling]("GI.Gtk.Objects.Widget#g:method:getPrevSibling"), [getPrimaryClipboard]("GI.Gtk.Objects.Widget#g:method:getPrimaryClipboard"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRealized]("GI.Gtk.Objects.Widget#g:method:getRealized"), [getReceivesDefault]("GI.Gtk.Objects.Widget#g:method:getReceivesDefault"), [getRequestMode]("GI.Gtk.Objects.Widget#g:method:getRequestMode"), [getRoot]("GI.Gtk.Objects.Widget#g:method:getRoot"), [getScaleFactor]("GI.Gtk.Objects.Widget#g:method:getScaleFactor"), [getScrollToFocus]("GI.Gtk.Objects.Viewport#g:method:getScrollToFocus"), [getSensitive]("GI.Gtk.Objects.Widget#g:method:getSensitive"), [getSettings]("GI.Gtk.Objects.Widget#g:method:getSettings"), [getSize]("GI.Gtk.Objects.Widget#g:method:getSize"), [getSizeRequest]("GI.Gtk.Objects.Widget#g:method:getSizeRequest"), [getStateFlags]("GI.Gtk.Objects.Widget#g:method:getStateFlags"), [getStyleContext]("GI.Gtk.Objects.Widget#g:method:getStyleContext"), [getTemplateChild]("GI.Gtk.Objects.Widget#g:method:getTemplateChild"), [getTooltipMarkup]("GI.Gtk.Objects.Widget#g:method:getTooltipMarkup"), [getTooltipText]("GI.Gtk.Objects.Widget#g:method:getTooltipText"), [getVadjustment]("GI.Gtk.Interfaces.Scrollable#g:method:getVadjustment"), [getValign]("GI.Gtk.Objects.Widget#g:method:getValign"), [getVexpand]("GI.Gtk.Objects.Widget#g:method:getVexpand"), [getVexpandSet]("GI.Gtk.Objects.Widget#g:method:getVexpandSet"), [getVisible]("GI.Gtk.Objects.Widget#g:method:getVisible"), [getVscrollPolicy]("GI.Gtk.Interfaces.Scrollable#g:method:getVscrollPolicy"), [getWidth]("GI.Gtk.Objects.Widget#g:method:getWidth").
-- 
-- ==== Setters
-- [setAccessibleParent]("GI.Gtk.Interfaces.Accessible#g:method:setAccessibleParent"), [setCanFocus]("GI.Gtk.Objects.Widget#g:method:setCanFocus"), [setCanTarget]("GI.Gtk.Objects.Widget#g:method:setCanTarget"), [setChild]("GI.Gtk.Objects.Viewport#g:method:setChild"), [setChildVisible]("GI.Gtk.Objects.Widget#g:method:setChildVisible"), [setCssClasses]("GI.Gtk.Objects.Widget#g:method:setCssClasses"), [setCursor]("GI.Gtk.Objects.Widget#g:method:setCursor"), [setCursorFromName]("GI.Gtk.Objects.Widget#g:method:setCursorFromName"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDirection]("GI.Gtk.Objects.Widget#g:method:setDirection"), [setFocusChild]("GI.Gtk.Objects.Widget#g:method:setFocusChild"), [setFocusOnClick]("GI.Gtk.Objects.Widget#g:method:setFocusOnClick"), [setFocusable]("GI.Gtk.Objects.Widget#g:method:setFocusable"), [setFontMap]("GI.Gtk.Objects.Widget#g:method:setFontMap"), [setFontOptions]("GI.Gtk.Objects.Widget#g:method:setFontOptions"), [setHadjustment]("GI.Gtk.Interfaces.Scrollable#g:method:setHadjustment"), [setHalign]("GI.Gtk.Objects.Widget#g:method:setHalign"), [setHasTooltip]("GI.Gtk.Objects.Widget#g:method:setHasTooltip"), [setHexpand]("GI.Gtk.Objects.Widget#g:method:setHexpand"), [setHexpandSet]("GI.Gtk.Objects.Widget#g:method:setHexpandSet"), [setHscrollPolicy]("GI.Gtk.Interfaces.Scrollable#g:method:setHscrollPolicy"), [setLayoutManager]("GI.Gtk.Objects.Widget#g:method:setLayoutManager"), [setMarginBottom]("GI.Gtk.Objects.Widget#g:method:setMarginBottom"), [setMarginEnd]("GI.Gtk.Objects.Widget#g:method:setMarginEnd"), [setMarginStart]("GI.Gtk.Objects.Widget#g:method:setMarginStart"), [setMarginTop]("GI.Gtk.Objects.Widget#g:method:setMarginTop"), [setName]("GI.Gtk.Objects.Widget#g:method:setName"), [setOpacity]("GI.Gtk.Objects.Widget#g:method:setOpacity"), [setOverflow]("GI.Gtk.Objects.Widget#g:method:setOverflow"), [setParent]("GI.Gtk.Objects.Widget#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setReceivesDefault]("GI.Gtk.Objects.Widget#g:method:setReceivesDefault"), [setScrollToFocus]("GI.Gtk.Objects.Viewport#g:method:setScrollToFocus"), [setSensitive]("GI.Gtk.Objects.Widget#g:method:setSensitive"), [setSizeRequest]("GI.Gtk.Objects.Widget#g:method:setSizeRequest"), [setStateFlags]("GI.Gtk.Objects.Widget#g:method:setStateFlags"), [setTooltipMarkup]("GI.Gtk.Objects.Widget#g:method:setTooltipMarkup"), [setTooltipText]("GI.Gtk.Objects.Widget#g:method:setTooltipText"), [setVadjustment]("GI.Gtk.Interfaces.Scrollable#g:method:setVadjustment"), [setValign]("GI.Gtk.Objects.Widget#g:method:setValign"), [setVexpand]("GI.Gtk.Objects.Widget#g:method:setVexpand"), [setVexpandSet]("GI.Gtk.Objects.Widget#g:method:setVexpandSet"), [setVisible]("GI.Gtk.Objects.Widget#g:method:setVisible"), [setVscrollPolicy]("GI.Gtk.Interfaces.Scrollable#g:method:setVscrollPolicy").

#if defined(ENABLE_OVERLOADING)
    ResolveViewportMethod                   ,
#endif

-- ** getChild #method:getChild#

#if defined(ENABLE_OVERLOADING)
    ViewportGetChildMethodInfo              ,
#endif
    viewportGetChild                        ,


-- ** getScrollToFocus #method:getScrollToFocus#

#if defined(ENABLE_OVERLOADING)
    ViewportGetScrollToFocusMethodInfo      ,
#endif
    viewportGetScrollToFocus                ,


-- ** new #method:new#

    viewportNew                             ,


-- ** setChild #method:setChild#

#if defined(ENABLE_OVERLOADING)
    ViewportSetChildMethodInfo              ,
#endif
    viewportSetChild                        ,


-- ** setScrollToFocus #method:setScrollToFocus#

#if defined(ENABLE_OVERLOADING)
    ViewportSetScrollToFocusMethodInfo      ,
#endif
    viewportSetScrollToFocus                ,




 -- * Properties


-- ** child #attr:child#
-- | The child widget.

#if defined(ENABLE_OVERLOADING)
    ViewportChildPropertyInfo               ,
#endif
    clearViewportChild                      ,
    constructViewportChild                  ,
    getViewportChild                        ,
    setViewportChild                        ,
#if defined(ENABLE_OVERLOADING)
    viewportChild                           ,
#endif


-- ** scrollToFocus #attr:scrollToFocus#
-- | Whether to scroll when the focus changes.
-- 
-- Before 4.6.2, this property was mistakenly defaulting to FALSE, so if your
-- code needs to work with older versions, consider setting it explicitly to
-- TRUE.

#if defined(ENABLE_OVERLOADING)
    ViewportScrollToFocusPropertyInfo       ,
#endif
    constructViewportScrollToFocus          ,
    getViewportScrollToFocus                ,
    setViewportScrollToFocus                ,
#if defined(ENABLE_OVERLOADING)
    viewportScrollToFocus                   ,
#endif




    ) 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.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
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.Scrollable as Gtk.Scrollable
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 Viewport = Viewport (SP.ManagedPtr Viewport)
    deriving (Viewport -> Viewport -> Bool
(Viewport -> Viewport -> Bool)
-> (Viewport -> Viewport -> Bool) -> Eq Viewport
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Viewport -> Viewport -> Bool
== :: Viewport -> Viewport -> Bool
$c/= :: Viewport -> Viewport -> Bool
/= :: Viewport -> Viewport -> Bool
Eq)

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

foreign import ccall "gtk_viewport_get_type"
    c_gtk_viewport_get_type :: IO B.Types.GType

instance B.Types.TypedObject Viewport where
    glibType :: IO GType
glibType = IO GType
c_gtk_viewport_get_type

instance B.Types.GObject Viewport

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

instance O.HasParentTypes Viewport
type instance O.ParentTypes Viewport = '[Gtk.Widget.Widget, GObject.Object.Object, Gtk.Accessible.Accessible, Gtk.Buildable.Buildable, Gtk.ConstraintTarget.ConstraintTarget, Gtk.Scrollable.Scrollable]

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

-- | Convert 'Viewport' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Viewport) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_viewport_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Viewport -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Viewport
P.Nothing = Ptr GValue -> Ptr Viewport -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Viewport
forall a. Ptr a
FP.nullPtr :: FP.Ptr Viewport)
    gvalueSet_ Ptr GValue
gv (P.Just Viewport
obj) = Viewport -> (Ptr Viewport -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Viewport
obj (Ptr GValue -> Ptr Viewport -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Viewport)
gvalueGet_ Ptr GValue
gv = do
        Ptr Viewport
ptr <- Ptr GValue -> IO (Ptr Viewport)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Viewport)
        if Ptr Viewport
ptr Ptr Viewport -> Ptr Viewport -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Viewport
forall a. Ptr a
FP.nullPtr
        then Viewport -> Maybe Viewport
forall a. a -> Maybe a
P.Just (Viewport -> Maybe Viewport) -> IO Viewport -> IO (Maybe Viewport)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Viewport -> Viewport) -> Ptr Viewport -> IO Viewport
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Viewport -> Viewport
Viewport Ptr Viewport
ptr
        else Maybe Viewport -> IO (Maybe Viewport)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Viewport
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveViewportMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveViewportMethod "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
    ResolveViewportMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveViewportMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveViewportMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveViewportMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveViewportMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
    ResolveViewportMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveViewportMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveViewportMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveViewportMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveViewportMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveViewportMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveViewportMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveViewportMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveViewportMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveViewportMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveViewportMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveViewportMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveViewportMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveViewportMethod "disposeTemplate" o = Gtk.Widget.WidgetDisposeTemplateMethodInfo
    ResolveViewportMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveViewportMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveViewportMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveViewportMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveViewportMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveViewportMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveViewportMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
    ResolveViewportMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveViewportMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveViewportMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolveViewportMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolveViewportMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolveViewportMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolveViewportMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolveViewportMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolveViewportMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolveViewportMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolveViewportMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolveViewportMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveViewportMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolveViewportMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolveViewportMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveViewportMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveViewportMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolveViewportMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolveViewportMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolveViewportMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolveViewportMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveViewportMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveViewportMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolveViewportMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolveViewportMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveViewportMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveViewportMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveViewportMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveViewportMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveViewportMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveViewportMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveViewportMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveViewportMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
    ResolveViewportMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveViewportMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveViewportMethod "resetProperty" o = Gtk.Accessible.AccessibleResetPropertyMethodInfo
    ResolveViewportMethod "resetRelation" o = Gtk.Accessible.AccessibleResetRelationMethodInfo
    ResolveViewportMethod "resetState" o = Gtk.Accessible.AccessibleResetStateMethodInfo
    ResolveViewportMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveViewportMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
    ResolveViewportMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolveViewportMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolveViewportMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolveViewportMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveViewportMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveViewportMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveViewportMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolveViewportMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolveViewportMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolveViewportMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolveViewportMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolveViewportMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveViewportMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveViewportMethod "updateNextAccessibleSibling" o = Gtk.Accessible.AccessibleUpdateNextAccessibleSiblingMethodInfo
    ResolveViewportMethod "updateProperty" o = Gtk.Accessible.AccessibleUpdatePropertyMethodInfo
    ResolveViewportMethod "updateRelation" o = Gtk.Accessible.AccessibleUpdateRelationMethodInfo
    ResolveViewportMethod "updateState" o = Gtk.Accessible.AccessibleUpdateStateMethodInfo
    ResolveViewportMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveViewportMethod "getAccessibleParent" o = Gtk.Accessible.AccessibleGetAccessibleParentMethodInfo
    ResolveViewportMethod "getAccessibleRole" o = Gtk.Accessible.AccessibleGetAccessibleRoleMethodInfo
    ResolveViewportMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolveViewportMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolveViewportMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolveViewportMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolveViewportMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolveViewportMethod "getAtContext" o = Gtk.Accessible.AccessibleGetAtContextMethodInfo
    ResolveViewportMethod "getBorder" o = Gtk.Scrollable.ScrollableGetBorderMethodInfo
    ResolveViewportMethod "getBounds" o = Gtk.Accessible.AccessibleGetBoundsMethodInfo
    ResolveViewportMethod "getBuildableId" o = Gtk.Buildable.BuildableGetBuildableIdMethodInfo
    ResolveViewportMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolveViewportMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolveViewportMethod "getChild" o = ViewportGetChildMethodInfo
    ResolveViewportMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolveViewportMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolveViewportMethod "getColor" o = Gtk.Widget.WidgetGetColorMethodInfo
    ResolveViewportMethod "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
    ResolveViewportMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
    ResolveViewportMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveViewportMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveViewportMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveViewportMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveViewportMethod "getFirstAccessibleChild" o = Gtk.Accessible.AccessibleGetFirstAccessibleChildMethodInfo
    ResolveViewportMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveViewportMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveViewportMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveViewportMethod "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
    ResolveViewportMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolveViewportMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolveViewportMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolveViewportMethod "getHadjustment" o = Gtk.Scrollable.ScrollableGetHadjustmentMethodInfo
    ResolveViewportMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolveViewportMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveViewportMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveViewportMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveViewportMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolveViewportMethod "getHscrollPolicy" o = Gtk.Scrollable.ScrollableGetHscrollPolicyMethodInfo
    ResolveViewportMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveViewportMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveViewportMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolveViewportMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolveViewportMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolveViewportMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolveViewportMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolveViewportMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveViewportMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
    ResolveViewportMethod "getNextAccessibleSibling" o = Gtk.Accessible.AccessibleGetNextAccessibleSiblingMethodInfo
    ResolveViewportMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolveViewportMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolveViewportMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolveViewportMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolveViewportMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolveViewportMethod "getPlatformState" o = Gtk.Accessible.AccessibleGetPlatformStateMethodInfo
    ResolveViewportMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolveViewportMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolveViewportMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolveViewportMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveViewportMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveViewportMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolveViewportMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolveViewportMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolveViewportMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolveViewportMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolveViewportMethod "getScrollToFocus" o = ViewportGetScrollToFocusMethodInfo
    ResolveViewportMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolveViewportMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolveViewportMethod "getSize" o = Gtk.Widget.WidgetGetSizeMethodInfo
    ResolveViewportMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveViewportMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveViewportMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveViewportMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveViewportMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveViewportMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolveViewportMethod "getVadjustment" o = Gtk.Scrollable.ScrollableGetVadjustmentMethodInfo
    ResolveViewportMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolveViewportMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolveViewportMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolveViewportMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolveViewportMethod "getVscrollPolicy" o = Gtk.Scrollable.ScrollableGetVscrollPolicyMethodInfo
    ResolveViewportMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolveViewportMethod "setAccessibleParent" o = Gtk.Accessible.AccessibleSetAccessibleParentMethodInfo
    ResolveViewportMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveViewportMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveViewportMethod "setChild" o = ViewportSetChildMethodInfo
    ResolveViewportMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveViewportMethod "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
    ResolveViewportMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolveViewportMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolveViewportMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveViewportMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveViewportMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolveViewportMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveViewportMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveViewportMethod "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
    ResolveViewportMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveViewportMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveViewportMethod "setHadjustment" o = Gtk.Scrollable.ScrollableSetHadjustmentMethodInfo
    ResolveViewportMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveViewportMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolveViewportMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolveViewportMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolveViewportMethod "setHscrollPolicy" o = Gtk.Scrollable.ScrollableSetHscrollPolicyMethodInfo
    ResolveViewportMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolveViewportMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolveViewportMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolveViewportMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolveViewportMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolveViewportMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolveViewportMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolveViewportMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolveViewportMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolveViewportMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveViewportMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolveViewportMethod "setScrollToFocus" o = ViewportSetScrollToFocusMethodInfo
    ResolveViewportMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolveViewportMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolveViewportMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolveViewportMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveViewportMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveViewportMethod "setVadjustment" o = Gtk.Scrollable.ScrollableSetVadjustmentMethodInfo
    ResolveViewportMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolveViewportMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolveViewportMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolveViewportMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolveViewportMethod "setVscrollPolicy" o = Gtk.Scrollable.ScrollableSetVscrollPolicyMethodInfo
    ResolveViewportMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveViewportMethod t Viewport, O.OverloadedMethod info Viewport p, R.HasField t Viewport p) => R.HasField t Viewport p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveViewportMethod t Viewport, O.OverloadedMethodInfo info Viewport) => OL.IsLabel t (O.MethodProxy info Viewport) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- VVV Prop "child"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Widget"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@child@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructViewportChild :: (IsViewport o, MIO.MonadIO m, Gtk.Widget.IsWidget a) => a -> m (GValueConstruct o)
constructViewportChild :: forall o (m :: * -> *) a.
(IsViewport o, MonadIO m, IsWidget a) =>
a -> m (GValueConstruct o)
constructViewportChild a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (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
"child" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@child@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #child
-- @
clearViewportChild :: (MonadIO m, IsViewport o) => o -> m ()
clearViewportChild :: forall (m :: * -> *) o. (MonadIO m, IsViewport o) => o -> m ()
clearViewportChild o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Widget -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"child" (Maybe Widget
forall a. Maybe a
Nothing :: Maybe Gtk.Widget.Widget)

#if defined(ENABLE_OVERLOADING)
data ViewportChildPropertyInfo
instance AttrInfo ViewportChildPropertyInfo where
    type AttrAllowedOps ViewportChildPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ViewportChildPropertyInfo = IsViewport
    type AttrSetTypeConstraint ViewportChildPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint ViewportChildPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType ViewportChildPropertyInfo = Gtk.Widget.Widget
    type AttrGetType ViewportChildPropertyInfo = (Maybe Gtk.Widget.Widget)
    type AttrLabel ViewportChildPropertyInfo = "child"
    type AttrOrigin ViewportChildPropertyInfo = Viewport
    attrGet = getViewportChild
    attrSet = setViewportChild
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructViewportChild
    attrClear = clearViewportChild
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Viewport.child"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-Viewport.html#g:attr:child"
        })
#endif

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

-- | Get the value of the “@scroll-to-focus@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' viewport #scrollToFocus
-- @
getViewportScrollToFocus :: (MonadIO m, IsViewport o) => o -> m Bool
getViewportScrollToFocus :: forall (m :: * -> *) o. (MonadIO m, IsViewport o) => o -> m Bool
getViewportScrollToFocus o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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
"scroll-to-focus"

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

-- | Construct a `GValueConstruct` with valid value for the “@scroll-to-focus@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructViewportScrollToFocus :: (IsViewport o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructViewportScrollToFocus :: forall o (m :: * -> *).
(IsViewport o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructViewportScrollToFocus Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (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
"scroll-to-focus" Bool
val

#if defined(ENABLE_OVERLOADING)
data ViewportScrollToFocusPropertyInfo
instance AttrInfo ViewportScrollToFocusPropertyInfo where
    type AttrAllowedOps ViewportScrollToFocusPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ViewportScrollToFocusPropertyInfo = IsViewport
    type AttrSetTypeConstraint ViewportScrollToFocusPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ViewportScrollToFocusPropertyInfo = (~) Bool
    type AttrTransferType ViewportScrollToFocusPropertyInfo = Bool
    type AttrGetType ViewportScrollToFocusPropertyInfo = Bool
    type AttrLabel ViewportScrollToFocusPropertyInfo = "scroll-to-focus"
    type AttrOrigin ViewportScrollToFocusPropertyInfo = Viewport
    attrGet = getViewportScrollToFocus
    attrSet = setViewportScrollToFocus
    attrTransfer _ v = do
        return v
    attrConstruct = constructViewportScrollToFocus
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Viewport.scrollToFocus"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-Viewport.html#g:attr:scrollToFocus"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Viewport
type instance O.AttributeList Viewport = ViewportAttributeList
type ViewportAttributeList = ('[ '("accessibleRole", Gtk.Accessible.AccessibleAccessibleRolePropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("child", ViewportChildPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("hadjustment", Gtk.Scrollable.ScrollableHadjustmentPropertyInfo), '("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), '("hscrollPolicy", Gtk.Scrollable.ScrollableHscrollPolicyPropertyInfo), '("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), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("scrollToFocus", ViewportScrollToFocusPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("vadjustment", Gtk.Scrollable.ScrollableVadjustmentPropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("vscrollPolicy", Gtk.Scrollable.ScrollableVscrollPolicyPropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
viewportChild :: AttrLabelProxy "child"
viewportChild = AttrLabelProxy

viewportScrollToFocus :: AttrLabelProxy "scrollToFocus"
viewportScrollToFocus = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Viewport = ViewportSignalList
type ViewportSignalList = ('[ '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("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)] :: [(Symbol, DK.Type)])

#endif

-- method Viewport::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "hadjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "horizontal adjustment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vadjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "vertical adjustment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Viewport" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_viewport_new" gtk_viewport_new :: 
    Ptr Gtk.Adjustment.Adjustment ->        -- hadjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    Ptr Gtk.Adjustment.Adjustment ->        -- vadjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    IO (Ptr Viewport)

-- | Creates a new @GtkViewport@.
-- 
-- The new viewport uses the given adjustments, or default
-- adjustments if none are given.
viewportNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.Adjustment.IsAdjustment a, Gtk.Adjustment.IsAdjustment b) =>
    Maybe (a)
    -- ^ /@hadjustment@/: horizontal adjustment
    -> Maybe (b)
    -- ^ /@vadjustment@/: vertical adjustment
    -> m Viewport
    -- ^ __Returns:__ a new @GtkViewport@
viewportNew :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAdjustment a, IsAdjustment b) =>
Maybe a -> Maybe b -> m Viewport
viewportNew Maybe a
hadjustment Maybe b
vadjustment = IO Viewport -> m Viewport
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Viewport -> m Viewport) -> IO Viewport -> m Viewport
forall a b. (a -> b) -> a -> b
$ do
    Ptr Adjustment
maybeHadjustment <- case Maybe a
hadjustment of
        Maybe a
Nothing -> Ptr Adjustment -> IO (Ptr Adjustment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Adjustment
forall a. Ptr a
nullPtr
        Just a
jHadjustment -> do
            Ptr Adjustment
jHadjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jHadjustment
            Ptr Adjustment -> IO (Ptr Adjustment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Adjustment
jHadjustment'
    Ptr Adjustment
maybeVadjustment <- case Maybe b
vadjustment of
        Maybe b
Nothing -> Ptr Adjustment -> IO (Ptr Adjustment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Adjustment
forall a. Ptr a
nullPtr
        Just b
jVadjustment -> do
            Ptr Adjustment
jVadjustment' <- b -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jVadjustment
            Ptr Adjustment -> IO (Ptr Adjustment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Adjustment
jVadjustment'
    Ptr Viewport
result <- Ptr Adjustment -> Ptr Adjustment -> IO (Ptr Viewport)
gtk_viewport_new Ptr Adjustment
maybeHadjustment Ptr Adjustment
maybeVadjustment
    Text -> Ptr Viewport -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"viewportNew" Ptr Viewport
result
    Viewport
result' <- ((ManagedPtr Viewport -> Viewport) -> Ptr Viewport -> IO Viewport
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Viewport -> Viewport
Viewport) Ptr Viewport
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
hadjustment a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
vadjustment b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Viewport -> IO Viewport
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Viewport
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Viewport::get_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "viewport"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Viewport" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkViewport`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Widget" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_viewport_get_child" gtk_viewport_get_child :: 
    Ptr Viewport ->                         -- viewport : TInterface (Name {namespace = "Gtk", name = "Viewport"})
    IO (Ptr Gtk.Widget.Widget)

-- | Gets the child widget of /@viewport@/.
viewportGetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewport a) =>
    a
    -- ^ /@viewport@/: a @GtkViewport@
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ the child widget of /@viewport@/
viewportGetChild :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewport a) =>
a -> m (Maybe Widget)
viewportGetChild a
viewport = IO (Maybe Widget) -> m (Maybe Widget)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Viewport
viewport' <- a -> IO (Ptr Viewport)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
viewport
    Ptr Widget
result <- Ptr Viewport -> IO (Ptr Widget)
gtk_viewport_get_child Ptr Viewport
viewport'
    Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
result' -> do
        Widget
result'' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result'
        Widget -> IO Widget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
viewport
    Maybe Widget -> IO (Maybe Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data ViewportGetChildMethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsViewport a) => O.OverloadedMethod ViewportGetChildMethodInfo a signature where
    overloadedMethod = viewportGetChild

instance O.OverloadedMethodInfo ViewportGetChildMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Viewport.viewportGetChild",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-Viewport.html#v:viewportGetChild"
        })


#endif

-- method Viewport::get_scroll_to_focus
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "viewport"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Viewport" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkViewport`" , 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_viewport_get_scroll_to_focus" gtk_viewport_get_scroll_to_focus :: 
    Ptr Viewport ->                         -- viewport : TInterface (Name {namespace = "Gtk", name = "Viewport"})
    IO CInt

-- | Gets whether the viewport is scrolling to keep the focused
-- child in view.
viewportGetScrollToFocus ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewport a) =>
    a
    -- ^ /@viewport@/: a @GtkViewport@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the viewport keeps the focus child scrolled to view
viewportGetScrollToFocus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewport a) =>
a -> m Bool
viewportGetScrollToFocus a
viewport = IO Bool -> m Bool
forall a. IO a -> m a
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 Viewport
viewport' <- a -> IO (Ptr Viewport)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
viewport
    CInt
result <- Ptr Viewport -> IO CInt
gtk_viewport_get_scroll_to_focus Ptr Viewport
viewport'
    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
viewport
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ViewportGetScrollToFocusMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsViewport a) => O.OverloadedMethod ViewportGetScrollToFocusMethodInfo a signature where
    overloadedMethod = viewportGetScrollToFocus

instance O.OverloadedMethodInfo ViewportGetScrollToFocusMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Viewport.viewportGetScrollToFocus",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-Viewport.html#v:viewportGetScrollToFocus"
        })


#endif

-- method Viewport::set_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "viewport"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Viewport" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkViewport`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the child widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_viewport_set_child" gtk_viewport_set_child :: 
    Ptr Viewport ->                         -- viewport : TInterface (Name {namespace = "Gtk", name = "Viewport"})
    Ptr Gtk.Widget.Widget ->                -- child : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | Sets the child widget of /@viewport@/.
viewportSetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewport a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@viewport@/: a @GtkViewport@
    -> Maybe (b)
    -- ^ /@child@/: the child widget
    -> m ()
viewportSetChild :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsViewport a, IsWidget b) =>
a -> Maybe b -> m ()
viewportSetChild a
viewport Maybe b
child = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Viewport
viewport' <- a -> IO (Ptr Viewport)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
viewport
    Ptr Widget
maybeChild <- case Maybe b
child of
        Maybe b
Nothing -> Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
        Just b
jChild -> do
            Ptr Widget
jChild' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jChild
            Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jChild'
    Ptr Viewport -> Ptr Widget -> IO ()
gtk_viewport_set_child Ptr Viewport
viewport' Ptr Widget
maybeChild
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
viewport
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
child b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ViewportSetChildMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsViewport a, Gtk.Widget.IsWidget b) => O.OverloadedMethod ViewportSetChildMethodInfo a signature where
    overloadedMethod = viewportSetChild

instance O.OverloadedMethodInfo ViewportSetChildMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Viewport.viewportSetChild",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-Viewport.html#v:viewportSetChild"
        })


#endif

-- method Viewport::set_scroll_to_focus
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "viewport"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Viewport" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkViewport`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scroll_to_focus"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether to keep the focus widget scrolled to view"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_viewport_set_scroll_to_focus" gtk_viewport_set_scroll_to_focus :: 
    Ptr Viewport ->                         -- viewport : TInterface (Name {namespace = "Gtk", name = "Viewport"})
    CInt ->                                 -- scroll_to_focus : TBasicType TBoolean
    IO ()

-- | Sets whether the viewport should automatically scroll
-- to keep the focused child in view.
viewportSetScrollToFocus ::
    (B.CallStack.HasCallStack, MonadIO m, IsViewport a) =>
    a
    -- ^ /@viewport@/: a @GtkViewport@
    -> Bool
    -- ^ /@scrollToFocus@/: whether to keep the focus widget scrolled to view
    -> m ()
viewportSetScrollToFocus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsViewport a) =>
a -> Bool -> m ()
viewportSetScrollToFocus a
viewport Bool
scrollToFocus = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Viewport
viewport' <- a -> IO (Ptr Viewport)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
viewport
    let scrollToFocus' :: CInt
scrollToFocus' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
scrollToFocus
    Ptr Viewport -> CInt -> IO ()
gtk_viewport_set_scroll_to_focus Ptr Viewport
viewport' CInt
scrollToFocus'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
viewport
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ViewportSetScrollToFocusMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsViewport a) => O.OverloadedMethod ViewportSetScrollToFocusMethodInfo a signature where
    overloadedMethod = viewportSetScrollToFocus

instance O.OverloadedMethodInfo ViewportSetScrollToFocusMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Viewport.viewportSetScrollToFocus",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Objects-Viewport.html#v:viewportSetScrollToFocus"
        })


#endif