{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Gtk.Objects.Stack
(
Stack(..) ,
IsStack ,
toStack ,
#if defined(ENABLE_OVERLOADING)
ResolveStackMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
StackAddNamedMethodInfo ,
#endif
stackAddNamed ,
#if defined(ENABLE_OVERLOADING)
StackAddTitledMethodInfo ,
#endif
stackAddTitled ,
#if defined(ENABLE_OVERLOADING)
StackGetChildByNameMethodInfo ,
#endif
stackGetChildByName ,
#if defined(ENABLE_OVERLOADING)
StackGetHhomogeneousMethodInfo ,
#endif
stackGetHhomogeneous ,
#if defined(ENABLE_OVERLOADING)
StackGetHomogeneousMethodInfo ,
#endif
stackGetHomogeneous ,
#if defined(ENABLE_OVERLOADING)
StackGetInterpolateSizeMethodInfo ,
#endif
stackGetInterpolateSize ,
#if defined(ENABLE_OVERLOADING)
StackGetTransitionDurationMethodInfo ,
#endif
stackGetTransitionDuration ,
#if defined(ENABLE_OVERLOADING)
StackGetTransitionRunningMethodInfo ,
#endif
stackGetTransitionRunning ,
#if defined(ENABLE_OVERLOADING)
StackGetTransitionTypeMethodInfo ,
#endif
stackGetTransitionType ,
#if defined(ENABLE_OVERLOADING)
StackGetVhomogeneousMethodInfo ,
#endif
stackGetVhomogeneous ,
#if defined(ENABLE_OVERLOADING)
StackGetVisibleChildMethodInfo ,
#endif
stackGetVisibleChild ,
#if defined(ENABLE_OVERLOADING)
StackGetVisibleChildNameMethodInfo ,
#endif
stackGetVisibleChildName ,
stackNew ,
#if defined(ENABLE_OVERLOADING)
StackSetHhomogeneousMethodInfo ,
#endif
stackSetHhomogeneous ,
#if defined(ENABLE_OVERLOADING)
StackSetHomogeneousMethodInfo ,
#endif
stackSetHomogeneous ,
#if defined(ENABLE_OVERLOADING)
StackSetInterpolateSizeMethodInfo ,
#endif
stackSetInterpolateSize ,
#if defined(ENABLE_OVERLOADING)
StackSetTransitionDurationMethodInfo ,
#endif
stackSetTransitionDuration ,
#if defined(ENABLE_OVERLOADING)
StackSetTransitionTypeMethodInfo ,
#endif
stackSetTransitionType ,
#if defined(ENABLE_OVERLOADING)
StackSetVhomogeneousMethodInfo ,
#endif
stackSetVhomogeneous ,
#if defined(ENABLE_OVERLOADING)
StackSetVisibleChildMethodInfo ,
#endif
stackSetVisibleChild ,
#if defined(ENABLE_OVERLOADING)
StackSetVisibleChildFullMethodInfo ,
#endif
stackSetVisibleChildFull ,
#if defined(ENABLE_OVERLOADING)
StackSetVisibleChildNameMethodInfo ,
#endif
stackSetVisibleChildName ,
#if defined(ENABLE_OVERLOADING)
StackHhomogeneousPropertyInfo ,
#endif
constructStackHhomogeneous ,
getStackHhomogeneous ,
setStackHhomogeneous ,
#if defined(ENABLE_OVERLOADING)
stackHhomogeneous ,
#endif
#if defined(ENABLE_OVERLOADING)
StackHomogeneousPropertyInfo ,
#endif
constructStackHomogeneous ,
getStackHomogeneous ,
setStackHomogeneous ,
#if defined(ENABLE_OVERLOADING)
stackHomogeneous ,
#endif
#if defined(ENABLE_OVERLOADING)
StackInterpolateSizePropertyInfo ,
#endif
constructStackInterpolateSize ,
getStackInterpolateSize ,
setStackInterpolateSize ,
#if defined(ENABLE_OVERLOADING)
stackInterpolateSize ,
#endif
#if defined(ENABLE_OVERLOADING)
StackTransitionDurationPropertyInfo ,
#endif
constructStackTransitionDuration ,
getStackTransitionDuration ,
setStackTransitionDuration ,
#if defined(ENABLE_OVERLOADING)
stackTransitionDuration ,
#endif
#if defined(ENABLE_OVERLOADING)
StackTransitionRunningPropertyInfo ,
#endif
getStackTransitionRunning ,
#if defined(ENABLE_OVERLOADING)
stackTransitionRunning ,
#endif
#if defined(ENABLE_OVERLOADING)
StackTransitionTypePropertyInfo ,
#endif
constructStackTransitionType ,
getStackTransitionType ,
setStackTransitionType ,
#if defined(ENABLE_OVERLOADING)
stackTransitionType ,
#endif
#if defined(ENABLE_OVERLOADING)
StackVhomogeneousPropertyInfo ,
#endif
constructStackVhomogeneous ,
getStackVhomogeneous ,
setStackVhomogeneous ,
#if defined(ENABLE_OVERLOADING)
stackVhomogeneous ,
#endif
#if defined(ENABLE_OVERLOADING)
StackVisibleChildPropertyInfo ,
#endif
constructStackVisibleChild ,
getStackVisibleChild ,
setStackVisibleChild ,
#if defined(ENABLE_OVERLOADING)
stackVisibleChild ,
#endif
#if defined(ENABLE_OVERLOADING)
StackVisibleChildNamePropertyInfo ,
#endif
constructStackVisibleChildName ,
getStackVisibleChildName ,
setStackVisibleChildName ,
#if defined(ENABLE_OVERLOADING)
stackVisibleChildName ,
#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.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Container as Gtk.Container
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
newtype Stack = Stack (SP.ManagedPtr Stack)
deriving (Stack -> Stack -> Bool
(Stack -> Stack -> Bool) -> (Stack -> Stack -> Bool) -> Eq Stack
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Stack -> Stack -> Bool
== :: Stack -> Stack -> Bool
$c/= :: Stack -> Stack -> Bool
/= :: Stack -> Stack -> Bool
Eq)
instance SP.ManagedPtrNewtype Stack where
toManagedPtr :: Stack -> ManagedPtr Stack
toManagedPtr (Stack ManagedPtr Stack
p) = ManagedPtr Stack
p
foreign import ccall "gtk_stack_get_type"
c_gtk_stack_get_type :: IO B.Types.GType
instance B.Types.TypedObject Stack where
glibType :: IO GType
glibType = IO GType
c_gtk_stack_get_type
instance B.Types.GObject Stack
class (SP.GObject o, O.IsDescendantOf Stack o) => IsStack o
instance (SP.GObject o, O.IsDescendantOf Stack o) => IsStack o
instance O.HasParentTypes Stack
type instance O.ParentTypes Stack = '[Gtk.Container.Container, Gtk.Widget.Widget, GObject.Object.Object, Atk.ImplementorIface.ImplementorIface, Gtk.Buildable.Buildable]
toStack :: (MIO.MonadIO m, IsStack o) => o -> m Stack
toStack :: forall (m :: * -> *) o. (MonadIO m, IsStack o) => o -> m Stack
toStack = IO Stack -> m Stack
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Stack -> m Stack) -> (o -> IO Stack) -> o -> m Stack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Stack -> Stack) -> o -> IO Stack
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Stack -> Stack
Stack
instance B.GValue.IsGValue (Maybe Stack) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_stack_get_type
gvalueSet_ :: Ptr GValue -> Maybe Stack -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Stack
P.Nothing = Ptr GValue -> Ptr Stack -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Stack
forall a. Ptr a
FP.nullPtr :: FP.Ptr Stack)
gvalueSet_ Ptr GValue
gv (P.Just Stack
obj) = Stack -> (Ptr Stack -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Stack
obj (Ptr GValue -> Ptr Stack -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe Stack)
gvalueGet_ Ptr GValue
gv = do
Ptr Stack
ptr <- Ptr GValue -> IO (Ptr Stack)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Stack)
if Ptr Stack
ptr Ptr Stack -> Ptr Stack -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Stack
forall a. Ptr a
FP.nullPtr
then Stack -> Maybe Stack
forall a. a -> Maybe a
P.Just (Stack -> Maybe Stack) -> IO Stack -> IO (Maybe Stack)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Stack -> Stack) -> Ptr Stack -> IO Stack
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Stack -> Stack
Stack Ptr Stack
ptr
else Maybe Stack -> IO (Maybe Stack)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Stack
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveStackMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveStackMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
ResolveStackMethod "add" o = Gtk.Container.ContainerAddMethodInfo
ResolveStackMethod "addAccelerator" o = Gtk.Widget.WidgetAddAcceleratorMethodInfo
ResolveStackMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
ResolveStackMethod "addDeviceEvents" o = Gtk.Widget.WidgetAddDeviceEventsMethodInfo
ResolveStackMethod "addEvents" o = Gtk.Widget.WidgetAddEventsMethodInfo
ResolveStackMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
ResolveStackMethod "addNamed" o = StackAddNamedMethodInfo
ResolveStackMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
ResolveStackMethod "addTitled" o = StackAddTitledMethodInfo
ResolveStackMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveStackMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveStackMethod "canActivateAccel" o = Gtk.Widget.WidgetCanActivateAccelMethodInfo
ResolveStackMethod "checkResize" o = Gtk.Container.ContainerCheckResizeMethodInfo
ResolveStackMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
ResolveStackMethod "childGetProperty" o = Gtk.Container.ContainerChildGetPropertyMethodInfo
ResolveStackMethod "childNotify" o = Gtk.Container.ContainerChildNotifyMethodInfo
ResolveStackMethod "childNotifyByPspec" o = Gtk.Container.ContainerChildNotifyByPspecMethodInfo
ResolveStackMethod "childSetProperty" o = Gtk.Container.ContainerChildSetPropertyMethodInfo
ResolveStackMethod "childType" o = Gtk.Container.ContainerChildTypeMethodInfo
ResolveStackMethod "classPath" o = Gtk.Widget.WidgetClassPathMethodInfo
ResolveStackMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
ResolveStackMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
ResolveStackMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
ResolveStackMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
ResolveStackMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
ResolveStackMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
ResolveStackMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
ResolveStackMethod "destroy" o = Gtk.Widget.WidgetDestroyMethodInfo
ResolveStackMethod "destroyed" o = Gtk.Widget.WidgetDestroyedMethodInfo
ResolveStackMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
ResolveStackMethod "dragBegin" o = Gtk.Widget.WidgetDragBeginMethodInfo
ResolveStackMethod "dragBeginWithCoordinates" o = Gtk.Widget.WidgetDragBeginWithCoordinatesMethodInfo
ResolveStackMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
ResolveStackMethod "dragDestAddImageTargets" o = Gtk.Widget.WidgetDragDestAddImageTargetsMethodInfo
ResolveStackMethod "dragDestAddTextTargets" o = Gtk.Widget.WidgetDragDestAddTextTargetsMethodInfo
ResolveStackMethod "dragDestAddUriTargets" o = Gtk.Widget.WidgetDragDestAddUriTargetsMethodInfo
ResolveStackMethod "dragDestFindTarget" o = Gtk.Widget.WidgetDragDestFindTargetMethodInfo
ResolveStackMethod "dragDestGetTargetList" o = Gtk.Widget.WidgetDragDestGetTargetListMethodInfo
ResolveStackMethod "dragDestGetTrackMotion" o = Gtk.Widget.WidgetDragDestGetTrackMotionMethodInfo
ResolveStackMethod "dragDestSet" o = Gtk.Widget.WidgetDragDestSetMethodInfo
ResolveStackMethod "dragDestSetProxy" o = Gtk.Widget.WidgetDragDestSetProxyMethodInfo
ResolveStackMethod "dragDestSetTargetList" o = Gtk.Widget.WidgetDragDestSetTargetListMethodInfo
ResolveStackMethod "dragDestSetTrackMotion" o = Gtk.Widget.WidgetDragDestSetTrackMotionMethodInfo
ResolveStackMethod "dragDestUnset" o = Gtk.Widget.WidgetDragDestUnsetMethodInfo
ResolveStackMethod "dragGetData" o = Gtk.Widget.WidgetDragGetDataMethodInfo
ResolveStackMethod "dragHighlight" o = Gtk.Widget.WidgetDragHighlightMethodInfo
ResolveStackMethod "dragSourceAddImageTargets" o = Gtk.Widget.WidgetDragSourceAddImageTargetsMethodInfo
ResolveStackMethod "dragSourceAddTextTargets" o = Gtk.Widget.WidgetDragSourceAddTextTargetsMethodInfo
ResolveStackMethod "dragSourceAddUriTargets" o = Gtk.Widget.WidgetDragSourceAddUriTargetsMethodInfo
ResolveStackMethod "dragSourceGetTargetList" o = Gtk.Widget.WidgetDragSourceGetTargetListMethodInfo
ResolveStackMethod "dragSourceSet" o = Gtk.Widget.WidgetDragSourceSetMethodInfo
ResolveStackMethod "dragSourceSetIconGicon" o = Gtk.Widget.WidgetDragSourceSetIconGiconMethodInfo
ResolveStackMethod "dragSourceSetIconName" o = Gtk.Widget.WidgetDragSourceSetIconNameMethodInfo
ResolveStackMethod "dragSourceSetIconPixbuf" o = Gtk.Widget.WidgetDragSourceSetIconPixbufMethodInfo
ResolveStackMethod "dragSourceSetIconStock" o = Gtk.Widget.WidgetDragSourceSetIconStockMethodInfo
ResolveStackMethod "dragSourceSetTargetList" o = Gtk.Widget.WidgetDragSourceSetTargetListMethodInfo
ResolveStackMethod "dragSourceUnset" o = Gtk.Widget.WidgetDragSourceUnsetMethodInfo
ResolveStackMethod "dragUnhighlight" o = Gtk.Widget.WidgetDragUnhighlightMethodInfo
ResolveStackMethod "draw" o = Gtk.Widget.WidgetDrawMethodInfo
ResolveStackMethod "ensureStyle" o = Gtk.Widget.WidgetEnsureStyleMethodInfo
ResolveStackMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
ResolveStackMethod "event" o = Gtk.Widget.WidgetEventMethodInfo
ResolveStackMethod "forall" o = Gtk.Container.ContainerForallMethodInfo
ResolveStackMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveStackMethod "foreach" o = Gtk.Container.ContainerForeachMethodInfo
ResolveStackMethod "freezeChildNotify" o = Gtk.Widget.WidgetFreezeChildNotifyMethodInfo
ResolveStackMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveStackMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveStackMethod "grabAdd" o = Gtk.Widget.WidgetGrabAddMethodInfo
ResolveStackMethod "grabDefault" o = Gtk.Widget.WidgetGrabDefaultMethodInfo
ResolveStackMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
ResolveStackMethod "grabRemove" o = Gtk.Widget.WidgetGrabRemoveMethodInfo
ResolveStackMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
ResolveStackMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
ResolveStackMethod "hasGrab" o = Gtk.Widget.WidgetHasGrabMethodInfo
ResolveStackMethod "hasRcStyle" o = Gtk.Widget.WidgetHasRcStyleMethodInfo
ResolveStackMethod "hasScreen" o = Gtk.Widget.WidgetHasScreenMethodInfo
ResolveStackMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
ResolveStackMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
ResolveStackMethod "hideOnDelete" o = Gtk.Widget.WidgetHideOnDeleteMethodInfo
ResolveStackMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
ResolveStackMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
ResolveStackMethod "inputShapeCombineRegion" o = Gtk.Widget.WidgetInputShapeCombineRegionMethodInfo
ResolveStackMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
ResolveStackMethod "intersect" o = Gtk.Widget.WidgetIntersectMethodInfo
ResolveStackMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
ResolveStackMethod "isComposited" o = Gtk.Widget.WidgetIsCompositedMethodInfo
ResolveStackMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
ResolveStackMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveStackMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
ResolveStackMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
ResolveStackMethod "isToplevel" o = Gtk.Widget.WidgetIsToplevelMethodInfo
ResolveStackMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
ResolveStackMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
ResolveStackMethod "listAccelClosures" o = Gtk.Widget.WidgetListAccelClosuresMethodInfo
ResolveStackMethod "listActionPrefixes" o = Gtk.Widget.WidgetListActionPrefixesMethodInfo
ResolveStackMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
ResolveStackMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
ResolveStackMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
ResolveStackMethod "modifyBase" o = Gtk.Widget.WidgetModifyBaseMethodInfo
ResolveStackMethod "modifyBg" o = Gtk.Widget.WidgetModifyBgMethodInfo
ResolveStackMethod "modifyCursor" o = Gtk.Widget.WidgetModifyCursorMethodInfo
ResolveStackMethod "modifyFg" o = Gtk.Widget.WidgetModifyFgMethodInfo
ResolveStackMethod "modifyFont" o = Gtk.Widget.WidgetModifyFontMethodInfo
ResolveStackMethod "modifyStyle" o = Gtk.Widget.WidgetModifyStyleMethodInfo
ResolveStackMethod "modifyText" o = Gtk.Widget.WidgetModifyTextMethodInfo
ResolveStackMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveStackMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveStackMethod "overrideBackgroundColor" o = Gtk.Widget.WidgetOverrideBackgroundColorMethodInfo
ResolveStackMethod "overrideColor" o = Gtk.Widget.WidgetOverrideColorMethodInfo
ResolveStackMethod "overrideCursor" o = Gtk.Widget.WidgetOverrideCursorMethodInfo
ResolveStackMethod "overrideFont" o = Gtk.Widget.WidgetOverrideFontMethodInfo
ResolveStackMethod "overrideSymbolicColor" o = Gtk.Widget.WidgetOverrideSymbolicColorMethodInfo
ResolveStackMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
ResolveStackMethod "path" o = Gtk.Widget.WidgetPathMethodInfo
ResolveStackMethod "propagateDraw" o = Gtk.Container.ContainerPropagateDrawMethodInfo
ResolveStackMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
ResolveStackMethod "queueComputeExpand" o = Gtk.Widget.WidgetQueueComputeExpandMethodInfo
ResolveStackMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
ResolveStackMethod "queueDrawArea" o = Gtk.Widget.WidgetQueueDrawAreaMethodInfo
ResolveStackMethod "queueDrawRegion" o = Gtk.Widget.WidgetQueueDrawRegionMethodInfo
ResolveStackMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
ResolveStackMethod "queueResizeNoRedraw" o = Gtk.Widget.WidgetQueueResizeNoRedrawMethodInfo
ResolveStackMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
ResolveStackMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveStackMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveStackMethod "regionIntersect" o = Gtk.Widget.WidgetRegionIntersectMethodInfo
ResolveStackMethod "registerWindow" o = Gtk.Widget.WidgetRegisterWindowMethodInfo
ResolveStackMethod "remove" o = Gtk.Container.ContainerRemoveMethodInfo
ResolveStackMethod "removeAccelerator" o = Gtk.Widget.WidgetRemoveAcceleratorMethodInfo
ResolveStackMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
ResolveStackMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
ResolveStackMethod "renderIcon" o = Gtk.Widget.WidgetRenderIconMethodInfo
ResolveStackMethod "renderIconPixbuf" o = Gtk.Widget.WidgetRenderIconPixbufMethodInfo
ResolveStackMethod "reparent" o = Gtk.Widget.WidgetReparentMethodInfo
ResolveStackMethod "resetRcStyles" o = Gtk.Widget.WidgetResetRcStylesMethodInfo
ResolveStackMethod "resetStyle" o = Gtk.Widget.WidgetResetStyleMethodInfo
ResolveStackMethod "resizeChildren" o = Gtk.Container.ContainerResizeChildrenMethodInfo
ResolveStackMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveStackMethod "sendExpose" o = Gtk.Widget.WidgetSendExposeMethodInfo
ResolveStackMethod "sendFocusChange" o = Gtk.Widget.WidgetSendFocusChangeMethodInfo
ResolveStackMethod "shapeCombineRegion" o = Gtk.Widget.WidgetShapeCombineRegionMethodInfo
ResolveStackMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
ResolveStackMethod "showAll" o = Gtk.Widget.WidgetShowAllMethodInfo
ResolveStackMethod "showNow" o = Gtk.Widget.WidgetShowNowMethodInfo
ResolveStackMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
ResolveStackMethod "sizeAllocateWithBaseline" o = Gtk.Widget.WidgetSizeAllocateWithBaselineMethodInfo
ResolveStackMethod "sizeRequest" o = Gtk.Widget.WidgetSizeRequestMethodInfo
ResolveStackMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveStackMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveStackMethod "styleAttach" o = Gtk.Widget.WidgetStyleAttachMethodInfo
ResolveStackMethod "styleGetProperty" o = Gtk.Widget.WidgetStyleGetPropertyMethodInfo
ResolveStackMethod "thawChildNotify" o = Gtk.Widget.WidgetThawChildNotifyMethodInfo
ResolveStackMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveStackMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
ResolveStackMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
ResolveStackMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
ResolveStackMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
ResolveStackMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
ResolveStackMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveStackMethod "unregisterWindow" o = Gtk.Widget.WidgetUnregisterWindowMethodInfo
ResolveStackMethod "unsetFocusChain" o = Gtk.Container.ContainerUnsetFocusChainMethodInfo
ResolveStackMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
ResolveStackMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveStackMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
ResolveStackMethod "getActionGroup" o = Gtk.Widget.WidgetGetActionGroupMethodInfo
ResolveStackMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
ResolveStackMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
ResolveStackMethod "getAllocatedSize" o = Gtk.Widget.WidgetGetAllocatedSizeMethodInfo
ResolveStackMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
ResolveStackMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
ResolveStackMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
ResolveStackMethod "getAppPaintable" o = Gtk.Widget.WidgetGetAppPaintableMethodInfo
ResolveStackMethod "getBorderWidth" o = Gtk.Container.ContainerGetBorderWidthMethodInfo
ResolveStackMethod "getCanDefault" o = Gtk.Widget.WidgetGetCanDefaultMethodInfo
ResolveStackMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
ResolveStackMethod "getChildByName" o = StackGetChildByNameMethodInfo
ResolveStackMethod "getChildRequisition" o = Gtk.Widget.WidgetGetChildRequisitionMethodInfo
ResolveStackMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
ResolveStackMethod "getChildren" o = Gtk.Container.ContainerGetChildrenMethodInfo
ResolveStackMethod "getClip" o = Gtk.Widget.WidgetGetClipMethodInfo
ResolveStackMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
ResolveStackMethod "getCompositeName" o = Gtk.Widget.WidgetGetCompositeNameMethodInfo
ResolveStackMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveStackMethod "getDeviceEnabled" o = Gtk.Widget.WidgetGetDeviceEnabledMethodInfo
ResolveStackMethod "getDeviceEvents" o = Gtk.Widget.WidgetGetDeviceEventsMethodInfo
ResolveStackMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
ResolveStackMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
ResolveStackMethod "getDoubleBuffered" o = Gtk.Widget.WidgetGetDoubleBufferedMethodInfo
ResolveStackMethod "getEvents" o = Gtk.Widget.WidgetGetEventsMethodInfo
ResolveStackMethod "getFocusChain" o = Gtk.Container.ContainerGetFocusChainMethodInfo
ResolveStackMethod "getFocusChild" o = Gtk.Container.ContainerGetFocusChildMethodInfo
ResolveStackMethod "getFocusHadjustment" o = Gtk.Container.ContainerGetFocusHadjustmentMethodInfo
ResolveStackMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
ResolveStackMethod "getFocusVadjustment" o = Gtk.Container.ContainerGetFocusVadjustmentMethodInfo
ResolveStackMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
ResolveStackMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
ResolveStackMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
ResolveStackMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
ResolveStackMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
ResolveStackMethod "getHasWindow" o = Gtk.Widget.WidgetGetHasWindowMethodInfo
ResolveStackMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
ResolveStackMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
ResolveStackMethod "getHhomogeneous" o = StackGetHhomogeneousMethodInfo
ResolveStackMethod "getHomogeneous" o = StackGetHomogeneousMethodInfo
ResolveStackMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
ResolveStackMethod "getInterpolateSize" o = StackGetInterpolateSizeMethodInfo
ResolveStackMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
ResolveStackMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
ResolveStackMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
ResolveStackMethod "getMarginLeft" o = Gtk.Widget.WidgetGetMarginLeftMethodInfo
ResolveStackMethod "getMarginRight" o = Gtk.Widget.WidgetGetMarginRightMethodInfo
ResolveStackMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
ResolveStackMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
ResolveStackMethod "getModifierMask" o = Gtk.Widget.WidgetGetModifierMaskMethodInfo
ResolveStackMethod "getModifierStyle" o = Gtk.Widget.WidgetGetModifierStyleMethodInfo
ResolveStackMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
ResolveStackMethod "getNoShowAll" o = Gtk.Widget.WidgetGetNoShowAllMethodInfo
ResolveStackMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
ResolveStackMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
ResolveStackMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
ResolveStackMethod "getParentWindow" o = Gtk.Widget.WidgetGetParentWindowMethodInfo
ResolveStackMethod "getPath" o = Gtk.Widget.WidgetGetPathMethodInfo
ResolveStackMethod "getPathForChild" o = Gtk.Container.ContainerGetPathForChildMethodInfo
ResolveStackMethod "getPointer" o = Gtk.Widget.WidgetGetPointerMethodInfo
ResolveStackMethod "getPreferredHeight" o = Gtk.Widget.WidgetGetPreferredHeightMethodInfo
ResolveStackMethod "getPreferredHeightAndBaselineForWidth" o = Gtk.Widget.WidgetGetPreferredHeightAndBaselineForWidthMethodInfo
ResolveStackMethod "getPreferredHeightForWidth" o = Gtk.Widget.WidgetGetPreferredHeightForWidthMethodInfo
ResolveStackMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
ResolveStackMethod "getPreferredWidth" o = Gtk.Widget.WidgetGetPreferredWidthMethodInfo
ResolveStackMethod "getPreferredWidthForHeight" o = Gtk.Widget.WidgetGetPreferredWidthForHeightMethodInfo
ResolveStackMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveStackMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveStackMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
ResolveStackMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
ResolveStackMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
ResolveStackMethod "getRequisition" o = Gtk.Widget.WidgetGetRequisitionMethodInfo
ResolveStackMethod "getResizeMode" o = Gtk.Container.ContainerGetResizeModeMethodInfo
ResolveStackMethod "getRootWindow" o = Gtk.Widget.WidgetGetRootWindowMethodInfo
ResolveStackMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
ResolveStackMethod "getScreen" o = Gtk.Widget.WidgetGetScreenMethodInfo
ResolveStackMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
ResolveStackMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
ResolveStackMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
ResolveStackMethod "getState" o = Gtk.Widget.WidgetGetStateMethodInfo
ResolveStackMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
ResolveStackMethod "getStyle" o = Gtk.Widget.WidgetGetStyleMethodInfo
ResolveStackMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
ResolveStackMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
ResolveStackMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
ResolveStackMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
ResolveStackMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
ResolveStackMethod "getTooltipWindow" o = Gtk.Widget.WidgetGetTooltipWindowMethodInfo
ResolveStackMethod "getToplevel" o = Gtk.Widget.WidgetGetToplevelMethodInfo
ResolveStackMethod "getTransitionDuration" o = StackGetTransitionDurationMethodInfo
ResolveStackMethod "getTransitionRunning" o = StackGetTransitionRunningMethodInfo
ResolveStackMethod "getTransitionType" o = StackGetTransitionTypeMethodInfo
ResolveStackMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
ResolveStackMethod "getValignWithBaseline" o = Gtk.Widget.WidgetGetValignWithBaselineMethodInfo
ResolveStackMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
ResolveStackMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
ResolveStackMethod "getVhomogeneous" o = StackGetVhomogeneousMethodInfo
ResolveStackMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
ResolveStackMethod "getVisibleChild" o = StackGetVisibleChildMethodInfo
ResolveStackMethod "getVisibleChildName" o = StackGetVisibleChildNameMethodInfo
ResolveStackMethod "getVisual" o = Gtk.Widget.WidgetGetVisualMethodInfo
ResolveStackMethod "getWindow" o = Gtk.Widget.WidgetGetWindowMethodInfo
ResolveStackMethod "setAccelPath" o = Gtk.Widget.WidgetSetAccelPathMethodInfo
ResolveStackMethod "setAllocation" o = Gtk.Widget.WidgetSetAllocationMethodInfo
ResolveStackMethod "setAppPaintable" o = Gtk.Widget.WidgetSetAppPaintableMethodInfo
ResolveStackMethod "setBorderWidth" o = Gtk.Container.ContainerSetBorderWidthMethodInfo
ResolveStackMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
ResolveStackMethod "setCanDefault" o = Gtk.Widget.WidgetSetCanDefaultMethodInfo
ResolveStackMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
ResolveStackMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
ResolveStackMethod "setClip" o = Gtk.Widget.WidgetSetClipMethodInfo
ResolveStackMethod "setCompositeName" o = Gtk.Widget.WidgetSetCompositeNameMethodInfo
ResolveStackMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveStackMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveStackMethod "setDeviceEnabled" o = Gtk.Widget.WidgetSetDeviceEnabledMethodInfo
ResolveStackMethod "setDeviceEvents" o = Gtk.Widget.WidgetSetDeviceEventsMethodInfo
ResolveStackMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
ResolveStackMethod "setDoubleBuffered" o = Gtk.Widget.WidgetSetDoubleBufferedMethodInfo
ResolveStackMethod "setEvents" o = Gtk.Widget.WidgetSetEventsMethodInfo
ResolveStackMethod "setFocusChain" o = Gtk.Container.ContainerSetFocusChainMethodInfo
ResolveStackMethod "setFocusChild" o = Gtk.Container.ContainerSetFocusChildMethodInfo
ResolveStackMethod "setFocusHadjustment" o = Gtk.Container.ContainerSetFocusHadjustmentMethodInfo
ResolveStackMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
ResolveStackMethod "setFocusVadjustment" o = Gtk.Container.ContainerSetFocusVadjustmentMethodInfo
ResolveStackMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
ResolveStackMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
ResolveStackMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
ResolveStackMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
ResolveStackMethod "setHasWindow" o = Gtk.Widget.WidgetSetHasWindowMethodInfo
ResolveStackMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
ResolveStackMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
ResolveStackMethod "setHhomogeneous" o = StackSetHhomogeneousMethodInfo
ResolveStackMethod "setHomogeneous" o = StackSetHomogeneousMethodInfo
ResolveStackMethod "setInterpolateSize" o = StackSetInterpolateSizeMethodInfo
ResolveStackMethod "setMapped" o = Gtk.Widget.WidgetSetMappedMethodInfo
ResolveStackMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
ResolveStackMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
ResolveStackMethod "setMarginLeft" o = Gtk.Widget.WidgetSetMarginLeftMethodInfo
ResolveStackMethod "setMarginRight" o = Gtk.Widget.WidgetSetMarginRightMethodInfo
ResolveStackMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
ResolveStackMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
ResolveStackMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
ResolveStackMethod "setNoShowAll" o = Gtk.Widget.WidgetSetNoShowAllMethodInfo
ResolveStackMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
ResolveStackMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
ResolveStackMethod "setParentWindow" o = Gtk.Widget.WidgetSetParentWindowMethodInfo
ResolveStackMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveStackMethod "setRealized" o = Gtk.Widget.WidgetSetRealizedMethodInfo
ResolveStackMethod "setReallocateRedraws" o = Gtk.Container.ContainerSetReallocateRedrawsMethodInfo
ResolveStackMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
ResolveStackMethod "setRedrawOnAllocate" o = Gtk.Widget.WidgetSetRedrawOnAllocateMethodInfo
ResolveStackMethod "setResizeMode" o = Gtk.Container.ContainerSetResizeModeMethodInfo
ResolveStackMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
ResolveStackMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
ResolveStackMethod "setState" o = Gtk.Widget.WidgetSetStateMethodInfo
ResolveStackMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
ResolveStackMethod "setStyle" o = Gtk.Widget.WidgetSetStyleMethodInfo
ResolveStackMethod "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
ResolveStackMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
ResolveStackMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
ResolveStackMethod "setTooltipWindow" o = Gtk.Widget.WidgetSetTooltipWindowMethodInfo
ResolveStackMethod "setTransitionDuration" o = StackSetTransitionDurationMethodInfo
ResolveStackMethod "setTransitionType" o = StackSetTransitionTypeMethodInfo
ResolveStackMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
ResolveStackMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
ResolveStackMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
ResolveStackMethod "setVhomogeneous" o = StackSetVhomogeneousMethodInfo
ResolveStackMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
ResolveStackMethod "setVisibleChild" o = StackSetVisibleChildMethodInfo
ResolveStackMethod "setVisibleChildFull" o = StackSetVisibleChildFullMethodInfo
ResolveStackMethod "setVisibleChildName" o = StackSetVisibleChildNameMethodInfo
ResolveStackMethod "setVisual" o = Gtk.Widget.WidgetSetVisualMethodInfo
ResolveStackMethod "setWindow" o = Gtk.Widget.WidgetSetWindowMethodInfo
ResolveStackMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveStackMethod t Stack, O.OverloadedMethod info Stack p) => OL.IsLabel t (Stack -> 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 ~ ResolveStackMethod t Stack, O.OverloadedMethod info Stack p, R.HasField t Stack p) => R.HasField t Stack p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveStackMethod t Stack, O.OverloadedMethodInfo info Stack) => OL.IsLabel t (O.MethodProxy info Stack) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getStackHhomogeneous :: (MonadIO m, IsStack o) => o -> m Bool
getStackHhomogeneous :: forall (m :: * -> *) o. (MonadIO m, IsStack o) => o -> m Bool
getStackHhomogeneous 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
"hhomogeneous"
setStackHhomogeneous :: (MonadIO m, IsStack o) => o -> Bool -> m ()
setStackHhomogeneous :: forall (m :: * -> *) o. (MonadIO m, IsStack o) => o -> Bool -> m ()
setStackHhomogeneous 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
"hhomogeneous" Bool
val
constructStackHhomogeneous :: (IsStack o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructStackHhomogeneous :: forall o (m :: * -> *).
(IsStack o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructStackHhomogeneous 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
"hhomogeneous" Bool
val
#if defined(ENABLE_OVERLOADING)
data StackHhomogeneousPropertyInfo
instance AttrInfo StackHhomogeneousPropertyInfo where
type AttrAllowedOps StackHhomogeneousPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint StackHhomogeneousPropertyInfo = IsStack
type AttrSetTypeConstraint StackHhomogeneousPropertyInfo = (~) Bool
type AttrTransferTypeConstraint StackHhomogeneousPropertyInfo = (~) Bool
type AttrTransferType StackHhomogeneousPropertyInfo = Bool
type AttrGetType StackHhomogeneousPropertyInfo = Bool
type AttrLabel StackHhomogeneousPropertyInfo = "hhomogeneous"
type AttrOrigin StackHhomogeneousPropertyInfo = Stack
attrGet = getStackHhomogeneous
attrSet = setStackHhomogeneous
attrTransfer _ v = do
return v
attrConstruct = constructStackHhomogeneous
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.hhomogeneous"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#g:attr:hhomogeneous"
})
#endif
getStackHomogeneous :: (MonadIO m, IsStack o) => o -> m Bool
getStackHomogeneous :: forall (m :: * -> *) o. (MonadIO m, IsStack o) => o -> m Bool
getStackHomogeneous 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
"homogeneous"
setStackHomogeneous :: (MonadIO m, IsStack o) => o -> Bool -> m ()
setStackHomogeneous :: forall (m :: * -> *) o. (MonadIO m, IsStack o) => o -> Bool -> m ()
setStackHomogeneous 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
"homogeneous" Bool
val
constructStackHomogeneous :: (IsStack o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructStackHomogeneous :: forall o (m :: * -> *).
(IsStack o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructStackHomogeneous 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
"homogeneous" Bool
val
#if defined(ENABLE_OVERLOADING)
data StackHomogeneousPropertyInfo
instance AttrInfo StackHomogeneousPropertyInfo where
type AttrAllowedOps StackHomogeneousPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint StackHomogeneousPropertyInfo = IsStack
type AttrSetTypeConstraint StackHomogeneousPropertyInfo = (~) Bool
type AttrTransferTypeConstraint StackHomogeneousPropertyInfo = (~) Bool
type AttrTransferType StackHomogeneousPropertyInfo = Bool
type AttrGetType StackHomogeneousPropertyInfo = Bool
type AttrLabel StackHomogeneousPropertyInfo = "homogeneous"
type AttrOrigin StackHomogeneousPropertyInfo = Stack
attrGet = getStackHomogeneous
attrSet = setStackHomogeneous
attrTransfer _ v = do
return v
attrConstruct = constructStackHomogeneous
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.homogeneous"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#g:attr:homogeneous"
})
#endif
getStackInterpolateSize :: (MonadIO m, IsStack o) => o -> m Bool
getStackInterpolateSize :: forall (m :: * -> *) o. (MonadIO m, IsStack o) => o -> m Bool
getStackInterpolateSize 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
"interpolate-size"
setStackInterpolateSize :: (MonadIO m, IsStack o) => o -> Bool -> m ()
setStackInterpolateSize :: forall (m :: * -> *) o. (MonadIO m, IsStack o) => o -> Bool -> m ()
setStackInterpolateSize 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
"interpolate-size" Bool
val
constructStackInterpolateSize :: (IsStack o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructStackInterpolateSize :: forall o (m :: * -> *).
(IsStack o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructStackInterpolateSize 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
"interpolate-size" Bool
val
#if defined(ENABLE_OVERLOADING)
data StackInterpolateSizePropertyInfo
instance AttrInfo StackInterpolateSizePropertyInfo where
type AttrAllowedOps StackInterpolateSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint StackInterpolateSizePropertyInfo = IsStack
type AttrSetTypeConstraint StackInterpolateSizePropertyInfo = (~) Bool
type AttrTransferTypeConstraint StackInterpolateSizePropertyInfo = (~) Bool
type AttrTransferType StackInterpolateSizePropertyInfo = Bool
type AttrGetType StackInterpolateSizePropertyInfo = Bool
type AttrLabel StackInterpolateSizePropertyInfo = "interpolate-size"
type AttrOrigin StackInterpolateSizePropertyInfo = Stack
attrGet = getStackInterpolateSize
attrSet = setStackInterpolateSize
attrTransfer _ v = do
return v
attrConstruct = constructStackInterpolateSize
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.interpolateSize"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#g:attr:interpolateSize"
})
#endif
getStackTransitionDuration :: (MonadIO m, IsStack o) => o -> m Word32
getStackTransitionDuration :: forall (m :: * -> *) o. (MonadIO m, IsStack o) => o -> m Word32
getStackTransitionDuration o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"transition-duration"
setStackTransitionDuration :: (MonadIO m, IsStack o) => o -> Word32 -> m ()
setStackTransitionDuration :: forall (m :: * -> *) o.
(MonadIO m, IsStack o) =>
o -> Word32 -> m ()
setStackTransitionDuration o
obj Word32
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 -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"transition-duration" Word32
val
constructStackTransitionDuration :: (IsStack o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructStackTransitionDuration :: forall o (m :: * -> *).
(IsStack o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructStackTransitionDuration Word32
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 -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"transition-duration" Word32
val
#if defined(ENABLE_OVERLOADING)
data StackTransitionDurationPropertyInfo
instance AttrInfo StackTransitionDurationPropertyInfo where
type AttrAllowedOps StackTransitionDurationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint StackTransitionDurationPropertyInfo = IsStack
type AttrSetTypeConstraint StackTransitionDurationPropertyInfo = (~) Word32
type AttrTransferTypeConstraint StackTransitionDurationPropertyInfo = (~) Word32
type AttrTransferType StackTransitionDurationPropertyInfo = Word32
type AttrGetType StackTransitionDurationPropertyInfo = Word32
type AttrLabel StackTransitionDurationPropertyInfo = "transition-duration"
type AttrOrigin StackTransitionDurationPropertyInfo = Stack
attrGet = getStackTransitionDuration
attrSet = setStackTransitionDuration
attrTransfer _ v = do
return v
attrConstruct = constructStackTransitionDuration
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.transitionDuration"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#g:attr:transitionDuration"
})
#endif
getStackTransitionRunning :: (MonadIO m, IsStack o) => o -> m Bool
getStackTransitionRunning :: forall (m :: * -> *) o. (MonadIO m, IsStack o) => o -> m Bool
getStackTransitionRunning 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
"transition-running"
#if defined(ENABLE_OVERLOADING)
data StackTransitionRunningPropertyInfo
instance AttrInfo StackTransitionRunningPropertyInfo where
type AttrAllowedOps StackTransitionRunningPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint StackTransitionRunningPropertyInfo = IsStack
type AttrSetTypeConstraint StackTransitionRunningPropertyInfo = (~) ()
type AttrTransferTypeConstraint StackTransitionRunningPropertyInfo = (~) ()
type AttrTransferType StackTransitionRunningPropertyInfo = ()
type AttrGetType StackTransitionRunningPropertyInfo = Bool
type AttrLabel StackTransitionRunningPropertyInfo = "transition-running"
type AttrOrigin StackTransitionRunningPropertyInfo = Stack
attrGet = getStackTransitionRunning
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.transitionRunning"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#g:attr:transitionRunning"
})
#endif
getStackTransitionType :: (MonadIO m, IsStack o) => o -> m Gtk.Enums.StackTransitionType
getStackTransitionType :: forall (m :: * -> *) o.
(MonadIO m, IsStack o) =>
o -> m StackTransitionType
getStackTransitionType o
obj = IO StackTransitionType -> m StackTransitionType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO StackTransitionType -> m StackTransitionType)
-> IO StackTransitionType -> m StackTransitionType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO StackTransitionType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"transition-type"
setStackTransitionType :: (MonadIO m, IsStack o) => o -> Gtk.Enums.StackTransitionType -> m ()
setStackTransitionType :: forall (m :: * -> *) o.
(MonadIO m, IsStack o) =>
o -> StackTransitionType -> m ()
setStackTransitionType o
obj StackTransitionType
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 -> StackTransitionType -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"transition-type" StackTransitionType
val
constructStackTransitionType :: (IsStack o, MIO.MonadIO m) => Gtk.Enums.StackTransitionType -> m (GValueConstruct o)
constructStackTransitionType :: forall o (m :: * -> *).
(IsStack o, MonadIO m) =>
StackTransitionType -> m (GValueConstruct o)
constructStackTransitionType StackTransitionType
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 -> StackTransitionType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"transition-type" StackTransitionType
val
#if defined(ENABLE_OVERLOADING)
data StackTransitionTypePropertyInfo
instance AttrInfo StackTransitionTypePropertyInfo where
type AttrAllowedOps StackTransitionTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint StackTransitionTypePropertyInfo = IsStack
type AttrSetTypeConstraint StackTransitionTypePropertyInfo = (~) Gtk.Enums.StackTransitionType
type AttrTransferTypeConstraint StackTransitionTypePropertyInfo = (~) Gtk.Enums.StackTransitionType
type AttrTransferType StackTransitionTypePropertyInfo = Gtk.Enums.StackTransitionType
type AttrGetType StackTransitionTypePropertyInfo = Gtk.Enums.StackTransitionType
type AttrLabel StackTransitionTypePropertyInfo = "transition-type"
type AttrOrigin StackTransitionTypePropertyInfo = Stack
attrGet = getStackTransitionType
attrSet = setStackTransitionType
attrTransfer _ v = do
return v
attrConstruct = constructStackTransitionType
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.transitionType"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#g:attr:transitionType"
})
#endif
getStackVhomogeneous :: (MonadIO m, IsStack o) => o -> m Bool
getStackVhomogeneous :: forall (m :: * -> *) o. (MonadIO m, IsStack o) => o -> m Bool
getStackVhomogeneous 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
"vhomogeneous"
setStackVhomogeneous :: (MonadIO m, IsStack o) => o -> Bool -> m ()
setStackVhomogeneous :: forall (m :: * -> *) o. (MonadIO m, IsStack o) => o -> Bool -> m ()
setStackVhomogeneous 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
"vhomogeneous" Bool
val
constructStackVhomogeneous :: (IsStack o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructStackVhomogeneous :: forall o (m :: * -> *).
(IsStack o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructStackVhomogeneous 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
"vhomogeneous" Bool
val
#if defined(ENABLE_OVERLOADING)
data StackVhomogeneousPropertyInfo
instance AttrInfo StackVhomogeneousPropertyInfo where
type AttrAllowedOps StackVhomogeneousPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint StackVhomogeneousPropertyInfo = IsStack
type AttrSetTypeConstraint StackVhomogeneousPropertyInfo = (~) Bool
type AttrTransferTypeConstraint StackVhomogeneousPropertyInfo = (~) Bool
type AttrTransferType StackVhomogeneousPropertyInfo = Bool
type AttrGetType StackVhomogeneousPropertyInfo = Bool
type AttrLabel StackVhomogeneousPropertyInfo = "vhomogeneous"
type AttrOrigin StackVhomogeneousPropertyInfo = Stack
attrGet = getStackVhomogeneous
attrSet = setStackVhomogeneous
attrTransfer _ v = do
return v
attrConstruct = constructStackVhomogeneous
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.vhomogeneous"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#g:attr:vhomogeneous"
})
#endif
getStackVisibleChild :: (MonadIO m, IsStack o) => o -> m (Maybe Gtk.Widget.Widget)
getStackVisibleChild :: forall (m :: * -> *) o.
(MonadIO m, IsStack o) =>
o -> m (Maybe Widget)
getStackVisibleChild 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
"visible-child" ManagedPtr Widget -> Widget
Gtk.Widget.Widget
setStackVisibleChild :: (MonadIO m, IsStack o, Gtk.Widget.IsWidget a) => o -> a -> m ()
setStackVisibleChild :: forall (m :: * -> *) o a.
(MonadIO m, IsStack o, IsWidget a) =>
o -> a -> m ()
setStackVisibleChild 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
"visible-child" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)
constructStackVisibleChild :: (IsStack o, MIO.MonadIO m, Gtk.Widget.IsWidget a) => a -> m (GValueConstruct o)
constructStackVisibleChild :: forall o (m :: * -> *) a.
(IsStack o, MonadIO m, IsWidget a) =>
a -> m (GValueConstruct o)
constructStackVisibleChild 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
"visible-child" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)
#if defined(ENABLE_OVERLOADING)
data StackVisibleChildPropertyInfo
instance AttrInfo StackVisibleChildPropertyInfo where
type AttrAllowedOps StackVisibleChildPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint StackVisibleChildPropertyInfo = IsStack
type AttrSetTypeConstraint StackVisibleChildPropertyInfo = Gtk.Widget.IsWidget
type AttrTransferTypeConstraint StackVisibleChildPropertyInfo = Gtk.Widget.IsWidget
type AttrTransferType StackVisibleChildPropertyInfo = Gtk.Widget.Widget
type AttrGetType StackVisibleChildPropertyInfo = (Maybe Gtk.Widget.Widget)
type AttrLabel StackVisibleChildPropertyInfo = "visible-child"
type AttrOrigin StackVisibleChildPropertyInfo = Stack
attrGet = getStackVisibleChild
attrSet = setStackVisibleChild
attrTransfer _ v = do
unsafeCastTo Gtk.Widget.Widget v
attrConstruct = constructStackVisibleChild
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.visibleChild"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#g:attr:visibleChild"
})
#endif
getStackVisibleChildName :: (MonadIO m, IsStack o) => o -> m (Maybe T.Text)
getStackVisibleChildName :: forall (m :: * -> *) o.
(MonadIO m, IsStack o) =>
o -> m (Maybe Text)
getStackVisibleChildName o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"visible-child-name"
setStackVisibleChildName :: (MonadIO m, IsStack o) => o -> T.Text -> m ()
setStackVisibleChildName :: forall (m :: * -> *) o. (MonadIO m, IsStack o) => o -> Text -> m ()
setStackVisibleChildName o
obj Text
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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"visible-child-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructStackVisibleChildName :: (IsStack o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructStackVisibleChildName :: forall o (m :: * -> *).
(IsStack o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructStackVisibleChildName Text
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 Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"visible-child-name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
#if defined(ENABLE_OVERLOADING)
data StackVisibleChildNamePropertyInfo
instance AttrInfo StackVisibleChildNamePropertyInfo where
type AttrAllowedOps StackVisibleChildNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint StackVisibleChildNamePropertyInfo = IsStack
type AttrSetTypeConstraint StackVisibleChildNamePropertyInfo = (~) T.Text
type AttrTransferTypeConstraint StackVisibleChildNamePropertyInfo = (~) T.Text
type AttrTransferType StackVisibleChildNamePropertyInfo = T.Text
type AttrGetType StackVisibleChildNamePropertyInfo = (Maybe T.Text)
type AttrLabel StackVisibleChildNamePropertyInfo = "visible-child-name"
type AttrOrigin StackVisibleChildNamePropertyInfo = Stack
attrGet = getStackVisibleChildName
attrSet = setStackVisibleChildName
attrTransfer _ v = do
return v
attrConstruct = constructStackVisibleChildName
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.visibleChildName"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#g:attr:visibleChildName"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Stack
type instance O.AttributeList Stack = StackAttributeList
type StackAttributeList = ('[ '("appPaintable", Gtk.Widget.WidgetAppPaintablePropertyInfo), '("borderWidth", Gtk.Container.ContainerBorderWidthPropertyInfo), '("canDefault", Gtk.Widget.WidgetCanDefaultPropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("child", Gtk.Container.ContainerChildPropertyInfo), '("compositeChild", Gtk.Widget.WidgetCompositeChildPropertyInfo), '("doubleBuffered", Gtk.Widget.WidgetDoubleBufferedPropertyInfo), '("events", Gtk.Widget.WidgetEventsPropertyInfo), '("expand", Gtk.Widget.WidgetExpandPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("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), '("hhomogeneous", StackHhomogeneousPropertyInfo), '("homogeneous", StackHomogeneousPropertyInfo), '("interpolateSize", StackInterpolateSizePropertyInfo), '("isFocus", Gtk.Widget.WidgetIsFocusPropertyInfo), '("margin", Gtk.Widget.WidgetMarginPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginLeft", Gtk.Widget.WidgetMarginLeftPropertyInfo), '("marginRight", Gtk.Widget.WidgetMarginRightPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("noShowAll", Gtk.Widget.WidgetNoShowAllPropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("resizeMode", Gtk.Container.ContainerResizeModePropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("style", Gtk.Widget.WidgetStylePropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("transitionDuration", StackTransitionDurationPropertyInfo), '("transitionRunning", StackTransitionRunningPropertyInfo), '("transitionType", StackTransitionTypePropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("vhomogeneous", StackVhomogeneousPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("visibleChild", StackVisibleChildPropertyInfo), '("visibleChildName", StackVisibleChildNamePropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo), '("window", Gtk.Widget.WidgetWindowPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
stackHhomogeneous :: AttrLabelProxy "hhomogeneous"
stackHhomogeneous = AttrLabelProxy
stackHomogeneous :: AttrLabelProxy "homogeneous"
stackHomogeneous = AttrLabelProxy
stackInterpolateSize :: AttrLabelProxy "interpolateSize"
stackInterpolateSize = AttrLabelProxy
stackTransitionDuration :: AttrLabelProxy "transitionDuration"
stackTransitionDuration = AttrLabelProxy
stackTransitionRunning :: AttrLabelProxy "transitionRunning"
stackTransitionRunning = AttrLabelProxy
stackTransitionType :: AttrLabelProxy "transitionType"
stackTransitionType = AttrLabelProxy
stackVhomogeneous :: AttrLabelProxy "vhomogeneous"
stackVhomogeneous = AttrLabelProxy
stackVisibleChild :: AttrLabelProxy "visibleChild"
stackVisibleChild = AttrLabelProxy
stackVisibleChildName :: AttrLabelProxy "visibleChildName"
stackVisibleChildName = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Stack = StackSignalList
type StackSignalList = ('[ '("accelClosuresChanged", Gtk.Widget.WidgetAccelClosuresChangedSignalInfo), '("add", Gtk.Container.ContainerAddSignalInfo), '("buttonPressEvent", Gtk.Widget.WidgetButtonPressEventSignalInfo), '("buttonReleaseEvent", Gtk.Widget.WidgetButtonReleaseEventSignalInfo), '("canActivateAccel", Gtk.Widget.WidgetCanActivateAccelSignalInfo), '("checkResize", Gtk.Container.ContainerCheckResizeSignalInfo), '("childNotify", Gtk.Widget.WidgetChildNotifySignalInfo), '("compositedChanged", Gtk.Widget.WidgetCompositedChangedSignalInfo), '("configureEvent", Gtk.Widget.WidgetConfigureEventSignalInfo), '("damageEvent", Gtk.Widget.WidgetDamageEventSignalInfo), '("deleteEvent", Gtk.Widget.WidgetDeleteEventSignalInfo), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("destroyEvent", Gtk.Widget.WidgetDestroyEventSignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("dragBegin", Gtk.Widget.WidgetDragBeginSignalInfo), '("dragDataDelete", Gtk.Widget.WidgetDragDataDeleteSignalInfo), '("dragDataGet", Gtk.Widget.WidgetDragDataGetSignalInfo), '("dragDataReceived", Gtk.Widget.WidgetDragDataReceivedSignalInfo), '("dragDrop", Gtk.Widget.WidgetDragDropSignalInfo), '("dragEnd", Gtk.Widget.WidgetDragEndSignalInfo), '("dragFailed", Gtk.Widget.WidgetDragFailedSignalInfo), '("dragLeave", Gtk.Widget.WidgetDragLeaveSignalInfo), '("dragMotion", Gtk.Widget.WidgetDragMotionSignalInfo), '("draw", Gtk.Widget.WidgetDrawSignalInfo), '("enterNotifyEvent", Gtk.Widget.WidgetEnterNotifyEventSignalInfo), '("event", Gtk.Widget.WidgetEventSignalInfo), '("eventAfter", Gtk.Widget.WidgetEventAfterSignalInfo), '("focus", Gtk.Widget.WidgetFocusSignalInfo), '("focusInEvent", Gtk.Widget.WidgetFocusInEventSignalInfo), '("focusOutEvent", Gtk.Widget.WidgetFocusOutEventSignalInfo), '("grabBrokenEvent", Gtk.Widget.WidgetGrabBrokenEventSignalInfo), '("grabFocus", Gtk.Widget.WidgetGrabFocusSignalInfo), '("grabNotify", Gtk.Widget.WidgetGrabNotifySignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("hierarchyChanged", Gtk.Widget.WidgetHierarchyChangedSignalInfo), '("keyPressEvent", Gtk.Widget.WidgetKeyPressEventSignalInfo), '("keyReleaseEvent", Gtk.Widget.WidgetKeyReleaseEventSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("leaveNotifyEvent", Gtk.Widget.WidgetLeaveNotifyEventSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mapEvent", Gtk.Widget.WidgetMapEventSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("motionNotifyEvent", Gtk.Widget.WidgetMotionNotifyEventSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("parentSet", Gtk.Widget.WidgetParentSetSignalInfo), '("popupMenu", Gtk.Widget.WidgetPopupMenuSignalInfo), '("propertyNotifyEvent", Gtk.Widget.WidgetPropertyNotifyEventSignalInfo), '("proximityInEvent", Gtk.Widget.WidgetProximityInEventSignalInfo), '("proximityOutEvent", Gtk.Widget.WidgetProximityOutEventSignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("remove", Gtk.Container.ContainerRemoveSignalInfo), '("screenChanged", Gtk.Widget.WidgetScreenChangedSignalInfo), '("scrollEvent", Gtk.Widget.WidgetScrollEventSignalInfo), '("selectionClearEvent", Gtk.Widget.WidgetSelectionClearEventSignalInfo), '("selectionGet", Gtk.Widget.WidgetSelectionGetSignalInfo), '("selectionNotifyEvent", Gtk.Widget.WidgetSelectionNotifyEventSignalInfo), '("selectionReceived", Gtk.Widget.WidgetSelectionReceivedSignalInfo), '("selectionRequestEvent", Gtk.Widget.WidgetSelectionRequestEventSignalInfo), '("setFocusChild", Gtk.Container.ContainerSetFocusChildSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("showHelp", Gtk.Widget.WidgetShowHelpSignalInfo), '("sizeAllocate", Gtk.Widget.WidgetSizeAllocateSignalInfo), '("stateChanged", Gtk.Widget.WidgetStateChangedSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("styleSet", Gtk.Widget.WidgetStyleSetSignalInfo), '("styleUpdated", Gtk.Widget.WidgetStyleUpdatedSignalInfo), '("touchEvent", Gtk.Widget.WidgetTouchEventSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unmapEvent", Gtk.Widget.WidgetUnmapEventSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo), '("visibilityNotifyEvent", Gtk.Widget.WidgetVisibilityNotifyEventSignalInfo), '("windowStateEvent", Gtk.Widget.WidgetWindowStateEventSignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "gtk_stack_new" gtk_stack_new ::
IO (Ptr Stack)
stackNew ::
(B.CallStack.HasCallStack, MonadIO m) =>
m Stack
stackNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Stack
stackNew = IO Stack -> m Stack
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Stack -> m Stack) -> IO Stack -> m Stack
forall a b. (a -> b) -> a -> b
$ do
Ptr Stack
result <- IO (Ptr Stack)
gtk_stack_new
Text -> Ptr Stack -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"stackNew" Ptr Stack
result
Stack
result' <- ((ManagedPtr Stack -> Stack) -> Ptr Stack -> IO Stack
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Stack -> Stack
Stack) Ptr Stack
result
Stack -> IO Stack
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Stack
result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "gtk_stack_add_named" gtk_stack_add_named ::
Ptr Stack ->
Ptr Gtk.Widget.Widget ->
CString ->
IO ()
stackAddNamed ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a, Gtk.Widget.IsWidget b) =>
a
-> b
-> T.Text
-> m ()
stackAddNamed :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsStack a, IsWidget b) =>
a -> b -> Text -> m ()
stackAddNamed a
stack b
child Text
name = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
Ptr Widget
child' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
CString
name' <- Text -> IO CString
textToCString Text
name
Ptr Stack -> Ptr Widget -> CString -> IO ()
gtk_stack_add_named Ptr Stack
stack' Ptr Widget
child' CString
name'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stack
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data StackAddNamedMethodInfo
instance (signature ~ (b -> T.Text -> m ()), MonadIO m, IsStack a, Gtk.Widget.IsWidget b) => O.OverloadedMethod StackAddNamedMethodInfo a signature where
overloadedMethod = stackAddNamed
instance O.OverloadedMethodInfo StackAddNamedMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackAddNamed",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackAddNamed"
})
#endif
foreign import ccall "gtk_stack_add_titled" gtk_stack_add_titled ::
Ptr Stack ->
Ptr Gtk.Widget.Widget ->
CString ->
CString ->
IO ()
stackAddTitled ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a, Gtk.Widget.IsWidget b) =>
a
-> b
-> T.Text
-> T.Text
-> m ()
stackAddTitled :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsStack a, IsWidget b) =>
a -> b -> Text -> Text -> m ()
stackAddTitled a
stack b
child Text
name Text
title = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
Ptr Widget
child' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
CString
name' <- Text -> IO CString
textToCString Text
name
CString
title' <- Text -> IO CString
textToCString Text
title
Ptr Stack -> Ptr Widget -> CString -> CString -> IO ()
gtk_stack_add_titled Ptr Stack
stack' Ptr Widget
child' CString
name' CString
title'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stack
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data StackAddTitledMethodInfo
instance (signature ~ (b -> T.Text -> T.Text -> m ()), MonadIO m, IsStack a, Gtk.Widget.IsWidget b) => O.OverloadedMethod StackAddTitledMethodInfo a signature where
overloadedMethod = stackAddTitled
instance O.OverloadedMethodInfo StackAddTitledMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackAddTitled",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackAddTitled"
})
#endif
foreign import ccall "gtk_stack_get_child_by_name" gtk_stack_get_child_by_name ::
Ptr Stack ->
CString ->
IO (Ptr Gtk.Widget.Widget)
stackGetChildByName ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> T.Text
-> m (Maybe Gtk.Widget.Widget)
stackGetChildByName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> Text -> m (Maybe Widget)
stackGetChildByName a
stack Text
name = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
CString
name' <- Text -> IO CString
textToCString Text
name
Ptr Widget
result <- Ptr Stack -> CString -> IO (Ptr Widget)
gtk_stack_get_child_by_name Ptr Stack
stack' CString
name'
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
stack
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
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 StackGetChildByNameMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gtk.Widget.Widget)), MonadIO m, IsStack a) => O.OverloadedMethod StackGetChildByNameMethodInfo a signature where
overloadedMethod = stackGetChildByName
instance O.OverloadedMethodInfo StackGetChildByNameMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackGetChildByName",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackGetChildByName"
})
#endif
foreign import ccall "gtk_stack_get_hhomogeneous" gtk_stack_get_hhomogeneous ::
Ptr Stack ->
IO CInt
stackGetHhomogeneous ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> m Bool
stackGetHhomogeneous :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> m Bool
stackGetHhomogeneous a
stack = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
CInt
result <- Ptr Stack -> IO CInt
gtk_stack_get_hhomogeneous Ptr Stack
stack'
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
stack
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data StackGetHhomogeneousMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsStack a) => O.OverloadedMethod StackGetHhomogeneousMethodInfo a signature where
overloadedMethod = stackGetHhomogeneous
instance O.OverloadedMethodInfo StackGetHhomogeneousMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackGetHhomogeneous",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackGetHhomogeneous"
})
#endif
foreign import ccall "gtk_stack_get_homogeneous" gtk_stack_get_homogeneous ::
Ptr Stack ->
IO CInt
stackGetHomogeneous ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> m Bool
stackGetHomogeneous :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> m Bool
stackGetHomogeneous a
stack = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
CInt
result <- Ptr Stack -> IO CInt
gtk_stack_get_homogeneous Ptr Stack
stack'
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
stack
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data StackGetHomogeneousMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsStack a) => O.OverloadedMethod StackGetHomogeneousMethodInfo a signature where
overloadedMethod = stackGetHomogeneous
instance O.OverloadedMethodInfo StackGetHomogeneousMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackGetHomogeneous",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackGetHomogeneous"
})
#endif
foreign import ccall "gtk_stack_get_interpolate_size" gtk_stack_get_interpolate_size ::
Ptr Stack ->
IO CInt
stackGetInterpolateSize ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> m Bool
stackGetInterpolateSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> m Bool
stackGetInterpolateSize a
stack = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
CInt
result <- Ptr Stack -> IO CInt
gtk_stack_get_interpolate_size Ptr Stack
stack'
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
stack
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data StackGetInterpolateSizeMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsStack a) => O.OverloadedMethod StackGetInterpolateSizeMethodInfo a signature where
overloadedMethod = stackGetInterpolateSize
instance O.OverloadedMethodInfo StackGetInterpolateSizeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackGetInterpolateSize",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackGetInterpolateSize"
})
#endif
foreign import ccall "gtk_stack_get_transition_duration" gtk_stack_get_transition_duration ::
Ptr Stack ->
IO Word32
stackGetTransitionDuration ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> m Word32
stackGetTransitionDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> m Word32
stackGetTransitionDuration a
stack = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
Ptr Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
Word32
result <- Ptr Stack -> IO Word32
gtk_stack_get_transition_duration Ptr Stack
stack'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stack
Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
#if defined(ENABLE_OVERLOADING)
data StackGetTransitionDurationMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsStack a) => O.OverloadedMethod StackGetTransitionDurationMethodInfo a signature where
overloadedMethod = stackGetTransitionDuration
instance O.OverloadedMethodInfo StackGetTransitionDurationMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackGetTransitionDuration",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackGetTransitionDuration"
})
#endif
foreign import ccall "gtk_stack_get_transition_running" gtk_stack_get_transition_running ::
Ptr Stack ->
IO CInt
stackGetTransitionRunning ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> m Bool
stackGetTransitionRunning :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> m Bool
stackGetTransitionRunning a
stack = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
CInt
result <- Ptr Stack -> IO CInt
gtk_stack_get_transition_running Ptr Stack
stack'
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
stack
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data StackGetTransitionRunningMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsStack a) => O.OverloadedMethod StackGetTransitionRunningMethodInfo a signature where
overloadedMethod = stackGetTransitionRunning
instance O.OverloadedMethodInfo StackGetTransitionRunningMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackGetTransitionRunning",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackGetTransitionRunning"
})
#endif
foreign import ccall "gtk_stack_get_transition_type" gtk_stack_get_transition_type ::
Ptr Stack ->
IO CUInt
stackGetTransitionType ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> m Gtk.Enums.StackTransitionType
stackGetTransitionType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> m StackTransitionType
stackGetTransitionType a
stack = IO StackTransitionType -> m StackTransitionType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StackTransitionType -> m StackTransitionType)
-> IO StackTransitionType -> m StackTransitionType
forall a b. (a -> b) -> a -> b
$ do
Ptr Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
CUInt
result <- Ptr Stack -> IO CUInt
gtk_stack_get_transition_type Ptr Stack
stack'
let result' :: StackTransitionType
result' = (Int -> StackTransitionType
forall a. Enum a => Int -> a
toEnum (Int -> StackTransitionType)
-> (CUInt -> Int) -> CUInt -> StackTransitionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stack
StackTransitionType -> IO StackTransitionType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StackTransitionType
result'
#if defined(ENABLE_OVERLOADING)
data StackGetTransitionTypeMethodInfo
instance (signature ~ (m Gtk.Enums.StackTransitionType), MonadIO m, IsStack a) => O.OverloadedMethod StackGetTransitionTypeMethodInfo a signature where
overloadedMethod = stackGetTransitionType
instance O.OverloadedMethodInfo StackGetTransitionTypeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackGetTransitionType",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackGetTransitionType"
})
#endif
foreign import ccall "gtk_stack_get_vhomogeneous" gtk_stack_get_vhomogeneous ::
Ptr Stack ->
IO CInt
stackGetVhomogeneous ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> m Bool
stackGetVhomogeneous :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> m Bool
stackGetVhomogeneous a
stack = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
CInt
result <- Ptr Stack -> IO CInt
gtk_stack_get_vhomogeneous Ptr Stack
stack'
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
stack
Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data StackGetVhomogeneousMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsStack a) => O.OverloadedMethod StackGetVhomogeneousMethodInfo a signature where
overloadedMethod = stackGetVhomogeneous
instance O.OverloadedMethodInfo StackGetVhomogeneousMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackGetVhomogeneous",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackGetVhomogeneous"
})
#endif
foreign import ccall "gtk_stack_get_visible_child" gtk_stack_get_visible_child ::
Ptr Stack ->
IO (Ptr Gtk.Widget.Widget)
stackGetVisibleChild ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> m (Maybe Gtk.Widget.Widget)
stackGetVisibleChild :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> m (Maybe Widget)
stackGetVisibleChild a
stack = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
Ptr Widget
result <- Ptr Stack -> IO (Ptr Widget)
gtk_stack_get_visible_child Ptr Stack
stack'
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
stack
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 StackGetVisibleChildMethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsStack a) => O.OverloadedMethod StackGetVisibleChildMethodInfo a signature where
overloadedMethod = stackGetVisibleChild
instance O.OverloadedMethodInfo StackGetVisibleChildMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackGetVisibleChild",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackGetVisibleChild"
})
#endif
foreign import ccall "gtk_stack_get_visible_child_name" gtk_stack_get_visible_child_name ::
Ptr Stack ->
IO CString
stackGetVisibleChildName ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> m (Maybe T.Text)
stackGetVisibleChildName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> m (Maybe Text)
stackGetVisibleChildName a
stack = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
Ptr Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
CString
result <- Ptr Stack -> IO CString
gtk_stack_get_visible_child_name Ptr Stack
stack'
Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stack
Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult
#if defined(ENABLE_OVERLOADING)
data StackGetVisibleChildNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsStack a) => O.OverloadedMethod StackGetVisibleChildNameMethodInfo a signature where
overloadedMethod = stackGetVisibleChildName
instance O.OverloadedMethodInfo StackGetVisibleChildNameMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackGetVisibleChildName",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackGetVisibleChildName"
})
#endif
foreign import ccall "gtk_stack_set_hhomogeneous" gtk_stack_set_hhomogeneous ::
Ptr Stack ->
CInt ->
IO ()
stackSetHhomogeneous ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> Bool
-> m ()
stackSetHhomogeneous :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> Bool -> m ()
stackSetHhomogeneous a
stack Bool
hhomogeneous = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
let hhomogeneous' :: CInt
hhomogeneous' = (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
hhomogeneous
Ptr Stack -> CInt -> IO ()
gtk_stack_set_hhomogeneous Ptr Stack
stack' CInt
hhomogeneous'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stack
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data StackSetHhomogeneousMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsStack a) => O.OverloadedMethod StackSetHhomogeneousMethodInfo a signature where
overloadedMethod = stackSetHhomogeneous
instance O.OverloadedMethodInfo StackSetHhomogeneousMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackSetHhomogeneous",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackSetHhomogeneous"
})
#endif
foreign import ccall "gtk_stack_set_homogeneous" gtk_stack_set_homogeneous ::
Ptr Stack ->
CInt ->
IO ()
stackSetHomogeneous ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> Bool
-> m ()
stackSetHomogeneous :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> Bool -> m ()
stackSetHomogeneous a
stack Bool
homogeneous = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
let homogeneous' :: CInt
homogeneous' = (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
homogeneous
Ptr Stack -> CInt -> IO ()
gtk_stack_set_homogeneous Ptr Stack
stack' CInt
homogeneous'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stack
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data StackSetHomogeneousMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsStack a) => O.OverloadedMethod StackSetHomogeneousMethodInfo a signature where
overloadedMethod = stackSetHomogeneous
instance O.OverloadedMethodInfo StackSetHomogeneousMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackSetHomogeneous",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackSetHomogeneous"
})
#endif
foreign import ccall "gtk_stack_set_interpolate_size" gtk_stack_set_interpolate_size ::
Ptr Stack ->
CInt ->
IO ()
stackSetInterpolateSize ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> Bool
-> m ()
stackSetInterpolateSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> Bool -> m ()
stackSetInterpolateSize a
stack Bool
interpolateSize = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
let interpolateSize' :: CInt
interpolateSize' = (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
interpolateSize
Ptr Stack -> CInt -> IO ()
gtk_stack_set_interpolate_size Ptr Stack
stack' CInt
interpolateSize'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stack
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data StackSetInterpolateSizeMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsStack a) => O.OverloadedMethod StackSetInterpolateSizeMethodInfo a signature where
overloadedMethod = stackSetInterpolateSize
instance O.OverloadedMethodInfo StackSetInterpolateSizeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackSetInterpolateSize",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackSetInterpolateSize"
})
#endif
foreign import ccall "gtk_stack_set_transition_duration" gtk_stack_set_transition_duration ::
Ptr Stack ->
Word32 ->
IO ()
stackSetTransitionDuration ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> Word32
-> m ()
stackSetTransitionDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> Word32 -> m ()
stackSetTransitionDuration a
stack Word32
duration = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
Ptr Stack -> Word32 -> IO ()
gtk_stack_set_transition_duration Ptr Stack
stack' Word32
duration
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stack
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data StackSetTransitionDurationMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsStack a) => O.OverloadedMethod StackSetTransitionDurationMethodInfo a signature where
overloadedMethod = stackSetTransitionDuration
instance O.OverloadedMethodInfo StackSetTransitionDurationMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackSetTransitionDuration",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackSetTransitionDuration"
})
#endif
foreign import ccall "gtk_stack_set_transition_type" gtk_stack_set_transition_type ::
Ptr Stack ->
CUInt ->
IO ()
stackSetTransitionType ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> Gtk.Enums.StackTransitionType
-> m ()
stackSetTransitionType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> StackTransitionType -> m ()
stackSetTransitionType a
stack StackTransitionType
transition = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
let transition' :: CUInt
transition' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (StackTransitionType -> Int) -> StackTransitionType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackTransitionType -> Int
forall a. Enum a => a -> Int
fromEnum) StackTransitionType
transition
Ptr Stack -> CUInt -> IO ()
gtk_stack_set_transition_type Ptr Stack
stack' CUInt
transition'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stack
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data StackSetTransitionTypeMethodInfo
instance (signature ~ (Gtk.Enums.StackTransitionType -> m ()), MonadIO m, IsStack a) => O.OverloadedMethod StackSetTransitionTypeMethodInfo a signature where
overloadedMethod = stackSetTransitionType
instance O.OverloadedMethodInfo StackSetTransitionTypeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackSetTransitionType",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackSetTransitionType"
})
#endif
foreign import ccall "gtk_stack_set_vhomogeneous" gtk_stack_set_vhomogeneous ::
Ptr Stack ->
CInt ->
IO ()
stackSetVhomogeneous ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> Bool
-> m ()
stackSetVhomogeneous :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> Bool -> m ()
stackSetVhomogeneous a
stack Bool
vhomogeneous = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
let vhomogeneous' :: CInt
vhomogeneous' = (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
vhomogeneous
Ptr Stack -> CInt -> IO ()
gtk_stack_set_vhomogeneous Ptr Stack
stack' CInt
vhomogeneous'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stack
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data StackSetVhomogeneousMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsStack a) => O.OverloadedMethod StackSetVhomogeneousMethodInfo a signature where
overloadedMethod = stackSetVhomogeneous
instance O.OverloadedMethodInfo StackSetVhomogeneousMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackSetVhomogeneous",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackSetVhomogeneous"
})
#endif
foreign import ccall "gtk_stack_set_visible_child" gtk_stack_set_visible_child ::
Ptr Stack ->
Ptr Gtk.Widget.Widget ->
IO ()
stackSetVisibleChild ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a, Gtk.Widget.IsWidget b) =>
a
-> b
-> m ()
stackSetVisibleChild :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsStack a, IsWidget b) =>
a -> b -> m ()
stackSetVisibleChild a
stack 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
Ptr Widget
child' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
Ptr Stack -> Ptr Widget -> IO ()
gtk_stack_set_visible_child Ptr Stack
stack' Ptr Widget
child'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stack
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data StackSetVisibleChildMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsStack a, Gtk.Widget.IsWidget b) => O.OverloadedMethod StackSetVisibleChildMethodInfo a signature where
overloadedMethod = stackSetVisibleChild
instance O.OverloadedMethodInfo StackSetVisibleChildMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackSetVisibleChild",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackSetVisibleChild"
})
#endif
foreign import ccall "gtk_stack_set_visible_child_full" gtk_stack_set_visible_child_full ::
Ptr Stack ->
CString ->
CUInt ->
IO ()
stackSetVisibleChildFull ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> T.Text
-> Gtk.Enums.StackTransitionType
-> m ()
stackSetVisibleChildFull :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> Text -> StackTransitionType -> m ()
stackSetVisibleChildFull a
stack Text
name StackTransitionType
transition = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
CString
name' <- Text -> IO CString
textToCString Text
name
let transition' :: CUInt
transition' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (StackTransitionType -> Int) -> StackTransitionType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackTransitionType -> Int
forall a. Enum a => a -> Int
fromEnum) StackTransitionType
transition
Ptr Stack -> CString -> CUInt -> IO ()
gtk_stack_set_visible_child_full Ptr Stack
stack' CString
name' CUInt
transition'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stack
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data StackSetVisibleChildFullMethodInfo
instance (signature ~ (T.Text -> Gtk.Enums.StackTransitionType -> m ()), MonadIO m, IsStack a) => O.OverloadedMethod StackSetVisibleChildFullMethodInfo a signature where
overloadedMethod = stackSetVisibleChildFull
instance O.OverloadedMethodInfo StackSetVisibleChildFullMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackSetVisibleChildFull",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackSetVisibleChildFull"
})
#endif
foreign import ccall "gtk_stack_set_visible_child_name" gtk_stack_set_visible_child_name ::
Ptr Stack ->
CString ->
IO ()
stackSetVisibleChildName ::
(B.CallStack.HasCallStack, MonadIO m, IsStack a) =>
a
-> T.Text
-> m ()
stackSetVisibleChildName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStack a) =>
a -> Text -> m ()
stackSetVisibleChildName a
stack Text
name = 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 Stack
stack' <- a -> IO (Ptr Stack)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
stack
CString
name' <- Text -> IO CString
textToCString Text
name
Ptr Stack -> CString -> IO ()
gtk_stack_set_visible_child_name Ptr Stack
stack' CString
name'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
stack
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data StackSetVisibleChildNameMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsStack a) => O.OverloadedMethod StackSetVisibleChildNameMethodInfo a signature where
overloadedMethod = stackSetVisibleChildName
instance O.OverloadedMethodInfo StackSetVisibleChildNameMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Stack.stackSetVisibleChildName",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Stack.html#v:stackSetVisibleChildName"
})
#endif