{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- 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.FormField
    ( 

-- * Exported types
    FormField(..)                           ,
    IsFormField                             ,
    toFormField                             ,
    noFormField                             ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveFormFieldMethod                  ,
#endif


-- ** buttonGetButtonType #method:buttonGetButtonType#

#if defined(ENABLE_OVERLOADING)
    FormFieldButtonGetButtonTypeMethodInfo  ,
#endif
    formFieldButtonGetButtonType            ,


-- ** buttonGetState #method:buttonGetState#

#if defined(ENABLE_OVERLOADING)
    FormFieldButtonGetStateMethodInfo       ,
#endif
    formFieldButtonGetState                 ,


-- ** buttonSetState #method:buttonSetState#

#if defined(ENABLE_OVERLOADING)
    FormFieldButtonSetStateMethodInfo       ,
#endif
    formFieldButtonSetState                 ,


-- ** choiceCanSelectMultiple #method:choiceCanSelectMultiple#

#if defined(ENABLE_OVERLOADING)
    FormFieldChoiceCanSelectMultipleMethodInfo,
#endif
    formFieldChoiceCanSelectMultiple        ,


-- ** choiceCommitOnChange #method:choiceCommitOnChange#

#if defined(ENABLE_OVERLOADING)
    FormFieldChoiceCommitOnChangeMethodInfo ,
#endif
    formFieldChoiceCommitOnChange           ,


-- ** choiceDoSpellCheck #method:choiceDoSpellCheck#

#if defined(ENABLE_OVERLOADING)
    FormFieldChoiceDoSpellCheckMethodInfo   ,
#endif
    formFieldChoiceDoSpellCheck             ,


-- ** choiceGetChoiceType #method:choiceGetChoiceType#

#if defined(ENABLE_OVERLOADING)
    FormFieldChoiceGetChoiceTypeMethodInfo  ,
#endif
    formFieldChoiceGetChoiceType            ,


-- ** choiceGetItem #method:choiceGetItem#

#if defined(ENABLE_OVERLOADING)
    FormFieldChoiceGetItemMethodInfo        ,
#endif
    formFieldChoiceGetItem                  ,


-- ** choiceGetNItems #method:choiceGetNItems#

#if defined(ENABLE_OVERLOADING)
    FormFieldChoiceGetNItemsMethodInfo      ,
#endif
    formFieldChoiceGetNItems                ,


-- ** choiceGetText #method:choiceGetText#

#if defined(ENABLE_OVERLOADING)
    FormFieldChoiceGetTextMethodInfo        ,
#endif
    formFieldChoiceGetText                  ,


-- ** choiceIsEditable #method:choiceIsEditable#

#if defined(ENABLE_OVERLOADING)
    FormFieldChoiceIsEditableMethodInfo     ,
#endif
    formFieldChoiceIsEditable               ,


-- ** choiceIsItemSelected #method:choiceIsItemSelected#

#if defined(ENABLE_OVERLOADING)
    FormFieldChoiceIsItemSelectedMethodInfo ,
#endif
    formFieldChoiceIsItemSelected           ,


-- ** choiceSelectItem #method:choiceSelectItem#

#if defined(ENABLE_OVERLOADING)
    FormFieldChoiceSelectItemMethodInfo     ,
#endif
    formFieldChoiceSelectItem               ,


-- ** choiceSetText #method:choiceSetText#

#if defined(ENABLE_OVERLOADING)
    FormFieldChoiceSetTextMethodInfo        ,
#endif
    formFieldChoiceSetText                  ,


-- ** choiceToggleItem #method:choiceToggleItem#

#if defined(ENABLE_OVERLOADING)
    FormFieldChoiceToggleItemMethodInfo     ,
#endif
    formFieldChoiceToggleItem               ,


-- ** choiceUnselectAll #method:choiceUnselectAll#

#if defined(ENABLE_OVERLOADING)
    FormFieldChoiceUnselectAllMethodInfo    ,
#endif
    formFieldChoiceUnselectAll              ,


-- ** getAction #method:getAction#

#if defined(ENABLE_OVERLOADING)
    FormFieldGetActionMethodInfo            ,
#endif
    formFieldGetAction                      ,


-- ** getAdditionalAction #method:getAdditionalAction#

#if defined(ENABLE_OVERLOADING)
    FormFieldGetAdditionalActionMethodInfo  ,
#endif
    formFieldGetAdditionalAction            ,


-- ** getFieldType #method:getFieldType#

#if defined(ENABLE_OVERLOADING)
    FormFieldGetFieldTypeMethodInfo         ,
#endif
    formFieldGetFieldType                   ,


-- ** getFontSize #method:getFontSize#

#if defined(ENABLE_OVERLOADING)
    FormFieldGetFontSizeMethodInfo          ,
#endif
    formFieldGetFontSize                    ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    FormFieldGetIdMethodInfo                ,
#endif
    formFieldGetId                          ,


-- ** getMappingName #method:getMappingName#

#if defined(ENABLE_OVERLOADING)
    FormFieldGetMappingNameMethodInfo       ,
#endif
    formFieldGetMappingName                 ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    FormFieldGetNameMethodInfo              ,
#endif
    formFieldGetName                        ,


-- ** getPartialName #method:getPartialName#

#if defined(ENABLE_OVERLOADING)
    FormFieldGetPartialNameMethodInfo       ,
#endif
    formFieldGetPartialName                 ,


-- ** isReadOnly #method:isReadOnly#

#if defined(ENABLE_OVERLOADING)
    FormFieldIsReadOnlyMethodInfo           ,
#endif
    formFieldIsReadOnly                     ,


-- ** textDoScroll #method:textDoScroll#

#if defined(ENABLE_OVERLOADING)
    FormFieldTextDoScrollMethodInfo         ,
#endif
    formFieldTextDoScroll                   ,


-- ** textDoSpellCheck #method:textDoSpellCheck#

#if defined(ENABLE_OVERLOADING)
    FormFieldTextDoSpellCheckMethodInfo     ,
#endif
    formFieldTextDoSpellCheck               ,


-- ** textGetMaxLen #method:textGetMaxLen#

#if defined(ENABLE_OVERLOADING)
    FormFieldTextGetMaxLenMethodInfo        ,
#endif
    formFieldTextGetMaxLen                  ,


-- ** textGetText #method:textGetText#

#if defined(ENABLE_OVERLOADING)
    FormFieldTextGetTextMethodInfo          ,
#endif
    formFieldTextGetText                    ,


-- ** textGetTextType #method:textGetTextType#

#if defined(ENABLE_OVERLOADING)
    FormFieldTextGetTextTypeMethodInfo      ,
#endif
    formFieldTextGetTextType                ,


-- ** textIsPassword #method:textIsPassword#

#if defined(ENABLE_OVERLOADING)
    FormFieldTextIsPasswordMethodInfo       ,
#endif
    formFieldTextIsPassword                 ,


-- ** textIsRichText #method:textIsRichText#

#if defined(ENABLE_OVERLOADING)
    FormFieldTextIsRichTextMethodInfo       ,
#endif
    formFieldTextIsRichText                 ,


-- ** textSetText #method:textSetText#

#if defined(ENABLE_OVERLOADING)
    FormFieldTextSetTextMethodInfo          ,
#endif
    formFieldTextSetText                    ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums
import {-# SOURCE #-} qualified GI.Poppler.Unions.Action as Poppler.Action

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

instance GObject FormField where
    gobjectType :: IO GType
gobjectType = IO GType
c_poppler_form_field_get_type
    

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

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

instance O.HasParentTypes FormField
type instance O.ParentTypes FormField = '[GObject.Object.Object]

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

-- | A convenience alias for `Nothing` :: `Maybe` `FormField`.
noFormField :: Maybe FormField
noFormField :: Maybe FormField
noFormField = Maybe FormField
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveFormFieldMethod (t :: Symbol) (o :: *) :: * where
    ResolveFormFieldMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFormFieldMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFormFieldMethod "buttonGetButtonType" o = FormFieldButtonGetButtonTypeMethodInfo
    ResolveFormFieldMethod "buttonGetState" o = FormFieldButtonGetStateMethodInfo
    ResolveFormFieldMethod "buttonSetState" o = FormFieldButtonSetStateMethodInfo
    ResolveFormFieldMethod "choiceCanSelectMultiple" o = FormFieldChoiceCanSelectMultipleMethodInfo
    ResolveFormFieldMethod "choiceCommitOnChange" o = FormFieldChoiceCommitOnChangeMethodInfo
    ResolveFormFieldMethod "choiceDoSpellCheck" o = FormFieldChoiceDoSpellCheckMethodInfo
    ResolveFormFieldMethod "choiceGetChoiceType" o = FormFieldChoiceGetChoiceTypeMethodInfo
    ResolveFormFieldMethod "choiceGetItem" o = FormFieldChoiceGetItemMethodInfo
    ResolveFormFieldMethod "choiceGetNItems" o = FormFieldChoiceGetNItemsMethodInfo
    ResolveFormFieldMethod "choiceGetText" o = FormFieldChoiceGetTextMethodInfo
    ResolveFormFieldMethod "choiceIsEditable" o = FormFieldChoiceIsEditableMethodInfo
    ResolveFormFieldMethod "choiceIsItemSelected" o = FormFieldChoiceIsItemSelectedMethodInfo
    ResolveFormFieldMethod "choiceSelectItem" o = FormFieldChoiceSelectItemMethodInfo
    ResolveFormFieldMethod "choiceSetText" o = FormFieldChoiceSetTextMethodInfo
    ResolveFormFieldMethod "choiceToggleItem" o = FormFieldChoiceToggleItemMethodInfo
    ResolveFormFieldMethod "choiceUnselectAll" o = FormFieldChoiceUnselectAllMethodInfo
    ResolveFormFieldMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFormFieldMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFormFieldMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFormFieldMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFormFieldMethod "isReadOnly" o = FormFieldIsReadOnlyMethodInfo
    ResolveFormFieldMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFormFieldMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFormFieldMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFormFieldMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFormFieldMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFormFieldMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFormFieldMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFormFieldMethod "textDoScroll" o = FormFieldTextDoScrollMethodInfo
    ResolveFormFieldMethod "textDoSpellCheck" o = FormFieldTextDoSpellCheckMethodInfo
    ResolveFormFieldMethod "textGetMaxLen" o = FormFieldTextGetMaxLenMethodInfo
    ResolveFormFieldMethod "textGetText" o = FormFieldTextGetTextMethodInfo
    ResolveFormFieldMethod "textGetTextType" o = FormFieldTextGetTextTypeMethodInfo
    ResolveFormFieldMethod "textIsPassword" o = FormFieldTextIsPasswordMethodInfo
    ResolveFormFieldMethod "textIsRichText" o = FormFieldTextIsRichTextMethodInfo
    ResolveFormFieldMethod "textSetText" o = FormFieldTextSetTextMethodInfo
    ResolveFormFieldMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFormFieldMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFormFieldMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFormFieldMethod "getAction" o = FormFieldGetActionMethodInfo
    ResolveFormFieldMethod "getAdditionalAction" o = FormFieldGetAdditionalActionMethodInfo
    ResolveFormFieldMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFormFieldMethod "getFieldType" o = FormFieldGetFieldTypeMethodInfo
    ResolveFormFieldMethod "getFontSize" o = FormFieldGetFontSizeMethodInfo
    ResolveFormFieldMethod "getId" o = FormFieldGetIdMethodInfo
    ResolveFormFieldMethod "getMappingName" o = FormFieldGetMappingNameMethodInfo
    ResolveFormFieldMethod "getName" o = FormFieldGetNameMethodInfo
    ResolveFormFieldMethod "getPartialName" o = FormFieldGetPartialNameMethodInfo
    ResolveFormFieldMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFormFieldMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFormFieldMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFormFieldMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFormFieldMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFormFieldMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "poppler_form_field_button_get_button_type" poppler_form_field_button_get_button_type :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CUInt

-- | Gets the button type of /@field@/
formFieldButtonGetButtonType ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Poppler.Enums.FormButtonType
    -- ^ __Returns:__ t'GI.Poppler.Enums.FormButtonType' of /@field@/
formFieldButtonGetButtonType :: a -> m FormButtonType
formFieldButtonGetButtonType field :: a
field = IO FormButtonType -> m FormButtonType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FormButtonType -> m FormButtonType)
-> IO FormButtonType -> m FormButtonType
forall a b. (a -> b) -> a -> b
$ do
    Ptr FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CUInt
result <- Ptr FormField -> IO CUInt
poppler_form_field_button_get_button_type Ptr FormField
field'
    let result' :: FormButtonType
result' = (Int -> FormButtonType
forall a. Enum a => Int -> a
toEnum (Int -> FormButtonType)
-> (CUInt -> Int) -> CUInt -> FormButtonType
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
field
    FormButtonType -> IO FormButtonType
forall (m :: * -> *) a. Monad m => a -> m a
return FormButtonType
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldButtonGetButtonTypeMethodInfo
instance (signature ~ (m Poppler.Enums.FormButtonType), MonadIO m, IsFormField a) => O.MethodInfo FormFieldButtonGetButtonTypeMethodInfo a signature where
    overloadedMethod = formFieldButtonGetButtonType

#endif

-- method FormField::button_get_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , 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_form_field_button_get_state" poppler_form_field_button_get_state :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CInt

-- | Queries a t'GI.Poppler.Objects.FormField.FormField' and returns its current state. Returns 'P.True' if
-- /@field@/ is pressed in and 'P.False' if it is raised.
formFieldButtonGetState ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Bool
    -- ^ __Returns:__ current state of /@field@/
formFieldButtonGetState :: a -> m Bool
formFieldButtonGetState field :: a
field = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CInt
result <- Ptr FormField -> IO CInt
poppler_form_field_button_get_state Ptr FormField
field'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldButtonGetStateMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFormField a) => O.MethodInfo FormFieldButtonGetStateMethodInfo a signature where
    overloadedMethod = formFieldButtonGetState

#endif

-- method FormField::button_set_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "state"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE or %FALSE" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_form_field_button_set_state" poppler_form_field_button_set_state :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    CInt ->                                 -- state : TBasicType TBoolean
    IO ()

-- | Sets the status of /@field@/. Set to 'P.True' if you want the t'GI.Poppler.Objects.FormField.FormField'
-- to be \'pressed in\', and 'P.False' to raise it.
formFieldButtonSetState ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> Bool
    -- ^ /@state@/: 'P.True' or 'P.False'
    -> m ()
formFieldButtonSetState :: a -> Bool -> m ()
formFieldButtonSetState field :: a
field state :: Bool
state = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    let state' :: CInt
state' = (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
state
    Ptr FormField -> CInt -> IO ()
poppler_form_field_button_set_state Ptr FormField
field' CInt
state'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FormFieldButtonSetStateMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsFormField a) => O.MethodInfo FormFieldButtonSetStateMethodInfo a signature where
    overloadedMethod = formFieldButtonSetState

#endif

-- method FormField::choice_can_select_multiple
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , 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_form_field_choice_can_select_multiple" poppler_form_field_choice_can_select_multiple :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CInt

-- | Checks whether /@field@/ allows multiple choices to be selected
formFieldChoiceCanSelectMultiple ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@field@/ allows multiple choices to be selected
formFieldChoiceCanSelectMultiple :: a -> m Bool
formFieldChoiceCanSelectMultiple field :: a
field = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CInt
result <- Ptr FormField -> IO CInt
poppler_form_field_choice_can_select_multiple Ptr FormField
field'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldChoiceCanSelectMultipleMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFormField a) => O.MethodInfo FormFieldChoiceCanSelectMultipleMethodInfo a signature where
    overloadedMethod = formFieldChoiceCanSelectMultiple

#endif

-- method FormField::choice_commit_on_change
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_form_field_choice_commit_on_change" poppler_form_field_choice_commit_on_change :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CInt

-- | /No description available in the introspection data./
formFieldChoiceCommitOnChange ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -> m Bool
formFieldChoiceCommitOnChange :: a -> m Bool
formFieldChoiceCommitOnChange field :: a
field = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CInt
result <- Ptr FormField -> IO CInt
poppler_form_field_choice_commit_on_change Ptr FormField
field'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldChoiceCommitOnChangeMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFormField a) => O.MethodInfo FormFieldChoiceCommitOnChangeMethodInfo a signature where
    overloadedMethod = formFieldChoiceCommitOnChange

#endif

-- method FormField::choice_do_spell_check
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , 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_form_field_choice_do_spell_check" poppler_form_field_choice_do_spell_check :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CInt

-- | Checks whether spell checking should be done for the contents of /@field@/
formFieldChoiceDoSpellCheck ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if spell checking should be done for /@field@/
formFieldChoiceDoSpellCheck :: a -> m Bool
formFieldChoiceDoSpellCheck field :: a
field = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CInt
result <- Ptr FormField -> IO CInt
poppler_form_field_choice_do_spell_check Ptr FormField
field'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldChoiceDoSpellCheckMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFormField a) => O.MethodInfo FormFieldChoiceDoSpellCheckMethodInfo a signature where
    overloadedMethod = formFieldChoiceDoSpellCheck

#endif

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

foreign import ccall "poppler_form_field_choice_get_choice_type" poppler_form_field_choice_get_choice_type :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CUInt

-- | Gets the choice type of /@field@/
formFieldChoiceGetChoiceType ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Poppler.Enums.FormChoiceType
    -- ^ __Returns:__ t'GI.Poppler.Enums.FormChoiceType' of /@field@/
formFieldChoiceGetChoiceType :: a -> m FormChoiceType
formFieldChoiceGetChoiceType field :: a
field = IO FormChoiceType -> m FormChoiceType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FormChoiceType -> m FormChoiceType)
-> IO FormChoiceType -> m FormChoiceType
forall a b. (a -> b) -> a -> b
$ do
    Ptr FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CUInt
result <- Ptr FormField -> IO CUInt
poppler_form_field_choice_get_choice_type Ptr FormField
field'
    let result' :: FormChoiceType
result' = (Int -> FormChoiceType
forall a. Enum a => Int -> a
toEnum (Int -> FormChoiceType)
-> (CUInt -> Int) -> CUInt -> FormChoiceType
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
field
    FormChoiceType -> IO FormChoiceType
forall (m :: * -> *) a. Monad m => a -> m a
return FormChoiceType
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldChoiceGetChoiceTypeMethodInfo
instance (signature ~ (m Poppler.Enums.FormChoiceType), MonadIO m, IsFormField a) => O.MethodInfo FormFieldChoiceGetChoiceTypeMethodInfo a signature where
    overloadedMethod = formFieldChoiceGetChoiceType

#endif

-- method FormField::choice_get_item
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the item"
--                 , 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_form_field_choice_get_item" poppler_form_field_choice_get_item :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    Int32 ->                                -- index : TBasicType TInt
    IO CString

-- | Returns the contents of the item on /@field@/ at the given index
formFieldChoiceGetItem ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> Int32
    -- ^ /@index@/: the index of the item
    -> m T.Text
    -- ^ __Returns:__ a new allocated string. It must be freed with 'GI.GLib.Functions.free' when done.
formFieldChoiceGetItem :: a -> Int32 -> m Text
formFieldChoiceGetItem field :: a
field index :: Int32
index = IO Text -> m Text
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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CString
result <- Ptr FormField -> Int32 -> IO CString
poppler_form_field_choice_get_item Ptr FormField
field' Int32
index
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "formFieldChoiceGetItem" 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
field
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldChoiceGetItemMethodInfo
instance (signature ~ (Int32 -> m T.Text), MonadIO m, IsFormField a) => O.MethodInfo FormFieldChoiceGetItemMethodInfo a signature where
    overloadedMethod = formFieldChoiceGetItem

#endif

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

foreign import ccall "poppler_form_field_choice_get_n_items" poppler_form_field_choice_get_n_items :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO Int32

-- | Returns the number of items on /@field@/
formFieldChoiceGetNItems ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Int32
    -- ^ __Returns:__ the number of items on /@field@/
formFieldChoiceGetNItems :: a -> m Int32
formFieldChoiceGetNItems field :: a
field = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    Int32
result <- Ptr FormField -> IO Int32
poppler_form_field_choice_get_n_items Ptr FormField
field'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data FormFieldChoiceGetNItemsMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsFormField a) => O.MethodInfo FormFieldChoiceGetNItemsMethodInfo a signature where
    overloadedMethod = formFieldChoiceGetNItems

#endif

-- method FormField::choice_get_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , 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_form_field_choice_get_text" poppler_form_field_choice_get_text :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CString

-- | Retrieves the contents of /@field@/.
formFieldChoiceGetText ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string. It must be freed with 'GI.GLib.Functions.free' when done.
formFieldChoiceGetText :: a -> m Text
formFieldChoiceGetText field :: a
field = IO Text -> m Text
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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CString
result <- Ptr FormField -> IO CString
poppler_form_field_choice_get_text Ptr FormField
field'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "formFieldChoiceGetText" 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
field
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldChoiceGetTextMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsFormField a) => O.MethodInfo FormFieldChoiceGetTextMethodInfo a signature where
    overloadedMethod = formFieldChoiceGetText

#endif

-- method FormField::choice_is_editable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , 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_form_field_choice_is_editable" poppler_form_field_choice_is_editable :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CInt

-- | Checks whether /@field@/ is editable
formFieldChoiceIsEditable ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@field@/ is editable
formFieldChoiceIsEditable :: a -> m Bool
formFieldChoiceIsEditable field :: a
field = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CInt
result <- Ptr FormField -> IO CInt
poppler_form_field_choice_is_editable Ptr FormField
field'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldChoiceIsEditableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFormField a) => O.MethodInfo FormFieldChoiceIsEditableMethodInfo a signature where
    overloadedMethod = formFieldChoiceIsEditable

#endif

-- method FormField::choice_is_item_selected
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the item"
--                 , 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_form_field_choice_is_item_selected" poppler_form_field_choice_is_item_selected :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    Int32 ->                                -- index : TBasicType TInt
    IO CInt

-- | Checks whether the item at the given index on /@field@/ is currently selected
formFieldChoiceIsItemSelected ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> Int32
    -- ^ /@index@/: the index of the item
    -> m Bool
    -- ^ __Returns:__ 'P.True' if item at /@index@/ is currently selected
formFieldChoiceIsItemSelected :: a -> Int32 -> m Bool
formFieldChoiceIsItemSelected field :: a
field index :: Int32
index = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CInt
result <- Ptr FormField -> Int32 -> IO CInt
poppler_form_field_choice_is_item_selected Ptr FormField
field' Int32
index
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldChoiceIsItemSelectedMethodInfo
instance (signature ~ (Int32 -> m Bool), MonadIO m, IsFormField a) => O.MethodInfo FormFieldChoiceIsItemSelectedMethodInfo a signature where
    overloadedMethod = formFieldChoiceIsItemSelected

#endif

-- method FormField::choice_select_item
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_form_field_choice_select_item" poppler_form_field_choice_select_item :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    Int32 ->                                -- index : TBasicType TInt
    IO ()

-- | Selects the item at the given index on /@field@/
formFieldChoiceSelectItem ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> Int32
    -- ^ /@index@/: the index of the item
    -> m ()
formFieldChoiceSelectItem :: a -> Int32 -> m ()
formFieldChoiceSelectItem field :: a
field index :: Int32
index = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    Ptr FormField -> Int32 -> IO ()
poppler_form_field_choice_select_item Ptr FormField
field' Int32
index
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FormFieldChoiceSelectItemMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsFormField a) => O.MethodInfo FormFieldChoiceSelectItemMethodInfo a signature where
    overloadedMethod = formFieldChoiceSelectItem

#endif

-- method FormField::choice_set_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new text" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_form_field_choice_set_text" poppler_form_field_choice_set_text :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    CString ->                              -- text : TBasicType TUTF8
    IO ()

-- | Sets the text in /@field@/ to the given value, replacing the current contents
formFieldChoiceSetText ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> T.Text
    -- ^ /@text@/: the new text
    -> m ()
formFieldChoiceSetText :: a -> Text -> m ()
formFieldChoiceSetText field :: a
field text :: Text
text = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CString
text' <- Text -> IO CString
textToCString Text
text
    Ptr FormField -> CString -> IO ()
poppler_form_field_choice_set_text Ptr FormField
field' CString
text'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FormFieldChoiceSetTextMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsFormField a) => O.MethodInfo FormFieldChoiceSetTextMethodInfo a signature where
    overloadedMethod = formFieldChoiceSetText

#endif

-- method FormField::choice_toggle_item
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "index"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_form_field_choice_toggle_item" poppler_form_field_choice_toggle_item :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    Int32 ->                                -- index : TBasicType TInt
    IO ()

-- | Changes the state of the item at the given index
formFieldChoiceToggleItem ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> Int32
    -- ^ /@index@/: the index of the item
    -> m ()
formFieldChoiceToggleItem :: a -> Int32 -> m ()
formFieldChoiceToggleItem field :: a
field index :: Int32
index = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    Ptr FormField -> Int32 -> IO ()
poppler_form_field_choice_toggle_item Ptr FormField
field' Int32
index
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FormFieldChoiceToggleItemMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsFormField a) => O.MethodInfo FormFieldChoiceToggleItemMethodInfo a signature where
    overloadedMethod = formFieldChoiceToggleItem

#endif

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

foreign import ccall "poppler_form_field_choice_unselect_all" poppler_form_field_choice_unselect_all :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO ()

-- | Unselects all the items on /@field@/
formFieldChoiceUnselectAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m ()
formFieldChoiceUnselectAll :: a -> m ()
formFieldChoiceUnselectAll field :: a
field = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    Ptr FormField -> IO ()
poppler_form_field_choice_unselect_all Ptr FormField
field'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FormFieldChoiceUnselectAllMethodInfo
instance (signature ~ (m ()), MonadIO m, IsFormField a) => O.MethodInfo FormFieldChoiceUnselectAllMethodInfo a signature where
    overloadedMethod = formFieldChoiceUnselectAll

#endif

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

foreign import ccall "poppler_form_field_get_action" poppler_form_field_get_action :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO (Ptr Poppler.Action.Action)

-- | Retrieves the action (t'GI.Poppler.Unions.Action.Action') that shall be
-- performed when /@field@/ is activated, or 'P.Nothing'
-- 
-- /Since: 0.18/
formFieldGetAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Poppler.Action.Action
    -- ^ __Returns:__ the action to perform. The returned
    --               object is owned by /@field@/ and should not be freed
formFieldGetAction :: a -> m Action
formFieldGetAction field :: a
field = IO Action -> m Action
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Action -> m Action) -> IO Action -> m Action
forall a b. (a -> b) -> a -> b
$ do
    Ptr FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    Ptr Action
result <- Ptr FormField -> IO (Ptr Action)
poppler_form_field_get_action Ptr FormField
field'
    Text -> Ptr Action -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "formFieldGetAction" Ptr Action
result
    Action
result' <- ((ManagedPtr Action -> Action) -> Ptr Action -> IO Action
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Action -> Action
Poppler.Action.Action) Ptr Action
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Action -> IO Action
forall (m :: * -> *) a. Monad m => a -> m a
return Action
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldGetActionMethodInfo
instance (signature ~ (m Poppler.Action.Action), MonadIO m, IsFormField a) => O.MethodInfo FormFieldGetActionMethodInfo a signature where
    overloadedMethod = formFieldGetAction

#endif

-- method FormField::get_additional_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface
--                 Name { namespace = "Poppler" , name = "AdditionalActionType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the type of additional action"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Poppler" , name = "Action" })
-- throws : False
-- Skip return : False

foreign import ccall "poppler_form_field_get_additional_action" poppler_form_field_get_additional_action :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Poppler", name = "AdditionalActionType"})
    IO (Ptr Poppler.Action.Action)

-- | Retrieves the action (t'GI.Poppler.Unions.Action.Action') that shall be performed when
-- an additional action is triggered on /@field@/, or 'P.Nothing'.
-- 
-- /Since: 0.72/
formFieldGetAdditionalAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> Poppler.Enums.AdditionalActionType
    -- ^ /@type@/: the type of additional action
    -> m Poppler.Action.Action
    -- ^ __Returns:__ the action to perform. The returned
    --               object is owned by /@field@/ and should not be freed.
formFieldGetAdditionalAction :: a -> AdditionalActionType -> m Action
formFieldGetAdditionalAction field :: a
field type_ :: AdditionalActionType
type_ = IO Action -> m Action
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Action -> m Action) -> IO Action -> m Action
forall a b. (a -> b) -> a -> b
$ do
    Ptr FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (AdditionalActionType -> Int) -> AdditionalActionType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdditionalActionType -> Int
forall a. Enum a => a -> Int
fromEnum) AdditionalActionType
type_
    Ptr Action
result <- Ptr FormField -> CUInt -> IO (Ptr Action)
poppler_form_field_get_additional_action Ptr FormField
field' CUInt
type_'
    Text -> Ptr Action -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "formFieldGetAdditionalAction" Ptr Action
result
    Action
result' <- ((ManagedPtr Action -> Action) -> Ptr Action -> IO Action
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Action -> Action
Poppler.Action.Action) Ptr Action
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Action -> IO Action
forall (m :: * -> *) a. Monad m => a -> m a
return Action
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldGetAdditionalActionMethodInfo
instance (signature ~ (Poppler.Enums.AdditionalActionType -> m Poppler.Action.Action), MonadIO m, IsFormField a) => O.MethodInfo FormFieldGetAdditionalActionMethodInfo a signature where
    overloadedMethod = formFieldGetAdditionalAction

#endif

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

foreign import ccall "poppler_form_field_get_field_type" poppler_form_field_get_field_type :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CUInt

-- | Gets the type of /@field@/
formFieldGetFieldType ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Poppler.Enums.FormFieldType
    -- ^ __Returns:__ t'GI.Poppler.Enums.FormFieldType' of /@field@/
formFieldGetFieldType :: a -> m FormFieldType
formFieldGetFieldType field :: a
field = IO FormFieldType -> m FormFieldType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FormFieldType -> m FormFieldType)
-> IO FormFieldType -> m FormFieldType
forall a b. (a -> b) -> a -> b
$ do
    Ptr FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CUInt
result <- Ptr FormField -> IO CUInt
poppler_form_field_get_field_type Ptr FormField
field'
    let result' :: FormFieldType
result' = (Int -> FormFieldType
forall a. Enum a => Int -> a
toEnum (Int -> FormFieldType) -> (CUInt -> Int) -> CUInt -> FormFieldType
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
field
    FormFieldType -> IO FormFieldType
forall (m :: * -> *) a. Monad m => a -> m a
return FormFieldType
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldGetFieldTypeMethodInfo
instance (signature ~ (m Poppler.Enums.FormFieldType), MonadIO m, IsFormField a) => O.MethodInfo FormFieldGetFieldTypeMethodInfo a signature where
    overloadedMethod = formFieldGetFieldType

#endif

-- method FormField::get_font_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , 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_form_field_get_font_size" poppler_form_field_get_font_size :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CDouble

-- | Gets the font size of /@field@/
-- 
-- WARNING: This function always returns 0. Contact the poppler
-- mailing list if you\'re interested in implementing it properly
formFieldGetFontSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Double
    -- ^ __Returns:__ the font size of /@field@/
formFieldGetFontSize :: a -> m Double
formFieldGetFontSize field :: a
field = IO Double -> m Double
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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CDouble
result <- Ptr FormField -> IO CDouble
poppler_form_field_get_font_size Ptr FormField
field'
    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
field
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldGetFontSizeMethodInfo
instance (signature ~ (m Double), MonadIO m, IsFormField a) => O.MethodInfo FormFieldGetFontSizeMethodInfo a signature where
    overloadedMethod = formFieldGetFontSize

#endif

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

foreign import ccall "poppler_form_field_get_id" poppler_form_field_get_id :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO Int32

-- | Gets the id of /@field@/
formFieldGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Int32
    -- ^ __Returns:__ the id of /@field@/
formFieldGetId :: a -> m Int32
formFieldGetId field :: a
field = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    Int32
result <- Ptr FormField -> IO Int32
poppler_form_field_get_id Ptr FormField
field'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data FormFieldGetIdMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsFormField a) => O.MethodInfo FormFieldGetIdMethodInfo a signature where
    overloadedMethod = formFieldGetId

#endif

-- method FormField::get_mapping_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , 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_form_field_get_mapping_name" poppler_form_field_get_mapping_name :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CString

-- | Gets the mapping name of /@field@/ that is used when
-- exporting interactive form field data from the document
-- 
-- /Since: 0.16/
formFieldGetMappingName ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string. It must be freed with 'GI.GLib.Functions.free' when done.
formFieldGetMappingName :: a -> m Text
formFieldGetMappingName field :: a
field = IO Text -> m Text
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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CString
result <- Ptr FormField -> IO CString
poppler_form_field_get_mapping_name Ptr FormField
field'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "formFieldGetMappingName" 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
field
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldGetMappingNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsFormField a) => O.MethodInfo FormFieldGetMappingNameMethodInfo a signature where
    overloadedMethod = formFieldGetMappingName

#endif

-- method FormField::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , 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_form_field_get_name" poppler_form_field_get_name :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CString

-- | Gets the fully qualified name of /@field@/. It\'s constructed by concatenating
-- the partial field names of the field and all of its ancestors.
-- 
-- /Since: 0.16/
formFieldGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string. It must be freed with 'GI.GLib.Functions.free' when done.
formFieldGetName :: a -> m Text
formFieldGetName field :: a
field = IO Text -> m Text
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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CString
result <- Ptr FormField -> IO CString
poppler_form_field_get_name Ptr FormField
field'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "formFieldGetName" 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
field
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsFormField a) => O.MethodInfo FormFieldGetNameMethodInfo a signature where
    overloadedMethod = formFieldGetName

#endif

-- method FormField::get_partial_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , 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_form_field_get_partial_name" poppler_form_field_get_partial_name :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CString

-- | Gets the partial name of /@field@/.
-- 
-- /Since: 0.16/
formFieldGetPartialName ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string. It must be freed with 'GI.GLib.Functions.free' when done.
formFieldGetPartialName :: a -> m Text
formFieldGetPartialName field :: a
field = IO Text -> m Text
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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CString
result <- Ptr FormField -> IO CString
poppler_form_field_get_partial_name Ptr FormField
field'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "formFieldGetPartialName" 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
field
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldGetPartialNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsFormField a) => O.MethodInfo FormFieldGetPartialNameMethodInfo a signature where
    overloadedMethod = formFieldGetPartialName

#endif

-- method FormField::is_read_only
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , 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_form_field_is_read_only" poppler_form_field_is_read_only :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CInt

-- | Checks whether /@field@/ is read only
formFieldIsReadOnly ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@field@/ is read only
formFieldIsReadOnly :: a -> m Bool
formFieldIsReadOnly field :: a
field = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CInt
result <- Ptr FormField -> IO CInt
poppler_form_field_is_read_only Ptr FormField
field'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldIsReadOnlyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFormField a) => O.MethodInfo FormFieldIsReadOnlyMethodInfo a signature where
    overloadedMethod = formFieldIsReadOnly

#endif

-- method FormField::text_do_scroll
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_form_field_text_do_scroll" poppler_form_field_text_do_scroll :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CInt

-- | /No description available in the introspection data./
formFieldTextDoScroll ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -> m Bool
formFieldTextDoScroll :: a -> m Bool
formFieldTextDoScroll field :: a
field = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CInt
result <- Ptr FormField -> IO CInt
poppler_form_field_text_do_scroll Ptr FormField
field'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldTextDoScrollMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFormField a) => O.MethodInfo FormFieldTextDoScrollMethodInfo a signature where
    overloadedMethod = formFieldTextDoScroll

#endif

-- method FormField::text_do_spell_check
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , 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_form_field_text_do_spell_check" poppler_form_field_text_do_spell_check :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CInt

-- | Checks whether spell checking should be done for the contents of /@field@/
formFieldTextDoSpellCheck ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if spell checking should be done for /@field@/
formFieldTextDoSpellCheck :: a -> m Bool
formFieldTextDoSpellCheck field :: a
field = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CInt
result <- Ptr FormField -> IO CInt
poppler_form_field_text_do_spell_check Ptr FormField
field'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldTextDoSpellCheckMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFormField a) => O.MethodInfo FormFieldTextDoSpellCheckMethodInfo a signature where
    overloadedMethod = formFieldTextDoSpellCheck

#endif

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

foreign import ccall "poppler_form_field_text_get_max_len" poppler_form_field_text_get_max_len :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO Int32

-- | Retrieves the maximum allowed length of the text in /@field@/
formFieldTextGetMaxLen ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Int32
    -- ^ __Returns:__ the maximum allowed number of characters in /@field@/, or -1 if there is no maximum.
formFieldTextGetMaxLen :: a -> m Int32
formFieldTextGetMaxLen field :: a
field = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    Int32
result <- Ptr FormField -> IO Int32
poppler_form_field_text_get_max_len Ptr FormField
field'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data FormFieldTextGetMaxLenMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsFormField a) => O.MethodInfo FormFieldTextGetMaxLenMethodInfo a signature where
    overloadedMethod = formFieldTextGetMaxLen

#endif

-- method FormField::text_get_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , 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_form_field_text_get_text" poppler_form_field_text_get_text :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CString

-- | Retrieves the contents of /@field@/.
formFieldTextGetText ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m T.Text
    -- ^ __Returns:__ a new allocated string. It must be freed with 'GI.GLib.Functions.free' when done.
formFieldTextGetText :: a -> m Text
formFieldTextGetText field :: a
field = IO Text -> m Text
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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CString
result <- Ptr FormField -> IO CString
poppler_form_field_text_get_text Ptr FormField
field'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "formFieldTextGetText" 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
field
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldTextGetTextMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsFormField a) => O.MethodInfo FormFieldTextGetTextMethodInfo a signature where
    overloadedMethod = formFieldTextGetText

#endif

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

foreign import ccall "poppler_form_field_text_get_text_type" poppler_form_field_text_get_text_type :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CUInt

-- | Gets the text type of /@field@/.
formFieldTextGetTextType ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Poppler.Enums.FormTextType
    -- ^ __Returns:__ t'GI.Poppler.Enums.FormTextType' of /@field@/
formFieldTextGetTextType :: a -> m FormTextType
formFieldTextGetTextType field :: a
field = IO FormTextType -> m FormTextType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FormTextType -> m FormTextType)
-> IO FormTextType -> m FormTextType
forall a b. (a -> b) -> a -> b
$ do
    Ptr FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CUInt
result <- Ptr FormField -> IO CUInt
poppler_form_field_text_get_text_type Ptr FormField
field'
    let result' :: FormTextType
result' = (Int -> FormTextType
forall a. Enum a => Int -> a
toEnum (Int -> FormTextType) -> (CUInt -> Int) -> CUInt -> FormTextType
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
field
    FormTextType -> IO FormTextType
forall (m :: * -> *) a. Monad m => a -> m a
return FormTextType
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldTextGetTextTypeMethodInfo
instance (signature ~ (m Poppler.Enums.FormTextType), MonadIO m, IsFormField a) => O.MethodInfo FormFieldTextGetTextTypeMethodInfo a signature where
    overloadedMethod = formFieldTextGetTextType

#endif

-- method FormField::text_is_password
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , 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_form_field_text_is_password" poppler_form_field_text_is_password :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CInt

-- | Checks whether content of /@field@/ is a password and it must be hidden
formFieldTextIsPassword ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the content of /@field@/ is a password
formFieldTextIsPassword :: a -> m Bool
formFieldTextIsPassword field :: a
field = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CInt
result <- Ptr FormField -> IO CInt
poppler_form_field_text_is_password Ptr FormField
field'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldTextIsPasswordMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFormField a) => O.MethodInfo FormFieldTextIsPasswordMethodInfo a signature where
    overloadedMethod = formFieldTextIsPassword

#endif

-- method FormField::text_is_rich_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , 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_form_field_text_is_rich_text" poppler_form_field_text_is_rich_text :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    IO CInt

-- | Checks whether the contents of /@field@/ are rich text
formFieldTextIsRichText ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the contents of /@field@/ are rich text
formFieldTextIsRichText :: a -> m Bool
formFieldTextIsRichText field :: a
field = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CInt
result <- Ptr FormField -> IO CInt
poppler_form_field_text_is_rich_text Ptr FormField
field'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FormFieldTextIsRichTextMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFormField a) => O.MethodInfo FormFieldTextIsRichTextMethodInfo a signature where
    overloadedMethod = formFieldTextIsRichText

#endif

-- method FormField::text_set_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "field"
--           , argType =
--               TInterface Name { namespace = "Poppler" , name = "FormField" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PopplerFormField"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new text" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_form_field_text_set_text" poppler_form_field_text_set_text :: 
    Ptr FormField ->                        -- field : TInterface (Name {namespace = "Poppler", name = "FormField"})
    CString ->                              -- text : TBasicType TUTF8
    IO ()

-- | Sets the text in /@field@/ to the given value, replacing the current contents.
formFieldTextSetText ::
    (B.CallStack.HasCallStack, MonadIO m, IsFormField a) =>
    a
    -- ^ /@field@/: a t'GI.Poppler.Objects.FormField.FormField'
    -> T.Text
    -- ^ /@text@/: the new text
    -> m ()
formFieldTextSetText :: a -> Text -> m ()
formFieldTextSetText field :: a
field text :: Text
text = 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 FormField
field' <- a -> IO (Ptr FormField)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
field
    CString
text' <- Text -> IO CString
textToCString Text
text
    Ptr FormField -> CString -> IO ()
poppler_form_field_text_set_text Ptr FormField
field' CString
text'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
field
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FormFieldTextSetTextMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsFormField a) => O.MethodInfo FormFieldTextSetTextMethodInfo a signature where
    overloadedMethod = formFieldTextSetText

#endif