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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Dazzle.Objects.ShortcutController
    ( 

-- * Exported types
    ShortcutController(..)                  ,
    IsShortcutController                    ,
    toShortcutController                    ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addCommandAction]("GI.Dazzle.Objects.ShortcutController#g:method:addCommandAction"), [addCommandCallback]("GI.Dazzle.Objects.ShortcutController#g:method:addCommandCallback"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [executeCommand]("GI.Dazzle.Objects.ShortcutController#g:method:executeCommand"), [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"), [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"), [removeAccel]("GI.Dazzle.Objects.ShortcutController#g:method:removeAccel"), [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
-- [getContext]("GI.Dazzle.Objects.ShortcutController#g:method:getContext"), [getContextForPhase]("GI.Dazzle.Objects.ShortcutController#g:method:getContextForPhase"), [getCurrentChord]("GI.Dazzle.Objects.ShortcutController#g:method:getCurrentChord"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getManager]("GI.Dazzle.Objects.ShortcutController#g:method:getManager"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getWidget]("GI.Dazzle.Objects.ShortcutController#g:method:getWidget").
-- 
-- ==== Setters
-- [setContextByName]("GI.Dazzle.Objects.ShortcutController#g:method:setContextByName"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setManager]("GI.Dazzle.Objects.ShortcutController#g:method:setManager"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveShortcutControllerMethod         ,
#endif

-- ** addCommandAction #method:addCommandAction#

#if defined(ENABLE_OVERLOADING)
    ShortcutControllerAddCommandActionMethodInfo,
#endif
    shortcutControllerAddCommandAction      ,


-- ** addCommandCallback #method:addCommandCallback#

#if defined(ENABLE_OVERLOADING)
    ShortcutControllerAddCommandCallbackMethodInfo,
#endif
    shortcutControllerAddCommandCallback    ,


-- ** executeCommand #method:executeCommand#

#if defined(ENABLE_OVERLOADING)
    ShortcutControllerExecuteCommandMethodInfo,
#endif
    shortcutControllerExecuteCommand        ,


-- ** find #method:find#

    shortcutControllerFind                  ,


-- ** getContext #method:getContext#

#if defined(ENABLE_OVERLOADING)
    ShortcutControllerGetContextMethodInfo  ,
#endif
    shortcutControllerGetContext            ,


-- ** getContextForPhase #method:getContextForPhase#

#if defined(ENABLE_OVERLOADING)
    ShortcutControllerGetContextForPhaseMethodInfo,
#endif
    shortcutControllerGetContextForPhase    ,


-- ** getCurrentChord #method:getCurrentChord#

#if defined(ENABLE_OVERLOADING)
    ShortcutControllerGetCurrentChordMethodInfo,
#endif
    shortcutControllerGetCurrentChord       ,


-- ** getManager #method:getManager#

#if defined(ENABLE_OVERLOADING)
    ShortcutControllerGetManagerMethodInfo  ,
#endif
    shortcutControllerGetManager            ,


-- ** getWidget #method:getWidget#

#if defined(ENABLE_OVERLOADING)
    ShortcutControllerGetWidgetMethodInfo   ,
#endif
    shortcutControllerGetWidget             ,


-- ** new #method:new#

    shortcutControllerNew                   ,


-- ** removeAccel #method:removeAccel#

#if defined(ENABLE_OVERLOADING)
    ShortcutControllerRemoveAccelMethodInfo ,
#endif
    shortcutControllerRemoveAccel           ,


-- ** setContextByName #method:setContextByName#

#if defined(ENABLE_OVERLOADING)
    ShortcutControllerSetContextByNameMethodInfo,
#endif
    shortcutControllerSetContextByName      ,


-- ** setManager #method:setManager#

#if defined(ENABLE_OVERLOADING)
    ShortcutControllerSetManagerMethodInfo  ,
#endif
    shortcutControllerSetManager            ,


-- ** tryFind #method:tryFind#

    shortcutControllerTryFind               ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    ShortcutControllerContextPropertyInfo   ,
#endif
    getShortcutControllerContext            ,
#if defined(ENABLE_OVERLOADING)
    shortcutControllerContext               ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    ShortcutControllerCurrentChordPropertyInfo,
#endif
    getShortcutControllerCurrentChord       ,
#if defined(ENABLE_OVERLOADING)
    shortcutControllerCurrentChord          ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    ShortcutControllerManagerPropertyInfo   ,
#endif
    clearShortcutControllerManager          ,
    constructShortcutControllerManager      ,
    getShortcutControllerManager            ,
    setShortcutControllerManager            ,
#if defined(ENABLE_OVERLOADING)
    shortcutControllerManager               ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    ShortcutControllerWidgetPropertyInfo    ,
#endif
    constructShortcutControllerWidget       ,
    getShortcutControllerWidget             ,
#if defined(ENABLE_OVERLOADING)
    shortcutControllerWidget                ,
#endif




 -- * Signals


-- ** reset #signal:reset#

    ShortcutControllerResetCallback         ,
#if defined(ENABLE_OVERLOADING)
    ShortcutControllerResetSignalInfo       ,
#endif
    afterShortcutControllerReset            ,
    onShortcutControllerReset               ,


-- ** setContextNamed #signal:setContextNamed#

    ShortcutControllerSetContextNamedCallback,
#if defined(ENABLE_OVERLOADING)
    ShortcutControllerSetContextNamedSignalInfo,
#endif
    afterShortcutControllerSetContextNamed  ,
    onShortcutControllerSetContextNamed     ,




    ) 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.GHashTable as B.GHT
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.Kind as DK
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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import {-# SOURCE #-} qualified GI.Dazzle.Enums as Dazzle.Enums
import {-# SOURCE #-} qualified GI.Dazzle.Flags as Dazzle.Flags
import {-# SOURCE #-} qualified GI.Dazzle.Objects.ShortcutContext as Dazzle.ShortcutContext
import {-# SOURCE #-} qualified GI.Dazzle.Objects.ShortcutManager as Dazzle.ShortcutManager
import {-# SOURCE #-} qualified GI.Dazzle.Objects.ShortcutTheme as Dazzle.ShortcutTheme
import {-# SOURCE #-} qualified GI.Dazzle.Objects.ShortcutsWindow as Dazzle.ShortcutsWindow
import {-# SOURCE #-} qualified GI.Dazzle.Structs.ShortcutChord as Dazzle.ShortcutChord
import {-# SOURCE #-} qualified GI.Dazzle.Structs.ShortcutEntry as Dazzle.ShortcutEntry
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Structs.EventKey as Gdk.EventKey
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.OutputStream as Gio.OutputStream
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import qualified GI.Gtk.Objects.Bin as Gtk.Bin
import qualified GI.Gtk.Objects.Container as Gtk.Container
import qualified GI.Gtk.Objects.Widget as Gtk.Widget
import qualified GI.Gtk.Objects.Window as Gtk.Window

#else
import {-# SOURCE #-} qualified GI.Dazzle.Flags as Dazzle.Flags
import {-# SOURCE #-} qualified GI.Dazzle.Objects.ShortcutContext as Dazzle.ShortcutContext
import {-# SOURCE #-} qualified GI.Dazzle.Objects.ShortcutManager as Dazzle.ShortcutManager
import {-# SOURCE #-} qualified GI.Dazzle.Structs.ShortcutChord as Dazzle.ShortcutChord
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#endif

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

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

foreign import ccall "dzl_shortcut_controller_get_type"
    c_dzl_shortcut_controller_get_type :: IO B.Types.GType

instance B.Types.TypedObject ShortcutController where
    glibType :: IO GType
glibType = IO GType
c_dzl_shortcut_controller_get_type

instance B.Types.GObject ShortcutController

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveShortcutControllerMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveShortcutControllerMethod "addCommandAction" o = ShortcutControllerAddCommandActionMethodInfo
    ResolveShortcutControllerMethod "addCommandCallback" o = ShortcutControllerAddCommandCallbackMethodInfo
    ResolveShortcutControllerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveShortcutControllerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveShortcutControllerMethod "executeCommand" o = ShortcutControllerExecuteCommandMethodInfo
    ResolveShortcutControllerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveShortcutControllerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveShortcutControllerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveShortcutControllerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveShortcutControllerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveShortcutControllerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveShortcutControllerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveShortcutControllerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveShortcutControllerMethod "removeAccel" o = ShortcutControllerRemoveAccelMethodInfo
    ResolveShortcutControllerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveShortcutControllerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveShortcutControllerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveShortcutControllerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveShortcutControllerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveShortcutControllerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveShortcutControllerMethod "getContext" o = ShortcutControllerGetContextMethodInfo
    ResolveShortcutControllerMethod "getContextForPhase" o = ShortcutControllerGetContextForPhaseMethodInfo
    ResolveShortcutControllerMethod "getCurrentChord" o = ShortcutControllerGetCurrentChordMethodInfo
    ResolveShortcutControllerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveShortcutControllerMethod "getManager" o = ShortcutControllerGetManagerMethodInfo
    ResolveShortcutControllerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveShortcutControllerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveShortcutControllerMethod "getWidget" o = ShortcutControllerGetWidgetMethodInfo
    ResolveShortcutControllerMethod "setContextByName" o = ShortcutControllerSetContextByNameMethodInfo
    ResolveShortcutControllerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveShortcutControllerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveShortcutControllerMethod "setManager" o = ShortcutControllerSetManagerMethodInfo
    ResolveShortcutControllerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveShortcutControllerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal ShortcutController::reset
-- | This signal is emitted when the shortcut controller is requesting
-- the widget to reset any state it may have regarding the shortcut
-- controller. Such an example might be a modal system that lives
-- outside the controller whose state should be cleared in response
-- to the controller changing modes.
type ShortcutControllerResetCallback =
    IO ()

type C_ShortcutControllerResetCallback =
    Ptr ShortcutController ->               -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ShortcutControllerResetCallback :: 
    GObject a => (a -> ShortcutControllerResetCallback) ->
    C_ShortcutControllerResetCallback
wrap_ShortcutControllerResetCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_ShortcutControllerResetCallback
wrap_ShortcutControllerResetCallback a -> IO ()
gi'cb Ptr ShortcutController
gi'selfPtr Ptr ()
_ = do
    Ptr ShortcutController -> (ShortcutController -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr ShortcutController
gi'selfPtr ((ShortcutController -> IO ()) -> IO ())
-> (ShortcutController -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ShortcutController
gi'self -> a -> IO ()
gi'cb (ShortcutController -> a
forall a b. Coercible a b => a -> b
Coerce.coerce ShortcutController
gi'self) 


-- | Connect a signal handler for the [reset](#signal:reset) 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' shortcutController #reset callback
-- @
-- 
-- 
onShortcutControllerReset :: (IsShortcutController a, MonadIO m) => a -> ((?self :: a) => ShortcutControllerResetCallback) -> m SignalHandlerId
onShortcutControllerReset :: forall a (m :: * -> *).
(IsShortcutController a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onShortcutControllerReset a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ShortcutControllerResetCallback
wrapped' = (a -> IO ()) -> C_ShortcutControllerResetCallback
forall a.
GObject a =>
(a -> IO ()) -> C_ShortcutControllerResetCallback
wrap_ShortcutControllerResetCallback a -> IO ()
wrapped
    FunPtr C_ShortcutControllerResetCallback
wrapped'' <- C_ShortcutControllerResetCallback
-> IO (FunPtr C_ShortcutControllerResetCallback)
mk_ShortcutControllerResetCallback C_ShortcutControllerResetCallback
wrapped'
    a
-> Text
-> FunPtr C_ShortcutControllerResetCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"reset" FunPtr C_ShortcutControllerResetCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [reset](#signal:reset) 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' shortcutController #reset 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.
-- 
afterShortcutControllerReset :: (IsShortcutController a, MonadIO m) => a -> ((?self :: a) => ShortcutControllerResetCallback) -> m SignalHandlerId
afterShortcutControllerReset :: forall a (m :: * -> *).
(IsShortcutController a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterShortcutControllerReset a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ShortcutControllerResetCallback
wrapped' = (a -> IO ()) -> C_ShortcutControllerResetCallback
forall a.
GObject a =>
(a -> IO ()) -> C_ShortcutControllerResetCallback
wrap_ShortcutControllerResetCallback a -> IO ()
wrapped
    FunPtr C_ShortcutControllerResetCallback
wrapped'' <- C_ShortcutControllerResetCallback
-> IO (FunPtr C_ShortcutControllerResetCallback)
mk_ShortcutControllerResetCallback C_ShortcutControllerResetCallback
wrapped'
    a
-> Text
-> FunPtr C_ShortcutControllerResetCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"reset" FunPtr C_ShortcutControllerResetCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ShortcutControllerResetSignalInfo
instance SignalInfo ShortcutControllerResetSignalInfo where
    type HaskellCallbackType ShortcutControllerResetSignalInfo = ShortcutControllerResetCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ShortcutControllerResetCallback cb
        cb'' <- mk_ShortcutControllerResetCallback cb'
        connectSignalFunPtr obj "reset" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController::reset"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#g:signal:reset"})

#endif

-- signal ShortcutController::set-context-named
-- | This changes the current context on the t'GI.Dazzle.Objects.ShortcutController.ShortcutController' to be the
-- context matching /@name@/. This is found by looking up the context by name
-- in the active t'GI.Dazzle.Objects.ShortcutTheme.ShortcutTheme'.
type ShortcutControllerSetContextNamedCallback =
    T.Text
    -- ^ /@name@/: The name of the context
    -> IO ()

type C_ShortcutControllerSetContextNamedCallback =
    Ptr ShortcutController ->               -- object
    CString ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ShortcutControllerSetContextNamedCallback :: 
    GObject a => (a -> ShortcutControllerSetContextNamedCallback) ->
    C_ShortcutControllerSetContextNamedCallback
wrap_ShortcutControllerSetContextNamedCallback :: forall a.
GObject a =>
(a -> ShortcutControllerSetContextNamedCallback)
-> C_ShortcutControllerSetContextNamedCallback
wrap_ShortcutControllerSetContextNamedCallback a -> ShortcutControllerSetContextNamedCallback
gi'cb Ptr ShortcutController
gi'selfPtr CString
name Ptr ()
_ = do
    Text
name' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
name
    Ptr ShortcutController -> (ShortcutController -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr ShortcutController
gi'selfPtr ((ShortcutController -> IO ()) -> IO ())
-> (ShortcutController -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ShortcutController
gi'self -> a -> ShortcutControllerSetContextNamedCallback
gi'cb (ShortcutController -> a
forall a b. Coercible a b => a -> b
Coerce.coerce ShortcutController
gi'self)  Text
name'


-- | Connect a signal handler for the [setContextNamed](#signal:setContextNamed) 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' shortcutController #setContextNamed callback
-- @
-- 
-- 
onShortcutControllerSetContextNamed :: (IsShortcutController a, MonadIO m) => a -> ((?self :: a) => ShortcutControllerSetContextNamedCallback) -> m SignalHandlerId
onShortcutControllerSetContextNamed :: forall a (m :: * -> *).
(IsShortcutController a, MonadIO m) =>
a
-> ((?self::a) => ShortcutControllerSetContextNamedCallback)
-> m SignalHandlerId
onShortcutControllerSetContextNamed a
obj (?self::a) => ShortcutControllerSetContextNamedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 -> ShortcutControllerSetContextNamedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ShortcutControllerSetContextNamedCallback
ShortcutControllerSetContextNamedCallback
cb
    let wrapped' :: C_ShortcutControllerSetContextNamedCallback
wrapped' = (a -> ShortcutControllerSetContextNamedCallback)
-> C_ShortcutControllerSetContextNamedCallback
forall a.
GObject a =>
(a -> ShortcutControllerSetContextNamedCallback)
-> C_ShortcutControllerSetContextNamedCallback
wrap_ShortcutControllerSetContextNamedCallback a -> ShortcutControllerSetContextNamedCallback
wrapped
    FunPtr C_ShortcutControllerSetContextNamedCallback
wrapped'' <- C_ShortcutControllerSetContextNamedCallback
-> IO (FunPtr C_ShortcutControllerSetContextNamedCallback)
mk_ShortcutControllerSetContextNamedCallback C_ShortcutControllerSetContextNamedCallback
wrapped'
    a
-> Text
-> FunPtr C_ShortcutControllerSetContextNamedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"set-context-named" FunPtr C_ShortcutControllerSetContextNamedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [setContextNamed](#signal:setContextNamed) 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' shortcutController #setContextNamed 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.
-- 
afterShortcutControllerSetContextNamed :: (IsShortcutController a, MonadIO m) => a -> ((?self :: a) => ShortcutControllerSetContextNamedCallback) -> m SignalHandlerId
afterShortcutControllerSetContextNamed :: forall a (m :: * -> *).
(IsShortcutController a, MonadIO m) =>
a
-> ((?self::a) => ShortcutControllerSetContextNamedCallback)
-> m SignalHandlerId
afterShortcutControllerSetContextNamed a
obj (?self::a) => ShortcutControllerSetContextNamedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 -> ShortcutControllerSetContextNamedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => ShortcutControllerSetContextNamedCallback
ShortcutControllerSetContextNamedCallback
cb
    let wrapped' :: C_ShortcutControllerSetContextNamedCallback
wrapped' = (a -> ShortcutControllerSetContextNamedCallback)
-> C_ShortcutControllerSetContextNamedCallback
forall a.
GObject a =>
(a -> ShortcutControllerSetContextNamedCallback)
-> C_ShortcutControllerSetContextNamedCallback
wrap_ShortcutControllerSetContextNamedCallback a -> ShortcutControllerSetContextNamedCallback
wrapped
    FunPtr C_ShortcutControllerSetContextNamedCallback
wrapped'' <- C_ShortcutControllerSetContextNamedCallback
-> IO (FunPtr C_ShortcutControllerSetContextNamedCallback)
mk_ShortcutControllerSetContextNamedCallback C_ShortcutControllerSetContextNamedCallback
wrapped'
    a
-> Text
-> FunPtr C_ShortcutControllerSetContextNamedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"set-context-named" FunPtr C_ShortcutControllerSetContextNamedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ShortcutControllerSetContextNamedSignalInfo
instance SignalInfo ShortcutControllerSetContextNamedSignalInfo where
    type HaskellCallbackType ShortcutControllerSetContextNamedSignalInfo = ShortcutControllerSetContextNamedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ShortcutControllerSetContextNamedCallback cb
        cb'' <- mk_ShortcutControllerSetContextNamedCallback cb'
        connectSignalFunPtr obj "set-context-named" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController::set-context-named"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#g:signal:setContextNamed"})

#endif

-- VVV Prop "context"
   -- Type: TInterface (Name {namespace = "Dazzle", name = "ShortcutContext"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just True,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data ShortcutControllerContextPropertyInfo
instance AttrInfo ShortcutControllerContextPropertyInfo where
    type AttrAllowedOps ShortcutControllerContextPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutControllerContextPropertyInfo = IsShortcutController
    type AttrSetTypeConstraint ShortcutControllerContextPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ShortcutControllerContextPropertyInfo = (~) ()
    type AttrTransferType ShortcutControllerContextPropertyInfo = ()
    type AttrGetType ShortcutControllerContextPropertyInfo = (Maybe Dazzle.ShortcutContext.ShortcutContext)
    type AttrLabel ShortcutControllerContextPropertyInfo = "context"
    type AttrOrigin ShortcutControllerContextPropertyInfo = ShortcutController
    attrGet = getShortcutControllerContext
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController.context"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#g:attr:context"
        })
#endif

-- VVV Prop "current-chord"
   -- Type: TInterface (Name {namespace = "Dazzle", name = "ShortcutChord"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@current-chord@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shortcutController #currentChord
-- @
getShortcutControllerCurrentChord :: (MonadIO m, IsShortcutController o) => o -> m (Maybe Dazzle.ShortcutChord.ShortcutChord)
getShortcutControllerCurrentChord :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutController o) =>
o -> m (Maybe ShortcutChord)
getShortcutControllerCurrentChord o
obj = IO (Maybe ShortcutChord) -> m (Maybe ShortcutChord)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe ShortcutChord) -> m (Maybe ShortcutChord))
-> IO (Maybe ShortcutChord) -> m (Maybe ShortcutChord)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr ShortcutChord -> ShortcutChord)
-> IO (Maybe ShortcutChord)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"current-chord" ManagedPtr ShortcutChord -> ShortcutChord
Dazzle.ShortcutChord.ShortcutChord

#if defined(ENABLE_OVERLOADING)
data ShortcutControllerCurrentChordPropertyInfo
instance AttrInfo ShortcutControllerCurrentChordPropertyInfo where
    type AttrAllowedOps ShortcutControllerCurrentChordPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutControllerCurrentChordPropertyInfo = IsShortcutController
    type AttrSetTypeConstraint ShortcutControllerCurrentChordPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ShortcutControllerCurrentChordPropertyInfo = (~) ()
    type AttrTransferType ShortcutControllerCurrentChordPropertyInfo = ()
    type AttrGetType ShortcutControllerCurrentChordPropertyInfo = (Maybe Dazzle.ShortcutChord.ShortcutChord)
    type AttrLabel ShortcutControllerCurrentChordPropertyInfo = "current-chord"
    type AttrOrigin ShortcutControllerCurrentChordPropertyInfo = ShortcutController
    attrGet = getShortcutControllerCurrentChord
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController.currentChord"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#g:attr:currentChord"
        })
#endif

-- VVV Prop "manager"
   -- Type: TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just True)

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

-- | Set the value of the “@manager@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutController [ #manager 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutControllerManager :: (MonadIO m, IsShortcutController o, Dazzle.ShortcutManager.IsShortcutManager a) => o -> a -> m ()
setShortcutControllerManager :: forall (m :: * -> *) o a.
(MonadIO m, IsShortcutController o, IsShortcutManager a) =>
o -> a -> m ()
setShortcutControllerManager o
obj a
val = IO () -> m ()
forall a. IO a -> m a
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
"manager" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

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

-- | Set the value of the “@manager@” 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' #manager
-- @
clearShortcutControllerManager :: (MonadIO m, IsShortcutController o) => o -> m ()
clearShortcutControllerManager :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutController o) =>
o -> m ()
clearShortcutControllerManager o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe ShortcutManager -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"manager" (Maybe ShortcutManager
forall a. Maybe a
Nothing :: Maybe Dazzle.ShortcutManager.ShortcutManager)

#if defined(ENABLE_OVERLOADING)
data ShortcutControllerManagerPropertyInfo
instance AttrInfo ShortcutControllerManagerPropertyInfo where
    type AttrAllowedOps ShortcutControllerManagerPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutControllerManagerPropertyInfo = IsShortcutController
    type AttrSetTypeConstraint ShortcutControllerManagerPropertyInfo = Dazzle.ShortcutManager.IsShortcutManager
    type AttrTransferTypeConstraint ShortcutControllerManagerPropertyInfo = Dazzle.ShortcutManager.IsShortcutManager
    type AttrTransferType ShortcutControllerManagerPropertyInfo = Dazzle.ShortcutManager.ShortcutManager
    type AttrGetType ShortcutControllerManagerPropertyInfo = Dazzle.ShortcutManager.ShortcutManager
    type AttrLabel ShortcutControllerManagerPropertyInfo = "manager"
    type AttrOrigin ShortcutControllerManagerPropertyInfo = ShortcutController
    attrGet = getShortcutControllerManager
    attrSet = setShortcutControllerManager
    attrTransfer _ v = do
        unsafeCastTo Dazzle.ShortcutManager.ShortcutManager v
    attrConstruct = constructShortcutControllerManager
    attrClear = clearShortcutControllerManager
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController.manager"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#g:attr:manager"
        })
#endif

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

-- | Get the value of the “@widget@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shortcutController #widget
-- @
getShortcutControllerWidget :: (MonadIO m, IsShortcutController o) => o -> m Gtk.Widget.Widget
getShortcutControllerWidget :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutController o) =>
o -> m Widget
getShortcutControllerWidget o
obj = IO Widget -> m Widget
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Widget) -> IO Widget
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getShortcutControllerWidget" (IO (Maybe Widget) -> IO Widget) -> IO (Maybe Widget) -> IO 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
"widget" ManagedPtr Widget -> Widget
Gtk.Widget.Widget

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

#if defined(ENABLE_OVERLOADING)
data ShortcutControllerWidgetPropertyInfo
instance AttrInfo ShortcutControllerWidgetPropertyInfo where
    type AttrAllowedOps ShortcutControllerWidgetPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutControllerWidgetPropertyInfo = IsShortcutController
    type AttrSetTypeConstraint ShortcutControllerWidgetPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint ShortcutControllerWidgetPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType ShortcutControllerWidgetPropertyInfo = Gtk.Widget.Widget
    type AttrGetType ShortcutControllerWidgetPropertyInfo = Gtk.Widget.Widget
    type AttrLabel ShortcutControllerWidgetPropertyInfo = "widget"
    type AttrOrigin ShortcutControllerWidgetPropertyInfo = ShortcutController
    attrGet = getShortcutControllerWidget
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructShortcutControllerWidget
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController.widget"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#g:attr:widget"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ShortcutController
type instance O.AttributeList ShortcutController = ShortcutControllerAttributeList
type ShortcutControllerAttributeList = ('[ '("context", ShortcutControllerContextPropertyInfo), '("currentChord", ShortcutControllerCurrentChordPropertyInfo), '("manager", ShortcutControllerManagerPropertyInfo), '("widget", ShortcutControllerWidgetPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
shortcutControllerContext :: AttrLabelProxy "context"
shortcutControllerContext = AttrLabelProxy

shortcutControllerCurrentChord :: AttrLabelProxy "currentChord"
shortcutControllerCurrentChord = AttrLabelProxy

shortcutControllerManager :: AttrLabelProxy "manager"
shortcutControllerManager = AttrLabelProxy

shortcutControllerWidget :: AttrLabelProxy "widget"
shortcutControllerWidget = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ShortcutController = ShortcutControllerSignalList
type ShortcutControllerSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo), '("reset", ShortcutControllerResetSignalInfo), '("setContextNamed", ShortcutControllerSetContextNamedSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method ShortcutController::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Dazzle" , name = "ShortcutController" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_controller_new" dzl_shortcut_controller_new :: 
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO (Ptr ShortcutController)

-- | /No description available in the introspection data./
shortcutControllerNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.Widget.IsWidget a) =>
    a
    -> m ShortcutController
shortcutControllerNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ShortcutController
shortcutControllerNew a
widget = IO ShortcutController -> m ShortcutController
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutController -> m ShortcutController)
-> IO ShortcutController -> m ShortcutController
forall a b. (a -> b) -> a -> b
$ do
    Ptr Widget
widget' <- a -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
widget
    Ptr ShortcutController
result <- Ptr Widget -> IO (Ptr ShortcutController)
dzl_shortcut_controller_new Ptr Widget
widget'
    Text -> Ptr ShortcutController -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutControllerNew" Ptr ShortcutController
result
    ShortcutController
result' <- ((ManagedPtr ShortcutController -> ShortcutController)
-> Ptr ShortcutController -> IO ShortcutController
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ShortcutController -> ShortcutController
ShortcutController) Ptr ShortcutController
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
widget
    ShortcutController -> IO ShortcutController
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutController
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ShortcutController::add_command_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutController" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "command_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_accel"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "phase"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutPhase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_controller_add_command_action" dzl_shortcut_controller_add_command_action :: 
    Ptr ShortcutController ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutController"})
    CString ->                              -- command_id : TBasicType TUTF8
    CString ->                              -- default_accel : TBasicType TUTF8
    CUInt ->                                -- phase : TInterface (Name {namespace = "Dazzle", name = "ShortcutPhase"})
    CString ->                              -- action : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
shortcutControllerAddCommandAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutController a) =>
    a
    -> T.Text
    -> T.Text
    -> [Dazzle.Flags.ShortcutPhase]
    -> T.Text
    -> m ()
shortcutControllerAddCommandAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutController a) =>
a -> Text -> Text -> [ShortcutPhase] -> Text -> m ()
shortcutControllerAddCommandAction a
self Text
commandId Text
defaultAccel [ShortcutPhase]
phase Text
action = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutController
self' <- a -> IO (Ptr ShortcutController)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
commandId' <- Text -> IO CString
textToCString Text
commandId
    CString
defaultAccel' <- Text -> IO CString
textToCString Text
defaultAccel
    let phase' :: CUInt
phase' = [ShortcutPhase] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ShortcutPhase]
phase
    CString
action' <- Text -> IO CString
textToCString Text
action
    Ptr ShortcutController
-> CString -> CString -> CUInt -> CString -> IO ()
dzl_shortcut_controller_add_command_action Ptr ShortcutController
self' CString
commandId' CString
defaultAccel' CUInt
phase' CString
action'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commandId'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
defaultAccel'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
action'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutControllerAddCommandActionMethodInfo
instance (signature ~ (T.Text -> T.Text -> [Dazzle.Flags.ShortcutPhase] -> T.Text -> m ()), MonadIO m, IsShortcutController a) => O.OverloadedMethod ShortcutControllerAddCommandActionMethodInfo a signature where
    overloadedMethod = shortcutControllerAddCommandAction

instance O.OverloadedMethodInfo ShortcutControllerAddCommandActionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController.shortcutControllerAddCommandAction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#v:shortcutControllerAddCommandAction"
        })


#endif

-- method ShortcutController::add_command_callback
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutController" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "command_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_accel"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "phase"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutPhase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Callback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeNotified
--           , argClosure = 5
--           , argDestroy = 6
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback_data_destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_controller_add_command_callback" dzl_shortcut_controller_add_command_callback :: 
    Ptr ShortcutController ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutController"})
    CString ->                              -- command_id : TBasicType TUTF8
    CString ->                              -- default_accel : TBasicType TUTF8
    CUInt ->                                -- phase : TInterface (Name {namespace = "Dazzle", name = "ShortcutPhase"})
    FunPtr Gtk.Callbacks.C_Callback ->      -- callback : TInterface (Name {namespace = "Gtk", name = "Callback"})
    Ptr () ->                               -- callback_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- callback_data_destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | /No description available in the introspection data./
shortcutControllerAddCommandCallback ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutController a) =>
    a
    -> T.Text
    -> T.Text
    -> [Dazzle.Flags.ShortcutPhase]
    -> Gtk.Callbacks.Callback
    -> m ()
shortcutControllerAddCommandCallback :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutController a) =>
a -> Text -> Text -> [ShortcutPhase] -> Callback -> m ()
shortcutControllerAddCommandCallback a
self Text
commandId Text
defaultAccel [ShortcutPhase]
phase Callback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutController
self' <- a -> IO (Ptr ShortcutController)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
commandId' <- Text -> IO CString
textToCString Text
commandId
    CString
defaultAccel' <- Text -> IO CString
textToCString Text
defaultAccel
    let phase' :: CUInt
phase' = [ShortcutPhase] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ShortcutPhase]
phase
    FunPtr C_Callback
callback' <- C_Callback -> IO (FunPtr C_Callback)
Gtk.Callbacks.mk_Callback (Maybe (Ptr (FunPtr C_Callback))
-> Callback_WithClosures -> C_Callback
Gtk.Callbacks.wrap_Callback Maybe (Ptr (FunPtr C_Callback))
forall a. Maybe a
Nothing (Callback -> Callback_WithClosures
Gtk.Callbacks.drop_closures_Callback Callback
callback))
    let callbackData :: Ptr ()
callbackData = FunPtr C_Callback -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_Callback
callback'
    let callbackDataDestroy :: FunPtr (Ptr a -> IO ())
callbackDataDestroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr ShortcutController
-> CString
-> CString
-> CUInt
-> FunPtr C_Callback
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
dzl_shortcut_controller_add_command_callback Ptr ShortcutController
self' CString
commandId' CString
defaultAccel' CUInt
phase' FunPtr C_Callback
callback' Ptr ()
callbackData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
callbackDataDestroy
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commandId'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
defaultAccel'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutControllerAddCommandCallbackMethodInfo
instance (signature ~ (T.Text -> T.Text -> [Dazzle.Flags.ShortcutPhase] -> Gtk.Callbacks.Callback -> m ()), MonadIO m, IsShortcutController a) => O.OverloadedMethod ShortcutControllerAddCommandCallbackMethodInfo a signature where
    overloadedMethod = shortcutControllerAddCommandCallback

instance O.OverloadedMethodInfo ShortcutControllerAddCommandCallbackMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController.shortcutControllerAddCommandCallback",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#v:shortcutControllerAddCommandCallback"
        })


#endif

-- method ShortcutController::execute_command
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutController" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutController"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "command"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the id of the command"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_controller_execute_command" dzl_shortcut_controller_execute_command :: 
    Ptr ShortcutController ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutController"})
    CString ->                              -- command : TBasicType TUTF8
    IO CInt

-- | This method will locate and execute the command matching the id /@command@/.
-- 
-- If the command is not found, 'P.False' is returned.
shortcutControllerExecuteCommand ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutController a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutController.ShortcutController'
    -> T.Text
    -- ^ /@command@/: the id of the command
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the command was found and executed.
shortcutControllerExecuteCommand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutController a) =>
a -> Text -> m Bool
shortcutControllerExecuteCommand a
self Text
command = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutController
self' <- a -> IO (Ptr ShortcutController)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
command' <- Text -> IO CString
textToCString Text
command
    CInt
result <- Ptr ShortcutController -> CString -> IO CInt
dzl_shortcut_controller_execute_command Ptr ShortcutController
self' CString
command'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
command'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutControllerExecuteCommandMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsShortcutController a) => O.OverloadedMethod ShortcutControllerExecuteCommandMethodInfo a signature where
    overloadedMethod = shortcutControllerExecuteCommand

instance O.OverloadedMethodInfo ShortcutControllerExecuteCommandMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController.shortcutControllerExecuteCommand",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#v:shortcutControllerExecuteCommand"
        })


#endif

-- method ShortcutController::get_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutController" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #DzlShortcutController"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Dazzle" , name = "ShortcutContext" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_controller_get_context" dzl_shortcut_controller_get_context :: 
    Ptr ShortcutController ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutController"})
    IO (Ptr Dazzle.ShortcutContext.ShortcutContext)

-- | This function gets the [ShortcutController:context]("GI.Dazzle.Objects.ShortcutController#g:attr:context") property, which
-- is the current context to dispatch events to. An t'GI.Dazzle.Objects.ShortcutContext.ShortcutContext'
-- is a group of keybindings that may be activated in response to a
-- single or series of t'GI.Gdk.Structs.EventKey.EventKey'.
-- 
-- /Since: 3.26/
shortcutControllerGetContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutController a) =>
    a
    -- ^ /@self@/: An t'GI.Dazzle.Objects.ShortcutController.ShortcutController'
    -> m (Maybe Dazzle.ShortcutContext.ShortcutContext)
    -- ^ __Returns:__ A t'GI.Dazzle.Objects.ShortcutContext.ShortcutContext' or 'P.Nothing'.
shortcutControllerGetContext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutController a) =>
a -> m (Maybe ShortcutContext)
shortcutControllerGetContext a
self = IO (Maybe ShortcutContext) -> m (Maybe ShortcutContext)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ShortcutContext) -> m (Maybe ShortcutContext))
-> IO (Maybe ShortcutContext) -> m (Maybe ShortcutContext)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutController
self' <- a -> IO (Ptr ShortcutController)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ShortcutContext
result <- Ptr ShortcutController -> IO (Ptr ShortcutContext)
dzl_shortcut_controller_get_context Ptr ShortcutController
self'
    Maybe ShortcutContext
maybeResult <- Ptr ShortcutContext
-> (Ptr ShortcutContext -> IO ShortcutContext)
-> IO (Maybe ShortcutContext)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ShortcutContext
result ((Ptr ShortcutContext -> IO ShortcutContext)
 -> IO (Maybe ShortcutContext))
-> (Ptr ShortcutContext -> IO ShortcutContext)
-> IO (Maybe ShortcutContext)
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutContext
result' -> do
        ShortcutContext
result'' <- ((ManagedPtr ShortcutContext -> ShortcutContext)
-> Ptr ShortcutContext -> IO ShortcutContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ShortcutContext -> ShortcutContext
Dazzle.ShortcutContext.ShortcutContext) Ptr ShortcutContext
result'
        ShortcutContext -> IO ShortcutContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutContext
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe ShortcutContext -> IO (Maybe ShortcutContext)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ShortcutContext
maybeResult

#if defined(ENABLE_OVERLOADING)
data ShortcutControllerGetContextMethodInfo
instance (signature ~ (m (Maybe Dazzle.ShortcutContext.ShortcutContext)), MonadIO m, IsShortcutController a) => O.OverloadedMethod ShortcutControllerGetContextMethodInfo a signature where
    overloadedMethod = shortcutControllerGetContext

instance O.OverloadedMethodInfo ShortcutControllerGetContextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController.shortcutControllerGetContext",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#v:shortcutControllerGetContext"
        })


#endif

-- method ShortcutController::get_context_for_phase
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutController" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutController"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "phase"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutPhase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the phase for the shorcut delivery"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Dazzle" , name = "ShortcutContext" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_controller_get_context_for_phase" dzl_shortcut_controller_get_context_for_phase :: 
    Ptr ShortcutController ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutController"})
    CUInt ->                                -- phase : TInterface (Name {namespace = "Dazzle", name = "ShortcutPhase"})
    IO (Ptr Dazzle.ShortcutContext.ShortcutContext)

-- | Controllers can have a different context for a particular phase, which allows
-- them to activate different keybindings depending if the event in capture,
-- bubble, or dispatch.
-- 
-- /Since: 3.26/
shortcutControllerGetContextForPhase ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutController a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutController.ShortcutController'
    -> [Dazzle.Flags.ShortcutPhase]
    -- ^ /@phase@/: the phase for the shorcut delivery
    -> m (Maybe Dazzle.ShortcutContext.ShortcutContext)
    -- ^ __Returns:__ A t'GI.Dazzle.Objects.ShortcutContext.ShortcutContext' or 'P.Nothing'.
shortcutControllerGetContextForPhase :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutController a) =>
a -> [ShortcutPhase] -> m (Maybe ShortcutContext)
shortcutControllerGetContextForPhase a
self [ShortcutPhase]
phase = IO (Maybe ShortcutContext) -> m (Maybe ShortcutContext)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ShortcutContext) -> m (Maybe ShortcutContext))
-> IO (Maybe ShortcutContext) -> m (Maybe ShortcutContext)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutController
self' <- a -> IO (Ptr ShortcutController)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let phase' :: CUInt
phase' = [ShortcutPhase] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ShortcutPhase]
phase
    Ptr ShortcutContext
result <- Ptr ShortcutController -> CUInt -> IO (Ptr ShortcutContext)
dzl_shortcut_controller_get_context_for_phase Ptr ShortcutController
self' CUInt
phase'
    Maybe ShortcutContext
maybeResult <- Ptr ShortcutContext
-> (Ptr ShortcutContext -> IO ShortcutContext)
-> IO (Maybe ShortcutContext)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ShortcutContext
result ((Ptr ShortcutContext -> IO ShortcutContext)
 -> IO (Maybe ShortcutContext))
-> (Ptr ShortcutContext -> IO ShortcutContext)
-> IO (Maybe ShortcutContext)
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutContext
result' -> do
        ShortcutContext
result'' <- ((ManagedPtr ShortcutContext -> ShortcutContext)
-> Ptr ShortcutContext -> IO ShortcutContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ShortcutContext -> ShortcutContext
Dazzle.ShortcutContext.ShortcutContext) Ptr ShortcutContext
result'
        ShortcutContext -> IO ShortcutContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutContext
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe ShortcutContext -> IO (Maybe ShortcutContext)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ShortcutContext
maybeResult

#if defined(ENABLE_OVERLOADING)
data ShortcutControllerGetContextForPhaseMethodInfo
instance (signature ~ ([Dazzle.Flags.ShortcutPhase] -> m (Maybe Dazzle.ShortcutContext.ShortcutContext)), MonadIO m, IsShortcutController a) => O.OverloadedMethod ShortcutControllerGetContextForPhaseMethodInfo a signature where
    overloadedMethod = shortcutControllerGetContextForPhase

instance O.OverloadedMethodInfo ShortcutControllerGetContextForPhaseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController.shortcutControllerGetContextForPhase",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#v:shortcutControllerGetContextForPhase"
        })


#endif

-- method ShortcutController::get_current_chord
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutController" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutController"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Dazzle" , name = "ShortcutChord" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_controller_get_current_chord" dzl_shortcut_controller_get_current_chord :: 
    Ptr ShortcutController ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutController"})
    IO (Ptr Dazzle.ShortcutChord.ShortcutChord)

-- | This method gets the [ShortcutController:currentChord]("GI.Dazzle.Objects.ShortcutController#g:attr:currentChord") property.
-- This is useful if you want to monitor in-progress chord building.
-- 
-- Note that this value will only be valid on the controller for the
-- toplevel widget (a t'GI.Gtk.Objects.Window.Window'). Chords are not tracked at the
-- individual widget controller level.
shortcutControllerGetCurrentChord ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutController a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutController.ShortcutController'
    -> m (Maybe Dazzle.ShortcutChord.ShortcutChord)
    -- ^ __Returns:__ A t'GI.Dazzle.Structs.ShortcutChord.ShortcutChord' or 'P.Nothing'.
shortcutControllerGetCurrentChord :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutController a) =>
a -> m (Maybe ShortcutChord)
shortcutControllerGetCurrentChord a
self = IO (Maybe ShortcutChord) -> m (Maybe ShortcutChord)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ShortcutChord) -> m (Maybe ShortcutChord))
-> IO (Maybe ShortcutChord) -> m (Maybe ShortcutChord)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutController
self' <- a -> IO (Ptr ShortcutController)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ShortcutChord
result <- Ptr ShortcutController -> IO (Ptr ShortcutChord)
dzl_shortcut_controller_get_current_chord Ptr ShortcutController
self'
    Maybe ShortcutChord
maybeResult <- Ptr ShortcutChord
-> (Ptr ShortcutChord -> IO ShortcutChord)
-> IO (Maybe ShortcutChord)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ShortcutChord
result ((Ptr ShortcutChord -> IO ShortcutChord)
 -> IO (Maybe ShortcutChord))
-> (Ptr ShortcutChord -> IO ShortcutChord)
-> IO (Maybe ShortcutChord)
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutChord
result' -> do
        ShortcutChord
result'' <- ((ManagedPtr ShortcutChord -> ShortcutChord)
-> Ptr ShortcutChord -> IO ShortcutChord
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr ShortcutChord -> ShortcutChord
Dazzle.ShortcutChord.ShortcutChord) Ptr ShortcutChord
result'
        ShortcutChord -> IO ShortcutChord
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutChord
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe ShortcutChord -> IO (Maybe ShortcutChord)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ShortcutChord
maybeResult

#if defined(ENABLE_OVERLOADING)
data ShortcutControllerGetCurrentChordMethodInfo
instance (signature ~ (m (Maybe Dazzle.ShortcutChord.ShortcutChord)), MonadIO m, IsShortcutController a) => O.OverloadedMethod ShortcutControllerGetCurrentChordMethodInfo a signature where
    overloadedMethod = shortcutControllerGetCurrentChord

instance O.OverloadedMethodInfo ShortcutControllerGetCurrentChordMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController.shortcutControllerGetCurrentChord",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#v:shortcutControllerGetCurrentChord"
        })


#endif

-- method ShortcutController::get_manager
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutController" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutController"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Dazzle" , name = "ShortcutManager" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_controller_get_manager" dzl_shortcut_controller_get_manager :: 
    Ptr ShortcutController ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutController"})
    IO (Ptr Dazzle.ShortcutManager.ShortcutManager)

-- | Gets the t'GI.Dazzle.Objects.ShortcutManager.ShortcutManager' associated with this controller.
-- 
-- Generally, this will look for the root controller\'s manager as mixing and
-- matching managers in a single window hierarchy is not supported.
shortcutControllerGetManager ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutController a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutController.ShortcutController'
    -> m Dazzle.ShortcutManager.ShortcutManager
    -- ^ __Returns:__ A t'GI.Dazzle.Objects.ShortcutManager.ShortcutManager'.
shortcutControllerGetManager :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutController a) =>
a -> m ShortcutManager
shortcutControllerGetManager a
self = IO ShortcutManager -> m ShortcutManager
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutManager -> m ShortcutManager)
-> IO ShortcutManager -> m ShortcutManager
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutController
self' <- a -> IO (Ptr ShortcutController)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ShortcutManager
result <- Ptr ShortcutController -> IO (Ptr ShortcutManager)
dzl_shortcut_controller_get_manager Ptr ShortcutController
self'
    Text -> Ptr ShortcutManager -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutControllerGetManager" Ptr ShortcutManager
result
    ShortcutManager
result' <- ((ManagedPtr ShortcutManager -> ShortcutManager)
-> Ptr ShortcutManager -> IO ShortcutManager
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ShortcutManager -> ShortcutManager
Dazzle.ShortcutManager.ShortcutManager) Ptr ShortcutManager
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    ShortcutManager -> IO ShortcutManager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutManager
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutControllerGetManagerMethodInfo
instance (signature ~ (m Dazzle.ShortcutManager.ShortcutManager), MonadIO m, IsShortcutController a) => O.OverloadedMethod ShortcutControllerGetManagerMethodInfo a signature where
    overloadedMethod = shortcutControllerGetManager

instance O.OverloadedMethodInfo ShortcutControllerGetManagerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController.shortcutControllerGetManager",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#v:shortcutControllerGetManager"
        })


#endif

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

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

-- | /No description available in the introspection data./
-- 
-- /Since: 3.34/
shortcutControllerGetWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutController a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutController.ShortcutController'
    -> m Gtk.Widget.Widget
    -- ^ __Returns:__ the widget for the controller
shortcutControllerGetWidget :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutController a) =>
a -> m Widget
shortcutControllerGetWidget a
self = IO Widget -> m Widget
forall a. IO a -> m a
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 ShortcutController
self' <- a -> IO (Ptr ShortcutController)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
result <- Ptr ShortcutController -> IO (Ptr Widget)
dzl_shortcut_controller_get_widget Ptr ShortcutController
self'
    Text -> Ptr Widget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutControllerGetWidget" 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
self
    Widget -> IO Widget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutControllerGetWidgetMethodInfo
instance (signature ~ (m Gtk.Widget.Widget), MonadIO m, IsShortcutController a) => O.OverloadedMethod ShortcutControllerGetWidgetMethodInfo a signature where
    overloadedMethod = shortcutControllerGetWidget

instance O.OverloadedMethodInfo ShortcutControllerGetWidgetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController.shortcutControllerGetWidget",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#v:shortcutControllerGetWidget"
        })


#endif

-- method ShortcutController::remove_accel
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutController" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accel"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "phase"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutPhase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_controller_remove_accel" dzl_shortcut_controller_remove_accel :: 
    Ptr ShortcutController ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutController"})
    CString ->                              -- accel : TBasicType TUTF8
    CUInt ->                                -- phase : TInterface (Name {namespace = "Dazzle", name = "ShortcutPhase"})
    IO ()

-- | /No description available in the introspection data./
shortcutControllerRemoveAccel ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutController a) =>
    a
    -> T.Text
    -> [Dazzle.Flags.ShortcutPhase]
    -> m ()
shortcutControllerRemoveAccel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutController a) =>
a -> Text -> [ShortcutPhase] -> m ()
shortcutControllerRemoveAccel a
self Text
accel [ShortcutPhase]
phase = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutController
self' <- a -> IO (Ptr ShortcutController)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
accel' <- Text -> IO CString
textToCString Text
accel
    let phase' :: CUInt
phase' = [ShortcutPhase] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ShortcutPhase]
phase
    Ptr ShortcutController -> CString -> CUInt -> IO ()
dzl_shortcut_controller_remove_accel Ptr ShortcutController
self' CString
accel' CUInt
phase'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
accel'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutControllerRemoveAccelMethodInfo
instance (signature ~ (T.Text -> [Dazzle.Flags.ShortcutPhase] -> m ()), MonadIO m, IsShortcutController a) => O.OverloadedMethod ShortcutControllerRemoveAccelMethodInfo a signature where
    overloadedMethod = shortcutControllerRemoveAccel

instance O.OverloadedMethodInfo ShortcutControllerRemoveAccelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController.shortcutControllerRemoveAccel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#v:shortcutControllerRemoveAccel"
        })


#endif

-- method ShortcutController::set_context_by_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutController" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutController"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The name of the context"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_controller_set_context_by_name" dzl_shortcut_controller_set_context_by_name :: 
    Ptr ShortcutController ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutController"})
    CString ->                              -- name : TBasicType TUTF8
    IO ()

-- | Changes the context for the controller to the context matching /@name@/.
-- 
-- Contexts are resolved at runtime through the current theme (and possibly
-- a parent theme if it inherits from one).
-- 
-- /Since: 3.26/
shortcutControllerSetContextByName ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutController a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutController.ShortcutController'
    -> Maybe (T.Text)
    -- ^ /@name@/: The name of the context
    -> m ()
shortcutControllerSetContextByName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutController a) =>
a -> Maybe Text -> m ()
shortcutControllerSetContextByName a
self Maybe Text
name = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutController
self' <- a -> IO (Ptr ShortcutController)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jName -> do
            CString
jName' <- Text -> IO CString
textToCString Text
jName
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jName'
    Ptr ShortcutController -> CString -> IO ()
dzl_shortcut_controller_set_context_by_name Ptr ShortcutController
self' CString
maybeName
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeName
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutControllerSetContextByNameMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsShortcutController a) => O.OverloadedMethod ShortcutControllerSetContextByNameMethodInfo a signature where
    overloadedMethod = shortcutControllerSetContextByName

instance O.OverloadedMethodInfo ShortcutControllerSetContextByNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController.shortcutControllerSetContextByName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#v:shortcutControllerSetContextByName"
        })


#endif

-- method ShortcutController::set_manager
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutController" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutController"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlShortcutManager or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_controller_set_manager" dzl_shortcut_controller_set_manager :: 
    Ptr ShortcutController ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutController"})
    Ptr Dazzle.ShortcutManager.ShortcutManager -> -- manager : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    IO ()

-- | Sets the [ShortcutController:manager]("GI.Dazzle.Objects.ShortcutController#g:attr:manager") property.
-- 
-- If you set this to 'P.Nothing', it will revert to the default t'GI.Dazzle.Objects.ShortcutManager.ShortcutManager'
-- for the process.
shortcutControllerSetManager ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutController a, Dazzle.ShortcutManager.IsShortcutManager b) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutController.ShortcutController'
    -> Maybe (b)
    -- ^ /@manager@/: A t'GI.Dazzle.Objects.ShortcutManager.ShortcutManager' or 'P.Nothing'
    -> m ()
shortcutControllerSetManager :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutController a,
 IsShortcutManager b) =>
a -> Maybe b -> m ()
shortcutControllerSetManager a
self Maybe b
manager = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutController
self' <- a -> IO (Ptr ShortcutController)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ShortcutManager
maybeManager <- case Maybe b
manager of
        Maybe b
Nothing -> Ptr ShortcutManager -> IO (Ptr ShortcutManager)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ShortcutManager
forall a. Ptr a
nullPtr
        Just b
jManager -> do
            Ptr ShortcutManager
jManager' <- b -> IO (Ptr ShortcutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jManager
            Ptr ShortcutManager -> IO (Ptr ShortcutManager)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ShortcutManager
jManager'
    Ptr ShortcutController -> Ptr ShortcutManager -> IO ()
dzl_shortcut_controller_set_manager Ptr ShortcutController
self' Ptr ShortcutManager
maybeManager
    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
manager b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutControllerSetManagerMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsShortcutController a, Dazzle.ShortcutManager.IsShortcutManager b) => O.OverloadedMethod ShortcutControllerSetManagerMethodInfo a signature where
    overloadedMethod = shortcutControllerSetManager

instance O.OverloadedMethodInfo ShortcutControllerSetManagerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutController.shortcutControllerSetManager",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutController.html#v:shortcutControllerSetManager"
        })


#endif

-- method ShortcutController::find
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Dazzle" , name = "ShortcutController" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_controller_find" dzl_shortcut_controller_find :: 
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO (Ptr ShortcutController)

-- | Finds the registered t'GI.Dazzle.Objects.ShortcutController.ShortcutController' for a widget.
-- 
-- The controller is created if it does not already exist.
shortcutControllerFind ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.Widget.IsWidget a) =>
    a
    -> m ShortcutController
    -- ^ __Returns:__ An t'GI.Dazzle.Objects.ShortcutController.ShortcutController' or 'P.Nothing'.
shortcutControllerFind :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ShortcutController
shortcutControllerFind a
widget = IO ShortcutController -> m ShortcutController
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutController -> m ShortcutController)
-> IO ShortcutController -> m ShortcutController
forall a b. (a -> b) -> a -> b
$ do
    Ptr Widget
widget' <- a -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
widget
    Ptr ShortcutController
result <- Ptr Widget -> IO (Ptr ShortcutController)
dzl_shortcut_controller_find Ptr Widget
widget'
    Text -> Ptr ShortcutController -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutControllerFind" Ptr ShortcutController
result
    ShortcutController
result' <- ((ManagedPtr ShortcutController -> ShortcutController)
-> Ptr ShortcutController -> IO ShortcutController
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ShortcutController -> ShortcutController
ShortcutController) Ptr ShortcutController
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
widget
    ShortcutController -> IO ShortcutController
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutController
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ShortcutController::try_find
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Dazzle" , name = "ShortcutController" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_controller_try_find" dzl_shortcut_controller_try_find :: 
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO (Ptr ShortcutController)

-- | Finds the registered t'GI.Dazzle.Objects.ShortcutController.ShortcutController' for a widget.
-- 
-- If no controller is found, 'P.Nothing' is returned.
shortcutControllerTryFind ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.Widget.IsWidget a) =>
    a
    -> m (Maybe ShortcutController)
    -- ^ __Returns:__ An t'GI.Dazzle.Objects.ShortcutController.ShortcutController' or 'P.Nothing'.
shortcutControllerTryFind :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m (Maybe ShortcutController)
shortcutControllerTryFind a
widget = IO (Maybe ShortcutController) -> m (Maybe ShortcutController)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ShortcutController) -> m (Maybe ShortcutController))
-> IO (Maybe ShortcutController) -> m (Maybe ShortcutController)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Widget
widget' <- a -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
widget
    Ptr ShortcutController
result <- Ptr Widget -> IO (Ptr ShortcutController)
dzl_shortcut_controller_try_find Ptr Widget
widget'
    Maybe ShortcutController
maybeResult <- Ptr ShortcutController
-> (Ptr ShortcutController -> IO ShortcutController)
-> IO (Maybe ShortcutController)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ShortcutController
result ((Ptr ShortcutController -> IO ShortcutController)
 -> IO (Maybe ShortcutController))
-> (Ptr ShortcutController -> IO ShortcutController)
-> IO (Maybe ShortcutController)
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutController
result' -> do
        ShortcutController
result'' <- ((ManagedPtr ShortcutController -> ShortcutController)
-> Ptr ShortcutController -> IO ShortcutController
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ShortcutController -> ShortcutController
ShortcutController) Ptr ShortcutController
result'
        ShortcutController -> IO ShortcutController
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutController
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
widget
    Maybe ShortcutController -> IO (Maybe ShortcutController)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ShortcutController
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif