{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkDragSource@ is an event controller to initiate Drag-And-Drop operations.
-- 
-- @GtkDragSource@ can be set up with the necessary
-- ingredients for a DND operation ahead of time. This includes
-- the source for the data that is being transferred, in the form
-- of a t'GI.Gdk.Objects.ContentProvider.ContentProvider', the desired action, and the icon to
-- use during the drag operation. After setting it up, the drag
-- source must be added to a widget as an event controller, using
-- 'GI.Gtk.Objects.Widget.widgetAddController'.
-- 
-- 
-- === /c code/
-- >static void
-- >my_widget_init (MyWidget *self)
-- >{
-- >  GtkDragSource *drag_source = gtk_drag_source_new ();
-- >
-- >  g_signal_connect (drag_source, "prepare", G_CALLBACK (on_drag_prepare), self);
-- >  g_signal_connect (drag_source, "drag-begin", G_CALLBACK (on_drag_begin), self);
-- >
-- >  gtk_widget_add_controller (GTK_WIDGET (self), GTK_EVENT_CONTROLLER (drag_source));
-- >}
-- 
-- 
-- Setting up the content provider and icon ahead of time only makes
-- sense when the data does not change. More commonly, you will want
-- to set them up just in time. To do so, @GtkDragSource@ has
-- [DragSource::prepare]("GI.Gtk.Objects.DragSource#g:signal:prepare") and [DragSource::dragBegin]("GI.Gtk.Objects.DragSource#g:signal:dragBegin")
-- signals.
-- 
-- The [prepare](#g:signal:prepare) signal is emitted before a drag is started, and
-- can be used to set the content provider and actions that the
-- drag should be started with.
-- 
-- 
-- === /c code/
-- >static GdkContentProvider *
-- >on_drag_prepare (GtkDragSource *source,
-- >                 double         x,
-- >                 double         y,
-- >                 MyWidget      *self)
-- >{
-- >  // This widget supports two types of content: GFile objects
-- >  // and GdkPixbuf objects; GTK will handle the serialization
-- >  // of these types automatically
-- >  GFile *file = my_widget_get_file (self);
-- >  GdkPixbuf *pixbuf = my_widget_get_pixbuf (self);
-- >
-- >  return gdk_content_provider_new_union ((GdkContentProvider *[2]) {
-- >      gdk_content_provider_new_typed (G_TYPE_FILE, file),
-- >      gdk_content_provider_new_typed (GDK_TYPE_PIXBUF, pixbuf),
-- >    }, 2);
-- >}
-- 
-- 
-- The [dragBegin](#g:signal:dragBegin) signal is emitted after the @GdkDrag@ object has
-- been created, and can be used to set up the drag icon.
-- 
-- 
-- === /c code/
-- >static void
-- >on_drag_begin (GtkDragSource *source,
-- >               GtkDrag       *drag,
-- >               MyWidget      *self)
-- >{
-- >  // Set the widget as the drag icon
-- >  GdkPaintable *paintable = gtk_widget_paintable_new (GTK_WIDGET (self));
-- >  gtk_drag_source_set_icon (source, paintable, 0, 0);
-- >  g_object_unref (paintable);
-- >}
-- 
-- 
-- During the DND operation, @GtkDragSource@ emits signals that
-- can be used to obtain updates about the status of the operation,
-- but it is not normally necessary to connect to any signals,
-- except for one case: when the supported actions include
-- 'GI.Gdk.Flags.DragActionMove', you need to listen for the
-- [DragSource::dragEnd]("GI.Gtk.Objects.DragSource#g:signal:dragEnd") signal and delete the
-- data after it has been transferred.

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Gtk.Objects.DragSource
    ( 

-- * Exported types
    DragSource(..)                          ,
    IsDragSource                            ,
    toDragSource                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [dragCancel]("GI.Gtk.Objects.DragSource#g:method:dragCancel"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [group]("GI.Gtk.Objects.Gesture#g:method:group"), [handlesSequence]("GI.Gtk.Objects.Gesture#g:method:handlesSequence"), [isActive]("GI.Gtk.Objects.Gesture#g:method:isActive"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isGroupedWith]("GI.Gtk.Objects.Gesture#g:method:isGroupedWith"), [isRecognized]("GI.Gtk.Objects.Gesture#g:method:isRecognized"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [reset]("GI.Gtk.Objects.EventController#g:method:reset"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [ungroup]("GI.Gtk.Objects.Gesture#g:method:ungroup"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getActions]("GI.Gtk.Objects.DragSource#g:method:getActions"), [getBoundingBox]("GI.Gtk.Objects.Gesture#g:method:getBoundingBox"), [getBoundingBoxCenter]("GI.Gtk.Objects.Gesture#g:method:getBoundingBoxCenter"), [getButton]("GI.Gtk.Objects.GestureSingle#g:method:getButton"), [getContent]("GI.Gtk.Objects.DragSource#g:method:getContent"), [getCurrentButton]("GI.Gtk.Objects.GestureSingle#g:method:getCurrentButton"), [getCurrentEvent]("GI.Gtk.Objects.EventController#g:method:getCurrentEvent"), [getCurrentEventDevice]("GI.Gtk.Objects.EventController#g:method:getCurrentEventDevice"), [getCurrentEventState]("GI.Gtk.Objects.EventController#g:method:getCurrentEventState"), [getCurrentEventTime]("GI.Gtk.Objects.EventController#g:method:getCurrentEventTime"), [getCurrentSequence]("GI.Gtk.Objects.GestureSingle#g:method:getCurrentSequence"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDevice]("GI.Gtk.Objects.Gesture#g:method:getDevice"), [getDrag]("GI.Gtk.Objects.DragSource#g:method:getDrag"), [getExclusive]("GI.Gtk.Objects.GestureSingle#g:method:getExclusive"), [getGroup]("GI.Gtk.Objects.Gesture#g:method:getGroup"), [getLastEvent]("GI.Gtk.Objects.Gesture#g:method:getLastEvent"), [getLastUpdatedSequence]("GI.Gtk.Objects.Gesture#g:method:getLastUpdatedSequence"), [getName]("GI.Gtk.Objects.EventController#g:method:getName"), [getPoint]("GI.Gtk.Objects.Gesture#g:method:getPoint"), [getPropagationLimit]("GI.Gtk.Objects.EventController#g:method:getPropagationLimit"), [getPropagationPhase]("GI.Gtk.Objects.EventController#g:method:getPropagationPhase"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSequenceState]("GI.Gtk.Objects.Gesture#g:method:getSequenceState"), [getSequences]("GI.Gtk.Objects.Gesture#g:method:getSequences"), [getTouchOnly]("GI.Gtk.Objects.GestureSingle#g:method:getTouchOnly"), [getWidget]("GI.Gtk.Objects.EventController#g:method:getWidget").
-- 
-- ==== Setters
-- [setActions]("GI.Gtk.Objects.DragSource#g:method:setActions"), [setButton]("GI.Gtk.Objects.GestureSingle#g:method:setButton"), [setContent]("GI.Gtk.Objects.DragSource#g:method:setContent"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setExclusive]("GI.Gtk.Objects.GestureSingle#g:method:setExclusive"), [setIcon]("GI.Gtk.Objects.DragSource#g:method:setIcon"), [setName]("GI.Gtk.Objects.EventController#g:method:setName"), [setPropagationLimit]("GI.Gtk.Objects.EventController#g:method:setPropagationLimit"), [setPropagationPhase]("GI.Gtk.Objects.EventController#g:method:setPropagationPhase"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSequenceState]("GI.Gtk.Objects.Gesture#g:method:setSequenceState"), [setState]("GI.Gtk.Objects.Gesture#g:method:setState"), [setTouchOnly]("GI.Gtk.Objects.GestureSingle#g:method:setTouchOnly").

#if defined(ENABLE_OVERLOADING)
    ResolveDragSourceMethod                 ,
#endif

-- ** dragCancel #method:dragCancel#

#if defined(ENABLE_OVERLOADING)
    DragSourceDragCancelMethodInfo          ,
#endif
    dragSourceDragCancel                    ,


-- ** getActions #method:getActions#

#if defined(ENABLE_OVERLOADING)
    DragSourceGetActionsMethodInfo          ,
#endif
    dragSourceGetActions                    ,


-- ** getContent #method:getContent#

#if defined(ENABLE_OVERLOADING)
    DragSourceGetContentMethodInfo          ,
#endif
    dragSourceGetContent                    ,


-- ** getDrag #method:getDrag#

#if defined(ENABLE_OVERLOADING)
    DragSourceGetDragMethodInfo             ,
#endif
    dragSourceGetDrag                       ,


-- ** new #method:new#

    dragSourceNew                           ,


-- ** setActions #method:setActions#

#if defined(ENABLE_OVERLOADING)
    DragSourceSetActionsMethodInfo          ,
#endif
    dragSourceSetActions                    ,


-- ** setContent #method:setContent#

#if defined(ENABLE_OVERLOADING)
    DragSourceSetContentMethodInfo          ,
#endif
    dragSourceSetContent                    ,


-- ** setIcon #method:setIcon#

#if defined(ENABLE_OVERLOADING)
    DragSourceSetIconMethodInfo             ,
#endif
    dragSourceSetIcon                       ,




 -- * Properties


-- ** actions #attr:actions#
-- | The actions that are supported by drag operations from the source.
-- 
-- Note that you must handle the [DragSource::dragEnd]("GI.Gtk.Objects.DragSource#g:signal:dragEnd") signal
-- if the actions include 'GI.Gdk.Flags.DragActionMove'.

#if defined(ENABLE_OVERLOADING)
    DragSourceActionsPropertyInfo           ,
#endif
    constructDragSourceActions              ,
#if defined(ENABLE_OVERLOADING)
    dragSourceActions                       ,
#endif
    getDragSourceActions                    ,
    setDragSourceActions                    ,


-- ** content #attr:content#
-- | The data that is offered by drag operations from this source.

#if defined(ENABLE_OVERLOADING)
    DragSourceContentPropertyInfo           ,
#endif
    clearDragSourceContent                  ,
    constructDragSourceContent              ,
#if defined(ENABLE_OVERLOADING)
    dragSourceContent                       ,
#endif
    getDragSourceContent                    ,
    setDragSourceContent                    ,




 -- * Signals


-- ** dragBegin #signal:dragBegin#

    DragSourceDragBeginCallback             ,
#if defined(ENABLE_OVERLOADING)
    DragSourceDragBeginSignalInfo           ,
#endif
    afterDragSourceDragBegin                ,
    onDragSourceDragBegin                   ,


-- ** dragCancel #signal:dragCancel#

    DragSourceDragCancelCallback            ,
#if defined(ENABLE_OVERLOADING)
    DragSourceDragCancelSignalInfo          ,
#endif
    afterDragSourceDragCancel               ,
    onDragSourceDragCancel                  ,


-- ** dragEnd #signal:dragEnd#

    DragSourceDragEndCallback               ,
#if defined(ENABLE_OVERLOADING)
    DragSourceDragEndSignalInfo             ,
#endif
    afterDragSourceDragEnd                  ,
    onDragSourceDragEnd                     ,


-- ** prepare #signal:prepare#

    DragSourcePrepareCallback               ,
#if defined(ENABLE_OVERLOADING)
    DragSourcePrepareSignalInfo             ,
#endif
    afterDragSourcePrepare                  ,
    onDragSourcePrepare                     ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Enums as Gdk.Enums
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.Gdk.Objects.ContentProvider as Gdk.ContentProvider
import qualified GI.Gdk.Objects.Drag as Gdk.Drag
import {-# SOURCE #-} qualified GI.Gtk.Objects.EventController as Gtk.EventController
import {-# SOURCE #-} qualified GI.Gtk.Objects.Gesture as Gtk.Gesture
import {-# SOURCE #-} qualified GI.Gtk.Objects.GestureSingle as Gtk.GestureSingle

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

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

foreign import ccall "gtk_drag_source_get_type"
    c_gtk_drag_source_get_type :: IO B.Types.GType

instance B.Types.TypedObject DragSource where
    glibType :: IO GType
glibType = IO GType
c_gtk_drag_source_get_type

instance B.Types.GObject DragSource

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

instance O.HasParentTypes DragSource
type instance O.ParentTypes DragSource = '[Gtk.GestureSingle.GestureSingle, Gtk.Gesture.Gesture, Gtk.EventController.EventController, GObject.Object.Object]

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

-- | Convert 'DragSource' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe DragSource) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_drag_source_get_type
    gvalueSet_ :: Ptr GValue -> Maybe DragSource -> IO ()
gvalueSet_ Ptr GValue
gv Maybe DragSource
P.Nothing = Ptr GValue -> Ptr DragSource -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr DragSource
forall a. Ptr a
FP.nullPtr :: FP.Ptr DragSource)
    gvalueSet_ Ptr GValue
gv (P.Just DragSource
obj) = DragSource -> (Ptr DragSource -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DragSource
obj (Ptr GValue -> Ptr DragSource -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe DragSource)
gvalueGet_ Ptr GValue
gv = do
        Ptr DragSource
ptr <- Ptr GValue -> IO (Ptr DragSource)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr DragSource)
        if Ptr DragSource
ptr Ptr DragSource -> Ptr DragSource -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr DragSource
forall a. Ptr a
FP.nullPtr
        then DragSource -> Maybe DragSource
forall a. a -> Maybe a
P.Just (DragSource -> Maybe DragSource)
-> IO DragSource -> IO (Maybe DragSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr DragSource -> DragSource)
-> Ptr DragSource -> IO DragSource
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr DragSource -> DragSource
DragSource Ptr DragSource
ptr
        else Maybe DragSource -> IO (Maybe DragSource)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DragSource
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveDragSourceMethod (t :: Symbol) (o :: *) :: * where
    ResolveDragSourceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDragSourceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDragSourceMethod "dragCancel" o = DragSourceDragCancelMethodInfo
    ResolveDragSourceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDragSourceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDragSourceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDragSourceMethod "group" o = Gtk.Gesture.GestureGroupMethodInfo
    ResolveDragSourceMethod "handlesSequence" o = Gtk.Gesture.GestureHandlesSequenceMethodInfo
    ResolveDragSourceMethod "isActive" o = Gtk.Gesture.GestureIsActiveMethodInfo
    ResolveDragSourceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDragSourceMethod "isGroupedWith" o = Gtk.Gesture.GestureIsGroupedWithMethodInfo
    ResolveDragSourceMethod "isRecognized" o = Gtk.Gesture.GestureIsRecognizedMethodInfo
    ResolveDragSourceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDragSourceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDragSourceMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDragSourceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDragSourceMethod "reset" o = Gtk.EventController.EventControllerResetMethodInfo
    ResolveDragSourceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDragSourceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDragSourceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDragSourceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDragSourceMethod "ungroup" o = Gtk.Gesture.GestureUngroupMethodInfo
    ResolveDragSourceMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDragSourceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDragSourceMethod "getActions" o = DragSourceGetActionsMethodInfo
    ResolveDragSourceMethod "getBoundingBox" o = Gtk.Gesture.GestureGetBoundingBoxMethodInfo
    ResolveDragSourceMethod "getBoundingBoxCenter" o = Gtk.Gesture.GestureGetBoundingBoxCenterMethodInfo
    ResolveDragSourceMethod "getButton" o = Gtk.GestureSingle.GestureSingleGetButtonMethodInfo
    ResolveDragSourceMethod "getContent" o = DragSourceGetContentMethodInfo
    ResolveDragSourceMethod "getCurrentButton" o = Gtk.GestureSingle.GestureSingleGetCurrentButtonMethodInfo
    ResolveDragSourceMethod "getCurrentEvent" o = Gtk.EventController.EventControllerGetCurrentEventMethodInfo
    ResolveDragSourceMethod "getCurrentEventDevice" o = Gtk.EventController.EventControllerGetCurrentEventDeviceMethodInfo
    ResolveDragSourceMethod "getCurrentEventState" o = Gtk.EventController.EventControllerGetCurrentEventStateMethodInfo
    ResolveDragSourceMethod "getCurrentEventTime" o = Gtk.EventController.EventControllerGetCurrentEventTimeMethodInfo
    ResolveDragSourceMethod "getCurrentSequence" o = Gtk.GestureSingle.GestureSingleGetCurrentSequenceMethodInfo
    ResolveDragSourceMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDragSourceMethod "getDevice" o = Gtk.Gesture.GestureGetDeviceMethodInfo
    ResolveDragSourceMethod "getDrag" o = DragSourceGetDragMethodInfo
    ResolveDragSourceMethod "getExclusive" o = Gtk.GestureSingle.GestureSingleGetExclusiveMethodInfo
    ResolveDragSourceMethod "getGroup" o = Gtk.Gesture.GestureGetGroupMethodInfo
    ResolveDragSourceMethod "getLastEvent" o = Gtk.Gesture.GestureGetLastEventMethodInfo
    ResolveDragSourceMethod "getLastUpdatedSequence" o = Gtk.Gesture.GestureGetLastUpdatedSequenceMethodInfo
    ResolveDragSourceMethod "getName" o = Gtk.EventController.EventControllerGetNameMethodInfo
    ResolveDragSourceMethod "getPoint" o = Gtk.Gesture.GestureGetPointMethodInfo
    ResolveDragSourceMethod "getPropagationLimit" o = Gtk.EventController.EventControllerGetPropagationLimitMethodInfo
    ResolveDragSourceMethod "getPropagationPhase" o = Gtk.EventController.EventControllerGetPropagationPhaseMethodInfo
    ResolveDragSourceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDragSourceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDragSourceMethod "getSequenceState" o = Gtk.Gesture.GestureGetSequenceStateMethodInfo
    ResolveDragSourceMethod "getSequences" o = Gtk.Gesture.GestureGetSequencesMethodInfo
    ResolveDragSourceMethod "getTouchOnly" o = Gtk.GestureSingle.GestureSingleGetTouchOnlyMethodInfo
    ResolveDragSourceMethod "getWidget" o = Gtk.EventController.EventControllerGetWidgetMethodInfo
    ResolveDragSourceMethod "setActions" o = DragSourceSetActionsMethodInfo
    ResolveDragSourceMethod "setButton" o = Gtk.GestureSingle.GestureSingleSetButtonMethodInfo
    ResolveDragSourceMethod "setContent" o = DragSourceSetContentMethodInfo
    ResolveDragSourceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDragSourceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDragSourceMethod "setExclusive" o = Gtk.GestureSingle.GestureSingleSetExclusiveMethodInfo
    ResolveDragSourceMethod "setIcon" o = DragSourceSetIconMethodInfo
    ResolveDragSourceMethod "setName" o = Gtk.EventController.EventControllerSetNameMethodInfo
    ResolveDragSourceMethod "setPropagationLimit" o = Gtk.EventController.EventControllerSetPropagationLimitMethodInfo
    ResolveDragSourceMethod "setPropagationPhase" o = Gtk.EventController.EventControllerSetPropagationPhaseMethodInfo
    ResolveDragSourceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDragSourceMethod "setSequenceState" o = Gtk.Gesture.GestureSetSequenceStateMethodInfo
    ResolveDragSourceMethod "setState" o = Gtk.Gesture.GestureSetStateMethodInfo
    ResolveDragSourceMethod "setTouchOnly" o = Gtk.GestureSingle.GestureSingleSetTouchOnlyMethodInfo
    ResolveDragSourceMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveDragSourceMethod t DragSource, O.OverloadedMethod info DragSource p, R.HasField t DragSource p) => R.HasField t DragSource p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveDragSourceMethod t DragSource, O.OverloadedMethodInfo info DragSource) => OL.IsLabel t (O.MethodProxy info DragSource) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- signal DragSource::drag-begin
-- | Emitted on the drag source when a drag is started.
-- 
-- It can be used to e.g. set a custom drag icon with
-- 'GI.Gtk.Objects.DragSource.dragSourceSetIcon'.
type DragSourceDragBeginCallback =
    Gdk.Drag.Drag
    -- ^ /@drag@/: the @GdkDrag@ object
    -> IO ()

type C_DragSourceDragBeginCallback =
    Ptr DragSource ->                       -- object
    Ptr Gdk.Drag.Drag ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_DragSourceDragBeginCallback`.
foreign import ccall "wrapper"
    mk_DragSourceDragBeginCallback :: C_DragSourceDragBeginCallback -> IO (FunPtr C_DragSourceDragBeginCallback)

wrap_DragSourceDragBeginCallback :: 
    GObject a => (a -> DragSourceDragBeginCallback) ->
    C_DragSourceDragBeginCallback
wrap_DragSourceDragBeginCallback :: forall a.
GObject a =>
(a -> DragSourceDragBeginCallback) -> C_DragSourceDragBeginCallback
wrap_DragSourceDragBeginCallback a -> DragSourceDragBeginCallback
gi'cb Ptr DragSource
gi'selfPtr Ptr Drag
drag Ptr ()
_ = do
    Drag
drag' <- ((ManagedPtr Drag -> Drag) -> Ptr Drag -> IO Drag
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Drag -> Drag
Gdk.Drag.Drag) Ptr Drag
drag
    Ptr DragSource -> (DragSource -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr DragSource
gi'selfPtr ((DragSource -> IO ()) -> IO ()) -> (DragSource -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DragSource
gi'self -> a -> DragSourceDragBeginCallback
gi'cb (DragSource -> a
Coerce.coerce DragSource
gi'self)  Drag
drag'


-- | Connect a signal handler for the [dragBegin](#signal:dragBegin) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' dragSource #dragBegin callback
-- @
-- 
-- 
onDragSourceDragBegin :: (IsDragSource a, MonadIO m) => a -> ((?self :: a) => DragSourceDragBeginCallback) -> m SignalHandlerId
onDragSourceDragBegin :: forall a (m :: * -> *).
(IsDragSource a, MonadIO m) =>
a
-> ((?self::a) => DragSourceDragBeginCallback) -> m SignalHandlerId
onDragSourceDragBegin a
obj (?self::a) => DragSourceDragBeginCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> DragSourceDragBeginCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragSourceDragBeginCallback
DragSourceDragBeginCallback
cb
    let wrapped' :: C_DragSourceDragBeginCallback
wrapped' = (a -> DragSourceDragBeginCallback) -> C_DragSourceDragBeginCallback
forall a.
GObject a =>
(a -> DragSourceDragBeginCallback) -> C_DragSourceDragBeginCallback
wrap_DragSourceDragBeginCallback a -> DragSourceDragBeginCallback
wrapped
    FunPtr C_DragSourceDragBeginCallback
wrapped'' <- C_DragSourceDragBeginCallback
-> IO (FunPtr C_DragSourceDragBeginCallback)
mk_DragSourceDragBeginCallback C_DragSourceDragBeginCallback
wrapped'
    a
-> Text
-> FunPtr C_DragSourceDragBeginCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drag-begin" FunPtr C_DragSourceDragBeginCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [dragBegin](#signal:dragBegin) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' dragSource #dragBegin callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterDragSourceDragBegin :: (IsDragSource a, MonadIO m) => a -> ((?self :: a) => DragSourceDragBeginCallback) -> m SignalHandlerId
afterDragSourceDragBegin :: forall a (m :: * -> *).
(IsDragSource a, MonadIO m) =>
a
-> ((?self::a) => DragSourceDragBeginCallback) -> m SignalHandlerId
afterDragSourceDragBegin a
obj (?self::a) => DragSourceDragBeginCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> DragSourceDragBeginCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragSourceDragBeginCallback
DragSourceDragBeginCallback
cb
    let wrapped' :: C_DragSourceDragBeginCallback
wrapped' = (a -> DragSourceDragBeginCallback) -> C_DragSourceDragBeginCallback
forall a.
GObject a =>
(a -> DragSourceDragBeginCallback) -> C_DragSourceDragBeginCallback
wrap_DragSourceDragBeginCallback a -> DragSourceDragBeginCallback
wrapped
    FunPtr C_DragSourceDragBeginCallback
wrapped'' <- C_DragSourceDragBeginCallback
-> IO (FunPtr C_DragSourceDragBeginCallback)
mk_DragSourceDragBeginCallback C_DragSourceDragBeginCallback
wrapped'
    a
-> Text
-> FunPtr C_DragSourceDragBeginCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drag-begin" FunPtr C_DragSourceDragBeginCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DragSourceDragBeginSignalInfo
instance SignalInfo DragSourceDragBeginSignalInfo where
    type HaskellCallbackType DragSourceDragBeginSignalInfo = DragSourceDragBeginCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DragSourceDragBeginCallback cb
        cb'' <- mk_DragSourceDragBeginCallback cb'
        connectSignalFunPtr obj "drag-begin" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DragSource::drag-begin"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-DragSource.html#g:signal:dragBegin"})

#endif

-- signal DragSource::drag-cancel
-- | Emitted on the drag source when a drag has failed.
-- 
-- The signal handler may handle a failed drag operation based on
-- the type of error. It should return 'P.True' if the failure has been handled
-- and the default \"drag operation failed\" animation should not be shown.
type DragSourceDragCancelCallback =
    Gdk.Drag.Drag
    -- ^ /@drag@/: the @GdkDrag@ object
    -> Gdk.Enums.DragCancelReason
    -- ^ /@reason@/: information on why the drag failed
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if the failed drag operation has been already handled

type C_DragSourceDragCancelCallback =
    Ptr DragSource ->                       -- object
    Ptr Gdk.Drag.Drag ->
    CUInt ->
    Ptr () ->                               -- user_data
    IO CInt

-- | Generate a function pointer callable from C code, from a `C_DragSourceDragCancelCallback`.
foreign import ccall "wrapper"
    mk_DragSourceDragCancelCallback :: C_DragSourceDragCancelCallback -> IO (FunPtr C_DragSourceDragCancelCallback)

wrap_DragSourceDragCancelCallback :: 
    GObject a => (a -> DragSourceDragCancelCallback) ->
    C_DragSourceDragCancelCallback
wrap_DragSourceDragCancelCallback :: forall a.
GObject a =>
(a -> DragSourceDragCancelCallback)
-> C_DragSourceDragCancelCallback
wrap_DragSourceDragCancelCallback a -> DragSourceDragCancelCallback
gi'cb Ptr DragSource
gi'selfPtr Ptr Drag
drag CUInt
reason Ptr ()
_ = do
    Drag
drag' <- ((ManagedPtr Drag -> Drag) -> Ptr Drag -> IO Drag
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Drag -> Drag
Gdk.Drag.Drag) Ptr Drag
drag
    let reason' :: DragCancelReason
reason' = (Int -> DragCancelReason
forall a. Enum a => Int -> a
toEnum (Int -> DragCancelReason)
-> (CUInt -> Int) -> CUInt -> DragCancelReason
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
reason
    Bool
result <- Ptr DragSource -> (DragSource -> IO Bool) -> IO Bool
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr DragSource
gi'selfPtr ((DragSource -> IO Bool) -> IO Bool)
-> (DragSource -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \DragSource
gi'self -> a -> DragSourceDragCancelCallback
gi'cb (DragSource -> a
Coerce.coerce DragSource
gi'self)  Drag
drag' DragCancelReason
reason'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [dragCancel](#signal:dragCancel) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' dragSource #dragCancel callback
-- @
-- 
-- 
onDragSourceDragCancel :: (IsDragSource a, MonadIO m) => a -> ((?self :: a) => DragSourceDragCancelCallback) -> m SignalHandlerId
onDragSourceDragCancel :: forall a (m :: * -> *).
(IsDragSource a, MonadIO m) =>
a
-> ((?self::a) => DragSourceDragCancelCallback)
-> m SignalHandlerId
onDragSourceDragCancel a
obj (?self::a) => DragSourceDragCancelCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> DragSourceDragCancelCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragSourceDragCancelCallback
DragSourceDragCancelCallback
cb
    let wrapped' :: C_DragSourceDragCancelCallback
wrapped' = (a -> DragSourceDragCancelCallback)
-> C_DragSourceDragCancelCallback
forall a.
GObject a =>
(a -> DragSourceDragCancelCallback)
-> C_DragSourceDragCancelCallback
wrap_DragSourceDragCancelCallback a -> DragSourceDragCancelCallback
wrapped
    FunPtr C_DragSourceDragCancelCallback
wrapped'' <- C_DragSourceDragCancelCallback
-> IO (FunPtr C_DragSourceDragCancelCallback)
mk_DragSourceDragCancelCallback C_DragSourceDragCancelCallback
wrapped'
    a
-> Text
-> FunPtr C_DragSourceDragCancelCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drag-cancel" FunPtr C_DragSourceDragCancelCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [dragCancel](#signal:dragCancel) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' dragSource #dragCancel callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterDragSourceDragCancel :: (IsDragSource a, MonadIO m) => a -> ((?self :: a) => DragSourceDragCancelCallback) -> m SignalHandlerId
afterDragSourceDragCancel :: forall a (m :: * -> *).
(IsDragSource a, MonadIO m) =>
a
-> ((?self::a) => DragSourceDragCancelCallback)
-> m SignalHandlerId
afterDragSourceDragCancel a
obj (?self::a) => DragSourceDragCancelCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> DragSourceDragCancelCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragSourceDragCancelCallback
DragSourceDragCancelCallback
cb
    let wrapped' :: C_DragSourceDragCancelCallback
wrapped' = (a -> DragSourceDragCancelCallback)
-> C_DragSourceDragCancelCallback
forall a.
GObject a =>
(a -> DragSourceDragCancelCallback)
-> C_DragSourceDragCancelCallback
wrap_DragSourceDragCancelCallback a -> DragSourceDragCancelCallback
wrapped
    FunPtr C_DragSourceDragCancelCallback
wrapped'' <- C_DragSourceDragCancelCallback
-> IO (FunPtr C_DragSourceDragCancelCallback)
mk_DragSourceDragCancelCallback C_DragSourceDragCancelCallback
wrapped'
    a
-> Text
-> FunPtr C_DragSourceDragCancelCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drag-cancel" FunPtr C_DragSourceDragCancelCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DragSourceDragCancelSignalInfo
instance SignalInfo DragSourceDragCancelSignalInfo where
    type HaskellCallbackType DragSourceDragCancelSignalInfo = DragSourceDragCancelCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DragSourceDragCancelCallback cb
        cb'' <- mk_DragSourceDragCancelCallback cb'
        connectSignalFunPtr obj "drag-cancel" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DragSource::drag-cancel"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-DragSource.html#g:signal:dragCancel"})

#endif

-- signal DragSource::drag-end
-- | Emitted on the drag source when a drag is finished.
-- 
-- A typical reason to connect to this signal is to undo
-- things done in [DragSource::prepare]("GI.Gtk.Objects.DragSource#g:signal:prepare") or
-- [DragSource::dragBegin]("GI.Gtk.Objects.DragSource#g:signal:dragBegin") handlers.
type DragSourceDragEndCallback =
    Gdk.Drag.Drag
    -- ^ /@drag@/: the @GdkDrag@ object
    -> Bool
    -- ^ /@deleteData@/: 'P.True' if the drag was performing 'GI.Gdk.Flags.DragActionMove',
    --    and the data should be deleted
    -> IO ()

type C_DragSourceDragEndCallback =
    Ptr DragSource ->                       -- object
    Ptr Gdk.Drag.Drag ->
    CInt ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_DragSourceDragEndCallback`.
foreign import ccall "wrapper"
    mk_DragSourceDragEndCallback :: C_DragSourceDragEndCallback -> IO (FunPtr C_DragSourceDragEndCallback)

wrap_DragSourceDragEndCallback :: 
    GObject a => (a -> DragSourceDragEndCallback) ->
    C_DragSourceDragEndCallback
wrap_DragSourceDragEndCallback :: forall a.
GObject a =>
(a -> DragSourceDragEndCallback) -> C_DragSourceDragEndCallback
wrap_DragSourceDragEndCallback a -> DragSourceDragEndCallback
gi'cb Ptr DragSource
gi'selfPtr Ptr Drag
drag CInt
deleteData Ptr ()
_ = do
    Drag
drag' <- ((ManagedPtr Drag -> Drag) -> Ptr Drag -> IO Drag
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Drag -> Drag
Gdk.Drag.Drag) Ptr Drag
drag
    let deleteData' :: Bool
deleteData' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
deleteData
    Ptr DragSource -> (DragSource -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr DragSource
gi'selfPtr ((DragSource -> IO ()) -> IO ()) -> (DragSource -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DragSource
gi'self -> a -> DragSourceDragEndCallback
gi'cb (DragSource -> a
Coerce.coerce DragSource
gi'self)  Drag
drag' Bool
deleteData'


-- | Connect a signal handler for the [dragEnd](#signal:dragEnd) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' dragSource #dragEnd callback
-- @
-- 
-- 
onDragSourceDragEnd :: (IsDragSource a, MonadIO m) => a -> ((?self :: a) => DragSourceDragEndCallback) -> m SignalHandlerId
onDragSourceDragEnd :: forall a (m :: * -> *).
(IsDragSource a, MonadIO m) =>
a -> ((?self::a) => DragSourceDragEndCallback) -> m SignalHandlerId
onDragSourceDragEnd a
obj (?self::a) => DragSourceDragEndCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> DragSourceDragEndCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragSourceDragEndCallback
DragSourceDragEndCallback
cb
    let wrapped' :: C_DragSourceDragEndCallback
wrapped' = (a -> DragSourceDragEndCallback) -> C_DragSourceDragEndCallback
forall a.
GObject a =>
(a -> DragSourceDragEndCallback) -> C_DragSourceDragEndCallback
wrap_DragSourceDragEndCallback a -> DragSourceDragEndCallback
wrapped
    FunPtr C_DragSourceDragEndCallback
wrapped'' <- C_DragSourceDragEndCallback
-> IO (FunPtr C_DragSourceDragEndCallback)
mk_DragSourceDragEndCallback C_DragSourceDragEndCallback
wrapped'
    a
-> Text
-> FunPtr C_DragSourceDragEndCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drag-end" FunPtr C_DragSourceDragEndCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [dragEnd](#signal:dragEnd) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' dragSource #dragEnd callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterDragSourceDragEnd :: (IsDragSource a, MonadIO m) => a -> ((?self :: a) => DragSourceDragEndCallback) -> m SignalHandlerId
afterDragSourceDragEnd :: forall a (m :: * -> *).
(IsDragSource a, MonadIO m) =>
a -> ((?self::a) => DragSourceDragEndCallback) -> m SignalHandlerId
afterDragSourceDragEnd a
obj (?self::a) => DragSourceDragEndCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> DragSourceDragEndCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragSourceDragEndCallback
DragSourceDragEndCallback
cb
    let wrapped' :: C_DragSourceDragEndCallback
wrapped' = (a -> DragSourceDragEndCallback) -> C_DragSourceDragEndCallback
forall a.
GObject a =>
(a -> DragSourceDragEndCallback) -> C_DragSourceDragEndCallback
wrap_DragSourceDragEndCallback a -> DragSourceDragEndCallback
wrapped
    FunPtr C_DragSourceDragEndCallback
wrapped'' <- C_DragSourceDragEndCallback
-> IO (FunPtr C_DragSourceDragEndCallback)
mk_DragSourceDragEndCallback C_DragSourceDragEndCallback
wrapped'
    a
-> Text
-> FunPtr C_DragSourceDragEndCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drag-end" FunPtr C_DragSourceDragEndCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DragSourceDragEndSignalInfo
instance SignalInfo DragSourceDragEndSignalInfo where
    type HaskellCallbackType DragSourceDragEndSignalInfo = DragSourceDragEndCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DragSourceDragEndCallback cb
        cb'' <- mk_DragSourceDragEndCallback cb'
        connectSignalFunPtr obj "drag-end" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DragSource::drag-end"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-DragSource.html#g:signal:dragEnd"})

#endif

-- signal DragSource::prepare
-- | Emitted when a drag is about to be initiated.
-- 
-- It returns the @GdkContentProvider@ to use for the drag that is about
-- to start. The default handler for this signal returns the value of
-- the [DragSource:content]("GI.Gtk.Objects.DragSource#g:attr:content") property, so if you set up that
-- property ahead of time, you don\'t need to connect to this signal.
type DragSourcePrepareCallback =
    Double
    -- ^ /@x@/: the X coordinate of the drag starting point
    -> Double
    -- ^ /@y@/: the Y coordinate fo the drag starting point
    -> IO (Maybe Gdk.ContentProvider.ContentProvider)
    -- ^ __Returns:__ a @GdkContentProvider@

type C_DragSourcePrepareCallback =
    Ptr DragSource ->                       -- object
    CDouble ->
    CDouble ->
    Ptr () ->                               -- user_data
    IO (Ptr Gdk.ContentProvider.ContentProvider)

-- | Generate a function pointer callable from C code, from a `C_DragSourcePrepareCallback`.
foreign import ccall "wrapper"
    mk_DragSourcePrepareCallback :: C_DragSourcePrepareCallback -> IO (FunPtr C_DragSourcePrepareCallback)

wrap_DragSourcePrepareCallback :: 
    GObject a => (a -> DragSourcePrepareCallback) ->
    C_DragSourcePrepareCallback
wrap_DragSourcePrepareCallback :: forall a.
GObject a =>
(a -> DragSourcePrepareCallback) -> C_DragSourcePrepareCallback
wrap_DragSourcePrepareCallback a -> DragSourcePrepareCallback
gi'cb Ptr DragSource
gi'selfPtr CDouble
x CDouble
y Ptr ()
_ = do
    let x' :: Double
x' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x
    let y' :: Double
y' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y
    Maybe ContentProvider
result <- Ptr DragSource
-> (DragSource -> IO (Maybe ContentProvider))
-> IO (Maybe ContentProvider)
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr DragSource
gi'selfPtr ((DragSource -> IO (Maybe ContentProvider))
 -> IO (Maybe ContentProvider))
-> (DragSource -> IO (Maybe ContentProvider))
-> IO (Maybe ContentProvider)
forall a b. (a -> b) -> a -> b
$ \DragSource
gi'self -> a -> DragSourcePrepareCallback
gi'cb (DragSource -> a
Coerce.coerce DragSource
gi'self)  Double
x' Double
y'
    Ptr ContentProvider
-> Maybe ContentProvider
-> (ContentProvider -> IO (Ptr ContentProvider))
-> IO (Ptr ContentProvider)
forall (m :: * -> *) b a.
Monad m =>
b -> Maybe a -> (a -> m b) -> m b
maybeM Ptr ContentProvider
forall a. Ptr a
FP.nullPtr Maybe ContentProvider
result ((ContentProvider -> IO (Ptr ContentProvider))
 -> IO (Ptr ContentProvider))
-> (ContentProvider -> IO (Ptr ContentProvider))
-> IO (Ptr ContentProvider)
forall a b. (a -> b) -> a -> b
$ \ContentProvider
result' -> do
        Ptr ContentProvider
result'' <- ContentProvider -> IO (Ptr ContentProvider)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject ContentProvider
result'
        Ptr ContentProvider -> IO (Ptr ContentProvider)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ContentProvider
result''


-- | Connect a signal handler for the [prepare](#signal:prepare) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' dragSource #prepare callback
-- @
-- 
-- 
onDragSourcePrepare :: (IsDragSource a, MonadIO m) => a -> ((?self :: a) => DragSourcePrepareCallback) -> m SignalHandlerId
onDragSourcePrepare :: forall a (m :: * -> *).
(IsDragSource a, MonadIO m) =>
a -> ((?self::a) => DragSourcePrepareCallback) -> m SignalHandlerId
onDragSourcePrepare a
obj (?self::a) => DragSourcePrepareCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> DragSourcePrepareCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragSourcePrepareCallback
DragSourcePrepareCallback
cb
    let wrapped' :: C_DragSourcePrepareCallback
wrapped' = (a -> DragSourcePrepareCallback) -> C_DragSourcePrepareCallback
forall a.
GObject a =>
(a -> DragSourcePrepareCallback) -> C_DragSourcePrepareCallback
wrap_DragSourcePrepareCallback a -> DragSourcePrepareCallback
wrapped
    FunPtr C_DragSourcePrepareCallback
wrapped'' <- C_DragSourcePrepareCallback
-> IO (FunPtr C_DragSourcePrepareCallback)
mk_DragSourcePrepareCallback C_DragSourcePrepareCallback
wrapped'
    a
-> Text
-> FunPtr C_DragSourcePrepareCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"prepare" FunPtr C_DragSourcePrepareCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [prepare](#signal:prepare) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' dragSource #prepare callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterDragSourcePrepare :: (IsDragSource a, MonadIO m) => a -> ((?self :: a) => DragSourcePrepareCallback) -> m SignalHandlerId
afterDragSourcePrepare :: forall a (m :: * -> *).
(IsDragSource a, MonadIO m) =>
a -> ((?self::a) => DragSourcePrepareCallback) -> m SignalHandlerId
afterDragSourcePrepare a
obj (?self::a) => DragSourcePrepareCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> DragSourcePrepareCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragSourcePrepareCallback
DragSourcePrepareCallback
cb
    let wrapped' :: C_DragSourcePrepareCallback
wrapped' = (a -> DragSourcePrepareCallback) -> C_DragSourcePrepareCallback
forall a.
GObject a =>
(a -> DragSourcePrepareCallback) -> C_DragSourcePrepareCallback
wrap_DragSourcePrepareCallback a -> DragSourcePrepareCallback
wrapped
    FunPtr C_DragSourcePrepareCallback
wrapped'' <- C_DragSourcePrepareCallback
-> IO (FunPtr C_DragSourcePrepareCallback)
mk_DragSourcePrepareCallback C_DragSourcePrepareCallback
wrapped'
    a
-> Text
-> FunPtr C_DragSourcePrepareCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"prepare" FunPtr C_DragSourcePrepareCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DragSourcePrepareSignalInfo
instance SignalInfo DragSourcePrepareSignalInfo where
    type HaskellCallbackType DragSourcePrepareSignalInfo = DragSourcePrepareCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DragSourcePrepareCallback cb
        cb'' <- mk_DragSourcePrepareCallback cb'
        connectSignalFunPtr obj "prepare" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DragSource::prepare"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-DragSource.html#g:signal:prepare"})

#endif

-- VVV Prop "actions"
   -- Type: TInterface (Name {namespace = "Gdk", name = "DragAction"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

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

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

#if defined(ENABLE_OVERLOADING)
data DragSourceActionsPropertyInfo
instance AttrInfo DragSourceActionsPropertyInfo where
    type AttrAllowedOps DragSourceActionsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DragSourceActionsPropertyInfo = IsDragSource
    type AttrSetTypeConstraint DragSourceActionsPropertyInfo = (~) [Gdk.Flags.DragAction]
    type AttrTransferTypeConstraint DragSourceActionsPropertyInfo = (~) [Gdk.Flags.DragAction]
    type AttrTransferType DragSourceActionsPropertyInfo = [Gdk.Flags.DragAction]
    type AttrGetType DragSourceActionsPropertyInfo = [Gdk.Flags.DragAction]
    type AttrLabel DragSourceActionsPropertyInfo = "actions"
    type AttrOrigin DragSourceActionsPropertyInfo = DragSource
    attrGet = getDragSourceActions
    attrSet = setDragSourceActions
    attrTransfer _ v = do
        return v
    attrConstruct = constructDragSourceActions
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DragSource.actions"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-DragSource.html#g:attr:actions"
        })
#endif

-- VVV Prop "content"
   -- Type: TInterface (Name {namespace = "Gdk", name = "ContentProvider"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@content@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dragSource [ #content 'Data.GI.Base.Attributes.:=' value ]
-- @
setDragSourceContent :: (MonadIO m, IsDragSource o, Gdk.ContentProvider.IsContentProvider a) => o -> a -> m ()
setDragSourceContent :: forall (m :: * -> *) o a.
(MonadIO m, IsDragSource o, IsContentProvider a) =>
o -> a -> m ()
setDragSourceContent o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"content" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

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

#if defined(ENABLE_OVERLOADING)
data DragSourceContentPropertyInfo
instance AttrInfo DragSourceContentPropertyInfo where
    type AttrAllowedOps DragSourceContentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DragSourceContentPropertyInfo = IsDragSource
    type AttrSetTypeConstraint DragSourceContentPropertyInfo = Gdk.ContentProvider.IsContentProvider
    type AttrTransferTypeConstraint DragSourceContentPropertyInfo = Gdk.ContentProvider.IsContentProvider
    type AttrTransferType DragSourceContentPropertyInfo = Gdk.ContentProvider.ContentProvider
    type AttrGetType DragSourceContentPropertyInfo = (Maybe Gdk.ContentProvider.ContentProvider)
    type AttrLabel DragSourceContentPropertyInfo = "content"
    type AttrOrigin DragSourceContentPropertyInfo = DragSource
    attrGet = getDragSourceContent
    attrSet = setDragSourceContent
    attrTransfer _ v = do
        unsafeCastTo Gdk.ContentProvider.ContentProvider v
    attrConstruct = constructDragSourceContent
    attrClear = clearDragSourceContent
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DragSource.content"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-DragSource.html#g:attr:content"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DragSource
type instance O.AttributeList DragSource = DragSourceAttributeList
type DragSourceAttributeList = ('[ '("actions", DragSourceActionsPropertyInfo), '("button", Gtk.GestureSingle.GestureSingleButtonPropertyInfo), '("content", DragSourceContentPropertyInfo), '("exclusive", Gtk.GestureSingle.GestureSingleExclusivePropertyInfo), '("nPoints", Gtk.Gesture.GestureNPointsPropertyInfo), '("name", Gtk.EventController.EventControllerNamePropertyInfo), '("propagationLimit", Gtk.EventController.EventControllerPropagationLimitPropertyInfo), '("propagationPhase", Gtk.EventController.EventControllerPropagationPhasePropertyInfo), '("touchOnly", Gtk.GestureSingle.GestureSingleTouchOnlyPropertyInfo), '("widget", Gtk.EventController.EventControllerWidgetPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
dragSourceActions :: AttrLabelProxy "actions"
dragSourceActions = AttrLabelProxy

dragSourceContent :: AttrLabelProxy "content"
dragSourceContent = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DragSource = DragSourceSignalList
type DragSourceSignalList = ('[ '("begin", Gtk.Gesture.GestureBeginSignalInfo), '("cancel", Gtk.Gesture.GestureCancelSignalInfo), '("dragBegin", DragSourceDragBeginSignalInfo), '("dragCancel", DragSourceDragCancelSignalInfo), '("dragEnd", DragSourceDragEndSignalInfo), '("end", Gtk.Gesture.GestureEndSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("prepare", DragSourcePrepareSignalInfo), '("sequenceStateChanged", Gtk.Gesture.GestureSequenceStateChangedSignalInfo), '("update", Gtk.Gesture.GestureUpdateSignalInfo)] :: [(Symbol, *)])

#endif

-- method DragSource::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "DragSource" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drag_source_new" gtk_drag_source_new :: 
    IO (Ptr DragSource)

-- | Creates a new @GtkDragSource@ object.
dragSourceNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m DragSource
    -- ^ __Returns:__ the new @GtkDragSource@
dragSourceNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m DragSource
dragSourceNew  = IO DragSource -> m DragSource
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DragSource -> m DragSource) -> IO DragSource -> m DragSource
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragSource
result <- IO (Ptr DragSource)
gtk_drag_source_new
    Text -> Ptr DragSource -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dragSourceNew" Ptr DragSource
result
    DragSource
result' <- ((ManagedPtr DragSource -> DragSource)
-> Ptr DragSource -> IO DragSource
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DragSource -> DragSource
DragSource) Ptr DragSource
result
    DragSource -> IO DragSource
forall (m :: * -> *) a. Monad m => a -> m a
return DragSource
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DragSource::drag_cancel
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DragSource" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkDragSource`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drag_source_drag_cancel" gtk_drag_source_drag_cancel :: 
    Ptr DragSource ->                       -- source : TInterface (Name {namespace = "Gtk", name = "DragSource"})
    IO ()

-- | Cancels a currently ongoing drag operation.
dragSourceDragCancel ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragSource a) =>
    a
    -- ^ /@source@/: a @GtkDragSource@
    -> m ()
dragSourceDragCancel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDragSource a) =>
a -> m ()
dragSourceDragCancel a
source = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragSource
source' <- a -> IO (Ptr DragSource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
source
    Ptr DragSource -> IO ()
gtk_drag_source_drag_cancel Ptr DragSource
source'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
source
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DragSourceDragCancelMethodInfo
instance (signature ~ (m ()), MonadIO m, IsDragSource a) => O.OverloadedMethod DragSourceDragCancelMethodInfo a signature where
    overloadedMethod = dragSourceDragCancel

instance O.OverloadedMethodInfo DragSourceDragCancelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DragSource.dragSourceDragCancel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-DragSource.html#v:dragSourceDragCancel"
        })


#endif

-- method DragSource::get_actions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DragSource" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkDragSource`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "DragAction" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drag_source_get_actions" gtk_drag_source_get_actions :: 
    Ptr DragSource ->                       -- source : TInterface (Name {namespace = "Gtk", name = "DragSource"})
    IO CUInt

-- | Gets the actions that are currently set on the @GtkDragSource@.
dragSourceGetActions ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragSource a) =>
    a
    -- ^ /@source@/: a @GtkDragSource@
    -> m [Gdk.Flags.DragAction]
    -- ^ __Returns:__ the actions set on /@source@/
dragSourceGetActions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDragSource a) =>
a -> m [DragAction]
dragSourceGetActions a
source = IO [DragAction] -> m [DragAction]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [DragAction] -> m [DragAction])
-> IO [DragAction] -> m [DragAction]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragSource
source' <- a -> IO (Ptr DragSource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
source
    CUInt
result <- Ptr DragSource -> IO CUInt
gtk_drag_source_get_actions Ptr DragSource
source'
    let result' :: [DragAction]
result' = CUInt -> [DragAction]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
source
    [DragAction] -> IO [DragAction]
forall (m :: * -> *) a. Monad m => a -> m a
return [DragAction]
result'

#if defined(ENABLE_OVERLOADING)
data DragSourceGetActionsMethodInfo
instance (signature ~ (m [Gdk.Flags.DragAction]), MonadIO m, IsDragSource a) => O.OverloadedMethod DragSourceGetActionsMethodInfo a signature where
    overloadedMethod = dragSourceGetActions

instance O.OverloadedMethodInfo DragSourceGetActionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DragSource.dragSourceGetActions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-DragSource.html#v:dragSourceGetActions"
        })


#endif

-- method DragSource::get_content
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DragSource" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkDragSource`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "ContentProvider" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drag_source_get_content" gtk_drag_source_get_content :: 
    Ptr DragSource ->                       -- source : TInterface (Name {namespace = "Gtk", name = "DragSource"})
    IO (Ptr Gdk.ContentProvider.ContentProvider)

-- | Gets the current content provider of a @GtkDragSource@.
dragSourceGetContent ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragSource a) =>
    a
    -- ^ /@source@/: a @GtkDragSource@
    -> m (Maybe Gdk.ContentProvider.ContentProvider)
    -- ^ __Returns:__ the @GdkContentProvider@ of /@source@/
dragSourceGetContent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDragSource a) =>
a -> m (Maybe ContentProvider)
dragSourceGetContent a
source = IO (Maybe ContentProvider) -> m (Maybe ContentProvider)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ContentProvider) -> m (Maybe ContentProvider))
-> IO (Maybe ContentProvider) -> m (Maybe ContentProvider)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragSource
source' <- a -> IO (Ptr DragSource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
source
    Ptr ContentProvider
result <- Ptr DragSource -> IO (Ptr ContentProvider)
gtk_drag_source_get_content Ptr DragSource
source'
    Maybe ContentProvider
maybeResult <- Ptr ContentProvider
-> (Ptr ContentProvider -> IO ContentProvider)
-> IO (Maybe ContentProvider)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ContentProvider
result ((Ptr ContentProvider -> IO ContentProvider)
 -> IO (Maybe ContentProvider))
-> (Ptr ContentProvider -> IO ContentProvider)
-> IO (Maybe ContentProvider)
forall a b. (a -> b) -> a -> b
$ \Ptr ContentProvider
result' -> do
        ContentProvider
result'' <- ((ManagedPtr ContentProvider -> ContentProvider)
-> Ptr ContentProvider -> IO ContentProvider
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ContentProvider -> ContentProvider
Gdk.ContentProvider.ContentProvider) Ptr ContentProvider
result'
        ContentProvider -> IO ContentProvider
forall (m :: * -> *) a. Monad m => a -> m a
return ContentProvider
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
source
    Maybe ContentProvider -> IO (Maybe ContentProvider)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ContentProvider
maybeResult

#if defined(ENABLE_OVERLOADING)
data DragSourceGetContentMethodInfo
instance (signature ~ (m (Maybe Gdk.ContentProvider.ContentProvider)), MonadIO m, IsDragSource a) => O.OverloadedMethod DragSourceGetContentMethodInfo a signature where
    overloadedMethod = dragSourceGetContent

instance O.OverloadedMethodInfo DragSourceGetContentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DragSource.dragSourceGetContent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-DragSource.html#v:dragSourceGetContent"
        })


#endif

-- method DragSource::get_drag
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DragSource" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkDragSource`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Drag" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drag_source_get_drag" gtk_drag_source_get_drag :: 
    Ptr DragSource ->                       -- source : TInterface (Name {namespace = "Gtk", name = "DragSource"})
    IO (Ptr Gdk.Drag.Drag)

-- | Returns the underlying @GdkDrag@ object for an ongoing drag.
dragSourceGetDrag ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragSource a) =>
    a
    -- ^ /@source@/: a @GtkDragSource@
    -> m (Maybe Gdk.Drag.Drag)
    -- ^ __Returns:__ the @GdkDrag@ of the current
    --   drag operation
dragSourceGetDrag :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDragSource a) =>
a -> m (Maybe Drag)
dragSourceGetDrag a
source = IO (Maybe Drag) -> m (Maybe Drag)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Drag) -> m (Maybe Drag))
-> IO (Maybe Drag) -> m (Maybe Drag)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragSource
source' <- a -> IO (Ptr DragSource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
source
    Ptr Drag
result <- Ptr DragSource -> IO (Ptr Drag)
gtk_drag_source_get_drag Ptr DragSource
source'
    Maybe Drag
maybeResult <- Ptr Drag -> (Ptr Drag -> IO Drag) -> IO (Maybe Drag)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Drag
result ((Ptr Drag -> IO Drag) -> IO (Maybe Drag))
-> (Ptr Drag -> IO Drag) -> IO (Maybe Drag)
forall a b. (a -> b) -> a -> b
$ \Ptr Drag
result' -> do
        Drag
result'' <- ((ManagedPtr Drag -> Drag) -> Ptr Drag -> IO Drag
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Drag -> Drag
Gdk.Drag.Drag) Ptr Drag
result'
        Drag -> IO Drag
forall (m :: * -> *) a. Monad m => a -> m a
return Drag
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
source
    Maybe Drag -> IO (Maybe Drag)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Drag
maybeResult

#if defined(ENABLE_OVERLOADING)
data DragSourceGetDragMethodInfo
instance (signature ~ (m (Maybe Gdk.Drag.Drag)), MonadIO m, IsDragSource a) => O.OverloadedMethod DragSourceGetDragMethodInfo a signature where
    overloadedMethod = dragSourceGetDrag

instance O.OverloadedMethodInfo DragSourceGetDragMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DragSource.dragSourceGetDrag",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-DragSource.html#v:dragSourceGetDrag"
        })


#endif

-- method DragSource::set_actions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DragSource" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkDragSource`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "actions"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "DragAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the actions to offer"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drag_source_set_actions" gtk_drag_source_set_actions :: 
    Ptr DragSource ->                       -- source : TInterface (Name {namespace = "Gtk", name = "DragSource"})
    CUInt ->                                -- actions : TInterface (Name {namespace = "Gdk", name = "DragAction"})
    IO ()

-- | Sets the actions on the @GtkDragSource@.
-- 
-- During a DND operation, the actions are offered to potential
-- drop targets. If /@actions@/ include 'GI.Gdk.Flags.DragActionMove', you need
-- to listen to the [DragSource::dragEnd]("GI.Gtk.Objects.DragSource#g:signal:dragEnd") signal and
-- handle /@deleteData@/ being 'P.True'.
-- 
-- This function can be called before a drag is started,
-- or in a handler for the [DragSource::prepare]("GI.Gtk.Objects.DragSource#g:signal:prepare") signal.
dragSourceSetActions ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragSource a) =>
    a
    -- ^ /@source@/: a @GtkDragSource@
    -> [Gdk.Flags.DragAction]
    -- ^ /@actions@/: the actions to offer
    -> m ()
dragSourceSetActions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDragSource a) =>
a -> [DragAction] -> m ()
dragSourceSetActions a
source [DragAction]
actions = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragSource
source' <- a -> IO (Ptr DragSource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
source
    let actions' :: CUInt
actions' = [DragAction] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DragAction]
actions
    Ptr DragSource -> CUInt -> IO ()
gtk_drag_source_set_actions Ptr DragSource
source' CUInt
actions'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
source
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DragSourceSetActionsMethodInfo
instance (signature ~ ([Gdk.Flags.DragAction] -> m ()), MonadIO m, IsDragSource a) => O.OverloadedMethod DragSourceSetActionsMethodInfo a signature where
    overloadedMethod = dragSourceSetActions

instance O.OverloadedMethodInfo DragSourceSetActionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DragSource.dragSourceSetActions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-DragSource.html#v:dragSourceSetActions"
        })


#endif

-- method DragSource::set_content
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DragSource" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkDragSource`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "content"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentProvider" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkContentProvider`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drag_source_set_content" gtk_drag_source_set_content :: 
    Ptr DragSource ->                       -- source : TInterface (Name {namespace = "Gtk", name = "DragSource"})
    Ptr Gdk.ContentProvider.ContentProvider -> -- content : TInterface (Name {namespace = "Gdk", name = "ContentProvider"})
    IO ()

-- | Sets a content provider on a @GtkDragSource@.
-- 
-- When the data is requested in the cause of a DND operation,
-- it will be obtained from the content provider.
-- 
-- This function can be called before a drag is started,
-- or in a handler for the [DragSource::prepare]("GI.Gtk.Objects.DragSource#g:signal:prepare") signal.
-- 
-- You may consider setting the content provider back to
-- 'P.Nothing' in a [DragSource::dragEnd]("GI.Gtk.Objects.DragSource#g:signal:dragEnd") signal handler.
dragSourceSetContent ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragSource a, Gdk.ContentProvider.IsContentProvider b) =>
    a
    -- ^ /@source@/: a @GtkDragSource@
    -> Maybe (b)
    -- ^ /@content@/: a @GdkContentProvider@
    -> m ()
dragSourceSetContent :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDragSource a, IsContentProvider b) =>
a -> Maybe b -> m ()
dragSourceSetContent a
source Maybe b
content = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragSource
source' <- a -> IO (Ptr DragSource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
source
    Ptr ContentProvider
maybeContent <- case Maybe b
content of
        Maybe b
Nothing -> Ptr ContentProvider -> IO (Ptr ContentProvider)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ContentProvider
forall a. Ptr a
nullPtr
        Just b
jContent -> do
            Ptr ContentProvider
jContent' <- b -> IO (Ptr ContentProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jContent
            Ptr ContentProvider -> IO (Ptr ContentProvider)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ContentProvider
jContent'
    Ptr DragSource -> Ptr ContentProvider -> IO ()
gtk_drag_source_set_content Ptr DragSource
source' Ptr ContentProvider
maybeContent
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
source
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
content b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DragSourceSetContentMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsDragSource a, Gdk.ContentProvider.IsContentProvider b) => O.OverloadedMethod DragSourceSetContentMethodInfo a signature where
    overloadedMethod = dragSourceSetContent

instance O.OverloadedMethodInfo DragSourceSetContentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DragSource.dragSourceSetContent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-DragSource.html#v:dragSourceSetContent"
        })


#endif

-- method DragSource::set_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DragSource" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkDragSource`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "paintable"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Paintable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the `GdkPaintable` to use as icon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hot_x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the hotspot X coordinate on the icon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hot_y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the hotspot Y coordinate on the icon"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drag_source_set_icon" gtk_drag_source_set_icon :: 
    Ptr DragSource ->                       -- source : TInterface (Name {namespace = "Gtk", name = "DragSource"})
    Ptr Gdk.Paintable.Paintable ->          -- paintable : TInterface (Name {namespace = "Gdk", name = "Paintable"})
    Int32 ->                                -- hot_x : TBasicType TInt
    Int32 ->                                -- hot_y : TBasicType TInt
    IO ()

-- | Sets a paintable to use as icon during DND operations.
-- 
-- The hotspot coordinates determine the point on the icon
-- that gets aligned with the hotspot of the cursor.
-- 
-- If /@paintable@/ is 'P.Nothing', a default icon is used.
-- 
-- This function can be called before a drag is started, or in
-- a [DragSource::prepare]("GI.Gtk.Objects.DragSource#g:signal:prepare") or
-- [DragSource::dragBegin]("GI.Gtk.Objects.DragSource#g:signal:dragBegin") signal handler.
dragSourceSetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragSource a, Gdk.Paintable.IsPaintable b) =>
    a
    -- ^ /@source@/: a @GtkDragSource@
    -> Maybe (b)
    -- ^ /@paintable@/: the @GdkPaintable@ to use as icon
    -> Int32
    -- ^ /@hotX@/: the hotspot X coordinate on the icon
    -> Int32
    -- ^ /@hotY@/: the hotspot Y coordinate on the icon
    -> m ()
dragSourceSetIcon :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDragSource a, IsPaintable b) =>
a -> Maybe b -> Int32 -> Int32 -> m ()
dragSourceSetIcon a
source Maybe b
paintable Int32
hotX Int32
hotY = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragSource
source' <- a -> IO (Ptr DragSource)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
source
    Ptr Paintable
maybePaintable <- case Maybe b
paintable of
        Maybe b
Nothing -> Ptr Paintable -> IO (Ptr Paintable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Paintable
forall a. Ptr a
nullPtr
        Just b
jPaintable -> do
            Ptr Paintable
jPaintable' <- b -> IO (Ptr Paintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jPaintable
            Ptr Paintable -> IO (Ptr Paintable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Paintable
jPaintable'
    Ptr DragSource -> Ptr Paintable -> Int32 -> Int32 -> IO ()
gtk_drag_source_set_icon Ptr DragSource
source' Ptr Paintable
maybePaintable Int32
hotX Int32
hotY
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
source
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
paintable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DragSourceSetIconMethodInfo
instance (signature ~ (Maybe (b) -> Int32 -> Int32 -> m ()), MonadIO m, IsDragSource a, Gdk.Paintable.IsPaintable b) => O.OverloadedMethod DragSourceSetIconMethodInfo a signature where
    overloadedMethod = dragSourceSetIcon

instance O.OverloadedMethodInfo DragSourceSetIconMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DragSource.dragSourceSetIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-DragSource.html#v:dragSourceSetIcon"
        })


#endif