{-# 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.GtkSource.Objects.CompletionWords
    ( 

-- * Exported types
    CompletionWords(..)                     ,
    IsCompletionWords                       ,
    toCompletionWords                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveCompletionWordsMethod            ,
#endif


-- ** new #method:new#

    completionWordsNew                      ,


-- ** register #method:register#

#if defined(ENABLE_OVERLOADING)
    CompletionWordsRegisterMethodInfo       ,
#endif
    completionWordsRegister                 ,


-- ** unregister #method:unregister#

#if defined(ENABLE_OVERLOADING)
    CompletionWordsUnregisterMethodInfo     ,
#endif
    completionWordsUnregister               ,




 -- * Properties
-- ** activation #attr:activation#
-- | The type of activation.
-- 
-- /Since: 3.10/

#if defined(ENABLE_OVERLOADING)
    CompletionWordsActivationPropertyInfo   ,
#endif
#if defined(ENABLE_OVERLOADING)
    completionWordsActivation               ,
#endif
    constructCompletionWordsActivation      ,
    getCompletionWordsActivation            ,
    setCompletionWordsActivation            ,


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

#if defined(ENABLE_OVERLOADING)
    CompletionWordsIconPropertyInfo         ,
#endif
    clearCompletionWordsIcon                ,
#if defined(ENABLE_OVERLOADING)
    completionWordsIcon                     ,
#endif
    constructCompletionWordsIcon            ,
    getCompletionWordsIcon                  ,
    setCompletionWordsIcon                  ,


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

#if defined(ENABLE_OVERLOADING)
    CompletionWordsInteractiveDelayPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    completionWordsInteractiveDelay         ,
#endif
    constructCompletionWordsInteractiveDelay,
    getCompletionWordsInteractiveDelay      ,
    setCompletionWordsInteractiveDelay      ,


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

#if defined(ENABLE_OVERLOADING)
    CompletionWordsMinimumWordSizePropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    completionWordsMinimumWordSize          ,
#endif
    constructCompletionWordsMinimumWordSize ,
    getCompletionWordsMinimumWordSize       ,
    setCompletionWordsMinimumWordSize       ,


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

#if defined(ENABLE_OVERLOADING)
    CompletionWordsNamePropertyInfo         ,
#endif
    clearCompletionWordsName                ,
#if defined(ENABLE_OVERLOADING)
    completionWordsName                     ,
#endif
    constructCompletionWordsName            ,
    getCompletionWordsName                  ,
    setCompletionWordsName                  ,


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

#if defined(ENABLE_OVERLOADING)
    CompletionWordsPriorityPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    completionWordsPriority                 ,
#endif
    constructCompletionWordsPriority        ,
    getCompletionWordsPriority              ,
    setCompletionWordsPriority              ,


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

#if defined(ENABLE_OVERLOADING)
    CompletionWordsProposalsBatchSizePropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    completionWordsProposalsBatchSize       ,
#endif
    constructCompletionWordsProposalsBatchSize,
    getCompletionWordsProposalsBatchSize    ,
    setCompletionWordsProposalsBatchSize    ,


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

#if defined(ENABLE_OVERLOADING)
    CompletionWordsScanBatchSizePropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    completionWordsScanBatchSize            ,
#endif
    constructCompletionWordsScanBatchSize   ,
    getCompletionWordsScanBatchSize         ,
    setCompletionWordsScanBatchSize         ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gtk.Objects.TextBuffer as Gtk.TextBuffer
import {-# SOURCE #-} qualified GI.GtkSource.Flags as GtkSource.Flags
import {-# SOURCE #-} qualified GI.GtkSource.Interfaces.CompletionProvider as GtkSource.CompletionProvider

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

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

foreign import ccall "gtk_source_completion_words_get_type"
    c_gtk_source_completion_words_get_type :: IO B.Types.GType

instance B.Types.TypedObject CompletionWords where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_completion_words_get_type

instance B.Types.GObject CompletionWords

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

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

instance O.HasParentTypes CompletionWords
type instance O.ParentTypes CompletionWords = '[GObject.Object.Object, GtkSource.CompletionProvider.CompletionProvider]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveCompletionWordsMethod (t :: Symbol) (o :: *) :: * where
    ResolveCompletionWordsMethod "activateProposal" o = GtkSource.CompletionProvider.CompletionProviderActivateProposalMethodInfo
    ResolveCompletionWordsMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveCompletionWordsMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveCompletionWordsMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveCompletionWordsMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveCompletionWordsMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveCompletionWordsMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveCompletionWordsMethod "match" o = GtkSource.CompletionProvider.CompletionProviderMatchMethodInfo
    ResolveCompletionWordsMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveCompletionWordsMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveCompletionWordsMethod "populate" o = GtkSource.CompletionProvider.CompletionProviderPopulateMethodInfo
    ResolveCompletionWordsMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveCompletionWordsMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveCompletionWordsMethod "register" o = CompletionWordsRegisterMethodInfo
    ResolveCompletionWordsMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveCompletionWordsMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveCompletionWordsMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveCompletionWordsMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveCompletionWordsMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveCompletionWordsMethod "unregister" o = CompletionWordsUnregisterMethodInfo
    ResolveCompletionWordsMethod "updateInfo" o = GtkSource.CompletionProvider.CompletionProviderUpdateInfoMethodInfo
    ResolveCompletionWordsMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveCompletionWordsMethod "getActivation" o = GtkSource.CompletionProvider.CompletionProviderGetActivationMethodInfo
    ResolveCompletionWordsMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveCompletionWordsMethod "getGicon" o = GtkSource.CompletionProvider.CompletionProviderGetGiconMethodInfo
    ResolveCompletionWordsMethod "getIcon" o = GtkSource.CompletionProvider.CompletionProviderGetIconMethodInfo
    ResolveCompletionWordsMethod "getIconName" o = GtkSource.CompletionProvider.CompletionProviderGetIconNameMethodInfo
    ResolveCompletionWordsMethod "getInfoWidget" o = GtkSource.CompletionProvider.CompletionProviderGetInfoWidgetMethodInfo
    ResolveCompletionWordsMethod "getInteractiveDelay" o = GtkSource.CompletionProvider.CompletionProviderGetInteractiveDelayMethodInfo
    ResolveCompletionWordsMethod "getName" o = GtkSource.CompletionProvider.CompletionProviderGetNameMethodInfo
    ResolveCompletionWordsMethod "getPriority" o = GtkSource.CompletionProvider.CompletionProviderGetPriorityMethodInfo
    ResolveCompletionWordsMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveCompletionWordsMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveCompletionWordsMethod "getStartIter" o = GtkSource.CompletionProvider.CompletionProviderGetStartIterMethodInfo
    ResolveCompletionWordsMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveCompletionWordsMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveCompletionWordsMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveCompletionWordsMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "activation"
   -- Type: TInterface (Name {namespace = "GtkSource", name = "CompletionActivation"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@activation@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completionWords #activation
-- @
getCompletionWordsActivation :: (MonadIO m, IsCompletionWords o) => o -> m [GtkSource.Flags.CompletionActivation]
getCompletionWordsActivation :: o -> m [CompletionActivation]
getCompletionWordsActivation o
obj = IO [CompletionActivation] -> m [CompletionActivation]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [CompletionActivation] -> m [CompletionActivation])
-> IO [CompletionActivation] -> m [CompletionActivation]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [CompletionActivation]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"activation"

-- | Set the value of the “@activation@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' completionWords [ #activation 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionWordsActivation :: (MonadIO m, IsCompletionWords o) => o -> [GtkSource.Flags.CompletionActivation] -> m ()
setCompletionWordsActivation :: o -> [CompletionActivation] -> m ()
setCompletionWordsActivation o
obj [CompletionActivation]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> [CompletionActivation] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"activation" [CompletionActivation]
val

-- | Construct a `GValueConstruct` with valid value for the “@activation@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCompletionWordsActivation :: (IsCompletionWords o, MIO.MonadIO m) => [GtkSource.Flags.CompletionActivation] -> m (GValueConstruct o)
constructCompletionWordsActivation :: [CompletionActivation] -> m (GValueConstruct o)
constructCompletionWordsActivation [CompletionActivation]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [CompletionActivation] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"activation" [CompletionActivation]
val

#if defined(ENABLE_OVERLOADING)
data CompletionWordsActivationPropertyInfo
instance AttrInfo CompletionWordsActivationPropertyInfo where
    type AttrAllowedOps CompletionWordsActivationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CompletionWordsActivationPropertyInfo = IsCompletionWords
    type AttrSetTypeConstraint CompletionWordsActivationPropertyInfo = (~) [GtkSource.Flags.CompletionActivation]
    type AttrTransferTypeConstraint CompletionWordsActivationPropertyInfo = (~) [GtkSource.Flags.CompletionActivation]
    type AttrTransferType CompletionWordsActivationPropertyInfo = [GtkSource.Flags.CompletionActivation]
    type AttrGetType CompletionWordsActivationPropertyInfo = [GtkSource.Flags.CompletionActivation]
    type AttrLabel CompletionWordsActivationPropertyInfo = "activation"
    type AttrOrigin CompletionWordsActivationPropertyInfo = CompletionWords
    attrGet = getCompletionWordsActivation
    attrSet = setCompletionWordsActivation
    attrTransfer _ v = do
        return v
    attrConstruct = constructCompletionWordsActivation
    attrClear = undefined
#endif

-- VVV Prop "icon"
   -- Type: TInterface (Name {namespace = "GdkPixbuf", name = "Pixbuf"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@icon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completionWords #icon
-- @
getCompletionWordsIcon :: (MonadIO m, IsCompletionWords o) => o -> m (Maybe GdkPixbuf.Pixbuf.Pixbuf)
getCompletionWordsIcon :: o -> m (Maybe Pixbuf)
getCompletionWordsIcon o
obj = IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Pixbuf) -> m (Maybe Pixbuf))
-> IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Pixbuf -> Pixbuf) -> IO (Maybe Pixbuf)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"icon" ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf

-- | Set the value of the “@icon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' completionWords [ #icon 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionWordsIcon :: (MonadIO m, IsCompletionWords o, GdkPixbuf.Pixbuf.IsPixbuf a) => o -> a -> m ()
setCompletionWordsIcon :: o -> a -> m ()
setCompletionWordsIcon o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"icon" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@icon@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCompletionWordsIcon :: (IsCompletionWords o, MIO.MonadIO m, GdkPixbuf.Pixbuf.IsPixbuf a) => a -> m (GValueConstruct o)
constructCompletionWordsIcon :: a -> m (GValueConstruct o)
constructCompletionWordsIcon a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"icon" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@icon@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #icon
-- @
clearCompletionWordsIcon :: (MonadIO m, IsCompletionWords o) => o -> m ()
clearCompletionWordsIcon :: o -> m ()
clearCompletionWordsIcon o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Pixbuf -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"icon" (Maybe Pixbuf
forall a. Maybe a
Nothing :: Maybe GdkPixbuf.Pixbuf.Pixbuf)

#if defined(ENABLE_OVERLOADING)
data CompletionWordsIconPropertyInfo
instance AttrInfo CompletionWordsIconPropertyInfo where
    type AttrAllowedOps CompletionWordsIconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint CompletionWordsIconPropertyInfo = IsCompletionWords
    type AttrSetTypeConstraint CompletionWordsIconPropertyInfo = GdkPixbuf.Pixbuf.IsPixbuf
    type AttrTransferTypeConstraint CompletionWordsIconPropertyInfo = GdkPixbuf.Pixbuf.IsPixbuf
    type AttrTransferType CompletionWordsIconPropertyInfo = GdkPixbuf.Pixbuf.Pixbuf
    type AttrGetType CompletionWordsIconPropertyInfo = (Maybe GdkPixbuf.Pixbuf.Pixbuf)
    type AttrLabel CompletionWordsIconPropertyInfo = "icon"
    type AttrOrigin CompletionWordsIconPropertyInfo = CompletionWords
    attrGet = getCompletionWordsIcon
    attrSet = setCompletionWordsIcon
    attrTransfer _ v = do
        unsafeCastTo GdkPixbuf.Pixbuf.Pixbuf v
    attrConstruct = constructCompletionWordsIcon
    attrClear = clearCompletionWordsIcon
#endif

-- VVV Prop "interactive-delay"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@interactive-delay@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCompletionWordsInteractiveDelay :: (IsCompletionWords o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructCompletionWordsInteractiveDelay :: Int32 -> m (GValueConstruct o)
constructCompletionWordsInteractiveDelay Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"interactive-delay" Int32
val

#if defined(ENABLE_OVERLOADING)
data CompletionWordsInteractiveDelayPropertyInfo
instance AttrInfo CompletionWordsInteractiveDelayPropertyInfo where
    type AttrAllowedOps CompletionWordsInteractiveDelayPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CompletionWordsInteractiveDelayPropertyInfo = IsCompletionWords
    type AttrSetTypeConstraint CompletionWordsInteractiveDelayPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint CompletionWordsInteractiveDelayPropertyInfo = (~) Int32
    type AttrTransferType CompletionWordsInteractiveDelayPropertyInfo = Int32
    type AttrGetType CompletionWordsInteractiveDelayPropertyInfo = Int32
    type AttrLabel CompletionWordsInteractiveDelayPropertyInfo = "interactive-delay"
    type AttrOrigin CompletionWordsInteractiveDelayPropertyInfo = CompletionWords
    attrGet = getCompletionWordsInteractiveDelay
    attrSet = setCompletionWordsInteractiveDelay
    attrTransfer _ v = do
        return v
    attrConstruct = constructCompletionWordsInteractiveDelay
    attrClear = undefined
#endif

-- VVV Prop "minimum-word-size"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@minimum-word-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completionWords #minimumWordSize
-- @
getCompletionWordsMinimumWordSize :: (MonadIO m, IsCompletionWords o) => o -> m Word32
getCompletionWordsMinimumWordSize :: o -> m Word32
getCompletionWordsMinimumWordSize o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"minimum-word-size"

-- | Set the value of the “@minimum-word-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' completionWords [ #minimumWordSize 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionWordsMinimumWordSize :: (MonadIO m, IsCompletionWords o) => o -> Word32 -> m ()
setCompletionWordsMinimumWordSize :: o -> Word32 -> m ()
setCompletionWordsMinimumWordSize o
obj Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"minimum-word-size" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@minimum-word-size@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCompletionWordsMinimumWordSize :: (IsCompletionWords o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructCompletionWordsMinimumWordSize :: Word32 -> m (GValueConstruct o)
constructCompletionWordsMinimumWordSize Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"minimum-word-size" Word32
val

#if defined(ENABLE_OVERLOADING)
data CompletionWordsMinimumWordSizePropertyInfo
instance AttrInfo CompletionWordsMinimumWordSizePropertyInfo where
    type AttrAllowedOps CompletionWordsMinimumWordSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CompletionWordsMinimumWordSizePropertyInfo = IsCompletionWords
    type AttrSetTypeConstraint CompletionWordsMinimumWordSizePropertyInfo = (~) Word32
    type AttrTransferTypeConstraint CompletionWordsMinimumWordSizePropertyInfo = (~) Word32
    type AttrTransferType CompletionWordsMinimumWordSizePropertyInfo = Word32
    type AttrGetType CompletionWordsMinimumWordSizePropertyInfo = Word32
    type AttrLabel CompletionWordsMinimumWordSizePropertyInfo = "minimum-word-size"
    type AttrOrigin CompletionWordsMinimumWordSizePropertyInfo = CompletionWords
    attrGet = getCompletionWordsMinimumWordSize
    attrSet = setCompletionWordsMinimumWordSize
    attrTransfer _ v = do
        return v
    attrConstruct = constructCompletionWordsMinimumWordSize
    attrClear = undefined
#endif

-- VVV Prop "name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' completionWords [ #name 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionWordsName :: (MonadIO m, IsCompletionWords o) => o -> T.Text -> m ()
setCompletionWordsName :: o -> Text -> m ()
setCompletionWordsName o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCompletionWordsName :: (IsCompletionWords o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructCompletionWordsName :: Text -> m (GValueConstruct o)
constructCompletionWordsName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@name@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #name
-- @
clearCompletionWordsName :: (MonadIO m, IsCompletionWords o) => o -> m ()
clearCompletionWordsName :: o -> m ()
clearCompletionWordsName o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"name" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data CompletionWordsNamePropertyInfo
instance AttrInfo CompletionWordsNamePropertyInfo where
    type AttrAllowedOps CompletionWordsNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint CompletionWordsNamePropertyInfo = IsCompletionWords
    type AttrSetTypeConstraint CompletionWordsNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint CompletionWordsNamePropertyInfo = (~) T.Text
    type AttrTransferType CompletionWordsNamePropertyInfo = T.Text
    type AttrGetType CompletionWordsNamePropertyInfo = (Maybe T.Text)
    type AttrLabel CompletionWordsNamePropertyInfo = "name"
    type AttrOrigin CompletionWordsNamePropertyInfo = CompletionWords
    attrGet = getCompletionWordsName
    attrSet = setCompletionWordsName
    attrTransfer _ v = do
        return v
    attrConstruct = constructCompletionWordsName
    attrClear = clearCompletionWordsName
#endif

-- VVV Prop "priority"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@priority@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCompletionWordsPriority :: (IsCompletionWords o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructCompletionWordsPriority :: Int32 -> m (GValueConstruct o)
constructCompletionWordsPriority Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"priority" Int32
val

#if defined(ENABLE_OVERLOADING)
data CompletionWordsPriorityPropertyInfo
instance AttrInfo CompletionWordsPriorityPropertyInfo where
    type AttrAllowedOps CompletionWordsPriorityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CompletionWordsPriorityPropertyInfo = IsCompletionWords
    type AttrSetTypeConstraint CompletionWordsPriorityPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint CompletionWordsPriorityPropertyInfo = (~) Int32
    type AttrTransferType CompletionWordsPriorityPropertyInfo = Int32
    type AttrGetType CompletionWordsPriorityPropertyInfo = Int32
    type AttrLabel CompletionWordsPriorityPropertyInfo = "priority"
    type AttrOrigin CompletionWordsPriorityPropertyInfo = CompletionWords
    attrGet = getCompletionWordsPriority
    attrSet = setCompletionWordsPriority
    attrTransfer _ v = do
        return v
    attrConstruct = constructCompletionWordsPriority
    attrClear = undefined
#endif

-- VVV Prop "proposals-batch-size"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@proposals-batch-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completionWords #proposalsBatchSize
-- @
getCompletionWordsProposalsBatchSize :: (MonadIO m, IsCompletionWords o) => o -> m Word32
getCompletionWordsProposalsBatchSize :: o -> m Word32
getCompletionWordsProposalsBatchSize o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"proposals-batch-size"

-- | Set the value of the “@proposals-batch-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' completionWords [ #proposalsBatchSize 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionWordsProposalsBatchSize :: (MonadIO m, IsCompletionWords o) => o -> Word32 -> m ()
setCompletionWordsProposalsBatchSize :: o -> Word32 -> m ()
setCompletionWordsProposalsBatchSize o
obj Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"proposals-batch-size" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@proposals-batch-size@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCompletionWordsProposalsBatchSize :: (IsCompletionWords o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructCompletionWordsProposalsBatchSize :: Word32 -> m (GValueConstruct o)
constructCompletionWordsProposalsBatchSize Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"proposals-batch-size" Word32
val

#if defined(ENABLE_OVERLOADING)
data CompletionWordsProposalsBatchSizePropertyInfo
instance AttrInfo CompletionWordsProposalsBatchSizePropertyInfo where
    type AttrAllowedOps CompletionWordsProposalsBatchSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CompletionWordsProposalsBatchSizePropertyInfo = IsCompletionWords
    type AttrSetTypeConstraint CompletionWordsProposalsBatchSizePropertyInfo = (~) Word32
    type AttrTransferTypeConstraint CompletionWordsProposalsBatchSizePropertyInfo = (~) Word32
    type AttrTransferType CompletionWordsProposalsBatchSizePropertyInfo = Word32
    type AttrGetType CompletionWordsProposalsBatchSizePropertyInfo = Word32
    type AttrLabel CompletionWordsProposalsBatchSizePropertyInfo = "proposals-batch-size"
    type AttrOrigin CompletionWordsProposalsBatchSizePropertyInfo = CompletionWords
    attrGet = getCompletionWordsProposalsBatchSize
    attrSet = setCompletionWordsProposalsBatchSize
    attrTransfer _ v = do
        return v
    attrConstruct = constructCompletionWordsProposalsBatchSize
    attrClear = undefined
#endif

-- VVV Prop "scan-batch-size"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@scan-batch-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' completionWords #scanBatchSize
-- @
getCompletionWordsScanBatchSize :: (MonadIO m, IsCompletionWords o) => o -> m Word32
getCompletionWordsScanBatchSize :: o -> m Word32
getCompletionWordsScanBatchSize o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"scan-batch-size"

-- | Set the value of the “@scan-batch-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' completionWords [ #scanBatchSize 'Data.GI.Base.Attributes.:=' value ]
-- @
setCompletionWordsScanBatchSize :: (MonadIO m, IsCompletionWords o) => o -> Word32 -> m ()
setCompletionWordsScanBatchSize :: o -> Word32 -> m ()
setCompletionWordsScanBatchSize o
obj Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"scan-batch-size" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@scan-batch-size@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructCompletionWordsScanBatchSize :: (IsCompletionWords o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructCompletionWordsScanBatchSize :: Word32 -> m (GValueConstruct o)
constructCompletionWordsScanBatchSize Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"scan-batch-size" Word32
val

#if defined(ENABLE_OVERLOADING)
data CompletionWordsScanBatchSizePropertyInfo
instance AttrInfo CompletionWordsScanBatchSizePropertyInfo where
    type AttrAllowedOps CompletionWordsScanBatchSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint CompletionWordsScanBatchSizePropertyInfo = IsCompletionWords
    type AttrSetTypeConstraint CompletionWordsScanBatchSizePropertyInfo = (~) Word32
    type AttrTransferTypeConstraint CompletionWordsScanBatchSizePropertyInfo = (~) Word32
    type AttrTransferType CompletionWordsScanBatchSizePropertyInfo = Word32
    type AttrGetType CompletionWordsScanBatchSizePropertyInfo = Word32
    type AttrLabel CompletionWordsScanBatchSizePropertyInfo = "scan-batch-size"
    type AttrOrigin CompletionWordsScanBatchSizePropertyInfo = CompletionWords
    attrGet = getCompletionWordsScanBatchSize
    attrSet = setCompletionWordsScanBatchSize
    attrTransfer _ v = do
        return v
    attrConstruct = constructCompletionWordsScanBatchSize
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList CompletionWords
type instance O.AttributeList CompletionWords = CompletionWordsAttributeList
type CompletionWordsAttributeList = ('[ '("activation", CompletionWordsActivationPropertyInfo), '("icon", CompletionWordsIconPropertyInfo), '("interactiveDelay", CompletionWordsInteractiveDelayPropertyInfo), '("minimumWordSize", CompletionWordsMinimumWordSizePropertyInfo), '("name", CompletionWordsNamePropertyInfo), '("priority", CompletionWordsPriorityPropertyInfo), '("proposalsBatchSize", CompletionWordsProposalsBatchSizePropertyInfo), '("scanBatchSize", CompletionWordsScanBatchSizePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
completionWordsActivation :: AttrLabelProxy "activation"
completionWordsActivation = AttrLabelProxy

completionWordsIcon :: AttrLabelProxy "icon"
completionWordsIcon = AttrLabelProxy

completionWordsInteractiveDelay :: AttrLabelProxy "interactiveDelay"
completionWordsInteractiveDelay = AttrLabelProxy

completionWordsMinimumWordSize :: AttrLabelProxy "minimumWordSize"
completionWordsMinimumWordSize = AttrLabelProxy

completionWordsName :: AttrLabelProxy "name"
completionWordsName = AttrLabelProxy

completionWordsPriority :: AttrLabelProxy "priority"
completionWordsPriority = AttrLabelProxy

completionWordsProposalsBatchSize :: AttrLabelProxy "proposalsBatchSize"
completionWordsProposalsBatchSize = AttrLabelProxy

completionWordsScanBatchSize :: AttrLabelProxy "scanBatchSize"
completionWordsScanBatchSize = AttrLabelProxy

#endif

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

#endif

-- method CompletionWords::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The name for the provider, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A specific icon for the provider, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GtkSource" , name = "CompletionWords" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_completion_words_new" gtk_source_completion_words_new :: 
    CString ->                              -- name : TBasicType TUTF8
    Ptr GdkPixbuf.Pixbuf.Pixbuf ->          -- icon : TInterface (Name {namespace = "GdkPixbuf", name = "Pixbuf"})
    IO (Ptr CompletionWords)

-- | /No description available in the introspection data./
completionWordsNew ::
    (B.CallStack.HasCallStack, MonadIO m, GdkPixbuf.Pixbuf.IsPixbuf a) =>
    Maybe (T.Text)
    -- ^ /@name@/: The name for the provider, or 'P.Nothing'.
    -> Maybe (a)
    -- ^ /@icon@/: A specific icon for the provider, or 'P.Nothing'.
    -> m CompletionWords
    -- ^ __Returns:__ a new t'GI.GtkSource.Objects.CompletionWords.CompletionWords' provider
completionWordsNew :: Maybe Text -> Maybe a -> m CompletionWords
completionWordsNew Maybe Text
name Maybe a
icon = IO CompletionWords -> m CompletionWords
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CompletionWords -> m CompletionWords)
-> IO CompletionWords -> m CompletionWords
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jName -> do
            Ptr CChar
jName' <- Text -> IO (Ptr CChar)
textToCString Text
jName
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jName'
    Ptr Pixbuf
maybeIcon <- case Maybe a
icon of
        Maybe a
Nothing -> Ptr Pixbuf -> IO (Ptr Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Pixbuf
forall a. Ptr a
nullPtr
        Just a
jIcon -> do
            Ptr Pixbuf
jIcon' <- a -> IO (Ptr Pixbuf)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jIcon
            Ptr Pixbuf -> IO (Ptr Pixbuf)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Pixbuf
jIcon'
    Ptr CompletionWords
result <- Ptr CChar -> Ptr Pixbuf -> IO (Ptr CompletionWords)
gtk_source_completion_words_new Ptr CChar
maybeName Ptr Pixbuf
maybeIcon
    Text -> Ptr CompletionWords -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"completionWordsNew" Ptr CompletionWords
result
    CompletionWords
result' <- ((ManagedPtr CompletionWords -> CompletionWords)
-> Ptr CompletionWords -> IO CompletionWords
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr CompletionWords -> CompletionWords
CompletionWords) Ptr CompletionWords
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
icon a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeName
    CompletionWords -> IO CompletionWords
forall (m :: * -> *) a. Monad m => a -> m a
return CompletionWords
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method CompletionWords::register
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "words"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionWords" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionWords"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_completion_words_register" gtk_source_completion_words_register :: 
    Ptr CompletionWords ->                  -- words : TInterface (Name {namespace = "GtkSource", name = "CompletionWords"})
    Ptr Gtk.TextBuffer.TextBuffer ->        -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    IO ()

-- | Registers /@buffer@/ in the /@words@/ provider.
completionWordsRegister ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionWords a, Gtk.TextBuffer.IsTextBuffer b) =>
    a
    -- ^ /@words@/: a t'GI.GtkSource.Objects.CompletionWords.CompletionWords'
    -> b
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> m ()
completionWordsRegister :: a -> b -> m ()
completionWordsRegister a
words b
buffer = 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 CompletionWords
words' <- a -> IO (Ptr CompletionWords)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
words
    Ptr TextBuffer
buffer' <- b -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
buffer
    Ptr CompletionWords -> Ptr TextBuffer -> IO ()
gtk_source_completion_words_register Ptr CompletionWords
words' Ptr TextBuffer
buffer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
words
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
buffer
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CompletionWordsRegisterMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsCompletionWords a, Gtk.TextBuffer.IsTextBuffer b) => O.MethodInfo CompletionWordsRegisterMethodInfo a signature where
    overloadedMethod = completionWordsRegister

#endif

-- method CompletionWords::unregister
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "words"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "CompletionWords" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceCompletionWords"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_completion_words_unregister" gtk_source_completion_words_unregister :: 
    Ptr CompletionWords ->                  -- words : TInterface (Name {namespace = "GtkSource", name = "CompletionWords"})
    Ptr Gtk.TextBuffer.TextBuffer ->        -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    IO ()

-- | Unregisters /@buffer@/ from the /@words@/ provider.
completionWordsUnregister ::
    (B.CallStack.HasCallStack, MonadIO m, IsCompletionWords a, Gtk.TextBuffer.IsTextBuffer b) =>
    a
    -- ^ /@words@/: a t'GI.GtkSource.Objects.CompletionWords.CompletionWords'
    -> b
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'
    -> m ()
completionWordsUnregister :: a -> b -> m ()
completionWordsUnregister a
words b
buffer = 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 CompletionWords
words' <- a -> IO (Ptr CompletionWords)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
words
    Ptr TextBuffer
buffer' <- b -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
buffer
    Ptr CompletionWords -> Ptr TextBuffer -> IO ()
gtk_source_completion_words_unregister Ptr CompletionWords
words' Ptr TextBuffer
buffer'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
words
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
buffer
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CompletionWordsUnregisterMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsCompletionWords a, Gtk.TextBuffer.IsTextBuffer b) => O.MethodInfo CompletionWordsUnregisterMethodInfo a signature where
    overloadedMethod = completionWordsUnregister

#endif