{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gtk.Objects.Paned.Paned' has two panes, arranged either
-- horizontally or vertically. The division between
-- the two panes is adjustable by the user by dragging
-- a handle.
-- 
-- Child widgets are
-- added to the panes of the widget with 'GI.Gtk.Objects.Paned.panedPack1' and
-- 'GI.Gtk.Objects.Paned.panedPack2'. The division between the two children is set by default
-- from the size requests of the children, but it can be adjusted by the
-- user.
-- 
-- A paned widget draws a separator between the two child widgets and a
-- small handle that the user can drag to adjust the division. It does not
-- draw any relief around the children or around the separator. (The space
-- in which the separator is called the gutter.) Often, it is useful to put
-- each child inside a t'GI.Gtk.Objects.Frame.Frame' with the shadow type set to 'GI.Gtk.Enums.ShadowTypeIn'
-- so that the gutter appears as a ridge. No separator is drawn if one of
-- the children is missing.
-- 
-- Each child has two options that can be set, /@resize@/ and /@shrink@/. If
-- /@resize@/ is true, then when the t'GI.Gtk.Objects.Paned.Paned' is resized, that child will
-- expand or shrink along with the paned widget. If /@shrink@/ is true, then
-- that child can be made smaller than its requisition by the user.
-- Setting /@shrink@/ to 'P.False' allows the application to set a minimum size.
-- If /@resize@/ is false for both children, then this is treated as if
-- /@resize@/ is true for both children.
-- 
-- The application can set the position of the slider as if it were set
-- by the user, by calling 'GI.Gtk.Objects.Paned.panedSetPosition'.
-- 
-- = CSS nodes
-- 
-- 
-- === /plain code/
-- >
-- >paned
-- >├── <child>
-- >├── separator[.wide]
-- >╰── <child>
-- 
-- 
-- GtkPaned has a main CSS node with name paned, and a subnode for
-- the separator with name separator. The subnode gets a .wide style
-- class when the paned is supposed to be wide.
-- 
-- In horizontal orientation, the nodes are arranged based on the text
-- direction, so in left-to-right mode, :first-child will select the
-- leftmost child, while it will select the rightmost child in
-- RTL layouts.
-- 
-- == Creating a paned widget with minimum sizes.
-- 
-- 
-- === /C code/
-- >
-- >GtkWidget *hpaned = gtk_paned_new (GTK_ORIENTATION_HORIZONTAL);
-- >GtkWidget *frame1 = gtk_frame_new (NULL);
-- >GtkWidget *frame2 = gtk_frame_new (NULL);
-- >gtk_frame_set_shadow_type (GTK_FRAME (frame1), GTK_SHADOW_IN);
-- >gtk_frame_set_shadow_type (GTK_FRAME (frame2), GTK_SHADOW_IN);
-- >
-- >gtk_widget_set_size_request (hpaned, 200, -1);
-- >
-- >gtk_paned_pack1 (GTK_PANED (hpaned), frame1, TRUE, FALSE);
-- >gtk_widget_set_size_request (frame1, 50, -1);
-- >
-- >gtk_paned_pack2 (GTK_PANED (hpaned), frame2, FALSE, FALSE);
-- >gtk_widget_set_size_request (frame2, 50, -1);
-- 

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

module GI.Gtk.Objects.Paned
    ( 

-- * Exported types
    Paned(..)                               ,
    IsPaned                                 ,
    toPaned                                 ,
    noPaned                                 ,


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

#if defined(ENABLE_OVERLOADING)
    ResolvePanedMethod                      ,
#endif


-- ** add1 #method:add1#

#if defined(ENABLE_OVERLOADING)
    PanedAdd1MethodInfo                     ,
#endif
    panedAdd1                               ,


-- ** add2 #method:add2#

#if defined(ENABLE_OVERLOADING)
    PanedAdd2MethodInfo                     ,
#endif
    panedAdd2                               ,


-- ** getChild1 #method:getChild1#

#if defined(ENABLE_OVERLOADING)
    PanedGetChild1MethodInfo                ,
#endif
    panedGetChild1                          ,


-- ** getChild2 #method:getChild2#

#if defined(ENABLE_OVERLOADING)
    PanedGetChild2MethodInfo                ,
#endif
    panedGetChild2                          ,


-- ** getPosition #method:getPosition#

#if defined(ENABLE_OVERLOADING)
    PanedGetPositionMethodInfo              ,
#endif
    panedGetPosition                        ,


-- ** getWideHandle #method:getWideHandle#

#if defined(ENABLE_OVERLOADING)
    PanedGetWideHandleMethodInfo            ,
#endif
    panedGetWideHandle                      ,


-- ** new #method:new#

    panedNew                                ,


-- ** pack1 #method:pack1#

#if defined(ENABLE_OVERLOADING)
    PanedPack1MethodInfo                    ,
#endif
    panedPack1                              ,


-- ** pack2 #method:pack2#

#if defined(ENABLE_OVERLOADING)
    PanedPack2MethodInfo                    ,
#endif
    panedPack2                              ,


-- ** setPosition #method:setPosition#

#if defined(ENABLE_OVERLOADING)
    PanedSetPositionMethodInfo              ,
#endif
    panedSetPosition                        ,


-- ** setWideHandle #method:setWideHandle#

#if defined(ENABLE_OVERLOADING)
    PanedSetWideHandleMethodInfo            ,
#endif
    panedSetWideHandle                      ,




 -- * Properties
-- ** maxPosition #attr:maxPosition#
-- | The largest possible value for the position property.
-- This property is derived from the size and shrinkability
-- of the widget\'s children.

#if defined(ENABLE_OVERLOADING)
    PanedMaxPositionPropertyInfo            ,
#endif
    getPanedMaxPosition                     ,
#if defined(ENABLE_OVERLOADING)
    panedMaxPosition                        ,
#endif


-- ** minPosition #attr:minPosition#
-- | The smallest possible value for the position property.
-- This property is derived from the size and shrinkability
-- of the widget\'s children.

#if defined(ENABLE_OVERLOADING)
    PanedMinPositionPropertyInfo            ,
#endif
    getPanedMinPosition                     ,
#if defined(ENABLE_OVERLOADING)
    panedMinPosition                        ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    PanedPositionPropertyInfo               ,
#endif
    constructPanedPosition                  ,
    getPanedPosition                        ,
#if defined(ENABLE_OVERLOADING)
    panedPosition                           ,
#endif
    setPanedPosition                        ,


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

#if defined(ENABLE_OVERLOADING)
    PanedPositionSetPropertyInfo            ,
#endif
    constructPanedPositionSet               ,
    getPanedPositionSet                     ,
#if defined(ENABLE_OVERLOADING)
    panedPositionSet                        ,
#endif
    setPanedPositionSet                     ,


-- ** resizeChild1 #attr:resizeChild1#
-- | The \"resize-child1\" property determines whether the first child expands and
-- shrinks along with the paned widget.

#if defined(ENABLE_OVERLOADING)
    PanedResizeChild1PropertyInfo           ,
#endif
    constructPanedResizeChild1              ,
    getPanedResizeChild1                    ,
#if defined(ENABLE_OVERLOADING)
    panedResizeChild1                       ,
#endif
    setPanedResizeChild1                    ,


-- ** resizeChild2 #attr:resizeChild2#
-- | The \"resize-child2\" property determines whether the second child expands and
-- shrinks along with the paned widget.

#if defined(ENABLE_OVERLOADING)
    PanedResizeChild2PropertyInfo           ,
#endif
    constructPanedResizeChild2              ,
    getPanedResizeChild2                    ,
#if defined(ENABLE_OVERLOADING)
    panedResizeChild2                       ,
#endif
    setPanedResizeChild2                    ,


-- ** shrinkChild1 #attr:shrinkChild1#
-- | The \"shrink-child1\" property determines whether the first child can be made
-- smaller than its requisition.

#if defined(ENABLE_OVERLOADING)
    PanedShrinkChild1PropertyInfo           ,
#endif
    constructPanedShrinkChild1              ,
    getPanedShrinkChild1                    ,
#if defined(ENABLE_OVERLOADING)
    panedShrinkChild1                       ,
#endif
    setPanedShrinkChild1                    ,


-- ** shrinkChild2 #attr:shrinkChild2#
-- | The \"shrink-child2\" property determines whether the second child can be made
-- smaller than its requisition.

#if defined(ENABLE_OVERLOADING)
    PanedShrinkChild2PropertyInfo           ,
#endif
    constructPanedShrinkChild2              ,
    getPanedShrinkChild2                    ,
#if defined(ENABLE_OVERLOADING)
    panedShrinkChild2                       ,
#endif
    setPanedShrinkChild2                    ,


-- ** wideHandle #attr:wideHandle#
-- | Setting this property to 'P.True' indicates that the paned needs
-- to provide stronger visual separation (e.g. because it separates
-- between two notebooks, whose tab rows would otherwise merge visually).

#if defined(ENABLE_OVERLOADING)
    PanedWideHandlePropertyInfo             ,
#endif
    constructPanedWideHandle                ,
    getPanedWideHandle                      ,
#if defined(ENABLE_OVERLOADING)
    panedWideHandle                         ,
#endif
    setPanedWideHandle                      ,




 -- * Signals
-- ** acceptPosition #signal:acceptPosition#

    C_PanedAcceptPositionCallback           ,
    PanedAcceptPositionCallback             ,
#if defined(ENABLE_OVERLOADING)
    PanedAcceptPositionSignalInfo           ,
#endif
    afterPanedAcceptPosition                ,
    genClosure_PanedAcceptPosition          ,
    mk_PanedAcceptPositionCallback          ,
    noPanedAcceptPositionCallback           ,
    onPanedAcceptPosition                   ,
    wrap_PanedAcceptPositionCallback        ,


-- ** cancelPosition #signal:cancelPosition#

    C_PanedCancelPositionCallback           ,
    PanedCancelPositionCallback             ,
#if defined(ENABLE_OVERLOADING)
    PanedCancelPositionSignalInfo           ,
#endif
    afterPanedCancelPosition                ,
    genClosure_PanedCancelPosition          ,
    mk_PanedCancelPositionCallback          ,
    noPanedCancelPositionCallback           ,
    onPanedCancelPosition                   ,
    wrap_PanedCancelPositionCallback        ,


-- ** cycleChildFocus #signal:cycleChildFocus#

    C_PanedCycleChildFocusCallback          ,
    PanedCycleChildFocusCallback            ,
#if defined(ENABLE_OVERLOADING)
    PanedCycleChildFocusSignalInfo          ,
#endif
    afterPanedCycleChildFocus               ,
    genClosure_PanedCycleChildFocus         ,
    mk_PanedCycleChildFocusCallback         ,
    noPanedCycleChildFocusCallback          ,
    onPanedCycleChildFocus                  ,
    wrap_PanedCycleChildFocusCallback       ,


-- ** cycleHandleFocus #signal:cycleHandleFocus#

    C_PanedCycleHandleFocusCallback         ,
    PanedCycleHandleFocusCallback           ,
#if defined(ENABLE_OVERLOADING)
    PanedCycleHandleFocusSignalInfo         ,
#endif
    afterPanedCycleHandleFocus              ,
    genClosure_PanedCycleHandleFocus        ,
    mk_PanedCycleHandleFocusCallback        ,
    noPanedCycleHandleFocusCallback         ,
    onPanedCycleHandleFocus                 ,
    wrap_PanedCycleHandleFocusCallback      ,


-- ** moveHandle #signal:moveHandle#

    C_PanedMoveHandleCallback               ,
    PanedMoveHandleCallback                 ,
#if defined(ENABLE_OVERLOADING)
    PanedMoveHandleSignalInfo               ,
#endif
    afterPanedMoveHandle                    ,
    genClosure_PanedMoveHandle              ,
    mk_PanedMoveHandleCallback              ,
    noPanedMoveHandleCallback               ,
    onPanedMoveHandle                       ,
    wrap_PanedMoveHandleCallback            ,


-- ** toggleHandleFocus #signal:toggleHandleFocus#

    C_PanedToggleHandleFocusCallback        ,
    PanedToggleHandleFocusCallback          ,
#if defined(ENABLE_OVERLOADING)
    PanedToggleHandleFocusSignalInfo        ,
#endif
    afterPanedToggleHandleFocus             ,
    genClosure_PanedToggleHandleFocus       ,
    mk_PanedToggleHandleFocusCallback       ,
    noPanedToggleHandleFocusCallback        ,
    onPanedToggleHandleFocus                ,
    wrap_PanedToggleHandleFocusCallback     ,




    ) 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Orientable as Gtk.Orientable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Container as Gtk.Container
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

-- | Memory-managed wrapper type.
newtype Paned = Paned (ManagedPtr Paned)
    deriving (Paned -> Paned -> Bool
(Paned -> Paned -> Bool) -> (Paned -> Paned -> Bool) -> Eq Paned
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Paned -> Paned -> Bool
$c/= :: Paned -> Paned -> Bool
== :: Paned -> Paned -> Bool
$c== :: Paned -> Paned -> Bool
Eq)
foreign import ccall "gtk_paned_get_type"
    c_gtk_paned_get_type :: IO GType

instance GObject Paned where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_paned_get_type
    

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

-- | Type class for types which can be safely cast to `Paned`, for instance with `toPaned`.
class (GObject o, O.IsDescendantOf Paned o) => IsPaned o
instance (GObject o, O.IsDescendantOf Paned o) => IsPaned o

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `Paned`.
noPaned :: Maybe Paned
noPaned :: Maybe Paned
noPaned = Maybe Paned
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolvePanedMethod (t :: Symbol) (o :: *) :: * where
    ResolvePanedMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolvePanedMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolvePanedMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolvePanedMethod "add" o = Gtk.Container.ContainerAddMethodInfo
    ResolvePanedMethod "add1" o = PanedAdd1MethodInfo
    ResolvePanedMethod "add2" o = PanedAdd2MethodInfo
    ResolvePanedMethod "addAccelerator" o = Gtk.Widget.WidgetAddAcceleratorMethodInfo
    ResolvePanedMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolvePanedMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolvePanedMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolvePanedMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolvePanedMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolvePanedMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePanedMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePanedMethod "canActivateAccel" o = Gtk.Widget.WidgetCanActivateAccelMethodInfo
    ResolvePanedMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolvePanedMethod "childType" o = Gtk.Container.ContainerChildTypeMethodInfo
    ResolvePanedMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolvePanedMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolvePanedMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolvePanedMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolvePanedMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolvePanedMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolvePanedMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolvePanedMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolvePanedMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolvePanedMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolvePanedMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolvePanedMethod "destroy" o = Gtk.Widget.WidgetDestroyMethodInfo
    ResolvePanedMethod "destroyed" o = Gtk.Widget.WidgetDestroyedMethodInfo
    ResolvePanedMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
    ResolvePanedMethod "dragBegin" o = Gtk.Widget.WidgetDragBeginMethodInfo
    ResolvePanedMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolvePanedMethod "dragDestAddImageTargets" o = Gtk.Widget.WidgetDragDestAddImageTargetsMethodInfo
    ResolvePanedMethod "dragDestAddTextTargets" o = Gtk.Widget.WidgetDragDestAddTextTargetsMethodInfo
    ResolvePanedMethod "dragDestAddUriTargets" o = Gtk.Widget.WidgetDragDestAddUriTargetsMethodInfo
    ResolvePanedMethod "dragDestFindTarget" o = Gtk.Widget.WidgetDragDestFindTargetMethodInfo
    ResolvePanedMethod "dragDestGetTargetList" o = Gtk.Widget.WidgetDragDestGetTargetListMethodInfo
    ResolvePanedMethod "dragDestGetTrackMotion" o = Gtk.Widget.WidgetDragDestGetTrackMotionMethodInfo
    ResolvePanedMethod "dragDestSet" o = Gtk.Widget.WidgetDragDestSetMethodInfo
    ResolvePanedMethod "dragDestSetTargetList" o = Gtk.Widget.WidgetDragDestSetTargetListMethodInfo
    ResolvePanedMethod "dragDestSetTrackMotion" o = Gtk.Widget.WidgetDragDestSetTrackMotionMethodInfo
    ResolvePanedMethod "dragDestUnset" o = Gtk.Widget.WidgetDragDestUnsetMethodInfo
    ResolvePanedMethod "dragGetData" o = Gtk.Widget.WidgetDragGetDataMethodInfo
    ResolvePanedMethod "dragHighlight" o = Gtk.Widget.WidgetDragHighlightMethodInfo
    ResolvePanedMethod "dragSourceAddImageTargets" o = Gtk.Widget.WidgetDragSourceAddImageTargetsMethodInfo
    ResolvePanedMethod "dragSourceAddTextTargets" o = Gtk.Widget.WidgetDragSourceAddTextTargetsMethodInfo
    ResolvePanedMethod "dragSourceAddUriTargets" o = Gtk.Widget.WidgetDragSourceAddUriTargetsMethodInfo
    ResolvePanedMethod "dragSourceGetTargetList" o = Gtk.Widget.WidgetDragSourceGetTargetListMethodInfo
    ResolvePanedMethod "dragSourceSet" o = Gtk.Widget.WidgetDragSourceSetMethodInfo
    ResolvePanedMethod "dragSourceSetIconGicon" o = Gtk.Widget.WidgetDragSourceSetIconGiconMethodInfo
    ResolvePanedMethod "dragSourceSetIconName" o = Gtk.Widget.WidgetDragSourceSetIconNameMethodInfo
    ResolvePanedMethod "dragSourceSetIconPaintable" o = Gtk.Widget.WidgetDragSourceSetIconPaintableMethodInfo
    ResolvePanedMethod "dragSourceSetTargetList" o = Gtk.Widget.WidgetDragSourceSetTargetListMethodInfo
    ResolvePanedMethod "dragSourceUnset" o = Gtk.Widget.WidgetDragSourceUnsetMethodInfo
    ResolvePanedMethod "dragUnhighlight" o = Gtk.Widget.WidgetDragUnhighlightMethodInfo
    ResolvePanedMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolvePanedMethod "event" o = Gtk.Widget.WidgetEventMethodInfo
    ResolvePanedMethod "forall" o = Gtk.Container.ContainerForallMethodInfo
    ResolvePanedMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePanedMethod "foreach" o = Gtk.Container.ContainerForeachMethodInfo
    ResolvePanedMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePanedMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePanedMethod "grabAdd" o = Gtk.Widget.WidgetGrabAddMethodInfo
    ResolvePanedMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolvePanedMethod "grabRemove" o = Gtk.Widget.WidgetGrabRemoveMethodInfo
    ResolvePanedMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolvePanedMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolvePanedMethod "hasGrab" o = Gtk.Widget.WidgetHasGrabMethodInfo
    ResolvePanedMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolvePanedMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolvePanedMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolvePanedMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolvePanedMethod "inputShapeCombineRegion" o = Gtk.Widget.WidgetInputShapeCombineRegionMethodInfo
    ResolvePanedMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolvePanedMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolvePanedMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolvePanedMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolvePanedMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolvePanedMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePanedMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolvePanedMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolvePanedMethod "isToplevel" o = Gtk.Widget.WidgetIsToplevelMethodInfo
    ResolvePanedMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolvePanedMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolvePanedMethod "listAccelClosures" o = Gtk.Widget.WidgetListAccelClosuresMethodInfo
    ResolvePanedMethod "listActionPrefixes" o = Gtk.Widget.WidgetListActionPrefixesMethodInfo
    ResolvePanedMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolvePanedMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolvePanedMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolvePanedMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolvePanedMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePanedMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePanedMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolvePanedMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolvePanedMethod "pack1" o = PanedPack1MethodInfo
    ResolvePanedMethod "pack2" o = PanedPack2MethodInfo
    ResolvePanedMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolvePanedMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolvePanedMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolvePanedMethod "queueComputeExpand" o = Gtk.Widget.WidgetQueueComputeExpandMethodInfo
    ResolvePanedMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolvePanedMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolvePanedMethod "queueResizeNoRedraw" o = Gtk.Widget.WidgetQueueResizeNoRedrawMethodInfo
    ResolvePanedMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolvePanedMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePanedMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePanedMethod "registerSurface" o = Gtk.Widget.WidgetRegisterSurfaceMethodInfo
    ResolvePanedMethod "remove" o = Gtk.Container.ContainerRemoveMethodInfo
    ResolvePanedMethod "removeAccelerator" o = Gtk.Widget.WidgetRemoveAcceleratorMethodInfo
    ResolvePanedMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolvePanedMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolvePanedMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolvePanedMethod "resetStyle" o = Gtk.Widget.WidgetResetStyleMethodInfo
    ResolvePanedMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePanedMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolvePanedMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolvePanedMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolvePanedMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePanedMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePanedMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePanedMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolvePanedMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolvePanedMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolvePanedMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolvePanedMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolvePanedMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePanedMethod "unregisterSurface" o = Gtk.Widget.WidgetUnregisterSurfaceMethodInfo
    ResolvePanedMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolvePanedMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePanedMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
    ResolvePanedMethod "getActionGroup" o = Gtk.Widget.WidgetGetActionGroupMethodInfo
    ResolvePanedMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolvePanedMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolvePanedMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolvePanedMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolvePanedMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolvePanedMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolvePanedMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolvePanedMethod "getChild1" o = PanedGetChild1MethodInfo
    ResolvePanedMethod "getChild2" o = PanedGetChild2MethodInfo
    ResolvePanedMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolvePanedMethod "getChildren" o = Gtk.Container.ContainerGetChildrenMethodInfo
    ResolvePanedMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolvePanedMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolvePanedMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePanedMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolvePanedMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolvePanedMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolvePanedMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolvePanedMethod "getFocusHadjustment" o = Gtk.Container.ContainerGetFocusHadjustmentMethodInfo
    ResolvePanedMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolvePanedMethod "getFocusVadjustment" o = Gtk.Container.ContainerGetFocusVadjustmentMethodInfo
    ResolvePanedMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolvePanedMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolvePanedMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolvePanedMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolvePanedMethod "getHasSurface" o = Gtk.Widget.WidgetGetHasSurfaceMethodInfo
    ResolvePanedMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolvePanedMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolvePanedMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolvePanedMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolvePanedMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolvePanedMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolvePanedMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolvePanedMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolvePanedMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolvePanedMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolvePanedMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolvePanedMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolvePanedMethod "getModifierMask" o = Gtk.Widget.WidgetGetModifierMaskMethodInfo
    ResolvePanedMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolvePanedMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolvePanedMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolvePanedMethod "getOrientation" o = Gtk.Orientable.OrientableGetOrientationMethodInfo
    ResolvePanedMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolvePanedMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolvePanedMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolvePanedMethod "getPath" o = Gtk.Widget.WidgetGetPathMethodInfo
    ResolvePanedMethod "getPathForChild" o = Gtk.Container.ContainerGetPathForChildMethodInfo
    ResolvePanedMethod "getPosition" o = PanedGetPositionMethodInfo
    ResolvePanedMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolvePanedMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolvePanedMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolvePanedMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePanedMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePanedMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolvePanedMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolvePanedMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolvePanedMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolvePanedMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolvePanedMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolvePanedMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolvePanedMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolvePanedMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolvePanedMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolvePanedMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
    ResolvePanedMethod "getSurface" o = Gtk.Widget.WidgetGetSurfaceMethodInfo
    ResolvePanedMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolvePanedMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolvePanedMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolvePanedMethod "getTooltipWindow" o = Gtk.Widget.WidgetGetTooltipWindowMethodInfo
    ResolvePanedMethod "getToplevel" o = Gtk.Widget.WidgetGetToplevelMethodInfo
    ResolvePanedMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolvePanedMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolvePanedMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolvePanedMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolvePanedMethod "getWideHandle" o = PanedGetWideHandleMethodInfo
    ResolvePanedMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolvePanedMethod "setAccelPath" o = Gtk.Widget.WidgetSetAccelPathMethodInfo
    ResolvePanedMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolvePanedMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolvePanedMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolvePanedMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolvePanedMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolvePanedMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolvePanedMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePanedMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePanedMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolvePanedMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolvePanedMethod "setFocusHadjustment" o = Gtk.Container.ContainerSetFocusHadjustmentMethodInfo
    ResolvePanedMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolvePanedMethod "setFocusVadjustment" o = Gtk.Container.ContainerSetFocusVadjustmentMethodInfo
    ResolvePanedMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolvePanedMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolvePanedMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolvePanedMethod "setHasSurface" o = Gtk.Widget.WidgetSetHasSurfaceMethodInfo
    ResolvePanedMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolvePanedMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolvePanedMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolvePanedMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolvePanedMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolvePanedMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolvePanedMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolvePanedMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolvePanedMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolvePanedMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolvePanedMethod "setOrientation" o = Gtk.Orientable.OrientableSetOrientationMethodInfo
    ResolvePanedMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolvePanedMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolvePanedMethod "setPosition" o = PanedSetPositionMethodInfo
    ResolvePanedMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePanedMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolvePanedMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolvePanedMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolvePanedMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolvePanedMethod "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
    ResolvePanedMethod "setSurface" o = Gtk.Widget.WidgetSetSurfaceMethodInfo
    ResolvePanedMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolvePanedMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolvePanedMethod "setTooltipWindow" o = Gtk.Widget.WidgetSetTooltipWindowMethodInfo
    ResolvePanedMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolvePanedMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolvePanedMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolvePanedMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolvePanedMethod "setWideHandle" o = PanedSetWideHandleMethodInfo
    ResolvePanedMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal Paned::accept-position
-- | The [acceptPosition](#signal:acceptPosition) signal is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted to accept the current position of the handle when
-- moving it using key bindings.
-- 
-- The default binding for this signal is Return or Space.
type PanedAcceptPositionCallback =
    IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `PanedAcceptPositionCallback`@.
noPanedAcceptPositionCallback :: Maybe PanedAcceptPositionCallback
noPanedAcceptPositionCallback :: Maybe PanedAcceptPositionCallback
noPanedAcceptPositionCallback = Maybe PanedAcceptPositionCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_PanedAcceptPosition :: MonadIO m => PanedAcceptPositionCallback -> m (GClosure C_PanedAcceptPositionCallback)
genClosure_PanedAcceptPosition :: PanedAcceptPositionCallback
-> m (GClosure C_PanedAcceptPositionCallback)
genClosure_PanedAcceptPosition cb :: PanedAcceptPositionCallback
cb = IO (GClosure C_PanedAcceptPositionCallback)
-> m (GClosure C_PanedAcceptPositionCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_PanedAcceptPositionCallback)
 -> m (GClosure C_PanedAcceptPositionCallback))
-> IO (GClosure C_PanedAcceptPositionCallback)
-> m (GClosure C_PanedAcceptPositionCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedAcceptPositionCallback
cb' = PanedAcceptPositionCallback -> C_PanedAcceptPositionCallback
wrap_PanedAcceptPositionCallback PanedAcceptPositionCallback
cb
    C_PanedAcceptPositionCallback
-> IO (FunPtr C_PanedAcceptPositionCallback)
mk_PanedAcceptPositionCallback C_PanedAcceptPositionCallback
cb' IO (FunPtr C_PanedAcceptPositionCallback)
-> (FunPtr C_PanedAcceptPositionCallback
    -> IO (GClosure C_PanedAcceptPositionCallback))
-> IO (GClosure C_PanedAcceptPositionCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_PanedAcceptPositionCallback
-> IO (GClosure C_PanedAcceptPositionCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `PanedAcceptPositionCallback` into a `C_PanedAcceptPositionCallback`.
wrap_PanedAcceptPositionCallback ::
    PanedAcceptPositionCallback ->
    C_PanedAcceptPositionCallback
wrap_PanedAcceptPositionCallback :: PanedAcceptPositionCallback -> C_PanedAcceptPositionCallback
wrap_PanedAcceptPositionCallback _cb :: PanedAcceptPositionCallback
_cb _ _ = do
    Bool
result <- PanedAcceptPositionCallback
_cb 
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [acceptPosition](#signal:acceptPosition) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' paned #acceptPosition callback
-- @
-- 
-- 
onPanedAcceptPosition :: (IsPaned a, MonadIO m) => a -> PanedAcceptPositionCallback -> m SignalHandlerId
onPanedAcceptPosition :: a -> PanedAcceptPositionCallback -> m SignalHandlerId
onPanedAcceptPosition obj :: a
obj cb :: PanedAcceptPositionCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedAcceptPositionCallback
cb' = PanedAcceptPositionCallback -> C_PanedAcceptPositionCallback
wrap_PanedAcceptPositionCallback PanedAcceptPositionCallback
cb
    FunPtr C_PanedAcceptPositionCallback
cb'' <- C_PanedAcceptPositionCallback
-> IO (FunPtr C_PanedAcceptPositionCallback)
mk_PanedAcceptPositionCallback C_PanedAcceptPositionCallback
cb'
    a
-> Text
-> FunPtr C_PanedAcceptPositionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "accept-position" FunPtr C_PanedAcceptPositionCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [acceptPosition](#signal:acceptPosition) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' paned #acceptPosition callback
-- @
-- 
-- 
afterPanedAcceptPosition :: (IsPaned a, MonadIO m) => a -> PanedAcceptPositionCallback -> m SignalHandlerId
afterPanedAcceptPosition :: a -> PanedAcceptPositionCallback -> m SignalHandlerId
afterPanedAcceptPosition obj :: a
obj cb :: PanedAcceptPositionCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedAcceptPositionCallback
cb' = PanedAcceptPositionCallback -> C_PanedAcceptPositionCallback
wrap_PanedAcceptPositionCallback PanedAcceptPositionCallback
cb
    FunPtr C_PanedAcceptPositionCallback
cb'' <- C_PanedAcceptPositionCallback
-> IO (FunPtr C_PanedAcceptPositionCallback)
mk_PanedAcceptPositionCallback C_PanedAcceptPositionCallback
cb'
    a
-> Text
-> FunPtr C_PanedAcceptPositionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "accept-position" FunPtr C_PanedAcceptPositionCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanedAcceptPositionSignalInfo
instance SignalInfo PanedAcceptPositionSignalInfo where
    type HaskellCallbackType PanedAcceptPositionSignalInfo = PanedAcceptPositionCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanedAcceptPositionCallback cb
        cb'' <- mk_PanedAcceptPositionCallback cb'
        connectSignalFunPtr obj "accept-position" cb'' connectMode detail

#endif

-- signal Paned::cancel-position
-- | The [cancelPosition](#signal:cancelPosition) signal is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted to cancel moving the position of the handle using key
-- bindings. The position of the handle will be reset to the value prior to
-- moving it.
-- 
-- The default binding for this signal is Escape.
type PanedCancelPositionCallback =
    IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `PanedCancelPositionCallback`@.
noPanedCancelPositionCallback :: Maybe PanedCancelPositionCallback
noPanedCancelPositionCallback :: Maybe PanedAcceptPositionCallback
noPanedCancelPositionCallback = Maybe PanedAcceptPositionCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_PanedCancelPosition :: MonadIO m => PanedCancelPositionCallback -> m (GClosure C_PanedCancelPositionCallback)
genClosure_PanedCancelPosition :: PanedAcceptPositionCallback
-> m (GClosure C_PanedAcceptPositionCallback)
genClosure_PanedCancelPosition cb :: PanedAcceptPositionCallback
cb = IO (GClosure C_PanedAcceptPositionCallback)
-> m (GClosure C_PanedAcceptPositionCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_PanedAcceptPositionCallback)
 -> m (GClosure C_PanedAcceptPositionCallback))
-> IO (GClosure C_PanedAcceptPositionCallback)
-> m (GClosure C_PanedAcceptPositionCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedAcceptPositionCallback
cb' = PanedAcceptPositionCallback -> C_PanedAcceptPositionCallback
wrap_PanedCancelPositionCallback PanedAcceptPositionCallback
cb
    C_PanedAcceptPositionCallback
-> IO (FunPtr C_PanedAcceptPositionCallback)
mk_PanedCancelPositionCallback C_PanedAcceptPositionCallback
cb' IO (FunPtr C_PanedAcceptPositionCallback)
-> (FunPtr C_PanedAcceptPositionCallback
    -> IO (GClosure C_PanedAcceptPositionCallback))
-> IO (GClosure C_PanedAcceptPositionCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_PanedAcceptPositionCallback
-> IO (GClosure C_PanedAcceptPositionCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `PanedCancelPositionCallback` into a `C_PanedCancelPositionCallback`.
wrap_PanedCancelPositionCallback ::
    PanedCancelPositionCallback ->
    C_PanedCancelPositionCallback
wrap_PanedCancelPositionCallback :: PanedAcceptPositionCallback -> C_PanedAcceptPositionCallback
wrap_PanedCancelPositionCallback _cb :: PanedAcceptPositionCallback
_cb _ _ = do
    Bool
result <- PanedAcceptPositionCallback
_cb 
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [cancelPosition](#signal:cancelPosition) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' paned #cancelPosition callback
-- @
-- 
-- 
onPanedCancelPosition :: (IsPaned a, MonadIO m) => a -> PanedCancelPositionCallback -> m SignalHandlerId
onPanedCancelPosition :: a -> PanedAcceptPositionCallback -> m SignalHandlerId
onPanedCancelPosition obj :: a
obj cb :: PanedAcceptPositionCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedAcceptPositionCallback
cb' = PanedAcceptPositionCallback -> C_PanedAcceptPositionCallback
wrap_PanedCancelPositionCallback PanedAcceptPositionCallback
cb
    FunPtr C_PanedAcceptPositionCallback
cb'' <- C_PanedAcceptPositionCallback
-> IO (FunPtr C_PanedAcceptPositionCallback)
mk_PanedCancelPositionCallback C_PanedAcceptPositionCallback
cb'
    a
-> Text
-> FunPtr C_PanedAcceptPositionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "cancel-position" FunPtr C_PanedAcceptPositionCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [cancelPosition](#signal:cancelPosition) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' paned #cancelPosition callback
-- @
-- 
-- 
afterPanedCancelPosition :: (IsPaned a, MonadIO m) => a -> PanedCancelPositionCallback -> m SignalHandlerId
afterPanedCancelPosition :: a -> PanedAcceptPositionCallback -> m SignalHandlerId
afterPanedCancelPosition obj :: a
obj cb :: PanedAcceptPositionCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedAcceptPositionCallback
cb' = PanedAcceptPositionCallback -> C_PanedAcceptPositionCallback
wrap_PanedCancelPositionCallback PanedAcceptPositionCallback
cb
    FunPtr C_PanedAcceptPositionCallback
cb'' <- C_PanedAcceptPositionCallback
-> IO (FunPtr C_PanedAcceptPositionCallback)
mk_PanedCancelPositionCallback C_PanedAcceptPositionCallback
cb'
    a
-> Text
-> FunPtr C_PanedAcceptPositionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "cancel-position" FunPtr C_PanedAcceptPositionCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanedCancelPositionSignalInfo
instance SignalInfo PanedCancelPositionSignalInfo where
    type HaskellCallbackType PanedCancelPositionSignalInfo = PanedCancelPositionCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanedCancelPositionCallback cb
        cb'' <- mk_PanedCancelPositionCallback cb'
        connectSignalFunPtr obj "cancel-position" cb'' connectMode detail

#endif

-- signal Paned::cycle-child-focus
-- | The [cycleChildFocus](#signal:cycleChildFocus) signal is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted to cycle the focus between the children of the paned.
-- 
-- The default binding is f6.
type PanedCycleChildFocusCallback =
    Bool
    -- ^ /@reversed@/: whether cycling backward or forward
    -> IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `PanedCycleChildFocusCallback`@.
noPanedCycleChildFocusCallback :: Maybe PanedCycleChildFocusCallback
noPanedCycleChildFocusCallback :: Maybe PanedCycleChildFocusCallback
noPanedCycleChildFocusCallback = Maybe PanedCycleChildFocusCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_PanedCycleChildFocus :: MonadIO m => PanedCycleChildFocusCallback -> m (GClosure C_PanedCycleChildFocusCallback)
genClosure_PanedCycleChildFocus :: PanedCycleChildFocusCallback
-> m (GClosure C_PanedCycleChildFocusCallback)
genClosure_PanedCycleChildFocus cb :: PanedCycleChildFocusCallback
cb = IO (GClosure C_PanedCycleChildFocusCallback)
-> m (GClosure C_PanedCycleChildFocusCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_PanedCycleChildFocusCallback)
 -> m (GClosure C_PanedCycleChildFocusCallback))
-> IO (GClosure C_PanedCycleChildFocusCallback)
-> m (GClosure C_PanedCycleChildFocusCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedCycleChildFocusCallback
cb' = PanedCycleChildFocusCallback -> C_PanedCycleChildFocusCallback
wrap_PanedCycleChildFocusCallback PanedCycleChildFocusCallback
cb
    C_PanedCycleChildFocusCallback
-> IO (FunPtr C_PanedCycleChildFocusCallback)
mk_PanedCycleChildFocusCallback C_PanedCycleChildFocusCallback
cb' IO (FunPtr C_PanedCycleChildFocusCallback)
-> (FunPtr C_PanedCycleChildFocusCallback
    -> IO (GClosure C_PanedCycleChildFocusCallback))
-> IO (GClosure C_PanedCycleChildFocusCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_PanedCycleChildFocusCallback
-> IO (GClosure C_PanedCycleChildFocusCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `PanedCycleChildFocusCallback` into a `C_PanedCycleChildFocusCallback`.
wrap_PanedCycleChildFocusCallback ::
    PanedCycleChildFocusCallback ->
    C_PanedCycleChildFocusCallback
wrap_PanedCycleChildFocusCallback :: PanedCycleChildFocusCallback -> C_PanedCycleChildFocusCallback
wrap_PanedCycleChildFocusCallback _cb :: PanedCycleChildFocusCallback
_cb _ reversed :: CInt
reversed _ = do
    let reversed' :: Bool
reversed' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
reversed
    Bool
result <- PanedCycleChildFocusCallback
_cb  Bool
reversed'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [cycleChildFocus](#signal:cycleChildFocus) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' paned #cycleChildFocus callback
-- @
-- 
-- 
onPanedCycleChildFocus :: (IsPaned a, MonadIO m) => a -> PanedCycleChildFocusCallback -> m SignalHandlerId
onPanedCycleChildFocus :: a -> PanedCycleChildFocusCallback -> m SignalHandlerId
onPanedCycleChildFocus obj :: a
obj cb :: PanedCycleChildFocusCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedCycleChildFocusCallback
cb' = PanedCycleChildFocusCallback -> C_PanedCycleChildFocusCallback
wrap_PanedCycleChildFocusCallback PanedCycleChildFocusCallback
cb
    FunPtr C_PanedCycleChildFocusCallback
cb'' <- C_PanedCycleChildFocusCallback
-> IO (FunPtr C_PanedCycleChildFocusCallback)
mk_PanedCycleChildFocusCallback C_PanedCycleChildFocusCallback
cb'
    a
-> Text
-> FunPtr C_PanedCycleChildFocusCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "cycle-child-focus" FunPtr C_PanedCycleChildFocusCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [cycleChildFocus](#signal:cycleChildFocus) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' paned #cycleChildFocus callback
-- @
-- 
-- 
afterPanedCycleChildFocus :: (IsPaned a, MonadIO m) => a -> PanedCycleChildFocusCallback -> m SignalHandlerId
afterPanedCycleChildFocus :: a -> PanedCycleChildFocusCallback -> m SignalHandlerId
afterPanedCycleChildFocus obj :: a
obj cb :: PanedCycleChildFocusCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedCycleChildFocusCallback
cb' = PanedCycleChildFocusCallback -> C_PanedCycleChildFocusCallback
wrap_PanedCycleChildFocusCallback PanedCycleChildFocusCallback
cb
    FunPtr C_PanedCycleChildFocusCallback
cb'' <- C_PanedCycleChildFocusCallback
-> IO (FunPtr C_PanedCycleChildFocusCallback)
mk_PanedCycleChildFocusCallback C_PanedCycleChildFocusCallback
cb'
    a
-> Text
-> FunPtr C_PanedCycleChildFocusCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "cycle-child-focus" FunPtr C_PanedCycleChildFocusCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanedCycleChildFocusSignalInfo
instance SignalInfo PanedCycleChildFocusSignalInfo where
    type HaskellCallbackType PanedCycleChildFocusSignalInfo = PanedCycleChildFocusCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanedCycleChildFocusCallback cb
        cb'' <- mk_PanedCycleChildFocusCallback cb'
        connectSignalFunPtr obj "cycle-child-focus" cb'' connectMode detail

#endif

-- signal Paned::cycle-handle-focus
-- | The [cycleHandleFocus](#signal:cycleHandleFocus) signal is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted to cycle whether the paned should grab focus to allow
-- the user to change position of the handle by using key bindings.
-- 
-- The default binding for this signal is f8.
type PanedCycleHandleFocusCallback =
    Bool
    -- ^ /@reversed@/: whether cycling backward or forward
    -> IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `PanedCycleHandleFocusCallback`@.
noPanedCycleHandleFocusCallback :: Maybe PanedCycleHandleFocusCallback
noPanedCycleHandleFocusCallback :: Maybe PanedCycleChildFocusCallback
noPanedCycleHandleFocusCallback = Maybe PanedCycleChildFocusCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_PanedCycleHandleFocus :: MonadIO m => PanedCycleHandleFocusCallback -> m (GClosure C_PanedCycleHandleFocusCallback)
genClosure_PanedCycleHandleFocus :: PanedCycleChildFocusCallback
-> m (GClosure C_PanedCycleChildFocusCallback)
genClosure_PanedCycleHandleFocus cb :: PanedCycleChildFocusCallback
cb = IO (GClosure C_PanedCycleChildFocusCallback)
-> m (GClosure C_PanedCycleChildFocusCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_PanedCycleChildFocusCallback)
 -> m (GClosure C_PanedCycleChildFocusCallback))
-> IO (GClosure C_PanedCycleChildFocusCallback)
-> m (GClosure C_PanedCycleChildFocusCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedCycleChildFocusCallback
cb' = PanedCycleChildFocusCallback -> C_PanedCycleChildFocusCallback
wrap_PanedCycleHandleFocusCallback PanedCycleChildFocusCallback
cb
    C_PanedCycleChildFocusCallback
-> IO (FunPtr C_PanedCycleChildFocusCallback)
mk_PanedCycleHandleFocusCallback C_PanedCycleChildFocusCallback
cb' IO (FunPtr C_PanedCycleChildFocusCallback)
-> (FunPtr C_PanedCycleChildFocusCallback
    -> IO (GClosure C_PanedCycleChildFocusCallback))
-> IO (GClosure C_PanedCycleChildFocusCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_PanedCycleChildFocusCallback
-> IO (GClosure C_PanedCycleChildFocusCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `PanedCycleHandleFocusCallback` into a `C_PanedCycleHandleFocusCallback`.
wrap_PanedCycleHandleFocusCallback ::
    PanedCycleHandleFocusCallback ->
    C_PanedCycleHandleFocusCallback
wrap_PanedCycleHandleFocusCallback :: PanedCycleChildFocusCallback -> C_PanedCycleChildFocusCallback
wrap_PanedCycleHandleFocusCallback _cb :: PanedCycleChildFocusCallback
_cb _ reversed :: CInt
reversed _ = do
    let reversed' :: Bool
reversed' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
reversed
    Bool
result <- PanedCycleChildFocusCallback
_cb  Bool
reversed'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [cycleHandleFocus](#signal:cycleHandleFocus) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' paned #cycleHandleFocus callback
-- @
-- 
-- 
onPanedCycleHandleFocus :: (IsPaned a, MonadIO m) => a -> PanedCycleHandleFocusCallback -> m SignalHandlerId
onPanedCycleHandleFocus :: a -> PanedCycleChildFocusCallback -> m SignalHandlerId
onPanedCycleHandleFocus obj :: a
obj cb :: PanedCycleChildFocusCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedCycleChildFocusCallback
cb' = PanedCycleChildFocusCallback -> C_PanedCycleChildFocusCallback
wrap_PanedCycleHandleFocusCallback PanedCycleChildFocusCallback
cb
    FunPtr C_PanedCycleChildFocusCallback
cb'' <- C_PanedCycleChildFocusCallback
-> IO (FunPtr C_PanedCycleChildFocusCallback)
mk_PanedCycleHandleFocusCallback C_PanedCycleChildFocusCallback
cb'
    a
-> Text
-> FunPtr C_PanedCycleChildFocusCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "cycle-handle-focus" FunPtr C_PanedCycleChildFocusCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [cycleHandleFocus](#signal:cycleHandleFocus) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' paned #cycleHandleFocus callback
-- @
-- 
-- 
afterPanedCycleHandleFocus :: (IsPaned a, MonadIO m) => a -> PanedCycleHandleFocusCallback -> m SignalHandlerId
afterPanedCycleHandleFocus :: a -> PanedCycleChildFocusCallback -> m SignalHandlerId
afterPanedCycleHandleFocus obj :: a
obj cb :: PanedCycleChildFocusCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedCycleChildFocusCallback
cb' = PanedCycleChildFocusCallback -> C_PanedCycleChildFocusCallback
wrap_PanedCycleHandleFocusCallback PanedCycleChildFocusCallback
cb
    FunPtr C_PanedCycleChildFocusCallback
cb'' <- C_PanedCycleChildFocusCallback
-> IO (FunPtr C_PanedCycleChildFocusCallback)
mk_PanedCycleHandleFocusCallback C_PanedCycleChildFocusCallback
cb'
    a
-> Text
-> FunPtr C_PanedCycleChildFocusCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "cycle-handle-focus" FunPtr C_PanedCycleChildFocusCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanedCycleHandleFocusSignalInfo
instance SignalInfo PanedCycleHandleFocusSignalInfo where
    type HaskellCallbackType PanedCycleHandleFocusSignalInfo = PanedCycleHandleFocusCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanedCycleHandleFocusCallback cb
        cb'' <- mk_PanedCycleHandleFocusCallback cb'
        connectSignalFunPtr obj "cycle-handle-focus" cb'' connectMode detail

#endif

-- signal Paned::move-handle
-- | The [moveHandle](#signal:moveHandle) signal is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted to move the handle when the user is using key bindings
-- to move it.
type PanedMoveHandleCallback =
    Gtk.Enums.ScrollType
    -- ^ /@scrollType@/: a t'GI.Gtk.Enums.ScrollType'
    -> IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `PanedMoveHandleCallback`@.
noPanedMoveHandleCallback :: Maybe PanedMoveHandleCallback
noPanedMoveHandleCallback :: Maybe PanedMoveHandleCallback
noPanedMoveHandleCallback = Maybe PanedMoveHandleCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_PanedMoveHandle :: MonadIO m => PanedMoveHandleCallback -> m (GClosure C_PanedMoveHandleCallback)
genClosure_PanedMoveHandle :: PanedMoveHandleCallback -> m (GClosure C_PanedMoveHandleCallback)
genClosure_PanedMoveHandle cb :: PanedMoveHandleCallback
cb = IO (GClosure C_PanedMoveHandleCallback)
-> m (GClosure C_PanedMoveHandleCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_PanedMoveHandleCallback)
 -> m (GClosure C_PanedMoveHandleCallback))
-> IO (GClosure C_PanedMoveHandleCallback)
-> m (GClosure C_PanedMoveHandleCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedMoveHandleCallback
cb' = PanedMoveHandleCallback -> C_PanedMoveHandleCallback
wrap_PanedMoveHandleCallback PanedMoveHandleCallback
cb
    C_PanedMoveHandleCallback -> IO (FunPtr C_PanedMoveHandleCallback)
mk_PanedMoveHandleCallback C_PanedMoveHandleCallback
cb' IO (FunPtr C_PanedMoveHandleCallback)
-> (FunPtr C_PanedMoveHandleCallback
    -> IO (GClosure C_PanedMoveHandleCallback))
-> IO (GClosure C_PanedMoveHandleCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_PanedMoveHandleCallback
-> IO (GClosure C_PanedMoveHandleCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `PanedMoveHandleCallback` into a `C_PanedMoveHandleCallback`.
wrap_PanedMoveHandleCallback ::
    PanedMoveHandleCallback ->
    C_PanedMoveHandleCallback
wrap_PanedMoveHandleCallback :: PanedMoveHandleCallback -> C_PanedMoveHandleCallback
wrap_PanedMoveHandleCallback _cb :: PanedMoveHandleCallback
_cb _ scrollType :: CUInt
scrollType _ = do
    let scrollType' :: ScrollType
scrollType' = (Int -> ScrollType
forall a. Enum a => Int -> a
toEnum (Int -> ScrollType) -> (CUInt -> Int) -> CUInt -> ScrollType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
scrollType
    Bool
result <- PanedMoveHandleCallback
_cb  ScrollType
scrollType'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [moveHandle](#signal:moveHandle) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' paned #moveHandle callback
-- @
-- 
-- 
onPanedMoveHandle :: (IsPaned a, MonadIO m) => a -> PanedMoveHandleCallback -> m SignalHandlerId
onPanedMoveHandle :: a -> PanedMoveHandleCallback -> m SignalHandlerId
onPanedMoveHandle obj :: a
obj cb :: PanedMoveHandleCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedMoveHandleCallback
cb' = PanedMoveHandleCallback -> C_PanedMoveHandleCallback
wrap_PanedMoveHandleCallback PanedMoveHandleCallback
cb
    FunPtr C_PanedMoveHandleCallback
cb'' <- C_PanedMoveHandleCallback -> IO (FunPtr C_PanedMoveHandleCallback)
mk_PanedMoveHandleCallback C_PanedMoveHandleCallback
cb'
    a
-> Text
-> FunPtr C_PanedMoveHandleCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "move-handle" FunPtr C_PanedMoveHandleCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [moveHandle](#signal:moveHandle) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' paned #moveHandle callback
-- @
-- 
-- 
afterPanedMoveHandle :: (IsPaned a, MonadIO m) => a -> PanedMoveHandleCallback -> m SignalHandlerId
afterPanedMoveHandle :: a -> PanedMoveHandleCallback -> m SignalHandlerId
afterPanedMoveHandle obj :: a
obj cb :: PanedMoveHandleCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedMoveHandleCallback
cb' = PanedMoveHandleCallback -> C_PanedMoveHandleCallback
wrap_PanedMoveHandleCallback PanedMoveHandleCallback
cb
    FunPtr C_PanedMoveHandleCallback
cb'' <- C_PanedMoveHandleCallback -> IO (FunPtr C_PanedMoveHandleCallback)
mk_PanedMoveHandleCallback C_PanedMoveHandleCallback
cb'
    a
-> Text
-> FunPtr C_PanedMoveHandleCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "move-handle" FunPtr C_PanedMoveHandleCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanedMoveHandleSignalInfo
instance SignalInfo PanedMoveHandleSignalInfo where
    type HaskellCallbackType PanedMoveHandleSignalInfo = PanedMoveHandleCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanedMoveHandleCallback cb
        cb'' <- mk_PanedMoveHandleCallback cb'
        connectSignalFunPtr obj "move-handle" cb'' connectMode detail

#endif

-- signal Paned::toggle-handle-focus
-- | The [toggleHandleFocus](#signal:toggleHandleFocus) is a
-- [keybinding signal][GtkBindingSignal]
-- which gets emitted to accept the current position of the handle and then
-- move focus to the next widget in the focus chain.
-- 
-- The default binding is Tab.
type PanedToggleHandleFocusCallback =
    IO Bool

-- | A convenience synonym for @`Nothing` :: `Maybe` `PanedToggleHandleFocusCallback`@.
noPanedToggleHandleFocusCallback :: Maybe PanedToggleHandleFocusCallback
noPanedToggleHandleFocusCallback :: Maybe PanedAcceptPositionCallback
noPanedToggleHandleFocusCallback = Maybe PanedAcceptPositionCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_PanedToggleHandleFocus :: MonadIO m => PanedToggleHandleFocusCallback -> m (GClosure C_PanedToggleHandleFocusCallback)
genClosure_PanedToggleHandleFocus :: PanedAcceptPositionCallback
-> m (GClosure C_PanedAcceptPositionCallback)
genClosure_PanedToggleHandleFocus cb :: PanedAcceptPositionCallback
cb = IO (GClosure C_PanedAcceptPositionCallback)
-> m (GClosure C_PanedAcceptPositionCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_PanedAcceptPositionCallback)
 -> m (GClosure C_PanedAcceptPositionCallback))
-> IO (GClosure C_PanedAcceptPositionCallback)
-> m (GClosure C_PanedAcceptPositionCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedAcceptPositionCallback
cb' = PanedAcceptPositionCallback -> C_PanedAcceptPositionCallback
wrap_PanedToggleHandleFocusCallback PanedAcceptPositionCallback
cb
    C_PanedAcceptPositionCallback
-> IO (FunPtr C_PanedAcceptPositionCallback)
mk_PanedToggleHandleFocusCallback C_PanedAcceptPositionCallback
cb' IO (FunPtr C_PanedAcceptPositionCallback)
-> (FunPtr C_PanedAcceptPositionCallback
    -> IO (GClosure C_PanedAcceptPositionCallback))
-> IO (GClosure C_PanedAcceptPositionCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_PanedAcceptPositionCallback
-> IO (GClosure C_PanedAcceptPositionCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `PanedToggleHandleFocusCallback` into a `C_PanedToggleHandleFocusCallback`.
wrap_PanedToggleHandleFocusCallback ::
    PanedToggleHandleFocusCallback ->
    C_PanedToggleHandleFocusCallback
wrap_PanedToggleHandleFocusCallback :: PanedAcceptPositionCallback -> C_PanedAcceptPositionCallback
wrap_PanedToggleHandleFocusCallback _cb :: PanedAcceptPositionCallback
_cb _ _ = do
    Bool
result <- PanedAcceptPositionCallback
_cb 
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [toggleHandleFocus](#signal:toggleHandleFocus) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' paned #toggleHandleFocus callback
-- @
-- 
-- 
onPanedToggleHandleFocus :: (IsPaned a, MonadIO m) => a -> PanedToggleHandleFocusCallback -> m SignalHandlerId
onPanedToggleHandleFocus :: a -> PanedAcceptPositionCallback -> m SignalHandlerId
onPanedToggleHandleFocus obj :: a
obj cb :: PanedAcceptPositionCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedAcceptPositionCallback
cb' = PanedAcceptPositionCallback -> C_PanedAcceptPositionCallback
wrap_PanedToggleHandleFocusCallback PanedAcceptPositionCallback
cb
    FunPtr C_PanedAcceptPositionCallback
cb'' <- C_PanedAcceptPositionCallback
-> IO (FunPtr C_PanedAcceptPositionCallback)
mk_PanedToggleHandleFocusCallback C_PanedAcceptPositionCallback
cb'
    a
-> Text
-> FunPtr C_PanedAcceptPositionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "toggle-handle-focus" FunPtr C_PanedAcceptPositionCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [toggleHandleFocus](#signal:toggleHandleFocus) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' paned #toggleHandleFocus callback
-- @
-- 
-- 
afterPanedToggleHandleFocus :: (IsPaned a, MonadIO m) => a -> PanedToggleHandleFocusCallback -> m SignalHandlerId
afterPanedToggleHandleFocus :: a -> PanedAcceptPositionCallback -> m SignalHandlerId
afterPanedToggleHandleFocus obj :: a
obj cb :: PanedAcceptPositionCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_PanedAcceptPositionCallback
cb' = PanedAcceptPositionCallback -> C_PanedAcceptPositionCallback
wrap_PanedToggleHandleFocusCallback PanedAcceptPositionCallback
cb
    FunPtr C_PanedAcceptPositionCallback
cb'' <- C_PanedAcceptPositionCallback
-> IO (FunPtr C_PanedAcceptPositionCallback)
mk_PanedToggleHandleFocusCallback C_PanedAcceptPositionCallback
cb'
    a
-> Text
-> FunPtr C_PanedAcceptPositionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "toggle-handle-focus" FunPtr C_PanedAcceptPositionCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data PanedToggleHandleFocusSignalInfo
instance SignalInfo PanedToggleHandleFocusSignalInfo where
    type HaskellCallbackType PanedToggleHandleFocusSignalInfo = PanedToggleHandleFocusCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_PanedToggleHandleFocusCallback cb
        cb'' <- mk_PanedToggleHandleFocusCallback cb'
        connectSignalFunPtr obj "toggle-handle-focus" cb'' connectMode detail

#endif

-- VVV Prop "max-position"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data PanedMaxPositionPropertyInfo
instance AttrInfo PanedMaxPositionPropertyInfo where
    type AttrAllowedOps PanedMaxPositionPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint PanedMaxPositionPropertyInfo = IsPaned
    type AttrSetTypeConstraint PanedMaxPositionPropertyInfo = (~) ()
    type AttrTransferTypeConstraint PanedMaxPositionPropertyInfo = (~) ()
    type AttrTransferType PanedMaxPositionPropertyInfo = ()
    type AttrGetType PanedMaxPositionPropertyInfo = Int32
    type AttrLabel PanedMaxPositionPropertyInfo = "max-position"
    type AttrOrigin PanedMaxPositionPropertyInfo = Paned
    attrGet = getPanedMaxPosition
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "min-position"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data PanedMinPositionPropertyInfo
instance AttrInfo PanedMinPositionPropertyInfo where
    type AttrAllowedOps PanedMinPositionPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint PanedMinPositionPropertyInfo = IsPaned
    type AttrSetTypeConstraint PanedMinPositionPropertyInfo = (~) ()
    type AttrTransferTypeConstraint PanedMinPositionPropertyInfo = (~) ()
    type AttrTransferType PanedMinPositionPropertyInfo = ()
    type AttrGetType PanedMinPositionPropertyInfo = Int32
    type AttrLabel PanedMinPositionPropertyInfo = "min-position"
    type AttrOrigin PanedMinPositionPropertyInfo = Paned
    attrGet = getPanedMinPosition
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@position@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPanedPosition :: (IsPaned o) => Int32 -> IO (GValueConstruct o)
constructPanedPosition :: Int32 -> IO (GValueConstruct o)
constructPanedPosition val :: Int32
val = String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 "position" Int32
val

#if defined(ENABLE_OVERLOADING)
data PanedPositionPropertyInfo
instance AttrInfo PanedPositionPropertyInfo where
    type AttrAllowedOps PanedPositionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PanedPositionPropertyInfo = IsPaned
    type AttrSetTypeConstraint PanedPositionPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint PanedPositionPropertyInfo = (~) Int32
    type AttrTransferType PanedPositionPropertyInfo = Int32
    type AttrGetType PanedPositionPropertyInfo = Int32
    type AttrLabel PanedPositionPropertyInfo = "position"
    type AttrOrigin PanedPositionPropertyInfo = Paned
    attrGet = getPanedPosition
    attrSet = setPanedPosition
    attrTransfer _ v = do
        return v
    attrConstruct = constructPanedPosition
    attrClear = undefined
#endif

-- VVV Prop "position-set"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@position-set@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPanedPositionSet :: (IsPaned o) => Bool -> IO (GValueConstruct o)
constructPanedPositionSet :: Bool -> IO (GValueConstruct o)
constructPanedPositionSet val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "position-set" Bool
val

#if defined(ENABLE_OVERLOADING)
data PanedPositionSetPropertyInfo
instance AttrInfo PanedPositionSetPropertyInfo where
    type AttrAllowedOps PanedPositionSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PanedPositionSetPropertyInfo = IsPaned
    type AttrSetTypeConstraint PanedPositionSetPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PanedPositionSetPropertyInfo = (~) Bool
    type AttrTransferType PanedPositionSetPropertyInfo = Bool
    type AttrGetType PanedPositionSetPropertyInfo = Bool
    type AttrLabel PanedPositionSetPropertyInfo = "position-set"
    type AttrOrigin PanedPositionSetPropertyInfo = Paned
    attrGet = getPanedPositionSet
    attrSet = setPanedPositionSet
    attrTransfer _ v = do
        return v
    attrConstruct = constructPanedPositionSet
    attrClear = undefined
#endif

-- VVV Prop "resize-child1"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@resize-child1@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPanedResizeChild1 :: (IsPaned o) => Bool -> IO (GValueConstruct o)
constructPanedResizeChild1 :: Bool -> IO (GValueConstruct o)
constructPanedResizeChild1 val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "resize-child1" Bool
val

#if defined(ENABLE_OVERLOADING)
data PanedResizeChild1PropertyInfo
instance AttrInfo PanedResizeChild1PropertyInfo where
    type AttrAllowedOps PanedResizeChild1PropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PanedResizeChild1PropertyInfo = IsPaned
    type AttrSetTypeConstraint PanedResizeChild1PropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PanedResizeChild1PropertyInfo = (~) Bool
    type AttrTransferType PanedResizeChild1PropertyInfo = Bool
    type AttrGetType PanedResizeChild1PropertyInfo = Bool
    type AttrLabel PanedResizeChild1PropertyInfo = "resize-child1"
    type AttrOrigin PanedResizeChild1PropertyInfo = Paned
    attrGet = getPanedResizeChild1
    attrSet = setPanedResizeChild1
    attrTransfer _ v = do
        return v
    attrConstruct = constructPanedResizeChild1
    attrClear = undefined
#endif

-- VVV Prop "resize-child2"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@resize-child2@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPanedResizeChild2 :: (IsPaned o) => Bool -> IO (GValueConstruct o)
constructPanedResizeChild2 :: Bool -> IO (GValueConstruct o)
constructPanedResizeChild2 val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "resize-child2" Bool
val

#if defined(ENABLE_OVERLOADING)
data PanedResizeChild2PropertyInfo
instance AttrInfo PanedResizeChild2PropertyInfo where
    type AttrAllowedOps PanedResizeChild2PropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PanedResizeChild2PropertyInfo = IsPaned
    type AttrSetTypeConstraint PanedResizeChild2PropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PanedResizeChild2PropertyInfo = (~) Bool
    type AttrTransferType PanedResizeChild2PropertyInfo = Bool
    type AttrGetType PanedResizeChild2PropertyInfo = Bool
    type AttrLabel PanedResizeChild2PropertyInfo = "resize-child2"
    type AttrOrigin PanedResizeChild2PropertyInfo = Paned
    attrGet = getPanedResizeChild2
    attrSet = setPanedResizeChild2
    attrTransfer _ v = do
        return v
    attrConstruct = constructPanedResizeChild2
    attrClear = undefined
#endif

-- VVV Prop "shrink-child1"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@shrink-child1@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPanedShrinkChild1 :: (IsPaned o) => Bool -> IO (GValueConstruct o)
constructPanedShrinkChild1 :: Bool -> IO (GValueConstruct o)
constructPanedShrinkChild1 val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "shrink-child1" Bool
val

#if defined(ENABLE_OVERLOADING)
data PanedShrinkChild1PropertyInfo
instance AttrInfo PanedShrinkChild1PropertyInfo where
    type AttrAllowedOps PanedShrinkChild1PropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PanedShrinkChild1PropertyInfo = IsPaned
    type AttrSetTypeConstraint PanedShrinkChild1PropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PanedShrinkChild1PropertyInfo = (~) Bool
    type AttrTransferType PanedShrinkChild1PropertyInfo = Bool
    type AttrGetType PanedShrinkChild1PropertyInfo = Bool
    type AttrLabel PanedShrinkChild1PropertyInfo = "shrink-child1"
    type AttrOrigin PanedShrinkChild1PropertyInfo = Paned
    attrGet = getPanedShrinkChild1
    attrSet = setPanedShrinkChild1
    attrTransfer _ v = do
        return v
    attrConstruct = constructPanedShrinkChild1
    attrClear = undefined
#endif

-- VVV Prop "shrink-child2"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@shrink-child2@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPanedShrinkChild2 :: (IsPaned o) => Bool -> IO (GValueConstruct o)
constructPanedShrinkChild2 :: Bool -> IO (GValueConstruct o)
constructPanedShrinkChild2 val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "shrink-child2" Bool
val

#if defined(ENABLE_OVERLOADING)
data PanedShrinkChild2PropertyInfo
instance AttrInfo PanedShrinkChild2PropertyInfo where
    type AttrAllowedOps PanedShrinkChild2PropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PanedShrinkChild2PropertyInfo = IsPaned
    type AttrSetTypeConstraint PanedShrinkChild2PropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PanedShrinkChild2PropertyInfo = (~) Bool
    type AttrTransferType PanedShrinkChild2PropertyInfo = Bool
    type AttrGetType PanedShrinkChild2PropertyInfo = Bool
    type AttrLabel PanedShrinkChild2PropertyInfo = "shrink-child2"
    type AttrOrigin PanedShrinkChild2PropertyInfo = Paned
    attrGet = getPanedShrinkChild2
    attrSet = setPanedShrinkChild2
    attrTransfer _ v = do
        return v
    attrConstruct = constructPanedShrinkChild2
    attrClear = undefined
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@wide-handle@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructPanedWideHandle :: (IsPaned o) => Bool -> IO (GValueConstruct o)
constructPanedWideHandle :: Bool -> IO (GValueConstruct o)
constructPanedWideHandle val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "wide-handle" Bool
val

#if defined(ENABLE_OVERLOADING)
data PanedWideHandlePropertyInfo
instance AttrInfo PanedWideHandlePropertyInfo where
    type AttrAllowedOps PanedWideHandlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint PanedWideHandlePropertyInfo = IsPaned
    type AttrSetTypeConstraint PanedWideHandlePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint PanedWideHandlePropertyInfo = (~) Bool
    type AttrTransferType PanedWideHandlePropertyInfo = Bool
    type AttrGetType PanedWideHandlePropertyInfo = Bool
    type AttrLabel PanedWideHandlePropertyInfo = "wide-handle"
    type AttrOrigin PanedWideHandlePropertyInfo = Paned
    attrGet = getPanedWideHandle
    attrSet = setPanedWideHandle
    attrTransfer _ v = do
        return v
    attrConstruct = constructPanedWideHandle
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Paned
type instance O.AttributeList Paned = PanedAttributeList
type PanedAttributeList = ('[ '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("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), '("isFocus", Gtk.Widget.WidgetIsFocusPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("margin", Gtk.Widget.WidgetMarginPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("maxPosition", PanedMaxPositionPropertyInfo), '("minPosition", PanedMinPositionPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("orientation", Gtk.Orientable.OrientableOrientationPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("position", PanedPositionPropertyInfo), '("positionSet", PanedPositionSetPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("resizeChild1", PanedResizeChild1PropertyInfo), '("resizeChild2", PanedResizeChild2PropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("shrinkChild1", PanedShrinkChild1PropertyInfo), '("shrinkChild2", PanedShrinkChild2PropertyInfo), '("surface", Gtk.Widget.WidgetSurfacePropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("wideHandle", PanedWideHandlePropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
panedMaxPosition :: AttrLabelProxy "maxPosition"
panedMaxPosition = AttrLabelProxy

panedMinPosition :: AttrLabelProxy "minPosition"
panedMinPosition = AttrLabelProxy

panedPosition :: AttrLabelProxy "position"
panedPosition = AttrLabelProxy

panedPositionSet :: AttrLabelProxy "positionSet"
panedPositionSet = AttrLabelProxy

panedResizeChild1 :: AttrLabelProxy "resizeChild1"
panedResizeChild1 = AttrLabelProxy

panedResizeChild2 :: AttrLabelProxy "resizeChild2"
panedResizeChild2 = AttrLabelProxy

panedShrinkChild1 :: AttrLabelProxy "shrinkChild1"
panedShrinkChild1 = AttrLabelProxy

panedShrinkChild2 :: AttrLabelProxy "shrinkChild2"
panedShrinkChild2 = AttrLabelProxy

panedWideHandle :: AttrLabelProxy "wideHandle"
panedWideHandle = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Paned = PanedSignalList
type PanedSignalList = ('[ '("accelClosuresChanged", Gtk.Widget.WidgetAccelClosuresChangedSignalInfo), '("acceptPosition", PanedAcceptPositionSignalInfo), '("add", Gtk.Container.ContainerAddSignalInfo), '("canActivateAccel", Gtk.Widget.WidgetCanActivateAccelSignalInfo), '("cancelPosition", PanedCancelPositionSignalInfo), '("cycleChildFocus", PanedCycleChildFocusSignalInfo), '("cycleHandleFocus", PanedCycleHandleFocusSignalInfo), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("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), '("grabNotify", Gtk.Widget.WidgetGrabNotifySignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("moveHandle", PanedMoveHandleSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("popupMenu", Gtk.Widget.WidgetPopupMenuSignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("remove", Gtk.Container.ContainerRemoveSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("sizeAllocate", Gtk.Widget.WidgetSizeAllocateSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("styleUpdated", Gtk.Widget.WidgetStyleUpdatedSignalInfo), '("toggleHandleFocus", PanedToggleHandleFocusSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, *)])

#endif

-- method Paned::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "orientation"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Orientation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the paned\8217s orientation."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Paned" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_paned_new" gtk_paned_new :: 
    CUInt ->                                -- orientation : TInterface (Name {namespace = "Gtk", name = "Orientation"})
    IO (Ptr Paned)

-- | Creates a new t'GI.Gtk.Objects.Paned.Paned' widget.
panedNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gtk.Enums.Orientation
    -- ^ /@orientation@/: the paned’s orientation.
    -> m Paned
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.Paned.Paned'.
panedNew :: Orientation -> m Paned
panedNew orientation :: Orientation
orientation = IO Paned -> m Paned
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Paned -> m Paned) -> IO Paned -> m Paned
forall a b. (a -> b) -> a -> b
$ do
    let orientation' :: CUInt
orientation' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Orientation -> Int) -> Orientation -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Orientation -> Int
forall a. Enum a => a -> Int
fromEnum) Orientation
orientation
    Ptr Paned
result <- CUInt -> IO (Ptr Paned)
gtk_paned_new CUInt
orientation'
    Text -> Ptr Paned -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "panedNew" Ptr Paned
result
    Paned
result' <- ((ManagedPtr Paned -> Paned) -> Ptr Paned -> IO Paned
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Paned -> Paned
Paned) Ptr Paned
result
    Paned -> IO Paned
forall (m :: * -> *) a. Monad m => a -> m a
return Paned
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gtk_paned_add1" gtk_paned_add1 :: 
    Ptr Paned ->                            -- paned : TInterface (Name {namespace = "Gtk", name = "Paned"})
    Ptr Gtk.Widget.Widget ->                -- child : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | Adds a child to the top or left pane with default parameters. This is
-- equivalent to
-- @gtk_paned_pack1 (paned, child, FALSE, TRUE)@.
panedAdd1 ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaned a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@paned@/: a paned widget
    -> b
    -- ^ /@child@/: the child to add
    -> m ()
panedAdd1 :: a -> b -> m ()
panedAdd1 paned :: a
paned child :: b
child = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Paned
paned' <- a -> IO (Ptr Paned)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paned
    Ptr Widget
child' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    Ptr Paned -> Ptr Widget -> IO ()
gtk_paned_add1 Ptr Paned
paned' Ptr Widget
child'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paned
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanedAdd1MethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsPaned a, Gtk.Widget.IsWidget b) => O.MethodInfo PanedAdd1MethodInfo a signature where
    overloadedMethod = panedAdd1

#endif

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

foreign import ccall "gtk_paned_add2" gtk_paned_add2 :: 
    Ptr Paned ->                            -- paned : TInterface (Name {namespace = "Gtk", name = "Paned"})
    Ptr Gtk.Widget.Widget ->                -- child : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | Adds a child to the bottom or right pane with default parameters. This
-- is equivalent to
-- @gtk_paned_pack2 (paned, child, TRUE, TRUE)@.
panedAdd2 ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaned a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@paned@/: a paned widget
    -> b
    -- ^ /@child@/: the child to add
    -> m ()
panedAdd2 :: a -> b -> m ()
panedAdd2 paned :: a
paned child :: b
child = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Paned
paned' <- a -> IO (Ptr Paned)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paned
    Ptr Widget
child' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    Ptr Paned -> Ptr Widget -> IO ()
gtk_paned_add2 Ptr Paned
paned' Ptr Widget
child'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paned
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanedAdd2MethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsPaned a, Gtk.Widget.IsWidget b) => O.MethodInfo PanedAdd2MethodInfo a signature where
    overloadedMethod = panedAdd2

#endif

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

foreign import ccall "gtk_paned_get_child1" gtk_paned_get_child1 :: 
    Ptr Paned ->                            -- paned : TInterface (Name {namespace = "Gtk", name = "Paned"})
    IO (Ptr Gtk.Widget.Widget)

-- | Obtains the first child of the paned widget.
panedGetChild1 ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaned a) =>
    a
    -- ^ /@paned@/: a t'GI.Gtk.Objects.Paned.Paned' widget
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ first child, or 'P.Nothing' if it is not set.
panedGetChild1 :: a -> m (Maybe Widget)
panedGetChild1 paned :: a
paned = IO (Maybe Widget) -> m (Maybe Widget)
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 Paned
paned' <- a -> IO (Ptr Paned)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paned
    Ptr Widget
result <- Ptr Paned -> IO (Ptr Widget)
gtk_paned_get_child1 Ptr Paned
paned'
    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
$ \result' :: 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 (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paned
    Maybe Widget -> IO (Maybe Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data PanedGetChild1MethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsPaned a) => O.MethodInfo PanedGetChild1MethodInfo a signature where
    overloadedMethod = panedGetChild1

#endif

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

foreign import ccall "gtk_paned_get_child2" gtk_paned_get_child2 :: 
    Ptr Paned ->                            -- paned : TInterface (Name {namespace = "Gtk", name = "Paned"})
    IO (Ptr Gtk.Widget.Widget)

-- | Obtains the second child of the paned widget.
panedGetChild2 ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaned a) =>
    a
    -- ^ /@paned@/: a t'GI.Gtk.Objects.Paned.Paned' widget
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ second child, or 'P.Nothing' if it is not set.
panedGetChild2 :: a -> m (Maybe Widget)
panedGetChild2 paned :: a
paned = IO (Maybe Widget) -> m (Maybe Widget)
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 Paned
paned' <- a -> IO (Ptr Paned)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paned
    Ptr Widget
result <- Ptr Paned -> IO (Ptr Widget)
gtk_paned_get_child2 Ptr Paned
paned'
    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
$ \result' :: 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 (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paned
    Maybe Widget -> IO (Maybe Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data PanedGetChild2MethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsPaned a) => O.MethodInfo PanedGetChild2MethodInfo a signature where
    overloadedMethod = panedGetChild2

#endif

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

foreign import ccall "gtk_paned_get_position" gtk_paned_get_position :: 
    Ptr Paned ->                            -- paned : TInterface (Name {namespace = "Gtk", name = "Paned"})
    IO Int32

-- | Obtains the position of the divider between the two panes.
panedGetPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaned a) =>
    a
    -- ^ /@paned@/: a t'GI.Gtk.Objects.Paned.Paned' widget
    -> m Int32
    -- ^ __Returns:__ position of the divider
panedGetPosition :: a -> m Int32
panedGetPosition paned :: a
paned = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Paned
paned' <- a -> IO (Ptr Paned)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paned
    Int32
result <- Ptr Paned -> IO Int32
gtk_paned_get_position Ptr Paned
paned'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paned
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data PanedGetPositionMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsPaned a) => O.MethodInfo PanedGetPositionMethodInfo a signature where
    overloadedMethod = panedGetPosition

#endif

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

foreign import ccall "gtk_paned_get_wide_handle" gtk_paned_get_wide_handle :: 
    Ptr Paned ->                            -- paned : TInterface (Name {namespace = "Gtk", name = "Paned"})
    IO CInt

-- | Gets the t'GI.Gtk.Objects.Paned.Paned':@/wide-handle/@ property.
panedGetWideHandle ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaned a) =>
    a
    -- ^ /@paned@/: a t'GI.Gtk.Objects.Paned.Paned'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the paned should have a wide handle
panedGetWideHandle :: a -> m Bool
panedGetWideHandle paned :: a
paned = PanedAcceptPositionCallback -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (PanedAcceptPositionCallback -> m Bool)
-> PanedAcceptPositionCallback -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Paned
paned' <- a -> IO (Ptr Paned)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paned
    CInt
result <- Ptr Paned -> IO CInt
gtk_paned_get_wide_handle Ptr Paned
paned'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paned
    PanedCycleChildFocusCallback
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PanedGetWideHandleMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPaned a) => O.MethodInfo PanedGetWideHandleMethodInfo a signature where
    overloadedMethod = panedGetWideHandle

#endif

-- method Paned::pack1
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "paned"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Paned" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a paned widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the child to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "resize"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "should this child expand when the paned widget is resized."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "shrink"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "can this child be made smaller than its requisition."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_paned_pack1" gtk_paned_pack1 :: 
    Ptr Paned ->                            -- paned : TInterface (Name {namespace = "Gtk", name = "Paned"})
    Ptr Gtk.Widget.Widget ->                -- child : TInterface (Name {namespace = "Gtk", name = "Widget"})
    CInt ->                                 -- resize : TBasicType TBoolean
    CInt ->                                 -- shrink : TBasicType TBoolean
    IO ()

-- | Adds a child to the top or left pane.
panedPack1 ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaned a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@paned@/: a paned widget
    -> b
    -- ^ /@child@/: the child to add
    -> Bool
    -- ^ /@resize@/: should this child expand when the paned widget is resized.
    -> Bool
    -- ^ /@shrink@/: can this child be made smaller than its requisition.
    -> m ()
panedPack1 :: a -> b -> Bool -> Bool -> m ()
panedPack1 paned :: a
paned child :: b
child resize :: Bool
resize shrink :: Bool
shrink = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Paned
paned' <- a -> IO (Ptr Paned)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paned
    Ptr Widget
child' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    let resize' :: CInt
resize' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
resize
    let shrink' :: CInt
shrink' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
shrink
    Ptr Paned -> Ptr Widget -> CInt -> CInt -> IO ()
gtk_paned_pack1 Ptr Paned
paned' Ptr Widget
child' CInt
resize' CInt
shrink'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paned
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanedPack1MethodInfo
instance (signature ~ (b -> Bool -> Bool -> m ()), MonadIO m, IsPaned a, Gtk.Widget.IsWidget b) => O.MethodInfo PanedPack1MethodInfo a signature where
    overloadedMethod = panedPack1

#endif

-- method Paned::pack2
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "paned"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Paned" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a paned widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the child to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "resize"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "should this child expand when the paned widget is resized."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "shrink"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "can this child be made smaller than its requisition."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_paned_pack2" gtk_paned_pack2 :: 
    Ptr Paned ->                            -- paned : TInterface (Name {namespace = "Gtk", name = "Paned"})
    Ptr Gtk.Widget.Widget ->                -- child : TInterface (Name {namespace = "Gtk", name = "Widget"})
    CInt ->                                 -- resize : TBasicType TBoolean
    CInt ->                                 -- shrink : TBasicType TBoolean
    IO ()

-- | Adds a child to the bottom or right pane.
panedPack2 ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaned a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@paned@/: a paned widget
    -> b
    -- ^ /@child@/: the child to add
    -> Bool
    -- ^ /@resize@/: should this child expand when the paned widget is resized.
    -> Bool
    -- ^ /@shrink@/: can this child be made smaller than its requisition.
    -> m ()
panedPack2 :: a -> b -> Bool -> Bool -> m ()
panedPack2 paned :: a
paned child :: b
child resize :: Bool
resize shrink :: Bool
shrink = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Paned
paned' <- a -> IO (Ptr Paned)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paned
    Ptr Widget
child' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
child
    let resize' :: CInt
resize' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
resize
    let shrink' :: CInt
shrink' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
shrink
    Ptr Paned -> Ptr Widget -> CInt -> CInt -> IO ()
gtk_paned_pack2 Ptr Paned
paned' Ptr Widget
child' CInt
resize' CInt
shrink'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paned
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
child
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanedPack2MethodInfo
instance (signature ~ (b -> Bool -> Bool -> m ()), MonadIO m, IsPaned a, Gtk.Widget.IsWidget b) => O.MethodInfo PanedPack2MethodInfo a signature where
    overloadedMethod = panedPack2

#endif

-- method Paned::set_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "paned"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Paned" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkPaned widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "pixel position of divider, a negative value means that the position\n           is unset."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_paned_set_position" gtk_paned_set_position :: 
    Ptr Paned ->                            -- paned : TInterface (Name {namespace = "Gtk", name = "Paned"})
    Int32 ->                                -- position : TBasicType TInt
    IO ()

-- | Sets the position of the divider between the two panes.
panedSetPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaned a) =>
    a
    -- ^ /@paned@/: a t'GI.Gtk.Objects.Paned.Paned' widget
    -> Int32
    -- ^ /@position@/: pixel position of divider, a negative value means that the position
    --            is unset.
    -> m ()
panedSetPosition :: a -> Int32 -> m ()
panedSetPosition paned :: a
paned position :: Int32
position = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Paned
paned' <- a -> IO (Ptr Paned)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paned
    Ptr Paned -> Int32 -> IO ()
gtk_paned_set_position Ptr Paned
paned' Int32
position
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paned
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanedSetPositionMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsPaned a) => O.MethodInfo PanedSetPositionMethodInfo a signature where
    overloadedMethod = panedSetPosition

#endif

-- method Paned::set_wide_handle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "paned"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Paned" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkPaned" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "wide"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the new value for the #GtkPaned:wide-handle property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_paned_set_wide_handle" gtk_paned_set_wide_handle :: 
    Ptr Paned ->                            -- paned : TInterface (Name {namespace = "Gtk", name = "Paned"})
    CInt ->                                 -- wide : TBasicType TBoolean
    IO ()

-- | Sets the t'GI.Gtk.Objects.Paned.Paned':@/wide-handle/@ property.
panedSetWideHandle ::
    (B.CallStack.HasCallStack, MonadIO m, IsPaned a) =>
    a
    -- ^ /@paned@/: a t'GI.Gtk.Objects.Paned.Paned'
    -> Bool
    -- ^ /@wide@/: the new value for the t'GI.Gtk.Objects.Paned.Paned':@/wide-handle/@ property
    -> m ()
panedSetWideHandle :: a -> Bool -> m ()
panedSetWideHandle paned :: a
paned wide :: Bool
wide = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Paned
paned' <- a -> IO (Ptr Paned)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
paned
    let wide' :: CInt
wide' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
wide
    Ptr Paned -> CInt -> IO ()
gtk_paned_set_wide_handle Ptr Paned
paned' CInt
wide'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
paned
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PanedSetWideHandleMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsPaned a) => O.MethodInfo PanedSetWideHandleMethodInfo a signature where
    overloadedMethod = panedSetWideHandle

#endif