{- |
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.Vte.Objects.Terminal
    ( 

-- * Exported types
    Terminal(..)                            ,
    TerminalK                               ,
    toTerminal                              ,
    noTerminal                              ,


 -- * Methods
-- ** terminalCopyClipboard
    terminalCopyClipboard                   ,


-- ** terminalCopyPrimary
    terminalCopyPrimary                     ,


-- ** terminalFeed
    terminalFeed                            ,


-- ** terminalFeedChild
    terminalFeedChild                       ,


-- ** terminalFeedChildBinary
    terminalFeedChildBinary                 ,


-- ** terminalGetAllowBold
    terminalGetAllowBold                    ,


-- ** terminalGetAudibleBell
    terminalGetAudibleBell                  ,


-- ** terminalGetCharHeight
    terminalGetCharHeight                   ,


-- ** terminalGetCharWidth
    terminalGetCharWidth                    ,


-- ** terminalGetCjkAmbiguousWidth
    terminalGetCjkAmbiguousWidth            ,


-- ** terminalGetColumnCount
    terminalGetColumnCount                  ,


-- ** terminalGetCurrentDirectoryUri
    terminalGetCurrentDirectoryUri          ,


-- ** terminalGetCurrentFileUri
    terminalGetCurrentFileUri               ,


-- ** terminalGetCursorBlinkMode
    terminalGetCursorBlinkMode              ,


-- ** terminalGetCursorPosition
    terminalGetCursorPosition               ,


-- ** terminalGetCursorShape
    terminalGetCursorShape                  ,


-- ** terminalGetEncoding
    terminalGetEncoding                     ,


-- ** terminalGetFont
    terminalGetFont                         ,


-- ** terminalGetFontScale
    terminalGetFontScale                    ,


-- ** terminalGetGeometryHints
    terminalGetGeometryHints                ,


-- ** terminalGetHasSelection
    terminalGetHasSelection                 ,


-- ** terminalGetIconTitle
    terminalGetIconTitle                    ,


-- ** terminalGetInputEnabled
    terminalGetInputEnabled                 ,


-- ** terminalGetMouseAutohide
    terminalGetMouseAutohide                ,


-- ** terminalGetPty
    terminalGetPty                          ,


-- ** terminalGetRewrapOnResize
    terminalGetRewrapOnResize               ,


-- ** terminalGetRowCount
    terminalGetRowCount                     ,


-- ** terminalGetText
    terminalGetText                         ,


-- ** terminalGetTextIncludeTrailingSpaces
    terminalGetTextIncludeTrailingSpaces    ,


-- ** terminalGetTextRange
    terminalGetTextRange                    ,


-- ** terminalGetWindowTitle
    terminalGetWindowTitle                  ,


-- ** terminalGetWordCharExceptions
    terminalGetWordCharExceptions           ,


-- ** terminalMatchAddGregex
    terminalMatchAddGregex                  ,


-- ** terminalMatchCheck
    terminalMatchCheck                      ,


-- ** terminalMatchCheckEvent
    terminalMatchCheckEvent                 ,


-- ** terminalMatchRemove
    terminalMatchRemove                     ,


-- ** terminalMatchRemoveAll
    terminalMatchRemoveAll                  ,


-- ** terminalMatchSetCursorName
    terminalMatchSetCursorName              ,


-- ** terminalMatchSetCursorType
    terminalMatchSetCursorType              ,


-- ** terminalNew
    terminalNew                             ,


-- ** terminalPasteClipboard
    terminalPasteClipboard                  ,


-- ** terminalPastePrimary
    terminalPastePrimary                    ,


-- ** terminalPtyNewSync
    terminalPtyNewSync                      ,


-- ** terminalReset
    terminalReset                           ,


-- ** terminalSearchFindNext
    terminalSearchFindNext                  ,


-- ** terminalSearchFindPrevious
    terminalSearchFindPrevious              ,


-- ** terminalSearchGetGregex
    terminalSearchGetGregex                 ,


-- ** terminalSearchGetWrapAround
    terminalSearchGetWrapAround             ,


-- ** terminalSearchSetGregex
    terminalSearchSetGregex                 ,


-- ** terminalSearchSetWrapAround
    terminalSearchSetWrapAround             ,


-- ** terminalSelectAll
    terminalSelectAll                       ,


-- ** terminalSetAllowBold
    terminalSetAllowBold                    ,


-- ** terminalSetAudibleBell
    terminalSetAudibleBell                  ,


-- ** terminalSetBackspaceBinding
    terminalSetBackspaceBinding             ,


-- ** terminalSetCjkAmbiguousWidth
    terminalSetCjkAmbiguousWidth            ,


-- ** terminalSetColorBackground
    terminalSetColorBackground              ,


-- ** terminalSetColorBold
    terminalSetColorBold                    ,


-- ** terminalSetColorCursor
    terminalSetColorCursor                  ,


-- ** terminalSetColorForeground
    terminalSetColorForeground              ,


-- ** terminalSetColorHighlight
    terminalSetColorHighlight               ,


-- ** terminalSetColorHighlightForeground
    terminalSetColorHighlightForeground     ,


-- ** terminalSetColors
    terminalSetColors                       ,


-- ** terminalSetCursorBlinkMode
    terminalSetCursorBlinkMode              ,


-- ** terminalSetCursorShape
    terminalSetCursorShape                  ,


-- ** terminalSetDefaultColors
    terminalSetDefaultColors                ,


-- ** terminalSetDeleteBinding
    terminalSetDeleteBinding                ,


-- ** terminalSetEncoding
    terminalSetEncoding                     ,


-- ** terminalSetFont
    terminalSetFont                         ,


-- ** terminalSetFontScale
    terminalSetFontScale                    ,


-- ** terminalSetGeometryHintsForWindow
    terminalSetGeometryHintsForWindow       ,


-- ** terminalSetInputEnabled
    terminalSetInputEnabled                 ,


-- ** terminalSetMouseAutohide
    terminalSetMouseAutohide                ,


-- ** terminalSetPty
    terminalSetPty                          ,


-- ** terminalSetRewrapOnResize
    terminalSetRewrapOnResize               ,


-- ** terminalSetScrollOnKeystroke
    terminalSetScrollOnKeystroke            ,


-- ** terminalSetScrollOnOutput
    terminalSetScrollOnOutput               ,


-- ** terminalSetScrollbackLines
    terminalSetScrollbackLines              ,


-- ** terminalSetSize
    terminalSetSize                         ,


-- ** terminalSetWordCharExceptions
    terminalSetWordCharExceptions           ,


-- ** terminalSpawnSync
    terminalSpawnSync                       ,


-- ** terminalUnselectAll
    terminalUnselectAll                     ,


-- ** terminalWatchChild
    terminalWatchChild                      ,


-- ** terminalWriteContentsSync
    terminalWriteContentsSync               ,




 -- * Properties
-- ** AllowBold
    TerminalAllowBoldPropertyInfo           ,
    constructTerminalAllowBold              ,
    getTerminalAllowBold                    ,
    setTerminalAllowBold                    ,


-- ** AudibleBell
    TerminalAudibleBellPropertyInfo         ,
    constructTerminalAudibleBell            ,
    getTerminalAudibleBell                  ,
    setTerminalAudibleBell                  ,


-- ** BackspaceBinding
    TerminalBackspaceBindingPropertyInfo    ,
    constructTerminalBackspaceBinding       ,
    getTerminalBackspaceBinding             ,
    setTerminalBackspaceBinding             ,


-- ** CjkAmbiguousWidth
    TerminalCjkAmbiguousWidthPropertyInfo   ,
    constructTerminalCjkAmbiguousWidth      ,
    getTerminalCjkAmbiguousWidth            ,
    setTerminalCjkAmbiguousWidth            ,


-- ** CurrentDirectoryUri
    TerminalCurrentDirectoryUriPropertyInfo ,
    getTerminalCurrentDirectoryUri          ,


-- ** CurrentFileUri
    TerminalCurrentFileUriPropertyInfo      ,
    getTerminalCurrentFileUri               ,


-- ** CursorBlinkMode
    TerminalCursorBlinkModePropertyInfo     ,
    constructTerminalCursorBlinkMode        ,
    getTerminalCursorBlinkMode              ,
    setTerminalCursorBlinkMode              ,


-- ** CursorShape
    TerminalCursorShapePropertyInfo         ,
    constructTerminalCursorShape            ,
    getTerminalCursorShape                  ,
    setTerminalCursorShape                  ,


-- ** DeleteBinding
    TerminalDeleteBindingPropertyInfo       ,
    constructTerminalDeleteBinding          ,
    getTerminalDeleteBinding                ,
    setTerminalDeleteBinding                ,


-- ** Encoding
    TerminalEncodingPropertyInfo            ,
    constructTerminalEncoding               ,
    getTerminalEncoding                     ,
    setTerminalEncoding                     ,


-- ** FontDesc
    TerminalFontDescPropertyInfo            ,
    constructTerminalFontDesc               ,
    getTerminalFontDesc                     ,
    setTerminalFontDesc                     ,


-- ** FontScale
    TerminalFontScalePropertyInfo           ,
    constructTerminalFontScale              ,
    getTerminalFontScale                    ,
    setTerminalFontScale                    ,


-- ** IconTitle
    TerminalIconTitlePropertyInfo           ,
    getTerminalIconTitle                    ,


-- ** InputEnabled
    TerminalInputEnabledPropertyInfo        ,
    constructTerminalInputEnabled           ,
    getTerminalInputEnabled                 ,
    setTerminalInputEnabled                 ,


-- ** PointerAutohide
    TerminalPointerAutohidePropertyInfo     ,
    constructTerminalPointerAutohide        ,
    getTerminalPointerAutohide              ,
    setTerminalPointerAutohide              ,


-- ** Pty
    TerminalPtyPropertyInfo                 ,
    constructTerminalPty                    ,
    getTerminalPty                          ,
    setTerminalPty                          ,


-- ** RewrapOnResize
    TerminalRewrapOnResizePropertyInfo      ,
    constructTerminalRewrapOnResize         ,
    getTerminalRewrapOnResize               ,
    setTerminalRewrapOnResize               ,


-- ** ScrollOnKeystroke
    TerminalScrollOnKeystrokePropertyInfo   ,
    constructTerminalScrollOnKeystroke      ,
    getTerminalScrollOnKeystroke            ,
    setTerminalScrollOnKeystroke            ,


-- ** ScrollOnOutput
    TerminalScrollOnOutputPropertyInfo      ,
    constructTerminalScrollOnOutput         ,
    getTerminalScrollOnOutput               ,
    setTerminalScrollOnOutput               ,


-- ** ScrollbackLines
    TerminalScrollbackLinesPropertyInfo     ,
    constructTerminalScrollbackLines        ,
    getTerminalScrollbackLines              ,
    setTerminalScrollbackLines              ,


-- ** WindowTitle
    TerminalWindowTitlePropertyInfo         ,
    getTerminalWindowTitle                  ,


-- ** WordCharExceptions
    TerminalWordCharExceptionsPropertyInfo  ,
    getTerminalWordCharExceptions           ,




 -- * Signals
-- ** Bell
    TerminalBellCallback                    ,
    TerminalBellCallbackC                   ,
    TerminalBellSignalInfo                  ,
    afterTerminalBell                       ,
    mkTerminalBellCallback                  ,
    noTerminalBellCallback                  ,
    onTerminalBell                          ,
    terminalBellCallbackWrapper             ,
    terminalBellClosure                     ,


-- ** CharSizeChanged
    TerminalCharSizeChangedCallback         ,
    TerminalCharSizeChangedCallbackC        ,
    TerminalCharSizeChangedSignalInfo       ,
    afterTerminalCharSizeChanged            ,
    mkTerminalCharSizeChangedCallback       ,
    noTerminalCharSizeChangedCallback       ,
    onTerminalCharSizeChanged               ,
    terminalCharSizeChangedCallbackWrapper  ,
    terminalCharSizeChangedClosure          ,


-- ** ChildExited
    TerminalChildExitedCallback             ,
    TerminalChildExitedCallbackC            ,
    TerminalChildExitedSignalInfo           ,
    afterTerminalChildExited                ,
    mkTerminalChildExitedCallback           ,
    noTerminalChildExitedCallback           ,
    onTerminalChildExited                   ,
    terminalChildExitedCallbackWrapper      ,
    terminalChildExitedClosure              ,


-- ** Commit
    TerminalCommitCallback                  ,
    TerminalCommitCallbackC                 ,
    TerminalCommitSignalInfo                ,
    afterTerminalCommit                     ,
    mkTerminalCommitCallback                ,
    noTerminalCommitCallback                ,
    onTerminalCommit                        ,
    terminalCommitCallbackWrapper           ,
    terminalCommitClosure                   ,


-- ** ContentsChanged
    TerminalContentsChangedCallback         ,
    TerminalContentsChangedCallbackC        ,
    TerminalContentsChangedSignalInfo       ,
    afterTerminalContentsChanged            ,
    mkTerminalContentsChangedCallback       ,
    noTerminalContentsChangedCallback       ,
    onTerminalContentsChanged               ,
    terminalContentsChangedCallbackWrapper  ,
    terminalContentsChangedClosure          ,


-- ** CopyClipboard
    TerminalCopyClipboardCallback           ,
    TerminalCopyClipboardCallbackC          ,
    TerminalCopyClipboardSignalInfo         ,
    afterTerminalCopyClipboard              ,
    mkTerminalCopyClipboardCallback         ,
    noTerminalCopyClipboardCallback         ,
    onTerminalCopyClipboard                 ,
    terminalCopyClipboardCallbackWrapper    ,
    terminalCopyClipboardClosure            ,


-- ** CurrentDirectoryUriChanged
    TerminalCurrentDirectoryUriChangedCallback,
    TerminalCurrentDirectoryUriChangedCallbackC,
    TerminalCurrentDirectoryUriChangedSignalInfo,
    afterTerminalCurrentDirectoryUriChanged ,
    mkTerminalCurrentDirectoryUriChangedCallback,
    noTerminalCurrentDirectoryUriChangedCallback,
    onTerminalCurrentDirectoryUriChanged    ,
    terminalCurrentDirectoryUriChangedCallbackWrapper,
    terminalCurrentDirectoryUriChangedClosure,


-- ** CurrentFileUriChanged
    TerminalCurrentFileUriChangedCallback   ,
    TerminalCurrentFileUriChangedCallbackC  ,
    TerminalCurrentFileUriChangedSignalInfo ,
    afterTerminalCurrentFileUriChanged      ,
    mkTerminalCurrentFileUriChangedCallback ,
    noTerminalCurrentFileUriChangedCallback ,
    onTerminalCurrentFileUriChanged         ,
    terminalCurrentFileUriChangedCallbackWrapper,
    terminalCurrentFileUriChangedClosure    ,


-- ** CursorMoved
    TerminalCursorMovedCallback             ,
    TerminalCursorMovedCallbackC            ,
    TerminalCursorMovedSignalInfo           ,
    afterTerminalCursorMoved                ,
    mkTerminalCursorMovedCallback           ,
    noTerminalCursorMovedCallback           ,
    onTerminalCursorMoved                   ,
    terminalCursorMovedCallbackWrapper      ,
    terminalCursorMovedClosure              ,


-- ** DecreaseFontSize
    TerminalDecreaseFontSizeCallback        ,
    TerminalDecreaseFontSizeCallbackC       ,
    TerminalDecreaseFontSizeSignalInfo      ,
    afterTerminalDecreaseFontSize           ,
    mkTerminalDecreaseFontSizeCallback      ,
    noTerminalDecreaseFontSizeCallback      ,
    onTerminalDecreaseFontSize              ,
    terminalDecreaseFontSizeCallbackWrapper ,
    terminalDecreaseFontSizeClosure         ,


-- ** DeiconifyWindow
    TerminalDeiconifyWindowCallback         ,
    TerminalDeiconifyWindowCallbackC        ,
    TerminalDeiconifyWindowSignalInfo       ,
    afterTerminalDeiconifyWindow            ,
    mkTerminalDeiconifyWindowCallback       ,
    noTerminalDeiconifyWindowCallback       ,
    onTerminalDeiconifyWindow               ,
    terminalDeiconifyWindowCallbackWrapper  ,
    terminalDeiconifyWindowClosure          ,


-- ** EncodingChanged
    TerminalEncodingChangedCallback         ,
    TerminalEncodingChangedCallbackC        ,
    TerminalEncodingChangedSignalInfo       ,
    afterTerminalEncodingChanged            ,
    mkTerminalEncodingChangedCallback       ,
    noTerminalEncodingChangedCallback       ,
    onTerminalEncodingChanged               ,
    terminalEncodingChangedCallbackWrapper  ,
    terminalEncodingChangedClosure          ,


-- ** Eof
    TerminalEofCallback                     ,
    TerminalEofCallbackC                    ,
    TerminalEofSignalInfo                   ,
    afterTerminalEof                        ,
    mkTerminalEofCallback                   ,
    noTerminalEofCallback                   ,
    onTerminalEof                           ,
    terminalEofCallbackWrapper              ,
    terminalEofClosure                      ,


-- ** IconTitleChanged
    TerminalIconTitleChangedCallback        ,
    TerminalIconTitleChangedCallbackC       ,
    TerminalIconTitleChangedSignalInfo      ,
    afterTerminalIconTitleChanged           ,
    mkTerminalIconTitleChangedCallback      ,
    noTerminalIconTitleChangedCallback      ,
    onTerminalIconTitleChanged              ,
    terminalIconTitleChangedCallbackWrapper ,
    terminalIconTitleChangedClosure         ,


-- ** IconifyWindow
    TerminalIconifyWindowCallback           ,
    TerminalIconifyWindowCallbackC          ,
    TerminalIconifyWindowSignalInfo         ,
    afterTerminalIconifyWindow              ,
    mkTerminalIconifyWindowCallback         ,
    noTerminalIconifyWindowCallback         ,
    onTerminalIconifyWindow                 ,
    terminalIconifyWindowCallbackWrapper    ,
    terminalIconifyWindowClosure            ,


-- ** IncreaseFontSize
    TerminalIncreaseFontSizeCallback        ,
    TerminalIncreaseFontSizeCallbackC       ,
    TerminalIncreaseFontSizeSignalInfo      ,
    afterTerminalIncreaseFontSize           ,
    mkTerminalIncreaseFontSizeCallback      ,
    noTerminalIncreaseFontSizeCallback      ,
    onTerminalIncreaseFontSize              ,
    terminalIncreaseFontSizeCallbackWrapper ,
    terminalIncreaseFontSizeClosure         ,


-- ** LowerWindow
    TerminalLowerWindowCallback             ,
    TerminalLowerWindowCallbackC            ,
    TerminalLowerWindowSignalInfo           ,
    afterTerminalLowerWindow                ,
    mkTerminalLowerWindowCallback           ,
    noTerminalLowerWindowCallback           ,
    onTerminalLowerWindow                   ,
    terminalLowerWindowCallbackWrapper      ,
    terminalLowerWindowClosure              ,


-- ** MaximizeWindow
    TerminalMaximizeWindowCallback          ,
    TerminalMaximizeWindowCallbackC         ,
    TerminalMaximizeWindowSignalInfo        ,
    afterTerminalMaximizeWindow             ,
    mkTerminalMaximizeWindowCallback        ,
    noTerminalMaximizeWindowCallback        ,
    onTerminalMaximizeWindow                ,
    terminalMaximizeWindowCallbackWrapper   ,
    terminalMaximizeWindowClosure           ,


-- ** MoveWindow
    TerminalMoveWindowCallback              ,
    TerminalMoveWindowCallbackC             ,
    TerminalMoveWindowSignalInfo            ,
    afterTerminalMoveWindow                 ,
    mkTerminalMoveWindowCallback            ,
    noTerminalMoveWindowCallback            ,
    onTerminalMoveWindow                    ,
    terminalMoveWindowCallbackWrapper       ,
    terminalMoveWindowClosure               ,


-- ** NotificationReceived
    TerminalNotificationReceivedCallback    ,
    TerminalNotificationReceivedCallbackC   ,
    TerminalNotificationReceivedSignalInfo  ,
    afterTerminalNotificationReceived       ,
    mkTerminalNotificationReceivedCallback  ,
    noTerminalNotificationReceivedCallback  ,
    onTerminalNotificationReceived          ,
    terminalNotificationReceivedCallbackWrapper,
    terminalNotificationReceivedClosure     ,


-- ** PasteClipboard
    TerminalPasteClipboardCallback          ,
    TerminalPasteClipboardCallbackC         ,
    TerminalPasteClipboardSignalInfo        ,
    afterTerminalPasteClipboard             ,
    mkTerminalPasteClipboardCallback        ,
    noTerminalPasteClipboardCallback        ,
    onTerminalPasteClipboard                ,
    terminalPasteClipboardCallbackWrapper   ,
    terminalPasteClipboardClosure           ,


-- ** RaiseWindow
    TerminalRaiseWindowCallback             ,
    TerminalRaiseWindowCallbackC            ,
    TerminalRaiseWindowSignalInfo           ,
    afterTerminalRaiseWindow                ,
    mkTerminalRaiseWindowCallback           ,
    noTerminalRaiseWindowCallback           ,
    onTerminalRaiseWindow                   ,
    terminalRaiseWindowCallbackWrapper      ,
    terminalRaiseWindowClosure              ,


-- ** RefreshWindow
    TerminalRefreshWindowCallback           ,
    TerminalRefreshWindowCallbackC          ,
    TerminalRefreshWindowSignalInfo         ,
    afterTerminalRefreshWindow              ,
    mkTerminalRefreshWindowCallback         ,
    noTerminalRefreshWindowCallback         ,
    onTerminalRefreshWindow                 ,
    terminalRefreshWindowCallbackWrapper    ,
    terminalRefreshWindowClosure            ,


-- ** ResizeWindow
    TerminalResizeWindowCallback            ,
    TerminalResizeWindowCallbackC           ,
    TerminalResizeWindowSignalInfo          ,
    afterTerminalResizeWindow               ,
    mkTerminalResizeWindowCallback          ,
    noTerminalResizeWindowCallback          ,
    onTerminalResizeWindow                  ,
    terminalResizeWindowCallbackWrapper     ,
    terminalResizeWindowClosure             ,


-- ** RestoreWindow
    TerminalRestoreWindowCallback           ,
    TerminalRestoreWindowCallbackC          ,
    TerminalRestoreWindowSignalInfo         ,
    afterTerminalRestoreWindow              ,
    mkTerminalRestoreWindowCallback         ,
    noTerminalRestoreWindowCallback         ,
    onTerminalRestoreWindow                 ,
    terminalRestoreWindowCallbackWrapper    ,
    terminalRestoreWindowClosure            ,


-- ** SelectionChanged
    TerminalSelectionChangedCallback        ,
    TerminalSelectionChangedCallbackC       ,
    TerminalSelectionChangedSignalInfo      ,
    afterTerminalSelectionChanged           ,
    mkTerminalSelectionChangedCallback      ,
    noTerminalSelectionChangedCallback      ,
    onTerminalSelectionChanged              ,
    terminalSelectionChangedCallbackWrapper ,
    terminalSelectionChangedClosure         ,


-- ** TextDeleted
    TerminalTextDeletedCallback             ,
    TerminalTextDeletedCallbackC            ,
    TerminalTextDeletedSignalInfo           ,
    afterTerminalTextDeleted                ,
    mkTerminalTextDeletedCallback           ,
    noTerminalTextDeletedCallback           ,
    onTerminalTextDeleted                   ,
    terminalTextDeletedCallbackWrapper      ,
    terminalTextDeletedClosure              ,


-- ** TextInserted
    TerminalTextInsertedCallback            ,
    TerminalTextInsertedCallbackC           ,
    TerminalTextInsertedSignalInfo          ,
    afterTerminalTextInserted               ,
    mkTerminalTextInsertedCallback          ,
    noTerminalTextInsertedCallback          ,
    onTerminalTextInserted                  ,
    terminalTextInsertedCallbackWrapper     ,
    terminalTextInsertedClosure             ,


-- ** TextModified
    TerminalTextModifiedCallback            ,
    TerminalTextModifiedCallbackC           ,
    TerminalTextModifiedSignalInfo          ,
    afterTerminalTextModified               ,
    mkTerminalTextModifiedCallback          ,
    noTerminalTextModifiedCallback          ,
    onTerminalTextModified                  ,
    terminalTextModifiedCallbackWrapper     ,
    terminalTextModifiedClosure             ,


-- ** TextScrolled
    TerminalTextScrolledCallback            ,
    TerminalTextScrolledCallbackC           ,
    TerminalTextScrolledSignalInfo          ,
    afterTerminalTextScrolled               ,
    mkTerminalTextScrolledCallback          ,
    noTerminalTextScrolledCallback          ,
    onTerminalTextScrolled                  ,
    terminalTextScrolledCallbackWrapper     ,
    terminalTextScrolledClosure             ,


-- ** WindowTitleChanged
    TerminalWindowTitleChangedCallback      ,
    TerminalWindowTitleChangedCallbackC     ,
    TerminalWindowTitleChangedSignalInfo    ,
    afterTerminalWindowTitleChanged         ,
    mkTerminalWindowTitleChangedCallback    ,
    noTerminalWindowTitleChangedCallback    ,
    onTerminalWindowTitleChanged            ,
    terminalWindowTitleChangedCallbackWrapper,
    terminalWindowTitleChangedClosure       ,




    ) 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.Vte.Types
import GI.Vte.Callbacks
import qualified GI.Atk as Atk
import qualified GI.GLib as GLib
import qualified GI.GObject as GObject
import qualified GI.Gdk as Gdk
import qualified GI.Gio as Gio
import qualified GI.Gtk as Gtk
import qualified GI.Pango as Pango

newtype Terminal = Terminal (ForeignPtr Terminal)
foreign import ccall "vte_terminal_get_type"
    c_vte_terminal_get_type :: IO GType

type instance ParentTypes Terminal = TerminalParentTypes
type TerminalParentTypes = '[Gtk.Widget, GObject.Object, Atk.ImplementorIface, Gtk.Buildable, Gtk.Scrollable]

instance GObject Terminal where
    gobjectIsInitiallyUnowned _ = True
    gobjectType _ = c_vte_terminal_get_type
    

class GObject o => TerminalK o
instance (GObject o, IsDescendantOf Terminal o) => TerminalK o

toTerminal :: TerminalK o => o -> IO Terminal
toTerminal = unsafeCastTo Terminal

noTerminal :: Maybe Terminal
noTerminal = Nothing

-- signal Terminal::bell
type TerminalBellCallback =
    IO ()

noTerminalBellCallback :: Maybe TerminalBellCallback
noTerminalBellCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalBellCallback :: TerminalBellCallbackC -> IO (FunPtr TerminalBellCallbackC)

terminalBellClosure :: TerminalBellCallback -> IO Closure
terminalBellClosure cb = newCClosure =<< mkTerminalBellCallback wrapped
    where wrapped = terminalBellCallbackWrapper cb

terminalBellCallbackWrapper ::
    TerminalBellCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalBellCallbackWrapper _cb _ _ = do
    _cb 

onTerminalBell :: (GObject a, MonadIO m) => a -> TerminalBellCallback -> m SignalHandlerId
onTerminalBell obj cb = liftIO $ connectTerminalBell obj cb SignalConnectBefore
afterTerminalBell :: (GObject a, MonadIO m) => a -> TerminalBellCallback -> m SignalHandlerId
afterTerminalBell obj cb = connectTerminalBell obj cb SignalConnectAfter

connectTerminalBell :: (GObject a, MonadIO m) =>
                       a -> TerminalBellCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalBell obj cb after = liftIO $ do
    cb' <- mkTerminalBellCallback (terminalBellCallbackWrapper cb)
    connectSignalFunPtr obj "bell" cb' after

-- signal Terminal::char-size-changed
type TerminalCharSizeChangedCallback =
    Word32 ->
    Word32 ->
    IO ()

noTerminalCharSizeChangedCallback :: Maybe TerminalCharSizeChangedCallback
noTerminalCharSizeChangedCallback = Nothing

type TerminalCharSizeChangedCallbackC =
    Ptr () ->                               -- object
    Word32 ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTerminalCharSizeChangedCallback :: TerminalCharSizeChangedCallbackC -> IO (FunPtr TerminalCharSizeChangedCallbackC)

terminalCharSizeChangedClosure :: TerminalCharSizeChangedCallback -> IO Closure
terminalCharSizeChangedClosure cb = newCClosure =<< mkTerminalCharSizeChangedCallback wrapped
    where wrapped = terminalCharSizeChangedCallbackWrapper cb

terminalCharSizeChangedCallbackWrapper ::
    TerminalCharSizeChangedCallback ->
    Ptr () ->
    Word32 ->
    Word32 ->
    Ptr () ->
    IO ()
terminalCharSizeChangedCallbackWrapper _cb _ width height _ = do
    _cb  width height

onTerminalCharSizeChanged :: (GObject a, MonadIO m) => a -> TerminalCharSizeChangedCallback -> m SignalHandlerId
onTerminalCharSizeChanged obj cb = liftIO $ connectTerminalCharSizeChanged obj cb SignalConnectBefore
afterTerminalCharSizeChanged :: (GObject a, MonadIO m) => a -> TerminalCharSizeChangedCallback -> m SignalHandlerId
afterTerminalCharSizeChanged obj cb = connectTerminalCharSizeChanged obj cb SignalConnectAfter

connectTerminalCharSizeChanged :: (GObject a, MonadIO m) =>
                                  a -> TerminalCharSizeChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalCharSizeChanged obj cb after = liftIO $ do
    cb' <- mkTerminalCharSizeChangedCallback (terminalCharSizeChangedCallbackWrapper cb)
    connectSignalFunPtr obj "char-size-changed" cb' after

-- signal Terminal::child-exited
type TerminalChildExitedCallback =
    Int32 ->
    IO ()

noTerminalChildExitedCallback :: Maybe TerminalChildExitedCallback
noTerminalChildExitedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalChildExitedCallback :: TerminalChildExitedCallbackC -> IO (FunPtr TerminalChildExitedCallbackC)

terminalChildExitedClosure :: TerminalChildExitedCallback -> IO Closure
terminalChildExitedClosure cb = newCClosure =<< mkTerminalChildExitedCallback wrapped
    where wrapped = terminalChildExitedCallbackWrapper cb

terminalChildExitedCallbackWrapper ::
    TerminalChildExitedCallback ->
    Ptr () ->
    Int32 ->
    Ptr () ->
    IO ()
terminalChildExitedCallbackWrapper _cb _ status _ = do
    _cb  status

onTerminalChildExited :: (GObject a, MonadIO m) => a -> TerminalChildExitedCallback -> m SignalHandlerId
onTerminalChildExited obj cb = liftIO $ connectTerminalChildExited obj cb SignalConnectBefore
afterTerminalChildExited :: (GObject a, MonadIO m) => a -> TerminalChildExitedCallback -> m SignalHandlerId
afterTerminalChildExited obj cb = connectTerminalChildExited obj cb SignalConnectAfter

connectTerminalChildExited :: (GObject a, MonadIO m) =>
                              a -> TerminalChildExitedCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalChildExited obj cb after = liftIO $ do
    cb' <- mkTerminalChildExitedCallback (terminalChildExitedCallbackWrapper cb)
    connectSignalFunPtr obj "child-exited" cb' after

-- signal Terminal::commit
type TerminalCommitCallback =
    T.Text ->
    Word32 ->
    IO ()

noTerminalCommitCallback :: Maybe TerminalCommitCallback
noTerminalCommitCallback = Nothing

type TerminalCommitCallbackC =
    Ptr () ->                               -- object
    CString ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTerminalCommitCallback :: TerminalCommitCallbackC -> IO (FunPtr TerminalCommitCallbackC)

terminalCommitClosure :: TerminalCommitCallback -> IO Closure
terminalCommitClosure cb = newCClosure =<< mkTerminalCommitCallback wrapped
    where wrapped = terminalCommitCallbackWrapper cb

terminalCommitCallbackWrapper ::
    TerminalCommitCallback ->
    Ptr () ->
    CString ->
    Word32 ->
    Ptr () ->
    IO ()
terminalCommitCallbackWrapper _cb _ text size _ = do
    text' <- cstringToText text
    _cb  text' size

onTerminalCommit :: (GObject a, MonadIO m) => a -> TerminalCommitCallback -> m SignalHandlerId
onTerminalCommit obj cb = liftIO $ connectTerminalCommit obj cb SignalConnectBefore
afterTerminalCommit :: (GObject a, MonadIO m) => a -> TerminalCommitCallback -> m SignalHandlerId
afterTerminalCommit obj cb = connectTerminalCommit obj cb SignalConnectAfter

connectTerminalCommit :: (GObject a, MonadIO m) =>
                         a -> TerminalCommitCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalCommit obj cb after = liftIO $ do
    cb' <- mkTerminalCommitCallback (terminalCommitCallbackWrapper cb)
    connectSignalFunPtr obj "commit" cb' after

-- signal Terminal::contents-changed
type TerminalContentsChangedCallback =
    IO ()

noTerminalContentsChangedCallback :: Maybe TerminalContentsChangedCallback
noTerminalContentsChangedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalContentsChangedCallback :: TerminalContentsChangedCallbackC -> IO (FunPtr TerminalContentsChangedCallbackC)

terminalContentsChangedClosure :: TerminalContentsChangedCallback -> IO Closure
terminalContentsChangedClosure cb = newCClosure =<< mkTerminalContentsChangedCallback wrapped
    where wrapped = terminalContentsChangedCallbackWrapper cb

terminalContentsChangedCallbackWrapper ::
    TerminalContentsChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalContentsChangedCallbackWrapper _cb _ _ = do
    _cb 

onTerminalContentsChanged :: (GObject a, MonadIO m) => a -> TerminalContentsChangedCallback -> m SignalHandlerId
onTerminalContentsChanged obj cb = liftIO $ connectTerminalContentsChanged obj cb SignalConnectBefore
afterTerminalContentsChanged :: (GObject a, MonadIO m) => a -> TerminalContentsChangedCallback -> m SignalHandlerId
afterTerminalContentsChanged obj cb = connectTerminalContentsChanged obj cb SignalConnectAfter

connectTerminalContentsChanged :: (GObject a, MonadIO m) =>
                                  a -> TerminalContentsChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalContentsChanged obj cb after = liftIO $ do
    cb' <- mkTerminalContentsChangedCallback (terminalContentsChangedCallbackWrapper cb)
    connectSignalFunPtr obj "contents-changed" cb' after

-- signal Terminal::copy-clipboard
type TerminalCopyClipboardCallback =
    IO ()

noTerminalCopyClipboardCallback :: Maybe TerminalCopyClipboardCallback
noTerminalCopyClipboardCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalCopyClipboardCallback :: TerminalCopyClipboardCallbackC -> IO (FunPtr TerminalCopyClipboardCallbackC)

terminalCopyClipboardClosure :: TerminalCopyClipboardCallback -> IO Closure
terminalCopyClipboardClosure cb = newCClosure =<< mkTerminalCopyClipboardCallback wrapped
    where wrapped = terminalCopyClipboardCallbackWrapper cb

terminalCopyClipboardCallbackWrapper ::
    TerminalCopyClipboardCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalCopyClipboardCallbackWrapper _cb _ _ = do
    _cb 

onTerminalCopyClipboard :: (GObject a, MonadIO m) => a -> TerminalCopyClipboardCallback -> m SignalHandlerId
onTerminalCopyClipboard obj cb = liftIO $ connectTerminalCopyClipboard obj cb SignalConnectBefore
afterTerminalCopyClipboard :: (GObject a, MonadIO m) => a -> TerminalCopyClipboardCallback -> m SignalHandlerId
afterTerminalCopyClipboard obj cb = connectTerminalCopyClipboard obj cb SignalConnectAfter

connectTerminalCopyClipboard :: (GObject a, MonadIO m) =>
                                a -> TerminalCopyClipboardCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalCopyClipboard obj cb after = liftIO $ do
    cb' <- mkTerminalCopyClipboardCallback (terminalCopyClipboardCallbackWrapper cb)
    connectSignalFunPtr obj "copy-clipboard" cb' after

-- signal Terminal::current-directory-uri-changed
type TerminalCurrentDirectoryUriChangedCallback =
    IO ()

noTerminalCurrentDirectoryUriChangedCallback :: Maybe TerminalCurrentDirectoryUriChangedCallback
noTerminalCurrentDirectoryUriChangedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalCurrentDirectoryUriChangedCallback :: TerminalCurrentDirectoryUriChangedCallbackC -> IO (FunPtr TerminalCurrentDirectoryUriChangedCallbackC)

terminalCurrentDirectoryUriChangedClosure :: TerminalCurrentDirectoryUriChangedCallback -> IO Closure
terminalCurrentDirectoryUriChangedClosure cb = newCClosure =<< mkTerminalCurrentDirectoryUriChangedCallback wrapped
    where wrapped = terminalCurrentDirectoryUriChangedCallbackWrapper cb

terminalCurrentDirectoryUriChangedCallbackWrapper ::
    TerminalCurrentDirectoryUriChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalCurrentDirectoryUriChangedCallbackWrapper _cb _ _ = do
    _cb 

onTerminalCurrentDirectoryUriChanged :: (GObject a, MonadIO m) => a -> TerminalCurrentDirectoryUriChangedCallback -> m SignalHandlerId
onTerminalCurrentDirectoryUriChanged obj cb = liftIO $ connectTerminalCurrentDirectoryUriChanged obj cb SignalConnectBefore
afterTerminalCurrentDirectoryUriChanged :: (GObject a, MonadIO m) => a -> TerminalCurrentDirectoryUriChangedCallback -> m SignalHandlerId
afterTerminalCurrentDirectoryUriChanged obj cb = connectTerminalCurrentDirectoryUriChanged obj cb SignalConnectAfter

connectTerminalCurrentDirectoryUriChanged :: (GObject a, MonadIO m) =>
                                             a -> TerminalCurrentDirectoryUriChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalCurrentDirectoryUriChanged obj cb after = liftIO $ do
    cb' <- mkTerminalCurrentDirectoryUriChangedCallback (terminalCurrentDirectoryUriChangedCallbackWrapper cb)
    connectSignalFunPtr obj "current-directory-uri-changed" cb' after

-- signal Terminal::current-file-uri-changed
type TerminalCurrentFileUriChangedCallback =
    IO ()

noTerminalCurrentFileUriChangedCallback :: Maybe TerminalCurrentFileUriChangedCallback
noTerminalCurrentFileUriChangedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalCurrentFileUriChangedCallback :: TerminalCurrentFileUriChangedCallbackC -> IO (FunPtr TerminalCurrentFileUriChangedCallbackC)

terminalCurrentFileUriChangedClosure :: TerminalCurrentFileUriChangedCallback -> IO Closure
terminalCurrentFileUriChangedClosure cb = newCClosure =<< mkTerminalCurrentFileUriChangedCallback wrapped
    where wrapped = terminalCurrentFileUriChangedCallbackWrapper cb

terminalCurrentFileUriChangedCallbackWrapper ::
    TerminalCurrentFileUriChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalCurrentFileUriChangedCallbackWrapper _cb _ _ = do
    _cb 

onTerminalCurrentFileUriChanged :: (GObject a, MonadIO m) => a -> TerminalCurrentFileUriChangedCallback -> m SignalHandlerId
onTerminalCurrentFileUriChanged obj cb = liftIO $ connectTerminalCurrentFileUriChanged obj cb SignalConnectBefore
afterTerminalCurrentFileUriChanged :: (GObject a, MonadIO m) => a -> TerminalCurrentFileUriChangedCallback -> m SignalHandlerId
afterTerminalCurrentFileUriChanged obj cb = connectTerminalCurrentFileUriChanged obj cb SignalConnectAfter

connectTerminalCurrentFileUriChanged :: (GObject a, MonadIO m) =>
                                        a -> TerminalCurrentFileUriChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalCurrentFileUriChanged obj cb after = liftIO $ do
    cb' <- mkTerminalCurrentFileUriChangedCallback (terminalCurrentFileUriChangedCallbackWrapper cb)
    connectSignalFunPtr obj "current-file-uri-changed" cb' after

-- signal Terminal::cursor-moved
type TerminalCursorMovedCallback =
    IO ()

noTerminalCursorMovedCallback :: Maybe TerminalCursorMovedCallback
noTerminalCursorMovedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalCursorMovedCallback :: TerminalCursorMovedCallbackC -> IO (FunPtr TerminalCursorMovedCallbackC)

terminalCursorMovedClosure :: TerminalCursorMovedCallback -> IO Closure
terminalCursorMovedClosure cb = newCClosure =<< mkTerminalCursorMovedCallback wrapped
    where wrapped = terminalCursorMovedCallbackWrapper cb

terminalCursorMovedCallbackWrapper ::
    TerminalCursorMovedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalCursorMovedCallbackWrapper _cb _ _ = do
    _cb 

onTerminalCursorMoved :: (GObject a, MonadIO m) => a -> TerminalCursorMovedCallback -> m SignalHandlerId
onTerminalCursorMoved obj cb = liftIO $ connectTerminalCursorMoved obj cb SignalConnectBefore
afterTerminalCursorMoved :: (GObject a, MonadIO m) => a -> TerminalCursorMovedCallback -> m SignalHandlerId
afterTerminalCursorMoved obj cb = connectTerminalCursorMoved obj cb SignalConnectAfter

connectTerminalCursorMoved :: (GObject a, MonadIO m) =>
                              a -> TerminalCursorMovedCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalCursorMoved obj cb after = liftIO $ do
    cb' <- mkTerminalCursorMovedCallback (terminalCursorMovedCallbackWrapper cb)
    connectSignalFunPtr obj "cursor-moved" cb' after

-- signal Terminal::decrease-font-size
type TerminalDecreaseFontSizeCallback =
    IO ()

noTerminalDecreaseFontSizeCallback :: Maybe TerminalDecreaseFontSizeCallback
noTerminalDecreaseFontSizeCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalDecreaseFontSizeCallback :: TerminalDecreaseFontSizeCallbackC -> IO (FunPtr TerminalDecreaseFontSizeCallbackC)

terminalDecreaseFontSizeClosure :: TerminalDecreaseFontSizeCallback -> IO Closure
terminalDecreaseFontSizeClosure cb = newCClosure =<< mkTerminalDecreaseFontSizeCallback wrapped
    where wrapped = terminalDecreaseFontSizeCallbackWrapper cb

terminalDecreaseFontSizeCallbackWrapper ::
    TerminalDecreaseFontSizeCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalDecreaseFontSizeCallbackWrapper _cb _ _ = do
    _cb 

onTerminalDecreaseFontSize :: (GObject a, MonadIO m) => a -> TerminalDecreaseFontSizeCallback -> m SignalHandlerId
onTerminalDecreaseFontSize obj cb = liftIO $ connectTerminalDecreaseFontSize obj cb SignalConnectBefore
afterTerminalDecreaseFontSize :: (GObject a, MonadIO m) => a -> TerminalDecreaseFontSizeCallback -> m SignalHandlerId
afterTerminalDecreaseFontSize obj cb = connectTerminalDecreaseFontSize obj cb SignalConnectAfter

connectTerminalDecreaseFontSize :: (GObject a, MonadIO m) =>
                                   a -> TerminalDecreaseFontSizeCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalDecreaseFontSize obj cb after = liftIO $ do
    cb' <- mkTerminalDecreaseFontSizeCallback (terminalDecreaseFontSizeCallbackWrapper cb)
    connectSignalFunPtr obj "decrease-font-size" cb' after

-- signal Terminal::deiconify-window
type TerminalDeiconifyWindowCallback =
    IO ()

noTerminalDeiconifyWindowCallback :: Maybe TerminalDeiconifyWindowCallback
noTerminalDeiconifyWindowCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalDeiconifyWindowCallback :: TerminalDeiconifyWindowCallbackC -> IO (FunPtr TerminalDeiconifyWindowCallbackC)

terminalDeiconifyWindowClosure :: TerminalDeiconifyWindowCallback -> IO Closure
terminalDeiconifyWindowClosure cb = newCClosure =<< mkTerminalDeiconifyWindowCallback wrapped
    where wrapped = terminalDeiconifyWindowCallbackWrapper cb

terminalDeiconifyWindowCallbackWrapper ::
    TerminalDeiconifyWindowCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalDeiconifyWindowCallbackWrapper _cb _ _ = do
    _cb 

onTerminalDeiconifyWindow :: (GObject a, MonadIO m) => a -> TerminalDeiconifyWindowCallback -> m SignalHandlerId
onTerminalDeiconifyWindow obj cb = liftIO $ connectTerminalDeiconifyWindow obj cb SignalConnectBefore
afterTerminalDeiconifyWindow :: (GObject a, MonadIO m) => a -> TerminalDeiconifyWindowCallback -> m SignalHandlerId
afterTerminalDeiconifyWindow obj cb = connectTerminalDeiconifyWindow obj cb SignalConnectAfter

connectTerminalDeiconifyWindow :: (GObject a, MonadIO m) =>
                                  a -> TerminalDeiconifyWindowCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalDeiconifyWindow obj cb after = liftIO $ do
    cb' <- mkTerminalDeiconifyWindowCallback (terminalDeiconifyWindowCallbackWrapper cb)
    connectSignalFunPtr obj "deiconify-window" cb' after

-- signal Terminal::encoding-changed
type TerminalEncodingChangedCallback =
    IO ()

noTerminalEncodingChangedCallback :: Maybe TerminalEncodingChangedCallback
noTerminalEncodingChangedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalEncodingChangedCallback :: TerminalEncodingChangedCallbackC -> IO (FunPtr TerminalEncodingChangedCallbackC)

terminalEncodingChangedClosure :: TerminalEncodingChangedCallback -> IO Closure
terminalEncodingChangedClosure cb = newCClosure =<< mkTerminalEncodingChangedCallback wrapped
    where wrapped = terminalEncodingChangedCallbackWrapper cb

terminalEncodingChangedCallbackWrapper ::
    TerminalEncodingChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalEncodingChangedCallbackWrapper _cb _ _ = do
    _cb 

onTerminalEncodingChanged :: (GObject a, MonadIO m) => a -> TerminalEncodingChangedCallback -> m SignalHandlerId
onTerminalEncodingChanged obj cb = liftIO $ connectTerminalEncodingChanged obj cb SignalConnectBefore
afterTerminalEncodingChanged :: (GObject a, MonadIO m) => a -> TerminalEncodingChangedCallback -> m SignalHandlerId
afterTerminalEncodingChanged obj cb = connectTerminalEncodingChanged obj cb SignalConnectAfter

connectTerminalEncodingChanged :: (GObject a, MonadIO m) =>
                                  a -> TerminalEncodingChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalEncodingChanged obj cb after = liftIO $ do
    cb' <- mkTerminalEncodingChangedCallback (terminalEncodingChangedCallbackWrapper cb)
    connectSignalFunPtr obj "encoding-changed" cb' after

-- signal Terminal::eof
type TerminalEofCallback =
    IO ()

noTerminalEofCallback :: Maybe TerminalEofCallback
noTerminalEofCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalEofCallback :: TerminalEofCallbackC -> IO (FunPtr TerminalEofCallbackC)

terminalEofClosure :: TerminalEofCallback -> IO Closure
terminalEofClosure cb = newCClosure =<< mkTerminalEofCallback wrapped
    where wrapped = terminalEofCallbackWrapper cb

terminalEofCallbackWrapper ::
    TerminalEofCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalEofCallbackWrapper _cb _ _ = do
    _cb 

onTerminalEof :: (GObject a, MonadIO m) => a -> TerminalEofCallback -> m SignalHandlerId
onTerminalEof obj cb = liftIO $ connectTerminalEof obj cb SignalConnectBefore
afterTerminalEof :: (GObject a, MonadIO m) => a -> TerminalEofCallback -> m SignalHandlerId
afterTerminalEof obj cb = connectTerminalEof obj cb SignalConnectAfter

connectTerminalEof :: (GObject a, MonadIO m) =>
                      a -> TerminalEofCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalEof obj cb after = liftIO $ do
    cb' <- mkTerminalEofCallback (terminalEofCallbackWrapper cb)
    connectSignalFunPtr obj "eof" cb' after

-- signal Terminal::icon-title-changed
type TerminalIconTitleChangedCallback =
    IO ()

noTerminalIconTitleChangedCallback :: Maybe TerminalIconTitleChangedCallback
noTerminalIconTitleChangedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalIconTitleChangedCallback :: TerminalIconTitleChangedCallbackC -> IO (FunPtr TerminalIconTitleChangedCallbackC)

terminalIconTitleChangedClosure :: TerminalIconTitleChangedCallback -> IO Closure
terminalIconTitleChangedClosure cb = newCClosure =<< mkTerminalIconTitleChangedCallback wrapped
    where wrapped = terminalIconTitleChangedCallbackWrapper cb

terminalIconTitleChangedCallbackWrapper ::
    TerminalIconTitleChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalIconTitleChangedCallbackWrapper _cb _ _ = do
    _cb 

onTerminalIconTitleChanged :: (GObject a, MonadIO m) => a -> TerminalIconTitleChangedCallback -> m SignalHandlerId
onTerminalIconTitleChanged obj cb = liftIO $ connectTerminalIconTitleChanged obj cb SignalConnectBefore
afterTerminalIconTitleChanged :: (GObject a, MonadIO m) => a -> TerminalIconTitleChangedCallback -> m SignalHandlerId
afterTerminalIconTitleChanged obj cb = connectTerminalIconTitleChanged obj cb SignalConnectAfter

connectTerminalIconTitleChanged :: (GObject a, MonadIO m) =>
                                   a -> TerminalIconTitleChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalIconTitleChanged obj cb after = liftIO $ do
    cb' <- mkTerminalIconTitleChangedCallback (terminalIconTitleChangedCallbackWrapper cb)
    connectSignalFunPtr obj "icon-title-changed" cb' after

-- signal Terminal::iconify-window
type TerminalIconifyWindowCallback =
    IO ()

noTerminalIconifyWindowCallback :: Maybe TerminalIconifyWindowCallback
noTerminalIconifyWindowCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalIconifyWindowCallback :: TerminalIconifyWindowCallbackC -> IO (FunPtr TerminalIconifyWindowCallbackC)

terminalIconifyWindowClosure :: TerminalIconifyWindowCallback -> IO Closure
terminalIconifyWindowClosure cb = newCClosure =<< mkTerminalIconifyWindowCallback wrapped
    where wrapped = terminalIconifyWindowCallbackWrapper cb

terminalIconifyWindowCallbackWrapper ::
    TerminalIconifyWindowCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalIconifyWindowCallbackWrapper _cb _ _ = do
    _cb 

onTerminalIconifyWindow :: (GObject a, MonadIO m) => a -> TerminalIconifyWindowCallback -> m SignalHandlerId
onTerminalIconifyWindow obj cb = liftIO $ connectTerminalIconifyWindow obj cb SignalConnectBefore
afterTerminalIconifyWindow :: (GObject a, MonadIO m) => a -> TerminalIconifyWindowCallback -> m SignalHandlerId
afterTerminalIconifyWindow obj cb = connectTerminalIconifyWindow obj cb SignalConnectAfter

connectTerminalIconifyWindow :: (GObject a, MonadIO m) =>
                                a -> TerminalIconifyWindowCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalIconifyWindow obj cb after = liftIO $ do
    cb' <- mkTerminalIconifyWindowCallback (terminalIconifyWindowCallbackWrapper cb)
    connectSignalFunPtr obj "iconify-window" cb' after

-- signal Terminal::increase-font-size
type TerminalIncreaseFontSizeCallback =
    IO ()

noTerminalIncreaseFontSizeCallback :: Maybe TerminalIncreaseFontSizeCallback
noTerminalIncreaseFontSizeCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalIncreaseFontSizeCallback :: TerminalIncreaseFontSizeCallbackC -> IO (FunPtr TerminalIncreaseFontSizeCallbackC)

terminalIncreaseFontSizeClosure :: TerminalIncreaseFontSizeCallback -> IO Closure
terminalIncreaseFontSizeClosure cb = newCClosure =<< mkTerminalIncreaseFontSizeCallback wrapped
    where wrapped = terminalIncreaseFontSizeCallbackWrapper cb

terminalIncreaseFontSizeCallbackWrapper ::
    TerminalIncreaseFontSizeCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalIncreaseFontSizeCallbackWrapper _cb _ _ = do
    _cb 

onTerminalIncreaseFontSize :: (GObject a, MonadIO m) => a -> TerminalIncreaseFontSizeCallback -> m SignalHandlerId
onTerminalIncreaseFontSize obj cb = liftIO $ connectTerminalIncreaseFontSize obj cb SignalConnectBefore
afterTerminalIncreaseFontSize :: (GObject a, MonadIO m) => a -> TerminalIncreaseFontSizeCallback -> m SignalHandlerId
afterTerminalIncreaseFontSize obj cb = connectTerminalIncreaseFontSize obj cb SignalConnectAfter

connectTerminalIncreaseFontSize :: (GObject a, MonadIO m) =>
                                   a -> TerminalIncreaseFontSizeCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalIncreaseFontSize obj cb after = liftIO $ do
    cb' <- mkTerminalIncreaseFontSizeCallback (terminalIncreaseFontSizeCallbackWrapper cb)
    connectSignalFunPtr obj "increase-font-size" cb' after

-- signal Terminal::lower-window
type TerminalLowerWindowCallback =
    IO ()

noTerminalLowerWindowCallback :: Maybe TerminalLowerWindowCallback
noTerminalLowerWindowCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalLowerWindowCallback :: TerminalLowerWindowCallbackC -> IO (FunPtr TerminalLowerWindowCallbackC)

terminalLowerWindowClosure :: TerminalLowerWindowCallback -> IO Closure
terminalLowerWindowClosure cb = newCClosure =<< mkTerminalLowerWindowCallback wrapped
    where wrapped = terminalLowerWindowCallbackWrapper cb

terminalLowerWindowCallbackWrapper ::
    TerminalLowerWindowCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalLowerWindowCallbackWrapper _cb _ _ = do
    _cb 

onTerminalLowerWindow :: (GObject a, MonadIO m) => a -> TerminalLowerWindowCallback -> m SignalHandlerId
onTerminalLowerWindow obj cb = liftIO $ connectTerminalLowerWindow obj cb SignalConnectBefore
afterTerminalLowerWindow :: (GObject a, MonadIO m) => a -> TerminalLowerWindowCallback -> m SignalHandlerId
afterTerminalLowerWindow obj cb = connectTerminalLowerWindow obj cb SignalConnectAfter

connectTerminalLowerWindow :: (GObject a, MonadIO m) =>
                              a -> TerminalLowerWindowCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalLowerWindow obj cb after = liftIO $ do
    cb' <- mkTerminalLowerWindowCallback (terminalLowerWindowCallbackWrapper cb)
    connectSignalFunPtr obj "lower-window" cb' after

-- signal Terminal::maximize-window
type TerminalMaximizeWindowCallback =
    IO ()

noTerminalMaximizeWindowCallback :: Maybe TerminalMaximizeWindowCallback
noTerminalMaximizeWindowCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalMaximizeWindowCallback :: TerminalMaximizeWindowCallbackC -> IO (FunPtr TerminalMaximizeWindowCallbackC)

terminalMaximizeWindowClosure :: TerminalMaximizeWindowCallback -> IO Closure
terminalMaximizeWindowClosure cb = newCClosure =<< mkTerminalMaximizeWindowCallback wrapped
    where wrapped = terminalMaximizeWindowCallbackWrapper cb

terminalMaximizeWindowCallbackWrapper ::
    TerminalMaximizeWindowCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalMaximizeWindowCallbackWrapper _cb _ _ = do
    _cb 

onTerminalMaximizeWindow :: (GObject a, MonadIO m) => a -> TerminalMaximizeWindowCallback -> m SignalHandlerId
onTerminalMaximizeWindow obj cb = liftIO $ connectTerminalMaximizeWindow obj cb SignalConnectBefore
afterTerminalMaximizeWindow :: (GObject a, MonadIO m) => a -> TerminalMaximizeWindowCallback -> m SignalHandlerId
afterTerminalMaximizeWindow obj cb = connectTerminalMaximizeWindow obj cb SignalConnectAfter

connectTerminalMaximizeWindow :: (GObject a, MonadIO m) =>
                                 a -> TerminalMaximizeWindowCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalMaximizeWindow obj cb after = liftIO $ do
    cb' <- mkTerminalMaximizeWindowCallback (terminalMaximizeWindowCallbackWrapper cb)
    connectSignalFunPtr obj "maximize-window" cb' after

-- signal Terminal::move-window
type TerminalMoveWindowCallback =
    Word32 ->
    Word32 ->
    IO ()

noTerminalMoveWindowCallback :: Maybe TerminalMoveWindowCallback
noTerminalMoveWindowCallback = Nothing

type TerminalMoveWindowCallbackC =
    Ptr () ->                               -- object
    Word32 ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTerminalMoveWindowCallback :: TerminalMoveWindowCallbackC -> IO (FunPtr TerminalMoveWindowCallbackC)

terminalMoveWindowClosure :: TerminalMoveWindowCallback -> IO Closure
terminalMoveWindowClosure cb = newCClosure =<< mkTerminalMoveWindowCallback wrapped
    where wrapped = terminalMoveWindowCallbackWrapper cb

terminalMoveWindowCallbackWrapper ::
    TerminalMoveWindowCallback ->
    Ptr () ->
    Word32 ->
    Word32 ->
    Ptr () ->
    IO ()
terminalMoveWindowCallbackWrapper _cb _ x y _ = do
    _cb  x y

onTerminalMoveWindow :: (GObject a, MonadIO m) => a -> TerminalMoveWindowCallback -> m SignalHandlerId
onTerminalMoveWindow obj cb = liftIO $ connectTerminalMoveWindow obj cb SignalConnectBefore
afterTerminalMoveWindow :: (GObject a, MonadIO m) => a -> TerminalMoveWindowCallback -> m SignalHandlerId
afterTerminalMoveWindow obj cb = connectTerminalMoveWindow obj cb SignalConnectAfter

connectTerminalMoveWindow :: (GObject a, MonadIO m) =>
                             a -> TerminalMoveWindowCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalMoveWindow obj cb after = liftIO $ do
    cb' <- mkTerminalMoveWindowCallback (terminalMoveWindowCallbackWrapper cb)
    connectSignalFunPtr obj "move-window" cb' after

-- signal Terminal::notification-received
type TerminalNotificationReceivedCallback =
    T.Text ->
    Maybe T.Text ->
    IO ()

noTerminalNotificationReceivedCallback :: Maybe TerminalNotificationReceivedCallback
noTerminalNotificationReceivedCallback = Nothing

type TerminalNotificationReceivedCallbackC =
    Ptr () ->                               -- object
    CString ->
    CString ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTerminalNotificationReceivedCallback :: TerminalNotificationReceivedCallbackC -> IO (FunPtr TerminalNotificationReceivedCallbackC)

terminalNotificationReceivedClosure :: TerminalNotificationReceivedCallback -> IO Closure
terminalNotificationReceivedClosure cb = newCClosure =<< mkTerminalNotificationReceivedCallback wrapped
    where wrapped = terminalNotificationReceivedCallbackWrapper cb

terminalNotificationReceivedCallbackWrapper ::
    TerminalNotificationReceivedCallback ->
    Ptr () ->
    CString ->
    CString ->
    Ptr () ->
    IO ()
terminalNotificationReceivedCallbackWrapper _cb _ summary body _ = do
    summary' <- cstringToText summary
    maybeBody <-
        if body == nullPtr
        then return Nothing
        else do
            body' <- cstringToText body
            return $ Just body'
    _cb  summary' maybeBody

onTerminalNotificationReceived :: (GObject a, MonadIO m) => a -> TerminalNotificationReceivedCallback -> m SignalHandlerId
onTerminalNotificationReceived obj cb = liftIO $ connectTerminalNotificationReceived obj cb SignalConnectBefore
afterTerminalNotificationReceived :: (GObject a, MonadIO m) => a -> TerminalNotificationReceivedCallback -> m SignalHandlerId
afterTerminalNotificationReceived obj cb = connectTerminalNotificationReceived obj cb SignalConnectAfter

connectTerminalNotificationReceived :: (GObject a, MonadIO m) =>
                                       a -> TerminalNotificationReceivedCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalNotificationReceived obj cb after = liftIO $ do
    cb' <- mkTerminalNotificationReceivedCallback (terminalNotificationReceivedCallbackWrapper cb)
    connectSignalFunPtr obj "notification-received" cb' after

-- signal Terminal::paste-clipboard
type TerminalPasteClipboardCallback =
    IO ()

noTerminalPasteClipboardCallback :: Maybe TerminalPasteClipboardCallback
noTerminalPasteClipboardCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalPasteClipboardCallback :: TerminalPasteClipboardCallbackC -> IO (FunPtr TerminalPasteClipboardCallbackC)

terminalPasteClipboardClosure :: TerminalPasteClipboardCallback -> IO Closure
terminalPasteClipboardClosure cb = newCClosure =<< mkTerminalPasteClipboardCallback wrapped
    where wrapped = terminalPasteClipboardCallbackWrapper cb

terminalPasteClipboardCallbackWrapper ::
    TerminalPasteClipboardCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalPasteClipboardCallbackWrapper _cb _ _ = do
    _cb 

onTerminalPasteClipboard :: (GObject a, MonadIO m) => a -> TerminalPasteClipboardCallback -> m SignalHandlerId
onTerminalPasteClipboard obj cb = liftIO $ connectTerminalPasteClipboard obj cb SignalConnectBefore
afterTerminalPasteClipboard :: (GObject a, MonadIO m) => a -> TerminalPasteClipboardCallback -> m SignalHandlerId
afterTerminalPasteClipboard obj cb = connectTerminalPasteClipboard obj cb SignalConnectAfter

connectTerminalPasteClipboard :: (GObject a, MonadIO m) =>
                                 a -> TerminalPasteClipboardCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalPasteClipboard obj cb after = liftIO $ do
    cb' <- mkTerminalPasteClipboardCallback (terminalPasteClipboardCallbackWrapper cb)
    connectSignalFunPtr obj "paste-clipboard" cb' after

-- signal Terminal::raise-window
type TerminalRaiseWindowCallback =
    IO ()

noTerminalRaiseWindowCallback :: Maybe TerminalRaiseWindowCallback
noTerminalRaiseWindowCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalRaiseWindowCallback :: TerminalRaiseWindowCallbackC -> IO (FunPtr TerminalRaiseWindowCallbackC)

terminalRaiseWindowClosure :: TerminalRaiseWindowCallback -> IO Closure
terminalRaiseWindowClosure cb = newCClosure =<< mkTerminalRaiseWindowCallback wrapped
    where wrapped = terminalRaiseWindowCallbackWrapper cb

terminalRaiseWindowCallbackWrapper ::
    TerminalRaiseWindowCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalRaiseWindowCallbackWrapper _cb _ _ = do
    _cb 

onTerminalRaiseWindow :: (GObject a, MonadIO m) => a -> TerminalRaiseWindowCallback -> m SignalHandlerId
onTerminalRaiseWindow obj cb = liftIO $ connectTerminalRaiseWindow obj cb SignalConnectBefore
afterTerminalRaiseWindow :: (GObject a, MonadIO m) => a -> TerminalRaiseWindowCallback -> m SignalHandlerId
afterTerminalRaiseWindow obj cb = connectTerminalRaiseWindow obj cb SignalConnectAfter

connectTerminalRaiseWindow :: (GObject a, MonadIO m) =>
                              a -> TerminalRaiseWindowCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalRaiseWindow obj cb after = liftIO $ do
    cb' <- mkTerminalRaiseWindowCallback (terminalRaiseWindowCallbackWrapper cb)
    connectSignalFunPtr obj "raise-window" cb' after

-- signal Terminal::refresh-window
type TerminalRefreshWindowCallback =
    IO ()

noTerminalRefreshWindowCallback :: Maybe TerminalRefreshWindowCallback
noTerminalRefreshWindowCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalRefreshWindowCallback :: TerminalRefreshWindowCallbackC -> IO (FunPtr TerminalRefreshWindowCallbackC)

terminalRefreshWindowClosure :: TerminalRefreshWindowCallback -> IO Closure
terminalRefreshWindowClosure cb = newCClosure =<< mkTerminalRefreshWindowCallback wrapped
    where wrapped = terminalRefreshWindowCallbackWrapper cb

terminalRefreshWindowCallbackWrapper ::
    TerminalRefreshWindowCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalRefreshWindowCallbackWrapper _cb _ _ = do
    _cb 

onTerminalRefreshWindow :: (GObject a, MonadIO m) => a -> TerminalRefreshWindowCallback -> m SignalHandlerId
onTerminalRefreshWindow obj cb = liftIO $ connectTerminalRefreshWindow obj cb SignalConnectBefore
afterTerminalRefreshWindow :: (GObject a, MonadIO m) => a -> TerminalRefreshWindowCallback -> m SignalHandlerId
afterTerminalRefreshWindow obj cb = connectTerminalRefreshWindow obj cb SignalConnectAfter

connectTerminalRefreshWindow :: (GObject a, MonadIO m) =>
                                a -> TerminalRefreshWindowCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalRefreshWindow obj cb after = liftIO $ do
    cb' <- mkTerminalRefreshWindowCallback (terminalRefreshWindowCallbackWrapper cb)
    connectSignalFunPtr obj "refresh-window" cb' after

-- signal Terminal::resize-window
type TerminalResizeWindowCallback =
    Word32 ->
    Word32 ->
    IO ()

noTerminalResizeWindowCallback :: Maybe TerminalResizeWindowCallback
noTerminalResizeWindowCallback = Nothing

type TerminalResizeWindowCallbackC =
    Ptr () ->                               -- object
    Word32 ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkTerminalResizeWindowCallback :: TerminalResizeWindowCallbackC -> IO (FunPtr TerminalResizeWindowCallbackC)

terminalResizeWindowClosure :: TerminalResizeWindowCallback -> IO Closure
terminalResizeWindowClosure cb = newCClosure =<< mkTerminalResizeWindowCallback wrapped
    where wrapped = terminalResizeWindowCallbackWrapper cb

terminalResizeWindowCallbackWrapper ::
    TerminalResizeWindowCallback ->
    Ptr () ->
    Word32 ->
    Word32 ->
    Ptr () ->
    IO ()
terminalResizeWindowCallbackWrapper _cb _ width height _ = do
    _cb  width height

onTerminalResizeWindow :: (GObject a, MonadIO m) => a -> TerminalResizeWindowCallback -> m SignalHandlerId
onTerminalResizeWindow obj cb = liftIO $ connectTerminalResizeWindow obj cb SignalConnectBefore
afterTerminalResizeWindow :: (GObject a, MonadIO m) => a -> TerminalResizeWindowCallback -> m SignalHandlerId
afterTerminalResizeWindow obj cb = connectTerminalResizeWindow obj cb SignalConnectAfter

connectTerminalResizeWindow :: (GObject a, MonadIO m) =>
                               a -> TerminalResizeWindowCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalResizeWindow obj cb after = liftIO $ do
    cb' <- mkTerminalResizeWindowCallback (terminalResizeWindowCallbackWrapper cb)
    connectSignalFunPtr obj "resize-window" cb' after

-- signal Terminal::restore-window
type TerminalRestoreWindowCallback =
    IO ()

noTerminalRestoreWindowCallback :: Maybe TerminalRestoreWindowCallback
noTerminalRestoreWindowCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalRestoreWindowCallback :: TerminalRestoreWindowCallbackC -> IO (FunPtr TerminalRestoreWindowCallbackC)

terminalRestoreWindowClosure :: TerminalRestoreWindowCallback -> IO Closure
terminalRestoreWindowClosure cb = newCClosure =<< mkTerminalRestoreWindowCallback wrapped
    where wrapped = terminalRestoreWindowCallbackWrapper cb

terminalRestoreWindowCallbackWrapper ::
    TerminalRestoreWindowCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalRestoreWindowCallbackWrapper _cb _ _ = do
    _cb 

onTerminalRestoreWindow :: (GObject a, MonadIO m) => a -> TerminalRestoreWindowCallback -> m SignalHandlerId
onTerminalRestoreWindow obj cb = liftIO $ connectTerminalRestoreWindow obj cb SignalConnectBefore
afterTerminalRestoreWindow :: (GObject a, MonadIO m) => a -> TerminalRestoreWindowCallback -> m SignalHandlerId
afterTerminalRestoreWindow obj cb = connectTerminalRestoreWindow obj cb SignalConnectAfter

connectTerminalRestoreWindow :: (GObject a, MonadIO m) =>
                                a -> TerminalRestoreWindowCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalRestoreWindow obj cb after = liftIO $ do
    cb' <- mkTerminalRestoreWindowCallback (terminalRestoreWindowCallbackWrapper cb)
    connectSignalFunPtr obj "restore-window" cb' after

-- signal Terminal::selection-changed
type TerminalSelectionChangedCallback =
    IO ()

noTerminalSelectionChangedCallback :: Maybe TerminalSelectionChangedCallback
noTerminalSelectionChangedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalSelectionChangedCallback :: TerminalSelectionChangedCallbackC -> IO (FunPtr TerminalSelectionChangedCallbackC)

terminalSelectionChangedClosure :: TerminalSelectionChangedCallback -> IO Closure
terminalSelectionChangedClosure cb = newCClosure =<< mkTerminalSelectionChangedCallback wrapped
    where wrapped = terminalSelectionChangedCallbackWrapper cb

terminalSelectionChangedCallbackWrapper ::
    TerminalSelectionChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalSelectionChangedCallbackWrapper _cb _ _ = do
    _cb 

onTerminalSelectionChanged :: (GObject a, MonadIO m) => a -> TerminalSelectionChangedCallback -> m SignalHandlerId
onTerminalSelectionChanged obj cb = liftIO $ connectTerminalSelectionChanged obj cb SignalConnectBefore
afterTerminalSelectionChanged :: (GObject a, MonadIO m) => a -> TerminalSelectionChangedCallback -> m SignalHandlerId
afterTerminalSelectionChanged obj cb = connectTerminalSelectionChanged obj cb SignalConnectAfter

connectTerminalSelectionChanged :: (GObject a, MonadIO m) =>
                                   a -> TerminalSelectionChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalSelectionChanged obj cb after = liftIO $ do
    cb' <- mkTerminalSelectionChangedCallback (terminalSelectionChangedCallbackWrapper cb)
    connectSignalFunPtr obj "selection-changed" cb' after

-- signal Terminal::text-deleted
type TerminalTextDeletedCallback =
    IO ()

noTerminalTextDeletedCallback :: Maybe TerminalTextDeletedCallback
noTerminalTextDeletedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalTextDeletedCallback :: TerminalTextDeletedCallbackC -> IO (FunPtr TerminalTextDeletedCallbackC)

terminalTextDeletedClosure :: TerminalTextDeletedCallback -> IO Closure
terminalTextDeletedClosure cb = newCClosure =<< mkTerminalTextDeletedCallback wrapped
    where wrapped = terminalTextDeletedCallbackWrapper cb

terminalTextDeletedCallbackWrapper ::
    TerminalTextDeletedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalTextDeletedCallbackWrapper _cb _ _ = do
    _cb 

onTerminalTextDeleted :: (GObject a, MonadIO m) => a -> TerminalTextDeletedCallback -> m SignalHandlerId
onTerminalTextDeleted obj cb = liftIO $ connectTerminalTextDeleted obj cb SignalConnectBefore
afterTerminalTextDeleted :: (GObject a, MonadIO m) => a -> TerminalTextDeletedCallback -> m SignalHandlerId
afterTerminalTextDeleted obj cb = connectTerminalTextDeleted obj cb SignalConnectAfter

connectTerminalTextDeleted :: (GObject a, MonadIO m) =>
                              a -> TerminalTextDeletedCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalTextDeleted obj cb after = liftIO $ do
    cb' <- mkTerminalTextDeletedCallback (terminalTextDeletedCallbackWrapper cb)
    connectSignalFunPtr obj "text-deleted" cb' after

-- signal Terminal::text-inserted
type TerminalTextInsertedCallback =
    IO ()

noTerminalTextInsertedCallback :: Maybe TerminalTextInsertedCallback
noTerminalTextInsertedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalTextInsertedCallback :: TerminalTextInsertedCallbackC -> IO (FunPtr TerminalTextInsertedCallbackC)

terminalTextInsertedClosure :: TerminalTextInsertedCallback -> IO Closure
terminalTextInsertedClosure cb = newCClosure =<< mkTerminalTextInsertedCallback wrapped
    where wrapped = terminalTextInsertedCallbackWrapper cb

terminalTextInsertedCallbackWrapper ::
    TerminalTextInsertedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalTextInsertedCallbackWrapper _cb _ _ = do
    _cb 

onTerminalTextInserted :: (GObject a, MonadIO m) => a -> TerminalTextInsertedCallback -> m SignalHandlerId
onTerminalTextInserted obj cb = liftIO $ connectTerminalTextInserted obj cb SignalConnectBefore
afterTerminalTextInserted :: (GObject a, MonadIO m) => a -> TerminalTextInsertedCallback -> m SignalHandlerId
afterTerminalTextInserted obj cb = connectTerminalTextInserted obj cb SignalConnectAfter

connectTerminalTextInserted :: (GObject a, MonadIO m) =>
                               a -> TerminalTextInsertedCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalTextInserted obj cb after = liftIO $ do
    cb' <- mkTerminalTextInsertedCallback (terminalTextInsertedCallbackWrapper cb)
    connectSignalFunPtr obj "text-inserted" cb' after

-- signal Terminal::text-modified
type TerminalTextModifiedCallback =
    IO ()

noTerminalTextModifiedCallback :: Maybe TerminalTextModifiedCallback
noTerminalTextModifiedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalTextModifiedCallback :: TerminalTextModifiedCallbackC -> IO (FunPtr TerminalTextModifiedCallbackC)

terminalTextModifiedClosure :: TerminalTextModifiedCallback -> IO Closure
terminalTextModifiedClosure cb = newCClosure =<< mkTerminalTextModifiedCallback wrapped
    where wrapped = terminalTextModifiedCallbackWrapper cb

terminalTextModifiedCallbackWrapper ::
    TerminalTextModifiedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalTextModifiedCallbackWrapper _cb _ _ = do
    _cb 

onTerminalTextModified :: (GObject a, MonadIO m) => a -> TerminalTextModifiedCallback -> m SignalHandlerId
onTerminalTextModified obj cb = liftIO $ connectTerminalTextModified obj cb SignalConnectBefore
afterTerminalTextModified :: (GObject a, MonadIO m) => a -> TerminalTextModifiedCallback -> m SignalHandlerId
afterTerminalTextModified obj cb = connectTerminalTextModified obj cb SignalConnectAfter

connectTerminalTextModified :: (GObject a, MonadIO m) =>
                               a -> TerminalTextModifiedCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalTextModified obj cb after = liftIO $ do
    cb' <- mkTerminalTextModifiedCallback (terminalTextModifiedCallbackWrapper cb)
    connectSignalFunPtr obj "text-modified" cb' after

-- signal Terminal::text-scrolled
type TerminalTextScrolledCallback =
    Int32 ->
    IO ()

noTerminalTextScrolledCallback :: Maybe TerminalTextScrolledCallback
noTerminalTextScrolledCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalTextScrolledCallback :: TerminalTextScrolledCallbackC -> IO (FunPtr TerminalTextScrolledCallbackC)

terminalTextScrolledClosure :: TerminalTextScrolledCallback -> IO Closure
terminalTextScrolledClosure cb = newCClosure =<< mkTerminalTextScrolledCallback wrapped
    where wrapped = terminalTextScrolledCallbackWrapper cb

terminalTextScrolledCallbackWrapper ::
    TerminalTextScrolledCallback ->
    Ptr () ->
    Int32 ->
    Ptr () ->
    IO ()
terminalTextScrolledCallbackWrapper _cb _ delta _ = do
    _cb  delta

onTerminalTextScrolled :: (GObject a, MonadIO m) => a -> TerminalTextScrolledCallback -> m SignalHandlerId
onTerminalTextScrolled obj cb = liftIO $ connectTerminalTextScrolled obj cb SignalConnectBefore
afterTerminalTextScrolled :: (GObject a, MonadIO m) => a -> TerminalTextScrolledCallback -> m SignalHandlerId
afterTerminalTextScrolled obj cb = connectTerminalTextScrolled obj cb SignalConnectAfter

connectTerminalTextScrolled :: (GObject a, MonadIO m) =>
                               a -> TerminalTextScrolledCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalTextScrolled obj cb after = liftIO $ do
    cb' <- mkTerminalTextScrolledCallback (terminalTextScrolledCallbackWrapper cb)
    connectSignalFunPtr obj "text-scrolled" cb' after

-- signal Terminal::window-title-changed
type TerminalWindowTitleChangedCallback =
    IO ()

noTerminalWindowTitleChangedCallback :: Maybe TerminalWindowTitleChangedCallback
noTerminalWindowTitleChangedCallback = Nothing

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

foreign import ccall "wrapper"
    mkTerminalWindowTitleChangedCallback :: TerminalWindowTitleChangedCallbackC -> IO (FunPtr TerminalWindowTitleChangedCallbackC)

terminalWindowTitleChangedClosure :: TerminalWindowTitleChangedCallback -> IO Closure
terminalWindowTitleChangedClosure cb = newCClosure =<< mkTerminalWindowTitleChangedCallback wrapped
    where wrapped = terminalWindowTitleChangedCallbackWrapper cb

terminalWindowTitleChangedCallbackWrapper ::
    TerminalWindowTitleChangedCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
terminalWindowTitleChangedCallbackWrapper _cb _ _ = do
    _cb 

onTerminalWindowTitleChanged :: (GObject a, MonadIO m) => a -> TerminalWindowTitleChangedCallback -> m SignalHandlerId
onTerminalWindowTitleChanged obj cb = liftIO $ connectTerminalWindowTitleChanged obj cb SignalConnectBefore
afterTerminalWindowTitleChanged :: (GObject a, MonadIO m) => a -> TerminalWindowTitleChangedCallback -> m SignalHandlerId
afterTerminalWindowTitleChanged obj cb = connectTerminalWindowTitleChanged obj cb SignalConnectAfter

connectTerminalWindowTitleChanged :: (GObject a, MonadIO m) =>
                                     a -> TerminalWindowTitleChangedCallback -> SignalConnectMode -> m SignalHandlerId
connectTerminalWindowTitleChanged obj cb after = liftIO $ do
    cb' <- mkTerminalWindowTitleChangedCallback (terminalWindowTitleChangedCallbackWrapper cb)
    connectSignalFunPtr obj "window-title-changed" cb' after

-- VVV Prop "allow-bold"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalAllowBold :: (MonadIO m, TerminalK o) => o -> m Bool
getTerminalAllowBold obj = liftIO $ getObjectPropertyBool obj "allow-bold"

setTerminalAllowBold :: (MonadIO m, TerminalK o) => o -> Bool -> m ()
setTerminalAllowBold obj val = liftIO $ setObjectPropertyBool obj "allow-bold" val

constructTerminalAllowBold :: Bool -> IO ([Char], GValue)
constructTerminalAllowBold val = constructObjectPropertyBool "allow-bold" val

data TerminalAllowBoldPropertyInfo
instance AttrInfo TerminalAllowBoldPropertyInfo where
    type AttrAllowedOps TerminalAllowBoldPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalAllowBoldPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint TerminalAllowBoldPropertyInfo = TerminalK
    type AttrGetType TerminalAllowBoldPropertyInfo = Bool
    type AttrLabel TerminalAllowBoldPropertyInfo = "Terminal::allow-bold"
    attrGet _ = getTerminalAllowBold
    attrSet _ = setTerminalAllowBold
    attrConstruct _ = constructTerminalAllowBold

-- VVV Prop "audible-bell"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalAudibleBell :: (MonadIO m, TerminalK o) => o -> m Bool
getTerminalAudibleBell obj = liftIO $ getObjectPropertyBool obj "audible-bell"

setTerminalAudibleBell :: (MonadIO m, TerminalK o) => o -> Bool -> m ()
setTerminalAudibleBell obj val = liftIO $ setObjectPropertyBool obj "audible-bell" val

constructTerminalAudibleBell :: Bool -> IO ([Char], GValue)
constructTerminalAudibleBell val = constructObjectPropertyBool "audible-bell" val

data TerminalAudibleBellPropertyInfo
instance AttrInfo TerminalAudibleBellPropertyInfo where
    type AttrAllowedOps TerminalAudibleBellPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalAudibleBellPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint TerminalAudibleBellPropertyInfo = TerminalK
    type AttrGetType TerminalAudibleBellPropertyInfo = Bool
    type AttrLabel TerminalAudibleBellPropertyInfo = "Terminal::audible-bell"
    attrGet _ = getTerminalAudibleBell
    attrSet _ = setTerminalAudibleBell
    attrConstruct _ = constructTerminalAudibleBell

-- VVV Prop "backspace-binding"
   -- Type: TInterface "Vte" "EraseBinding"
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalBackspaceBinding :: (MonadIO m, TerminalK o) => o -> m EraseBinding
getTerminalBackspaceBinding obj = liftIO $ getObjectPropertyEnum obj "backspace-binding"

setTerminalBackspaceBinding :: (MonadIO m, TerminalK o) => o -> EraseBinding -> m ()
setTerminalBackspaceBinding obj val = liftIO $ setObjectPropertyEnum obj "backspace-binding" val

constructTerminalBackspaceBinding :: EraseBinding -> IO ([Char], GValue)
constructTerminalBackspaceBinding val = constructObjectPropertyEnum "backspace-binding" val

data TerminalBackspaceBindingPropertyInfo
instance AttrInfo TerminalBackspaceBindingPropertyInfo where
    type AttrAllowedOps TerminalBackspaceBindingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalBackspaceBindingPropertyInfo = (~) EraseBinding
    type AttrBaseTypeConstraint TerminalBackspaceBindingPropertyInfo = TerminalK
    type AttrGetType TerminalBackspaceBindingPropertyInfo = EraseBinding
    type AttrLabel TerminalBackspaceBindingPropertyInfo = "Terminal::backspace-binding"
    attrGet _ = getTerminalBackspaceBinding
    attrSet _ = setTerminalBackspaceBinding
    attrConstruct _ = constructTerminalBackspaceBinding

-- VVV Prop "cjk-ambiguous-width"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalCjkAmbiguousWidth :: (MonadIO m, TerminalK o) => o -> m Int32
getTerminalCjkAmbiguousWidth obj = liftIO $ getObjectPropertyCInt obj "cjk-ambiguous-width"

setTerminalCjkAmbiguousWidth :: (MonadIO m, TerminalK o) => o -> Int32 -> m ()
setTerminalCjkAmbiguousWidth obj val = liftIO $ setObjectPropertyCInt obj "cjk-ambiguous-width" val

constructTerminalCjkAmbiguousWidth :: Int32 -> IO ([Char], GValue)
constructTerminalCjkAmbiguousWidth val = constructObjectPropertyCInt "cjk-ambiguous-width" val

data TerminalCjkAmbiguousWidthPropertyInfo
instance AttrInfo TerminalCjkAmbiguousWidthPropertyInfo where
    type AttrAllowedOps TerminalCjkAmbiguousWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalCjkAmbiguousWidthPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint TerminalCjkAmbiguousWidthPropertyInfo = TerminalK
    type AttrGetType TerminalCjkAmbiguousWidthPropertyInfo = Int32
    type AttrLabel TerminalCjkAmbiguousWidthPropertyInfo = "Terminal::cjk-ambiguous-width"
    attrGet _ = getTerminalCjkAmbiguousWidth
    attrSet _ = setTerminalCjkAmbiguousWidth
    attrConstruct _ = constructTerminalCjkAmbiguousWidth

-- VVV Prop "current-directory-uri"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]

getTerminalCurrentDirectoryUri :: (MonadIO m, TerminalK o) => o -> m T.Text
getTerminalCurrentDirectoryUri obj = liftIO $ getObjectPropertyString obj "current-directory-uri"

data TerminalCurrentDirectoryUriPropertyInfo
instance AttrInfo TerminalCurrentDirectoryUriPropertyInfo where
    type AttrAllowedOps TerminalCurrentDirectoryUriPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint TerminalCurrentDirectoryUriPropertyInfo = (~) ()
    type AttrBaseTypeConstraint TerminalCurrentDirectoryUriPropertyInfo = TerminalK
    type AttrGetType TerminalCurrentDirectoryUriPropertyInfo = T.Text
    type AttrLabel TerminalCurrentDirectoryUriPropertyInfo = "Terminal::current-directory-uri"
    attrGet _ = getTerminalCurrentDirectoryUri
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "current-file-uri"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]

getTerminalCurrentFileUri :: (MonadIO m, TerminalK o) => o -> m T.Text
getTerminalCurrentFileUri obj = liftIO $ getObjectPropertyString obj "current-file-uri"

data TerminalCurrentFileUriPropertyInfo
instance AttrInfo TerminalCurrentFileUriPropertyInfo where
    type AttrAllowedOps TerminalCurrentFileUriPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint TerminalCurrentFileUriPropertyInfo = (~) ()
    type AttrBaseTypeConstraint TerminalCurrentFileUriPropertyInfo = TerminalK
    type AttrGetType TerminalCurrentFileUriPropertyInfo = T.Text
    type AttrLabel TerminalCurrentFileUriPropertyInfo = "Terminal::current-file-uri"
    attrGet _ = getTerminalCurrentFileUri
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "cursor-blink-mode"
   -- Type: TInterface "Vte" "CursorBlinkMode"
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalCursorBlinkMode :: (MonadIO m, TerminalK o) => o -> m CursorBlinkMode
getTerminalCursorBlinkMode obj = liftIO $ getObjectPropertyEnum obj "cursor-blink-mode"

setTerminalCursorBlinkMode :: (MonadIO m, TerminalK o) => o -> CursorBlinkMode -> m ()
setTerminalCursorBlinkMode obj val = liftIO $ setObjectPropertyEnum obj "cursor-blink-mode" val

constructTerminalCursorBlinkMode :: CursorBlinkMode -> IO ([Char], GValue)
constructTerminalCursorBlinkMode val = constructObjectPropertyEnum "cursor-blink-mode" val

data TerminalCursorBlinkModePropertyInfo
instance AttrInfo TerminalCursorBlinkModePropertyInfo where
    type AttrAllowedOps TerminalCursorBlinkModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalCursorBlinkModePropertyInfo = (~) CursorBlinkMode
    type AttrBaseTypeConstraint TerminalCursorBlinkModePropertyInfo = TerminalK
    type AttrGetType TerminalCursorBlinkModePropertyInfo = CursorBlinkMode
    type AttrLabel TerminalCursorBlinkModePropertyInfo = "Terminal::cursor-blink-mode"
    attrGet _ = getTerminalCursorBlinkMode
    attrSet _ = setTerminalCursorBlinkMode
    attrConstruct _ = constructTerminalCursorBlinkMode

-- VVV Prop "cursor-shape"
   -- Type: TInterface "Vte" "CursorShape"
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalCursorShape :: (MonadIO m, TerminalK o) => o -> m CursorShape
getTerminalCursorShape obj = liftIO $ getObjectPropertyEnum obj "cursor-shape"

setTerminalCursorShape :: (MonadIO m, TerminalK o) => o -> CursorShape -> m ()
setTerminalCursorShape obj val = liftIO $ setObjectPropertyEnum obj "cursor-shape" val

constructTerminalCursorShape :: CursorShape -> IO ([Char], GValue)
constructTerminalCursorShape val = constructObjectPropertyEnum "cursor-shape" val

data TerminalCursorShapePropertyInfo
instance AttrInfo TerminalCursorShapePropertyInfo where
    type AttrAllowedOps TerminalCursorShapePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalCursorShapePropertyInfo = (~) CursorShape
    type AttrBaseTypeConstraint TerminalCursorShapePropertyInfo = TerminalK
    type AttrGetType TerminalCursorShapePropertyInfo = CursorShape
    type AttrLabel TerminalCursorShapePropertyInfo = "Terminal::cursor-shape"
    attrGet _ = getTerminalCursorShape
    attrSet _ = setTerminalCursorShape
    attrConstruct _ = constructTerminalCursorShape

-- VVV Prop "delete-binding"
   -- Type: TInterface "Vte" "EraseBinding"
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalDeleteBinding :: (MonadIO m, TerminalK o) => o -> m EraseBinding
getTerminalDeleteBinding obj = liftIO $ getObjectPropertyEnum obj "delete-binding"

setTerminalDeleteBinding :: (MonadIO m, TerminalK o) => o -> EraseBinding -> m ()
setTerminalDeleteBinding obj val = liftIO $ setObjectPropertyEnum obj "delete-binding" val

constructTerminalDeleteBinding :: EraseBinding -> IO ([Char], GValue)
constructTerminalDeleteBinding val = constructObjectPropertyEnum "delete-binding" val

data TerminalDeleteBindingPropertyInfo
instance AttrInfo TerminalDeleteBindingPropertyInfo where
    type AttrAllowedOps TerminalDeleteBindingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalDeleteBindingPropertyInfo = (~) EraseBinding
    type AttrBaseTypeConstraint TerminalDeleteBindingPropertyInfo = TerminalK
    type AttrGetType TerminalDeleteBindingPropertyInfo = EraseBinding
    type AttrLabel TerminalDeleteBindingPropertyInfo = "Terminal::delete-binding"
    attrGet _ = getTerminalDeleteBinding
    attrSet _ = setTerminalDeleteBinding
    attrConstruct _ = constructTerminalDeleteBinding

-- VVV Prop "encoding"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalEncoding :: (MonadIO m, TerminalK o) => o -> m T.Text
getTerminalEncoding obj = liftIO $ getObjectPropertyString obj "encoding"

setTerminalEncoding :: (MonadIO m, TerminalK o) => o -> T.Text -> m ()
setTerminalEncoding obj val = liftIO $ setObjectPropertyString obj "encoding" val

constructTerminalEncoding :: T.Text -> IO ([Char], GValue)
constructTerminalEncoding val = constructObjectPropertyString "encoding" val

data TerminalEncodingPropertyInfo
instance AttrInfo TerminalEncodingPropertyInfo where
    type AttrAllowedOps TerminalEncodingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalEncodingPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint TerminalEncodingPropertyInfo = TerminalK
    type AttrGetType TerminalEncodingPropertyInfo = T.Text
    type AttrLabel TerminalEncodingPropertyInfo = "Terminal::encoding"
    attrGet _ = getTerminalEncoding
    attrSet _ = setTerminalEncoding
    attrConstruct _ = constructTerminalEncoding

-- VVV Prop "font-desc"
   -- Type: TInterface "Pango" "FontDescription"
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalFontDesc :: (MonadIO m, TerminalK o) => o -> m Pango.FontDescription
getTerminalFontDesc obj = liftIO $ getObjectPropertyBoxed obj "font-desc" Pango.FontDescription

setTerminalFontDesc :: (MonadIO m, TerminalK o) => o -> Pango.FontDescription -> m ()
setTerminalFontDesc obj val = liftIO $ setObjectPropertyBoxed obj "font-desc" val

constructTerminalFontDesc :: Pango.FontDescription -> IO ([Char], GValue)
constructTerminalFontDesc val = constructObjectPropertyBoxed "font-desc" val

data TerminalFontDescPropertyInfo
instance AttrInfo TerminalFontDescPropertyInfo where
    type AttrAllowedOps TerminalFontDescPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalFontDescPropertyInfo = (~) Pango.FontDescription
    type AttrBaseTypeConstraint TerminalFontDescPropertyInfo = TerminalK
    type AttrGetType TerminalFontDescPropertyInfo = Pango.FontDescription
    type AttrLabel TerminalFontDescPropertyInfo = "Terminal::font-desc"
    attrGet _ = getTerminalFontDesc
    attrSet _ = setTerminalFontDesc
    attrConstruct _ = constructTerminalFontDesc

-- VVV Prop "font-scale"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalFontScale :: (MonadIO m, TerminalK o) => o -> m Double
getTerminalFontScale obj = liftIO $ getObjectPropertyDouble obj "font-scale"

setTerminalFontScale :: (MonadIO m, TerminalK o) => o -> Double -> m ()
setTerminalFontScale obj val = liftIO $ setObjectPropertyDouble obj "font-scale" val

constructTerminalFontScale :: Double -> IO ([Char], GValue)
constructTerminalFontScale val = constructObjectPropertyDouble "font-scale" val

data TerminalFontScalePropertyInfo
instance AttrInfo TerminalFontScalePropertyInfo where
    type AttrAllowedOps TerminalFontScalePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalFontScalePropertyInfo = (~) Double
    type AttrBaseTypeConstraint TerminalFontScalePropertyInfo = TerminalK
    type AttrGetType TerminalFontScalePropertyInfo = Double
    type AttrLabel TerminalFontScalePropertyInfo = "Terminal::font-scale"
    attrGet _ = getTerminalFontScale
    attrSet _ = setTerminalFontScale
    attrConstruct _ = constructTerminalFontScale

-- VVV Prop "icon-title"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]

getTerminalIconTitle :: (MonadIO m, TerminalK o) => o -> m T.Text
getTerminalIconTitle obj = liftIO $ getObjectPropertyString obj "icon-title"

data TerminalIconTitlePropertyInfo
instance AttrInfo TerminalIconTitlePropertyInfo where
    type AttrAllowedOps TerminalIconTitlePropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint TerminalIconTitlePropertyInfo = (~) ()
    type AttrBaseTypeConstraint TerminalIconTitlePropertyInfo = TerminalK
    type AttrGetType TerminalIconTitlePropertyInfo = T.Text
    type AttrLabel TerminalIconTitlePropertyInfo = "Terminal::icon-title"
    attrGet _ = getTerminalIconTitle
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "input-enabled"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalInputEnabled :: (MonadIO m, TerminalK o) => o -> m Bool
getTerminalInputEnabled obj = liftIO $ getObjectPropertyBool obj "input-enabled"

setTerminalInputEnabled :: (MonadIO m, TerminalK o) => o -> Bool -> m ()
setTerminalInputEnabled obj val = liftIO $ setObjectPropertyBool obj "input-enabled" val

constructTerminalInputEnabled :: Bool -> IO ([Char], GValue)
constructTerminalInputEnabled val = constructObjectPropertyBool "input-enabled" val

data TerminalInputEnabledPropertyInfo
instance AttrInfo TerminalInputEnabledPropertyInfo where
    type AttrAllowedOps TerminalInputEnabledPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalInputEnabledPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint TerminalInputEnabledPropertyInfo = TerminalK
    type AttrGetType TerminalInputEnabledPropertyInfo = Bool
    type AttrLabel TerminalInputEnabledPropertyInfo = "Terminal::input-enabled"
    attrGet _ = getTerminalInputEnabled
    attrSet _ = setTerminalInputEnabled
    attrConstruct _ = constructTerminalInputEnabled

-- VVV Prop "pointer-autohide"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalPointerAutohide :: (MonadIO m, TerminalK o) => o -> m Bool
getTerminalPointerAutohide obj = liftIO $ getObjectPropertyBool obj "pointer-autohide"

setTerminalPointerAutohide :: (MonadIO m, TerminalK o) => o -> Bool -> m ()
setTerminalPointerAutohide obj val = liftIO $ setObjectPropertyBool obj "pointer-autohide" val

constructTerminalPointerAutohide :: Bool -> IO ([Char], GValue)
constructTerminalPointerAutohide val = constructObjectPropertyBool "pointer-autohide" val

data TerminalPointerAutohidePropertyInfo
instance AttrInfo TerminalPointerAutohidePropertyInfo where
    type AttrAllowedOps TerminalPointerAutohidePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalPointerAutohidePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint TerminalPointerAutohidePropertyInfo = TerminalK
    type AttrGetType TerminalPointerAutohidePropertyInfo = Bool
    type AttrLabel TerminalPointerAutohidePropertyInfo = "Terminal::pointer-autohide"
    attrGet _ = getTerminalPointerAutohide
    attrSet _ = setTerminalPointerAutohide
    attrConstruct _ = constructTerminalPointerAutohide

-- VVV Prop "pty"
   -- Type: TInterface "Vte" "Pty"
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalPty :: (MonadIO m, TerminalK o) => o -> m Pty
getTerminalPty obj = liftIO $ getObjectPropertyObject obj "pty" Pty

setTerminalPty :: (MonadIO m, TerminalK o, PtyK a) => o -> a -> m ()
setTerminalPty obj val = liftIO $ setObjectPropertyObject obj "pty" val

constructTerminalPty :: (PtyK a) => a -> IO ([Char], GValue)
constructTerminalPty val = constructObjectPropertyObject "pty" val

data TerminalPtyPropertyInfo
instance AttrInfo TerminalPtyPropertyInfo where
    type AttrAllowedOps TerminalPtyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalPtyPropertyInfo = PtyK
    type AttrBaseTypeConstraint TerminalPtyPropertyInfo = TerminalK
    type AttrGetType TerminalPtyPropertyInfo = Pty
    type AttrLabel TerminalPtyPropertyInfo = "Terminal::pty"
    attrGet _ = getTerminalPty
    attrSet _ = setTerminalPty
    attrConstruct _ = constructTerminalPty

-- VVV Prop "rewrap-on-resize"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalRewrapOnResize :: (MonadIO m, TerminalK o) => o -> m Bool
getTerminalRewrapOnResize obj = liftIO $ getObjectPropertyBool obj "rewrap-on-resize"

setTerminalRewrapOnResize :: (MonadIO m, TerminalK o) => o -> Bool -> m ()
setTerminalRewrapOnResize obj val = liftIO $ setObjectPropertyBool obj "rewrap-on-resize" val

constructTerminalRewrapOnResize :: Bool -> IO ([Char], GValue)
constructTerminalRewrapOnResize val = constructObjectPropertyBool "rewrap-on-resize" val

data TerminalRewrapOnResizePropertyInfo
instance AttrInfo TerminalRewrapOnResizePropertyInfo where
    type AttrAllowedOps TerminalRewrapOnResizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalRewrapOnResizePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint TerminalRewrapOnResizePropertyInfo = TerminalK
    type AttrGetType TerminalRewrapOnResizePropertyInfo = Bool
    type AttrLabel TerminalRewrapOnResizePropertyInfo = "Terminal::rewrap-on-resize"
    attrGet _ = getTerminalRewrapOnResize
    attrSet _ = setTerminalRewrapOnResize
    attrConstruct _ = constructTerminalRewrapOnResize

-- VVV Prop "scroll-on-keystroke"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalScrollOnKeystroke :: (MonadIO m, TerminalK o) => o -> m Bool
getTerminalScrollOnKeystroke obj = liftIO $ getObjectPropertyBool obj "scroll-on-keystroke"

setTerminalScrollOnKeystroke :: (MonadIO m, TerminalK o) => o -> Bool -> m ()
setTerminalScrollOnKeystroke obj val = liftIO $ setObjectPropertyBool obj "scroll-on-keystroke" val

constructTerminalScrollOnKeystroke :: Bool -> IO ([Char], GValue)
constructTerminalScrollOnKeystroke val = constructObjectPropertyBool "scroll-on-keystroke" val

data TerminalScrollOnKeystrokePropertyInfo
instance AttrInfo TerminalScrollOnKeystrokePropertyInfo where
    type AttrAllowedOps TerminalScrollOnKeystrokePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalScrollOnKeystrokePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint TerminalScrollOnKeystrokePropertyInfo = TerminalK
    type AttrGetType TerminalScrollOnKeystrokePropertyInfo = Bool
    type AttrLabel TerminalScrollOnKeystrokePropertyInfo = "Terminal::scroll-on-keystroke"
    attrGet _ = getTerminalScrollOnKeystroke
    attrSet _ = setTerminalScrollOnKeystroke
    attrConstruct _ = constructTerminalScrollOnKeystroke

-- VVV Prop "scroll-on-output"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalScrollOnOutput :: (MonadIO m, TerminalK o) => o -> m Bool
getTerminalScrollOnOutput obj = liftIO $ getObjectPropertyBool obj "scroll-on-output"

setTerminalScrollOnOutput :: (MonadIO m, TerminalK o) => o -> Bool -> m ()
setTerminalScrollOnOutput obj val = liftIO $ setObjectPropertyBool obj "scroll-on-output" val

constructTerminalScrollOnOutput :: Bool -> IO ([Char], GValue)
constructTerminalScrollOnOutput val = constructObjectPropertyBool "scroll-on-output" val

data TerminalScrollOnOutputPropertyInfo
instance AttrInfo TerminalScrollOnOutputPropertyInfo where
    type AttrAllowedOps TerminalScrollOnOutputPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalScrollOnOutputPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint TerminalScrollOnOutputPropertyInfo = TerminalK
    type AttrGetType TerminalScrollOnOutputPropertyInfo = Bool
    type AttrLabel TerminalScrollOnOutputPropertyInfo = "Terminal::scroll-on-output"
    attrGet _ = getTerminalScrollOnOutput
    attrSet _ = setTerminalScrollOnOutput
    attrConstruct _ = constructTerminalScrollOnOutput

-- VVV Prop "scrollback-lines"
   -- Type: TBasicType TUInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getTerminalScrollbackLines :: (MonadIO m, TerminalK o) => o -> m Word32
getTerminalScrollbackLines obj = liftIO $ getObjectPropertyCUInt obj "scrollback-lines"

setTerminalScrollbackLines :: (MonadIO m, TerminalK o) => o -> Word32 -> m ()
setTerminalScrollbackLines obj val = liftIO $ setObjectPropertyCUInt obj "scrollback-lines" val

constructTerminalScrollbackLines :: Word32 -> IO ([Char], GValue)
constructTerminalScrollbackLines val = constructObjectPropertyCUInt "scrollback-lines" val

data TerminalScrollbackLinesPropertyInfo
instance AttrInfo TerminalScrollbackLinesPropertyInfo where
    type AttrAllowedOps TerminalScrollbackLinesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint TerminalScrollbackLinesPropertyInfo = (~) Word32
    type AttrBaseTypeConstraint TerminalScrollbackLinesPropertyInfo = TerminalK
    type AttrGetType TerminalScrollbackLinesPropertyInfo = Word32
    type AttrLabel TerminalScrollbackLinesPropertyInfo = "Terminal::scrollback-lines"
    attrGet _ = getTerminalScrollbackLines
    attrSet _ = setTerminalScrollbackLines
    attrConstruct _ = constructTerminalScrollbackLines

-- VVV Prop "window-title"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]

getTerminalWindowTitle :: (MonadIO m, TerminalK o) => o -> m T.Text
getTerminalWindowTitle obj = liftIO $ getObjectPropertyString obj "window-title"

data TerminalWindowTitlePropertyInfo
instance AttrInfo TerminalWindowTitlePropertyInfo where
    type AttrAllowedOps TerminalWindowTitlePropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint TerminalWindowTitlePropertyInfo = (~) ()
    type AttrBaseTypeConstraint TerminalWindowTitlePropertyInfo = TerminalK
    type AttrGetType TerminalWindowTitlePropertyInfo = T.Text
    type AttrLabel TerminalWindowTitlePropertyInfo = "Terminal::window-title"
    attrGet _ = getTerminalWindowTitle
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "word-char-exceptions"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]

getTerminalWordCharExceptions :: (MonadIO m, TerminalK o) => o -> m T.Text
getTerminalWordCharExceptions obj = liftIO $ getObjectPropertyString obj "word-char-exceptions"

data TerminalWordCharExceptionsPropertyInfo
instance AttrInfo TerminalWordCharExceptionsPropertyInfo where
    type AttrAllowedOps TerminalWordCharExceptionsPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint TerminalWordCharExceptionsPropertyInfo = (~) ()
    type AttrBaseTypeConstraint TerminalWordCharExceptionsPropertyInfo = TerminalK
    type AttrGetType TerminalWordCharExceptionsPropertyInfo = T.Text
    type AttrLabel TerminalWordCharExceptionsPropertyInfo = "Terminal::word-char-exceptions"
    attrGet _ = getTerminalWordCharExceptions
    attrSet _ = undefined
    attrConstruct _ = undefined

type instance AttributeList Terminal = TerminalAttributeList
type TerminalAttributeList = ('[ '("allow-bold", TerminalAllowBoldPropertyInfo), '("app-paintable", Gtk.WidgetAppPaintablePropertyInfo), '("audible-bell", TerminalAudibleBellPropertyInfo), '("backspace-binding", TerminalBackspaceBindingPropertyInfo), '("can-default", Gtk.WidgetCanDefaultPropertyInfo), '("can-focus", Gtk.WidgetCanFocusPropertyInfo), '("cjk-ambiguous-width", TerminalCjkAmbiguousWidthPropertyInfo), '("composite-child", Gtk.WidgetCompositeChildPropertyInfo), '("current-directory-uri", TerminalCurrentDirectoryUriPropertyInfo), '("current-file-uri", TerminalCurrentFileUriPropertyInfo), '("cursor-blink-mode", TerminalCursorBlinkModePropertyInfo), '("cursor-shape", TerminalCursorShapePropertyInfo), '("delete-binding", TerminalDeleteBindingPropertyInfo), '("double-buffered", Gtk.WidgetDoubleBufferedPropertyInfo), '("encoding", TerminalEncodingPropertyInfo), '("events", Gtk.WidgetEventsPropertyInfo), '("expand", Gtk.WidgetExpandPropertyInfo), '("font-desc", TerminalFontDescPropertyInfo), '("font-scale", TerminalFontScalePropertyInfo), '("hadjustment", Gtk.ScrollableHadjustmentPropertyInfo), '("halign", Gtk.WidgetHalignPropertyInfo), '("has-default", Gtk.WidgetHasDefaultPropertyInfo), '("has-focus", Gtk.WidgetHasFocusPropertyInfo), '("has-tooltip", Gtk.WidgetHasTooltipPropertyInfo), '("height-request", Gtk.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.WidgetHexpandPropertyInfo), '("hexpand-set", Gtk.WidgetHexpandSetPropertyInfo), '("hscroll-policy", Gtk.ScrollableHscrollPolicyPropertyInfo), '("icon-title", TerminalIconTitlePropertyInfo), '("input-enabled", TerminalInputEnabledPropertyInfo), '("is-focus", Gtk.WidgetIsFocusPropertyInfo), '("margin", Gtk.WidgetMarginPropertyInfo), '("margin-bottom", Gtk.WidgetMarginBottomPropertyInfo), '("margin-end", Gtk.WidgetMarginEndPropertyInfo), '("margin-left", Gtk.WidgetMarginLeftPropertyInfo), '("margin-right", Gtk.WidgetMarginRightPropertyInfo), '("margin-start", Gtk.WidgetMarginStartPropertyInfo), '("margin-top", Gtk.WidgetMarginTopPropertyInfo), '("name", Gtk.WidgetNamePropertyInfo), '("no-show-all", Gtk.WidgetNoShowAllPropertyInfo), '("opacity", Gtk.WidgetOpacityPropertyInfo), '("parent", Gtk.WidgetParentPropertyInfo), '("pointer-autohide", TerminalPointerAutohidePropertyInfo), '("pty", TerminalPtyPropertyInfo), '("receives-default", Gtk.WidgetReceivesDefaultPropertyInfo), '("rewrap-on-resize", TerminalRewrapOnResizePropertyInfo), '("scale-factor", Gtk.WidgetScaleFactorPropertyInfo), '("scroll-on-keystroke", TerminalScrollOnKeystrokePropertyInfo), '("scroll-on-output", TerminalScrollOnOutputPropertyInfo), '("scrollback-lines", TerminalScrollbackLinesPropertyInfo), '("sensitive", Gtk.WidgetSensitivePropertyInfo), '("style", Gtk.WidgetStylePropertyInfo), '("tooltip-markup", Gtk.WidgetTooltipMarkupPropertyInfo), '("tooltip-text", Gtk.WidgetTooltipTextPropertyInfo), '("vadjustment", Gtk.ScrollableVadjustmentPropertyInfo), '("valign", Gtk.WidgetValignPropertyInfo), '("vexpand", Gtk.WidgetVexpandPropertyInfo), '("vexpand-set", Gtk.WidgetVexpandSetPropertyInfo), '("visible", Gtk.WidgetVisiblePropertyInfo), '("vscroll-policy", Gtk.ScrollableVscrollPolicyPropertyInfo), '("width-request", Gtk.WidgetWidthRequestPropertyInfo), '("window", Gtk.WidgetWindowPropertyInfo), '("window-title", TerminalWindowTitlePropertyInfo), '("word-char-exceptions", TerminalWordCharExceptionsPropertyInfo)] :: [(Symbol, *)])

data TerminalBellSignalInfo
instance SignalInfo TerminalBellSignalInfo where
    type HaskellCallbackType TerminalBellSignalInfo = TerminalBellCallback
    connectSignal _ = connectTerminalBell

data TerminalCharSizeChangedSignalInfo
instance SignalInfo TerminalCharSizeChangedSignalInfo where
    type HaskellCallbackType TerminalCharSizeChangedSignalInfo = TerminalCharSizeChangedCallback
    connectSignal _ = connectTerminalCharSizeChanged

data TerminalChildExitedSignalInfo
instance SignalInfo TerminalChildExitedSignalInfo where
    type HaskellCallbackType TerminalChildExitedSignalInfo = TerminalChildExitedCallback
    connectSignal _ = connectTerminalChildExited

data TerminalCommitSignalInfo
instance SignalInfo TerminalCommitSignalInfo where
    type HaskellCallbackType TerminalCommitSignalInfo = TerminalCommitCallback
    connectSignal _ = connectTerminalCommit

data TerminalContentsChangedSignalInfo
instance SignalInfo TerminalContentsChangedSignalInfo where
    type HaskellCallbackType TerminalContentsChangedSignalInfo = TerminalContentsChangedCallback
    connectSignal _ = connectTerminalContentsChanged

data TerminalCopyClipboardSignalInfo
instance SignalInfo TerminalCopyClipboardSignalInfo where
    type HaskellCallbackType TerminalCopyClipboardSignalInfo = TerminalCopyClipboardCallback
    connectSignal _ = connectTerminalCopyClipboard

data TerminalCurrentDirectoryUriChangedSignalInfo
instance SignalInfo TerminalCurrentDirectoryUriChangedSignalInfo where
    type HaskellCallbackType TerminalCurrentDirectoryUriChangedSignalInfo = TerminalCurrentDirectoryUriChangedCallback
    connectSignal _ = connectTerminalCurrentDirectoryUriChanged

data TerminalCurrentFileUriChangedSignalInfo
instance SignalInfo TerminalCurrentFileUriChangedSignalInfo where
    type HaskellCallbackType TerminalCurrentFileUriChangedSignalInfo = TerminalCurrentFileUriChangedCallback
    connectSignal _ = connectTerminalCurrentFileUriChanged

data TerminalCursorMovedSignalInfo
instance SignalInfo TerminalCursorMovedSignalInfo where
    type HaskellCallbackType TerminalCursorMovedSignalInfo = TerminalCursorMovedCallback
    connectSignal _ = connectTerminalCursorMoved

data TerminalDecreaseFontSizeSignalInfo
instance SignalInfo TerminalDecreaseFontSizeSignalInfo where
    type HaskellCallbackType TerminalDecreaseFontSizeSignalInfo = TerminalDecreaseFontSizeCallback
    connectSignal _ = connectTerminalDecreaseFontSize

data TerminalDeiconifyWindowSignalInfo
instance SignalInfo TerminalDeiconifyWindowSignalInfo where
    type HaskellCallbackType TerminalDeiconifyWindowSignalInfo = TerminalDeiconifyWindowCallback
    connectSignal _ = connectTerminalDeiconifyWindow

data TerminalEncodingChangedSignalInfo
instance SignalInfo TerminalEncodingChangedSignalInfo where
    type HaskellCallbackType TerminalEncodingChangedSignalInfo = TerminalEncodingChangedCallback
    connectSignal _ = connectTerminalEncodingChanged

data TerminalEofSignalInfo
instance SignalInfo TerminalEofSignalInfo where
    type HaskellCallbackType TerminalEofSignalInfo = TerminalEofCallback
    connectSignal _ = connectTerminalEof

data TerminalIconTitleChangedSignalInfo
instance SignalInfo TerminalIconTitleChangedSignalInfo where
    type HaskellCallbackType TerminalIconTitleChangedSignalInfo = TerminalIconTitleChangedCallback
    connectSignal _ = connectTerminalIconTitleChanged

data TerminalIconifyWindowSignalInfo
instance SignalInfo TerminalIconifyWindowSignalInfo where
    type HaskellCallbackType TerminalIconifyWindowSignalInfo = TerminalIconifyWindowCallback
    connectSignal _ = connectTerminalIconifyWindow

data TerminalIncreaseFontSizeSignalInfo
instance SignalInfo TerminalIncreaseFontSizeSignalInfo where
    type HaskellCallbackType TerminalIncreaseFontSizeSignalInfo = TerminalIncreaseFontSizeCallback
    connectSignal _ = connectTerminalIncreaseFontSize

data TerminalLowerWindowSignalInfo
instance SignalInfo TerminalLowerWindowSignalInfo where
    type HaskellCallbackType TerminalLowerWindowSignalInfo = TerminalLowerWindowCallback
    connectSignal _ = connectTerminalLowerWindow

data TerminalMaximizeWindowSignalInfo
instance SignalInfo TerminalMaximizeWindowSignalInfo where
    type HaskellCallbackType TerminalMaximizeWindowSignalInfo = TerminalMaximizeWindowCallback
    connectSignal _ = connectTerminalMaximizeWindow

data TerminalMoveWindowSignalInfo
instance SignalInfo TerminalMoveWindowSignalInfo where
    type HaskellCallbackType TerminalMoveWindowSignalInfo = TerminalMoveWindowCallback
    connectSignal _ = connectTerminalMoveWindow

data TerminalNotificationReceivedSignalInfo
instance SignalInfo TerminalNotificationReceivedSignalInfo where
    type HaskellCallbackType TerminalNotificationReceivedSignalInfo = TerminalNotificationReceivedCallback
    connectSignal _ = connectTerminalNotificationReceived

data TerminalPasteClipboardSignalInfo
instance SignalInfo TerminalPasteClipboardSignalInfo where
    type HaskellCallbackType TerminalPasteClipboardSignalInfo = TerminalPasteClipboardCallback
    connectSignal _ = connectTerminalPasteClipboard

data TerminalRaiseWindowSignalInfo
instance SignalInfo TerminalRaiseWindowSignalInfo where
    type HaskellCallbackType TerminalRaiseWindowSignalInfo = TerminalRaiseWindowCallback
    connectSignal _ = connectTerminalRaiseWindow

data TerminalRefreshWindowSignalInfo
instance SignalInfo TerminalRefreshWindowSignalInfo where
    type HaskellCallbackType TerminalRefreshWindowSignalInfo = TerminalRefreshWindowCallback
    connectSignal _ = connectTerminalRefreshWindow

data TerminalResizeWindowSignalInfo
instance SignalInfo TerminalResizeWindowSignalInfo where
    type HaskellCallbackType TerminalResizeWindowSignalInfo = TerminalResizeWindowCallback
    connectSignal _ = connectTerminalResizeWindow

data TerminalRestoreWindowSignalInfo
instance SignalInfo TerminalRestoreWindowSignalInfo where
    type HaskellCallbackType TerminalRestoreWindowSignalInfo = TerminalRestoreWindowCallback
    connectSignal _ = connectTerminalRestoreWindow

data TerminalSelectionChangedSignalInfo
instance SignalInfo TerminalSelectionChangedSignalInfo where
    type HaskellCallbackType TerminalSelectionChangedSignalInfo = TerminalSelectionChangedCallback
    connectSignal _ = connectTerminalSelectionChanged

data TerminalTextDeletedSignalInfo
instance SignalInfo TerminalTextDeletedSignalInfo where
    type HaskellCallbackType TerminalTextDeletedSignalInfo = TerminalTextDeletedCallback
    connectSignal _ = connectTerminalTextDeleted

data TerminalTextInsertedSignalInfo
instance SignalInfo TerminalTextInsertedSignalInfo where
    type HaskellCallbackType TerminalTextInsertedSignalInfo = TerminalTextInsertedCallback
    connectSignal _ = connectTerminalTextInserted

data TerminalTextModifiedSignalInfo
instance SignalInfo TerminalTextModifiedSignalInfo where
    type HaskellCallbackType TerminalTextModifiedSignalInfo = TerminalTextModifiedCallback
    connectSignal _ = connectTerminalTextModified

data TerminalTextScrolledSignalInfo
instance SignalInfo TerminalTextScrolledSignalInfo where
    type HaskellCallbackType TerminalTextScrolledSignalInfo = TerminalTextScrolledCallback
    connectSignal _ = connectTerminalTextScrolled

data TerminalWindowTitleChangedSignalInfo
instance SignalInfo TerminalWindowTitleChangedSignalInfo where
    type HaskellCallbackType TerminalWindowTitleChangedSignalInfo = TerminalWindowTitleChangedCallback
    connectSignal _ = connectTerminalWindowTitleChanged

type instance SignalList Terminal = TerminalSignalList
type TerminalSignalList = ('[ '("accel-closures-changed", Gtk.WidgetAccelClosuresChangedSignalInfo), '("bell", TerminalBellSignalInfo), '("button-press-event", Gtk.WidgetButtonPressEventSignalInfo), '("button-release-event", Gtk.WidgetButtonReleaseEventSignalInfo), '("can-activate-accel", Gtk.WidgetCanActivateAccelSignalInfo), '("char-size-changed", TerminalCharSizeChangedSignalInfo), '("child-exited", TerminalChildExitedSignalInfo), '("child-notify", Gtk.WidgetChildNotifySignalInfo), '("commit", TerminalCommitSignalInfo), '("composited-changed", Gtk.WidgetCompositedChangedSignalInfo), '("configure-event", Gtk.WidgetConfigureEventSignalInfo), '("contents-changed", TerminalContentsChangedSignalInfo), '("copy-clipboard", TerminalCopyClipboardSignalInfo), '("current-directory-uri-changed", TerminalCurrentDirectoryUriChangedSignalInfo), '("current-file-uri-changed", TerminalCurrentFileUriChangedSignalInfo), '("cursor-moved", TerminalCursorMovedSignalInfo), '("damage-event", Gtk.WidgetDamageEventSignalInfo), '("decrease-font-size", TerminalDecreaseFontSizeSignalInfo), '("deiconify-window", TerminalDeiconifyWindowSignalInfo), '("delete-event", Gtk.WidgetDeleteEventSignalInfo), '("destroy", Gtk.WidgetDestroySignalInfo), '("destroy-event", Gtk.WidgetDestroyEventSignalInfo), '("direction-changed", Gtk.WidgetDirectionChangedSignalInfo), '("drag-begin", Gtk.WidgetDragBeginSignalInfo), '("drag-data-delete", Gtk.WidgetDragDataDeleteSignalInfo), '("drag-data-get", Gtk.WidgetDragDataGetSignalInfo), '("drag-data-received", Gtk.WidgetDragDataReceivedSignalInfo), '("drag-drop", Gtk.WidgetDragDropSignalInfo), '("drag-end", Gtk.WidgetDragEndSignalInfo), '("drag-failed", Gtk.WidgetDragFailedSignalInfo), '("drag-leave", Gtk.WidgetDragLeaveSignalInfo), '("drag-motion", Gtk.WidgetDragMotionSignalInfo), '("draw", Gtk.WidgetDrawSignalInfo), '("encoding-changed", TerminalEncodingChangedSignalInfo), '("enter-notify-event", Gtk.WidgetEnterNotifyEventSignalInfo), '("eof", TerminalEofSignalInfo), '("event", Gtk.WidgetEventSignalInfo), '("event-after", Gtk.WidgetEventAfterSignalInfo), '("focus", Gtk.WidgetFocusSignalInfo), '("focus-in-event", Gtk.WidgetFocusInEventSignalInfo), '("focus-out-event", Gtk.WidgetFocusOutEventSignalInfo), '("grab-broken-event", Gtk.WidgetGrabBrokenEventSignalInfo), '("grab-focus", Gtk.WidgetGrabFocusSignalInfo), '("grab-notify", Gtk.WidgetGrabNotifySignalInfo), '("hide", Gtk.WidgetHideSignalInfo), '("hierarchy-changed", Gtk.WidgetHierarchyChangedSignalInfo), '("icon-title-changed", TerminalIconTitleChangedSignalInfo), '("iconify-window", TerminalIconifyWindowSignalInfo), '("increase-font-size", TerminalIncreaseFontSizeSignalInfo), '("key-press-event", Gtk.WidgetKeyPressEventSignalInfo), '("key-release-event", Gtk.WidgetKeyReleaseEventSignalInfo), '("keynav-failed", Gtk.WidgetKeynavFailedSignalInfo), '("leave-notify-event", Gtk.WidgetLeaveNotifyEventSignalInfo), '("lower-window", TerminalLowerWindowSignalInfo), '("map", Gtk.WidgetMapSignalInfo), '("map-event", Gtk.WidgetMapEventSignalInfo), '("maximize-window", TerminalMaximizeWindowSignalInfo), '("mnemonic-activate", Gtk.WidgetMnemonicActivateSignalInfo), '("motion-notify-event", Gtk.WidgetMotionNotifyEventSignalInfo), '("move-focus", Gtk.WidgetMoveFocusSignalInfo), '("move-window", TerminalMoveWindowSignalInfo), '("notification-received", TerminalNotificationReceivedSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("parent-set", Gtk.WidgetParentSetSignalInfo), '("paste-clipboard", TerminalPasteClipboardSignalInfo), '("popup-menu", Gtk.WidgetPopupMenuSignalInfo), '("property-notify-event", Gtk.WidgetPropertyNotifyEventSignalInfo), '("proximity-in-event", Gtk.WidgetProximityInEventSignalInfo), '("proximity-out-event", Gtk.WidgetProximityOutEventSignalInfo), '("query-tooltip", Gtk.WidgetQueryTooltipSignalInfo), '("raise-window", TerminalRaiseWindowSignalInfo), '("realize", Gtk.WidgetRealizeSignalInfo), '("refresh-window", TerminalRefreshWindowSignalInfo), '("resize-window", TerminalResizeWindowSignalInfo), '("restore-window", TerminalRestoreWindowSignalInfo), '("screen-changed", Gtk.WidgetScreenChangedSignalInfo), '("scroll-event", Gtk.WidgetScrollEventSignalInfo), '("selection-changed", TerminalSelectionChangedSignalInfo), '("selection-clear-event", Gtk.WidgetSelectionClearEventSignalInfo), '("selection-get", Gtk.WidgetSelectionGetSignalInfo), '("selection-notify-event", Gtk.WidgetSelectionNotifyEventSignalInfo), '("selection-received", Gtk.WidgetSelectionReceivedSignalInfo), '("selection-request-event", Gtk.WidgetSelectionRequestEventSignalInfo), '("show", Gtk.WidgetShowSignalInfo), '("show-help", Gtk.WidgetShowHelpSignalInfo), '("size-allocate", Gtk.WidgetSizeAllocateSignalInfo), '("state-changed", Gtk.WidgetStateChangedSignalInfo), '("state-flags-changed", Gtk.WidgetStateFlagsChangedSignalInfo), '("style-set", Gtk.WidgetStyleSetSignalInfo), '("style-updated", Gtk.WidgetStyleUpdatedSignalInfo), '("text-deleted", TerminalTextDeletedSignalInfo), '("text-inserted", TerminalTextInsertedSignalInfo), '("text-modified", TerminalTextModifiedSignalInfo), '("text-scrolled", TerminalTextScrolledSignalInfo), '("touch-event", Gtk.WidgetTouchEventSignalInfo), '("unmap", Gtk.WidgetUnmapSignalInfo), '("unmap-event", Gtk.WidgetUnmapEventSignalInfo), '("unrealize", Gtk.WidgetUnrealizeSignalInfo), '("visibility-notify-event", Gtk.WidgetVisibilityNotifyEventSignalInfo), '("window-state-event", Gtk.WidgetWindowStateEventSignalInfo), '("window-title-changed", TerminalWindowTitleChangedSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

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

foreign import ccall "vte_terminal_new" vte_terminal_new :: 
    IO (Ptr Terminal)


terminalNew ::
    (MonadIO m) =>
    m Terminal
terminalNew  = liftIO $ do
    result <- vte_terminal_new
    checkUnexpectedReturnNULL "vte_terminal_new" result
    result' <- (newObject Terminal) result
    return result'

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

foreign import ccall "vte_terminal_copy_clipboard" vte_terminal_copy_clipboard :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO ()


terminalCopyClipboard ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m ()
terminalCopyClipboard _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    vte_terminal_copy_clipboard _obj'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_copy_primary" vte_terminal_copy_primary :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO ()


terminalCopyPrimary ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m ()
terminalCopyPrimary _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    vte_terminal_copy_primary _obj'
    touchManagedPtr _obj
    return ()

-- method Terminal::feed
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : [Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TCArray False (-1) 2 (TBasicType TUInt8), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_feed" vte_terminal_feed :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr Word8 ->                            -- data : TCArray False (-1) 2 (TBasicType TUInt8)
    Int64 ->                                -- length : TBasicType TInt64
    IO ()


terminalFeed ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    ByteString ->                           -- data
    m ()
terminalFeed _obj data_ = liftIO $ do
    let length_ = fromIntegral $ B.length data_
    let _obj' = unsafeManagedPtrCastPtr _obj
    data_' <- packByteString data_
    vte_terminal_feed _obj' data_' length_
    touchManagedPtr _obj
    freeMem data_'
    return ()

-- method Terminal::feed_child
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", 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},Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", 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},Arg {argName = "length", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_feed_child" vte_terminal_feed_child :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CString ->                              -- text : TBasicType TUTF8
    Int64 ->                                -- length : TBasicType TInt64
    IO ()


terminalFeedChild ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- text
    Int64 ->                                -- length
    m ()
terminalFeedChild _obj text length_ = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    text' <- textToCString text
    vte_terminal_feed_child _obj' text' length_
    touchManagedPtr _obj
    freeMem text'
    return ()

-- method Terminal::feed_child_binary
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "data", argType = TBasicType TUInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_feed_child_binary" vte_terminal_feed_child_binary :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Word8 ->                                -- data : TBasicType TUInt8
    Word64 ->                               -- length : TBasicType TUInt64
    IO ()


terminalFeedChildBinary ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Word8 ->                                -- data
    Word64 ->                               -- length
    m ()
terminalFeedChildBinary _obj data_ length_ = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    vte_terminal_feed_child_binary _obj' data_ length_
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_get_allow_bold" vte_terminal_get_allow_bold :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CInt


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

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

foreign import ccall "vte_terminal_get_audible_bell" vte_terminal_get_audible_bell :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CInt


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

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

foreign import ccall "vte_terminal_get_char_height" vte_terminal_get_char_height :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO Int64


terminalGetCharHeight ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m Int64
terminalGetCharHeight _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- vte_terminal_get_char_height _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "vte_terminal_get_char_width" vte_terminal_get_char_width :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO Int64


terminalGetCharWidth ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m Int64
terminalGetCharWidth _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- vte_terminal_get_char_width _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "vte_terminal_get_cjk_ambiguous_width" vte_terminal_get_cjk_ambiguous_width :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO Int32


terminalGetCjkAmbiguousWidth ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m Int32
terminalGetCjkAmbiguousWidth _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- vte_terminal_get_cjk_ambiguous_width _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "vte_terminal_get_column_count" vte_terminal_get_column_count :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO Int64


terminalGetColumnCount ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m Int64
terminalGetColumnCount _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- vte_terminal_get_column_count _obj'
    touchManagedPtr _obj
    return result

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

foreign import ccall "vte_terminal_get_current_directory_uri" vte_terminal_get_current_directory_uri :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CString


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

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

foreign import ccall "vte_terminal_get_current_file_uri" vte_terminal_get_current_file_uri :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CString


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

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

foreign import ccall "vte_terminal_get_cursor_blink_mode" vte_terminal_get_cursor_blink_mode :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CUInt


terminalGetCursorBlinkMode ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m CursorBlinkMode
terminalGetCursorBlinkMode _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- vte_terminal_get_cursor_blink_mode _obj'
    let result' = (toEnum . fromIntegral) result
    touchManagedPtr _obj
    return result'

-- method Terminal::get_cursor_position
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "column", argType = TBasicType TInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "row", argType = TBasicType TInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_get_cursor_position" vte_terminal_get_cursor_position :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr Int64 ->                            -- column : TBasicType TInt64
    Ptr Int64 ->                            -- row : TBasicType TInt64
    IO ()


terminalGetCursorPosition ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m (Int64,Int64)
terminalGetCursorPosition _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    column <- allocMem :: IO (Ptr Int64)
    row <- allocMem :: IO (Ptr Int64)
    vte_terminal_get_cursor_position _obj' column row
    column' <- peek column
    row' <- peek row
    touchManagedPtr _obj
    freeMem column
    freeMem row
    return (column', row')

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

foreign import ccall "vte_terminal_get_cursor_shape" vte_terminal_get_cursor_shape :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CUInt


terminalGetCursorShape ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m CursorShape
terminalGetCursorShape _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- vte_terminal_get_cursor_shape _obj'
    let result' = (toEnum . fromIntegral) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "vte_terminal_get_encoding" vte_terminal_get_encoding :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CString


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

-- method Terminal::get_font
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Pango" "FontDescription"
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_get_font" vte_terminal_get_font :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO (Ptr Pango.FontDescription)


terminalGetFont ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m Pango.FontDescription
terminalGetFont _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- vte_terminal_get_font _obj'
    checkUnexpectedReturnNULL "vte_terminal_get_font" result
    result' <- (newBoxed Pango.FontDescription) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "vte_terminal_get_font_scale" vte_terminal_get_font_scale :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CDouble


terminalGetFontScale ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m Double
terminalGetFontScale _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- vte_terminal_get_font_scale _obj'
    let result' = realToFrac result
    touchManagedPtr _obj
    return result'

-- method Terminal::get_geometry_hints
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hints", argType = TInterface "Gdk" "Geometry", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "min_rows", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "min_columns", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "min_rows", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "min_columns", 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 "vte_terminal_get_geometry_hints" vte_terminal_get_geometry_hints :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr Gdk.Geometry ->                     -- hints : TInterface "Gdk" "Geometry"
    Int32 ->                                -- min_rows : TBasicType TInt32
    Int32 ->                                -- min_columns : TBasicType TInt32
    IO ()


terminalGetGeometryHints ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- min_rows
    Int32 ->                                -- min_columns
    m (Gdk.Geometry)
terminalGetGeometryHints _obj min_rows min_columns = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    hints <- callocBytes 56 :: IO (Ptr Gdk.Geometry)
    vte_terminal_get_geometry_hints _obj' hints min_rows min_columns
    hints' <- (wrapPtr Gdk.Geometry) hints
    touchManagedPtr _obj
    return hints'

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

foreign import ccall "vte_terminal_get_has_selection" vte_terminal_get_has_selection :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CInt


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

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

foreign import ccall "vte_terminal_get_icon_title" vte_terminal_get_icon_title :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CString


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

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

foreign import ccall "vte_terminal_get_input_enabled" vte_terminal_get_input_enabled :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CInt


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

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

foreign import ccall "vte_terminal_get_mouse_autohide" vte_terminal_get_mouse_autohide :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CInt


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

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

foreign import ccall "vte_terminal_get_pty" vte_terminal_get_pty :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO (Ptr Pty)


terminalGetPty ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m Pty
terminalGetPty _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- vte_terminal_get_pty _obj'
    checkUnexpectedReturnNULL "vte_terminal_get_pty" result
    result' <- (newObject Pty) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "vte_terminal_get_rewrap_on_resize" vte_terminal_get_rewrap_on_resize :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CInt


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

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

foreign import ccall "vte_terminal_get_row_count" vte_terminal_get_row_count :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO Int64


terminalGetRowCount ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m Int64
terminalGetRowCount _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- vte_terminal_get_row_count _obj'
    touchManagedPtr _obj
    return result

-- method Terminal::get_text
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_selected", argType = TInterface "Vte" "SelectionFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeCall, argClosure = 2, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TGArray (TInterface "Vte" "CharAttributes"), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_selected", argType = TInterface "Vte" "SelectionFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeCall, argClosure = 2, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_get_text" vte_terminal_get_text :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    FunPtr SelectionFuncC ->                -- is_selected : TInterface "Vte" "SelectionFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    Ptr (Ptr (GArray (Ptr CharAttributes))) -> -- attributes : TGArray (TInterface "Vte" "CharAttributes")
    IO CString


terminalGetText ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Maybe (SelectionFunc) ->                -- is_selected
    m (T.Text,[CharAttributes])
terminalGetText _obj is_selected = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeIs_selected <- case is_selected of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jIs_selected -> do
            jIs_selected' <- mkSelectionFunc (selectionFuncWrapper Nothing jIs_selected)
            return jIs_selected'
    attributes <- allocMem :: IO (Ptr (Ptr (GArray (Ptr CharAttributes))))
    let user_data = nullPtr
    result <- vte_terminal_get_text _obj' maybeIs_selected user_data attributes
    checkUnexpectedReturnNULL "vte_terminal_get_text" result
    result' <- cstringToText result
    freeMem result
    attributes' <- peek attributes
    attributes'' <- unpackGArray attributes'
    attributes''' <- mapM (wrapPtr CharAttributes) attributes''
    unrefGArray attributes'
    safeFreeFunPtr $ castFunPtrToPtr maybeIs_selected
    touchManagedPtr _obj
    freeMem attributes
    return (result', attributes''')

-- method Terminal::get_text_include_trailing_spaces
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_selected", argType = TInterface "Vte" "SelectionFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeCall, argClosure = 2, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TGArray (TInterface "Vte" "CharAttributes"), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_selected", argType = TInterface "Vte" "SelectionFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeCall, argClosure = 2, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_get_text_include_trailing_spaces" vte_terminal_get_text_include_trailing_spaces :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    FunPtr SelectionFuncC ->                -- is_selected : TInterface "Vte" "SelectionFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    Ptr (Ptr (GArray (Ptr CharAttributes))) -> -- attributes : TGArray (TInterface "Vte" "CharAttributes")
    IO CString


terminalGetTextIncludeTrailingSpaces ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Maybe (SelectionFunc) ->                -- is_selected
    m (T.Text,[CharAttributes])
terminalGetTextIncludeTrailingSpaces _obj is_selected = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeIs_selected <- case is_selected of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jIs_selected -> do
            jIs_selected' <- mkSelectionFunc (selectionFuncWrapper Nothing jIs_selected)
            return jIs_selected'
    attributes <- allocMem :: IO (Ptr (Ptr (GArray (Ptr CharAttributes))))
    let user_data = nullPtr
    result <- vte_terminal_get_text_include_trailing_spaces _obj' maybeIs_selected user_data attributes
    checkUnexpectedReturnNULL "vte_terminal_get_text_include_trailing_spaces" result
    result' <- cstringToText result
    freeMem result
    attributes' <- peek attributes
    attributes'' <- unpackGArray attributes'
    attributes''' <- mapM (wrapPtr CharAttributes) attributes''
    unrefGArray attributes'
    safeFreeFunPtr $ castFunPtrToPtr maybeIs_selected
    touchManagedPtr _obj
    freeMem attributes
    return (result', attributes''')

-- method Terminal::get_text_range
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_row", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_col", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_row", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_col", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_selected", argType = TInterface "Vte" "SelectionFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeCall, argClosure = 6, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attributes", argType = TGArray (TInterface "Vte" "CharAttributes"), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_row", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_col", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_row", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_col", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_selected", argType = TInterface "Vte" "SelectionFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeCall, argClosure = 6, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_get_text_range" vte_terminal_get_text_range :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Int64 ->                                -- start_row : TBasicType TInt64
    Int64 ->                                -- start_col : TBasicType TInt64
    Int64 ->                                -- end_row : TBasicType TInt64
    Int64 ->                                -- end_col : TBasicType TInt64
    FunPtr SelectionFuncC ->                -- is_selected : TInterface "Vte" "SelectionFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    Ptr (Ptr (GArray (Ptr CharAttributes))) -> -- attributes : TGArray (TInterface "Vte" "CharAttributes")
    IO CString


terminalGetTextRange ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Int64 ->                                -- start_row
    Int64 ->                                -- start_col
    Int64 ->                                -- end_row
    Int64 ->                                -- end_col
    Maybe (SelectionFunc) ->                -- is_selected
    m (T.Text,[CharAttributes])
terminalGetTextRange _obj start_row start_col end_row end_col is_selected = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeIs_selected <- case is_selected of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jIs_selected -> do
            jIs_selected' <- mkSelectionFunc (selectionFuncWrapper Nothing jIs_selected)
            return jIs_selected'
    attributes <- allocMem :: IO (Ptr (Ptr (GArray (Ptr CharAttributes))))
    let user_data = nullPtr
    result <- vte_terminal_get_text_range _obj' start_row start_col end_row end_col maybeIs_selected user_data attributes
    checkUnexpectedReturnNULL "vte_terminal_get_text_range" result
    result' <- cstringToText result
    freeMem result
    attributes' <- peek attributes
    attributes'' <- unpackGArray attributes'
    attributes''' <- mapM (wrapPtr CharAttributes) attributes''
    unrefGArray attributes'
    safeFreeFunPtr $ castFunPtrToPtr maybeIs_selected
    touchManagedPtr _obj
    freeMem attributes
    return (result', attributes''')

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

foreign import ccall "vte_terminal_get_window_title" vte_terminal_get_window_title :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CString


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

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

foreign import ccall "vte_terminal_get_word_char_exceptions" vte_terminal_get_word_char_exceptions :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CString


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

-- method Terminal::match_add_gregex
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "regex", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "regex", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_match_add_gregex" vte_terminal_match_add_gregex :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr GLib.Regex ->                       -- regex : TInterface "GLib" "Regex"
    CUInt ->                                -- flags : TInterface "GLib" "RegexMatchFlags"
    IO Int32


terminalMatchAddGregex ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    GLib.Regex ->                           -- regex
    [GLib.RegexMatchFlags] ->               -- flags
    m Int32
terminalMatchAddGregex _obj regex flags = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let regex' = unsafeManagedPtrGetPtr regex
    let flags' = gflagsToWord flags
    result <- vte_terminal_match_add_gregex _obj' regex' flags'
    touchManagedPtr _obj
    touchManagedPtr regex
    return result

-- method Terminal::match_check
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "column", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "row", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tag", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "column", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "row", argType = TBasicType TInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_match_check" vte_terminal_match_check :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Int64 ->                                -- column : TBasicType TInt64
    Int64 ->                                -- row : TBasicType TInt64
    Ptr Int32 ->                            -- tag : TBasicType TInt32
    IO CString


terminalMatchCheck ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Int64 ->                                -- column
    Int64 ->                                -- row
    m (T.Text,Int32)
terminalMatchCheck _obj column row = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    tag <- allocMem :: IO (Ptr Int32)
    result <- vte_terminal_match_check _obj' column row tag
    checkUnexpectedReturnNULL "vte_terminal_match_check" result
    result' <- cstringToText result
    freeMem result
    tag' <- peek tag
    touchManagedPtr _obj
    freeMem tag
    return (result', tag')

-- method Terminal::match_check_event
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event", argType = TInterface "Gdk" "Event", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tag", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "event", argType = TInterface "Gdk" "Event", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_match_check_event" vte_terminal_match_check_event :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr Gdk.Event ->                        -- event : TInterface "Gdk" "Event"
    Ptr Int32 ->                            -- tag : TBasicType TInt32
    IO CString


terminalMatchCheckEvent ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Gdk.Event ->                            -- event
    m (T.Text,Int32)
terminalMatchCheckEvent _obj event = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let event' = unsafeManagedPtrGetPtr event
    tag <- allocMem :: IO (Ptr Int32)
    result <- vte_terminal_match_check_event _obj' event' tag
    checkUnexpectedReturnNULL "vte_terminal_match_check_event" result
    result' <- cstringToText result
    freeMem result
    tag' <- peek tag
    touchManagedPtr _obj
    touchManagedPtr event
    freeMem tag
    return (result', tag')

-- method Terminal::match_remove
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tag", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tag", 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 "vte_terminal_match_remove" vte_terminal_match_remove :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Int32 ->                                -- tag : TBasicType TInt32
    IO ()


terminalMatchRemove ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- tag
    m ()
terminalMatchRemove _obj tag = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    vte_terminal_match_remove _obj' tag
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_match_remove_all" vte_terminal_match_remove_all :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO ()


terminalMatchRemoveAll ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m ()
terminalMatchRemoveAll _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    vte_terminal_match_remove_all _obj'
    touchManagedPtr _obj
    return ()

-- method Terminal::match_set_cursor_name
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tag", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cursor_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tag", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cursor_name", 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 "vte_terminal_match_set_cursor_name" vte_terminal_match_set_cursor_name :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Int32 ->                                -- tag : TBasicType TInt32
    CString ->                              -- cursor_name : TBasicType TUTF8
    IO ()


terminalMatchSetCursorName ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- tag
    T.Text ->                               -- cursor_name
    m ()
terminalMatchSetCursorName _obj tag cursor_name = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    cursor_name' <- textToCString cursor_name
    vte_terminal_match_set_cursor_name _obj' tag cursor_name'
    touchManagedPtr _obj
    freeMem cursor_name'
    return ()

-- method Terminal::match_set_cursor_type
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tag", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cursor_type", argType = TInterface "Gdk" "CursorType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "tag", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cursor_type", argType = TInterface "Gdk" "CursorType", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_match_set_cursor_type" vte_terminal_match_set_cursor_type :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Int32 ->                                -- tag : TBasicType TInt32
    CUInt ->                                -- cursor_type : TInterface "Gdk" "CursorType"
    IO ()


terminalMatchSetCursorType ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- tag
    Gdk.CursorType ->                       -- cursor_type
    m ()
terminalMatchSetCursorType _obj tag cursor_type = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let cursor_type' = (fromIntegral . fromEnum) cursor_type
    vte_terminal_match_set_cursor_type _obj' tag cursor_type'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_paste_clipboard" vte_terminal_paste_clipboard :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO ()


terminalPasteClipboard ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m ()
terminalPasteClipboard _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    vte_terminal_paste_clipboard _obj'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_paste_primary" vte_terminal_paste_primary :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO ()


terminalPastePrimary ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m ()
terminalPastePrimary _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    vte_terminal_paste_primary _obj'
    touchManagedPtr _obj
    return ()

-- method Terminal::pty_new_sync
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Vte" "PtyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Vte" "PtyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Vte" "Pty"
-- throws : True
-- Skip return : False

foreign import ccall "vte_terminal_pty_new_sync" vte_terminal_pty_new_sync :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CUInt ->                                -- flags : TInterface "Vte" "PtyFlags"
    Ptr Gio.Cancellable ->                  -- cancellable : TInterface "Gio" "Cancellable"
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Pty)


terminalPtyNewSync ::
    (MonadIO m, TerminalK a, Gio.CancellableK b) =>
    a ->                                    -- _obj
    [PtyFlags] ->                           -- flags
    Maybe (b) ->                            -- cancellable
    m Pty
terminalPtyNewSync _obj flags cancellable = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let flags' = gflagsToWord flags
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    onException (do
        result <- propagateGError $ vte_terminal_pty_new_sync _obj' flags' maybeCancellable
        checkUnexpectedReturnNULL "vte_terminal_pty_new_sync" result
        result' <- (wrapObject Pty) result
        touchManagedPtr _obj
        whenJust cancellable touchManagedPtr
        return result'
     ) (do
        return ()
     )

-- method Terminal::reset
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "clear_tabstops", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "clear_history", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "clear_tabstops", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "clear_history", 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 "vte_terminal_reset" vte_terminal_reset :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CInt ->                                 -- clear_tabstops : TBasicType TBoolean
    CInt ->                                 -- clear_history : TBasicType TBoolean
    IO ()


terminalReset ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- clear_tabstops
    Bool ->                                 -- clear_history
    m ()
terminalReset _obj clear_tabstops clear_history = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let clear_tabstops' = (fromIntegral . fromEnum) clear_tabstops
    let clear_history' = (fromIntegral . fromEnum) clear_history
    vte_terminal_reset _obj' clear_tabstops' clear_history'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_search_find_next" vte_terminal_search_find_next :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CInt


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

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

foreign import ccall "vte_terminal_search_find_previous" vte_terminal_search_find_previous :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CInt


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

-- method Terminal::search_get_gregex
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "GLib" "Regex"
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_search_get_gregex" vte_terminal_search_get_gregex :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO (Ptr GLib.Regex)


terminalSearchGetGregex ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m GLib.Regex
terminalSearchGetGregex _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- vte_terminal_search_get_gregex _obj'
    checkUnexpectedReturnNULL "vte_terminal_search_get_gregex" result
    result' <- (newBoxed GLib.Regex) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "vte_terminal_search_get_wrap_around" vte_terminal_search_get_wrap_around :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO CInt


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

-- method Terminal::search_set_gregex
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "regex", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "regex", argType = TInterface "GLib" "Regex", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "RegexMatchFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_search_set_gregex" vte_terminal_search_set_gregex :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr GLib.Regex ->                       -- regex : TInterface "GLib" "Regex"
    CUInt ->                                -- flags : TInterface "GLib" "RegexMatchFlags"
    IO ()


terminalSearchSetGregex ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Maybe (GLib.Regex) ->                   -- regex
    [GLib.RegexMatchFlags] ->               -- flags
    m ()
terminalSearchSetGregex _obj regex flags = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeRegex <- case regex of
        Nothing -> return nullPtr
        Just jRegex -> do
            let jRegex' = unsafeManagedPtrGetPtr jRegex
            return jRegex'
    let flags' = gflagsToWord flags
    vte_terminal_search_set_gregex _obj' maybeRegex flags'
    touchManagedPtr _obj
    whenJust regex touchManagedPtr
    return ()

-- method Terminal::search_set_wrap_around
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wrap_around", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wrap_around", 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 "vte_terminal_search_set_wrap_around" vte_terminal_search_set_wrap_around :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CInt ->                                 -- wrap_around : TBasicType TBoolean
    IO ()


terminalSearchSetWrapAround ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- wrap_around
    m ()
terminalSearchSetWrapAround _obj wrap_around = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let wrap_around' = (fromIntegral . fromEnum) wrap_around
    vte_terminal_search_set_wrap_around _obj' wrap_around'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_select_all" vte_terminal_select_all :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO ()


terminalSelectAll ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m ()
terminalSelectAll _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    vte_terminal_select_all _obj'
    touchManagedPtr _obj
    return ()

-- method Terminal::set_allow_bold
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "allow_bold", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "allow_bold", 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 "vte_terminal_set_allow_bold" vte_terminal_set_allow_bold :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CInt ->                                 -- allow_bold : TBasicType TBoolean
    IO ()


terminalSetAllowBold ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- allow_bold
    m ()
terminalSetAllowBold _obj allow_bold = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let allow_bold' = (fromIntegral . fromEnum) allow_bold
    vte_terminal_set_allow_bold _obj' allow_bold'
    touchManagedPtr _obj
    return ()

-- method Terminal::set_audible_bell
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_audible", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "is_audible", 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 "vte_terminal_set_audible_bell" vte_terminal_set_audible_bell :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CInt ->                                 -- is_audible : TBasicType TBoolean
    IO ()


terminalSetAudibleBell ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- is_audible
    m ()
terminalSetAudibleBell _obj is_audible = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let is_audible' = (fromIntegral . fromEnum) is_audible
    vte_terminal_set_audible_bell _obj' is_audible'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_set_backspace_binding" vte_terminal_set_backspace_binding :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CUInt ->                                -- binding : TInterface "Vte" "EraseBinding"
    IO ()


terminalSetBackspaceBinding ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    EraseBinding ->                         -- binding
    m ()
terminalSetBackspaceBinding _obj binding = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let binding' = (fromIntegral . fromEnum) binding
    vte_terminal_set_backspace_binding _obj' binding'
    touchManagedPtr _obj
    return ()

-- method Terminal::set_cjk_ambiguous_width
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "width", 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 "vte_terminal_set_cjk_ambiguous_width" vte_terminal_set_cjk_ambiguous_width :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Int32 ->                                -- width : TBasicType TInt32
    IO ()


terminalSetCjkAmbiguousWidth ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- width
    m ()
terminalSetCjkAmbiguousWidth _obj width = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    vte_terminal_set_cjk_ambiguous_width _obj' width
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_set_color_background" vte_terminal_set_color_background :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr Gdk.RGBA ->                         -- background : TInterface "Gdk" "RGBA"
    IO ()


terminalSetColorBackground ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Gdk.RGBA ->                             -- background
    m ()
terminalSetColorBackground _obj background = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let background' = unsafeManagedPtrGetPtr background
    vte_terminal_set_color_background _obj' background'
    touchManagedPtr _obj
    touchManagedPtr background
    return ()

-- method Terminal::set_color_bold
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bold", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "bold", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_set_color_bold" vte_terminal_set_color_bold :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr Gdk.RGBA ->                         -- bold : TInterface "Gdk" "RGBA"
    IO ()


terminalSetColorBold ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Maybe (Gdk.RGBA) ->                     -- bold
    m ()
terminalSetColorBold _obj bold = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeBold <- case bold of
        Nothing -> return nullPtr
        Just jBold -> do
            let jBold' = unsafeManagedPtrGetPtr jBold
            return jBold'
    vte_terminal_set_color_bold _obj' maybeBold
    touchManagedPtr _obj
    whenJust bold touchManagedPtr
    return ()

-- method Terminal::set_color_cursor
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cursor_background", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cursor_background", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_set_color_cursor" vte_terminal_set_color_cursor :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr Gdk.RGBA ->                         -- cursor_background : TInterface "Gdk" "RGBA"
    IO ()


terminalSetColorCursor ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Maybe (Gdk.RGBA) ->                     -- cursor_background
    m ()
terminalSetColorCursor _obj cursor_background = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeCursor_background <- case cursor_background of
        Nothing -> return nullPtr
        Just jCursor_background -> do
            let jCursor_background' = unsafeManagedPtrGetPtr jCursor_background
            return jCursor_background'
    vte_terminal_set_color_cursor _obj' maybeCursor_background
    touchManagedPtr _obj
    whenJust cursor_background touchManagedPtr
    return ()

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

foreign import ccall "vte_terminal_set_color_foreground" vte_terminal_set_color_foreground :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr Gdk.RGBA ->                         -- foreground : TInterface "Gdk" "RGBA"
    IO ()


terminalSetColorForeground ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Gdk.RGBA ->                             -- foreground
    m ()
terminalSetColorForeground _obj foreground = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let foreground' = unsafeManagedPtrGetPtr foreground
    vte_terminal_set_color_foreground _obj' foreground'
    touchManagedPtr _obj
    touchManagedPtr foreground
    return ()

-- method Terminal::set_color_highlight
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "highlight_background", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "highlight_background", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_set_color_highlight" vte_terminal_set_color_highlight :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr Gdk.RGBA ->                         -- highlight_background : TInterface "Gdk" "RGBA"
    IO ()


terminalSetColorHighlight ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Maybe (Gdk.RGBA) ->                     -- highlight_background
    m ()
terminalSetColorHighlight _obj highlight_background = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeHighlight_background <- case highlight_background of
        Nothing -> return nullPtr
        Just jHighlight_background -> do
            let jHighlight_background' = unsafeManagedPtrGetPtr jHighlight_background
            return jHighlight_background'
    vte_terminal_set_color_highlight _obj' maybeHighlight_background
    touchManagedPtr _obj
    whenJust highlight_background touchManagedPtr
    return ()

-- method Terminal::set_color_highlight_foreground
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "highlight_foreground", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "highlight_foreground", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_set_color_highlight_foreground" vte_terminal_set_color_highlight_foreground :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr Gdk.RGBA ->                         -- highlight_foreground : TInterface "Gdk" "RGBA"
    IO ()


terminalSetColorHighlightForeground ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Maybe (Gdk.RGBA) ->                     -- highlight_foreground
    m ()
terminalSetColorHighlightForeground _obj highlight_foreground = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeHighlight_foreground <- case highlight_foreground of
        Nothing -> return nullPtr
        Just jHighlight_foreground -> do
            let jHighlight_foreground' = unsafeManagedPtrGetPtr jHighlight_foreground
            return jHighlight_foreground'
    vte_terminal_set_color_highlight_foreground _obj' maybeHighlight_foreground
    touchManagedPtr _obj
    whenJust highlight_foreground touchManagedPtr
    return ()

-- method Terminal::set_colors
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "foreground", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "background", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "palette", argType = TCArray False (-1) 4 (TInterface "Gdk" "RGBA"), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "palette_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : [Arg {argName = "palette_size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "foreground", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "background", argType = TInterface "Gdk" "RGBA", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "palette", argType = TCArray False (-1) 4 (TInterface "Gdk" "RGBA"), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_set_colors" vte_terminal_set_colors :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr Gdk.RGBA ->                         -- foreground : TInterface "Gdk" "RGBA"
    Ptr Gdk.RGBA ->                         -- background : TInterface "Gdk" "RGBA"
    Ptr Gdk.RGBA ->                         -- palette : TCArray False (-1) 4 (TInterface "Gdk" "RGBA")
    Word64 ->                               -- palette_size : TBasicType TUInt64
    IO ()


terminalSetColors ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Maybe (Gdk.RGBA) ->                     -- foreground
    Maybe (Gdk.RGBA) ->                     -- background
    Maybe ([Gdk.RGBA]) ->                   -- palette
    m ()
terminalSetColors _obj foreground background palette = liftIO $ do
    let palette_size = case palette of
            Nothing -> 0
            Just jPalette -> fromIntegral $ length jPalette
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeForeground <- case foreground of
        Nothing -> return nullPtr
        Just jForeground -> do
            let jForeground' = unsafeManagedPtrGetPtr jForeground
            return jForeground'
    maybeBackground <- case background of
        Nothing -> return nullPtr
        Just jBackground -> do
            let jBackground' = unsafeManagedPtrGetPtr jBackground
            return jBackground'
    maybePalette <- case palette of
        Nothing -> return nullPtr
        Just jPalette -> do
            let jPalette' = map unsafeManagedPtrGetPtr jPalette
            jPalette'' <- packBlockArray 32 jPalette'
            return jPalette''
    vte_terminal_set_colors _obj' maybeForeground maybeBackground maybePalette palette_size
    touchManagedPtr _obj
    whenJust foreground touchManagedPtr
    whenJust background touchManagedPtr
    whenJust palette (mapM_ touchManagedPtr)
    freeMem maybePalette
    return ()

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

foreign import ccall "vte_terminal_set_cursor_blink_mode" vte_terminal_set_cursor_blink_mode :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CUInt ->                                -- mode : TInterface "Vte" "CursorBlinkMode"
    IO ()


terminalSetCursorBlinkMode ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    CursorBlinkMode ->                      -- mode
    m ()
terminalSetCursorBlinkMode _obj mode = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let mode' = (fromIntegral . fromEnum) mode
    vte_terminal_set_cursor_blink_mode _obj' mode'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_set_cursor_shape" vte_terminal_set_cursor_shape :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CUInt ->                                -- shape : TInterface "Vte" "CursorShape"
    IO ()


terminalSetCursorShape ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    CursorShape ->                          -- shape
    m ()
terminalSetCursorShape _obj shape = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let shape' = (fromIntegral . fromEnum) shape
    vte_terminal_set_cursor_shape _obj' shape'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_set_default_colors" vte_terminal_set_default_colors :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO ()


terminalSetDefaultColors ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m ()
terminalSetDefaultColors _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    vte_terminal_set_default_colors _obj'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_set_delete_binding" vte_terminal_set_delete_binding :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CUInt ->                                -- binding : TInterface "Vte" "EraseBinding"
    IO ()


terminalSetDeleteBinding ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    EraseBinding ->                         -- binding
    m ()
terminalSetDeleteBinding _obj binding = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let binding' = (fromIntegral . fromEnum) binding
    vte_terminal_set_delete_binding _obj' binding'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_set_encoding" vte_terminal_set_encoding :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CString ->                              -- codeset : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt


terminalSetEncoding ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Maybe (T.Text) ->                       -- codeset
    m ()
terminalSetEncoding _obj codeset = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeCodeset <- case codeset of
        Nothing -> return nullPtr
        Just jCodeset -> do
            jCodeset' <- textToCString jCodeset
            return jCodeset'
    onException (do
        _ <- propagateGError $ vte_terminal_set_encoding _obj' maybeCodeset
        touchManagedPtr _obj
        freeMem maybeCodeset
        return ()
     ) (do
        freeMem maybeCodeset
     )

-- method Terminal::set_font
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "font_desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "font_desc", argType = TInterface "Pango" "FontDescription", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "vte_terminal_set_font" vte_terminal_set_font :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr Pango.FontDescription ->            -- font_desc : TInterface "Pango" "FontDescription"
    IO ()


terminalSetFont ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Maybe (Pango.FontDescription) ->        -- font_desc
    m ()
terminalSetFont _obj font_desc = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeFont_desc <- case font_desc of
        Nothing -> return nullPtr
        Just jFont_desc -> do
            let jFont_desc' = unsafeManagedPtrGetPtr jFont_desc
            return jFont_desc'
    vte_terminal_set_font _obj' maybeFont_desc
    touchManagedPtr _obj
    whenJust font_desc touchManagedPtr
    return ()

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

foreign import ccall "vte_terminal_set_font_scale" vte_terminal_set_font_scale :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CDouble ->                              -- scale : TBasicType TDouble
    IO ()


terminalSetFontScale ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Double ->                               -- scale
    m ()
terminalSetFontScale _obj scale = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let scale' = realToFrac scale
    vte_terminal_set_font_scale _obj' scale'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_set_geometry_hints_for_window" vte_terminal_set_geometry_hints_for_window :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr Gtk.Window ->                       -- window : TInterface "Gtk" "Window"
    IO ()


terminalSetGeometryHintsForWindow ::
    (MonadIO m, TerminalK a, Gtk.WindowK b) =>
    a ->                                    -- _obj
    b ->                                    -- window
    m ()
terminalSetGeometryHintsForWindow _obj window = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let window' = unsafeManagedPtrCastPtr window
    vte_terminal_set_geometry_hints_for_window _obj' window'
    touchManagedPtr _obj
    touchManagedPtr window
    return ()

-- method Terminal::set_input_enabled
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "enabled", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "enabled", 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 "vte_terminal_set_input_enabled" vte_terminal_set_input_enabled :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()


terminalSetInputEnabled ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- enabled
    m ()
terminalSetInputEnabled _obj enabled = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let enabled' = (fromIntegral . fromEnum) enabled
    vte_terminal_set_input_enabled _obj' enabled'
    touchManagedPtr _obj
    return ()

-- method Terminal::set_mouse_autohide
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", 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 "vte_terminal_set_mouse_autohide" vte_terminal_set_mouse_autohide :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CInt ->                                 -- setting : TBasicType TBoolean
    IO ()


terminalSetMouseAutohide ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- setting
    m ()
terminalSetMouseAutohide _obj setting = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let setting' = (fromIntegral . fromEnum) setting
    vte_terminal_set_mouse_autohide _obj' setting'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_set_pty" vte_terminal_set_pty :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr Pty ->                              -- pty : TInterface "Vte" "Pty"
    IO ()


terminalSetPty ::
    (MonadIO m, TerminalK a, PtyK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- pty
    m ()
terminalSetPty _obj pty = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybePty <- case pty of
        Nothing -> return nullPtr
        Just jPty -> do
            let jPty' = unsafeManagedPtrCastPtr jPty
            return jPty'
    vte_terminal_set_pty _obj' maybePty
    touchManagedPtr _obj
    whenJust pty touchManagedPtr
    return ()

-- method Terminal::set_rewrap_on_resize
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rewrap", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "rewrap", 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 "vte_terminal_set_rewrap_on_resize" vte_terminal_set_rewrap_on_resize :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CInt ->                                 -- rewrap : TBasicType TBoolean
    IO ()


terminalSetRewrapOnResize ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- rewrap
    m ()
terminalSetRewrapOnResize _obj rewrap = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let rewrap' = (fromIntegral . fromEnum) rewrap
    vte_terminal_set_rewrap_on_resize _obj' rewrap'
    touchManagedPtr _obj
    return ()

-- method Terminal::set_scroll_on_keystroke
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scroll", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scroll", 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 "vte_terminal_set_scroll_on_keystroke" vte_terminal_set_scroll_on_keystroke :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CInt ->                                 -- scroll : TBasicType TBoolean
    IO ()


terminalSetScrollOnKeystroke ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- scroll
    m ()
terminalSetScrollOnKeystroke _obj scroll = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let scroll' = (fromIntegral . fromEnum) scroll
    vte_terminal_set_scroll_on_keystroke _obj' scroll'
    touchManagedPtr _obj
    return ()

-- method Terminal::set_scroll_on_output
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scroll", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "scroll", 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 "vte_terminal_set_scroll_on_output" vte_terminal_set_scroll_on_output :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CInt ->                                 -- scroll : TBasicType TBoolean
    IO ()


terminalSetScrollOnOutput ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- scroll
    m ()
terminalSetScrollOnOutput _obj scroll = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let scroll' = (fromIntegral . fromEnum) scroll
    vte_terminal_set_scroll_on_output _obj' scroll'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_set_scrollback_lines" vte_terminal_set_scrollback_lines :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Int64 ->                                -- lines : TBasicType TInt64
    IO ()


terminalSetScrollbackLines ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Int64 ->                                -- lines
    m ()
terminalSetScrollbackLines _obj lines = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    vte_terminal_set_scrollback_lines _obj' lines
    touchManagedPtr _obj
    return ()

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

foreign import ccall "vte_terminal_set_size" vte_terminal_set_size :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Int64 ->                                -- columns : TBasicType TInt64
    Int64 ->                                -- rows : TBasicType TInt64
    IO ()


terminalSetSize ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Int64 ->                                -- columns
    Int64 ->                                -- rows
    m ()
terminalSetSize _obj columns rows = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    vte_terminal_set_size _obj' columns rows
    touchManagedPtr _obj
    return ()

-- method Terminal::set_word_char_exceptions
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "exceptions", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "exceptions", 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 "vte_terminal_set_word_char_exceptions" vte_terminal_set_word_char_exceptions :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CString ->                              -- exceptions : TBasicType TUTF8
    IO ()


terminalSetWordCharExceptions ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- exceptions
    m ()
terminalSetWordCharExceptions _obj exceptions = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    exceptions' <- textToCString exceptions
    vte_terminal_set_word_char_exceptions _obj' exceptions'
    touchManagedPtr _obj
    freeMem exceptions'
    return ()

-- method Terminal::spawn_sync
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pty_flags", argType = TInterface "Vte" "PtyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "working_directory", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argv", argType = TCArray True (-1) (-1) (TBasicType TFileName), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "envv", argType = TCArray True (-1) (-1) (TBasicType TFileName), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "spawn_flags", argType = TInterface "GLib" "SpawnFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_setup", argType = TInterface "GLib" "SpawnChildSetupFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeCall, argClosure = 7, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_setup_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_pid", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pty_flags", argType = TInterface "Vte" "PtyFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "working_directory", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argv", argType = TCArray True (-1) (-1) (TBasicType TFileName), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "envv", argType = TCArray True (-1) (-1) (TBasicType TFileName), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "spawn_flags", argType = TInterface "GLib" "SpawnFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_setup", argType = TInterface "GLib" "SpawnChildSetupFunc", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeCall, argClosure = 7, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : True
-- Skip return : False

foreign import ccall "vte_terminal_spawn_sync" vte_terminal_spawn_sync :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    CUInt ->                                -- pty_flags : TInterface "Vte" "PtyFlags"
    CString ->                              -- working_directory : TBasicType TUTF8
    Ptr CString ->                          -- argv : TCArray True (-1) (-1) (TBasicType TFileName)
    Ptr CString ->                          -- envv : TCArray True (-1) (-1) (TBasicType TFileName)
    CUInt ->                                -- spawn_flags : TInterface "GLib" "SpawnFlags"
    FunPtr GLib.SpawnChildSetupFuncC ->     -- child_setup : TInterface "GLib" "SpawnChildSetupFunc"
    Ptr () ->                               -- child_setup_data : TBasicType TVoid
    Ptr Int32 ->                            -- child_pid : TBasicType TInt32
    Ptr Gio.Cancellable ->                  -- cancellable : TInterface "Gio" "Cancellable"
    Ptr (Ptr GError) ->                     -- error
    IO CInt


terminalSpawnSync ::
    (MonadIO m, TerminalK a, Gio.CancellableK b) =>
    a ->                                    -- _obj
    [PtyFlags] ->                           -- pty_flags
    Maybe (T.Text) ->                       -- working_directory
    [[Char]] ->                             -- argv
    Maybe ([[Char]]) ->                     -- envv
    [GLib.SpawnFlags] ->                    -- spawn_flags
    Maybe (GLib.SpawnChildSetupFunc) ->     -- child_setup
    Maybe (b) ->                            -- cancellable
    m (Int32)
terminalSpawnSync _obj pty_flags working_directory argv envv spawn_flags child_setup cancellable = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let pty_flags' = gflagsToWord pty_flags
    maybeWorking_directory <- case working_directory of
        Nothing -> return nullPtr
        Just jWorking_directory -> do
            jWorking_directory' <- textToCString jWorking_directory
            return jWorking_directory'
    argv' <- packZeroTerminatedFileNameArray argv
    maybeEnvv <- case envv of
        Nothing -> return nullPtr
        Just jEnvv -> do
            jEnvv' <- packZeroTerminatedFileNameArray jEnvv
            return jEnvv'
    let spawn_flags' = gflagsToWord spawn_flags
    maybeChild_setup <- case child_setup of
        Nothing -> return (castPtrToFunPtr nullPtr)
        Just jChild_setup -> do
            jChild_setup' <- GLib.mkSpawnChildSetupFunc (GLib.spawnChildSetupFuncWrapper Nothing jChild_setup)
            return jChild_setup'
    child_pid <- allocMem :: IO (Ptr Int32)
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    let child_setup_data = nullPtr
    onException (do
        _ <- propagateGError $ vte_terminal_spawn_sync _obj' pty_flags' maybeWorking_directory argv' maybeEnvv spawn_flags' maybeChild_setup child_setup_data child_pid maybeCancellable
        child_pid' <- peek child_pid
        safeFreeFunPtr $ castFunPtrToPtr maybeChild_setup
        touchManagedPtr _obj
        whenJust cancellable touchManagedPtr
        freeMem maybeWorking_directory
        mapZeroTerminatedCArray freeMem argv'
        freeMem argv'
        mapZeroTerminatedCArray freeMem maybeEnvv
        freeMem maybeEnvv
        freeMem child_pid
        return child_pid'
     ) (do
        safeFreeFunPtr $ castFunPtrToPtr maybeChild_setup
        freeMem maybeWorking_directory
        mapZeroTerminatedCArray freeMem argv'
        freeMem argv'
        mapZeroTerminatedCArray freeMem maybeEnvv
        freeMem maybeEnvv
        freeMem child_pid
     )

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

foreign import ccall "vte_terminal_unselect_all" vte_terminal_unselect_all :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    IO ()


terminalUnselectAll ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    m ()
terminalUnselectAll _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    vte_terminal_unselect_all _obj'
    touchManagedPtr _obj
    return ()

-- method Terminal::watch_child
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_pid", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "child_pid", 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 "vte_terminal_watch_child" vte_terminal_watch_child :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Int32 ->                                -- child_pid : TBasicType TInt32
    IO ()


terminalWatchChild ::
    (MonadIO m, TerminalK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- child_pid
    m ()
terminalWatchChild _obj child_pid = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    vte_terminal_watch_child _obj' child_pid
    touchManagedPtr _obj
    return ()

-- method Terminal::write_contents_sync
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Vte" "WriteFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Vte" "Terminal", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "stream", argType = TInterface "Gio" "OutputStream", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Vte" "WriteFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : True
-- Skip return : False

foreign import ccall "vte_terminal_write_contents_sync" vte_terminal_write_contents_sync :: 
    Ptr Terminal ->                         -- _obj : TInterface "Vte" "Terminal"
    Ptr Gio.OutputStream ->                 -- stream : TInterface "Gio" "OutputStream"
    CUInt ->                                -- flags : TInterface "Vte" "WriteFlags"
    Ptr Gio.Cancellable ->                  -- cancellable : TInterface "Gio" "Cancellable"
    Ptr (Ptr GError) ->                     -- error
    IO CInt


terminalWriteContentsSync ::
    (MonadIO m, TerminalK a, Gio.OutputStreamK b, Gio.CancellableK c) =>
    a ->                                    -- _obj
    b ->                                    -- stream
    WriteFlags ->                           -- flags
    Maybe (c) ->                            -- cancellable
    m ()
terminalWriteContentsSync _obj stream flags cancellable = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let stream' = unsafeManagedPtrCastPtr stream
    let flags' = (fromIntegral . fromEnum) flags
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    onException (do
        _ <- propagateGError $ vte_terminal_write_contents_sync _obj' stream' flags' maybeCancellable
        touchManagedPtr _obj
        touchManagedPtr stream
        whenJust cancellable touchManagedPtr
        return ()
     ) (do
        return ()
     )