module GI.Gtk.Objects.EntryCompletion
(
EntryCompletion(..) ,
EntryCompletionK ,
toEntryCompletion ,
noEntryCompletion ,
entryCompletionComplete ,
entryCompletionComputePrefix ,
entryCompletionDeleteAction ,
entryCompletionGetCompletionPrefix ,
entryCompletionGetEntry ,
entryCompletionGetInlineCompletion ,
entryCompletionGetInlineSelection ,
entryCompletionGetMinimumKeyLength ,
entryCompletionGetModel ,
entryCompletionGetPopupCompletion ,
entryCompletionGetPopupSetWidth ,
entryCompletionGetPopupSingleMatch ,
entryCompletionGetTextColumn ,
entryCompletionInsertActionMarkup ,
entryCompletionInsertActionText ,
entryCompletionInsertPrefix ,
entryCompletionNew ,
entryCompletionNewWithArea ,
entryCompletionSetInlineCompletion ,
entryCompletionSetInlineSelection ,
entryCompletionSetMatchFunc ,
entryCompletionSetMinimumKeyLength ,
entryCompletionSetModel ,
entryCompletionSetPopupCompletion ,
entryCompletionSetPopupSetWidth ,
entryCompletionSetPopupSingleMatch ,
entryCompletionSetTextColumn ,
EntryCompletionCellAreaPropertyInfo ,
constructEntryCompletionCellArea ,
getEntryCompletionCellArea ,
EntryCompletionInlineCompletionPropertyInfo,
constructEntryCompletionInlineCompletion,
getEntryCompletionInlineCompletion ,
setEntryCompletionInlineCompletion ,
EntryCompletionInlineSelectionPropertyInfo,
constructEntryCompletionInlineSelection ,
getEntryCompletionInlineSelection ,
setEntryCompletionInlineSelection ,
EntryCompletionMinimumKeyLengthPropertyInfo,
constructEntryCompletionMinimumKeyLength,
getEntryCompletionMinimumKeyLength ,
setEntryCompletionMinimumKeyLength ,
EntryCompletionModelPropertyInfo ,
constructEntryCompletionModel ,
getEntryCompletionModel ,
setEntryCompletionModel ,
EntryCompletionPopupCompletionPropertyInfo,
constructEntryCompletionPopupCompletion ,
getEntryCompletionPopupCompletion ,
setEntryCompletionPopupCompletion ,
EntryCompletionPopupSetWidthPropertyInfo,
constructEntryCompletionPopupSetWidth ,
getEntryCompletionPopupSetWidth ,
setEntryCompletionPopupSetWidth ,
EntryCompletionPopupSingleMatchPropertyInfo,
constructEntryCompletionPopupSingleMatch,
getEntryCompletionPopupSingleMatch ,
setEntryCompletionPopupSingleMatch ,
EntryCompletionTextColumnPropertyInfo ,
constructEntryCompletionTextColumn ,
getEntryCompletionTextColumn ,
setEntryCompletionTextColumn ,
EntryCompletionActionActivatedCallback ,
EntryCompletionActionActivatedCallbackC ,
EntryCompletionActionActivatedSignalInfo,
afterEntryCompletionActionActivated ,
entryCompletionActionActivatedCallbackWrapper,
entryCompletionActionActivatedClosure ,
mkEntryCompletionActionActivatedCallback,
noEntryCompletionActionActivatedCallback,
onEntryCompletionActionActivated ,
EntryCompletionCursorOnMatchCallback ,
EntryCompletionCursorOnMatchCallbackC ,
EntryCompletionCursorOnMatchSignalInfo ,
afterEntryCompletionCursorOnMatch ,
entryCompletionCursorOnMatchCallbackWrapper,
entryCompletionCursorOnMatchClosure ,
mkEntryCompletionCursorOnMatchCallback ,
noEntryCompletionCursorOnMatchCallback ,
onEntryCompletionCursorOnMatch ,
EntryCompletionInsertPrefixCallback ,
EntryCompletionInsertPrefixCallbackC ,
EntryCompletionInsertPrefixSignalInfo ,
afterEntryCompletionInsertPrefix ,
entryCompletionInsertPrefixCallbackWrapper,
entryCompletionInsertPrefixClosure ,
mkEntryCompletionInsertPrefixCallback ,
noEntryCompletionInsertPrefixCallback ,
onEntryCompletionInsertPrefix ,
EntryCompletionMatchSelectedCallback ,
EntryCompletionMatchSelectedCallbackC ,
EntryCompletionMatchSelectedSignalInfo ,
afterEntryCompletionMatchSelected ,
entryCompletionMatchSelectedCallbackWrapper,
entryCompletionMatchSelectedClosure ,
mkEntryCompletionMatchSelectedCallback ,
noEntryCompletionMatchSelectedCallback ,
onEntryCompletionMatchSelected ,
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
type EntryCompletionActionActivatedCallback =
Int32 ->
IO ()
noEntryCompletionActionActivatedCallback :: Maybe EntryCompletionActionActivatedCallback
noEntryCompletionActionActivatedCallback = Nothing
type EntryCompletionActionActivatedCallbackC =
Ptr () ->
Int32 ->
Ptr () ->
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
type EntryCompletionCursorOnMatchCallback =
TreeModel ->
TreeIter ->
IO Bool
noEntryCompletionCursorOnMatchCallback :: Maybe EntryCompletionCursorOnMatchCallback
noEntryCompletionCursorOnMatchCallback = Nothing
type EntryCompletionCursorOnMatchCallbackC =
Ptr () ->
Ptr TreeModel ->
Ptr TreeIter ->
Ptr () ->
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
type EntryCompletionInsertPrefixCallback =
T.Text ->
IO Bool
noEntryCompletionInsertPrefixCallback :: Maybe EntryCompletionInsertPrefixCallback
noEntryCompletionInsertPrefixCallback = Nothing
type EntryCompletionInsertPrefixCallbackC =
Ptr () ->
CString ->
Ptr () ->
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
type EntryCompletionMatchSelectedCallback =
TreeModel ->
TreeIter ->
IO Bool
noEntryCompletionMatchSelectedCallback :: Maybe EntryCompletionMatchSelectedCallback
noEntryCompletionMatchSelectedCallback = Nothing
type EntryCompletionMatchSelectedCallbackC =
Ptr () ->
Ptr TreeModel ->
Ptr TreeIter ->
Ptr () ->
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
type EntryCompletionNoMatchesCallback =
IO ()
noEntryCompletionNoMatchesCallback :: Maybe EntryCompletionNoMatchesCallback
noEntryCompletionNoMatchesCallback = Nothing
type EntryCompletionNoMatchesCallbackC =
Ptr () ->
Ptr () ->
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
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
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
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
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
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
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
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
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
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, *)])
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'
foreign import ccall "gtk_entry_completion_new_with_area" gtk_entry_completion_new_with_area ::
Ptr CellArea ->
IO (Ptr EntryCompletion)
entryCompletionNewWithArea ::
(MonadIO m, CellAreaK a) =>
a ->
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'
foreign import ccall "gtk_entry_completion_complete" gtk_entry_completion_complete ::
Ptr EntryCompletion ->
IO ()
entryCompletionComplete ::
(MonadIO m, EntryCompletionK a) =>
a ->
m ()
entryCompletionComplete _obj = liftIO $ do
let _obj' = unsafeManagedPtrCastPtr _obj
gtk_entry_completion_complete _obj'
touchManagedPtr _obj
return ()
foreign import ccall "gtk_entry_completion_compute_prefix" gtk_entry_completion_compute_prefix ::
Ptr EntryCompletion ->
CString ->
IO CString
entryCompletionComputePrefix ::
(MonadIO m, EntryCompletionK a) =>
a ->
T.Text ->
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'
foreign import ccall "gtk_entry_completion_delete_action" gtk_entry_completion_delete_action ::
Ptr EntryCompletion ->
Int32 ->
IO ()
entryCompletionDeleteAction ::
(MonadIO m, EntryCompletionK a) =>
a ->
Int32 ->
m ()
entryCompletionDeleteAction _obj index_ = liftIO $ do
let _obj' = unsafeManagedPtrCastPtr _obj
gtk_entry_completion_delete_action _obj' index_
touchManagedPtr _obj
return ()
foreign import ccall "gtk_entry_completion_get_completion_prefix" gtk_entry_completion_get_completion_prefix ::
Ptr EntryCompletion ->
IO CString
entryCompletionGetCompletionPrefix ::
(MonadIO m, EntryCompletionK a) =>
a ->
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'
foreign import ccall "gtk_entry_completion_get_entry" gtk_entry_completion_get_entry ::
Ptr EntryCompletion ->
IO (Ptr Widget)
entryCompletionGetEntry ::
(MonadIO m, EntryCompletionK a) =>
a ->
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'
foreign import ccall "gtk_entry_completion_get_inline_completion" gtk_entry_completion_get_inline_completion ::
Ptr EntryCompletion ->
IO CInt
entryCompletionGetInlineCompletion ::
(MonadIO m, EntryCompletionK a) =>
a ->
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'
foreign import ccall "gtk_entry_completion_get_inline_selection" gtk_entry_completion_get_inline_selection ::
Ptr EntryCompletion ->
IO CInt
entryCompletionGetInlineSelection ::
(MonadIO m, EntryCompletionK a) =>
a ->
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'
foreign import ccall "gtk_entry_completion_get_minimum_key_length" gtk_entry_completion_get_minimum_key_length ::
Ptr EntryCompletion ->
IO Int32
entryCompletionGetMinimumKeyLength ::
(MonadIO m, EntryCompletionK a) =>
a ->
m Int32
entryCompletionGetMinimumKeyLength _obj = liftIO $ do
let _obj' = unsafeManagedPtrCastPtr _obj
result <- gtk_entry_completion_get_minimum_key_length _obj'
touchManagedPtr _obj
return result
foreign import ccall "gtk_entry_completion_get_model" gtk_entry_completion_get_model ::
Ptr EntryCompletion ->
IO (Ptr TreeModel)
entryCompletionGetModel ::
(MonadIO m, EntryCompletionK a) =>
a ->
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'
foreign import ccall "gtk_entry_completion_get_popup_completion" gtk_entry_completion_get_popup_completion ::
Ptr EntryCompletion ->
IO CInt
entryCompletionGetPopupCompletion ::
(MonadIO m, EntryCompletionK a) =>
a ->
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'
foreign import ccall "gtk_entry_completion_get_popup_set_width" gtk_entry_completion_get_popup_set_width ::
Ptr EntryCompletion ->
IO CInt
entryCompletionGetPopupSetWidth ::
(MonadIO m, EntryCompletionK a) =>
a ->
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'
foreign import ccall "gtk_entry_completion_get_popup_single_match" gtk_entry_completion_get_popup_single_match ::
Ptr EntryCompletion ->
IO CInt
entryCompletionGetPopupSingleMatch ::
(MonadIO m, EntryCompletionK a) =>
a ->
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'
foreign import ccall "gtk_entry_completion_get_text_column" gtk_entry_completion_get_text_column ::
Ptr EntryCompletion ->
IO Int32
entryCompletionGetTextColumn ::
(MonadIO m, EntryCompletionK a) =>
a ->
m Int32
entryCompletionGetTextColumn _obj = liftIO $ do
let _obj' = unsafeManagedPtrCastPtr _obj
result <- gtk_entry_completion_get_text_column _obj'
touchManagedPtr _obj
return result
foreign import ccall "gtk_entry_completion_insert_action_markup" gtk_entry_completion_insert_action_markup ::
Ptr EntryCompletion ->
Int32 ->
CString ->
IO ()
entryCompletionInsertActionMarkup ::
(MonadIO m, EntryCompletionK a) =>
a ->
Int32 ->
T.Text ->
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 ()
foreign import ccall "gtk_entry_completion_insert_action_text" gtk_entry_completion_insert_action_text ::
Ptr EntryCompletion ->
Int32 ->
CString ->
IO ()
entryCompletionInsertActionText ::
(MonadIO m, EntryCompletionK a) =>
a ->
Int32 ->
T.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 ()
foreign import ccall "gtk_entry_completion_insert_prefix" gtk_entry_completion_insert_prefix ::
Ptr EntryCompletion ->
IO ()
entryCompletionInsertPrefix ::
(MonadIO m, EntryCompletionK a) =>
a ->
m ()
entryCompletionInsertPrefix _obj = liftIO $ do
let _obj' = unsafeManagedPtrCastPtr _obj
gtk_entry_completion_insert_prefix _obj'
touchManagedPtr _obj
return ()
foreign import ccall "gtk_entry_completion_set_inline_completion" gtk_entry_completion_set_inline_completion ::
Ptr EntryCompletion ->
CInt ->
IO ()
entryCompletionSetInlineCompletion ::
(MonadIO m, EntryCompletionK a) =>
a ->
Bool ->
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 ()
foreign import ccall "gtk_entry_completion_set_inline_selection" gtk_entry_completion_set_inline_selection ::
Ptr EntryCompletion ->
CInt ->
IO ()
entryCompletionSetInlineSelection ::
(MonadIO m, EntryCompletionK a) =>
a ->
Bool ->
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 ()
foreign import ccall "gtk_entry_completion_set_match_func" gtk_entry_completion_set_match_func ::
Ptr EntryCompletion ->
FunPtr EntryCompletionMatchFuncC ->
Ptr () ->
FunPtr GLib.DestroyNotifyC ->
IO ()
entryCompletionSetMatchFunc ::
(MonadIO m, EntryCompletionK a) =>
a ->
EntryCompletionMatchFunc ->
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 ()
foreign import ccall "gtk_entry_completion_set_minimum_key_length" gtk_entry_completion_set_minimum_key_length ::
Ptr EntryCompletion ->
Int32 ->
IO ()
entryCompletionSetMinimumKeyLength ::
(MonadIO m, EntryCompletionK a) =>
a ->
Int32 ->
m ()
entryCompletionSetMinimumKeyLength _obj length_ = liftIO $ do
let _obj' = unsafeManagedPtrCastPtr _obj
gtk_entry_completion_set_minimum_key_length _obj' length_
touchManagedPtr _obj
return ()
foreign import ccall "gtk_entry_completion_set_model" gtk_entry_completion_set_model ::
Ptr EntryCompletion ->
Ptr TreeModel ->
IO ()
entryCompletionSetModel ::
(MonadIO m, EntryCompletionK a, TreeModelK b) =>
a ->
Maybe (b) ->
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 ()
foreign import ccall "gtk_entry_completion_set_popup_completion" gtk_entry_completion_set_popup_completion ::
Ptr EntryCompletion ->
CInt ->
IO ()
entryCompletionSetPopupCompletion ::
(MonadIO m, EntryCompletionK a) =>
a ->
Bool ->
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 ()
foreign import ccall "gtk_entry_completion_set_popup_set_width" gtk_entry_completion_set_popup_set_width ::
Ptr EntryCompletion ->
CInt ->
IO ()
entryCompletionSetPopupSetWidth ::
(MonadIO m, EntryCompletionK a) =>
a ->
Bool ->
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 ()
foreign import ccall "gtk_entry_completion_set_popup_single_match" gtk_entry_completion_set_popup_single_match ::
Ptr EntryCompletion ->
CInt ->
IO ()
entryCompletionSetPopupSingleMatch ::
(MonadIO m, EntryCompletionK a) =>
a ->
Bool ->
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 ()
foreign import ccall "gtk_entry_completion_set_text_column" gtk_entry_completion_set_text_column ::
Ptr EntryCompletion ->
Int32 ->
IO ()
entryCompletionSetTextColumn ::
(MonadIO m, EntryCompletionK a) =>
a ->
Int32 ->
m ()
entryCompletionSetTextColumn _obj column = liftIO $ do
let _obj' = unsafeManagedPtrCastPtr _obj
gtk_entry_completion_set_text_column _obj' column
touchManagedPtr _obj
return ()