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

module GI.Gtk.Objects.Clipboard
    ( 

-- * Exported types
    Clipboard(..)                           ,
    ClipboardK                              ,
    toClipboard                             ,
    noClipboard                             ,


 -- * Methods
-- ** clipboardClear
    clipboardClear                          ,


-- ** clipboardGet
    clipboardGet                            ,


-- ** clipboardGetDefault
    clipboardGetDefault                     ,


-- ** clipboardGetDisplay
    clipboardGetDisplay                     ,


-- ** clipboardGetForDisplay
    clipboardGetForDisplay                  ,


-- ** clipboardGetOwner
    clipboardGetOwner                       ,


-- ** clipboardRequestContents
    clipboardRequestContents                ,


-- ** clipboardRequestImage
    clipboardRequestImage                   ,


-- ** clipboardRequestRichText
    clipboardRequestRichText                ,


-- ** clipboardRequestTargets
    clipboardRequestTargets                 ,


-- ** clipboardRequestText
    clipboardRequestText                    ,


-- ** clipboardRequestUris
    clipboardRequestUris                    ,


-- ** clipboardSetCanStore
    clipboardSetCanStore                    ,


-- ** clipboardSetImage
    clipboardSetImage                       ,


-- ** clipboardSetText
    clipboardSetText                        ,


-- ** clipboardStore
    clipboardStore                          ,


-- ** clipboardWaitForContents
    clipboardWaitForContents                ,


-- ** clipboardWaitForImage
    clipboardWaitForImage                   ,


-- ** clipboardWaitForRichText
    clipboardWaitForRichText                ,


-- ** clipboardWaitForTargets
    clipboardWaitForTargets                 ,


-- ** clipboardWaitForText
    clipboardWaitForText                    ,


-- ** clipboardWaitForUris
    clipboardWaitForUris                    ,


-- ** clipboardWaitIsImageAvailable
    clipboardWaitIsImageAvailable           ,


-- ** clipboardWaitIsRichTextAvailable
    clipboardWaitIsRichTextAvailable        ,


-- ** clipboardWaitIsTargetAvailable
    clipboardWaitIsTargetAvailable          ,


-- ** clipboardWaitIsTextAvailable
    clipboardWaitIsTextAvailable            ,


-- ** clipboardWaitIsUrisAvailable
    clipboardWaitIsUrisAvailable            ,




 -- * Signals
-- ** OwnerChange
    ClipboardOwnerChangeCallback            ,
    ClipboardOwnerChangeCallbackC           ,
    ClipboardOwnerChangeSignalInfo          ,
    afterClipboardOwnerChange               ,
    clipboardOwnerChangeCallbackWrapper     ,
    clipboardOwnerChangeClosure             ,
    mkClipboardOwnerChangeCallback          ,
    noClipboardOwnerChangeCallback          ,
    onClipboardOwnerChange                  ,




    ) where

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

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

import GI.Gtk.Types
import GI.Gtk.Callbacks
import qualified GI.GObject as GObject
import qualified GI.Gdk as Gdk
import qualified GI.GdkPixbuf as GdkPixbuf

newtype Clipboard = Clipboard (ForeignPtr Clipboard)
foreign import ccall "gtk_clipboard_get_type"
    c_gtk_clipboard_get_type :: IO GType

type instance ParentTypes Clipboard = ClipboardParentTypes
type ClipboardParentTypes = '[GObject.Object]

instance GObject Clipboard where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_gtk_clipboard_get_type
    

class GObject o => ClipboardK o
instance (GObject o, IsDescendantOf Clipboard o) => ClipboardK o

toClipboard :: ClipboardK o => o -> IO Clipboard
toClipboard = unsafeCastTo Clipboard

noClipboard :: Maybe Clipboard
noClipboard = Nothing

-- signal Clipboard::owner-change
type ClipboardOwnerChangeCallback =
    Gdk.EventOwnerChange ->
    IO ()

noClipboardOwnerChangeCallback :: Maybe ClipboardOwnerChangeCallback
noClipboardOwnerChangeCallback = Nothing

type ClipboardOwnerChangeCallbackC =
    Ptr () ->                               -- object
    Ptr Gdk.EventOwnerChange ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkClipboardOwnerChangeCallback :: ClipboardOwnerChangeCallbackC -> IO (FunPtr ClipboardOwnerChangeCallbackC)

clipboardOwnerChangeClosure :: ClipboardOwnerChangeCallback -> IO Closure
clipboardOwnerChangeClosure cb = newCClosure =<< mkClipboardOwnerChangeCallback wrapped
    where wrapped = clipboardOwnerChangeCallbackWrapper cb

clipboardOwnerChangeCallbackWrapper ::
    ClipboardOwnerChangeCallback ->
    Ptr () ->
    Ptr Gdk.EventOwnerChange ->
    Ptr () ->
    IO ()
clipboardOwnerChangeCallbackWrapper _cb _ event _ = do
    event' <- (newPtr 56 Gdk.EventOwnerChange) event
    _cb  event'

onClipboardOwnerChange :: (GObject a, MonadIO m) => a -> ClipboardOwnerChangeCallback -> m SignalHandlerId
onClipboardOwnerChange obj cb = liftIO $ connectClipboardOwnerChange obj cb SignalConnectBefore
afterClipboardOwnerChange :: (GObject a, MonadIO m) => a -> ClipboardOwnerChangeCallback -> m SignalHandlerId
afterClipboardOwnerChange obj cb = connectClipboardOwnerChange obj cb SignalConnectAfter

connectClipboardOwnerChange :: (GObject a, MonadIO m) =>
                               a -> ClipboardOwnerChangeCallback -> SignalConnectMode -> m SignalHandlerId
connectClipboardOwnerChange obj cb after = liftIO $ do
    cb' <- mkClipboardOwnerChangeCallback (clipboardOwnerChangeCallbackWrapper cb)
    connectSignalFunPtr obj "owner-change" cb' after

type instance AttributeList Clipboard = ClipboardAttributeList
type ClipboardAttributeList = ('[ ] :: [(Symbol, *)])

data ClipboardOwnerChangeSignalInfo
instance SignalInfo ClipboardOwnerChangeSignalInfo where
    type HaskellCallbackType ClipboardOwnerChangeSignalInfo = ClipboardOwnerChangeCallback
    connectSignal _ = connectClipboardOwnerChange

type instance SignalList Clipboard = ClipboardSignalList
type ClipboardSignalList = ('[ '("notify", GObject.ObjectNotifySignalInfo), '("owner-change", ClipboardOwnerChangeSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

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

foreign import ccall "gtk_clipboard_clear" gtk_clipboard_clear :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    IO ()


clipboardClear ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    m ()
clipboardClear _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_clipboard_clear _obj'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "gtk_clipboard_get_display" gtk_clipboard_get_display :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    IO (Ptr Gdk.Display)


clipboardGetDisplay ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    m Gdk.Display
clipboardGetDisplay _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_clipboard_get_display _obj'
    checkUnexpectedReturnNULL "gtk_clipboard_get_display" result
    result' <- (newObject Gdk.Display) result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "gtk_clipboard_get_owner" gtk_clipboard_get_owner :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    IO (Ptr GObject.Object)


clipboardGetOwner ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    m GObject.Object
clipboardGetOwner _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_clipboard_get_owner _obj'
    checkUnexpectedReturnNULL "gtk_clipboard_get_owner" result
    result' <- (newObject GObject.Object) result
    touchManagedPtr _obj
    return result'

-- method Clipboard::request_contents
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target", argType = TInterface "Gdk" "Atom", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gtk" "ClipboardReceivedFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "target", argType = TInterface "Gdk" "Atom", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gtk" "ClipboardReceivedFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_clipboard_request_contents" gtk_clipboard_request_contents :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    Ptr Gdk.Atom ->                         -- target : TInterface "Gdk" "Atom"
    FunPtr ClipboardReceivedFuncC ->        -- callback : TInterface "Gtk" "ClipboardReceivedFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    IO ()


clipboardRequestContents ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    Gdk.Atom ->                             -- target
    ClipboardReceivedFunc ->                -- callback
    m ()
clipboardRequestContents _obj target callback = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let target' = unsafeManagedPtrGetPtr target
    ptrcallback <- callocMem :: IO (Ptr (FunPtr ClipboardReceivedFuncC))
    callback' <- mkClipboardReceivedFunc (clipboardReceivedFuncWrapper (Just ptrcallback) callback)
    poke ptrcallback callback'
    let user_data = nullPtr
    gtk_clipboard_request_contents _obj' target' callback' user_data
    touchManagedPtr _obj
    touchManagedPtr target
    return ()

-- method Clipboard::request_image
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gtk" "ClipboardImageReceivedFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, 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}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gtk" "ClipboardImageReceivedFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = 2, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_clipboard_request_image" gtk_clipboard_request_image :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    FunPtr ClipboardImageReceivedFuncC ->   -- callback : TInterface "Gtk" "ClipboardImageReceivedFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    IO ()


clipboardRequestImage ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    ClipboardImageReceivedFunc ->           -- callback
    m ()
clipboardRequestImage _obj callback = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    ptrcallback <- callocMem :: IO (Ptr (FunPtr ClipboardImageReceivedFuncC))
    callback' <- mkClipboardImageReceivedFunc (clipboardImageReceivedFuncWrapper (Just ptrcallback) callback)
    poke ptrcallback callback'
    let user_data = nullPtr
    gtk_clipboard_request_image _obj' callback' user_data
    touchManagedPtr _obj
    return ()

-- method Clipboard::request_rich_text
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gtk" "ClipboardRichTextReceivedFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing},Arg {argName = "user_data", argType = TBasicType TVoid, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gtk" "ClipboardRichTextReceivedFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = 3, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_clipboard_request_rich_text" gtk_clipboard_request_rich_text :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    Ptr TextBuffer ->                       -- buffer : TInterface "Gtk" "TextBuffer"
    FunPtr ClipboardRichTextReceivedFuncC -> -- callback : TInterface "Gtk" "ClipboardRichTextReceivedFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    IO ()


clipboardRequestRichText ::
    (MonadIO m, ClipboardK a, TextBufferK b) =>
    a ->                                    -- _obj
    b ->                                    -- buffer
    ClipboardRichTextReceivedFunc ->        -- callback
    m ()
clipboardRequestRichText _obj buffer callback = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let buffer' = unsafeManagedPtrCastPtr buffer
    ptrcallback <- callocMem :: IO (Ptr (FunPtr ClipboardRichTextReceivedFuncC))
    callback' <- mkClipboardRichTextReceivedFunc (clipboardRichTextReceivedFuncWrapper (Just ptrcallback) callback)
    poke ptrcallback callback'
    let user_data = nullPtr
    gtk_clipboard_request_rich_text _obj' buffer' callback' user_data
    touchManagedPtr _obj
    touchManagedPtr buffer
    return ()

-- method Clipboard::request_targets
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gtk" "ClipboardTargetsReceivedFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, 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}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gtk" "ClipboardTargetsReceivedFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = 2, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_clipboard_request_targets" gtk_clipboard_request_targets :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    FunPtr ClipboardTargetsReceivedFuncC -> -- callback : TInterface "Gtk" "ClipboardTargetsReceivedFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    IO ()


clipboardRequestTargets ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    ClipboardTargetsReceivedFunc ->         -- callback
    m ()
clipboardRequestTargets _obj callback = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    ptrcallback <- callocMem :: IO (Ptr (FunPtr ClipboardTargetsReceivedFuncC))
    callback' <- mkClipboardTargetsReceivedFunc (clipboardTargetsReceivedFuncWrapper (Just ptrcallback) callback)
    poke ptrcallback callback'
    let user_data = nullPtr
    gtk_clipboard_request_targets _obj' callback' user_data
    touchManagedPtr _obj
    return ()

-- method Clipboard::request_text
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gtk" "ClipboardTextReceivedFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, 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}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gtk" "ClipboardTextReceivedFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = 2, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_clipboard_request_text" gtk_clipboard_request_text :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    FunPtr ClipboardTextReceivedFuncC ->    -- callback : TInterface "Gtk" "ClipboardTextReceivedFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    IO ()


clipboardRequestText ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    ClipboardTextReceivedFunc ->            -- callback
    m ()
clipboardRequestText _obj callback = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    ptrcallback <- callocMem :: IO (Ptr (FunPtr ClipboardTextReceivedFuncC))
    callback' <- mkClipboardTextReceivedFunc (clipboardTextReceivedFuncWrapper (Just ptrcallback) callback)
    poke ptrcallback callback'
    let user_data = nullPtr
    gtk_clipboard_request_text _obj' callback' user_data
    touchManagedPtr _obj
    return ()

-- method Clipboard::request_uris
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gtk" "ClipboardURIReceivedFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, 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}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "callback", argType = TInterface "Gtk" "ClipboardURIReceivedFunc", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeAsync, argClosure = 2, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_clipboard_request_uris" gtk_clipboard_request_uris :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    FunPtr ClipboardURIReceivedFuncC ->     -- callback : TInterface "Gtk" "ClipboardURIReceivedFunc"
    Ptr () ->                               -- user_data : TBasicType TVoid
    IO ()


clipboardRequestUris ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    ClipboardURIReceivedFunc ->             -- callback
    m ()
clipboardRequestUris _obj callback = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    ptrcallback <- callocMem :: IO (Ptr (FunPtr ClipboardURIReceivedFuncC))
    callback' <- mkClipboardURIReceivedFunc (clipboardURIReceivedFuncWrapper (Just ptrcallback) callback)
    poke ptrcallback callback'
    let user_data = nullPtr
    gtk_clipboard_request_uris _obj' callback' user_data
    touchManagedPtr _obj
    return ()

-- method Clipboard::set_can_store
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "targets", argType = TCArray False (-1) 2 (TInterface "Gtk" "TargetEntry"), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_targets", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : [Arg {argName = "n_targets", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "targets", argType = TCArray False (-1) 2 (TInterface "Gtk" "TargetEntry"), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_clipboard_set_can_store" gtk_clipboard_set_can_store :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    Ptr TargetEntry ->                      -- targets : TCArray False (-1) 2 (TInterface "Gtk" "TargetEntry")
    Int32 ->                                -- n_targets : TBasicType TInt32
    IO ()


clipboardSetCanStore ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    Maybe ([TargetEntry]) ->                -- targets
    m ()
clipboardSetCanStore _obj targets = liftIO $ do
    let n_targets = case targets of
            Nothing -> 0
            Just jTargets -> fromIntegral $ length jTargets
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeTargets <- case targets of
        Nothing -> return nullPtr
        Just jTargets -> do
            let jTargets' = map unsafeManagedPtrGetPtr jTargets
            jTargets'' <- packBlockArray 16 jTargets'
            return jTargets''
    gtk_clipboard_set_can_store _obj' maybeTargets n_targets
    touchManagedPtr _obj
    whenJust targets (mapM_ touchManagedPtr)
    freeMem maybeTargets
    return ()

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

foreign import ccall "gtk_clipboard_set_image" gtk_clipboard_set_image :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    Ptr GdkPixbuf.Pixbuf ->                 -- pixbuf : TInterface "GdkPixbuf" "Pixbuf"
    IO ()


clipboardSetImage ::
    (MonadIO m, ClipboardK a, GdkPixbuf.PixbufK b) =>
    a ->                                    -- _obj
    b ->                                    -- pixbuf
    m ()
clipboardSetImage _obj pixbuf = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let pixbuf' = unsafeManagedPtrCastPtr pixbuf
    gtk_clipboard_set_image _obj' pixbuf'
    touchManagedPtr _obj
    touchManagedPtr pixbuf
    return ()

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

foreign import ccall "gtk_clipboard_set_text" gtk_clipboard_set_text :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    CString ->                              -- text : TBasicType TUTF8
    Int32 ->                                -- len : TBasicType TInt32
    IO ()


clipboardSetText ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- text
    Int32 ->                                -- len
    m ()
clipboardSetText _obj text len = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    text' <- textToCString text
    gtk_clipboard_set_text _obj' text' len
    touchManagedPtr _obj
    freeMem text'
    return ()

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

foreign import ccall "gtk_clipboard_store" gtk_clipboard_store :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    IO ()


clipboardStore ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    m ()
clipboardStore _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_clipboard_store _obj'
    touchManagedPtr _obj
    return ()

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

foreign import ccall "gtk_clipboard_wait_for_contents" gtk_clipboard_wait_for_contents :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    Ptr Gdk.Atom ->                         -- target : TInterface "Gdk" "Atom"
    IO (Ptr SelectionData)


clipboardWaitForContents ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    Gdk.Atom ->                             -- target
    m SelectionData
clipboardWaitForContents _obj target = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let target' = unsafeManagedPtrGetPtr target
    result <- gtk_clipboard_wait_for_contents _obj' target'
    checkUnexpectedReturnNULL "gtk_clipboard_wait_for_contents" result
    result' <- (wrapBoxed SelectionData) result
    touchManagedPtr _obj
    touchManagedPtr target
    return result'

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

foreign import ccall "gtk_clipboard_wait_for_image" gtk_clipboard_wait_for_image :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    IO (Ptr GdkPixbuf.Pixbuf)


clipboardWaitForImage ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    m GdkPixbuf.Pixbuf
clipboardWaitForImage _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_clipboard_wait_for_image _obj'
    checkUnexpectedReturnNULL "gtk_clipboard_wait_for_image" result
    result' <- (wrapObject GdkPixbuf.Pixbuf) result
    touchManagedPtr _obj
    return result'

-- method Clipboard::wait_for_rich_text
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "format", argType = TInterface "Gdk" "Atom", direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : [Arg {argName = "length", argType = TBasicType TUInt64, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "buffer", argType = TInterface "Gtk" "TextBuffer", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TCArray False (-1) 3 (TBasicType TUInt8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_clipboard_wait_for_rich_text" gtk_clipboard_wait_for_rich_text :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    Ptr TextBuffer ->                       -- buffer : TInterface "Gtk" "TextBuffer"
    Ptr (Ptr Gdk.Atom) ->                   -- format : TInterface "Gdk" "Atom"
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    IO (Ptr Word8)


clipboardWaitForRichText ::
    (MonadIO m, ClipboardK a, TextBufferK b) =>
    a ->                                    -- _obj
    b ->                                    -- buffer
    m (ByteString,Gdk.Atom)
clipboardWaitForRichText _obj buffer = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let buffer' = unsafeManagedPtrCastPtr buffer
    format <- allocMem :: IO (Ptr (Ptr Gdk.Atom))
    length_ <- allocMem :: IO (Ptr Word64)
    result <- gtk_clipboard_wait_for_rich_text _obj' buffer' format length_
    length_' <- peek length_
    checkUnexpectedReturnNULL "gtk_clipboard_wait_for_rich_text" result
    result' <- (unpackByteStringWithLength length_') result
    freeMem result
    format' <- peek format
    -- XXX Wrapping a foreign struct/union with no known destructor, leak?
    format'' <- (\x -> Gdk.Atom <$> newForeignPtr_ x) format'
    touchManagedPtr _obj
    touchManagedPtr buffer
    freeMem format
    freeMem length_
    return (result', format'')

-- method Clipboard::wait_for_targets
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "targets", argType = TCArray False (-1) 2 (TInterface "Gdk" "Atom"), direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferContainer},Arg {argName = "n_targets", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : [Arg {argName = "n_targets", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Clipboard", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_clipboard_wait_for_targets" gtk_clipboard_wait_for_targets :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    Ptr (Ptr (Ptr Gdk.Atom)) ->             -- targets : TCArray False (-1) 2 (TInterface "Gdk" "Atom")
    Ptr Int32 ->                            -- n_targets : TBasicType TInt32
    IO CInt


clipboardWaitForTargets ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    m (Bool,[Gdk.Atom])
clipboardWaitForTargets _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    targets <- allocMem :: IO (Ptr (Ptr (Ptr Gdk.Atom)))
    n_targets <- allocMem :: IO (Ptr Int32)
    result <- gtk_clipboard_wait_for_targets _obj' targets n_targets
    n_targets' <- peek n_targets
    let result' = (/= 0) result
    targets' <- peek targets
    -- XXX Wrapping a foreign struct/union with no known destructor, leak?
    targets'' <- (unpackPtrArrayWithLength n_targets') targets'
    targets''' <- mapM (\x -> Gdk.Atom <$> newForeignPtr_ x) targets''
    freeMem targets'
    touchManagedPtr _obj
    freeMem targets
    freeMem n_targets
    return (result', targets''')

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

foreign import ccall "gtk_clipboard_wait_for_text" gtk_clipboard_wait_for_text :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    IO CString


clipboardWaitForText ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    m T.Text
clipboardWaitForText _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_clipboard_wait_for_text _obj'
    checkUnexpectedReturnNULL "gtk_clipboard_wait_for_text" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "gtk_clipboard_wait_for_uris" gtk_clipboard_wait_for_uris :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    IO (Ptr CString)


clipboardWaitForUris ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    m [T.Text]
clipboardWaitForUris _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_clipboard_wait_for_uris _obj'
    checkUnexpectedReturnNULL "gtk_clipboard_wait_for_uris" result
    result' <- unpackZeroTerminatedUTF8CArray result
    mapZeroTerminatedCArray freeMem result
    freeMem result
    touchManagedPtr _obj
    return result'

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

foreign import ccall "gtk_clipboard_wait_is_image_available" gtk_clipboard_wait_is_image_available :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    IO CInt


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

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

foreign import ccall "gtk_clipboard_wait_is_rich_text_available" gtk_clipboard_wait_is_rich_text_available :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    Ptr TextBuffer ->                       -- buffer : TInterface "Gtk" "TextBuffer"
    IO CInt


clipboardWaitIsRichTextAvailable ::
    (MonadIO m, ClipboardK a, TextBufferK b) =>
    a ->                                    -- _obj
    b ->                                    -- buffer
    m Bool
clipboardWaitIsRichTextAvailable _obj buffer = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let buffer' = unsafeManagedPtrCastPtr buffer
    result <- gtk_clipboard_wait_is_rich_text_available _obj' buffer'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr buffer
    return result'

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

foreign import ccall "gtk_clipboard_wait_is_target_available" gtk_clipboard_wait_is_target_available :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    Ptr Gdk.Atom ->                         -- target : TInterface "Gdk" "Atom"
    IO CInt


clipboardWaitIsTargetAvailable ::
    (MonadIO m, ClipboardK a) =>
    a ->                                    -- _obj
    Gdk.Atom ->                             -- target
    m Bool
clipboardWaitIsTargetAvailable _obj target = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let target' = unsafeManagedPtrGetPtr target
    result <- gtk_clipboard_wait_is_target_available _obj' target'
    let result' = (/= 0) result
    touchManagedPtr _obj
    touchManagedPtr target
    return result'

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

foreign import ccall "gtk_clipboard_wait_is_text_available" gtk_clipboard_wait_is_text_available :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    IO CInt


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

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

foreign import ccall "gtk_clipboard_wait_is_uris_available" gtk_clipboard_wait_is_uris_available :: 
    Ptr Clipboard ->                        -- _obj : TInterface "Gtk" "Clipboard"
    IO CInt


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

-- method Clipboard::get
-- method type : MemberFunction
-- Args : [Arg {argName = "selection", argType = TInterface "Gdk" "Atom", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "selection", argType = TInterface "Gdk" "Atom", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Clipboard"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_clipboard_get" gtk_clipboard_get :: 
    Ptr Gdk.Atom ->                         -- selection : TInterface "Gdk" "Atom"
    IO (Ptr Clipboard)


clipboardGet ::
    (MonadIO m) =>
    Gdk.Atom ->                             -- selection
    m Clipboard
clipboardGet selection = liftIO $ do
    let selection' = unsafeManagedPtrGetPtr selection
    result <- gtk_clipboard_get selection'
    checkUnexpectedReturnNULL "gtk_clipboard_get" result
    result' <- (newObject Clipboard) result
    touchManagedPtr selection
    return result'

-- method Clipboard::get_default
-- method type : MemberFunction
-- Args : [Arg {argName = "display", argType = TInterface "Gdk" "Display", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "display", argType = TInterface "Gdk" "Display", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Clipboard"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_clipboard_get_default" gtk_clipboard_get_default :: 
    Ptr Gdk.Display ->                      -- display : TInterface "Gdk" "Display"
    IO (Ptr Clipboard)


clipboardGetDefault ::
    (MonadIO m, Gdk.DisplayK a) =>
    a ->                                    -- display
    m Clipboard
clipboardGetDefault display = liftIO $ do
    let display' = unsafeManagedPtrCastPtr display
    result <- gtk_clipboard_get_default display'
    checkUnexpectedReturnNULL "gtk_clipboard_get_default" result
    result' <- (newObject Clipboard) result
    touchManagedPtr display
    return result'

-- method Clipboard::get_for_display
-- method type : MemberFunction
-- Args : [Arg {argName = "display", argType = TInterface "Gdk" "Display", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "selection", argType = TInterface "Gdk" "Atom", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "display", argType = TInterface "Gdk" "Display", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "selection", argType = TInterface "Gdk" "Atom", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Clipboard"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_clipboard_get_for_display" gtk_clipboard_get_for_display :: 
    Ptr Gdk.Display ->                      -- display : TInterface "Gdk" "Display"
    Ptr Gdk.Atom ->                         -- selection : TInterface "Gdk" "Atom"
    IO (Ptr Clipboard)


clipboardGetForDisplay ::
    (MonadIO m, Gdk.DisplayK a) =>
    a ->                                    -- display
    Gdk.Atom ->                             -- selection
    m Clipboard
clipboardGetForDisplay display selection = liftIO $ do
    let display' = unsafeManagedPtrCastPtr display
    let selection' = unsafeManagedPtrGetPtr selection
    result <- gtk_clipboard_get_for_display display' selection'
    checkUnexpectedReturnNULL "gtk_clipboard_get_for_display" result
    result' <- (newObject Clipboard) result
    touchManagedPtr display
    touchManagedPtr selection
    return result'