{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkDragIcon@ is a @GtkRoot@ implementation for drag icons.
-- 
-- A drag icon moves with the pointer during a Drag-and-Drop operation
-- and is destroyed when the drag ends.
-- 
-- To set up a drag icon and associate it with an ongoing drag operation,
-- use [func/@gtk@/.DragIcon.get_for_drag] to get the icon for a drag. You can
-- then use it like any other widget and use 'GI.Gtk.Objects.DragIcon.dragIconSetChild'
-- to set whatever widget should be used for the drag icon.
-- 
-- Keep in mind that drag icons do not allow user input.

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

module GI.Gtk.Objects.DragIcon
    ( 

-- * Exported types
    DragIcon(..)                            ,
    IsDragIcon                              ,
    toDragIcon                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [actionSetEnabled]("GI.Gtk.Objects.Widget#g:method:actionSetEnabled"), [activate]("GI.Gtk.Objects.Widget#g:method:activate"), [activateAction]("GI.Gtk.Objects.Widget#g:method:activateAction"), [activateDefault]("GI.Gtk.Objects.Widget#g:method:activateDefault"), [addController]("GI.Gtk.Objects.Widget#g:method:addController"), [addCssClass]("GI.Gtk.Objects.Widget#g:method:addCssClass"), [addMnemonicLabel]("GI.Gtk.Objects.Widget#g:method:addMnemonicLabel"), [addTickCallback]("GI.Gtk.Objects.Widget#g:method:addTickCallback"), [allocate]("GI.Gtk.Objects.Widget#g:method:allocate"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [childFocus]("GI.Gtk.Objects.Widget#g:method:childFocus"), [computeBounds]("GI.Gtk.Objects.Widget#g:method:computeBounds"), [computeExpand]("GI.Gtk.Objects.Widget#g:method:computeExpand"), [computePoint]("GI.Gtk.Objects.Widget#g:method:computePoint"), [computeTransform]("GI.Gtk.Objects.Widget#g:method:computeTransform"), [contains]("GI.Gtk.Objects.Widget#g:method:contains"), [createPangoContext]("GI.Gtk.Objects.Widget#g:method:createPangoContext"), [createPangoLayout]("GI.Gtk.Objects.Widget#g:method:createPangoLayout"), [dragCheckThreshold]("GI.Gtk.Objects.Widget#g:method:dragCheckThreshold"), [errorBell]("GI.Gtk.Objects.Widget#g:method:errorBell"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [grabFocus]("GI.Gtk.Objects.Widget#g:method:grabFocus"), [hasCssClass]("GI.Gtk.Objects.Widget#g:method:hasCssClass"), [hasDefault]("GI.Gtk.Objects.Widget#g:method:hasDefault"), [hasFocus]("GI.Gtk.Objects.Widget#g:method:hasFocus"), [hasVisibleFocus]("GI.Gtk.Objects.Widget#g:method:hasVisibleFocus"), [hide]("GI.Gtk.Objects.Widget#g:method:hide"), [inDestruction]("GI.Gtk.Objects.Widget#g:method:inDestruction"), [initTemplate]("GI.Gtk.Objects.Widget#g:method:initTemplate"), [insertActionGroup]("GI.Gtk.Objects.Widget#g:method:insertActionGroup"), [insertAfter]("GI.Gtk.Objects.Widget#g:method:insertAfter"), [insertBefore]("GI.Gtk.Objects.Widget#g:method:insertBefore"), [isAncestor]("GI.Gtk.Objects.Widget#g:method:isAncestor"), [isDrawable]("GI.Gtk.Objects.Widget#g:method:isDrawable"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isFocus]("GI.Gtk.Objects.Widget#g:method:isFocus"), [isSensitive]("GI.Gtk.Objects.Widget#g:method:isSensitive"), [isVisible]("GI.Gtk.Objects.Widget#g:method:isVisible"), [keynavFailed]("GI.Gtk.Objects.Widget#g:method:keynavFailed"), [listMnemonicLabels]("GI.Gtk.Objects.Widget#g:method:listMnemonicLabels"), [map]("GI.Gtk.Objects.Widget#g:method:map"), [measure]("GI.Gtk.Objects.Widget#g:method:measure"), [mnemonicActivate]("GI.Gtk.Objects.Widget#g:method:mnemonicActivate"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [observeChildren]("GI.Gtk.Objects.Widget#g:method:observeChildren"), [observeControllers]("GI.Gtk.Objects.Widget#g:method:observeControllers"), [pick]("GI.Gtk.Objects.Widget#g:method:pick"), [queueAllocate]("GI.Gtk.Objects.Widget#g:method:queueAllocate"), [queueDraw]("GI.Gtk.Objects.Widget#g:method:queueDraw"), [queueResize]("GI.Gtk.Objects.Widget#g:method:queueResize"), [realize]("GI.Gtk.Objects.Widget#g:method:realize"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeController]("GI.Gtk.Objects.Widget#g:method:removeController"), [removeCssClass]("GI.Gtk.Objects.Widget#g:method:removeCssClass"), [removeMnemonicLabel]("GI.Gtk.Objects.Widget#g:method:removeMnemonicLabel"), [removeTickCallback]("GI.Gtk.Objects.Widget#g:method:removeTickCallback"), [resetProperty]("GI.Gtk.Interfaces.Accessible#g:method:resetProperty"), [resetRelation]("GI.Gtk.Interfaces.Accessible#g:method:resetRelation"), [resetState]("GI.Gtk.Interfaces.Accessible#g:method:resetState"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [shouldLayout]("GI.Gtk.Objects.Widget#g:method:shouldLayout"), [show]("GI.Gtk.Objects.Widget#g:method:show"), [sizeAllocate]("GI.Gtk.Objects.Widget#g:method:sizeAllocate"), [snapshotChild]("GI.Gtk.Objects.Widget#g:method:snapshotChild"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [translateCoordinates]("GI.Gtk.Objects.Widget#g:method:translateCoordinates"), [triggerTooltipQuery]("GI.Gtk.Objects.Widget#g:method:triggerTooltipQuery"), [unmap]("GI.Gtk.Objects.Widget#g:method:unmap"), [unparent]("GI.Gtk.Objects.Widget#g:method:unparent"), [unrealize]("GI.Gtk.Objects.Widget#g:method:unrealize"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [unsetStateFlags]("GI.Gtk.Objects.Widget#g:method:unsetStateFlags"), [updateProperty]("GI.Gtk.Interfaces.Accessible#g:method:updateProperty"), [updateRelation]("GI.Gtk.Interfaces.Accessible#g:method:updateRelation"), [updateState]("GI.Gtk.Interfaces.Accessible#g:method:updateState"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAccessibleRole]("GI.Gtk.Interfaces.Accessible#g:method:getAccessibleRole"), [getAllocatedBaseline]("GI.Gtk.Objects.Widget#g:method:getAllocatedBaseline"), [getAllocatedHeight]("GI.Gtk.Objects.Widget#g:method:getAllocatedHeight"), [getAllocatedWidth]("GI.Gtk.Objects.Widget#g:method:getAllocatedWidth"), [getAllocation]("GI.Gtk.Objects.Widget#g:method:getAllocation"), [getAncestor]("GI.Gtk.Objects.Widget#g:method:getAncestor"), [getBuildableId]("GI.Gtk.Interfaces.Buildable#g:method:getBuildableId"), [getCanFocus]("GI.Gtk.Objects.Widget#g:method:getCanFocus"), [getCanTarget]("GI.Gtk.Objects.Widget#g:method:getCanTarget"), [getChild]("GI.Gtk.Objects.DragIcon#g:method:getChild"), [getChildVisible]("GI.Gtk.Objects.Widget#g:method:getChildVisible"), [getClipboard]("GI.Gtk.Objects.Widget#g:method:getClipboard"), [getCssClasses]("GI.Gtk.Objects.Widget#g:method:getCssClasses"), [getCssName]("GI.Gtk.Objects.Widget#g:method:getCssName"), [getCursor]("GI.Gtk.Objects.Widget#g:method:getCursor"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDirection]("GI.Gtk.Objects.Widget#g:method:getDirection"), [getDisplay]("GI.Gtk.Objects.Widget#g:method:getDisplay"), [getFirstChild]("GI.Gtk.Objects.Widget#g:method:getFirstChild"), [getFocus]("GI.Gtk.Interfaces.Root#g:method:getFocus"), [getFocusChild]("GI.Gtk.Objects.Widget#g:method:getFocusChild"), [getFocusOnClick]("GI.Gtk.Objects.Widget#g:method:getFocusOnClick"), [getFocusable]("GI.Gtk.Objects.Widget#g:method:getFocusable"), [getFontMap]("GI.Gtk.Objects.Widget#g:method:getFontMap"), [getFontOptions]("GI.Gtk.Objects.Widget#g:method:getFontOptions"), [getFrameClock]("GI.Gtk.Objects.Widget#g:method:getFrameClock"), [getHalign]("GI.Gtk.Objects.Widget#g:method:getHalign"), [getHasTooltip]("GI.Gtk.Objects.Widget#g:method:getHasTooltip"), [getHeight]("GI.Gtk.Objects.Widget#g:method:getHeight"), [getHexpand]("GI.Gtk.Objects.Widget#g:method:getHexpand"), [getHexpandSet]("GI.Gtk.Objects.Widget#g:method:getHexpandSet"), [getLastChild]("GI.Gtk.Objects.Widget#g:method:getLastChild"), [getLayoutManager]("GI.Gtk.Objects.Widget#g:method:getLayoutManager"), [getMapped]("GI.Gtk.Objects.Widget#g:method:getMapped"), [getMarginBottom]("GI.Gtk.Objects.Widget#g:method:getMarginBottom"), [getMarginEnd]("GI.Gtk.Objects.Widget#g:method:getMarginEnd"), [getMarginStart]("GI.Gtk.Objects.Widget#g:method:getMarginStart"), [getMarginTop]("GI.Gtk.Objects.Widget#g:method:getMarginTop"), [getName]("GI.Gtk.Objects.Widget#g:method:getName"), [getNative]("GI.Gtk.Objects.Widget#g:method:getNative"), [getNextSibling]("GI.Gtk.Objects.Widget#g:method:getNextSibling"), [getOpacity]("GI.Gtk.Objects.Widget#g:method:getOpacity"), [getOverflow]("GI.Gtk.Objects.Widget#g:method:getOverflow"), [getPangoContext]("GI.Gtk.Objects.Widget#g:method:getPangoContext"), [getParent]("GI.Gtk.Objects.Widget#g:method:getParent"), [getPreferredSize]("GI.Gtk.Objects.Widget#g:method:getPreferredSize"), [getPrevSibling]("GI.Gtk.Objects.Widget#g:method:getPrevSibling"), [getPrimaryClipboard]("GI.Gtk.Objects.Widget#g:method:getPrimaryClipboard"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRealized]("GI.Gtk.Objects.Widget#g:method:getRealized"), [getReceivesDefault]("GI.Gtk.Objects.Widget#g:method:getReceivesDefault"), [getRenderer]("GI.Gtk.Interfaces.Native#g:method:getRenderer"), [getRequestMode]("GI.Gtk.Objects.Widget#g:method:getRequestMode"), [getRoot]("GI.Gtk.Objects.Widget#g:method:getRoot"), [getScaleFactor]("GI.Gtk.Objects.Widget#g:method:getScaleFactor"), [getSensitive]("GI.Gtk.Objects.Widget#g:method:getSensitive"), [getSettings]("GI.Gtk.Objects.Widget#g:method:getSettings"), [getSize]("GI.Gtk.Objects.Widget#g:method:getSize"), [getSizeRequest]("GI.Gtk.Objects.Widget#g:method:getSizeRequest"), [getStateFlags]("GI.Gtk.Objects.Widget#g:method:getStateFlags"), [getStyleContext]("GI.Gtk.Objects.Widget#g:method:getStyleContext"), [getSurface]("GI.Gtk.Interfaces.Native#g:method:getSurface"), [getSurfaceTransform]("GI.Gtk.Interfaces.Native#g:method:getSurfaceTransform"), [getTemplateChild]("GI.Gtk.Objects.Widget#g:method:getTemplateChild"), [getTooltipMarkup]("GI.Gtk.Objects.Widget#g:method:getTooltipMarkup"), [getTooltipText]("GI.Gtk.Objects.Widget#g:method:getTooltipText"), [getValign]("GI.Gtk.Objects.Widget#g:method:getValign"), [getVexpand]("GI.Gtk.Objects.Widget#g:method:getVexpand"), [getVexpandSet]("GI.Gtk.Objects.Widget#g:method:getVexpandSet"), [getVisible]("GI.Gtk.Objects.Widget#g:method:getVisible"), [getWidth]("GI.Gtk.Objects.Widget#g:method:getWidth").
-- 
-- ==== Setters
-- [setCanFocus]("GI.Gtk.Objects.Widget#g:method:setCanFocus"), [setCanTarget]("GI.Gtk.Objects.Widget#g:method:setCanTarget"), [setChild]("GI.Gtk.Objects.DragIcon#g:method:setChild"), [setChildVisible]("GI.Gtk.Objects.Widget#g:method:setChildVisible"), [setCssClasses]("GI.Gtk.Objects.Widget#g:method:setCssClasses"), [setCursor]("GI.Gtk.Objects.Widget#g:method:setCursor"), [setCursorFromName]("GI.Gtk.Objects.Widget#g:method:setCursorFromName"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDirection]("GI.Gtk.Objects.Widget#g:method:setDirection"), [setFocus]("GI.Gtk.Interfaces.Root#g:method:setFocus"), [setFocusChild]("GI.Gtk.Objects.Widget#g:method:setFocusChild"), [setFocusOnClick]("GI.Gtk.Objects.Widget#g:method:setFocusOnClick"), [setFocusable]("GI.Gtk.Objects.Widget#g:method:setFocusable"), [setFontMap]("GI.Gtk.Objects.Widget#g:method:setFontMap"), [setFontOptions]("GI.Gtk.Objects.Widget#g:method:setFontOptions"), [setHalign]("GI.Gtk.Objects.Widget#g:method:setHalign"), [setHasTooltip]("GI.Gtk.Objects.Widget#g:method:setHasTooltip"), [setHexpand]("GI.Gtk.Objects.Widget#g:method:setHexpand"), [setHexpandSet]("GI.Gtk.Objects.Widget#g:method:setHexpandSet"), [setLayoutManager]("GI.Gtk.Objects.Widget#g:method:setLayoutManager"), [setMarginBottom]("GI.Gtk.Objects.Widget#g:method:setMarginBottom"), [setMarginEnd]("GI.Gtk.Objects.Widget#g:method:setMarginEnd"), [setMarginStart]("GI.Gtk.Objects.Widget#g:method:setMarginStart"), [setMarginTop]("GI.Gtk.Objects.Widget#g:method:setMarginTop"), [setName]("GI.Gtk.Objects.Widget#g:method:setName"), [setOpacity]("GI.Gtk.Objects.Widget#g:method:setOpacity"), [setOverflow]("GI.Gtk.Objects.Widget#g:method:setOverflow"), [setParent]("GI.Gtk.Objects.Widget#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setReceivesDefault]("GI.Gtk.Objects.Widget#g:method:setReceivesDefault"), [setSensitive]("GI.Gtk.Objects.Widget#g:method:setSensitive"), [setSizeRequest]("GI.Gtk.Objects.Widget#g:method:setSizeRequest"), [setStateFlags]("GI.Gtk.Objects.Widget#g:method:setStateFlags"), [setTooltipMarkup]("GI.Gtk.Objects.Widget#g:method:setTooltipMarkup"), [setTooltipText]("GI.Gtk.Objects.Widget#g:method:setTooltipText"), [setValign]("GI.Gtk.Objects.Widget#g:method:setValign"), [setVexpand]("GI.Gtk.Objects.Widget#g:method:setVexpand"), [setVexpandSet]("GI.Gtk.Objects.Widget#g:method:setVexpandSet"), [setVisible]("GI.Gtk.Objects.Widget#g:method:setVisible").

#if defined(ENABLE_OVERLOADING)
    ResolveDragIconMethod                   ,
#endif

-- ** createWidgetForValue #method:createWidgetForValue#

    dragIconCreateWidgetForValue            ,


-- ** getChild #method:getChild#

#if defined(ENABLE_OVERLOADING)
    DragIconGetChildMethodInfo              ,
#endif
    dragIconGetChild                        ,


-- ** getForDrag #method:getForDrag#

    dragIconGetForDrag                      ,


-- ** setChild #method:setChild#

#if defined(ENABLE_OVERLOADING)
    DragIconSetChildMethodInfo              ,
#endif
    dragIconSetChild                        ,


-- ** setFromPaintable #method:setFromPaintable#

    dragIconSetFromPaintable                ,




 -- * Properties


-- ** child #attr:child#
-- | The widget to display as drag icon.

#if defined(ENABLE_OVERLOADING)
    DragIconChildPropertyInfo               ,
#endif
    clearDragIconChild                      ,
    constructDragIconChild                  ,
#if defined(ENABLE_OVERLOADING)
    dragIconChild                           ,
#endif
    getDragIconChild                        ,
    setDragIconChild                        ,




    ) 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.Interfaces.Paintable as Gdk.Paintable
import qualified GI.Gdk.Objects.Drag as Gdk.Drag
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Native as Gtk.Native
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Root as Gtk.Root
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

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

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

foreign import ccall "gtk_drag_icon_get_type"
    c_gtk_drag_icon_get_type :: IO B.Types.GType

instance B.Types.TypedObject DragIcon where
    glibType :: IO GType
glibType = IO GType
c_gtk_drag_icon_get_type

instance B.Types.GObject DragIcon

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

instance O.HasParentTypes DragIcon
type instance O.ParentTypes DragIcon = '[Gtk.Widget.Widget, GObject.Object.Object, Gtk.Accessible.Accessible, Gtk.Buildable.Buildable, Gtk.ConstraintTarget.ConstraintTarget, Gtk.Native.Native, Gtk.Root.Root]

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

-- | Convert 'DragIcon' 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 DragIcon) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_drag_icon_get_type
    gvalueSet_ :: Ptr GValue -> Maybe DragIcon -> IO ()
gvalueSet_ Ptr GValue
gv Maybe DragIcon
P.Nothing = Ptr GValue -> Ptr DragIcon -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr DragIcon
forall a. Ptr a
FP.nullPtr :: FP.Ptr DragIcon)
    gvalueSet_ Ptr GValue
gv (P.Just DragIcon
obj) = DragIcon -> (Ptr DragIcon -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DragIcon
obj (Ptr GValue -> Ptr DragIcon -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe DragIcon)
gvalueGet_ Ptr GValue
gv = do
        Ptr DragIcon
ptr <- Ptr GValue -> IO (Ptr DragIcon)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr DragIcon)
        if Ptr DragIcon
ptr Ptr DragIcon -> Ptr DragIcon -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr DragIcon
forall a. Ptr a
FP.nullPtr
        then DragIcon -> Maybe DragIcon
forall a. a -> Maybe a
P.Just (DragIcon -> Maybe DragIcon) -> IO DragIcon -> IO (Maybe DragIcon)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr DragIcon -> DragIcon) -> Ptr DragIcon -> IO DragIcon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr DragIcon -> DragIcon
DragIcon Ptr DragIcon
ptr
        else Maybe DragIcon -> IO (Maybe DragIcon)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DragIcon
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveDragIconMethod (t :: Symbol) (o :: *) :: * where
    ResolveDragIconMethod "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
    ResolveDragIconMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveDragIconMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveDragIconMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveDragIconMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveDragIconMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
    ResolveDragIconMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveDragIconMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveDragIconMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveDragIconMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDragIconMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDragIconMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveDragIconMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveDragIconMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveDragIconMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveDragIconMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveDragIconMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveDragIconMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveDragIconMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveDragIconMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveDragIconMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveDragIconMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDragIconMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDragIconMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDragIconMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveDragIconMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
    ResolveDragIconMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveDragIconMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveDragIconMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolveDragIconMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolveDragIconMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolveDragIconMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolveDragIconMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolveDragIconMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolveDragIconMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolveDragIconMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolveDragIconMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolveDragIconMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDragIconMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolveDragIconMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolveDragIconMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveDragIconMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveDragIconMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolveDragIconMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolveDragIconMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolveDragIconMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolveDragIconMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDragIconMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDragIconMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolveDragIconMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolveDragIconMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveDragIconMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveDragIconMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveDragIconMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveDragIconMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveDragIconMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDragIconMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDragIconMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveDragIconMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
    ResolveDragIconMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveDragIconMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveDragIconMethod "resetProperty" o = Gtk.Accessible.AccessibleResetPropertyMethodInfo
    ResolveDragIconMethod "resetRelation" o = Gtk.Accessible.AccessibleResetRelationMethodInfo
    ResolveDragIconMethod "resetState" o = Gtk.Accessible.AccessibleResetStateMethodInfo
    ResolveDragIconMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDragIconMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
    ResolveDragIconMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolveDragIconMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolveDragIconMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolveDragIconMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDragIconMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDragIconMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDragIconMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolveDragIconMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolveDragIconMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolveDragIconMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolveDragIconMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolveDragIconMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDragIconMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveDragIconMethod "updateProperty" o = Gtk.Accessible.AccessibleUpdatePropertyMethodInfo
    ResolveDragIconMethod "updateRelation" o = Gtk.Accessible.AccessibleUpdateRelationMethodInfo
    ResolveDragIconMethod "updateState" o = Gtk.Accessible.AccessibleUpdateStateMethodInfo
    ResolveDragIconMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDragIconMethod "getAccessibleRole" o = Gtk.Accessible.AccessibleGetAccessibleRoleMethodInfo
    ResolveDragIconMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolveDragIconMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolveDragIconMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolveDragIconMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolveDragIconMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolveDragIconMethod "getBuildableId" o = Gtk.Buildable.BuildableGetBuildableIdMethodInfo
    ResolveDragIconMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolveDragIconMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolveDragIconMethod "getChild" o = DragIconGetChildMethodInfo
    ResolveDragIconMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolveDragIconMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolveDragIconMethod "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
    ResolveDragIconMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
    ResolveDragIconMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveDragIconMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDragIconMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveDragIconMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveDragIconMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveDragIconMethod "getFocus" o = Gtk.Root.RootGetFocusMethodInfo
    ResolveDragIconMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveDragIconMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveDragIconMethod "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
    ResolveDragIconMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolveDragIconMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolveDragIconMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolveDragIconMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolveDragIconMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveDragIconMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveDragIconMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveDragIconMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolveDragIconMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveDragIconMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveDragIconMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolveDragIconMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolveDragIconMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolveDragIconMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolveDragIconMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolveDragIconMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveDragIconMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
    ResolveDragIconMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolveDragIconMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolveDragIconMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolveDragIconMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolveDragIconMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolveDragIconMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolveDragIconMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolveDragIconMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolveDragIconMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDragIconMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDragIconMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolveDragIconMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolveDragIconMethod "getRenderer" o = Gtk.Native.NativeGetRendererMethodInfo
    ResolveDragIconMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolveDragIconMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolveDragIconMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolveDragIconMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolveDragIconMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolveDragIconMethod "getSize" o = Gtk.Widget.WidgetGetSizeMethodInfo
    ResolveDragIconMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveDragIconMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveDragIconMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveDragIconMethod "getSurface" o = Gtk.Native.NativeGetSurfaceMethodInfo
    ResolveDragIconMethod "getSurfaceTransform" o = Gtk.Native.NativeGetSurfaceTransformMethodInfo
    ResolveDragIconMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveDragIconMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveDragIconMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolveDragIconMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolveDragIconMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolveDragIconMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolveDragIconMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolveDragIconMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolveDragIconMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveDragIconMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveDragIconMethod "setChild" o = DragIconSetChildMethodInfo
    ResolveDragIconMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveDragIconMethod "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
    ResolveDragIconMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolveDragIconMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolveDragIconMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDragIconMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDragIconMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolveDragIconMethod "setFocus" o = Gtk.Root.RootSetFocusMethodInfo
    ResolveDragIconMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveDragIconMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveDragIconMethod "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
    ResolveDragIconMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveDragIconMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveDragIconMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveDragIconMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolveDragIconMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolveDragIconMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolveDragIconMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolveDragIconMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolveDragIconMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolveDragIconMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolveDragIconMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolveDragIconMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolveDragIconMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolveDragIconMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolveDragIconMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolveDragIconMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDragIconMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolveDragIconMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolveDragIconMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolveDragIconMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolveDragIconMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveDragIconMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveDragIconMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolveDragIconMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolveDragIconMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolveDragIconMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolveDragIconMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDragIconMethod t DragIcon, O.OverloadedMethod info DragIcon p) => OL.IsLabel t (DragIcon -> 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 ~ ResolveDragIconMethod t DragIcon, O.OverloadedMethod info DragIcon p, R.HasField t DragIcon p) => R.HasField t DragIcon p where
    getField = O.overloadedMethod @info

#endif

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

#endif

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

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

-- | Set the value of the “@child@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dragIcon [ #child 'Data.GI.Base.Attributes.:=' value ]
-- @
setDragIconChild :: (MonadIO m, IsDragIcon o, Gtk.Widget.IsWidget a) => o -> a -> m ()
setDragIconChild :: forall (m :: * -> *) o a.
(MonadIO m, IsDragIcon o, IsWidget a) =>
o -> a -> m ()
setDragIconChild 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
"child" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@child@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDragIconChild :: (IsDragIcon o, MIO.MonadIO m, Gtk.Widget.IsWidget a) => a -> m (GValueConstruct o)
constructDragIconChild :: forall o (m :: * -> *) a.
(IsDragIcon o, MonadIO m, IsWidget a) =>
a -> m (GValueConstruct o)
constructDragIconChild 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
"child" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@child@” 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' #child
-- @
clearDragIconChild :: (MonadIO m, IsDragIcon o) => o -> m ()
clearDragIconChild :: forall (m :: * -> *) o. (MonadIO m, IsDragIcon o) => o -> m ()
clearDragIconChild 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 Widget -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"child" (Maybe Widget
forall a. Maybe a
Nothing :: Maybe Gtk.Widget.Widget)

#if defined(ENABLE_OVERLOADING)
data DragIconChildPropertyInfo
instance AttrInfo DragIconChildPropertyInfo where
    type AttrAllowedOps DragIconChildPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DragIconChildPropertyInfo = IsDragIcon
    type AttrSetTypeConstraint DragIconChildPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint DragIconChildPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType DragIconChildPropertyInfo = Gtk.Widget.Widget
    type AttrGetType DragIconChildPropertyInfo = (Maybe Gtk.Widget.Widget)
    type AttrLabel DragIconChildPropertyInfo = "child"
    type AttrOrigin DragIconChildPropertyInfo = DragIcon
    attrGet = getDragIconChild
    attrSet = setDragIconChild
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructDragIconChild
    attrClear = clearDragIconChild
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.DragIcon.child"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-DragIcon.html#g:attr:child"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DragIcon
type instance O.AttributeList DragIcon = DragIconAttributeList
type DragIconAttributeList = ('[ '("accessibleRole", Gtk.Accessible.AccessibleAccessibleRolePropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("child", DragIconChildPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
dragIconChild :: AttrLabelProxy "child"
dragIconChild = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DragIcon = DragIconSignalList
type DragIconSignalList = ('[ '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "gtk_drag_icon_get_child" gtk_drag_icon_get_child :: 
    Ptr DragIcon ->                         -- self : TInterface (Name {namespace = "Gtk", name = "DragIcon"})
    IO (Ptr Gtk.Widget.Widget)

-- | Gets the widget currently used as drag icon.
dragIconGetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragIcon a) =>
    a
    -- ^ /@self@/: a @GtkDragIcon@
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ The drag icon
dragIconGetChild :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDragIcon a) =>
a -> m (Maybe Widget)
dragIconGetChild a
self = IO (Maybe Widget) -> m (Maybe Widget)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragIcon
self' <- a -> IO (Ptr DragIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
result <- Ptr DragIcon -> IO (Ptr Widget)
gtk_drag_icon_get_child Ptr DragIcon
self'
    Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
result' -> do
        Widget
result'' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result'
        Widget -> IO Widget
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Widget -> IO (Maybe Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data DragIconGetChildMethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsDragIcon a) => O.OverloadedMethod DragIconGetChildMethodInfo a signature where
    overloadedMethod = dragIconGetChild

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


#endif

-- method DragIcon::set_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DragIcon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkDragIcon`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "child"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkWidget`" , 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_icon_set_child" gtk_drag_icon_set_child :: 
    Ptr DragIcon ->                         -- self : TInterface (Name {namespace = "Gtk", name = "DragIcon"})
    Ptr Gtk.Widget.Widget ->                -- child : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | Sets the widget to display as the drag icon.
dragIconSetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragIcon a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@self@/: a @GtkDragIcon@
    -> Maybe (b)
    -- ^ /@child@/: a @GtkWidget@
    -> m ()
dragIconSetChild :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDragIcon a, IsWidget b) =>
a -> Maybe b -> m ()
dragIconSetChild a
self Maybe b
child = 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 DragIcon
self' <- a -> IO (Ptr DragIcon)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
maybeChild <- case Maybe b
child of
        Maybe b
Nothing -> Ptr Widget -> IO (Ptr Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
        Just b
jChild -> do
            Ptr Widget
jChild' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jChild
            Ptr Widget -> IO (Ptr Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jChild'
    Ptr DragIcon -> Ptr Widget -> IO ()
gtk_drag_icon_set_child Ptr DragIcon
self' Ptr Widget
maybeChild
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
child b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DragIconSetChildMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsDragIcon a, Gtk.Widget.IsWidget b) => O.OverloadedMethod DragIconSetChildMethodInfo a signature where
    overloadedMethod = dragIconSetChild

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


#endif

-- method DragIcon::create_widget_for_value
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GValue`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Widget" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drag_icon_create_widget_for_value" gtk_drag_icon_create_widget_for_value :: 
    Ptr GValue ->                           -- value : TGValue
    IO (Ptr Gtk.Widget.Widget)

-- | Creates a widget that can be used as a drag icon for the given
-- /@value@/.
-- 
-- Supported types include strings, @GdkRGBA@ and @GtkTextBuffer@.
-- If GTK does not know how to create a widget for a given value,
-- it will return 'P.Nothing'.
-- 
-- This method is used to set the default drag icon on drag-and-drop
-- operations started by @GtkDragSource@, so you don\'t need to set
-- a drag icon using this function there.
dragIconCreateWidgetForValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GValue
    -- ^ /@value@/: a @GValue@
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ A new @GtkWidget@
    --   for displaying /@value@/ as a drag icon.
dragIconCreateWidgetForValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GValue -> m (Maybe Widget)
dragIconCreateWidgetForValue GValue
value = IO (Maybe Widget) -> m (Maybe Widget)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Widget
result <- Ptr GValue -> IO (Ptr Widget)
gtk_drag_icon_create_widget_for_value Ptr GValue
value'
    Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
result' -> do
        Widget
result'' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result'
        Widget -> IO Widget
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Maybe Widget -> IO (Maybe Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gtk_drag_icon_get_for_drag" gtk_drag_icon_get_for_drag :: 
    Ptr Gdk.Drag.Drag ->                    -- drag : TInterface (Name {namespace = "Gdk", name = "Drag"})
    IO (Ptr Gtk.Widget.Widget)

-- | Gets the @GtkDragIcon@ in use with /@drag@/.
-- 
-- If no drag icon exists yet, a new one will be created
-- and shown.
dragIconGetForDrag ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Drag.IsDrag a) =>
    a
    -- ^ /@drag@/: a @GdkDrag@
    -> m Gtk.Widget.Widget
    -- ^ __Returns:__ the @GtkDragIcon@
dragIconGetForDrag :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrag a) =>
a -> m Widget
dragIconGetForDrag a
drag = IO Widget -> m Widget
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ do
    Ptr Drag
drag' <- a -> IO (Ptr Drag)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drag
    Ptr Widget
result <- Ptr Drag -> IO (Ptr Widget)
gtk_drag_icon_get_for_drag Ptr Drag
drag'
    Text -> Ptr Widget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dragIconGetForDrag" Ptr Widget
result
    Widget
result' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drag
    Widget -> IO Widget
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DragIcon::set_from_paintable
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "drag"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Drag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkDrag`" , 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 = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkPaintable` to display"
--                 , 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 "X coordinate of the hotspot"
--                 , 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 "Y coordinate of the hotspot"
--                 , 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_icon_set_from_paintable" gtk_drag_icon_set_from_paintable :: 
    Ptr Gdk.Drag.Drag ->                    -- drag : TInterface (Name {namespace = "Gdk", name = "Drag"})
    Ptr Gdk.Paintable.Paintable ->          -- paintable : TInterface (Name {namespace = "Gdk", name = "Paintable"})
    Int32 ->                                -- hot_x : TBasicType TInt
    Int32 ->                                -- hot_y : TBasicType TInt
    IO ()

-- | Creates a @GtkDragIcon@ that shows /@paintable@/, and associates
-- it with the drag operation.
-- 
-- The hotspot position on the paintable is aligned with the
-- hotspot of the cursor.
dragIconSetFromPaintable ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Drag.IsDrag a, Gdk.Paintable.IsPaintable b) =>
    a
    -- ^ /@drag@/: a @GdkDrag@
    -> b
    -- ^ /@paintable@/: a @GdkPaintable@ to display
    -> Int32
    -- ^ /@hotX@/: X coordinate of the hotspot
    -> Int32
    -- ^ /@hotY@/: Y coordinate of the hotspot
    -> m ()
dragIconSetFromPaintable :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDrag a, IsPaintable b) =>
a -> b -> Int32 -> Int32 -> m ()
dragIconSetFromPaintable a
drag 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 Drag
drag' <- a -> IO (Ptr Drag)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drag
    Ptr Paintable
paintable' <- b -> IO (Ptr Paintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
paintable
    Ptr Drag -> Ptr Paintable -> Int32 -> Int32 -> IO ()
gtk_drag_icon_set_from_paintable Ptr Drag
drag' Ptr Paintable
paintable' Int32
hotX Int32
hotY
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drag
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
paintable
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif