{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Gtk.Objects.Layout
(
Layout(..) ,
IsLayout ,
toLayout ,
#if defined(ENABLE_OVERLOADING)
ResolveLayoutMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
LayoutGetBinWindowMethodInfo ,
#endif
layoutGetBinWindow ,
#if defined(ENABLE_OVERLOADING)
LayoutGetHadjustmentMethodInfo ,
#endif
layoutGetHadjustment ,
#if defined(ENABLE_OVERLOADING)
LayoutGetSizeMethodInfo ,
#endif
layoutGetSize ,
#if defined(ENABLE_OVERLOADING)
LayoutGetVadjustmentMethodInfo ,
#endif
layoutGetVadjustment ,
#if defined(ENABLE_OVERLOADING)
LayoutMoveMethodInfo ,
#endif
layoutMove ,
layoutNew ,
#if defined(ENABLE_OVERLOADING)
LayoutPutMethodInfo ,
#endif
layoutPut ,
#if defined(ENABLE_OVERLOADING)
LayoutSetHadjustmentMethodInfo ,
#endif
layoutSetHadjustment ,
#if defined(ENABLE_OVERLOADING)
LayoutSetSizeMethodInfo ,
#endif
layoutSetSize ,
#if defined(ENABLE_OVERLOADING)
LayoutSetVadjustmentMethodInfo ,
#endif
layoutSetVadjustment ,
#if defined(ENABLE_OVERLOADING)
LayoutHeightPropertyInfo ,
#endif
constructLayoutHeight ,
getLayoutHeight ,
#if defined(ENABLE_OVERLOADING)
layoutHeight ,
#endif
setLayoutHeight ,
#if defined(ENABLE_OVERLOADING)
LayoutWidthPropertyInfo ,
#endif
constructLayoutWidth ,
getLayoutWidth ,
#if defined(ENABLE_OVERLOADING)
layoutWidth ,
#endif
setLayoutWidth ,
) 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 qualified GI.Gdk.Objects.Window as Gdk.Window
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Scrollable as Gtk.Scrollable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Adjustment as Gtk.Adjustment
import {-# SOURCE #-} qualified GI.Gtk.Objects.Container as Gtk.Container
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
newtype Layout = Layout (SP.ManagedPtr Layout)
deriving (Layout -> Layout -> Bool
(Layout -> Layout -> Bool)
-> (Layout -> Layout -> Bool) -> Eq Layout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Layout -> Layout -> Bool
== :: Layout -> Layout -> Bool
$c/= :: Layout -> Layout -> Bool
/= :: Layout -> Layout -> Bool
Eq)
instance SP.ManagedPtrNewtype Layout where
toManagedPtr :: Layout -> ManagedPtr Layout
toManagedPtr (Layout ManagedPtr Layout
p) = ManagedPtr Layout
p
foreign import ccall "gtk_layout_get_type"
c_gtk_layout_get_type :: IO B.Types.GType
instance B.Types.TypedObject Layout where
glibType :: IO GType
glibType = IO GType
c_gtk_layout_get_type
instance B.Types.GObject Layout
class (SP.GObject o, O.IsDescendantOf Layout o) => IsLayout o
instance (SP.GObject o, O.IsDescendantOf Layout o) => IsLayout o
instance O.HasParentTypes Layout
type instance O.ParentTypes Layout = '[Gtk.Container.Container, Gtk.Widget.Widget, GObject.Object.Object, Atk.ImplementorIface.ImplementorIface, Gtk.Buildable.Buildable, Gtk.Scrollable.Scrollable]
toLayout :: (MIO.MonadIO m, IsLayout o) => o -> m Layout
toLayout :: forall (m :: * -> *) o. (MonadIO m, IsLayout o) => o -> m Layout
toLayout = IO Layout -> m Layout
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Layout -> m Layout) -> (o -> IO Layout) -> o -> m Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Layout -> Layout) -> o -> IO Layout
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Layout -> Layout
Layout
instance B.GValue.IsGValue (Maybe Layout) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_layout_get_type
gvalueSet_ :: Ptr GValue -> Maybe Layout -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Layout
P.Nothing = Ptr GValue -> Ptr Layout -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Layout
forall a. Ptr a
FP.nullPtr :: FP.Ptr Layout)
gvalueSet_ Ptr GValue
gv (P.Just Layout
obj) = Layout -> (Ptr Layout -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Layout
obj (Ptr GValue -> Ptr Layout -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe Layout)
gvalueGet_ Ptr GValue
gv = do
Ptr Layout
ptr <- Ptr GValue -> IO (Ptr Layout)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Layout)
if Ptr Layout
ptr Ptr Layout -> Ptr Layout -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Layout
forall a. Ptr a
FP.nullPtr
then Layout -> Maybe Layout
forall a. a -> Maybe a
P.Just (Layout -> Maybe Layout) -> IO Layout -> IO (Maybe Layout)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Layout -> Layout) -> Ptr Layout -> IO Layout
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Layout -> Layout
Layout Ptr Layout
ptr
else Maybe Layout -> IO (Maybe Layout)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Layout
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveLayoutMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveLayoutMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
ResolveLayoutMethod "add" o = Gtk.Container.ContainerAddMethodInfo
ResolveLayoutMethod "addAccelerator" o = Gtk.Widget.WidgetAddAcceleratorMethodInfo
ResolveLayoutMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
ResolveLayoutMethod "addDeviceEvents" o = Gtk.Widget.WidgetAddDeviceEventsMethodInfo
ResolveLayoutMethod "addEvents" o = Gtk.Widget.WidgetAddEventsMethodInfo
ResolveLayoutMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
ResolveLayoutMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
ResolveLayoutMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveLayoutMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveLayoutMethod "canActivateAccel" o = Gtk.Widget.WidgetCanActivateAccelMethodInfo
ResolveLayoutMethod "checkResize" o = Gtk.Container.ContainerCheckResizeMethodInfo
ResolveLayoutMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
ResolveLayoutMethod "childGetProperty" o = Gtk.Container.ContainerChildGetPropertyMethodInfo
ResolveLayoutMethod "childNotify" o = Gtk.Container.ContainerChildNotifyMethodInfo
ResolveLayoutMethod "childNotifyByPspec" o = Gtk.Container.ContainerChildNotifyByPspecMethodInfo
ResolveLayoutMethod "childSetProperty" o = Gtk.Container.ContainerChildSetPropertyMethodInfo
ResolveLayoutMethod "childType" o = Gtk.Container.ContainerChildTypeMethodInfo
ResolveLayoutMethod "classPath" o = Gtk.Widget.WidgetClassPathMethodInfo
ResolveLayoutMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
ResolveLayoutMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
ResolveLayoutMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
ResolveLayoutMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
ResolveLayoutMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
ResolveLayoutMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
ResolveLayoutMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
ResolveLayoutMethod "destroy" o = Gtk.Widget.WidgetDestroyMethodInfo
ResolveLayoutMethod "destroyed" o = Gtk.Widget.WidgetDestroyedMethodInfo
ResolveLayoutMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
ResolveLayoutMethod "dragBegin" o = Gtk.Widget.WidgetDragBeginMethodInfo
ResolveLayoutMethod "dragBeginWithCoordinates" o = Gtk.Widget.WidgetDragBeginWithCoordinatesMethodInfo
ResolveLayoutMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
ResolveLayoutMethod "dragDestAddImageTargets" o = Gtk.Widget.WidgetDragDestAddImageTargetsMethodInfo
ResolveLayoutMethod "dragDestAddTextTargets" o = Gtk.Widget.WidgetDragDestAddTextTargetsMethodInfo
ResolveLayoutMethod "dragDestAddUriTargets" o = Gtk.Widget.WidgetDragDestAddUriTargetsMethodInfo
ResolveLayoutMethod "dragDestFindTarget" o = Gtk.Widget.WidgetDragDestFindTargetMethodInfo
ResolveLayoutMethod "dragDestGetTargetList" o = Gtk.Widget.WidgetDragDestGetTargetListMethodInfo
ResolveLayoutMethod "dragDestGetTrackMotion" o = Gtk.Widget.WidgetDragDestGetTrackMotionMethodInfo
ResolveLayoutMethod "dragDestSet" o = Gtk.Widget.WidgetDragDestSetMethodInfo
ResolveLayoutMethod "dragDestSetProxy" o = Gtk.Widget.WidgetDragDestSetProxyMethodInfo
ResolveLayoutMethod "dragDestSetTargetList" o = Gtk.Widget.WidgetDragDestSetTargetListMethodInfo
ResolveLayoutMethod "dragDestSetTrackMotion" o = Gtk.Widget.WidgetDragDestSetTrackMotionMethodInfo
ResolveLayoutMethod "dragDestUnset" o = Gtk.Widget.WidgetDragDestUnsetMethodInfo
ResolveLayoutMethod "dragGetData" o = Gtk.Widget.WidgetDragGetDataMethodInfo
ResolveLayoutMethod "dragHighlight" o = Gtk.Widget.WidgetDragHighlightMethodInfo
ResolveLayoutMethod "dragSourceAddImageTargets" o = Gtk.Widget.WidgetDragSourceAddImageTargetsMethodInfo
ResolveLayoutMethod "dragSourceAddTextTargets" o = Gtk.Widget.WidgetDragSourceAddTextTargetsMethodInfo
ResolveLayoutMethod "dragSourceAddUriTargets" o = Gtk.Widget.WidgetDragSourceAddUriTargetsMethodInfo
ResolveLayoutMethod "dragSourceGetTargetList" o = Gtk.Widget.WidgetDragSourceGetTargetListMethodInfo
ResolveLayoutMethod "dragSourceSet" o = Gtk.Widget.WidgetDragSourceSetMethodInfo
ResolveLayoutMethod "dragSourceSetIconGicon" o = Gtk.Widget.WidgetDragSourceSetIconGiconMethodInfo
ResolveLayoutMethod "dragSourceSetIconName" o = Gtk.Widget.WidgetDragSourceSetIconNameMethodInfo
ResolveLayoutMethod "dragSourceSetIconPixbuf" o = Gtk.Widget.WidgetDragSourceSetIconPixbufMethodInfo
ResolveLayoutMethod "dragSourceSetIconStock" o = Gtk.Widget.WidgetDragSourceSetIconStockMethodInfo
ResolveLayoutMethod "dragSourceSetTargetList" o = Gtk.Widget.WidgetDragSourceSetTargetListMethodInfo
ResolveLayoutMethod "dragSourceUnset" o = Gtk.Widget.WidgetDragSourceUnsetMethodInfo
ResolveLayoutMethod "dragUnhighlight" o = Gtk.Widget.WidgetDragUnhighlightMethodInfo
ResolveLayoutMethod "draw" o = Gtk.Widget.WidgetDrawMethodInfo
ResolveLayoutMethod "ensureStyle" o = Gtk.Widget.WidgetEnsureStyleMethodInfo
ResolveLayoutMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
ResolveLayoutMethod "event" o = Gtk.Widget.WidgetEventMethodInfo
ResolveLayoutMethod "forall" o = Gtk.Container.ContainerForallMethodInfo
ResolveLayoutMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveLayoutMethod "foreach" o = Gtk.Container.ContainerForeachMethodInfo
ResolveLayoutMethod "freezeChildNotify" o = Gtk.Widget.WidgetFreezeChildNotifyMethodInfo
ResolveLayoutMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveLayoutMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveLayoutMethod "grabAdd" o = Gtk.Widget.WidgetGrabAddMethodInfo
ResolveLayoutMethod "grabDefault" o = Gtk.Widget.WidgetGrabDefaultMethodInfo
ResolveLayoutMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
ResolveLayoutMethod "grabRemove" o = Gtk.Widget.WidgetGrabRemoveMethodInfo
ResolveLayoutMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
ResolveLayoutMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
ResolveLayoutMethod "hasGrab" o = Gtk.Widget.WidgetHasGrabMethodInfo
ResolveLayoutMethod "hasRcStyle" o = Gtk.Widget.WidgetHasRcStyleMethodInfo
ResolveLayoutMethod "hasScreen" o = Gtk.Widget.WidgetHasScreenMethodInfo
ResolveLayoutMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
ResolveLayoutMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
ResolveLayoutMethod "hideOnDelete" o = Gtk.Widget.WidgetHideOnDeleteMethodInfo
ResolveLayoutMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
ResolveLayoutMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
ResolveLayoutMethod "inputShapeCombineRegion" o = Gtk.Widget.WidgetInputShapeCombineRegionMethodInfo
ResolveLayoutMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
ResolveLayoutMethod "intersect" o = Gtk.Widget.WidgetIntersectMethodInfo
ResolveLayoutMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
ResolveLayoutMethod "isComposited" o = Gtk.Widget.WidgetIsCompositedMethodInfo
ResolveLayoutMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
ResolveLayoutMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveLayoutMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
ResolveLayoutMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
ResolveLayoutMethod "isToplevel" o = Gtk.Widget.WidgetIsToplevelMethodInfo
ResolveLayoutMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
ResolveLayoutMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
ResolveLayoutMethod "listAccelClosures" o = Gtk.Widget.WidgetListAccelClosuresMethodInfo
ResolveLayoutMethod "listActionPrefixes" o = Gtk.Widget.WidgetListActionPrefixesMethodInfo
ResolveLayoutMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
ResolveLayoutMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
ResolveLayoutMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
ResolveLayoutMethod "modifyBase" o = Gtk.Widget.WidgetModifyBaseMethodInfo
ResolveLayoutMethod "modifyBg" o = Gtk.Widget.WidgetModifyBgMethodInfo
ResolveLayoutMethod "modifyCursor" o = Gtk.Widget.WidgetModifyCursorMethodInfo
ResolveLayoutMethod "modifyFg" o = Gtk.Widget.WidgetModifyFgMethodInfo
ResolveLayoutMethod "modifyFont" o = Gtk.Widget.WidgetModifyFontMethodInfo
ResolveLayoutMethod "modifyStyle" o = Gtk.Widget.WidgetModifyStyleMethodInfo
ResolveLayoutMethod "modifyText" o = Gtk.Widget.WidgetModifyTextMethodInfo
ResolveLayoutMethod "move" o = LayoutMoveMethodInfo
ResolveLayoutMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveLayoutMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveLayoutMethod "overrideBackgroundColor" o = Gtk.Widget.WidgetOverrideBackgroundColorMethodInfo
ResolveLayoutMethod "overrideColor" o = Gtk.Widget.WidgetOverrideColorMethodInfo
ResolveLayoutMethod "overrideCursor" o = Gtk.Widget.WidgetOverrideCursorMethodInfo
ResolveLayoutMethod "overrideFont" o = Gtk.Widget.WidgetOverrideFontMethodInfo
ResolveLayoutMethod "overrideSymbolicColor" o = Gtk.Widget.WidgetOverrideSymbolicColorMethodInfo
ResolveLayoutMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
ResolveLayoutMethod "path" o = Gtk.Widget.WidgetPathMethodInfo
ResolveLayoutMethod "propagateDraw" o = Gtk.Container.ContainerPropagateDrawMethodInfo
ResolveLayoutMethod "put" o = LayoutPutMethodInfo
ResolveLayoutMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
ResolveLayoutMethod "queueComputeExpand" o = Gtk.Widget.WidgetQueueComputeExpandMethodInfo
ResolveLayoutMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
ResolveLayoutMethod "queueDrawArea" o = Gtk.Widget.WidgetQueueDrawAreaMethodInfo
ResolveLayoutMethod "queueDrawRegion" o = Gtk.Widget.WidgetQueueDrawRegionMethodInfo
ResolveLayoutMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
ResolveLayoutMethod "queueResizeNoRedraw" o = Gtk.Widget.WidgetQueueResizeNoRedrawMethodInfo
ResolveLayoutMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
ResolveLayoutMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveLayoutMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveLayoutMethod "regionIntersect" o = Gtk.Widget.WidgetRegionIntersectMethodInfo
ResolveLayoutMethod "registerWindow" o = Gtk.Widget.WidgetRegisterWindowMethodInfo
ResolveLayoutMethod "remove" o = Gtk.Container.ContainerRemoveMethodInfo
ResolveLayoutMethod "removeAccelerator" o = Gtk.Widget.WidgetRemoveAcceleratorMethodInfo
ResolveLayoutMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
ResolveLayoutMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
ResolveLayoutMethod "renderIcon" o = Gtk.Widget.WidgetRenderIconMethodInfo
ResolveLayoutMethod "renderIconPixbuf" o = Gtk.Widget.WidgetRenderIconPixbufMethodInfo
ResolveLayoutMethod "reparent" o = Gtk.Widget.WidgetReparentMethodInfo
ResolveLayoutMethod "resetRcStyles" o = Gtk.Widget.WidgetResetRcStylesMethodInfo
ResolveLayoutMethod "resetStyle" o = Gtk.Widget.WidgetResetStyleMethodInfo
ResolveLayoutMethod "resizeChildren" o = Gtk.Container.ContainerResizeChildrenMethodInfo
ResolveLayoutMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveLayoutMethod "sendExpose" o = Gtk.Widget.WidgetSendExposeMethodInfo
ResolveLayoutMethod "sendFocusChange" o = Gtk.Widget.WidgetSendFocusChangeMethodInfo
ResolveLayoutMethod "shapeCombineRegion" o = Gtk.Widget.WidgetShapeCombineRegionMethodInfo
ResolveLayoutMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
ResolveLayoutMethod "showAll" o = Gtk.Widget.WidgetShowAllMethodInfo
ResolveLayoutMethod "showNow" o = Gtk.Widget.WidgetShowNowMethodInfo
ResolveLayoutMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
ResolveLayoutMethod "sizeAllocateWithBaseline" o = Gtk.Widget.WidgetSizeAllocateWithBaselineMethodInfo
ResolveLayoutMethod "sizeRequest" o = Gtk.Widget.WidgetSizeRequestMethodInfo
ResolveLayoutMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveLayoutMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveLayoutMethod "styleAttach" o = Gtk.Widget.WidgetStyleAttachMethodInfo
ResolveLayoutMethod "styleGetProperty" o = Gtk.Widget.WidgetStyleGetPropertyMethodInfo
ResolveLayoutMethod "thawChildNotify" o = Gtk.Widget.WidgetThawChildNotifyMethodInfo
ResolveLayoutMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveLayoutMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
ResolveLayoutMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
ResolveLayoutMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
ResolveLayoutMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
ResolveLayoutMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
ResolveLayoutMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveLayoutMethod "unregisterWindow" o = Gtk.Widget.WidgetUnregisterWindowMethodInfo
ResolveLayoutMethod "unsetFocusChain" o = Gtk.Container.ContainerUnsetFocusChainMethodInfo
ResolveLayoutMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
ResolveLayoutMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveLayoutMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
ResolveLayoutMethod "getActionGroup" o = Gtk.Widget.WidgetGetActionGroupMethodInfo
ResolveLayoutMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
ResolveLayoutMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
ResolveLayoutMethod "getAllocatedSize" o = Gtk.Widget.WidgetGetAllocatedSizeMethodInfo
ResolveLayoutMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
ResolveLayoutMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
ResolveLayoutMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
ResolveLayoutMethod "getAppPaintable" o = Gtk.Widget.WidgetGetAppPaintableMethodInfo
ResolveLayoutMethod "getBinWindow" o = LayoutGetBinWindowMethodInfo
ResolveLayoutMethod "getBorder" o = Gtk.Scrollable.ScrollableGetBorderMethodInfo
ResolveLayoutMethod "getBorderWidth" o = Gtk.Container.ContainerGetBorderWidthMethodInfo
ResolveLayoutMethod "getCanDefault" o = Gtk.Widget.WidgetGetCanDefaultMethodInfo
ResolveLayoutMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
ResolveLayoutMethod "getChildRequisition" o = Gtk.Widget.WidgetGetChildRequisitionMethodInfo
ResolveLayoutMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
ResolveLayoutMethod "getChildren" o = Gtk.Container.ContainerGetChildrenMethodInfo
ResolveLayoutMethod "getClip" o = Gtk.Widget.WidgetGetClipMethodInfo
ResolveLayoutMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
ResolveLayoutMethod "getCompositeName" o = Gtk.Widget.WidgetGetCompositeNameMethodInfo
ResolveLayoutMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveLayoutMethod "getDeviceEnabled" o = Gtk.Widget.WidgetGetDeviceEnabledMethodInfo
ResolveLayoutMethod "getDeviceEvents" o = Gtk.Widget.WidgetGetDeviceEventsMethodInfo
ResolveLayoutMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
ResolveLayoutMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
ResolveLayoutMethod "getDoubleBuffered" o = Gtk.Widget.WidgetGetDoubleBufferedMethodInfo
ResolveLayoutMethod "getEvents" o = Gtk.Widget.WidgetGetEventsMethodInfo
ResolveLayoutMethod "getFocusChain" o = Gtk.Container.ContainerGetFocusChainMethodInfo
ResolveLayoutMethod "getFocusChild" o = Gtk.Container.ContainerGetFocusChildMethodInfo
ResolveLayoutMethod "getFocusHadjustment" o = Gtk.Container.ContainerGetFocusHadjustmentMethodInfo
ResolveLayoutMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
ResolveLayoutMethod "getFocusVadjustment" o = Gtk.Container.ContainerGetFocusVadjustmentMethodInfo
ResolveLayoutMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
ResolveLayoutMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
ResolveLayoutMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
ResolveLayoutMethod "getHadjustment" o = LayoutGetHadjustmentMethodInfo
ResolveLayoutMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
ResolveLayoutMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
ResolveLayoutMethod "getHasWindow" o = Gtk.Widget.WidgetGetHasWindowMethodInfo
ResolveLayoutMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
ResolveLayoutMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
ResolveLayoutMethod "getHscrollPolicy" o = Gtk.Scrollable.ScrollableGetHscrollPolicyMethodInfo
ResolveLayoutMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
ResolveLayoutMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
ResolveLayoutMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
ResolveLayoutMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
ResolveLayoutMethod "getMarginLeft" o = Gtk.Widget.WidgetGetMarginLeftMethodInfo
ResolveLayoutMethod "getMarginRight" o = Gtk.Widget.WidgetGetMarginRightMethodInfo
ResolveLayoutMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
ResolveLayoutMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
ResolveLayoutMethod "getModifierMask" o = Gtk.Widget.WidgetGetModifierMaskMethodInfo
ResolveLayoutMethod "getModifierStyle" o = Gtk.Widget.WidgetGetModifierStyleMethodInfo
ResolveLayoutMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
ResolveLayoutMethod "getNoShowAll" o = Gtk.Widget.WidgetGetNoShowAllMethodInfo
ResolveLayoutMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
ResolveLayoutMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
ResolveLayoutMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
ResolveLayoutMethod "getParentWindow" o = Gtk.Widget.WidgetGetParentWindowMethodInfo
ResolveLayoutMethod "getPath" o = Gtk.Widget.WidgetGetPathMethodInfo
ResolveLayoutMethod "getPathForChild" o = Gtk.Container.ContainerGetPathForChildMethodInfo
ResolveLayoutMethod "getPointer" o = Gtk.Widget.WidgetGetPointerMethodInfo
ResolveLayoutMethod "getPreferredHeight" o = Gtk.Widget.WidgetGetPreferredHeightMethodInfo
ResolveLayoutMethod "getPreferredHeightAndBaselineForWidth" o = Gtk.Widget.WidgetGetPreferredHeightAndBaselineForWidthMethodInfo
ResolveLayoutMethod "getPreferredHeightForWidth" o = Gtk.Widget.WidgetGetPreferredHeightForWidthMethodInfo
ResolveLayoutMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
ResolveLayoutMethod "getPreferredWidth" o = Gtk.Widget.WidgetGetPreferredWidthMethodInfo
ResolveLayoutMethod "getPreferredWidthForHeight" o = Gtk.Widget.WidgetGetPreferredWidthForHeightMethodInfo
ResolveLayoutMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveLayoutMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveLayoutMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
ResolveLayoutMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
ResolveLayoutMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
ResolveLayoutMethod "getRequisition" o = Gtk.Widget.WidgetGetRequisitionMethodInfo
ResolveLayoutMethod "getResizeMode" o = Gtk.Container.ContainerGetResizeModeMethodInfo
ResolveLayoutMethod "getRootWindow" o = Gtk.Widget.WidgetGetRootWindowMethodInfo
ResolveLayoutMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
ResolveLayoutMethod "getScreen" o = Gtk.Widget.WidgetGetScreenMethodInfo
ResolveLayoutMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
ResolveLayoutMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
ResolveLayoutMethod "getSize" o = LayoutGetSizeMethodInfo
ResolveLayoutMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
ResolveLayoutMethod "getState" o = Gtk.Widget.WidgetGetStateMethodInfo
ResolveLayoutMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
ResolveLayoutMethod "getStyle" o = Gtk.Widget.WidgetGetStyleMethodInfo
ResolveLayoutMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
ResolveLayoutMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
ResolveLayoutMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
ResolveLayoutMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
ResolveLayoutMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
ResolveLayoutMethod "getTooltipWindow" o = Gtk.Widget.WidgetGetTooltipWindowMethodInfo
ResolveLayoutMethod "getToplevel" o = Gtk.Widget.WidgetGetToplevelMethodInfo
ResolveLayoutMethod "getVadjustment" o = LayoutGetVadjustmentMethodInfo
ResolveLayoutMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
ResolveLayoutMethod "getValignWithBaseline" o = Gtk.Widget.WidgetGetValignWithBaselineMethodInfo
ResolveLayoutMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
ResolveLayoutMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
ResolveLayoutMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
ResolveLayoutMethod "getVisual" o = Gtk.Widget.WidgetGetVisualMethodInfo
ResolveLayoutMethod "getVscrollPolicy" o = Gtk.Scrollable.ScrollableGetVscrollPolicyMethodInfo
ResolveLayoutMethod "getWindow" o = Gtk.Widget.WidgetGetWindowMethodInfo
ResolveLayoutMethod "setAccelPath" o = Gtk.Widget.WidgetSetAccelPathMethodInfo
ResolveLayoutMethod "setAllocation" o = Gtk.Widget.WidgetSetAllocationMethodInfo
ResolveLayoutMethod "setAppPaintable" o = Gtk.Widget.WidgetSetAppPaintableMethodInfo
ResolveLayoutMethod "setBorderWidth" o = Gtk.Container.ContainerSetBorderWidthMethodInfo
ResolveLayoutMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
ResolveLayoutMethod "setCanDefault" o = Gtk.Widget.WidgetSetCanDefaultMethodInfo
ResolveLayoutMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
ResolveLayoutMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
ResolveLayoutMethod "setClip" o = Gtk.Widget.WidgetSetClipMethodInfo
ResolveLayoutMethod "setCompositeName" o = Gtk.Widget.WidgetSetCompositeNameMethodInfo
ResolveLayoutMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveLayoutMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveLayoutMethod "setDeviceEnabled" o = Gtk.Widget.WidgetSetDeviceEnabledMethodInfo
ResolveLayoutMethod "setDeviceEvents" o = Gtk.Widget.WidgetSetDeviceEventsMethodInfo
ResolveLayoutMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
ResolveLayoutMethod "setDoubleBuffered" o = Gtk.Widget.WidgetSetDoubleBufferedMethodInfo
ResolveLayoutMethod "setEvents" o = Gtk.Widget.WidgetSetEventsMethodInfo
ResolveLayoutMethod "setFocusChain" o = Gtk.Container.ContainerSetFocusChainMethodInfo
ResolveLayoutMethod "setFocusChild" o = Gtk.Container.ContainerSetFocusChildMethodInfo
ResolveLayoutMethod "setFocusHadjustment" o = Gtk.Container.ContainerSetFocusHadjustmentMethodInfo
ResolveLayoutMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
ResolveLayoutMethod "setFocusVadjustment" o = Gtk.Container.ContainerSetFocusVadjustmentMethodInfo
ResolveLayoutMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
ResolveLayoutMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
ResolveLayoutMethod "setHadjustment" o = LayoutSetHadjustmentMethodInfo
ResolveLayoutMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
ResolveLayoutMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
ResolveLayoutMethod "setHasWindow" o = Gtk.Widget.WidgetSetHasWindowMethodInfo
ResolveLayoutMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
ResolveLayoutMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
ResolveLayoutMethod "setHscrollPolicy" o = Gtk.Scrollable.ScrollableSetHscrollPolicyMethodInfo
ResolveLayoutMethod "setMapped" o = Gtk.Widget.WidgetSetMappedMethodInfo
ResolveLayoutMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
ResolveLayoutMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
ResolveLayoutMethod "setMarginLeft" o = Gtk.Widget.WidgetSetMarginLeftMethodInfo
ResolveLayoutMethod "setMarginRight" o = Gtk.Widget.WidgetSetMarginRightMethodInfo
ResolveLayoutMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
ResolveLayoutMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
ResolveLayoutMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
ResolveLayoutMethod "setNoShowAll" o = Gtk.Widget.WidgetSetNoShowAllMethodInfo
ResolveLayoutMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
ResolveLayoutMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
ResolveLayoutMethod "setParentWindow" o = Gtk.Widget.WidgetSetParentWindowMethodInfo
ResolveLayoutMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveLayoutMethod "setRealized" o = Gtk.Widget.WidgetSetRealizedMethodInfo
ResolveLayoutMethod "setReallocateRedraws" o = Gtk.Container.ContainerSetReallocateRedrawsMethodInfo
ResolveLayoutMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
ResolveLayoutMethod "setRedrawOnAllocate" o = Gtk.Widget.WidgetSetRedrawOnAllocateMethodInfo
ResolveLayoutMethod "setResizeMode" o = Gtk.Container.ContainerSetResizeModeMethodInfo
ResolveLayoutMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
ResolveLayoutMethod "setSize" o = LayoutSetSizeMethodInfo
ResolveLayoutMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
ResolveLayoutMethod "setState" o = Gtk.Widget.WidgetSetStateMethodInfo
ResolveLayoutMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
ResolveLayoutMethod "setStyle" o = Gtk.Widget.WidgetSetStyleMethodInfo
ResolveLayoutMethod "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
ResolveLayoutMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
ResolveLayoutMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
ResolveLayoutMethod "setTooltipWindow" o = Gtk.Widget.WidgetSetTooltipWindowMethodInfo
ResolveLayoutMethod "setVadjustment" o = LayoutSetVadjustmentMethodInfo
ResolveLayoutMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
ResolveLayoutMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
ResolveLayoutMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
ResolveLayoutMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
ResolveLayoutMethod "setVisual" o = Gtk.Widget.WidgetSetVisualMethodInfo
ResolveLayoutMethod "setVscrollPolicy" o = Gtk.Scrollable.ScrollableSetVscrollPolicyMethodInfo
ResolveLayoutMethod "setWindow" o = Gtk.Widget.WidgetSetWindowMethodInfo
ResolveLayoutMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveLayoutMethod t Layout, O.OverloadedMethod info Layout p) => OL.IsLabel t (Layout -> 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 ~ ResolveLayoutMethod t Layout, O.OverloadedMethod info Layout p, R.HasField t Layout p) => R.HasField t Layout p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveLayoutMethod t Layout, O.OverloadedMethodInfo info Layout) => OL.IsLabel t (O.MethodProxy info Layout) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getLayoutHeight :: (MonadIO m, IsLayout o) => o -> m Word32
getLayoutHeight :: forall (m :: * -> *) o. (MonadIO m, IsLayout o) => o -> m Word32
getLayoutHeight 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
"height"
setLayoutHeight :: (MonadIO m, IsLayout o) => o -> Word32 -> m ()
setLayoutHeight :: forall (m :: * -> *) o.
(MonadIO m, IsLayout o) =>
o -> Word32 -> m ()
setLayoutHeight 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
"height" Word32
val
constructLayoutHeight :: (IsLayout o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructLayoutHeight :: forall o (m :: * -> *).
(IsLayout o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructLayoutHeight 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
"height" Word32
val
#if defined(ENABLE_OVERLOADING)
data LayoutHeightPropertyInfo
instance AttrInfo LayoutHeightPropertyInfo where
type AttrAllowedOps LayoutHeightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint LayoutHeightPropertyInfo = IsLayout
type AttrSetTypeConstraint LayoutHeightPropertyInfo = (~) Word32
type AttrTransferTypeConstraint LayoutHeightPropertyInfo = (~) Word32
type AttrTransferType LayoutHeightPropertyInfo = Word32
type AttrGetType LayoutHeightPropertyInfo = Word32
type AttrLabel LayoutHeightPropertyInfo = "height"
type AttrOrigin LayoutHeightPropertyInfo = Layout
attrGet = getLayoutHeight
attrSet = setLayoutHeight
attrTransfer _ v = do
return v
attrConstruct = constructLayoutHeight
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Layout.height"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Layout.html#g:attr:height"
})
#endif
getLayoutWidth :: (MonadIO m, IsLayout o) => o -> m Word32
getLayoutWidth :: forall (m :: * -> *) o. (MonadIO m, IsLayout o) => o -> m Word32
getLayoutWidth 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
"width"
setLayoutWidth :: (MonadIO m, IsLayout o) => o -> Word32 -> m ()
setLayoutWidth :: forall (m :: * -> *) o.
(MonadIO m, IsLayout o) =>
o -> Word32 -> m ()
setLayoutWidth 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
"width" Word32
val
constructLayoutWidth :: (IsLayout o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructLayoutWidth :: forall o (m :: * -> *).
(IsLayout o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructLayoutWidth 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
"width" Word32
val
#if defined(ENABLE_OVERLOADING)
data LayoutWidthPropertyInfo
instance AttrInfo LayoutWidthPropertyInfo where
type AttrAllowedOps LayoutWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint LayoutWidthPropertyInfo = IsLayout
type AttrSetTypeConstraint LayoutWidthPropertyInfo = (~) Word32
type AttrTransferTypeConstraint LayoutWidthPropertyInfo = (~) Word32
type AttrTransferType LayoutWidthPropertyInfo = Word32
type AttrGetType LayoutWidthPropertyInfo = Word32
type AttrLabel LayoutWidthPropertyInfo = "width"
type AttrOrigin LayoutWidthPropertyInfo = Layout
attrGet = getLayoutWidth
attrSet = setLayoutWidth
attrTransfer _ v = do
return v
attrConstruct = constructLayoutWidth
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Layout.width"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Layout.html#g:attr:width"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Layout
type instance O.AttributeList Layout = LayoutAttributeList
type LayoutAttributeList = ('[ '("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), '("hadjustment", Gtk.Scrollable.ScrollableHadjustmentPropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("height", LayoutHeightPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("hscrollPolicy", Gtk.Scrollable.ScrollableHscrollPolicyPropertyInfo), '("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), '("vadjustment", Gtk.Scrollable.ScrollableVadjustmentPropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("vscrollPolicy", Gtk.Scrollable.ScrollableVscrollPolicyPropertyInfo), '("width", LayoutWidthPropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo), '("window", Gtk.Widget.WidgetWindowPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
layoutHeight :: AttrLabelProxy "height"
layoutHeight = AttrLabelProxy
layoutWidth :: AttrLabelProxy "width"
layoutWidth = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Layout = LayoutSignalList
type LayoutSignalList = ('[ '("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_layout_new" gtk_layout_new ::
Ptr Gtk.Adjustment.Adjustment ->
Ptr Gtk.Adjustment.Adjustment ->
IO (Ptr Layout)
layoutNew ::
(B.CallStack.HasCallStack, MonadIO m, Gtk.Adjustment.IsAdjustment a, Gtk.Adjustment.IsAdjustment b) =>
Maybe (a)
-> Maybe (b)
-> m Layout
layoutNew :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAdjustment a, IsAdjustment b) =>
Maybe a -> Maybe b -> m Layout
layoutNew Maybe a
hadjustment Maybe b
vadjustment = IO Layout -> m Layout
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Layout -> m Layout) -> IO Layout -> m Layout
forall a b. (a -> b) -> a -> b
$ do
Ptr Adjustment
maybeHadjustment <- case Maybe a
hadjustment of
Maybe a
Nothing -> Ptr Adjustment -> IO (Ptr Adjustment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Adjustment
forall a. Ptr a
nullPtr
Just a
jHadjustment -> do
Ptr Adjustment
jHadjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jHadjustment
Ptr Adjustment -> IO (Ptr Adjustment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Adjustment
jHadjustment'
Ptr Adjustment
maybeVadjustment <- case Maybe b
vadjustment of
Maybe b
Nothing -> Ptr Adjustment -> IO (Ptr Adjustment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Adjustment
forall a. Ptr a
nullPtr
Just b
jVadjustment -> do
Ptr Adjustment
jVadjustment' <- b -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jVadjustment
Ptr Adjustment -> IO (Ptr Adjustment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Adjustment
jVadjustment'
Ptr Layout
result <- Ptr Adjustment -> Ptr Adjustment -> IO (Ptr Layout)
gtk_layout_new Ptr Adjustment
maybeHadjustment Ptr Adjustment
maybeVadjustment
Text -> Ptr Layout -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"layoutNew" Ptr Layout
result
Layout
result' <- ((ManagedPtr Layout -> Layout) -> Ptr Layout -> IO Layout
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Layout -> Layout
Layout) Ptr Layout
result
Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
hadjustment a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
vadjustment b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
Layout -> IO Layout
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Layout
result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "gtk_layout_get_bin_window" gtk_layout_get_bin_window ::
Ptr Layout ->
IO (Ptr Gdk.Window.Window)
layoutGetBinWindow ::
(B.CallStack.HasCallStack, MonadIO m, IsLayout a) =>
a
-> m Gdk.Window.Window
layoutGetBinWindow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayout a) =>
a -> m Window
layoutGetBinWindow a
layout = IO Window -> m Window
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Window -> m Window) -> IO Window -> m Window
forall a b. (a -> b) -> a -> b
$ do
Ptr Layout
layout' <- a -> IO (Ptr Layout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
Ptr Window
result <- Ptr Layout -> IO (Ptr Window)
gtk_layout_get_bin_window Ptr Layout
layout'
Text -> Ptr Window -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"layoutGetBinWindow" Ptr Window
result
Window
result' <- ((ManagedPtr Window -> Window) -> Ptr Window -> IO Window
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Window -> Window
Gdk.Window.Window) Ptr Window
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
Window -> IO Window
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Window
result'
#if defined(ENABLE_OVERLOADING)
data LayoutGetBinWindowMethodInfo
instance (signature ~ (m Gdk.Window.Window), MonadIO m, IsLayout a) => O.OverloadedMethod LayoutGetBinWindowMethodInfo a signature where
overloadedMethod = layoutGetBinWindow
instance O.OverloadedMethodInfo LayoutGetBinWindowMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Layout.layoutGetBinWindow",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Layout.html#v:layoutGetBinWindow"
})
#endif
foreign import ccall "gtk_layout_get_hadjustment" gtk_layout_get_hadjustment ::
Ptr Layout ->
IO (Ptr Gtk.Adjustment.Adjustment)
{-# DEPRECATED layoutGetHadjustment ["(Since version 3.0)","Use 'GI.Gtk.Interfaces.Scrollable.scrollableGetHadjustment'"] #-}
layoutGetHadjustment ::
(B.CallStack.HasCallStack, MonadIO m, IsLayout a) =>
a
-> m Gtk.Adjustment.Adjustment
layoutGetHadjustment :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayout a) =>
a -> m Adjustment
layoutGetHadjustment a
layout = IO Adjustment -> m Adjustment
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Adjustment -> m Adjustment) -> IO Adjustment -> m Adjustment
forall a b. (a -> b) -> a -> b
$ do
Ptr Layout
layout' <- a -> IO (Ptr Layout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
Ptr Adjustment
result <- Ptr Layout -> IO (Ptr Adjustment)
gtk_layout_get_hadjustment Ptr Layout
layout'
Text -> Ptr Adjustment -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"layoutGetHadjustment" Ptr Adjustment
result
Adjustment
result' <- ((ManagedPtr Adjustment -> Adjustment)
-> Ptr Adjustment -> IO Adjustment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Adjustment -> Adjustment
Gtk.Adjustment.Adjustment) Ptr Adjustment
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
Adjustment -> IO Adjustment
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Adjustment
result'
#if defined(ENABLE_OVERLOADING)
data LayoutGetHadjustmentMethodInfo
instance (signature ~ (m Gtk.Adjustment.Adjustment), MonadIO m, IsLayout a) => O.OverloadedMethod LayoutGetHadjustmentMethodInfo a signature where
overloadedMethod = layoutGetHadjustment
instance O.OverloadedMethodInfo LayoutGetHadjustmentMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Layout.layoutGetHadjustment",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Layout.html#v:layoutGetHadjustment"
})
#endif
foreign import ccall "gtk_layout_get_size" gtk_layout_get_size ::
Ptr Layout ->
Ptr Word32 ->
Ptr Word32 ->
IO ()
layoutGetSize ::
(B.CallStack.HasCallStack, MonadIO m, IsLayout a) =>
a
-> m ((Word32, Word32))
layoutGetSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayout a) =>
a -> m (Word32, Word32)
layoutGetSize a
layout = IO (Word32, Word32) -> m (Word32, Word32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word32, Word32) -> m (Word32, Word32))
-> IO (Word32, Word32) -> m (Word32, Word32)
forall a b. (a -> b) -> a -> b
$ do
Ptr Layout
layout' <- a -> IO (Ptr Layout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
Ptr Word32
width <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
Ptr Word32
height <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
Ptr Layout -> Ptr Word32 -> Ptr Word32 -> IO ()
gtk_layout_get_size Ptr Layout
layout' Ptr Word32
width Ptr Word32
height
Word32
width' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
width
Word32
height' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
height
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
width
Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
height
(Word32, Word32) -> IO (Word32, Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
width', Word32
height')
#if defined(ENABLE_OVERLOADING)
data LayoutGetSizeMethodInfo
instance (signature ~ (m ((Word32, Word32))), MonadIO m, IsLayout a) => O.OverloadedMethod LayoutGetSizeMethodInfo a signature where
overloadedMethod = layoutGetSize
instance O.OverloadedMethodInfo LayoutGetSizeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Layout.layoutGetSize",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Layout.html#v:layoutGetSize"
})
#endif
foreign import ccall "gtk_layout_get_vadjustment" gtk_layout_get_vadjustment ::
Ptr Layout ->
IO (Ptr Gtk.Adjustment.Adjustment)
{-# DEPRECATED layoutGetVadjustment ["(Since version 3.0)","Use 'GI.Gtk.Interfaces.Scrollable.scrollableGetVadjustment'"] #-}
layoutGetVadjustment ::
(B.CallStack.HasCallStack, MonadIO m, IsLayout a) =>
a
-> m Gtk.Adjustment.Adjustment
layoutGetVadjustment :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayout a) =>
a -> m Adjustment
layoutGetVadjustment a
layout = IO Adjustment -> m Adjustment
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Adjustment -> m Adjustment) -> IO Adjustment -> m Adjustment
forall a b. (a -> b) -> a -> b
$ do
Ptr Layout
layout' <- a -> IO (Ptr Layout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
Ptr Adjustment
result <- Ptr Layout -> IO (Ptr Adjustment)
gtk_layout_get_vadjustment Ptr Layout
layout'
Text -> Ptr Adjustment -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"layoutGetVadjustment" Ptr Adjustment
result
Adjustment
result' <- ((ManagedPtr Adjustment -> Adjustment)
-> Ptr Adjustment -> IO Adjustment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Adjustment -> Adjustment
Gtk.Adjustment.Adjustment) Ptr Adjustment
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
Adjustment -> IO Adjustment
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Adjustment
result'
#if defined(ENABLE_OVERLOADING)
data LayoutGetVadjustmentMethodInfo
instance (signature ~ (m Gtk.Adjustment.Adjustment), MonadIO m, IsLayout a) => O.OverloadedMethod LayoutGetVadjustmentMethodInfo a signature where
overloadedMethod = layoutGetVadjustment
instance O.OverloadedMethodInfo LayoutGetVadjustmentMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Layout.layoutGetVadjustment",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Layout.html#v:layoutGetVadjustment"
})
#endif
foreign import ccall "gtk_layout_move" gtk_layout_move ::
Ptr Layout ->
Ptr Gtk.Widget.Widget ->
Int32 ->
Int32 ->
IO ()
layoutMove ::
(B.CallStack.HasCallStack, MonadIO m, IsLayout a, Gtk.Widget.IsWidget b) =>
a
-> b
-> Int32
-> Int32
-> m ()
layoutMove :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayout a, IsWidget b) =>
a -> b -> Int32 -> Int32 -> m ()
layoutMove a
layout b
childWidget Int32
x Int32
y = 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 Layout
layout' <- a -> IO (Ptr Layout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
Ptr Widget
childWidget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
childWidget
Ptr Layout -> Ptr Widget -> Int32 -> Int32 -> IO ()
gtk_layout_move Ptr Layout
layout' Ptr Widget
childWidget' Int32
x Int32
y
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
childWidget
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data LayoutMoveMethodInfo
instance (signature ~ (b -> Int32 -> Int32 -> m ()), MonadIO m, IsLayout a, Gtk.Widget.IsWidget b) => O.OverloadedMethod LayoutMoveMethodInfo a signature where
overloadedMethod = layoutMove
instance O.OverloadedMethodInfo LayoutMoveMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Layout.layoutMove",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Layout.html#v:layoutMove"
})
#endif
foreign import ccall "gtk_layout_put" gtk_layout_put ::
Ptr Layout ->
Ptr Gtk.Widget.Widget ->
Int32 ->
Int32 ->
IO ()
layoutPut ::
(B.CallStack.HasCallStack, MonadIO m, IsLayout a, Gtk.Widget.IsWidget b) =>
a
-> b
-> Int32
-> Int32
-> m ()
layoutPut :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayout a, IsWidget b) =>
a -> b -> Int32 -> Int32 -> m ()
layoutPut a
layout b
childWidget Int32
x Int32
y = 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 Layout
layout' <- a -> IO (Ptr Layout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
Ptr Widget
childWidget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
childWidget
Ptr Layout -> Ptr Widget -> Int32 -> Int32 -> IO ()
gtk_layout_put Ptr Layout
layout' Ptr Widget
childWidget' Int32
x Int32
y
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
childWidget
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data LayoutPutMethodInfo
instance (signature ~ (b -> Int32 -> Int32 -> m ()), MonadIO m, IsLayout a, Gtk.Widget.IsWidget b) => O.OverloadedMethod LayoutPutMethodInfo a signature where
overloadedMethod = layoutPut
instance O.OverloadedMethodInfo LayoutPutMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Layout.layoutPut",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Layout.html#v:layoutPut"
})
#endif
foreign import ccall "gtk_layout_set_hadjustment" gtk_layout_set_hadjustment ::
Ptr Layout ->
Ptr Gtk.Adjustment.Adjustment ->
IO ()
{-# DEPRECATED layoutSetHadjustment ["(Since version 3.0)","Use 'GI.Gtk.Interfaces.Scrollable.scrollableSetHadjustment'"] #-}
layoutSetHadjustment ::
(B.CallStack.HasCallStack, MonadIO m, IsLayout a, Gtk.Adjustment.IsAdjustment b) =>
a
-> Maybe (b)
-> m ()
layoutSetHadjustment :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayout a, IsAdjustment b) =>
a -> Maybe b -> m ()
layoutSetHadjustment a
layout Maybe b
adjustment = 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 Layout
layout' <- a -> IO (Ptr Layout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
Ptr Adjustment
maybeAdjustment <- case Maybe b
adjustment of
Maybe b
Nothing -> Ptr Adjustment -> IO (Ptr Adjustment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Adjustment
forall a. Ptr a
nullPtr
Just b
jAdjustment -> do
Ptr Adjustment
jAdjustment' <- b -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jAdjustment
Ptr Adjustment -> IO (Ptr Adjustment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Adjustment
jAdjustment'
Ptr Layout -> Ptr Adjustment -> IO ()
gtk_layout_set_hadjustment Ptr Layout
layout' Ptr Adjustment
maybeAdjustment
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
adjustment b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data LayoutSetHadjustmentMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsLayout a, Gtk.Adjustment.IsAdjustment b) => O.OverloadedMethod LayoutSetHadjustmentMethodInfo a signature where
overloadedMethod = layoutSetHadjustment
instance O.OverloadedMethodInfo LayoutSetHadjustmentMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Layout.layoutSetHadjustment",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Layout.html#v:layoutSetHadjustment"
})
#endif
foreign import ccall "gtk_layout_set_size" gtk_layout_set_size ::
Ptr Layout ->
Word32 ->
Word32 ->
IO ()
layoutSetSize ::
(B.CallStack.HasCallStack, MonadIO m, IsLayout a) =>
a
-> Word32
-> Word32
-> m ()
layoutSetSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLayout a) =>
a -> Word32 -> Word32 -> m ()
layoutSetSize a
layout Word32
width Word32
height = 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 Layout
layout' <- a -> IO (Ptr Layout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
Ptr Layout -> Word32 -> Word32 -> IO ()
gtk_layout_set_size Ptr Layout
layout' Word32
width Word32
height
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data LayoutSetSizeMethodInfo
instance (signature ~ (Word32 -> Word32 -> m ()), MonadIO m, IsLayout a) => O.OverloadedMethod LayoutSetSizeMethodInfo a signature where
overloadedMethod = layoutSetSize
instance O.OverloadedMethodInfo LayoutSetSizeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Layout.layoutSetSize",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Layout.html#v:layoutSetSize"
})
#endif
foreign import ccall "gtk_layout_set_vadjustment" gtk_layout_set_vadjustment ::
Ptr Layout ->
Ptr Gtk.Adjustment.Adjustment ->
IO ()
{-# DEPRECATED layoutSetVadjustment ["(Since version 3.0)","Use 'GI.Gtk.Interfaces.Scrollable.scrollableSetVadjustment'"] #-}
layoutSetVadjustment ::
(B.CallStack.HasCallStack, MonadIO m, IsLayout a, Gtk.Adjustment.IsAdjustment b) =>
a
-> Maybe (b)
-> m ()
layoutSetVadjustment :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsLayout a, IsAdjustment b) =>
a -> Maybe b -> m ()
layoutSetVadjustment a
layout Maybe b
adjustment = 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 Layout
layout' <- a -> IO (Ptr Layout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
layout
Ptr Adjustment
maybeAdjustment <- case Maybe b
adjustment of
Maybe b
Nothing -> Ptr Adjustment -> IO (Ptr Adjustment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Adjustment
forall a. Ptr a
nullPtr
Just b
jAdjustment -> do
Ptr Adjustment
jAdjustment' <- b -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jAdjustment
Ptr Adjustment -> IO (Ptr Adjustment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Adjustment
jAdjustment'
Ptr Layout -> Ptr Adjustment -> IO ()
gtk_layout_set_vadjustment Ptr Layout
layout' Ptr Adjustment
maybeAdjustment
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
layout
Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
adjustment b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data LayoutSetVadjustmentMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsLayout a, Gtk.Adjustment.IsAdjustment b) => O.OverloadedMethod LayoutSetVadjustmentMethodInfo a signature where
overloadedMethod = layoutSetVadjustment
instance O.OverloadedMethodInfo LayoutSetVadjustmentMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.Layout.layoutSetVadjustment",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.41/docs/GI-Gtk-Objects-Layout.html#v:layoutSetVadjustment"
})
#endif