{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Poppler.Objects.AnnotMarkup
    ( 

-- * Exported types
    AnnotMarkup(..)                         ,
    IsAnnotMarkup                           ,
    toAnnotMarkup                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasPopup]("GI.Poppler.Objects.AnnotMarkup#g:method:hasPopup"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAnnotType]("GI.Poppler.Objects.Annot#g:method:getAnnotType"), [getColor]("GI.Poppler.Objects.Annot#g:method:getColor"), [getContents]("GI.Poppler.Objects.Annot#g:method:getContents"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDate]("GI.Poppler.Objects.AnnotMarkup#g:method:getDate"), [getExternalData]("GI.Poppler.Objects.AnnotMarkup#g:method:getExternalData"), [getFlags]("GI.Poppler.Objects.Annot#g:method:getFlags"), [getLabel]("GI.Poppler.Objects.AnnotMarkup#g:method:getLabel"), [getModified]("GI.Poppler.Objects.Annot#g:method:getModified"), [getName]("GI.Poppler.Objects.Annot#g:method:getName"), [getOpacity]("GI.Poppler.Objects.AnnotMarkup#g:method:getOpacity"), [getPageIndex]("GI.Poppler.Objects.Annot#g:method:getPageIndex"), [getPopupIsOpen]("GI.Poppler.Objects.AnnotMarkup#g:method:getPopupIsOpen"), [getPopupRectangle]("GI.Poppler.Objects.AnnotMarkup#g:method:getPopupRectangle"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRectangle]("GI.Poppler.Objects.Annot#g:method:getRectangle"), [getReplyTo]("GI.Poppler.Objects.AnnotMarkup#g:method:getReplyTo"), [getSubject]("GI.Poppler.Objects.AnnotMarkup#g:method:getSubject").
-- 
-- ==== Setters
-- [setColor]("GI.Poppler.Objects.Annot#g:method:setColor"), [setContents]("GI.Poppler.Objects.Annot#g:method:setContents"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFlags]("GI.Poppler.Objects.Annot#g:method:setFlags"), [setLabel]("GI.Poppler.Objects.AnnotMarkup#g:method:setLabel"), [setOpacity]("GI.Poppler.Objects.AnnotMarkup#g:method:setOpacity"), [setPopup]("GI.Poppler.Objects.AnnotMarkup#g:method:setPopup"), [setPopupIsOpen]("GI.Poppler.Objects.AnnotMarkup#g:method:setPopupIsOpen"), [setPopupRectangle]("GI.Poppler.Objects.AnnotMarkup#g:method:setPopupRectangle"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setRectangle]("GI.Poppler.Objects.Annot#g:method:setRectangle").

#if defined(ENABLE_OVERLOADING)
    ResolveAnnotMarkupMethod                ,
#endif

-- ** getDate #method:getDate#

#if defined(ENABLE_OVERLOADING)
    AnnotMarkupGetDateMethodInfo            ,
#endif
    annotMarkupGetDate                      ,


-- ** getExternalData #method:getExternalData#

#if defined(ENABLE_OVERLOADING)
    AnnotMarkupGetExternalDataMethodInfo    ,
#endif
    annotMarkupGetExternalData              ,


-- ** getLabel #method:getLabel#

#if defined(ENABLE_OVERLOADING)
    AnnotMarkupGetLabelMethodInfo           ,
#endif
    annotMarkupGetLabel                     ,


-- ** getOpacity #method:getOpacity#

#if defined(ENABLE_OVERLOADING)
    AnnotMarkupGetOpacityMethodInfo         ,
#endif
    annotMarkupGetOpacity                   ,


-- ** getPopupIsOpen #method:getPopupIsOpen#

#if defined(ENABLE_OVERLOADING)
    AnnotMarkupGetPopupIsOpenMethodInfo     ,
#endif
    annotMarkupGetPopupIsOpen               ,


-- ** getPopupRectangle #method:getPopupRectangle#

#if defined(ENABLE_OVERLOADING)
    AnnotMarkupGetPopupRectangleMethodInfo  ,
#endif
    annotMarkupGetPopupRectangle            ,


-- ** getReplyTo #method:getReplyTo#

#if defined(ENABLE_OVERLOADING)
    AnnotMarkupGetReplyToMethodInfo         ,
#endif
    annotMarkupGetReplyTo                   ,


-- ** getSubject #method:getSubject#

#if defined(ENABLE_OVERLOADING)
    AnnotMarkupGetSubjectMethodInfo         ,
#endif
    annotMarkupGetSubject                   ,


-- ** hasPopup #method:hasPopup#

#if defined(ENABLE_OVERLOADING)
    AnnotMarkupHasPopupMethodInfo           ,
#endif
    annotMarkupHasPopup                     ,


-- ** setLabel #method:setLabel#

#if defined(ENABLE_OVERLOADING)
    AnnotMarkupSetLabelMethodInfo           ,
#endif
    annotMarkupSetLabel                     ,


-- ** setOpacity #method:setOpacity#

#if defined(ENABLE_OVERLOADING)
    AnnotMarkupSetOpacityMethodInfo         ,
#endif
    annotMarkupSetOpacity                   ,


-- ** setPopup #method:setPopup#

#if defined(ENABLE_OVERLOADING)
    AnnotMarkupSetPopupMethodInfo           ,
#endif
    annotMarkupSetPopup                     ,


-- ** setPopupIsOpen #method:setPopupIsOpen#

#if defined(ENABLE_OVERLOADING)
    AnnotMarkupSetPopupIsOpenMethodInfo     ,
#endif
    annotMarkupSetPopupIsOpen               ,


-- ** setPopupRectangle #method:setPopupRectangle#

#if defined(ENABLE_OVERLOADING)
    AnnotMarkupSetPopupRectangleMethodInfo  ,
#endif
    annotMarkupSetPopupRectangle            ,




    ) 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.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GLib.Structs.Date as GLib.Date
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums
import {-# SOURCE #-} qualified GI.Poppler.Objects.Annot as Poppler.Annot
import {-# SOURCE #-} qualified GI.Poppler.Structs.Rectangle as Poppler.Rectangle

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

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

foreign import ccall "poppler_annot_markup_get_type"
    c_poppler_annot_markup_get_type :: IO B.Types.GType

instance B.Types.TypedObject AnnotMarkup where
    glibType :: IO GType
glibType = IO GType
c_poppler_annot_markup_get_type

instance B.Types.GObject AnnotMarkup

-- | Type class for types which can be safely cast to `AnnotMarkup`, for instance with `toAnnotMarkup`.
class (SP.GObject o, O.IsDescendantOf AnnotMarkup o) => IsAnnotMarkup o
instance (SP.GObject o, O.IsDescendantOf AnnotMarkup o) => IsAnnotMarkup o

instance O.HasParentTypes AnnotMarkup
type instance O.ParentTypes AnnotMarkup = '[Poppler.Annot.Annot, GObject.Object.Object]

-- | Cast to `AnnotMarkup`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toAnnotMarkup :: (MIO.MonadIO m, IsAnnotMarkup o) => o -> m AnnotMarkup
toAnnotMarkup :: forall (m :: * -> *) o.
(MonadIO m, IsAnnotMarkup o) =>
o -> m AnnotMarkup
toAnnotMarkup = IO AnnotMarkup -> m AnnotMarkup
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO AnnotMarkup -> m AnnotMarkup)
-> (o -> IO AnnotMarkup) -> o -> m AnnotMarkup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr AnnotMarkup -> AnnotMarkup) -> o -> IO AnnotMarkup
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr AnnotMarkup -> AnnotMarkup
AnnotMarkup

-- | Convert 'AnnotMarkup' 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 AnnotMarkup) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_poppler_annot_markup_get_type
    gvalueSet_ :: Ptr GValue -> Maybe AnnotMarkup -> IO ()
gvalueSet_ Ptr GValue
gv Maybe AnnotMarkup
P.Nothing = Ptr GValue -> Ptr AnnotMarkup -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr AnnotMarkup
forall a. Ptr a
FP.nullPtr :: FP.Ptr AnnotMarkup)
    gvalueSet_ Ptr GValue
gv (P.Just AnnotMarkup
obj) = AnnotMarkup -> (Ptr AnnotMarkup -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr AnnotMarkup
obj (Ptr GValue -> Ptr AnnotMarkup -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe AnnotMarkup)
gvalueGet_ Ptr GValue
gv = do
        Ptr AnnotMarkup
ptr <- Ptr GValue -> IO (Ptr AnnotMarkup)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr AnnotMarkup)
        if Ptr AnnotMarkup
ptr Ptr AnnotMarkup -> Ptr AnnotMarkup -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr AnnotMarkup
forall a. Ptr a
FP.nullPtr
        then AnnotMarkup -> Maybe AnnotMarkup
forall a. a -> Maybe a
P.Just (AnnotMarkup -> Maybe AnnotMarkup)
-> IO AnnotMarkup -> IO (Maybe AnnotMarkup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr AnnotMarkup -> AnnotMarkup)
-> Ptr AnnotMarkup -> IO AnnotMarkup
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr AnnotMarkup -> AnnotMarkup
AnnotMarkup Ptr AnnotMarkup
ptr
        else Maybe AnnotMarkup -> IO (Maybe AnnotMarkup)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AnnotMarkup
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveAnnotMarkupMethod (t :: Symbol) (o :: *) :: * where
    ResolveAnnotMarkupMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAnnotMarkupMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAnnotMarkupMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAnnotMarkupMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAnnotMarkupMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAnnotMarkupMethod "hasPopup" o = AnnotMarkupHasPopupMethodInfo
    ResolveAnnotMarkupMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAnnotMarkupMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAnnotMarkupMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAnnotMarkupMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAnnotMarkupMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAnnotMarkupMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAnnotMarkupMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAnnotMarkupMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAnnotMarkupMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAnnotMarkupMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAnnotMarkupMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAnnotMarkupMethod "getAnnotType" o = Poppler.Annot.AnnotGetAnnotTypeMethodInfo
    ResolveAnnotMarkupMethod "getColor" o = Poppler.Annot.AnnotGetColorMethodInfo
    ResolveAnnotMarkupMethod "getContents" o = Poppler.Annot.AnnotGetContentsMethodInfo
    ResolveAnnotMarkupMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAnnotMarkupMethod "getDate" o = AnnotMarkupGetDateMethodInfo
    ResolveAnnotMarkupMethod "getExternalData" o = AnnotMarkupGetExternalDataMethodInfo
    ResolveAnnotMarkupMethod "getFlags" o = Poppler.Annot.AnnotGetFlagsMethodInfo
    ResolveAnnotMarkupMethod "getLabel" o = AnnotMarkupGetLabelMethodInfo
    ResolveAnnotMarkupMethod "getModified" o = Poppler.Annot.AnnotGetModifiedMethodInfo
    ResolveAnnotMarkupMethod "getName" o = Poppler.Annot.AnnotGetNameMethodInfo
    ResolveAnnotMarkupMethod "getOpacity" o = AnnotMarkupGetOpacityMethodInfo
    ResolveAnnotMarkupMethod "getPageIndex" o = Poppler.Annot.AnnotGetPageIndexMethodInfo
    ResolveAnnotMarkupMethod "getPopupIsOpen" o = AnnotMarkupGetPopupIsOpenMethodInfo
    ResolveAnnotMarkupMethod "getPopupRectangle" o = AnnotMarkupGetPopupRectangleMethodInfo
    ResolveAnnotMarkupMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAnnotMarkupMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAnnotMarkupMethod "getRectangle" o = Poppler.Annot.AnnotGetRectangleMethodInfo
    ResolveAnnotMarkupMethod "getReplyTo" o = AnnotMarkupGetReplyToMethodInfo
    ResolveAnnotMarkupMethod "getSubject" o = AnnotMarkupGetSubjectMethodInfo
    ResolveAnnotMarkupMethod "setColor" o = Poppler.Annot.AnnotSetColorMethodInfo
    ResolveAnnotMarkupMethod "setContents" o = Poppler.Annot.AnnotSetContentsMethodInfo
    ResolveAnnotMarkupMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAnnotMarkupMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAnnotMarkupMethod "setFlags" o = Poppler.Annot.AnnotSetFlagsMethodInfo
    ResolveAnnotMarkupMethod "setLabel" o = AnnotMarkupSetLabelMethodInfo
    ResolveAnnotMarkupMethod "setOpacity" o = AnnotMarkupSetOpacityMethodInfo
    ResolveAnnotMarkupMethod "setPopup" o = AnnotMarkupSetPopupMethodInfo
    ResolveAnnotMarkupMethod "setPopupIsOpen" o = AnnotMarkupSetPopupIsOpenMethodInfo
    ResolveAnnotMarkupMethod "setPopupRectangle" o = AnnotMarkupSetPopupRectangleMethodInfo
    ResolveAnnotMarkupMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAnnotMarkupMethod "setRectangle" o = Poppler.Annot.AnnotSetRectangleMethodInfo
    ResolveAnnotMarkupMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveAnnotMarkupMethod t AnnotMarkup, O.OverloadedMethod info AnnotMarkup p) => OL.IsLabel t (AnnotMarkup -> 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 ~ ResolveAnnotMarkupMethod t AnnotMarkup, O.OverloadedMethod info AnnotMarkup p, R.HasField t AnnotMarkup p) => R.HasField t AnnotMarkup p where
    getField = O.overloadedMethod @info

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AnnotMarkup
type instance O.AttributeList AnnotMarkup = AnnotMarkupAttributeList
type AnnotMarkupAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList AnnotMarkup = AnnotMarkupSignalList
type AnnotMarkupSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method AnnotMarkup::get_date
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotMarkup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotMarkup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Date" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_markup_get_date" poppler_annot_markup_get_date :: 
    Ptr AnnotMarkup ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMarkup"})
    IO (Ptr GLib.Date.Date)

-- | Returns the date and time when the annotation was created
annotMarkupGetDate ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMarkup a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMarkup.AnnotMarkup'
    -> m GLib.Date.Date
    -- ^ __Returns:__ a t'GI.GLib.Structs.Date.Date' representing the date and time
    --               when the annotation was created, or 'P.Nothing'
annotMarkupGetDate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotMarkup a) =>
a -> m Date
annotMarkupGetDate a
popplerAnnot = IO Date -> m Date
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Date -> m Date) -> IO Date -> m Date
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMarkup
popplerAnnot' <- a -> IO (Ptr AnnotMarkup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    Ptr Date
result <- Ptr AnnotMarkup -> IO (Ptr Date)
poppler_annot_markup_get_date Ptr AnnotMarkup
popplerAnnot'
    Text -> Ptr Date -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"annotMarkupGetDate" Ptr Date
result
    Date
result' <- ((ManagedPtr Date -> Date) -> Ptr Date -> IO Date
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Date -> Date
GLib.Date.Date) Ptr Date
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Date -> IO Date
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Date
result'

#if defined(ENABLE_OVERLOADING)
data AnnotMarkupGetDateMethodInfo
instance (signature ~ (m GLib.Date.Date), MonadIO m, IsAnnotMarkup a) => O.OverloadedMethod AnnotMarkupGetDateMethodInfo a signature where
    overloadedMethod = annotMarkupGetDate

instance O.OverloadedMethodInfo AnnotMarkupGetDateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotMarkup.annotMarkupGetDate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Objects-AnnotMarkup.html#v:annotMarkupGetDate"
        })


#endif

-- method AnnotMarkup::get_external_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotMarkup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotMarkup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Poppler" , name = "AnnotExternalDataType" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_markup_get_external_data" poppler_annot_markup_get_external_data :: 
    Ptr AnnotMarkup ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMarkup"})
    IO CUInt

-- | Gets the external data type of /@popplerAnnot@/.
annotMarkupGetExternalData ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMarkup a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMarkup.AnnotMarkup'
    -> m Poppler.Enums.AnnotExternalDataType
    -- ^ __Returns:__ t'GI.Poppler.Enums.AnnotExternalDataType' of /@popplerAnnot@/.
annotMarkupGetExternalData :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotMarkup a) =>
a -> m AnnotExternalDataType
annotMarkupGetExternalData a
popplerAnnot = IO AnnotExternalDataType -> m AnnotExternalDataType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnnotExternalDataType -> m AnnotExternalDataType)
-> IO AnnotExternalDataType -> m AnnotExternalDataType
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMarkup
popplerAnnot' <- a -> IO (Ptr AnnotMarkup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CUInt
result <- Ptr AnnotMarkup -> IO CUInt
poppler_annot_markup_get_external_data Ptr AnnotMarkup
popplerAnnot'
    let result' :: AnnotExternalDataType
result' = (Int -> AnnotExternalDataType
forall a. Enum a => Int -> a
toEnum (Int -> AnnotExternalDataType)
-> (CUInt -> Int) -> CUInt -> AnnotExternalDataType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    AnnotExternalDataType -> IO AnnotExternalDataType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AnnotExternalDataType
result'

#if defined(ENABLE_OVERLOADING)
data AnnotMarkupGetExternalDataMethodInfo
instance (signature ~ (m Poppler.Enums.AnnotExternalDataType), MonadIO m, IsAnnotMarkup a) => O.OverloadedMethod AnnotMarkupGetExternalDataMethodInfo a signature where
    overloadedMethod = annotMarkupGetExternalData

instance O.OverloadedMethodInfo AnnotMarkupGetExternalDataMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotMarkup.annotMarkupGetExternalData",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Objects-AnnotMarkup.html#v:annotMarkupGetExternalData"
        })


#endif

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

foreign import ccall "poppler_annot_markup_get_label" poppler_annot_markup_get_label :: 
    Ptr AnnotMarkup ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMarkup"})
    IO CString

-- | Retrieves the label text of /@popplerAnnot@/.
annotMarkupGetLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMarkup a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMarkup.AnnotMarkup'
    -> m T.Text
    -- ^ __Returns:__ the label text of /@popplerAnnot@/.
annotMarkupGetLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotMarkup a) =>
a -> m Text
annotMarkupGetLabel a
popplerAnnot = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMarkup
popplerAnnot' <- a -> IO (Ptr AnnotMarkup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CString
result <- Ptr AnnotMarkup -> IO CString
poppler_annot_markup_get_label Ptr AnnotMarkup
popplerAnnot'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"annotMarkupGetLabel" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AnnotMarkupGetLabelMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAnnotMarkup a) => O.OverloadedMethod AnnotMarkupGetLabelMethodInfo a signature where
    overloadedMethod = annotMarkupGetLabel

instance O.OverloadedMethodInfo AnnotMarkupGetLabelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotMarkup.annotMarkupGetLabel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Objects-AnnotMarkup.html#v:annotMarkupGetLabel"
        })


#endif

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

foreign import ccall "poppler_annot_markup_get_opacity" poppler_annot_markup_get_opacity :: 
    Ptr AnnotMarkup ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMarkup"})
    IO CDouble

-- | Retrieves the opacity value of /@popplerAnnot@/.
annotMarkupGetOpacity ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMarkup a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMarkup.AnnotMarkup'
    -> m Double
    -- ^ __Returns:__ the opacity value of /@popplerAnnot@/,
    --               between 0 (transparent) and 1 (opaque)
annotMarkupGetOpacity :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotMarkup a) =>
a -> m Double
annotMarkupGetOpacity a
popplerAnnot = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMarkup
popplerAnnot' <- a -> IO (Ptr AnnotMarkup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CDouble
result <- Ptr AnnotMarkup -> IO CDouble
poppler_annot_markup_get_opacity Ptr AnnotMarkup
popplerAnnot'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data AnnotMarkupGetOpacityMethodInfo
instance (signature ~ (m Double), MonadIO m, IsAnnotMarkup a) => O.OverloadedMethod AnnotMarkupGetOpacityMethodInfo a signature where
    overloadedMethod = annotMarkupGetOpacity

instance O.OverloadedMethodInfo AnnotMarkupGetOpacityMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotMarkup.annotMarkupGetOpacity",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Objects-AnnotMarkup.html#v:annotMarkupGetOpacity"
        })


#endif

-- method AnnotMarkup::get_popup_is_open
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotMarkup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotMarkup"
--                 , 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 "poppler_annot_markup_get_popup_is_open" poppler_annot_markup_get_popup_is_open :: 
    Ptr AnnotMarkup ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMarkup"})
    IO CInt

-- | Retrieves the state of the popup window related to /@popplerAnnot@/.
annotMarkupGetPopupIsOpen ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMarkup a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMarkup.AnnotMarkup'
    -> m Bool
    -- ^ __Returns:__ the state of /@popplerAnnot@/. 'P.True' if it\'s open, 'P.False' in
    --               other case.
annotMarkupGetPopupIsOpen :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotMarkup a) =>
a -> m Bool
annotMarkupGetPopupIsOpen a
popplerAnnot = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMarkup
popplerAnnot' <- a -> IO (Ptr AnnotMarkup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CInt
result <- Ptr AnnotMarkup -> IO CInt
poppler_annot_markup_get_popup_is_open Ptr AnnotMarkup
popplerAnnot'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AnnotMarkupGetPopupIsOpenMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAnnotMarkup a) => O.OverloadedMethod AnnotMarkupGetPopupIsOpenMethodInfo a signature where
    overloadedMethod = annotMarkupGetPopupIsOpen

instance O.OverloadedMethodInfo AnnotMarkupGetPopupIsOpenMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotMarkup.annotMarkupGetPopupIsOpen",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Objects-AnnotMarkup.html#v:annotMarkupGetPopupIsOpen"
        })


#endif

-- method AnnotMarkup::get_popup_rectangle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotMarkup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotMarkup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "poppler_rect"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Rectangle" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #PopplerRectangle to store the popup rectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_markup_get_popup_rectangle" poppler_annot_markup_get_popup_rectangle :: 
    Ptr AnnotMarkup ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMarkup"})
    Ptr Poppler.Rectangle.Rectangle ->      -- poppler_rect : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO CInt

-- | Retrieves the rectangle of the popup window related to /@popplerAnnot@/.
-- 
-- /Since: 0.12/
annotMarkupGetPopupRectangle ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMarkup a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMarkup.AnnotMarkup'
    -> m ((Bool, Poppler.Rectangle.Rectangle))
    -- ^ __Returns:__ 'P.True' if t'GI.Poppler.Structs.Rectangle.Rectangle' was correctly filled, 'P.False' otherwise
annotMarkupGetPopupRectangle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotMarkup a) =>
a -> m (Bool, Rectangle)
annotMarkupGetPopupRectangle a
popplerAnnot = IO (Bool, Rectangle) -> m (Bool, Rectangle)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Rectangle) -> m (Bool, Rectangle))
-> IO (Bool, Rectangle) -> m (Bool, Rectangle)
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMarkup
popplerAnnot' <- a -> IO (Ptr AnnotMarkup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    Ptr Rectangle
popplerRect <- Int -> IO (Ptr Rectangle)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
32 :: IO (Ptr Poppler.Rectangle.Rectangle)
    CInt
result <- Ptr AnnotMarkup -> Ptr Rectangle -> IO CInt
poppler_annot_markup_get_popup_rectangle Ptr AnnotMarkup
popplerAnnot' Ptr Rectangle
popplerRect
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Rectangle
popplerRect' <- ((ManagedPtr Rectangle -> Rectangle)
-> Ptr Rectangle -> IO Rectangle
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rectangle -> Rectangle
Poppler.Rectangle.Rectangle) Ptr Rectangle
popplerRect
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    (Bool, Rectangle) -> IO (Bool, Rectangle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Rectangle
popplerRect')

#if defined(ENABLE_OVERLOADING)
data AnnotMarkupGetPopupRectangleMethodInfo
instance (signature ~ (m ((Bool, Poppler.Rectangle.Rectangle))), MonadIO m, IsAnnotMarkup a) => O.OverloadedMethod AnnotMarkupGetPopupRectangleMethodInfo a signature where
    overloadedMethod = annotMarkupGetPopupRectangle

instance O.OverloadedMethodInfo AnnotMarkupGetPopupRectangleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotMarkup.annotMarkupGetPopupRectangle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Objects-AnnotMarkup.html#v:annotMarkupGetPopupRectangle"
        })


#endif

-- method AnnotMarkup::get_reply_to
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotMarkup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotMarkup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Poppler" , name = "AnnotMarkupReplyType" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_markup_get_reply_to" poppler_annot_markup_get_reply_to :: 
    Ptr AnnotMarkup ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMarkup"})
    IO CUInt

-- | Gets the reply type of /@popplerAnnot@/.
annotMarkupGetReplyTo ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMarkup a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMarkup.AnnotMarkup'
    -> m Poppler.Enums.AnnotMarkupReplyType
    -- ^ __Returns:__ t'GI.Poppler.Enums.AnnotMarkupReplyType' of /@popplerAnnot@/.
annotMarkupGetReplyTo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotMarkup a) =>
a -> m AnnotMarkupReplyType
annotMarkupGetReplyTo a
popplerAnnot = IO AnnotMarkupReplyType -> m AnnotMarkupReplyType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnnotMarkupReplyType -> m AnnotMarkupReplyType)
-> IO AnnotMarkupReplyType -> m AnnotMarkupReplyType
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMarkup
popplerAnnot' <- a -> IO (Ptr AnnotMarkup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CUInt
result <- Ptr AnnotMarkup -> IO CUInt
poppler_annot_markup_get_reply_to Ptr AnnotMarkup
popplerAnnot'
    let result' :: AnnotMarkupReplyType
result' = (Int -> AnnotMarkupReplyType
forall a. Enum a => Int -> a
toEnum (Int -> AnnotMarkupReplyType)
-> (CUInt -> Int) -> CUInt -> AnnotMarkupReplyType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    AnnotMarkupReplyType -> IO AnnotMarkupReplyType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AnnotMarkupReplyType
result'

#if defined(ENABLE_OVERLOADING)
data AnnotMarkupGetReplyToMethodInfo
instance (signature ~ (m Poppler.Enums.AnnotMarkupReplyType), MonadIO m, IsAnnotMarkup a) => O.OverloadedMethod AnnotMarkupGetReplyToMethodInfo a signature where
    overloadedMethod = annotMarkupGetReplyTo

instance O.OverloadedMethodInfo AnnotMarkupGetReplyToMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotMarkup.annotMarkupGetReplyTo",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Objects-AnnotMarkup.html#v:annotMarkupGetReplyTo"
        })


#endif

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

foreign import ccall "poppler_annot_markup_get_subject" poppler_annot_markup_get_subject :: 
    Ptr AnnotMarkup ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMarkup"})
    IO CString

-- | Retrives the subject text of /@popplerAnnot@/.
annotMarkupGetSubject ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMarkup a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMarkup.AnnotMarkup'
    -> m T.Text
    -- ^ __Returns:__ the subject text of /@popplerAnnot@/.
annotMarkupGetSubject :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotMarkup a) =>
a -> m Text
annotMarkupGetSubject a
popplerAnnot = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMarkup
popplerAnnot' <- a -> IO (Ptr AnnotMarkup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CString
result <- Ptr AnnotMarkup -> IO CString
poppler_annot_markup_get_subject Ptr AnnotMarkup
popplerAnnot'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"annotMarkupGetSubject" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AnnotMarkupGetSubjectMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAnnotMarkup a) => O.OverloadedMethod AnnotMarkupGetSubjectMethodInfo a signature where
    overloadedMethod = annotMarkupGetSubject

instance O.OverloadedMethodInfo AnnotMarkupGetSubjectMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotMarkup.annotMarkupGetSubject",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Objects-AnnotMarkup.html#v:annotMarkupGetSubject"
        })


#endif

-- method AnnotMarkup::has_popup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotMarkup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotMarkup"
--                 , 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 "poppler_annot_markup_has_popup" poppler_annot_markup_has_popup :: 
    Ptr AnnotMarkup ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMarkup"})
    IO CInt

-- | Return 'P.True' if the markup annotation has a popup window associated
-- 
-- /Since: 0.12/
annotMarkupHasPopup ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMarkup a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMarkup.AnnotMarkup'
    -> m Bool
    -- ^ __Returns:__ 'P.True', if /@popplerAnnot@/ has popup, 'P.False' otherwise
annotMarkupHasPopup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotMarkup a) =>
a -> m Bool
annotMarkupHasPopup a
popplerAnnot = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMarkup
popplerAnnot' <- a -> IO (Ptr AnnotMarkup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CInt
result <- Ptr AnnotMarkup -> IO CInt
poppler_annot_markup_has_popup Ptr AnnotMarkup
popplerAnnot'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AnnotMarkupHasPopupMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAnnotMarkup a) => O.OverloadedMethod AnnotMarkupHasPopupMethodInfo a signature where
    overloadedMethod = annotMarkupHasPopup

instance O.OverloadedMethodInfo AnnotMarkupHasPopupMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotMarkup.annotMarkupHasPopup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Objects-AnnotMarkup.html#v:annotMarkupHasPopup"
        })


#endif

-- method AnnotMarkup::set_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotMarkup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotMarkup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a text string containing the new label, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_markup_set_label" poppler_annot_markup_set_label :: 
    Ptr AnnotMarkup ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMarkup"})
    CString ->                              -- label : TBasicType TUTF8
    IO ()

-- | Sets the label text of /@popplerAnnot@/, replacing the current one
-- 
-- /Since: 0.16/
annotMarkupSetLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMarkup a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMarkup.AnnotMarkup'
    -> Maybe (T.Text)
    -- ^ /@label@/: a text string containing the new label, or 'P.Nothing'
    -> m ()
annotMarkupSetLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotMarkup a) =>
a -> Maybe Text -> m ()
annotMarkupSetLabel a
popplerAnnot Maybe Text
label = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMarkup
popplerAnnot' <- a -> IO (Ptr AnnotMarkup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    CString
maybeLabel <- case Maybe Text
label of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jLabel -> do
            CString
jLabel' <- Text -> IO CString
textToCString Text
jLabel
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jLabel'
    Ptr AnnotMarkup -> CString -> IO ()
poppler_annot_markup_set_label Ptr AnnotMarkup
popplerAnnot' CString
maybeLabel
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeLabel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnnotMarkupSetLabelMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsAnnotMarkup a) => O.OverloadedMethod AnnotMarkupSetLabelMethodInfo a signature where
    overloadedMethod = annotMarkupSetLabel

instance O.OverloadedMethodInfo AnnotMarkupSetLabelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotMarkup.annotMarkupSetLabel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Objects-AnnotMarkup.html#v:annotMarkupSetLabel"
        })


#endif

-- method AnnotMarkup::set_opacity
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotMarkup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotMarkup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "opacity"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a constant opacity value, between 0 (transparent) and 1 (opaque)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_markup_set_opacity" poppler_annot_markup_set_opacity :: 
    Ptr AnnotMarkup ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMarkup"})
    CDouble ->                              -- opacity : TBasicType TDouble
    IO ()

-- | Sets the opacity of /@popplerAnnot@/. This value applies to
-- all visible elements of /@popplerAnnot@/ in its closed state,
-- but not to the pop-up window that appears when it\'s openened
-- 
-- /Since: 0.16/
annotMarkupSetOpacity ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMarkup a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMarkup.AnnotMarkup'
    -> Double
    -- ^ /@opacity@/: a constant opacity value, between 0 (transparent) and 1 (opaque)
    -> m ()
annotMarkupSetOpacity :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotMarkup a) =>
a -> Double -> m ()
annotMarkupSetOpacity a
popplerAnnot Double
opacity = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMarkup
popplerAnnot' <- a -> IO (Ptr AnnotMarkup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    let opacity' :: CDouble
opacity' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
opacity
    Ptr AnnotMarkup -> CDouble -> IO ()
poppler_annot_markup_set_opacity Ptr AnnotMarkup
popplerAnnot' CDouble
opacity'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnnotMarkupSetOpacityMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsAnnotMarkup a) => O.OverloadedMethod AnnotMarkupSetOpacityMethodInfo a signature where
    overloadedMethod = annotMarkupSetOpacity

instance O.OverloadedMethodInfo AnnotMarkupSetOpacityMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotMarkup.annotMarkupSetOpacity",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Objects-AnnotMarkup.html#v:annotMarkupSetOpacity"
        })


#endif

-- method AnnotMarkup::set_popup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotMarkup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotMarkup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "popup_rect"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerRectangle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_markup_set_popup" poppler_annot_markup_set_popup :: 
    Ptr AnnotMarkup ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMarkup"})
    Ptr Poppler.Rectangle.Rectangle ->      -- popup_rect : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO ()

-- | Associates a new popup window for editing contents of /@popplerAnnot@/.
-- Popup window shall be displayed by viewers at /@popupRect@/ on the page.
-- 
-- /Since: 0.16/
annotMarkupSetPopup ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMarkup a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMarkup.AnnotMarkup'
    -> Poppler.Rectangle.Rectangle
    -- ^ /@popupRect@/: a t'GI.Poppler.Structs.Rectangle.Rectangle'
    -> m ()
annotMarkupSetPopup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotMarkup a) =>
a -> Rectangle -> m ()
annotMarkupSetPopup a
popplerAnnot Rectangle
popupRect = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMarkup
popplerAnnot' <- a -> IO (Ptr AnnotMarkup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    Ptr Rectangle
popupRect' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
popupRect
    Ptr AnnotMarkup -> Ptr Rectangle -> IO ()
poppler_annot_markup_set_popup Ptr AnnotMarkup
popplerAnnot' Ptr Rectangle
popupRect'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
popupRect
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnnotMarkupSetPopupMethodInfo
instance (signature ~ (Poppler.Rectangle.Rectangle -> m ()), MonadIO m, IsAnnotMarkup a) => O.OverloadedMethod AnnotMarkupSetPopupMethodInfo a signature where
    overloadedMethod = annotMarkupSetPopup

instance O.OverloadedMethodInfo AnnotMarkupSetPopupMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotMarkup.annotMarkupSetPopup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Objects-AnnotMarkup.html#v:annotMarkupSetPopup"
        })


#endif

-- method AnnotMarkup::set_popup_is_open
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotMarkup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotMarkup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "is_open"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether popup window should initially be displayed open"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_markup_set_popup_is_open" poppler_annot_markup_set_popup_is_open :: 
    Ptr AnnotMarkup ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMarkup"})
    CInt ->                                 -- is_open : TBasicType TBoolean
    IO ()

-- | Sets the state of the popup window related to /@popplerAnnot@/.
-- 
-- /Since: 0.16/
annotMarkupSetPopupIsOpen ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMarkup a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMarkup.AnnotMarkup'
    -> Bool
    -- ^ /@isOpen@/: whether popup window should initially be displayed open
    -> m ()
annotMarkupSetPopupIsOpen :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotMarkup a) =>
a -> Bool -> m ()
annotMarkupSetPopupIsOpen a
popplerAnnot Bool
isOpen = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMarkup
popplerAnnot' <- a -> IO (Ptr AnnotMarkup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    let isOpen' :: CInt
isOpen' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
isOpen
    Ptr AnnotMarkup -> CInt -> IO ()
poppler_annot_markup_set_popup_is_open Ptr AnnotMarkup
popplerAnnot' CInt
isOpen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnnotMarkupSetPopupIsOpenMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAnnotMarkup a) => O.OverloadedMethod AnnotMarkupSetPopupIsOpenMethodInfo a signature where
    overloadedMethod = annotMarkupSetPopupIsOpen

instance O.OverloadedMethodInfo AnnotMarkupSetPopupIsOpenMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotMarkup.annotMarkupSetPopupIsOpen",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Objects-AnnotMarkup.html#v:annotMarkupSetPopupIsOpen"
        })


#endif

-- method AnnotMarkup::set_popup_rectangle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "poppler_annot"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "AnnotMarkup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerAnnotMarkup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "poppler_rect"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "Rectangle" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerRectangle to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_annot_markup_set_popup_rectangle" poppler_annot_markup_set_popup_rectangle :: 
    Ptr AnnotMarkup ->                      -- poppler_annot : TInterface (Name {namespace = "Poppler", name = "AnnotMarkup"})
    Ptr Poppler.Rectangle.Rectangle ->      -- poppler_rect : TInterface (Name {namespace = "Poppler", name = "Rectangle"})
    IO ()

-- | Sets the rectangle of the popup window related to /@popplerAnnot@/.
-- This doesn\'t have any effect if /@popplerAnnot@/ doesn\'t have a
-- popup associated, use 'GI.Poppler.Objects.AnnotMarkup.annotMarkupSetPopup' to associate
-- a popup window to a t'GI.Poppler.Objects.AnnotMarkup.AnnotMarkup'.
-- 
-- /Since: 0.33/
annotMarkupSetPopupRectangle ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnnotMarkup a) =>
    a
    -- ^ /@popplerAnnot@/: a t'GI.Poppler.Objects.AnnotMarkup.AnnotMarkup'
    -> Poppler.Rectangle.Rectangle
    -- ^ /@popplerRect@/: a t'GI.Poppler.Structs.Rectangle.Rectangle' to set
    -> m ()
annotMarkupSetPopupRectangle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnnotMarkup a) =>
a -> Rectangle -> m ()
annotMarkupSetPopupRectangle a
popplerAnnot Rectangle
popplerRect = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AnnotMarkup
popplerAnnot' <- a -> IO (Ptr AnnotMarkup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
popplerAnnot
    Ptr Rectangle
popplerRect' <- Rectangle -> IO (Ptr Rectangle)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rectangle
popplerRect
    Ptr AnnotMarkup -> Ptr Rectangle -> IO ()
poppler_annot_markup_set_popup_rectangle Ptr AnnotMarkup
popplerAnnot' Ptr Rectangle
popplerRect'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
popplerAnnot
    Rectangle -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Rectangle
popplerRect
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnnotMarkupSetPopupRectangleMethodInfo
instance (signature ~ (Poppler.Rectangle.Rectangle -> m ()), MonadIO m, IsAnnotMarkup a) => O.OverloadedMethod AnnotMarkupSetPopupRectangleMethodInfo a signature where
    overloadedMethod = annotMarkupSetPopupRectangle

instance O.OverloadedMethodInfo AnnotMarkupSetPopupRectangleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Poppler.Objects.AnnotMarkup.annotMarkupSetPopupRectangle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-poppler-0.18.27/docs/GI-Poppler-Objects-AnnotMarkup.html#v:annotMarkupSetPopupRectangle"
        })


#endif