{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Popups are positioned relative to their parent surface.
-- The GdkPopupLayout struct contains information that is
-- necessary to do so.

#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
-- ** Overloaded methods #method:Overloaded methods#

#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                ,


-- ** 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                ,


-- ** 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.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 Control.Monad.IO.Class as MIO
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 {-# 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

-- | 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
/= :: PopupLayout -> PopupLayout -> Bool
$c/= :: PopupLayout -> PopupLayout -> Bool
== :: PopupLayout -> PopupLayout -> Bool
$c== :: 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' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue PopupLayout where
    toGValue :: PopupLayout -> IO GValue
toGValue PopupLayout
o = do
        GType
gtype <- IO GType
c_gdk_popup_layout_get_type
        PopupLayout -> (Ptr PopupLayout -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr PopupLayout
o (GType
-> (GValue -> Ptr PopupLayout -> IO ())
-> Ptr PopupLayout
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr PopupLayout -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO PopupLayout
fromGValue GValue
gv = do
        Ptr PopupLayout
ptr <- GValue -> IO (Ptr PopupLayout)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr PopupLayout)
        (ManagedPtr PopupLayout -> PopupLayout)
-> Ptr PopupLayout -> IO PopupLayout
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr PopupLayout -> PopupLayout
PopupLayout Ptr PopupLayout
ptr
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PopupLayout
type instance O.AttributeList PopupLayout = PopupLayoutAttributeList
type PopupLayoutAttributeList = ('[ ] :: [(Symbol, *)])
#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
--           , 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
--           , 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
--           , 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
-- @/gdk_surface_present_popup()/@ 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 t'GI.Gdk.Structs.Rectangle.Rectangle' 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 t'GI.Gdk.Structs.PopupLayout.PopupLayout'
popupLayoutNew :: Rectangle -> Gravity -> Gravity -> m PopupLayout
popupLayoutNew Rectangle
anchorRect Gravity
rectAnchor Gravity
surfaceAnchor = IO PopupLayout -> m PopupLayout
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
    Ptr Rectangle
anchorRect' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
anchorRect
    let rectAnchor' :: CUInt
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' :: CUInt
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
    Ptr PopupLayout
result <- Ptr Rectangle -> CUInt -> CUInt -> IO (Ptr PopupLayout)
gdk_popup_layout_new Ptr Rectangle
anchorRect' CUInt
rectAnchor' CUInt
surfaceAnchor'
    Text -> Ptr PopupLayout -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"popupLayoutNew" Ptr PopupLayout
result
    PopupLayout
result' <- ((ManagedPtr PopupLayout -> PopupLayout)
-> Ptr PopupLayout -> IO PopupLayout
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr PopupLayout -> PopupLayout
PopupLayout) Ptr PopupLayout
result
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
anchorRect
    PopupLayout -> IO PopupLayout
forall (m :: * -> *) a. Monad m => a -> m a
return PopupLayout
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
--           , 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)

-- | Create a new t'GI.Gdk.Structs.PopupLayout.PopupLayout' and copy the contents of /@layout@/ into it.
popupLayoutCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a t'GI.Gdk.Structs.PopupLayout.PopupLayout'
    -> m PopupLayout
    -- ^ __Returns:__ a copy of /@layout@/.
popupLayoutCopy :: PopupLayout -> m PopupLayout
popupLayoutCopy PopupLayout
layout = IO PopupLayout -> m PopupLayout
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
    Ptr PopupLayout
layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    Ptr PopupLayout
result <- Ptr PopupLayout -> IO (Ptr PopupLayout)
gdk_popup_layout_copy Ptr PopupLayout
layout'
    Text -> Ptr PopupLayout -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"popupLayoutCopy" Ptr PopupLayout
result
    PopupLayout
result' <- ((ManagedPtr PopupLayout -> PopupLayout)
-> Ptr PopupLayout -> IO PopupLayout
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr PopupLayout -> PopupLayout
PopupLayout) Ptr PopupLayout
result
    PopupLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PopupLayout
layout
    PopupLayout -> IO PopupLayout
forall (m :: * -> *) a. Monad m => a -> m a
return PopupLayout
result'

#if defined(ENABLE_OVERLOADING)
data PopupLayoutCopyMethodInfo
instance (signature ~ (m PopupLayout), MonadIO m) => O.MethodInfo PopupLayoutCopyMethodInfo PopupLayout signature where
    overloadedMethod = 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
--           , 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
--           , 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 t'GI.Gdk.Structs.PopupLayout.PopupLayout'
    -> PopupLayout
    -- ^ /@other@/: another t'GI.Gdk.Structs.PopupLayout.PopupLayout'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@layout@/ and /@other@/ have identical layout properties,
    -- otherwise 'P.False'.
popupLayoutEqual :: PopupLayout -> PopupLayout -> m Bool
popupLayoutEqual PopupLayout
layout PopupLayout
other = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr PopupLayout
layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    Ptr PopupLayout
other' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
other
    CInt
result <- Ptr PopupLayout -> Ptr PopupLayout -> IO CInt
gdk_popup_layout_equal Ptr PopupLayout
layout' Ptr PopupLayout
other'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    PopupLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PopupLayout
layout
    PopupLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PopupLayout
other
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PopupLayoutEqualMethodInfo
instance (signature ~ (PopupLayout -> m Bool), MonadIO m) => O.MethodInfo PopupLayoutEqualMethodInfo PopupLayout signature where
    overloadedMethod = 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
--           , 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 t'GI.Gdk.Flags.AnchorHints'.
popupLayoutGetAnchorHints ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a t'GI.Gdk.Structs.PopupLayout.PopupLayout'
    -> m [Gdk.Flags.AnchorHints]
    -- ^ __Returns:__ the t'GI.Gdk.Flags.AnchorHints'.
popupLayoutGetAnchorHints :: PopupLayout -> m [AnchorHints]
popupLayoutGetAnchorHints PopupLayout
layout = IO [AnchorHints] -> m [AnchorHints]
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
    Ptr PopupLayout
layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    CUInt
result <- Ptr PopupLayout -> IO CUInt
gdk_popup_layout_get_anchor_hints Ptr PopupLayout
layout'
    let result' :: [AnchorHints]
result' = CUInt -> [AnchorHints]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    PopupLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PopupLayout
layout
    [AnchorHints] -> IO [AnchorHints]
forall (m :: * -> *) a. Monad m => a -> m a
return [AnchorHints]
result'

#if defined(ENABLE_OVERLOADING)
data PopupLayoutGetAnchorHintsMethodInfo
instance (signature ~ (m [Gdk.Flags.AnchorHints]), MonadIO m) => O.MethodInfo PopupLayoutGetAnchorHintsMethodInfo PopupLayout signature where
    overloadedMethod = 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
--           , 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 t'GI.Gdk.Structs.PopupLayout.PopupLayout'
    -> m Gdk.Rectangle.Rectangle
    -- ^ __Returns:__ The anchor rectangle.
popupLayoutGetAnchorRect :: PopupLayout -> m Rectangle
popupLayoutGetAnchorRect PopupLayout
layout = IO Rectangle -> m Rectangle
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
    Ptr PopupLayout
layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    Ptr Rectangle
result <- Ptr PopupLayout -> IO (Ptr Rectangle)
gdk_popup_layout_get_anchor_rect Ptr PopupLayout
layout'
    Text -> Ptr Rectangle -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"popupLayoutGetAnchorRect" Ptr Rectangle
result
    Rectangle
result' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Rectangle -> Rectangle
Gdk.Rectangle.Rectangle) Ptr Rectangle
result
    PopupLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PopupLayout
layout
    Rectangle -> IO Rectangle
forall (m :: * -> *) a. Monad m => a -> m a
return Rectangle
result'

#if defined(ENABLE_OVERLOADING)
data PopupLayoutGetAnchorRectMethodInfo
instance (signature ~ (m Gdk.Rectangle.Rectangle), MonadIO m) => O.MethodInfo PopupLayoutGetAnchorRectMethodInfo PopupLayout signature where
    overloadedMethod = 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
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dx"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a pointer to where to store the delta x coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dy"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a pointer to where to store the delta y coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- 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"})
    Int32 ->                                -- dx : TBasicType TInt
    Int32 ->                                -- dy : TBasicType TInt
    IO ()

-- | Get the delta the anchor rectangle is offset with
popupLayoutGetOffset ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PopupLayout
    -- ^ /@layout@/: a t'GI.Gdk.Structs.PopupLayout.PopupLayout'
    -> Int32
    -- ^ /@dx@/: a pointer to where to store the delta x coordinate
    -> Int32
    -- ^ /@dy@/: a pointer to where to store the delta y coordinate
    -> m ()
popupLayoutGetOffset :: PopupLayout -> Int32 -> Int32 -> m ()
popupLayoutGetOffset PopupLayout
layout Int32
dx Int32
dy = 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 PopupLayout
layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    Ptr PopupLayout -> Int32 -> Int32 -> IO ()
gdk_popup_layout_get_offset Ptr PopupLayout
layout' Int32
dx Int32
dy
    PopupLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PopupLayout
layout
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PopupLayoutGetOffsetMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m) => O.MethodInfo PopupLayoutGetOffsetMethodInfo PopupLayout signature where
    overloadedMethod = 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
--           , 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 t'GI.Gdk.Structs.PopupLayout.PopupLayout'
    -> m Gdk.Enums.Gravity
    -- ^ __Returns:__ the anchor on the anchor rectangle.
popupLayoutGetRectAnchor :: PopupLayout -> m Gravity
popupLayoutGetRectAnchor PopupLayout
layout = IO Gravity -> m Gravity
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
    Ptr PopupLayout
layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    CUInt
result <- Ptr PopupLayout -> IO CUInt
gdk_popup_layout_get_rect_anchor Ptr PopupLayout
layout'
    let result' :: Gravity
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
    PopupLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PopupLayout
layout
    Gravity -> IO Gravity
forall (m :: * -> *) a. Monad m => a -> m a
return Gravity
result'

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

#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
--           , 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 t'GI.Gdk.Structs.PopupLayout.PopupLayout'
    -> m Gdk.Enums.Gravity
    -- ^ __Returns:__ the anchor on the popup surface.
popupLayoutGetSurfaceAnchor :: PopupLayout -> m Gravity
popupLayoutGetSurfaceAnchor PopupLayout
layout = IO Gravity -> m Gravity
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
    Ptr PopupLayout
layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    CUInt
result <- Ptr PopupLayout -> IO CUInt
gdk_popup_layout_get_surface_anchor Ptr PopupLayout
layout'
    let result' :: Gravity
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
    PopupLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PopupLayout
layout
    Gravity -> IO Gravity
forall (m :: * -> *) a. Monad m => a -> m a
return Gravity
result'

#if defined(ENABLE_OVERLOADING)
data PopupLayoutGetSurfaceAnchorMethodInfo
instance (signature ~ (m Gdk.Enums.Gravity), MonadIO m) => O.MethodInfo PopupLayoutGetSurfaceAnchorMethodInfo PopupLayout signature where
    overloadedMethod = 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
--           , 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 t'GI.Gdk.Structs.PopupLayout.PopupLayout'
    -> m PopupLayout
    -- ^ __Returns:__ the same /@layout@/
popupLayoutRef :: PopupLayout -> m PopupLayout
popupLayoutRef PopupLayout
layout = IO PopupLayout -> m PopupLayout
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
    Ptr PopupLayout
layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    Ptr PopupLayout
result <- Ptr PopupLayout -> IO (Ptr PopupLayout)
gdk_popup_layout_ref Ptr PopupLayout
layout'
    Text -> Ptr PopupLayout -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"popupLayoutRef" Ptr PopupLayout
result
    PopupLayout
result' <- ((ManagedPtr PopupLayout -> PopupLayout)
-> Ptr PopupLayout -> IO PopupLayout
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr PopupLayout -> PopupLayout
PopupLayout) Ptr PopupLayout
result
    PopupLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PopupLayout
layout
    PopupLayout -> IO PopupLayout
forall (m :: * -> *) a. Monad m => a -> m a
return PopupLayout
result'

#if defined(ENABLE_OVERLOADING)
data PopupLayoutRefMethodInfo
instance (signature ~ (m PopupLayout), MonadIO m) => O.MethodInfo PopupLayoutRefMethodInfo PopupLayout signature where
    overloadedMethod = 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
--           , 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
--           , 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 t'GI.Gdk.Structs.PopupLayout.PopupLayout'
    -> [Gdk.Flags.AnchorHints]
    -- ^ /@anchorHints@/: the new t'GI.Gdk.Flags.AnchorHints'
    -> m ()
popupLayoutSetAnchorHints :: PopupLayout -> [AnchorHints] -> m ()
popupLayoutSetAnchorHints PopupLayout
layout [AnchorHints]
anchorHints = 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 PopupLayout
layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    let anchorHints' :: CUInt
anchorHints' = [AnchorHints] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [AnchorHints]
anchorHints
    Ptr PopupLayout -> CUInt -> IO ()
gdk_popup_layout_set_anchor_hints Ptr PopupLayout
layout' CUInt
anchorHints'
    PopupLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PopupLayout
layout
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PopupLayoutSetAnchorHintsMethodInfo
instance (signature ~ ([Gdk.Flags.AnchorHints] -> m ()), MonadIO m) => O.MethodInfo PopupLayoutSetAnchorHintsMethodInfo PopupLayout signature where
    overloadedMethod = 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
--           , 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
--           , 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 t'GI.Gdk.Structs.PopupLayout.PopupLayout'
    -> Gdk.Rectangle.Rectangle
    -- ^ /@anchorRect@/: the new anchor rectangle
    -> m ()
popupLayoutSetAnchorRect :: PopupLayout -> Rectangle -> m ()
popupLayoutSetAnchorRect PopupLayout
layout Rectangle
anchorRect = 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 PopupLayout
layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    Ptr Rectangle
anchorRect' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
anchorRect
    Ptr PopupLayout -> Ptr Rectangle -> IO ()
gdk_popup_layout_set_anchor_rect Ptr PopupLayout
layout' Ptr Rectangle
anchorRect'
    PopupLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PopupLayout
layout
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
anchorRect
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PopupLayoutSetAnchorRectMethodInfo
instance (signature ~ (Gdk.Rectangle.Rectangle -> m ()), MonadIO m) => O.MethodInfo PopupLayoutSetAnchorRectMethodInfo PopupLayout signature where
    overloadedMethod = 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
--           , 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
--           , 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
--           , 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 t'GI.Gdk.Structs.PopupLayout.PopupLayout'
    -> Int32
    -- ^ /@dx@/: x delta to offset the anchor rectangle with
    -> Int32
    -- ^ /@dy@/: y delta to offset the anchor rectangle with
    -> m ()
popupLayoutSetOffset :: PopupLayout -> Int32 -> Int32 -> m ()
popupLayoutSetOffset PopupLayout
layout Int32
dx Int32
dy = 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 PopupLayout
layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    Ptr PopupLayout -> Int32 -> Int32 -> IO ()
gdk_popup_layout_set_offset Ptr PopupLayout
layout' Int32
dx Int32
dy
    PopupLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PopupLayout
layout
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PopupLayoutSetOffsetMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m) => O.MethodInfo PopupLayoutSetOffsetMethodInfo PopupLayout signature where
    overloadedMethod = 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
--           , 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
--           , 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 t'GI.Gdk.Structs.PopupLayout.PopupLayout'
    -> Gdk.Enums.Gravity
    -- ^ /@anchor@/: the new rect anchor
    -> m ()
popupLayoutSetRectAnchor :: PopupLayout -> Gravity -> m ()
popupLayoutSetRectAnchor PopupLayout
layout Gravity
anchor = 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 PopupLayout
layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    let anchor' :: CUInt
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
    Ptr PopupLayout -> CUInt -> IO ()
gdk_popup_layout_set_rect_anchor Ptr PopupLayout
layout' CUInt
anchor'
    PopupLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PopupLayout
layout
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#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
--           , 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
--           , 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 t'GI.Gdk.Structs.PopupLayout.PopupLayout'
    -> Gdk.Enums.Gravity
    -- ^ /@anchor@/: the new popup surface anchor
    -> m ()
popupLayoutSetSurfaceAnchor :: PopupLayout -> Gravity -> m ()
popupLayoutSetSurfaceAnchor PopupLayout
layout Gravity
anchor = 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 PopupLayout
layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    let anchor' :: CUInt
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
    Ptr PopupLayout -> CUInt -> IO ()
gdk_popup_layout_set_surface_anchor Ptr PopupLayout
layout' CUInt
anchor'
    PopupLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PopupLayout
layout
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PopupLayoutSetSurfaceAnchorMethodInfo
instance (signature ~ (Gdk.Enums.Gravity -> m ()), MonadIO m) => O.MethodInfo PopupLayoutSetSurfaceAnchorMethodInfo PopupLayout signature where
    overloadedMethod = 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
--           , 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 t'GI.Gdk.Structs.PopupLayout.PopupLayout'
    -> m ()
popupLayoutUnref :: PopupLayout -> m ()
popupLayoutUnref PopupLayout
layout = 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 PopupLayout
layout' <- PopupLayout -> IO (Ptr PopupLayout)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PopupLayout
layout
    Ptr PopupLayout -> IO ()
gdk_popup_layout_unref Ptr PopupLayout
layout'
    PopupLayout -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PopupLayout
layout
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolvePopupLayoutMethod (t :: Symbol) (o :: *) :: * 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 "getSurfaceAnchor" o = PopupLayoutGetSurfaceAnchorMethodInfo
    ResolvePopupLayoutMethod "setAnchorHints" o = PopupLayoutSetAnchorHintsMethodInfo
    ResolvePopupLayoutMethod "setAnchorRect" o = PopupLayoutSetAnchorRectMethodInfo
    ResolvePopupLayoutMethod "setOffset" o = PopupLayoutSetOffsetMethodInfo
    ResolvePopupLayoutMethod "setRectAnchor" o = PopupLayoutSetRectAnchorMethodInfo
    ResolvePopupLayoutMethod "setSurfaceAnchor" o = PopupLayoutSetSurfaceAnchorMethodInfo
    ResolvePopupLayoutMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolvePopupLayoutMethod t PopupLayout, O.MethodInfo 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

#endif