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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- In addition to a single pointer and keyboard for user interface input,
-- GDK contains support for a variety of input devices, including graphics
-- tablets, touchscreens and multiple pointers\/keyboards interacting
-- simultaneously with the user interface. Such input devices often have
-- additional features, such as sub-pixel positioning information and
-- additional device-dependent information.
-- 
-- In order to query the device hierarchy and be aware of changes in the
-- device hierarchy (such as virtual devices being created or removed, or
-- physical devices being plugged or unplugged), GDK provides
-- t'GI.Gdk.Objects.DeviceManager.DeviceManager'.
-- 
-- By default, and if the platform supports it, GDK is aware of multiple
-- keyboard\/pointer pairs and multitouch devices. This behavior can be
-- changed by calling 'GI.Gdk.Functions.disableMultidevice' before 'GI.Gdk.Objects.Display.displayOpen'.
-- There should rarely be a need to do that though, since GDK defaults
-- to a compatibility mode in which it will emit just one enter\/leave
-- event pair for all devices on a window. To enable per-device
-- enter\/leave events and other multi-pointer interaction features,
-- 'GI.Gdk.Objects.Window.windowSetSupportMultidevice' must be called on
-- @/GdkWindows/@ (or @/gtk_widget_set_support_multidevice()/@ on widgets).
-- window. See the 'GI.Gdk.Objects.Window.windowSetSupportMultidevice' documentation
-- for more information.
-- 
-- On X11, multi-device support is implemented through XInput 2.
-- Unless 'GI.Gdk.Functions.disableMultidevice' is called, the XInput 2
-- t'GI.Gdk.Objects.DeviceManager.DeviceManager' implementation will be used as the input source.
-- Otherwise either the core or XInput 1 implementations will be used.
-- 
-- For simple applications that don’t have any special interest in
-- input devices, the so-called “client pointer”
-- provides a reasonable approximation to a simple setup with a single
-- pointer and keyboard. The device that has been set as the client
-- pointer can be accessed via 'GI.Gdk.Objects.DeviceManager.deviceManagerGetClientPointer'.
-- 
-- Conceptually, in multidevice mode there are 2 device types. Virtual
-- devices (or master devices) are represented by the pointer cursors
-- and keyboard foci that are seen on the screen. Physical devices (or
-- slave devices) represent the hardware that is controlling the virtual
-- devices, and thus have no visible cursor on the screen.
-- 
-- Virtual devices are always paired, so there is a keyboard device for every
-- pointer device. Associations between devices may be inspected through
-- 'GI.Gdk.Objects.Device.deviceGetAssociatedDevice'.
-- 
-- There may be several virtual devices, and several physical devices could
-- be controlling each of these virtual devices. Physical devices may also
-- be “floating”, which means they are not attached to any virtual device.
-- 
-- = Master and slave devices
-- 
-- >
-- >carlos@sacarino:~$ xinput list
-- >⎡ Virtual core pointer                          id=2    [master pointer  (3)]
-- >⎜   ↳ Virtual core XTEST pointer                id=4    [slave  pointer  (2)]
-- >⎜   ↳ Wacom ISDv4 E6 Pen stylus                 id=10   [slave  pointer  (2)]
-- >⎜   ↳ Wacom ISDv4 E6 Finger touch               id=11   [slave  pointer  (2)]
-- >⎜   ↳ SynPS/2 Synaptics TouchPad                id=13   [slave  pointer  (2)]
-- >⎜   ↳ TPPS/2 IBM TrackPoint                     id=14   [slave  pointer  (2)]
-- >⎜   ↳ Wacom ISDv4 E6 Pen eraser                 id=16   [slave  pointer  (2)]
-- >⎣ Virtual core keyboard                         id=3    [master keyboard (2)]
-- >    ↳ Virtual core XTEST keyboard               id=5    [slave  keyboard (3)]
-- >    ↳ Power Button                              id=6    [slave  keyboard (3)]
-- >    ↳ Video Bus                                 id=7    [slave  keyboard (3)]
-- >    ↳ Sleep Button                              id=8    [slave  keyboard (3)]
-- >    ↳ Integrated Camera                         id=9    [slave  keyboard (3)]
-- >    ↳ AT Translated Set 2 keyboard              id=12   [slave  keyboard (3)]
-- >    ↳ ThinkPad Extra Buttons                    id=15   [slave  keyboard (3)]
-- 
-- 
-- By default, GDK will automatically listen for events coming from all
-- master devices, setting the t'GI.Gdk.Objects.Device.Device' for all events coming from input
-- devices. Events containing device information are @/GDK_MOTION_NOTIFY/@,
-- @/GDK_BUTTON_PRESS/@, @/GDK_2BUTTON_PRESS/@, @/GDK_3BUTTON_PRESS/@,
-- @/GDK_BUTTON_RELEASE/@, @/GDK_SCROLL/@, @/GDK_KEY_PRESS/@, @/GDK_KEY_RELEASE/@,
-- @/GDK_ENTER_NOTIFY/@, @/GDK_LEAVE_NOTIFY/@, @/GDK_FOCUS_CHANGE/@,
-- @/GDK_PROXIMITY_IN/@, @/GDK_PROXIMITY_OUT/@, @/GDK_DRAG_ENTER/@, @/GDK_DRAG_LEAVE/@,
-- @/GDK_DRAG_MOTION/@, @/GDK_DRAG_STATUS/@, @/GDK_DROP_START/@, @/GDK_DROP_FINISHED/@
-- and @/GDK_GRAB_BROKEN/@. When dealing with an event on a master device,
-- it is possible to get the source (slave) device that the event originated
-- from via 'GI.Gdk.Unions.Event.eventGetSourceDevice'.
-- 
-- On a standard session, all physical devices are connected by default to
-- the \"Virtual Core Pointer\/Keyboard\" master devices, hence routing all events
-- through these. This behavior is only modified by device grabs, where the
-- slave device is temporarily detached for as long as the grab is held, and
-- more permanently by user modifications to the device hierarchy.
-- 
-- On certain application specific setups, it may make sense
-- to detach a physical device from its master pointer, and mapping it to
-- an specific window. This can be achieved by the combination of
-- 'GI.Gdk.Objects.Device.deviceGrab' and 'GI.Gdk.Objects.Device.deviceSetMode'.
-- 
-- In order to listen for events coming from devices
-- other than a virtual device, 'GI.Gdk.Objects.Window.windowSetDeviceEvents' must be
-- called. Generally, this function can be used to modify the event mask
-- for any given device.
-- 
-- Input devices may also provide additional information besides X\/Y.
-- For example, graphics tablets may also provide pressure and X\/Y tilt
-- information. This information is device-dependent, and may be
-- queried through @/gdk_device_get_axis()/@. In multidevice mode, virtual
-- devices will change axes in order to always represent the physical
-- device that is routing events through it. Whenever the physical device
-- changes, the t'GI.Gdk.Objects.Device.Device':@/n-axes/@ property will be notified, and
-- 'GI.Gdk.Objects.Device.deviceListAxes' will return the new device axes.
-- 
-- Devices may also have associated “keys” or
-- macro buttons. Such keys can be globally set to map into normal X
-- keyboard events. The mapping is set using 'GI.Gdk.Objects.Device.deviceSetKey'.
-- 
-- In GTK+ 3.20, a new t'GI.Gdk.Objects.Seat.Seat' object has been introduced that
-- supersedes t'GI.Gdk.Objects.DeviceManager.DeviceManager' and should be preferred in newly
-- written code.

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

module GI.Gdk.Objects.DeviceManager
    ( 

-- * Exported types
    DeviceManager(..)                       ,
    IsDeviceManager                         ,
    toDeviceManager                         ,


 -- * 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"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [listDevices]("GI.Gdk.Objects.DeviceManager#g:method:listDevices"), [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"), [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"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getClientPointer]("GI.Gdk.Objects.DeviceManager#g:method:getClientPointer"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDisplay]("GI.Gdk.Objects.DeviceManager#g:method:getDisplay"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveDeviceManagerMethod              ,
#endif

-- ** getClientPointer #method:getClientPointer#

#if defined(ENABLE_OVERLOADING)
    DeviceManagerGetClientPointerMethodInfo ,
#endif
    deviceManagerGetClientPointer           ,


-- ** getDisplay #method:getDisplay#

#if defined(ENABLE_OVERLOADING)
    DeviceManagerGetDisplayMethodInfo       ,
#endif
    deviceManagerGetDisplay                 ,


-- ** listDevices #method:listDevices#

#if defined(ENABLE_OVERLOADING)
    DeviceManagerListDevicesMethodInfo      ,
#endif
    deviceManagerListDevices                ,




 -- * Properties


-- ** display #attr:display#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DeviceManagerDisplayPropertyInfo        ,
#endif
    constructDeviceManagerDisplay           ,
#if defined(ENABLE_OVERLOADING)
    deviceManagerDisplay                    ,
#endif
    getDeviceManagerDisplay                 ,




 -- * Signals


-- ** deviceAdded #signal:deviceAdded#

    DeviceManagerDeviceAddedCallback        ,
#if defined(ENABLE_OVERLOADING)
    DeviceManagerDeviceAddedSignalInfo      ,
#endif
    afterDeviceManagerDeviceAdded           ,
    onDeviceManagerDeviceAdded              ,


-- ** deviceChanged #signal:deviceChanged#

    DeviceManagerDeviceChangedCallback      ,
#if defined(ENABLE_OVERLOADING)
    DeviceManagerDeviceChangedSignalInfo    ,
#endif
    afterDeviceManagerDeviceChanged         ,
    onDeviceManagerDeviceChanged            ,


-- ** deviceRemoved #signal:deviceRemoved#

    DeviceManagerDeviceRemovedCallback      ,
#if defined(ENABLE_OVERLOADING)
    DeviceManagerDeviceRemovedSignalInfo    ,
#endif
    afterDeviceManagerDeviceRemoved         ,
    onDeviceManagerDeviceRemoved            ,




    ) 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 {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums
import {-# SOURCE #-} qualified GI.Gdk.Objects.Device as Gdk.Device
import {-# SOURCE #-} qualified GI.Gdk.Objects.Display as Gdk.Display

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

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

foreign import ccall "gdk_device_manager_get_type"
    c_gdk_device_manager_get_type :: IO B.Types.GType

instance B.Types.TypedObject DeviceManager where
    glibType :: IO GType
glibType = IO GType
c_gdk_device_manager_get_type

instance B.Types.GObject DeviceManager

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

instance O.HasParentTypes DeviceManager
type instance O.ParentTypes DeviceManager = '[GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDeviceManagerMethod (t :: Symbol) (o :: *) :: * where
    ResolveDeviceManagerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDeviceManagerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDeviceManagerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDeviceManagerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDeviceManagerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDeviceManagerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDeviceManagerMethod "listDevices" o = DeviceManagerListDevicesMethodInfo
    ResolveDeviceManagerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDeviceManagerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDeviceManagerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDeviceManagerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDeviceManagerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDeviceManagerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDeviceManagerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDeviceManagerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDeviceManagerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDeviceManagerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDeviceManagerMethod "getClientPointer" o = DeviceManagerGetClientPointerMethodInfo
    ResolveDeviceManagerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDeviceManagerMethod "getDisplay" o = DeviceManagerGetDisplayMethodInfo
    ResolveDeviceManagerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDeviceManagerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDeviceManagerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDeviceManagerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDeviceManagerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDeviceManagerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal DeviceManager::device-added
-- | The [deviceAdded](#g:signal:deviceAdded) signal is emitted either when a new master
-- pointer is created, or when a slave (Hardware) input device
-- is plugged in.
type DeviceManagerDeviceAddedCallback =
    Gdk.Device.Device
    -- ^ /@device@/: the newly added t'GI.Gdk.Objects.Device.Device'.
    -> IO ()

type C_DeviceManagerDeviceAddedCallback =
    Ptr DeviceManager ->                    -- object
    Ptr Gdk.Device.Device ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_DeviceManagerDeviceAddedCallback :: 
    GObject a => (a -> DeviceManagerDeviceAddedCallback) ->
    C_DeviceManagerDeviceAddedCallback
wrap_DeviceManagerDeviceAddedCallback :: forall a.
GObject a =>
(a -> DeviceManagerDeviceAddedCallback)
-> C_DeviceManagerDeviceAddedCallback
wrap_DeviceManagerDeviceAddedCallback a -> DeviceManagerDeviceAddedCallback
gi'cb Ptr DeviceManager
gi'selfPtr Ptr Device
device Ptr ()
_ = do
    Device
device' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
Gdk.Device.Device) Ptr Device
device
    Ptr DeviceManager -> (DeviceManager -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr DeviceManager
gi'selfPtr ((DeviceManager -> IO ()) -> IO ())
-> (DeviceManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DeviceManager
gi'self -> a -> DeviceManagerDeviceAddedCallback
gi'cb (DeviceManager -> a
Coerce.coerce DeviceManager
gi'self)  Device
device'


-- | Connect a signal handler for the [deviceAdded](#signal:deviceAdded) 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' deviceManager #deviceAdded callback
-- @
-- 
-- 
onDeviceManagerDeviceAdded :: (IsDeviceManager a, MonadIO m) => a -> ((?self :: a) => DeviceManagerDeviceAddedCallback) -> m SignalHandlerId
onDeviceManagerDeviceAdded :: forall a (m :: * -> *).
(IsDeviceManager a, MonadIO m) =>
a
-> ((?self::a) => DeviceManagerDeviceAddedCallback)
-> m SignalHandlerId
onDeviceManagerDeviceAdded a
obj (?self::a) => DeviceManagerDeviceAddedCallback
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 -> DeviceManagerDeviceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DeviceManagerDeviceAddedCallback
DeviceManagerDeviceAddedCallback
cb
    let wrapped' :: C_DeviceManagerDeviceAddedCallback
wrapped' = (a -> DeviceManagerDeviceAddedCallback)
-> C_DeviceManagerDeviceAddedCallback
forall a.
GObject a =>
(a -> DeviceManagerDeviceAddedCallback)
-> C_DeviceManagerDeviceAddedCallback
wrap_DeviceManagerDeviceAddedCallback a -> DeviceManagerDeviceAddedCallback
wrapped
    FunPtr C_DeviceManagerDeviceAddedCallback
wrapped'' <- C_DeviceManagerDeviceAddedCallback
-> IO (FunPtr C_DeviceManagerDeviceAddedCallback)
mk_DeviceManagerDeviceAddedCallback C_DeviceManagerDeviceAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_DeviceManagerDeviceAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"device-added" FunPtr C_DeviceManagerDeviceAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [deviceAdded](#signal:deviceAdded) 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' deviceManager #deviceAdded 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.
-- 
afterDeviceManagerDeviceAdded :: (IsDeviceManager a, MonadIO m) => a -> ((?self :: a) => DeviceManagerDeviceAddedCallback) -> m SignalHandlerId
afterDeviceManagerDeviceAdded :: forall a (m :: * -> *).
(IsDeviceManager a, MonadIO m) =>
a
-> ((?self::a) => DeviceManagerDeviceAddedCallback)
-> m SignalHandlerId
afterDeviceManagerDeviceAdded a
obj (?self::a) => DeviceManagerDeviceAddedCallback
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 -> DeviceManagerDeviceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DeviceManagerDeviceAddedCallback
DeviceManagerDeviceAddedCallback
cb
    let wrapped' :: C_DeviceManagerDeviceAddedCallback
wrapped' = (a -> DeviceManagerDeviceAddedCallback)
-> C_DeviceManagerDeviceAddedCallback
forall a.
GObject a =>
(a -> DeviceManagerDeviceAddedCallback)
-> C_DeviceManagerDeviceAddedCallback
wrap_DeviceManagerDeviceAddedCallback a -> DeviceManagerDeviceAddedCallback
wrapped
    FunPtr C_DeviceManagerDeviceAddedCallback
wrapped'' <- C_DeviceManagerDeviceAddedCallback
-> IO (FunPtr C_DeviceManagerDeviceAddedCallback)
mk_DeviceManagerDeviceAddedCallback C_DeviceManagerDeviceAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_DeviceManagerDeviceAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"device-added" FunPtr C_DeviceManagerDeviceAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DeviceManagerDeviceAddedSignalInfo
instance SignalInfo DeviceManagerDeviceAddedSignalInfo where
    type HaskellCallbackType DeviceManagerDeviceAddedSignalInfo = DeviceManagerDeviceAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DeviceManagerDeviceAddedCallback cb
        cb'' <- mk_DeviceManagerDeviceAddedCallback cb'
        connectSignalFunPtr obj "device-added" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.DeviceManager::device-added"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-3.0.25/docs/GI-Gdk-Objects-DeviceManager.html#g:signal:deviceAdded"})

#endif

-- signal DeviceManager::device-changed
-- | The [deviceChanged](#g:signal:deviceChanged) signal is emitted whenever a device
-- has changed in the hierarchy, either slave devices being
-- disconnected from their master device or connected to
-- another one, or master devices being added or removed
-- a slave device.
-- 
-- If a slave device is detached from all master devices
-- ('GI.Gdk.Objects.Device.deviceGetAssociatedDevice' returns 'P.Nothing'), its
-- t'GI.Gdk.Enums.DeviceType' will change to 'GI.Gdk.Enums.DeviceTypeFloating',
-- if it\'s attached, it will change to 'GI.Gdk.Enums.DeviceTypeSlave'.
type DeviceManagerDeviceChangedCallback =
    Gdk.Device.Device
    -- ^ /@device@/: the t'GI.Gdk.Objects.Device.Device' that changed.
    -> IO ()

type C_DeviceManagerDeviceChangedCallback =
    Ptr DeviceManager ->                    -- object
    Ptr Gdk.Device.Device ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_DeviceManagerDeviceChangedCallback :: 
    GObject a => (a -> DeviceManagerDeviceChangedCallback) ->
    C_DeviceManagerDeviceChangedCallback
wrap_DeviceManagerDeviceChangedCallback :: forall a.
GObject a =>
(a -> DeviceManagerDeviceAddedCallback)
-> C_DeviceManagerDeviceAddedCallback
wrap_DeviceManagerDeviceChangedCallback a -> DeviceManagerDeviceAddedCallback
gi'cb Ptr DeviceManager
gi'selfPtr Ptr Device
device Ptr ()
_ = do
    Device
device' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
Gdk.Device.Device) Ptr Device
device
    Ptr DeviceManager -> (DeviceManager -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr DeviceManager
gi'selfPtr ((DeviceManager -> IO ()) -> IO ())
-> (DeviceManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DeviceManager
gi'self -> a -> DeviceManagerDeviceAddedCallback
gi'cb (DeviceManager -> a
Coerce.coerce DeviceManager
gi'self)  Device
device'


-- | Connect a signal handler for the [deviceChanged](#signal:deviceChanged) 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' deviceManager #deviceChanged callback
-- @
-- 
-- 
onDeviceManagerDeviceChanged :: (IsDeviceManager a, MonadIO m) => a -> ((?self :: a) => DeviceManagerDeviceChangedCallback) -> m SignalHandlerId
onDeviceManagerDeviceChanged :: forall a (m :: * -> *).
(IsDeviceManager a, MonadIO m) =>
a
-> ((?self::a) => DeviceManagerDeviceAddedCallback)
-> m SignalHandlerId
onDeviceManagerDeviceChanged a
obj (?self::a) => DeviceManagerDeviceAddedCallback
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 -> DeviceManagerDeviceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DeviceManagerDeviceAddedCallback
DeviceManagerDeviceAddedCallback
cb
    let wrapped' :: C_DeviceManagerDeviceAddedCallback
wrapped' = (a -> DeviceManagerDeviceAddedCallback)
-> C_DeviceManagerDeviceAddedCallback
forall a.
GObject a =>
(a -> DeviceManagerDeviceAddedCallback)
-> C_DeviceManagerDeviceAddedCallback
wrap_DeviceManagerDeviceChangedCallback a -> DeviceManagerDeviceAddedCallback
wrapped
    FunPtr C_DeviceManagerDeviceAddedCallback
wrapped'' <- C_DeviceManagerDeviceAddedCallback
-> IO (FunPtr C_DeviceManagerDeviceAddedCallback)
mk_DeviceManagerDeviceChangedCallback C_DeviceManagerDeviceAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_DeviceManagerDeviceAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"device-changed" FunPtr C_DeviceManagerDeviceAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [deviceChanged](#signal:deviceChanged) 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' deviceManager #deviceChanged 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.
-- 
afterDeviceManagerDeviceChanged :: (IsDeviceManager a, MonadIO m) => a -> ((?self :: a) => DeviceManagerDeviceChangedCallback) -> m SignalHandlerId
afterDeviceManagerDeviceChanged :: forall a (m :: * -> *).
(IsDeviceManager a, MonadIO m) =>
a
-> ((?self::a) => DeviceManagerDeviceAddedCallback)
-> m SignalHandlerId
afterDeviceManagerDeviceChanged a
obj (?self::a) => DeviceManagerDeviceAddedCallback
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 -> DeviceManagerDeviceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DeviceManagerDeviceAddedCallback
DeviceManagerDeviceAddedCallback
cb
    let wrapped' :: C_DeviceManagerDeviceAddedCallback
wrapped' = (a -> DeviceManagerDeviceAddedCallback)
-> C_DeviceManagerDeviceAddedCallback
forall a.
GObject a =>
(a -> DeviceManagerDeviceAddedCallback)
-> C_DeviceManagerDeviceAddedCallback
wrap_DeviceManagerDeviceChangedCallback a -> DeviceManagerDeviceAddedCallback
wrapped
    FunPtr C_DeviceManagerDeviceAddedCallback
wrapped'' <- C_DeviceManagerDeviceAddedCallback
-> IO (FunPtr C_DeviceManagerDeviceAddedCallback)
mk_DeviceManagerDeviceChangedCallback C_DeviceManagerDeviceAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_DeviceManagerDeviceAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"device-changed" FunPtr C_DeviceManagerDeviceAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DeviceManagerDeviceChangedSignalInfo
instance SignalInfo DeviceManagerDeviceChangedSignalInfo where
    type HaskellCallbackType DeviceManagerDeviceChangedSignalInfo = DeviceManagerDeviceChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DeviceManagerDeviceChangedCallback cb
        cb'' <- mk_DeviceManagerDeviceChangedCallback cb'
        connectSignalFunPtr obj "device-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.DeviceManager::device-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-3.0.25/docs/GI-Gdk-Objects-DeviceManager.html#g:signal:deviceChanged"})

#endif

-- signal DeviceManager::device-removed
-- | The [deviceRemoved](#g:signal:deviceRemoved) signal is emitted either when a master
-- pointer is removed, or when a slave (Hardware) input device
-- is unplugged.
type DeviceManagerDeviceRemovedCallback =
    Gdk.Device.Device
    -- ^ /@device@/: the just removed t'GI.Gdk.Objects.Device.Device'.
    -> IO ()

type C_DeviceManagerDeviceRemovedCallback =
    Ptr DeviceManager ->                    -- object
    Ptr Gdk.Device.Device ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_DeviceManagerDeviceRemovedCallback :: 
    GObject a => (a -> DeviceManagerDeviceRemovedCallback) ->
    C_DeviceManagerDeviceRemovedCallback
wrap_DeviceManagerDeviceRemovedCallback :: forall a.
GObject a =>
(a -> DeviceManagerDeviceAddedCallback)
-> C_DeviceManagerDeviceAddedCallback
wrap_DeviceManagerDeviceRemovedCallback a -> DeviceManagerDeviceAddedCallback
gi'cb Ptr DeviceManager
gi'selfPtr Ptr Device
device Ptr ()
_ = do
    Device
device' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
Gdk.Device.Device) Ptr Device
device
    Ptr DeviceManager -> (DeviceManager -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr DeviceManager
gi'selfPtr ((DeviceManager -> IO ()) -> IO ())
-> (DeviceManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DeviceManager
gi'self -> a -> DeviceManagerDeviceAddedCallback
gi'cb (DeviceManager -> a
Coerce.coerce DeviceManager
gi'self)  Device
device'


-- | Connect a signal handler for the [deviceRemoved](#signal:deviceRemoved) 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' deviceManager #deviceRemoved callback
-- @
-- 
-- 
onDeviceManagerDeviceRemoved :: (IsDeviceManager a, MonadIO m) => a -> ((?self :: a) => DeviceManagerDeviceRemovedCallback) -> m SignalHandlerId
onDeviceManagerDeviceRemoved :: forall a (m :: * -> *).
(IsDeviceManager a, MonadIO m) =>
a
-> ((?self::a) => DeviceManagerDeviceAddedCallback)
-> m SignalHandlerId
onDeviceManagerDeviceRemoved a
obj (?self::a) => DeviceManagerDeviceAddedCallback
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 -> DeviceManagerDeviceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DeviceManagerDeviceAddedCallback
DeviceManagerDeviceAddedCallback
cb
    let wrapped' :: C_DeviceManagerDeviceAddedCallback
wrapped' = (a -> DeviceManagerDeviceAddedCallback)
-> C_DeviceManagerDeviceAddedCallback
forall a.
GObject a =>
(a -> DeviceManagerDeviceAddedCallback)
-> C_DeviceManagerDeviceAddedCallback
wrap_DeviceManagerDeviceRemovedCallback a -> DeviceManagerDeviceAddedCallback
wrapped
    FunPtr C_DeviceManagerDeviceAddedCallback
wrapped'' <- C_DeviceManagerDeviceAddedCallback
-> IO (FunPtr C_DeviceManagerDeviceAddedCallback)
mk_DeviceManagerDeviceRemovedCallback C_DeviceManagerDeviceAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_DeviceManagerDeviceAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"device-removed" FunPtr C_DeviceManagerDeviceAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [deviceRemoved](#signal:deviceRemoved) 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' deviceManager #deviceRemoved 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.
-- 
afterDeviceManagerDeviceRemoved :: (IsDeviceManager a, MonadIO m) => a -> ((?self :: a) => DeviceManagerDeviceRemovedCallback) -> m SignalHandlerId
afterDeviceManagerDeviceRemoved :: forall a (m :: * -> *).
(IsDeviceManager a, MonadIO m) =>
a
-> ((?self::a) => DeviceManagerDeviceAddedCallback)
-> m SignalHandlerId
afterDeviceManagerDeviceRemoved a
obj (?self::a) => DeviceManagerDeviceAddedCallback
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 -> DeviceManagerDeviceAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DeviceManagerDeviceAddedCallback
DeviceManagerDeviceAddedCallback
cb
    let wrapped' :: C_DeviceManagerDeviceAddedCallback
wrapped' = (a -> DeviceManagerDeviceAddedCallback)
-> C_DeviceManagerDeviceAddedCallback
forall a.
GObject a =>
(a -> DeviceManagerDeviceAddedCallback)
-> C_DeviceManagerDeviceAddedCallback
wrap_DeviceManagerDeviceRemovedCallback a -> DeviceManagerDeviceAddedCallback
wrapped
    FunPtr C_DeviceManagerDeviceAddedCallback
wrapped'' <- C_DeviceManagerDeviceAddedCallback
-> IO (FunPtr C_DeviceManagerDeviceAddedCallback)
mk_DeviceManagerDeviceRemovedCallback C_DeviceManagerDeviceAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_DeviceManagerDeviceAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"device-removed" FunPtr C_DeviceManagerDeviceAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DeviceManagerDeviceRemovedSignalInfo
instance SignalInfo DeviceManagerDeviceRemovedSignalInfo where
    type HaskellCallbackType DeviceManagerDeviceRemovedSignalInfo = DeviceManagerDeviceRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DeviceManagerDeviceRemovedCallback cb
        cb'' <- mk_DeviceManagerDeviceRemovedCallback cb'
        connectSignalFunPtr obj "device-removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.DeviceManager::device-removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-3.0.25/docs/GI-Gdk-Objects-DeviceManager.html#g:signal:deviceRemoved"})

#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data DeviceManagerDisplayPropertyInfo
instance AttrInfo DeviceManagerDisplayPropertyInfo where
    type AttrAllowedOps DeviceManagerDisplayPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DeviceManagerDisplayPropertyInfo = IsDeviceManager
    type AttrSetTypeConstraint DeviceManagerDisplayPropertyInfo = Gdk.Display.IsDisplay
    type AttrTransferTypeConstraint DeviceManagerDisplayPropertyInfo = Gdk.Display.IsDisplay
    type AttrTransferType DeviceManagerDisplayPropertyInfo = Gdk.Display.Display
    type AttrGetType DeviceManagerDisplayPropertyInfo = (Maybe Gdk.Display.Display)
    type AttrLabel DeviceManagerDisplayPropertyInfo = "display"
    type AttrOrigin DeviceManagerDisplayPropertyInfo = DeviceManager
    attrGet = getDeviceManagerDisplay
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gdk.Display.Display v
    attrConstruct = constructDeviceManagerDisplay
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.DeviceManager.display"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-3.0.25/docs/GI-Gdk-Objects-DeviceManager.html#g:attr:display"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DeviceManager
type instance O.AttributeList DeviceManager = DeviceManagerAttributeList
type DeviceManagerAttributeList = ('[ '("display", DeviceManagerDisplayPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
deviceManagerDisplay :: AttrLabelProxy "display"
deviceManagerDisplay = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DeviceManager = DeviceManagerSignalList
type DeviceManagerSignalList = ('[ '("deviceAdded", DeviceManagerDeviceAddedSignalInfo), '("deviceChanged", DeviceManagerDeviceChangedSignalInfo), '("deviceRemoved", DeviceManagerDeviceRemovedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method DeviceManager::get_client_pointer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device_manager"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "DeviceManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDeviceManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Device" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_manager_get_client_pointer" gdk_device_manager_get_client_pointer :: 
    Ptr DeviceManager ->                    -- device_manager : TInterface (Name {namespace = "Gdk", name = "DeviceManager"})
    IO (Ptr Gdk.Device.Device)

{-# DEPRECATED deviceManagerGetClientPointer ["(Since version 3.20)","Use 'GI.Gdk.Objects.Seat.seatGetPointer' instead."] #-}
-- | Returns the client pointer, that is, the master pointer that acts as the core pointer
-- for this application. In X11, window managers may change this depending on the interaction
-- pattern under the presence of several pointers.
-- 
-- You should use this function seldomly, only in code that isn’t triggered by a t'GI.Gdk.Unions.Event.Event'
-- and there aren’t other means to get a meaningful t'GI.Gdk.Objects.Device.Device' to operate on.
-- 
-- /Since: 3.0/
deviceManagerGetClientPointer ::
    (B.CallStack.HasCallStack, MonadIO m, IsDeviceManager a) =>
    a
    -- ^ /@deviceManager@/: a t'GI.Gdk.Objects.DeviceManager.DeviceManager'
    -> m Gdk.Device.Device
    -- ^ __Returns:__ The client pointer. This memory is
    --          owned by GDK and must not be freed or unreferenced.
deviceManagerGetClientPointer :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceManager a) =>
a -> m Device
deviceManagerGetClientPointer a
deviceManager = IO Device -> m Device
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Device -> m Device) -> IO Device -> m Device
forall a b. (a -> b) -> a -> b
$ do
    Ptr DeviceManager
deviceManager' <- a -> IO (Ptr DeviceManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
deviceManager
    Ptr Device
result <- Ptr DeviceManager -> IO (Ptr Device)
gdk_device_manager_get_client_pointer Ptr DeviceManager
deviceManager'
    Text -> Ptr Device -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceManagerGetClientPointer" Ptr Device
result
    Device
result' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
Gdk.Device.Device) Ptr Device
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
deviceManager
    Device -> IO Device
forall (m :: * -> *) a. Monad m => a -> m a
return Device
result'

#if defined(ENABLE_OVERLOADING)
data DeviceManagerGetClientPointerMethodInfo
instance (signature ~ (m Gdk.Device.Device), MonadIO m, IsDeviceManager a) => O.OverloadedMethod DeviceManagerGetClientPointerMethodInfo a signature where
    overloadedMethod = deviceManagerGetClientPointer

instance O.OverloadedMethodInfo DeviceManagerGetClientPointerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.DeviceManager.deviceManagerGetClientPointer",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-3.0.25/docs/GI-Gdk-Objects-DeviceManager.html#v:deviceManagerGetClientPointer"
        })


#endif

-- method DeviceManager::get_display
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device_manager"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "DeviceManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDeviceManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Display" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_manager_get_display" gdk_device_manager_get_display :: 
    Ptr DeviceManager ->                    -- device_manager : TInterface (Name {namespace = "Gdk", name = "DeviceManager"})
    IO (Ptr Gdk.Display.Display)

-- | Gets the t'GI.Gdk.Objects.Display.Display' associated to /@deviceManager@/.
-- 
-- /Since: 3.0/
deviceManagerGetDisplay ::
    (B.CallStack.HasCallStack, MonadIO m, IsDeviceManager a) =>
    a
    -- ^ /@deviceManager@/: a t'GI.Gdk.Objects.DeviceManager.DeviceManager'
    -> m (Maybe Gdk.Display.Display)
    -- ^ __Returns:__ the t'GI.Gdk.Objects.Display.Display' to which
    --          /@deviceManager@/ is associated to, or 'P.Nothing'. This memory is
    --          owned by GDK and must not be freed or unreferenced.
deviceManagerGetDisplay :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceManager a) =>
a -> m (Maybe Display)
deviceManagerGetDisplay a
deviceManager = IO (Maybe Display) -> m (Maybe Display)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Display) -> m (Maybe Display))
-> IO (Maybe Display) -> m (Maybe Display)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DeviceManager
deviceManager' <- a -> IO (Ptr DeviceManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
deviceManager
    Ptr Display
result <- Ptr DeviceManager -> IO (Ptr Display)
gdk_device_manager_get_display Ptr DeviceManager
deviceManager'
    Maybe Display
maybeResult <- Ptr Display -> (Ptr Display -> IO Display) -> IO (Maybe Display)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Display
result ((Ptr Display -> IO Display) -> IO (Maybe Display))
-> (Ptr Display -> IO Display) -> IO (Maybe Display)
forall a b. (a -> b) -> a -> b
$ \Ptr Display
result' -> do
        Display
result'' <- ((ManagedPtr Display -> Display) -> Ptr Display -> IO Display
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Display -> Display
Gdk.Display.Display) Ptr Display
result'
        Display -> IO Display
forall (m :: * -> *) a. Monad m => a -> m a
return Display
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
deviceManager
    Maybe Display -> IO (Maybe Display)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Display
maybeResult

#if defined(ENABLE_OVERLOADING)
data DeviceManagerGetDisplayMethodInfo
instance (signature ~ (m (Maybe Gdk.Display.Display)), MonadIO m, IsDeviceManager a) => O.OverloadedMethod DeviceManagerGetDisplayMethodInfo a signature where
    overloadedMethod = deviceManagerGetDisplay

instance O.OverloadedMethodInfo DeviceManagerGetDisplayMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.DeviceManager.deviceManagerGetDisplay",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-3.0.25/docs/GI-Gdk-Objects-DeviceManager.html#v:deviceManagerGetDisplay"
        })


#endif

-- method DeviceManager::list_devices
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device_manager"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "DeviceManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDeviceManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "DeviceType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "device type to get."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Gdk" , name = "Device" }))
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_manager_list_devices" gdk_device_manager_list_devices :: 
    Ptr DeviceManager ->                    -- device_manager : TInterface (Name {namespace = "Gdk", name = "DeviceManager"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Gdk", name = "DeviceType"})
    IO (Ptr (GList (Ptr Gdk.Device.Device)))

{-# DEPRECATED deviceManagerListDevices ["(Since version 3.20)",", use 'GI.Gdk.Objects.Seat.seatGetPointer', 'GI.Gdk.Objects.Seat.seatGetKeyboard'","            and 'GI.Gdk.Objects.Seat.seatGetSlaves' instead."] #-}
-- | Returns the list of devices of type /@type@/ currently attached to
-- /@deviceManager@/.
-- 
-- /Since: 3.0/
deviceManagerListDevices ::
    (B.CallStack.HasCallStack, MonadIO m, IsDeviceManager a) =>
    a
    -- ^ /@deviceManager@/: a t'GI.Gdk.Objects.DeviceManager.DeviceManager'
    -> Gdk.Enums.DeviceType
    -- ^ /@type@/: device type to get.
    -> m [Gdk.Device.Device]
    -- ^ __Returns:__ a list of
    --          @/GdkDevices/@. The returned list must be
    --          freed with g_list_free (). The list elements are owned by
    --          GTK+ and must not be freed or unreffed.
deviceManagerListDevices :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDeviceManager a) =>
a -> DeviceType -> m [Device]
deviceManagerListDevices a
deviceManager DeviceType
type_ = IO [Device] -> m [Device]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Device] -> m [Device]) -> IO [Device] -> m [Device]
forall a b. (a -> b) -> a -> b
$ do
    Ptr DeviceManager
deviceManager' <- a -> IO (Ptr DeviceManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
deviceManager
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (DeviceType -> Int) -> DeviceType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeviceType -> Int
forall a. Enum a => a -> Int
fromEnum) DeviceType
type_
    Ptr (GList (Ptr Device))
result <- Ptr DeviceManager -> CUInt -> IO (Ptr (GList (Ptr Device)))
gdk_device_manager_list_devices Ptr DeviceManager
deviceManager' CUInt
type_'
    [Ptr Device]
result' <- Ptr (GList (Ptr Device)) -> IO [Ptr Device]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Device))
result
    [Device]
result'' <- (Ptr Device -> IO Device) -> [Ptr Device] -> IO [Device]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
Gdk.Device.Device) [Ptr Device]
result'
    Ptr (GList (Ptr Device)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Device))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
deviceManager
    [Device] -> IO [Device]
forall (m :: * -> *) a. Monad m => a -> m a
return [Device]
result''

#if defined(ENABLE_OVERLOADING)
data DeviceManagerListDevicesMethodInfo
instance (signature ~ (Gdk.Enums.DeviceType -> m [Gdk.Device.Device]), MonadIO m, IsDeviceManager a) => O.OverloadedMethod DeviceManagerListDevicesMethodInfo a signature where
    overloadedMethod = deviceManagerListDevices

instance O.OverloadedMethodInfo DeviceManagerListDevicesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.DeviceManager.deviceManagerListDevices",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-3.0.25/docs/GI-Gdk-Objects-DeviceManager.html#v:deviceManagerListDevices"
        })


#endif