{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Gtk.Objects.EntryCompletion
    ( 

-- * Exported types
    EntryCompletion(..)                     ,
    EntryCompletionK                        ,
    toEntryCompletion                       ,
    noEntryCompletion                       ,


 -- * Methods
-- ** entryCompletionComplete
    entryCompletionComplete                 ,


-- ** entryCompletionComputePrefix
    entryCompletionComputePrefix            ,


-- ** entryCompletionDeleteAction
    entryCompletionDeleteAction             ,


-- ** entryCompletionGetCompletionPrefix
    entryCompletionGetCompletionPrefix      ,


-- ** entryCompletionGetEntry
    entryCompletionGetEntry                 ,


-- ** entryCompletionGetInlineCompletion
    entryCompletionGetInlineCompletion      ,


-- ** entryCompletionGetInlineSelection
    entryCompletionGetInlineSelection       ,


-- ** entryCompletionGetMinimumKeyLength
    entryCompletionGetMinimumKeyLength      ,


-- ** entryCompletionGetModel
    entryCompletionGetModel                 ,


-- ** entryCompletionGetPopupCompletion
    entryCompletionGetPopupCompletion       ,


-- ** entryCompletionGetPopupSetWidth
    entryCompletionGetPopupSetWidth         ,


-- ** entryCompletionGetPopupSingleMatch
    entryCompletionGetPopupSingleMatch      ,


-- ** entryCompletionGetTextColumn
    entryCompletionGetTextColumn            ,


-- ** entryCompletionInsertActionMarkup
    entryCompletionInsertActionMarkup       ,


-- ** entryCompletionInsertActionText
    entryCompletionInsertActionText         ,


-- ** entryCompletionInsertPrefix
    entryCompletionInsertPrefix             ,


-- ** entryCompletionNew
    entryCompletionNew                      ,


-- ** entryCompletionNewWithArea
    entryCompletionNewWithArea              ,


-- ** entryCompletionSetInlineCompletion
    entryCompletionSetInlineCompletion      ,


-- ** entryCompletionSetInlineSelection
    entryCompletionSetInlineSelection       ,


-- ** entryCompletionSetMatchFunc
    entryCompletionSetMatchFunc             ,


-- ** entryCompletionSetMinimumKeyLength
    entryCompletionSetMinimumKeyLength      ,


-- ** entryCompletionSetModel
    entryCompletionSetModel                 ,


-- ** entryCompletionSetPopupCompletion
    entryCompletionSetPopupCompletion       ,


-- ** entryCompletionSetPopupSetWidth
    entryCompletionSetPopupSetWidth         ,


-- ** entryCompletionSetPopupSingleMatch
    entryCompletionSetPopupSingleMatch      ,


-- ** entryCompletionSetTextColumn
    entryCompletionSetTextColumn            ,




 -- * Properties
-- ** CellArea
    EntryCompletionCellAreaPropertyInfo     ,
    constructEntryCompletionCellArea        ,
    getEntryCompletionCellArea              ,


-- ** InlineCompletion
    EntryCompletionInlineCompletionPropertyInfo,
    constructEntryCompletionInlineCompletion,
    getEntryCompletionInlineCompletion      ,
    setEntryCompletionInlineCompletion      ,


-- ** InlineSelection
    EntryCompletionInlineSelectionPropertyInfo,
    constructEntryCompletionInlineSelection ,
    getEntryCompletionInlineSelection       ,
    setEntryCompletionInlineSelection       ,


-- ** MinimumKeyLength
    EntryCompletionMinimumKeyLengthPropertyInfo,
    constructEntryCompletionMinimumKeyLength,
    getEntryCompletionMinimumKeyLength      ,
    setEntryCompletionMinimumKeyLength      ,


-- ** Model
    EntryCompletionModelPropertyInfo        ,
    constructEntryCompletionModel           ,
    getEntryCompletionModel                 ,
    setEntryCompletionModel                 ,


-- ** PopupCompletion
    EntryCompletionPopupCompletionPropertyInfo,
    constructEntryCompletionPopupCompletion ,
    getEntryCompletionPopupCompletion       ,
    setEntryCompletionPopupCompletion       ,


-- ** PopupSetWidth
    EntryCompletionPopupSetWidthPropertyInfo,
    constructEntryCompletionPopupSetWidth   ,
    getEntryCompletionPopupSetWidth         ,
    setEntryCompletionPopupSetWidth         ,


-- ** PopupSingleMatch
    EntryCompletionPopupSingleMatchPropertyInfo,
    constructEntryCompletionPopupSingleMatch,
    getEntryCompletionPopupSingleMatch      ,
    setEntryCompletionPopupSingleMatch      ,


-- ** TextColumn
    EntryCompletionTextColumnPropertyInfo   ,
    constructEntryCompletionTextColumn      ,
    getEntryCompletionTextColumn            ,
    setEntryCompletionTextColumn            ,




 -- * Signals
-- ** ActionActivated
    EntryCompletionActionActivatedCallback  ,
    EntryCompletionActionActivatedCallbackC ,
    EntryCompletionActionActivatedSignalInfo,
    afterEntryCompletionActionActivated     ,
    entryCompletionActionActivatedCallbackWrapper,
    entryCompletionActionActivatedClosure   ,
    mkEntryCompletionActionActivatedCallback,
    noEntryCompletionActionActivatedCallback,
    onEntryCompletionActionActivated        ,


-- ** CursorOnMatch
    EntryCompletionCursorOnMatchCallback    ,
    EntryCompletionCursorOnMatchCallbackC   ,
    EntryCompletionCursorOnMatchSignalInfo  ,
    afterEntryCompletionCursorOnMatch       ,
    entryCompletionCursorOnMatchCallbackWrapper,
    entryCompletionCursorOnMatchClosure     ,
    mkEntryCompletionCursorOnMatchCallback  ,
    noEntryCompletionCursorOnMatchCallback  ,
    onEntryCompletionCursorOnMatch          ,


-- ** InsertPrefix
    EntryCompletionInsertPrefixCallback     ,
    EntryCompletionInsertPrefixCallbackC    ,
    EntryCompletionInsertPrefixSignalInfo   ,
    afterEntryCompletionInsertPrefix        ,
    entryCompletionInsertPrefixCallbackWrapper,
    entryCompletionInsertPrefixClosure      ,
    mkEntryCompletionInsertPrefixCallback   ,
    noEntryCompletionInsertPrefixCallback   ,
    onEntryCompletionInsertPrefix           ,


-- ** MatchSelected
    EntryCompletionMatchSelectedCallback    ,
    EntryCompletionMatchSelectedCallbackC   ,
    EntryCompletionMatchSelectedSignalInfo  ,
    afterEntryCompletionMatchSelected       ,
    entryCompletionMatchSelectedCallbackWrapper,
    entryCompletionMatchSelectedClosure     ,
    mkEntryCompletionMatchSelectedCallback  ,
    noEntryCompletionMatchSelectedCallback  ,
    onEntryCompletionMatchSelected          ,


-- ** NoMatches
    EntryCompletionNoMatchesCallback        ,
    EntryCompletionNoMatchesCallbackC       ,
    EntryCompletionNoMatchesSignalInfo      ,
    afterEntryCompletionNoMatches           ,
    entryCompletionNoMatchesCallbackWrapper ,
    entryCompletionNoMatchesClosure         ,
    mkEntryCompletionNoMatchesCallback      ,
    noEntryCompletionNoMatchesCallback      ,
    onEntryCompletionNoMatches              ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gtk.Types
import GI.Gtk.Callbacks
import qualified GI.GLib as GLib
import qualified GI.GObject as GObject

newtype EntryCompletion = EntryCompletion (ForeignPtr EntryCompletion)
foreign import ccall "gtk_entry_completion_get_type"
    c_gtk_entry_completion_get_type :: IO GType

type instance ParentTypes EntryCompletion = EntryCompletionParentTypes
type EntryCompletionParentTypes = '[GObject.Object, Buildable, CellLayout]

instance GObject EntryCompletion where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_gtk_entry_completion_get_type
    

class GObject o => EntryCompletionK o
instance (GObject o, IsDescendantOf EntryCompletion o) => EntryCompletionK o

toEntryCompletion :: EntryCompletionK o => o -> IO EntryCompletion
toEntryCompletion = unsafeCastTo EntryCompletion

noEntryCompletion :: Maybe EntryCompletion
noEntryCompletion = Nothing

-- signal EntryCompletion::action-activated
type EntryCompletionActionActivatedCallback =
    Int32 ->
    IO ()

noEntryCompletionActionActivatedCallback :: Maybe EntryCompletionActionActivatedCallback
noEntryCompletionActionActivatedCallback = Nothing

type EntryCompletionActionActivatedCallbackC =
    Ptr () ->                               -- object
    Int32 ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkEntryCompletionActionActivatedCallback :: EntryCompletionActionActivatedCallbackC -> IO (FunPtr EntryCompletionActionActivatedCallbackC)

entryCompletionActionActivatedClosure :: EntryCompletionActionActivatedCallback -> IO Closure
entryCompletionActionActivatedClosure cb = newCClosure =<< mkEntryCompletionActionActivatedCallback wrapped
    where wrapped = entryCompletionActionActivatedCallbackWrapper cb

entryCompletionActionActivatedCallbackWrapper ::
    EntryCompletionActionActivatedCallback ->
    Ptr () ->
    Int32 ->
    Ptr () ->
    IO ()
entryCompletionActionActivatedCallbackWrapper _cb _ index _ = do
    _cb  index

onEntryCompletionActionActivated :: (GObject a, MonadIO m) => a -> EntryCompletionActionActivatedCallback -> m SignalHandlerId
onEntryCompletionActionActivated obj cb = liftIO $ connectEntryCompletionActionActivated obj cb SignalConnectBefore
afterEntryCompletionActionActivated :: (GObject a, MonadIO m) => a -> EntryCompletionActionActivatedCallback -> m SignalHandlerId
afterEntryCompletionActionActivated obj cb = connectEntryCompletionActionActivated obj cb SignalConnectAfter

connectEntryCompletionActionActivated :: (GObject a, MonadIO m) =>
                                         a -> EntryCompletionActionActivatedCallback -> SignalConnectMode -> m SignalHandlerId
connectEntryCompletionActionActivated obj cb after = liftIO $ do
    cb' <- mkEntryCompletionActionActivatedCallback (entryCompletionActionActivatedCallbackWrapper cb)
    connectSignalFunPtr obj "action-activated" cb' after

-- signal EntryCompletion::cursor-on-match
type EntryCompletionCursorOnMatchCallback =
    TreeModel ->
    TreeIter ->
    IO Bool

noEntryCompletionCursorOnMatchCallback :: Maybe EntryCompletionCursorOnMatchCallback
noEntryCompletionCursorOnMatchCallback = Nothing

type EntryCompletionCursorOnMatchCallbackC =
    Ptr () ->                               -- object
    Ptr TreeModel ->
    Ptr TreeIter ->
    Ptr () ->                               -- user_data
    IO CInt

foreign import ccall "wrapper"
    mkEntryCompletionCursorOnMatchCallback :: EntryCompletionCursorOnMatchCallbackC -> IO (FunPtr EntryCompletionCursorOnMatchCallbackC)

entryCompletionCursorOnMatchClosure :: EntryCompletionCursorOnMatchCallback -> IO Closure
entryCompletionCursorOnMatchClosure cb = newCClosure =<< mkEntryCompletionCursorOnMatchCallback wrapped
    where wrapped = entryCompletionCursorOnMatchCallbackWrapper cb

entryCompletionCursorOnMatchCallbackWrapper ::
    EntryCompletionCursorOnMatchCallback ->
    Ptr () ->
    Ptr TreeModel ->
    Ptr TreeIter ->
    Ptr () ->
    IO CInt
entryCompletionCursorOnMatchCallbackWrapper _cb _ model iter _ = do
    model' <- (newObject TreeModel) model
    iter' <- (newBoxed TreeIter) iter
    result <- _cb  model' iter'
    let result' = (fromIntegral . fromEnum) result
    return result'

onEntryCompletionCursorOnMatch :: (GObject a, MonadIO m) => a -> EntryCompletionCursorOnMatchCallback -> m SignalHandlerId
onEntryCompletionCursorOnMatch obj cb = liftIO $ connectEntryCompletionCursorOnMatch obj cb SignalConnectBefore
afterEntryCompletionCursorOnMatch :: (GObject a, MonadIO m) => a -> EntryCompletionCursorOnMatchCallback -> m SignalHandlerId
afterEntryCompletionCursorOnMatch obj cb = connectEntryCompletionCursorOnMatch obj cb SignalConnectAfter

connectEntryCompletionCursorOnMatch :: (GObject a, MonadIO m) =>
                                       a -> EntryCompletionCursorOnMatchCallback -> SignalConnectMode -> m SignalHandlerId
connectEntryCompletionCursorOnMatch obj cb after = liftIO $ do
    cb' <- mkEntryCompletionCursorOnMatchCallback (entryCompletionCursorOnMatchCallbackWrapper cb)
    connectSignalFunPtr obj "cursor-on-match" cb' after

-- signal EntryCompletion::insert-prefix
type EntryCompletionInsertPrefixCallback =
    T.Text ->
    IO Bool

noEntryCompletionInsertPrefixCallback :: Maybe EntryCompletionInsertPrefixCallback
noEntryCompletionInsertPrefixCallback = Nothing

type EntryCompletionInsertPrefixCallbackC =
    Ptr () ->                               -- object
    CString ->
    Ptr () ->                               -- user_data
    IO CInt

foreign import ccall "wrapper"
    mkEntryCompletionInsertPrefixCallback :: EntryCompletionInsertPrefixCallbackC -> IO (FunPtr EntryCompletionInsertPrefixCallbackC)

entryCompletionInsertPrefixClosure :: EntryCompletionInsertPrefixCallback -> IO Closure
entryCompletionInsertPrefixClosure cb = newCClosure =<< mkEntryCompletionInsertPrefixCallback wrapped
    where wrapped = entryCompletionInsertPrefixCallbackWrapper cb

entryCompletionInsertPrefixCallbackWrapper ::
    EntryCompletionInsertPrefixCallback ->
    Ptr () ->
    CString ->
    Ptr () ->
    IO CInt
entryCompletionInsertPrefixCallbackWrapper _cb _ prefix _ = do
    prefix' <- cstringToText prefix
    result <- _cb  prefix'
    let result' = (fromIntegral . fromEnum) result
    return result'

onEntryCompletionInsertPrefix :: (GObject a, MonadIO m) => a -> EntryCompletionInsertPrefixCallback -> m SignalHandlerId
onEntryCompletionInsertPrefix obj cb = liftIO $ connectEntryCompletionInsertPrefix obj cb SignalConnectBefore
afterEntryCompletionInsertPrefix :: (GObject a, MonadIO m) => a -> EntryCompletionInsertPrefixCallback -> m SignalHandlerId
afterEntryCompletionInsertPrefix obj cb = connectEntryCompletionInsertPrefix obj cb SignalConnectAfter

connectEntryCompletionInsertPrefix :: (GObject a, MonadIO m) =>
                                      a -> EntryCompletionInsertPrefixCallback -> SignalConnectMode -> m SignalHandlerId
connectEntryCompletionInsertPrefix obj cb after = liftIO $ do
    cb' <- mkEntryCompletionInsertPrefixCallback (entryCompletionInsertPrefixCallbackWrapper cb)
    connectSignalFunPtr obj "insert-prefix" cb' after

-- signal EntryCompletion::match-selected
type EntryCompletionMatchSelectedCallback =
    TreeModel ->
    TreeIter ->
    IO Bool

noEntryCompletionMatchSelectedCallback :: Maybe EntryCompletionMatchSelectedCallback
noEntryCompletionMatchSelectedCallback = Nothing

type EntryCompletionMatchSelectedCallbackC =
    Ptr () ->                               -- object
    Ptr TreeModel ->
    Ptr TreeIter ->
    Ptr () ->                               -- user_data
    IO CInt

foreign import ccall "wrapper"
    mkEntryCompletionMatchSelectedCallback :: EntryCompletionMatchSelectedCallbackC -> IO (FunPtr EntryCompletionMatchSelectedCallbackC)

entryCompletionMatchSelectedClosure :: EntryCompletionMatchSelectedCallback -> IO Closure
entryCompletionMatchSelectedClosure cb = newCClosure =<< mkEntryCompletionMatchSelectedCallback wrapped
    where wrapped = entryCompletionMatchSelectedCallbackWrapper cb

entryCompletionMatchSelectedCallbackWrapper ::
    EntryCompletionMatchSelectedCallback ->
    Ptr () ->
    Ptr TreeModel ->
    Ptr TreeIter ->
    Ptr () ->
    IO CInt
entryCompletionMatchSelectedCallbackWrapper _cb _ model iter _ = do
    model' <- (newObject TreeModel) model
    iter' <- (newBoxed TreeIter) iter
    result <- _cb  model' iter'
    let result' = (fromIntegral . fromEnum) result
    return result'

onEntryCompletionMatchSelected :: (GObject a, MonadIO m) => a -> EntryCompletionMatchSelectedCallback -> m SignalHandlerId
onEntryCompletionMatchSelected obj cb = liftIO $ connectEntryCompletionMatchSelected obj cb SignalConnectBefore
afterEntryCompletionMatchSelected :: (GObject a, MonadIO m) => a -> EntryCompletionMatchSelectedCallback -> m SignalHandlerId
afterEntryCompletionMatchSelected obj cb = connectEntryCompletionMatchSelected obj cb SignalConnectAfter

connectEntryCompletionMatchSelected :: (GObject a, MonadIO m) =>
                                       a -> EntryCompletionMatchSelectedCallback -> SignalConnectMode -> m SignalHandlerId
connectEntryCompletionMatchSelected obj cb after = liftIO $ do
    cb' <- mkEntryCompletionMatchSelectedCallback (entryCompletionMatchSelectedCallbackWrapper cb)
    connectSignalFunPtr obj "match-selected" cb' after

-- signal EntryCompletion::no-matches
type EntryCompletionNoMatchesCallback =
    IO ()

noEntryCompletionNoMatchesCallback :: Maybe EntryCompletionNoMatchesCallback
noEntryCompletionNoMatchesCallback = Nothing

type EntryCompletionNoMatchesCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkEntryCompletionNoMatchesCallback :: EntryCompletionNoMatchesCallbackC -> IO (FunPtr EntryCompletionNoMatchesCallbackC)

entryCompletionNoMatchesClosure :: EntryCompletionNoMatchesCallback -> IO Closure
entryCompletionNoMatchesClosure cb = newCClosure =<< mkEntryCompletionNoMatchesCallback wrapped
    where wrapped = entryCompletionNoMatchesCallbackWrapper cb

entryCompletionNoMatchesCallbackWrapper ::
    EntryCompletionNoMatchesCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
entryCompletionNoMatchesCallbackWrapper _cb _ _ = do
    _cb 

onEntryCompletionNoMatches :: (GObject a, MonadIO m) => a -> EntryCompletionNoMatchesCallback -> m SignalHandlerId
onEntryCompletionNoMatches obj cb = liftIO $ connectEntryCompletionNoMatches obj cb SignalConnectBefore
afterEntryCompletionNoMatches :: (GObject a, MonadIO m) => a -> EntryCompletionNoMatchesCallback -> m SignalHandlerId
afterEntryCompletionNoMatches obj cb = connectEntryCompletionNoMatches obj cb SignalConnectAfter

connectEntryCompletionNoMatches :: (GObject a, MonadIO m) =>
                                   a -> EntryCompletionNoMatchesCallback -> SignalConnectMode -> m SignalHandlerId
connectEntryCompletionNoMatches obj cb after = liftIO $ do
    cb' <- mkEntryCompletionNoMatchesCallback (entryCompletionNoMatchesCallbackWrapper cb)
    connectSignalFunPtr obj "no-matches" cb' after

-- VVV Prop "cell-area"
   -- Type: TInterface "Gtk" "CellArea"
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]

getEntryCompletionCellArea :: (MonadIO m, EntryCompletionK o) => o -> m CellArea
getEntryCompletionCellArea obj = liftIO $ getObjectPropertyObject obj "cell-area" CellArea

constructEntryCompletionCellArea :: (CellAreaK a) => a -> IO ([Char], GValue)
constructEntryCompletionCellArea val = constructObjectPropertyObject "cell-area" val

data EntryCompletionCellAreaPropertyInfo
instance AttrInfo EntryCompletionCellAreaPropertyInfo where
    type AttrAllowedOps EntryCompletionCellAreaPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint EntryCompletionCellAreaPropertyInfo = CellAreaK
    type AttrBaseTypeConstraint EntryCompletionCellAreaPropertyInfo = EntryCompletionK
    type AttrGetType EntryCompletionCellAreaPropertyInfo = CellArea
    type AttrLabel EntryCompletionCellAreaPropertyInfo = "EntryCompletion::cell-area"
    attrGet _ = getEntryCompletionCellArea
    attrSet _ = undefined
    attrConstruct _ = constructEntryCompletionCellArea

-- VVV Prop "inline-completion"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getEntryCompletionInlineCompletion :: (MonadIO m, EntryCompletionK o) => o -> m Bool
getEntryCompletionInlineCompletion obj = liftIO $ getObjectPropertyBool obj "inline-completion"

setEntryCompletionInlineCompletion :: (MonadIO m, EntryCompletionK o) => o -> Bool -> m ()
setEntryCompletionInlineCompletion obj val = liftIO $ setObjectPropertyBool obj "inline-completion" val

constructEntryCompletionInlineCompletion :: Bool -> IO ([Char], GValue)
constructEntryCompletionInlineCompletion val = constructObjectPropertyBool "inline-completion" val

data EntryCompletionInlineCompletionPropertyInfo
instance AttrInfo EntryCompletionInlineCompletionPropertyInfo where
    type AttrAllowedOps EntryCompletionInlineCompletionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint EntryCompletionInlineCompletionPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint EntryCompletionInlineCompletionPropertyInfo = EntryCompletionK
    type AttrGetType EntryCompletionInlineCompletionPropertyInfo = Bool
    type AttrLabel EntryCompletionInlineCompletionPropertyInfo = "EntryCompletion::inline-completion"
    attrGet _ = getEntryCompletionInlineCompletion
    attrSet _ = setEntryCompletionInlineCompletion
    attrConstruct _ = constructEntryCompletionInlineCompletion

-- VVV Prop "inline-selection"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getEntryCompletionInlineSelection :: (MonadIO m, EntryCompletionK o) => o -> m Bool
getEntryCompletionInlineSelection obj = liftIO $ getObjectPropertyBool obj "inline-selection"

setEntryCompletionInlineSelection :: (MonadIO m, EntryCompletionK o) => o -> Bool -> m ()
setEntryCompletionInlineSelection obj val = liftIO $ setObjectPropertyBool obj "inline-selection" val

constructEntryCompletionInlineSelection :: Bool -> IO ([Char], GValue)
constructEntryCompletionInlineSelection val = constructObjectPropertyBool "inline-selection" val

data EntryCompletionInlineSelectionPropertyInfo
instance AttrInfo EntryCompletionInlineSelectionPropertyInfo where
    type AttrAllowedOps EntryCompletionInlineSelectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint EntryCompletionInlineSelectionPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint EntryCompletionInlineSelectionPropertyInfo = EntryCompletionK
    type AttrGetType EntryCompletionInlineSelectionPropertyInfo = Bool
    type AttrLabel EntryCompletionInlineSelectionPropertyInfo = "EntryCompletion::inline-selection"
    attrGet _ = getEntryCompletionInlineSelection
    attrSet _ = setEntryCompletionInlineSelection
    attrConstruct _ = constructEntryCompletionInlineSelection

-- VVV Prop "minimum-key-length"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getEntryCompletionMinimumKeyLength :: (MonadIO m, EntryCompletionK o) => o -> m Int32
getEntryCompletionMinimumKeyLength obj = liftIO $ getObjectPropertyCInt obj "minimum-key-length"

setEntryCompletionMinimumKeyLength :: (MonadIO m, EntryCompletionK o) => o -> Int32 -> m ()
setEntryCompletionMinimumKeyLength obj val = liftIO $ setObjectPropertyCInt obj "minimum-key-length" val

constructEntryCompletionMinimumKeyLength :: Int32 -> IO ([Char], GValue)
constructEntryCompletionMinimumKeyLength val = constructObjectPropertyCInt "minimum-key-length" val

data EntryCompletionMinimumKeyLengthPropertyInfo
instance AttrInfo EntryCompletionMinimumKeyLengthPropertyInfo where
    type AttrAllowedOps EntryCompletionMinimumKeyLengthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint EntryCompletionMinimumKeyLengthPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint EntryCompletionMinimumKeyLengthPropertyInfo = EntryCompletionK
    type AttrGetType EntryCompletionMinimumKeyLengthPropertyInfo = Int32
    type AttrLabel EntryCompletionMinimumKeyLengthPropertyInfo = "EntryCompletion::minimum-key-length"
    attrGet _ = getEntryCompletionMinimumKeyLength
    attrSet _ = setEntryCompletionMinimumKeyLength
    attrConstruct _ = constructEntryCompletionMinimumKeyLength

-- VVV Prop "model"
   -- Type: TInterface "Gtk" "TreeModel"
   -- Flags: [PropertyReadable,PropertyWritable]

getEntryCompletionModel :: (MonadIO m, EntryCompletionK o) => o -> m TreeModel
getEntryCompletionModel obj = liftIO $ getObjectPropertyObject obj "model" TreeModel

setEntryCompletionModel :: (MonadIO m, EntryCompletionK o, TreeModelK a) => o -> a -> m ()
setEntryCompletionModel obj val = liftIO $ setObjectPropertyObject obj "model" val

constructEntryCompletionModel :: (TreeModelK a) => a -> IO ([Char], GValue)
constructEntryCompletionModel val = constructObjectPropertyObject "model" val

data EntryCompletionModelPropertyInfo
instance AttrInfo EntryCompletionModelPropertyInfo where
    type AttrAllowedOps EntryCompletionModelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint EntryCompletionModelPropertyInfo = TreeModelK
    type AttrBaseTypeConstraint EntryCompletionModelPropertyInfo = EntryCompletionK
    type AttrGetType EntryCompletionModelPropertyInfo = TreeModel
    type AttrLabel EntryCompletionModelPropertyInfo = "EntryCompletion::model"
    attrGet _ = getEntryCompletionModel
    attrSet _ = setEntryCompletionModel
    attrConstruct _ = constructEntryCompletionModel

-- VVV Prop "popup-completion"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getEntryCompletionPopupCompletion :: (MonadIO m, EntryCompletionK o) => o -> m Bool
getEntryCompletionPopupCompletion obj = liftIO $ getObjectPropertyBool obj "popup-completion"

setEntryCompletionPopupCompletion :: (MonadIO m, EntryCompletionK o) => o -> Bool -> m ()
setEntryCompletionPopupCompletion obj val = liftIO $ setObjectPropertyBool obj "popup-completion" val

constructEntryCompletionPopupCompletion :: Bool -> IO ([Char], GValue)
constructEntryCompletionPopupCompletion val = constructObjectPropertyBool "popup-completion" val

data EntryCompletionPopupCompletionPropertyInfo
instance AttrInfo EntryCompletionPopupCompletionPropertyInfo where
    type AttrAllowedOps EntryCompletionPopupCompletionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint EntryCompletionPopupCompletionPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint EntryCompletionPopupCompletionPropertyInfo = EntryCompletionK
    type AttrGetType EntryCompletionPopupCompletionPropertyInfo = Bool
    type AttrLabel EntryCompletionPopupCompletionPropertyInfo = "EntryCompletion::popup-completion"
    attrGet _ = getEntryCompletionPopupCompletion
    attrSet _ = setEntryCompletionPopupCompletion
    attrConstruct _ = constructEntryCompletionPopupCompletion

-- VVV Prop "popup-set-width"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getEntryCompletionPopupSetWidth :: (MonadIO m, EntryCompletionK o) => o -> m Bool
getEntryCompletionPopupSetWidth obj = liftIO $ getObjectPropertyBool obj "popup-set-width"

setEntryCompletionPopupSetWidth :: (MonadIO m, EntryCompletionK o) => o -> Bool -> m ()
setEntryCompletionPopupSetWidth obj val = liftIO $ setObjectPropertyBool obj "popup-set-width" val

constructEntryCompletionPopupSetWidth :: Bool -> IO ([Char], GValue)
constructEntryCompletionPopupSetWidth val = constructObjectPropertyBool "popup-set-width" val

data EntryCompletionPopupSetWidthPropertyInfo
instance AttrInfo EntryCompletionPopupSetWidthPropertyInfo where
    type AttrAllowedOps EntryCompletionPopupSetWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint EntryCompletionPopupSetWidthPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint EntryCompletionPopupSetWidthPropertyInfo = EntryCompletionK
    type AttrGetType EntryCompletionPopupSetWidthPropertyInfo = Bool
    type AttrLabel EntryCompletionPopupSetWidthPropertyInfo = "EntryCompletion::popup-set-width"
    attrGet _ = getEntryCompletionPopupSetWidth
    attrSet _ = setEntryCompletionPopupSetWidth
    attrConstruct _ = constructEntryCompletionPopupSetWidth

-- VVV Prop "popup-single-match"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getEntryCompletionPopupSingleMatch :: (MonadIO m, EntryCompletionK o) => o -> m Bool
getEntryCompletionPopupSingleMatch obj = liftIO $ getObjectPropertyBool obj "popup-single-match"

setEntryCompletionPopupSingleMatch :: (MonadIO m, EntryCompletionK o) => o -> Bool -> m ()
setEntryCompletionPopupSingleMatch obj val = liftIO $ setObjectPropertyBool obj "popup-single-match" val

constructEntryCompletionPopupSingleMatch :: Bool -> IO ([Char], GValue)
constructEntryCompletionPopupSingleMatch val = constructObjectPropertyBool "popup-single-match" val

data EntryCompletionPopupSingleMatchPropertyInfo
instance AttrInfo EntryCompletionPopupSingleMatchPropertyInfo where
    type AttrAllowedOps EntryCompletionPopupSingleMatchPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint EntryCompletionPopupSingleMatchPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint EntryCompletionPopupSingleMatchPropertyInfo = EntryCompletionK
    type AttrGetType EntryCompletionPopupSingleMatchPropertyInfo = Bool
    type AttrLabel EntryCompletionPopupSingleMatchPropertyInfo = "EntryCompletion::popup-single-match"
    attrGet _ = getEntryCompletionPopupSingleMatch
    attrSet _ = setEntryCompletionPopupSingleMatch
    attrConstruct _ = constructEntryCompletionPopupSingleMatch

-- VVV Prop "text-column"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getEntryCompletionTextColumn :: (MonadIO m, EntryCompletionK o) => o -> m Int32
getEntryCompletionTextColumn obj = liftIO $ getObjectPropertyCInt obj "text-column"

setEntryCompletionTextColumn :: (MonadIO m, EntryCompletionK o) => o -> Int32 -> m ()
setEntryCompletionTextColumn obj val = liftIO $ setObjectPropertyCInt obj "text-column" val

constructEntryCompletionTextColumn :: Int32 -> IO ([Char], GValue)
constructEntryCompletionTextColumn val = constructObjectPropertyCInt "text-column" val

data EntryCompletionTextColumnPropertyInfo
instance AttrInfo EntryCompletionTextColumnPropertyInfo where
    type AttrAllowedOps EntryCompletionTextColumnPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint EntryCompletionTextColumnPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint EntryCompletionTextColumnPropertyInfo = EntryCompletionK
    type AttrGetType EntryCompletionTextColumnPropertyInfo = Int32
    type AttrLabel EntryCompletionTextColumnPropertyInfo = "EntryCompletion::text-column"
    attrGet _ = getEntryCompletionTextColumn
    attrSet _ = setEntryCompletionTextColumn
    attrConstruct _ = constructEntryCompletionTextColumn

type instance AttributeList EntryCompletion = EntryCompletionAttributeList
type EntryCompletionAttributeList = ('[ '("cell-area", EntryCompletionCellAreaPropertyInfo), '("inline-completion", EntryCompletionInlineCompletionPropertyInfo), '("inline-selection", EntryCompletionInlineSelectionPropertyInfo), '("minimum-key-length", EntryCompletionMinimumKeyLengthPropertyInfo), '("model", EntryCompletionModelPropertyInfo), '("popup-completion", EntryCompletionPopupCompletionPropertyInfo), '("popup-set-width", EntryCompletionPopupSetWidthPropertyInfo), '("popup-single-match", EntryCompletionPopupSingleMatchPropertyInfo), '("text-column", EntryCompletionTextColumnPropertyInfo)] :: [(Symbol, *)])

data EntryCompletionActionActivatedSignalInfo
instance SignalInfo EntryCompletionActionActivatedSignalInfo where
    type HaskellCallbackType EntryCompletionActionActivatedSignalInfo = EntryCompletionActionActivatedCallback
    connectSignal _ = connectEntryCompletionActionActivated

data EntryCompletionCursorOnMatchSignalInfo
instance SignalInfo EntryCompletionCursorOnMatchSignalInfo where
    type HaskellCallbackType EntryCompletionCursorOnMatchSignalInfo = EntryCompletionCursorOnMatchCallback
    connectSignal _ = connectEntryCompletionCursorOnMatch

data EntryCompletionInsertPrefixSignalInfo
instance SignalInfo EntryCompletionInsertPrefixSignalInfo where
    type HaskellCallbackType EntryCompletionInsertPrefixSignalInfo = EntryCompletionInsertPrefixCallback
    connectSignal _ = connectEntryCompletionInsertPrefix

data EntryCompletionMatchSelectedSignalInfo
instance SignalInfo EntryCompletionMatchSelectedSignalInfo where
    type HaskellCallbackType EntryCompletionMatchSelectedSignalInfo = EntryCompletionMatchSelectedCallback
    connectSignal _ = connectEntryCompletionMatchSelected

data EntryCompletionNoMatchesSignalInfo
instance SignalInfo EntryCompletionNoMatchesSignalInfo where
    type HaskellCallbackType EntryCompletionNoMatchesSignalInfo = EntryCompletionNoMatchesCallback
    connectSignal _ = connectEntryCompletionNoMatches

type instance SignalList EntryCompletion = EntryCompletionSignalList
type EntryCompletionSignalList = ('[ '("action-activated", EntryCompletionActionActivatedSignalInfo), '("cursor-on-match", EntryCompletionCursorOnMatchSignalInfo), '("insert-prefix", EntryCompletionInsertPrefixSignalInfo), '("match-selected", EntryCompletionMatchSelectedSignalInfo), '("no-matches", EntryCompletionNoMatchesSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method EntryCompletion::new
-- method type : Constructor
-- Args : []
-- Lengths : []
-- hInArgs : []
-- returnType : TInterface "Gtk" "EntryCompletion"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_new" gtk_entry_completion_new :: 
    IO (Ptr EntryCompletion)


entryCompletionNew ::
    (MonadIO m) =>
    m EntryCompletion
entryCompletionNew  = liftIO $ do
    result <- gtk_entry_completion_new
    checkUnexpectedReturnNULL "gtk_entry_completion_new" result
    result' <- (wrapObject EntryCompletion) result
    return result'

-- method EntryCompletion::new_with_area
-- method type : Constructor
-- Args : [Arg {argName = "area", argType = TInterface "Gtk" "CellArea", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "area", argType = TInterface "Gtk" "CellArea", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "EntryCompletion"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_new_with_area" gtk_entry_completion_new_with_area :: 
    Ptr CellArea ->                         -- area : TInterface "Gtk" "CellArea"
    IO (Ptr EntryCompletion)


entryCompletionNewWithArea ::
    (MonadIO m, CellAreaK a) =>
    a ->                                    -- area
    m EntryCompletion
entryCompletionNewWithArea area = liftIO $ do
    let area' = unsafeManagedPtrCastPtr area
    result <- gtk_entry_completion_new_with_area area'
    checkUnexpectedReturnNULL "gtk_entry_completion_new_with_area" result
    result' <- (wrapObject EntryCompletion) result
    touchManagedPtr area
    return result'

-- method EntryCompletion::complete
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_complete" gtk_entry_completion_complete :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    IO ()


entryCompletionComplete ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    m ()
entryCompletionComplete _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_entry_completion_complete _obj'
    touchManagedPtr _obj
    return ()

-- method EntryCompletion::compute_prefix
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "key", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_compute_prefix" gtk_entry_completion_compute_prefix :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    CString ->                              -- key : TBasicType TUTF8
    IO CString


entryCompletionComputePrefix ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- key
    m T.Text
entryCompletionComputePrefix _obj key = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    key' <- textToCString key
    result <- gtk_entry_completion_compute_prefix _obj' key'
    checkUnexpectedReturnNULL "gtk_entry_completion_compute_prefix" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    freeMem key'
    return result'

-- method EntryCompletion::delete_action
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_delete_action" gtk_entry_completion_delete_action :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    Int32 ->                                -- index_ : TBasicType TInt32
    IO ()


entryCompletionDeleteAction ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- index_
    m ()
entryCompletionDeleteAction _obj index_ = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_entry_completion_delete_action _obj' index_
    touchManagedPtr _obj
    return ()

-- method EntryCompletion::get_completion_prefix
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_get_completion_prefix" gtk_entry_completion_get_completion_prefix :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    IO CString


entryCompletionGetCompletionPrefix ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    m T.Text
entryCompletionGetCompletionPrefix _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_entry_completion_get_completion_prefix _obj'
    checkUnexpectedReturnNULL "gtk_entry_completion_get_completion_prefix" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'

-- method EntryCompletion::get_entry
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Widget"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_get_entry" gtk_entry_completion_get_entry :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    IO (Ptr Widget)


entryCompletionGetEntry ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    m Widget
entryCompletionGetEntry _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_entry_completion_get_entry _obj'
    checkUnexpectedReturnNULL "gtk_entry_completion_get_entry" result
    result' <- (newObject Widget) result
    touchManagedPtr _obj
    return result'

-- method EntryCompletion::get_inline_completion
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_get_inline_completion" gtk_entry_completion_get_inline_completion :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    IO CInt


entryCompletionGetInlineCompletion ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    m Bool
entryCompletionGetInlineCompletion _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_entry_completion_get_inline_completion _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method EntryCompletion::get_inline_selection
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_get_inline_selection" gtk_entry_completion_get_inline_selection :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    IO CInt


entryCompletionGetInlineSelection ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    m Bool
entryCompletionGetInlineSelection _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_entry_completion_get_inline_selection _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method EntryCompletion::get_minimum_key_length
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_get_minimum_key_length" gtk_entry_completion_get_minimum_key_length :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    IO Int32


entryCompletionGetMinimumKeyLength ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    m Int32
entryCompletionGetMinimumKeyLength _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_entry_completion_get_minimum_key_length _obj'
    touchManagedPtr _obj
    return result

-- method EntryCompletion::get_model
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "TreeModel"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_get_model" gtk_entry_completion_get_model :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    IO (Ptr TreeModel)


entryCompletionGetModel ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    m TreeModel
entryCompletionGetModel _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_entry_completion_get_model _obj'
    checkUnexpectedReturnNULL "gtk_entry_completion_get_model" result
    result' <- (newObject TreeModel) result
    touchManagedPtr _obj
    return result'

-- method EntryCompletion::get_popup_completion
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_get_popup_completion" gtk_entry_completion_get_popup_completion :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    IO CInt


entryCompletionGetPopupCompletion ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    m Bool
entryCompletionGetPopupCompletion _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_entry_completion_get_popup_completion _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method EntryCompletion::get_popup_set_width
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_get_popup_set_width" gtk_entry_completion_get_popup_set_width :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    IO CInt


entryCompletionGetPopupSetWidth ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    m Bool
entryCompletionGetPopupSetWidth _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_entry_completion_get_popup_set_width _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method EntryCompletion::get_popup_single_match
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_get_popup_single_match" gtk_entry_completion_get_popup_single_match :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    IO CInt


entryCompletionGetPopupSingleMatch ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    m Bool
entryCompletionGetPopupSingleMatch _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_entry_completion_get_popup_single_match _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method EntryCompletion::get_text_column
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_get_text_column" gtk_entry_completion_get_text_column :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    IO Int32


entryCompletionGetTextColumn ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    m Int32
entryCompletionGetTextColumn _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_entry_completion_get_text_column _obj'
    touchManagedPtr _obj
    return result

-- method EntryCompletion::insert_action_markup
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "markup", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "markup", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_insert_action_markup" gtk_entry_completion_insert_action_markup :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    Int32 ->                                -- index_ : TBasicType TInt32
    CString ->                              -- markup : TBasicType TUTF8
    IO ()


entryCompletionInsertActionMarkup ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- index_
    T.Text ->                               -- markup
    m ()
entryCompletionInsertActionMarkup _obj index_ markup = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    markup' <- textToCString markup
    gtk_entry_completion_insert_action_markup _obj' index_ markup'
    touchManagedPtr _obj
    freeMem markup'
    return ()

-- method EntryCompletion::insert_action_text
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "index_", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "text", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_insert_action_text" gtk_entry_completion_insert_action_text :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    Int32 ->                                -- index_ : TBasicType TInt32
    CString ->                              -- text : TBasicType TUTF8
    IO ()


entryCompletionInsertActionText ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- index_
    T.Text ->                               -- text
    m ()
entryCompletionInsertActionText _obj index_ text = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    text' <- textToCString text
    gtk_entry_completion_insert_action_text _obj' index_ text'
    touchManagedPtr _obj
    freeMem text'
    return ()

-- method EntryCompletion::insert_prefix
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_insert_prefix" gtk_entry_completion_insert_prefix :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    IO ()


entryCompletionInsertPrefix ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    m ()
entryCompletionInsertPrefix _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_entry_completion_insert_prefix _obj'
    touchManagedPtr _obj
    return ()

-- method EntryCompletion::set_inline_completion
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inline_completion", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inline_completion", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_set_inline_completion" gtk_entry_completion_set_inline_completion :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    CInt ->                                 -- inline_completion : TBasicType TBoolean
    IO ()


entryCompletionSetInlineCompletion ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- inline_completion
    m ()
entryCompletionSetInlineCompletion _obj inline_completion = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let inline_completion' = (fromIntegral . fromEnum) inline_completion
    gtk_entry_completion_set_inline_completion _obj' inline_completion'
    touchManagedPtr _obj
    return ()

-- method EntryCompletion::set_inline_selection
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inline_selection", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inline_selection", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_set_inline_selection" gtk_entry_completion_set_inline_selection :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    CInt ->                                 -- inline_selection : TBasicType TBoolean
    IO ()


entryCompletionSetInlineSelection ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- inline_selection
    m ()
entryCompletionSetInlineSelection _obj inline_selection = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let inline_selection' = (fromIntegral . fromEnum) inline_selection
    gtk_entry_completion_set_inline_selection _obj' inline_selection'
    touchManagedPtr _obj
    return ()

-- method EntryCompletion::set_match_func
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "Gtk" "EntryCompletionMatchFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing},Arg {argName = "func_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func_notify", argType = TInterface "GLib" "DestroyNotify", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "func", argType = TInterface "Gtk" "EntryCompletionMatchFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeNotified, argClosure = 2, argDestroy = 3, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_set_match_func" gtk_entry_completion_set_match_func :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    FunPtr EntryCompletionMatchFuncC ->     -- func : TInterface "Gtk" "EntryCompletionMatchFunc"
    Ptr () ->                               -- func_data : TBasicType TVoid
    FunPtr GLib.DestroyNotifyC ->           -- func_notify : TInterface "GLib" "DestroyNotify"
    IO ()


entryCompletionSetMatchFunc ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    EntryCompletionMatchFunc ->             -- func
    m ()
entryCompletionSetMatchFunc _obj func = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    func' <- mkEntryCompletionMatchFunc (entryCompletionMatchFuncWrapper Nothing func)
    let func_data = castFunPtrToPtr func'
    let func_notify = safeFreeFunPtrPtr
    gtk_entry_completion_set_match_func _obj' func' func_data func_notify
    touchManagedPtr _obj
    return ()

-- method EntryCompletion::set_minimum_key_length
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_set_minimum_key_length" gtk_entry_completion_set_minimum_key_length :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    Int32 ->                                -- length : TBasicType TInt32
    IO ()


entryCompletionSetMinimumKeyLength ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- length
    m ()
entryCompletionSetMinimumKeyLength _obj length_ = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_entry_completion_set_minimum_key_length _obj' length_
    touchManagedPtr _obj
    return ()

-- method EntryCompletion::set_model
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "model", argType = TInterface "Gtk" "TreeModel", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "model", argType = TInterface "Gtk" "TreeModel", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_set_model" gtk_entry_completion_set_model :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    Ptr TreeModel ->                        -- model : TInterface "Gtk" "TreeModel"
    IO ()


entryCompletionSetModel ::
    (MonadIO m, EntryCompletionK a, TreeModelK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- model
    m ()
entryCompletionSetModel _obj model = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeModel <- case model of
        Nothing -> return nullPtr
        Just jModel -> do
            let jModel' = unsafeManagedPtrCastPtr jModel
            return jModel'
    gtk_entry_completion_set_model _obj' maybeModel
    touchManagedPtr _obj
    whenJust model touchManagedPtr
    return ()

-- method EntryCompletion::set_popup_completion
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "popup_completion", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "popup_completion", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_set_popup_completion" gtk_entry_completion_set_popup_completion :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    CInt ->                                 -- popup_completion : TBasicType TBoolean
    IO ()


entryCompletionSetPopupCompletion ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- popup_completion
    m ()
entryCompletionSetPopupCompletion _obj popup_completion = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let popup_completion' = (fromIntegral . fromEnum) popup_completion
    gtk_entry_completion_set_popup_completion _obj' popup_completion'
    touchManagedPtr _obj
    return ()

-- method EntryCompletion::set_popup_set_width
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "popup_set_width", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "popup_set_width", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_set_popup_set_width" gtk_entry_completion_set_popup_set_width :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    CInt ->                                 -- popup_set_width : TBasicType TBoolean
    IO ()


entryCompletionSetPopupSetWidth ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- popup_set_width
    m ()
entryCompletionSetPopupSetWidth _obj popup_set_width = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let popup_set_width' = (fromIntegral . fromEnum) popup_set_width
    gtk_entry_completion_set_popup_set_width _obj' popup_set_width'
    touchManagedPtr _obj
    return ()

-- method EntryCompletion::set_popup_single_match
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "popup_single_match", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "popup_single_match", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_set_popup_single_match" gtk_entry_completion_set_popup_single_match :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    CInt ->                                 -- popup_single_match : TBasicType TBoolean
    IO ()


entryCompletionSetPopupSingleMatch ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- popup_single_match
    m ()
entryCompletionSetPopupSingleMatch _obj popup_single_match = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let popup_single_match' = (fromIntegral . fromEnum) popup_single_match
    gtk_entry_completion_set_popup_single_match _obj' popup_single_match'
    touchManagedPtr _obj
    return ()

-- method EntryCompletion::set_text_column
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "column", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "EntryCompletion", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "column", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_entry_completion_set_text_column" gtk_entry_completion_set_text_column :: 
    Ptr EntryCompletion ->                  -- _obj : TInterface "Gtk" "EntryCompletion"
    Int32 ->                                -- column : TBasicType TInt32
    IO ()


entryCompletionSetTextColumn ::
    (MonadIO m, EntryCompletionK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- column
    m ()
entryCompletionSetTextColumn _obj column = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_entry_completion_set_text_column _obj' column
    touchManagedPtr _obj
    return ()