{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The @GdkPopupLayout@ struct contains information that is
-- necessary position a t'GI.Gdk.Interfaces.Popup.Popup' relative to its parent.
-- 
-- The positioning requires a negotiation with the windowing system,
-- since it depends on external constraints, such as the position of
-- the parent surface, and the screen dimensions.
-- 
-- The basic ingredients are a rectangle on the parent surface,
-- and the anchor on both that rectangle and the popup. The anchors
-- specify a side or corner to place next to each other.
-- 
-- <<http://developer.gnome.org/gdk/stable/popup-anchors.png Popup anchors>>
-- 
-- For cases where placing the anchors next to each other would make
-- the popup extend offscreen, the layout includes some hints for how
-- to resolve this problem. The hints may suggest to flip the anchor
-- position to the other side, or to \'slide\' the popup along a side,
-- or to resize it.
-- 
-- <<http://developer.gnome.org/gdk/stable/popup-flip.png Flipping popups>>
-- 
-- <<http://developer.gnome.org/gdk/stable/popup-slide.png Sliding popups>>
-- 
-- These hints may be combined.
-- 
-- Ultimatively, it is up to the windowing system to determine the position
-- and size of the popup. You can learn about the result by calling
-- 'GI.Gdk.Interfaces.Popup.popupGetPositionX', 'GI.Gdk.Interfaces.Popup.popupGetPositionY',
-- 'GI.Gdk.Interfaces.Popup.popupGetRectAnchor' and 'GI.Gdk.Interfaces.Popup.popupGetSurfaceAnchor'
-- after the popup has been presented. This can be used to adjust the rendering.
-- For example, <http://developer.gnome.org/gdk/stable/../gtk4/class.Popover.html GtkPopover> changes its arrow position
-- accordingly. But you have to be careful avoid changing the size of the popover,
-- or it has to be presented again.

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

module GI.Gdk.Structs.PopupLayout
    ( 

-- * Exported types
    PopupLayout(..)                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Gdk.Structs.PopupLayout#g:method:copy"), [equal]("GI.Gdk.Structs.PopupLayout#g:method:equal"), [ref]("GI.Gdk.Structs.PopupLayout#g:method:ref"), [unref]("GI.Gdk.Structs.PopupLayout#g:method:unref").
-- 
-- ==== Getters
-- [getAnchorHints]("GI.Gdk.Structs.PopupLayout#g:method:getAnchorHints"), [getAnchorRect]("GI.Gdk.Structs.PopupLayout#g:method:getAnchorRect"), [getOffset]("GI.Gdk.Structs.PopupLayout#g:method:getOffset"), [getRectAnchor]("GI.Gdk.Structs.PopupLayout#g:method:getRectAnchor"), [getShadowWidth]("GI.Gdk.Structs.PopupLayout#g:method:getShadowWidth"), [getSurfaceAnchor]("GI.Gdk.Structs.PopupLayout#g:method:getSurfaceAnchor").
-- 
-- ==== Setters
-- [setAnchorHints]("GI.Gdk.Structs.PopupLayout#g:method:setAnchorHints"), [setAnchorRect]("GI.Gdk.Structs.PopupLayout#g:method:setAnchorRect"), [setOffset]("GI.Gdk.Structs.PopupLayout#g:method:setOffset"), [setRectAnchor]("GI.Gdk.Structs.PopupLayout#g:method:setRectAnchor"), [setShadowWidth]("GI.Gdk.Structs.PopupLayout#g:method:setShadowWidth"), [setSurfaceAnchor]("GI.Gdk.Structs.PopupLayout#g:method:setSurfaceAnchor").

#if defined(ENABLE_OVERLOADING)
    ResolvePopupLayoutMethod                ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutCopyMethodInfo               ,
#endif
    popupLayoutCopy                         ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutEqualMethodInfo              ,
#endif
    popupLayoutEqual                        ,


-- ** getAnchorHints #method:getAnchorHints#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutGetAnchorHintsMethodInfo     ,
#endif
    popupLayoutGetAnchorHints               ,


-- ** getAnchorRect #method:getAnchorRect#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutGetAnchorRectMethodInfo      ,
#endif
    popupLayoutGetAnchorRect                ,


-- ** getOffset #method:getOffset#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutGetOffsetMethodInfo          ,
#endif
    popupLayoutGetOffset                    ,


-- ** getRectAnchor #method:getRectAnchor#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutGetRectAnchorMethodInfo      ,
#endif
    popupLayoutGetRectAnchor                ,


-- ** getShadowWidth #method:getShadowWidth#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutGetShadowWidthMethodInfo     ,
#endif
    popupLayoutGetShadowWidth               ,


-- ** getSurfaceAnchor #method:getSurfaceAnchor#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutGetSurfaceAnchorMethodInfo   ,
#endif
    popupLayoutGetSurfaceAnchor             ,


-- ** new #method:new#

    popupLayoutNew                          ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutRefMethodInfo                ,
#endif
    popupLayoutRef                          ,


-- ** setAnchorHints #method:setAnchorHints#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutSetAnchorHintsMethodInfo     ,
#endif
    popupLayoutSetAnchorHints               ,


-- ** setAnchorRect #method:setAnchorRect#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutSetAnchorRectMethodInfo      ,
#endif
    popupLayoutSetAnchorRect                ,


-- ** setOffset #method:setOffset#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutSetOffsetMethodInfo          ,
#endif
    popupLayoutSetOffset                    ,


-- ** setRectAnchor #method:setRectAnchor#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutSetRectAnchorMethodInfo      ,
#endif
    popupLayoutSetRectAnchor                ,


-- ** setShadowWidth #method:setShadowWidth#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutSetShadowWidthMethodInfo     ,
#endif
    popupLayoutSetShadowWidth               ,


-- ** setSurfaceAnchor #method:setSurfaceAnchor#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutSetSurfaceAnchorMethodInfo   ,
#endif
    popupLayoutSetSurfaceAnchor             ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    PopupLayoutUnrefMethodInfo              ,
#endif
    popupLayoutUnref                        ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums
import {-# SOURCE #-} qualified GI.Gdk.Flags as Gdk.Flags
import {-# SOURCE #-} qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle

#else
import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums
import {-# SOURCE #-} qualified GI.Gdk.Flags as Gdk.Flags
import {-# SOURCE #-} qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle

#endif

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

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

foreign import ccall "gdk_popup_layout_get_type" c_gdk_popup_layout_get_type :: 
    IO GType

type instance O.ParentTypes PopupLayout = '[]
instance O.HasParentTypes PopupLayout

instance B.Types.TypedObject PopupLayout where
    glibType :: IO GType
glibType = IO GType
c_gdk_popup_layout_get_type

instance B.Types.GBoxed PopupLayout

-- | Convert 'PopupLayout' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe PopupLayout) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gdk_popup_layout_get_type
    gvalueSet_ :: Ptr GValue -> Maybe PopupLayout -> IO ()
gvalueSet_ Ptr GValue
gv Maybe PopupLayout
P.Nothing = Ptr GValue -> Ptr PopupLayout -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr PopupLayout
forall a. Ptr a
FP.nullPtr :: FP.Ptr PopupLayout)
    gvalueSet_ Ptr GValue
gv (P.Just PopupLayout
obj) = PopupLayout -> (Ptr PopupLayout -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr PopupLayout
obj (Ptr GValue -> Ptr PopupLayout -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe PopupLayout)
gvalueGet_ Ptr GValue
gv = do
        ptr <- Ptr GValue -> IO (Ptr PopupLayout)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr PopupLayout)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newBoxed PopupLayout ptr
        else return P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PopupLayout
type instance O.AttributeList PopupLayout = PopupLayoutAttributeList
type PopupLayoutAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method PopupLayout::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "anchor_rect"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the anchor `GdkRectangle` to align @surface with"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "rect_anchor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Gravity" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the point on @anchor_rect to align with @surface's anchor point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "surface_anchor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Gravity" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the point on @surface to align with @rect's anchor point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "PopupLayout" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_new" gdk_popup_layout_new :: 
    Ptr Gdk.Rectangle.Rectangle ->          -- anchor_rect : TInterface (Name {namespace = "Gdk", name = "Rectangle"})
    CUInt ->                                -- rect_anchor : TInterface (Name {namespace = "Gdk", name = "Gravity"})
    CUInt ->                                -- surface_anchor : TInterface (Name {namespace = "Gdk", name = "Gravity"})
    IO (Ptr PopupLayout)

-- | Create a popup layout description.
-- 
-- Used together with 'GI.Gdk.Interfaces.Popup.popupPresent' to describe how a popup
-- surface should be placed and behave on-screen.
-- 
-- /@anchorRect@/ is relative to the top-left corner of the surface\'s parent.
-- /@rectAnchor@/ and /@surfaceAnchor@/ determine anchor points on /@anchorRect@/
-- and surface to pin together.
-- 
-- The position of /@anchorRect@/\'s anchor point can optionally be offset using
-- 'GI.Gdk.Structs.PopupLayout.popupLayoutSetOffset', which is equivalent to offsetting the
-- position of surface.
popupLayoutNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Gdk.Rectangle.Rectangle
    -- ^ /@anchorRect@/: the anchor @GdkRectangle@ to align /@surface@/ with
    -> Gdk.Enums.Gravity
    -- ^ /@rectAnchor@/: the point on /@anchorRect@/ to align with /@surface@/\'s anchor point
    -> Gdk.Enums.Gravity
    -- ^ /@surfaceAnchor@/: the point on /@surface@/ to align with /@rect@/\'s anchor point
    -> m PopupLayout
    -- ^ __Returns:__ newly created instance of @GdkPopupLayout@
popupLayoutNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Rectangle -> Gravity -> Gravity -> m PopupLayout
popupLayoutNew Rectangle
anchorRect Gravity
rectAnchor Gravity
surfaceAnchor = IO PopupLayout -> m PopupLayout
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PopupLayout -> m PopupLayout)
-> IO PopupLayout -> m PopupLayout
forall a b. (a -> b) -> a -> b
$ do
    anchorRect' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
anchorRect
    let rectAnchor' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Gravity -> Int) -> Gravity -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gravity -> Int
forall a. Enum a => a -> Int
fromEnum) Gravity
rectAnchor
    let surfaceAnchor' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Gravity -> Int) -> Gravity -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gravity -> Int
forall a. Enum a => a -> Int
fromEnum) Gravity
surfaceAnchor
    result <- gdk_popup_layout_new anchorRect' rectAnchor' surfaceAnchor'
    checkUnexpectedReturnNULL "popupLayoutNew" result
    result' <- (wrapBoxed PopupLayout) result
    touchManagedPtr anchorRect
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method PopupLayout::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "PopupLayout" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_copy" gdk_popup_layout_copy :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    IO (Ptr PopupLayout)

-- | Makes a copy of /@layout@/.
popupLayoutCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> m PopupLayout
    -- ^ __Returns:__ a copy of /@layout@/.
popupLayoutCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> m PopupLayout
popupLayoutCopy PopupLayout
layout = IO PopupLayout -> m PopupLayout
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PopupLayout -> m PopupLayout)
-> IO PopupLayout -> m PopupLayout
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    result <- gdk_popup_layout_copy layout'
    checkUnexpectedReturnNULL "popupLayoutCopy" result
    result' <- (wrapBoxed PopupLayout) result
    touchManagedPtr layout
    return result'

#if defined(ENABLE_OVERLOADING)
data PopupLayoutCopyMethodInfo
instance (signature ~ (m PopupLayout), MonadIO m) => O.OverloadedMethod PopupLayoutCopyMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutCopy

instance O.OverloadedMethodInfo PopupLayoutCopyMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutCopy"
        })


#endif

-- method PopupLayout::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "other"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another `GdkPopupLayout`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_equal" gdk_popup_layout_equal :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    Ptr PopupLayout ->                      -- other : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    IO CInt

-- | Check whether /@layout@/ and /@other@/ has identical layout properties.
popupLayoutEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> PopupLayout
    -- ^ /@other@/: another @GdkPopupLayout@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@layout@/ and /@other@/ have identical layout properties,
    --   otherwise 'P.False'.
popupLayoutEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> PopupLayout -> m Bool
popupLayoutEqual PopupLayout
layout PopupLayout
other = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    other' <- unsafeManagedPtrGetPtr other
    result <- gdk_popup_layout_equal layout' other'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr layout
    touchManagedPtr other
    return result'

#if defined(ENABLE_OVERLOADING)
data PopupLayoutEqualMethodInfo
instance (signature ~ (PopupLayout -> m Bool), MonadIO m) => O.OverloadedMethod PopupLayoutEqualMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutEqual

instance O.OverloadedMethodInfo PopupLayoutEqualMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutEqual",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutEqual"
        })


#endif

-- method PopupLayout::get_anchor_hints
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "AnchorHints" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_get_anchor_hints" gdk_popup_layout_get_anchor_hints :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    IO CUInt

-- | Get the @GdkAnchorHints@.
popupLayoutGetAnchorHints ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> m [Gdk.Flags.AnchorHints]
    -- ^ __Returns:__ the @GdkAnchorHints@
popupLayoutGetAnchorHints :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> m [AnchorHints]
popupLayoutGetAnchorHints PopupLayout
layout = IO [AnchorHints] -> m [AnchorHints]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AnchorHints] -> m [AnchorHints])
-> IO [AnchorHints] -> m [AnchorHints]
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    result <- gdk_popup_layout_get_anchor_hints layout'
    let result' = CUInt -> [AnchorHints]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    touchManagedPtr layout
    return result'

#if defined(ENABLE_OVERLOADING)
data PopupLayoutGetAnchorHintsMethodInfo
instance (signature ~ (m [Gdk.Flags.AnchorHints]), MonadIO m) => O.OverloadedMethod PopupLayoutGetAnchorHintsMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutGetAnchorHints

instance O.OverloadedMethodInfo PopupLayoutGetAnchorHintsMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutGetAnchorHints",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutGetAnchorHints"
        })


#endif

-- method PopupLayout::get_anchor_rect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Rectangle" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_get_anchor_rect" gdk_popup_layout_get_anchor_rect :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    IO (Ptr Gdk.Rectangle.Rectangle)

-- | Get the anchor rectangle.
popupLayoutGetAnchorRect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> m Gdk.Rectangle.Rectangle
    -- ^ __Returns:__ The anchor rectangle
popupLayoutGetAnchorRect :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> m Rectangle
popupLayoutGetAnchorRect PopupLayout
layout = IO Rectangle -> m Rectangle
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rectangle -> m Rectangle) -> IO Rectangle -> m Rectangle
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    result <- gdk_popup_layout_get_anchor_rect layout'
    checkUnexpectedReturnNULL "popupLayoutGetAnchorRect" result
    result' <- (newBoxed Gdk.Rectangle.Rectangle) result
    touchManagedPtr layout
    return result'

#if defined(ENABLE_OVERLOADING)
data PopupLayoutGetAnchorRectMethodInfo
instance (signature ~ (m Gdk.Rectangle.Rectangle), MonadIO m) => O.OverloadedMethod PopupLayoutGetAnchorRectMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutGetAnchorRect

instance O.OverloadedMethodInfo PopupLayoutGetAnchorRectMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutGetAnchorRect",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutGetAnchorRect"
        })


#endif

-- method PopupLayout::get_offset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dx"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the delta X coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "dy"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the delta Y coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_get_offset" gdk_popup_layout_get_offset :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    Ptr Int32 ->                            -- dx : TBasicType TInt
    Ptr Int32 ->                            -- dy : TBasicType TInt
    IO ()

-- | Retrieves the offset for the anchor rectangle.
popupLayoutGetOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> m ((Int32, Int32))
popupLayoutGetOffset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> m (Int32, Int32)
popupLayoutGetOffset PopupLayout
layout = IO (Int32, Int32) -> m (Int32, Int32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32) -> m (Int32, Int32))
-> IO (Int32, Int32) -> m (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    dx <- allocMem :: IO (Ptr Int32)
    dy <- allocMem :: IO (Ptr Int32)
    gdk_popup_layout_get_offset layout' dx dy
    dx' <- peek dx
    dy' <- peek dy
    touchManagedPtr layout
    freeMem dx
    freeMem dy
    return (dx', dy')

#if defined(ENABLE_OVERLOADING)
data PopupLayoutGetOffsetMethodInfo
instance (signature ~ (m ((Int32, Int32))), MonadIO m) => O.OverloadedMethod PopupLayoutGetOffsetMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutGetOffset

instance O.OverloadedMethodInfo PopupLayoutGetOffsetMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutGetOffset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutGetOffset"
        })


#endif

-- method PopupLayout::get_rect_anchor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Gravity" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_get_rect_anchor" gdk_popup_layout_get_rect_anchor :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    IO CUInt

-- | Returns the anchor position on the anchor rectangle.
popupLayoutGetRectAnchor ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> m Gdk.Enums.Gravity
    -- ^ __Returns:__ the anchor on the anchor rectangle.
popupLayoutGetRectAnchor :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> m Gravity
popupLayoutGetRectAnchor PopupLayout
layout = IO Gravity -> m Gravity
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Gravity -> m Gravity) -> IO Gravity -> m Gravity
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    result <- gdk_popup_layout_get_rect_anchor layout'
    let result' = (Int -> Gravity
forall a. Enum a => Int -> a
toEnum (Int -> Gravity) -> (CUInt -> Int) -> CUInt -> Gravity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    touchManagedPtr layout
    return result'

#if defined(ENABLE_OVERLOADING)
data PopupLayoutGetRectAnchorMethodInfo
instance (signature ~ (m Gdk.Enums.Gravity), MonadIO m) => O.OverloadedMethod PopupLayoutGetRectAnchorMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutGetRectAnchor

instance O.OverloadedMethodInfo PopupLayoutGetRectAnchorMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutGetRectAnchor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutGetRectAnchor"
        })


#endif

-- method PopupLayout::get_shadow_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "left"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the left shadow width"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "right"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the right shadow width"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "top"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the top shadow width"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "bottom"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the bottom shadow width"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_get_shadow_width" gdk_popup_layout_get_shadow_width :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    Ptr Int32 ->                            -- left : TBasicType TInt
    Ptr Int32 ->                            -- right : TBasicType TInt
    Ptr Int32 ->                            -- top : TBasicType TInt
    Ptr Int32 ->                            -- bottom : TBasicType TInt
    IO ()

-- | Obtains the shadow widths of this layout.
-- 
-- /Since: 4.2/
popupLayoutGetShadowWidth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> m ((Int32, Int32, Int32, Int32))
popupLayoutGetShadowWidth :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> m (Int32, Int32, Int32, Int32)
popupLayoutGetShadowWidth PopupLayout
layout = IO (Int32, Int32, Int32, Int32) -> m (Int32, Int32, Int32, Int32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32, Int32, Int32) -> m (Int32, Int32, Int32, Int32))
-> IO (Int32, Int32, Int32, Int32)
-> m (Int32, Int32, Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    left <- allocMem :: IO (Ptr Int32)
    right <- allocMem :: IO (Ptr Int32)
    top <- allocMem :: IO (Ptr Int32)
    bottom <- allocMem :: IO (Ptr Int32)
    gdk_popup_layout_get_shadow_width layout' left right top bottom
    left' <- peek left
    right' <- peek right
    top' <- peek top
    bottom' <- peek bottom
    touchManagedPtr layout
    freeMem left
    freeMem right
    freeMem top
    freeMem bottom
    return (left', right', top', bottom')

#if defined(ENABLE_OVERLOADING)
data PopupLayoutGetShadowWidthMethodInfo
instance (signature ~ (m ((Int32, Int32, Int32, Int32))), MonadIO m) => O.OverloadedMethod PopupLayoutGetShadowWidthMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutGetShadowWidth

instance O.OverloadedMethodInfo PopupLayoutGetShadowWidthMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutGetShadowWidth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutGetShadowWidth"
        })


#endif

-- method PopupLayout::get_surface_anchor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Gravity" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_get_surface_anchor" gdk_popup_layout_get_surface_anchor :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    IO CUInt

-- | Returns the anchor position on the popup surface.
popupLayoutGetSurfaceAnchor ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> m Gdk.Enums.Gravity
    -- ^ __Returns:__ the anchor on the popup surface.
popupLayoutGetSurfaceAnchor :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> m Gravity
popupLayoutGetSurfaceAnchor PopupLayout
layout = IO Gravity -> m Gravity
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Gravity -> m Gravity) -> IO Gravity -> m Gravity
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    result <- gdk_popup_layout_get_surface_anchor layout'
    let result' = (Int -> Gravity
forall a. Enum a => Int -> a
toEnum (Int -> Gravity) -> (CUInt -> Int) -> CUInt -> Gravity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    touchManagedPtr layout
    return result'

#if defined(ENABLE_OVERLOADING)
data PopupLayoutGetSurfaceAnchorMethodInfo
instance (signature ~ (m Gdk.Enums.Gravity), MonadIO m) => O.OverloadedMethod PopupLayoutGetSurfaceAnchorMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutGetSurfaceAnchor

instance O.OverloadedMethodInfo PopupLayoutGetSurfaceAnchorMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutGetSurfaceAnchor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutGetSurfaceAnchor"
        })


#endif

-- method PopupLayout::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "PopupLayout" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_ref" gdk_popup_layout_ref :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    IO (Ptr PopupLayout)

-- | Increases the reference count of /@value@/.
popupLayoutRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> m PopupLayout
    -- ^ __Returns:__ the same /@layout@/
popupLayoutRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> m PopupLayout
popupLayoutRef PopupLayout
layout = IO PopupLayout -> m PopupLayout
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PopupLayout -> m PopupLayout)
-> IO PopupLayout -> m PopupLayout
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    result <- gdk_popup_layout_ref layout'
    checkUnexpectedReturnNULL "popupLayoutRef" result
    result' <- (wrapBoxed PopupLayout) result
    touchManagedPtr layout
    return result'

#if defined(ENABLE_OVERLOADING)
data PopupLayoutRefMethodInfo
instance (signature ~ (m PopupLayout), MonadIO m) => O.OverloadedMethod PopupLayoutRefMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutRef

instance O.OverloadedMethodInfo PopupLayoutRefMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutRef"
        })


#endif

-- method PopupLayout::set_anchor_hints
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "anchor_hints"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "AnchorHints" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new `GdkAnchorHints`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_set_anchor_hints" gdk_popup_layout_set_anchor_hints :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    CUInt ->                                -- anchor_hints : TInterface (Name {namespace = "Gdk", name = "AnchorHints"})
    IO ()

-- | Set new anchor hints.
-- 
-- The set /@anchorHints@/ determines how /@surface@/ will be moved
-- if the anchor points cause it to move off-screen. For example,
-- 'GI.Gdk.Flags.AnchorHintsFlipX' will replace 'GI.Gdk.Enums.GravityNorthWest' with
-- 'GI.Gdk.Enums.GravityNorthEast' and vice versa if /@surface@/ extends
-- beyond the left or right edges of the monitor.
popupLayoutSetAnchorHints ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> [Gdk.Flags.AnchorHints]
    -- ^ /@anchorHints@/: the new @GdkAnchorHints@
    -> m ()
popupLayoutSetAnchorHints :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> [AnchorHints] -> m ()
popupLayoutSetAnchorHints PopupLayout
layout [AnchorHints]
anchorHints = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    let anchorHints' = [AnchorHints] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [AnchorHints]
anchorHints
    gdk_popup_layout_set_anchor_hints layout' anchorHints'
    touchManagedPtr layout
    return ()

#if defined(ENABLE_OVERLOADING)
data PopupLayoutSetAnchorHintsMethodInfo
instance (signature ~ ([Gdk.Flags.AnchorHints] -> m ()), MonadIO m) => O.OverloadedMethod PopupLayoutSetAnchorHintsMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutSetAnchorHints

instance O.OverloadedMethodInfo PopupLayoutSetAnchorHintsMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutSetAnchorHints",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutSetAnchorHints"
        })


#endif

-- method PopupLayout::set_anchor_rect
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "anchor_rect"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new anchor rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_set_anchor_rect" gdk_popup_layout_set_anchor_rect :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    Ptr Gdk.Rectangle.Rectangle ->          -- anchor_rect : TInterface (Name {namespace = "Gdk", name = "Rectangle"})
    IO ()

-- | Set the anchor rectangle.
popupLayoutSetAnchorRect ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> Gdk.Rectangle.Rectangle
    -- ^ /@anchorRect@/: the new anchor rectangle
    -> m ()
popupLayoutSetAnchorRect :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> Rectangle -> m ()
popupLayoutSetAnchorRect PopupLayout
layout Rectangle
anchorRect = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    anchorRect' <- unsafeManagedPtrGetPtr anchorRect
    gdk_popup_layout_set_anchor_rect layout' anchorRect'
    touchManagedPtr layout
    touchManagedPtr anchorRect
    return ()

#if defined(ENABLE_OVERLOADING)
data PopupLayoutSetAnchorRectMethodInfo
instance (signature ~ (Gdk.Rectangle.Rectangle -> m ()), MonadIO m) => O.OverloadedMethod PopupLayoutSetAnchorRectMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutSetAnchorRect

instance O.OverloadedMethodInfo PopupLayoutSetAnchorRectMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutSetAnchorRect",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutSetAnchorRect"
        })


#endif

-- method PopupLayout::set_offset
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dx"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "x delta to offset the anchor rectangle with"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dy"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "y delta to offset the anchor rectangle with"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_set_offset" gdk_popup_layout_set_offset :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    Int32 ->                                -- dx : TBasicType TInt
    Int32 ->                                -- dy : TBasicType TInt
    IO ()

-- | Offset the position of the anchor rectangle with the given delta.
popupLayoutSetOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> Int32
    -- ^ /@dx@/: x delta to offset the anchor rectangle with
    -> Int32
    -- ^ /@dy@/: y delta to offset the anchor rectangle with
    -> m ()
popupLayoutSetOffset :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> Int32 -> Int32 -> m ()
popupLayoutSetOffset PopupLayout
layout Int32
dx Int32
dy = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    gdk_popup_layout_set_offset layout' dx dy
    touchManagedPtr layout
    return ()

#if defined(ENABLE_OVERLOADING)
data PopupLayoutSetOffsetMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m) => O.OverloadedMethod PopupLayoutSetOffsetMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutSetOffset

instance O.OverloadedMethodInfo PopupLayoutSetOffsetMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutSetOffset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutSetOffset"
        })


#endif

-- method PopupLayout::set_rect_anchor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "anchor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Gravity" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new rect anchor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_set_rect_anchor" gdk_popup_layout_set_rect_anchor :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    CUInt ->                                -- anchor : TInterface (Name {namespace = "Gdk", name = "Gravity"})
    IO ()

-- | Set the anchor on the anchor rectangle.
popupLayoutSetRectAnchor ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> Gdk.Enums.Gravity
    -- ^ /@anchor@/: the new rect anchor
    -> m ()
popupLayoutSetRectAnchor :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> Gravity -> m ()
popupLayoutSetRectAnchor PopupLayout
layout Gravity
anchor = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    let anchor' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Gravity -> Int) -> Gravity -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gravity -> Int
forall a. Enum a => a -> Int
fromEnum) Gravity
anchor
    gdk_popup_layout_set_rect_anchor layout' anchor'
    touchManagedPtr layout
    return ()

#if defined(ENABLE_OVERLOADING)
data PopupLayoutSetRectAnchorMethodInfo
instance (signature ~ (Gdk.Enums.Gravity -> m ()), MonadIO m) => O.OverloadedMethod PopupLayoutSetRectAnchorMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutSetRectAnchor

instance O.OverloadedMethodInfo PopupLayoutSetRectAnchorMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutSetRectAnchor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutSetRectAnchor"
        })


#endif

-- method PopupLayout::set_shadow_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "left"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "width of the left part of the shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "right"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "width of the right part of the shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "top"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "height of the top part of the shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bottom"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "height of the bottom part of the shadow"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_set_shadow_width" gdk_popup_layout_set_shadow_width :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    Int32 ->                                -- left : TBasicType TInt
    Int32 ->                                -- right : TBasicType TInt
    Int32 ->                                -- top : TBasicType TInt
    Int32 ->                                -- bottom : TBasicType TInt
    IO ()

-- | Sets the shadow width of the popup.
-- 
-- The shadow width corresponds to the part of the computed
-- surface size that would consist of the shadow margin
-- surrounding the window, would there be any.
-- 
-- /Since: 4.2/
popupLayoutSetShadowWidth ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> Int32
    -- ^ /@left@/: width of the left part of the shadow
    -> Int32
    -- ^ /@right@/: width of the right part of the shadow
    -> Int32
    -- ^ /@top@/: height of the top part of the shadow
    -> Int32
    -- ^ /@bottom@/: height of the bottom part of the shadow
    -> m ()
popupLayoutSetShadowWidth :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> Int32 -> Int32 -> Int32 -> Int32 -> m ()
popupLayoutSetShadowWidth PopupLayout
layout Int32
left Int32
right Int32
top Int32
bottom = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    gdk_popup_layout_set_shadow_width layout' left right top bottom
    touchManagedPtr layout
    return ()

#if defined(ENABLE_OVERLOADING)
data PopupLayoutSetShadowWidthMethodInfo
instance (signature ~ (Int32 -> Int32 -> Int32 -> Int32 -> m ()), MonadIO m) => O.OverloadedMethod PopupLayoutSetShadowWidthMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutSetShadowWidth

instance O.OverloadedMethodInfo PopupLayoutSetShadowWidthMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutSetShadowWidth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutSetShadowWidth"
        })


#endif

-- method PopupLayout::set_surface_anchor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "anchor"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Gravity" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new popup surface anchor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_set_surface_anchor" gdk_popup_layout_set_surface_anchor :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    CUInt ->                                -- anchor : TInterface (Name {namespace = "Gdk", name = "Gravity"})
    IO ()

-- | Set the anchor on the popup surface.
popupLayoutSetSurfaceAnchor ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> Gdk.Enums.Gravity
    -- ^ /@anchor@/: the new popup surface anchor
    -> m ()
popupLayoutSetSurfaceAnchor :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> Gravity -> m ()
popupLayoutSetSurfaceAnchor PopupLayout
layout Gravity
anchor = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    let anchor' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Gravity -> Int) -> Gravity -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gravity -> Int
forall a. Enum a => a -> Int
fromEnum) Gravity
anchor
    gdk_popup_layout_set_surface_anchor layout' anchor'
    touchManagedPtr layout
    return ()

#if defined(ENABLE_OVERLOADING)
data PopupLayoutSetSurfaceAnchorMethodInfo
instance (signature ~ (Gdk.Enums.Gravity -> m ()), MonadIO m) => O.OverloadedMethod PopupLayoutSetSurfaceAnchorMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutSetSurfaceAnchor

instance O.OverloadedMethodInfo PopupLayoutSetSurfaceAnchorMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutSetSurfaceAnchor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutSetSurfaceAnchor"
        })


#endif

-- method PopupLayout::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "layout"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "PopupLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPopupLayout`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_popup_layout_unref" gdk_popup_layout_unref :: 
    Ptr PopupLayout ->                      -- layout : TInterface (Name {namespace = "Gdk", name = "PopupLayout"})
    IO ()

-- | Decreases the reference count of /@value@/.
popupLayoutUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a @GdkPopupLayout@
    -> m ()
popupLayoutUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
PopupLayout -> m ()
popupLayoutUnref PopupLayout
layout = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    gdk_popup_layout_unref layout'
    touchManagedPtr layout
    return ()

#if defined(ENABLE_OVERLOADING)
data PopupLayoutUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod PopupLayoutUnrefMethodInfo PopupLayout signature where
    overloadedMethod = popupLayoutUnref

instance O.OverloadedMethodInfo PopupLayoutUnrefMethodInfo PopupLayout where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.PopupLayout.popupLayoutUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-PopupLayout.html#v:popupLayoutUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolvePopupLayoutMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePopupLayoutMethod "copy" o = PopupLayoutCopyMethodInfo
    ResolvePopupLayoutMethod "equal" o = PopupLayoutEqualMethodInfo
    ResolvePopupLayoutMethod "ref" o = PopupLayoutRefMethodInfo
    ResolvePopupLayoutMethod "unref" o = PopupLayoutUnrefMethodInfo
    ResolvePopupLayoutMethod "getAnchorHints" o = PopupLayoutGetAnchorHintsMethodInfo
    ResolvePopupLayoutMethod "getAnchorRect" o = PopupLayoutGetAnchorRectMethodInfo
    ResolvePopupLayoutMethod "getOffset" o = PopupLayoutGetOffsetMethodInfo
    ResolvePopupLayoutMethod "getRectAnchor" o = PopupLayoutGetRectAnchorMethodInfo
    ResolvePopupLayoutMethod "getShadowWidth" o = PopupLayoutGetShadowWidthMethodInfo
    ResolvePopupLayoutMethod "getSurfaceAnchor" o = PopupLayoutGetSurfaceAnchorMethodInfo
    ResolvePopupLayoutMethod "setAnchorHints" o = PopupLayoutSetAnchorHintsMethodInfo
    ResolvePopupLayoutMethod "setAnchorRect" o = PopupLayoutSetAnchorRectMethodInfo
    ResolvePopupLayoutMethod "setOffset" o = PopupLayoutSetOffsetMethodInfo
    ResolvePopupLayoutMethod "setRectAnchor" o = PopupLayoutSetRectAnchorMethodInfo
    ResolvePopupLayoutMethod "setShadowWidth" o = PopupLayoutSetShadowWidthMethodInfo
    ResolvePopupLayoutMethod "setSurfaceAnchor" o = PopupLayoutSetSurfaceAnchorMethodInfo
    ResolvePopupLayoutMethod l o = O.MethodResolutionFailed l o

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

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

#endif

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

#endif