{-# LANGUAGE 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.ShortcutContext
    ( 

-- * Exported types
    ShortcutContext(..)                     ,
    IsShortcutContext                       ,
    toShortcutContext                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [activate]("GI.Dazzle.Objects.ShortcutContext#g:method:activate"), [addAction]("GI.Dazzle.Objects.ShortcutContext#g:method:addAction"), [addCommand]("GI.Dazzle.Objects.ShortcutContext#g:method:addCommand"), [addSignalv]("GI.Dazzle.Objects.ShortcutContext#g:method:addSignalv"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [loadFromData]("GI.Dazzle.Objects.ShortcutContext#g:method:loadFromData"), [loadFromResource]("GI.Dazzle.Objects.ShortcutContext#g:method:loadFromResource"), [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"), [remove]("GI.Dazzle.Objects.ShortcutContext#g:method:remove"), [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
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getName]("GI.Dazzle.Objects.ShortcutContext#g:method:getName"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveShortcutContextMethod            ,
#endif

-- ** activate #method:activate#

#if defined(ENABLE_OVERLOADING)
    ShortcutContextActivateMethodInfo       ,
#endif
    shortcutContextActivate                 ,


-- ** addAction #method:addAction#

#if defined(ENABLE_OVERLOADING)
    ShortcutContextAddActionMethodInfo      ,
#endif
    shortcutContextAddAction                ,


-- ** addCommand #method:addCommand#

#if defined(ENABLE_OVERLOADING)
    ShortcutContextAddCommandMethodInfo     ,
#endif
    shortcutContextAddCommand               ,


-- ** addSignalv #method:addSignalv#

#if defined(ENABLE_OVERLOADING)
    ShortcutContextAddSignalvMethodInfo     ,
#endif
    shortcutContextAddSignalv               ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    ShortcutContextGetNameMethodInfo        ,
#endif
    shortcutContextGetName                  ,


-- ** loadFromData #method:loadFromData#

#if defined(ENABLE_OVERLOADING)
    ShortcutContextLoadFromDataMethodInfo   ,
#endif
    shortcutContextLoadFromData             ,


-- ** loadFromResource #method:loadFromResource#

#if defined(ENABLE_OVERLOADING)
    ShortcutContextLoadFromResourceMethodInfo,
#endif
    shortcutContextLoadFromResource         ,


-- ** new #method:new#

    shortcutContextNew                      ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    ShortcutContextRemoveMethodInfo         ,
#endif
    shortcutContextRemove                   ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    ShortcutContextNamePropertyInfo         ,
#endif
    constructShortcutContextName            ,
    getShortcutContextName                  ,
#if defined(ENABLE_OVERLOADING)
    shortcutContextName                     ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    ShortcutContextUseBindingSetsPropertyInfo,
#endif
    constructShortcutContextUseBindingSets  ,
    getShortcutContextUseBindingSets        ,
    setShortcutContextUseBindingSets        ,
#if defined(ENABLE_OVERLOADING)
    shortcutContextUseBindingSets           ,
#endif




    ) 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 {-# SOURCE #-} qualified GI.Dazzle.Enums as Dazzle.Enums
import {-# SOURCE #-} qualified GI.Dazzle.Structs.ShortcutChord as Dazzle.ShortcutChord
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.Gtk.Objects.Widget as Gtk.Widget

#else
import {-# SOURCE #-} qualified GI.Dazzle.Enums as Dazzle.Enums
import {-# SOURCE #-} qualified GI.Dazzle.Structs.ShortcutChord as Dazzle.ShortcutChord
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#endif

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

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

foreign import ccall "dzl_shortcut_context_get_type"
    c_dzl_shortcut_context_get_type :: IO B.Types.GType

instance B.Types.TypedObject ShortcutContext where
    glibType :: IO GType
glibType = IO GType
c_dzl_shortcut_context_get_type

instance B.Types.GObject ShortcutContext

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveShortcutContextMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveShortcutContextMethod "activate" o = ShortcutContextActivateMethodInfo
    ResolveShortcutContextMethod "addAction" o = ShortcutContextAddActionMethodInfo
    ResolveShortcutContextMethod "addCommand" o = ShortcutContextAddCommandMethodInfo
    ResolveShortcutContextMethod "addSignalv" o = ShortcutContextAddSignalvMethodInfo
    ResolveShortcutContextMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveShortcutContextMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveShortcutContextMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveShortcutContextMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveShortcutContextMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveShortcutContextMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveShortcutContextMethod "loadFromData" o = ShortcutContextLoadFromDataMethodInfo
    ResolveShortcutContextMethod "loadFromResource" o = ShortcutContextLoadFromResourceMethodInfo
    ResolveShortcutContextMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveShortcutContextMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveShortcutContextMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveShortcutContextMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveShortcutContextMethod "remove" o = ShortcutContextRemoveMethodInfo
    ResolveShortcutContextMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveShortcutContextMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveShortcutContextMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveShortcutContextMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveShortcutContextMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveShortcutContextMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveShortcutContextMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveShortcutContextMethod "getName" o = ShortcutContextGetNameMethodInfo
    ResolveShortcutContextMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveShortcutContextMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveShortcutContextMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveShortcutContextMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveShortcutContextMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveShortcutContextMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructShortcutContextName :: (IsShortcutContext o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructShortcutContextName :: forall o (m :: * -> *).
(IsShortcutContext o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructShortcutContextName Text
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 Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data ShortcutContextNamePropertyInfo
instance AttrInfo ShortcutContextNamePropertyInfo where
    type AttrAllowedOps ShortcutContextNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutContextNamePropertyInfo = IsShortcutContext
    type AttrSetTypeConstraint ShortcutContextNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ShortcutContextNamePropertyInfo = (~) T.Text
    type AttrTransferType ShortcutContextNamePropertyInfo = T.Text
    type AttrGetType ShortcutContextNamePropertyInfo = T.Text
    type AttrLabel ShortcutContextNamePropertyInfo = "name"
    type AttrOrigin ShortcutContextNamePropertyInfo = ShortcutContext
    attrGet = getShortcutContextName
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutContextName
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutContext.name"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutContext.html#g:attr:name"
        })
#endif

-- VVV Prop "use-binding-sets"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@use-binding-sets@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shortcutContext #useBindingSets
-- @
getShortcutContextUseBindingSets :: (MonadIO m, IsShortcutContext o) => o -> m Bool
getShortcutContextUseBindingSets :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutContext o) =>
o -> m Bool
getShortcutContextUseBindingSets o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"use-binding-sets"

-- | Set the value of the “@use-binding-sets@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutContext [ #useBindingSets 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutContextUseBindingSets :: (MonadIO m, IsShortcutContext o) => o -> Bool -> m ()
setShortcutContextUseBindingSets :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutContext o) =>
o -> Bool -> m ()
setShortcutContextUseBindingSets o
obj Bool
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 -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"use-binding-sets" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@use-binding-sets@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructShortcutContextUseBindingSets :: (IsShortcutContext o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructShortcutContextUseBindingSets :: forall o (m :: * -> *).
(IsShortcutContext o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructShortcutContextUseBindingSets Bool
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 -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"use-binding-sets" Bool
val

#if defined(ENABLE_OVERLOADING)
data ShortcutContextUseBindingSetsPropertyInfo
instance AttrInfo ShortcutContextUseBindingSetsPropertyInfo where
    type AttrAllowedOps ShortcutContextUseBindingSetsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ShortcutContextUseBindingSetsPropertyInfo = IsShortcutContext
    type AttrSetTypeConstraint ShortcutContextUseBindingSetsPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ShortcutContextUseBindingSetsPropertyInfo = (~) Bool
    type AttrTransferType ShortcutContextUseBindingSetsPropertyInfo = Bool
    type AttrGetType ShortcutContextUseBindingSetsPropertyInfo = Bool
    type AttrLabel ShortcutContextUseBindingSetsPropertyInfo = "use-binding-sets"
    type AttrOrigin ShortcutContextUseBindingSetsPropertyInfo = ShortcutContext
    attrGet = getShortcutContextUseBindingSets
    attrSet = setShortcutContextUseBindingSets
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutContextUseBindingSets
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutContext.useBindingSets"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutContext.html#g:attr:useBindingSets"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ShortcutContext
type instance O.AttributeList ShortcutContext = ShortcutContextAttributeList
type ShortcutContextAttributeList = ('[ '("name", ShortcutContextNamePropertyInfo), '("useBindingSets", ShortcutContextUseBindingSetsPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
shortcutContextName :: AttrLabelProxy "name"
shortcutContextName = AttrLabelProxy

shortcutContextUseBindingSets :: AttrLabelProxy "useBindingSets"
shortcutContextUseBindingSets = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ShortcutContext = ShortcutContextSignalList
type ShortcutContextSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method ShortcutContext::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , 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: Just
--               (TInterface
--                  Name { namespace = "Dazzle" , name = "ShortcutContext" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_context_new" dzl_shortcut_context_new :: 
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr ShortcutContext)

-- | /No description available in the introspection data./
shortcutContextNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -> m ShortcutContext
shortcutContextNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m ShortcutContext
shortcutContextNew Text
name = IO ShortcutContext -> m ShortcutContext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutContext -> m ShortcutContext)
-> IO ShortcutContext -> m ShortcutContext
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr ShortcutContext
result <- CString -> IO (Ptr ShortcutContext)
dzl_shortcut_context_new CString
name'
    Text -> Ptr ShortcutContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutContextNew" Ptr ShortcutContext
result
    ShortcutContext
result' <- ((ManagedPtr ShortcutContext -> ShortcutContext)
-> Ptr ShortcutContext -> IO ShortcutContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ShortcutContext -> ShortcutContext
ShortcutContext) Ptr ShortcutContext
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    ShortcutContext -> IO ShortcutContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutContext
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ShortcutContext::activate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , 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
--           }
--       , Arg
--           { argCName = "chord"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutChord" }
--           , 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 = "ShortcutMatch" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_context_activate" dzl_shortcut_context_activate :: 
    Ptr ShortcutContext ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutContext"})
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    Ptr Dazzle.ShortcutChord.ShortcutChord -> -- chord : TInterface (Name {namespace = "Dazzle", name = "ShortcutChord"})
    IO CUInt

-- | /No description available in the introspection data./
shortcutContextActivate ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutContext a, Gtk.Widget.IsWidget b) =>
    a
    -> b
    -> Dazzle.ShortcutChord.ShortcutChord
    -> m Dazzle.Enums.ShortcutMatch
shortcutContextActivate :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutContext a, IsWidget b) =>
a -> b -> ShortcutChord -> m ShortcutMatch
shortcutContextActivate a
self b
widget ShortcutChord
chord = IO ShortcutMatch -> m ShortcutMatch
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutMatch -> m ShortcutMatch)
-> IO ShortcutMatch -> m ShortcutMatch
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutContext
self' <- a -> IO (Ptr ShortcutContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
widget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
widget
    Ptr ShortcutChord
chord' <- ShortcutChord -> IO (Ptr ShortcutChord)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChord
chord
    CUInt
result <- Ptr ShortcutContext -> Ptr Widget -> Ptr ShortcutChord -> IO CUInt
dzl_shortcut_context_activate Ptr ShortcutContext
self' Ptr Widget
widget' Ptr ShortcutChord
chord'
    let result' :: ShortcutMatch
result' = (Int -> ShortcutMatch
forall a. Enum a => Int -> a
toEnum (Int -> ShortcutMatch) -> (CUInt -> Int) -> CUInt -> ShortcutMatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
widget
    ShortcutChord -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChord
chord
    ShortcutMatch -> IO ShortcutMatch
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutMatch
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutContextActivateMethodInfo
instance (signature ~ (b -> Dazzle.ShortcutChord.ShortcutChord -> m Dazzle.Enums.ShortcutMatch), MonadIO m, IsShortcutContext a, Gtk.Widget.IsWidget b) => O.OverloadedMethod ShortcutContextActivateMethodInfo a signature where
    overloadedMethod = shortcutContextActivate

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


#endif

-- method ShortcutContext::add_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutContext" }
--           , 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 = "detailed_action_name"
--           , 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_context_add_action" dzl_shortcut_context_add_action :: 
    Ptr ShortcutContext ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutContext"})
    CString ->                              -- accel : TBasicType TUTF8
    CString ->                              -- detailed_action_name : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
shortcutContextAddAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutContext a) =>
    a
    -> T.Text
    -> T.Text
    -> m ()
shortcutContextAddAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutContext a) =>
a -> Text -> Text -> m ()
shortcutContextAddAction a
self Text
accel Text
detailedActionName = 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 ShortcutContext
self' <- a -> IO (Ptr ShortcutContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
accel' <- Text -> IO CString
textToCString Text
accel
    CString
detailedActionName' <- Text -> IO CString
textToCString Text
detailedActionName
    Ptr ShortcutContext -> CString -> CString -> IO ()
dzl_shortcut_context_add_action Ptr ShortcutContext
self' CString
accel' CString
detailedActionName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
accel'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
detailedActionName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutContextAddActionMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsShortcutContext a) => O.OverloadedMethod ShortcutContextAddActionMethodInfo a signature where
    overloadedMethod = shortcutContextAddAction

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


#endif

-- method ShortcutContext::add_command
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutContext" }
--           , 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 = "command"
--           , 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_context_add_command" dzl_shortcut_context_add_command :: 
    Ptr ShortcutContext ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutContext"})
    CString ->                              -- accel : TBasicType TUTF8
    CString ->                              -- command : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
shortcutContextAddCommand ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutContext a) =>
    a
    -> T.Text
    -> T.Text
    -> m ()
shortcutContextAddCommand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutContext a) =>
a -> Text -> Text -> m ()
shortcutContextAddCommand a
self Text
accel Text
command = 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 ShortcutContext
self' <- a -> IO (Ptr ShortcutContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
accel' <- Text -> IO CString
textToCString Text
accel
    CString
command' <- Text -> IO CString
textToCString Text
command
    Ptr ShortcutContext -> CString -> CString -> IO ()
dzl_shortcut_context_add_command Ptr ShortcutContext
self' CString
accel' CString
command'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
accel'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
command'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutContextAddCommandMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsShortcutContext a) => O.OverloadedMethod ShortcutContextAddCommandMethodInfo a signature where
    overloadedMethod = shortcutContextAddCommand

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


#endif

-- method ShortcutContext::add_signalv
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutContext"
--                 , 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 = Just "the accelerator for the shortcut"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "signal_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the signal"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "values"
--           , argType = TGArray TGValue
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The\n  values to use when calling the signal."
--                 , 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_context_add_signalv" dzl_shortcut_context_add_signalv :: 
    Ptr ShortcutContext ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutContext"})
    CString ->                              -- accel : TBasicType TUTF8
    CString ->                              -- signal_name : TBasicType TUTF8
    Ptr (GArray (Ptr GValue)) ->            -- values : TGArray TGValue
    IO ()

-- | This is similar to @/dzl_shortcut_context_add_signal()/@ but is easier to use
-- from language bindings.
shortcutContextAddSignalv ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutContext a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutContext.ShortcutContext'
    -> T.Text
    -- ^ /@accel@/: the accelerator for the shortcut
    -> T.Text
    -- ^ /@signalName@/: the name of the signal
    -> Maybe ([GValue])
    -- ^ /@values@/: The
    --   values to use when calling the signal.
    -> m ()
shortcutContextAddSignalv :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutContext a) =>
a -> Text -> Text -> Maybe [GValue] -> m ()
shortcutContextAddSignalv a
self Text
accel Text
signalName Maybe [GValue]
values = 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 ShortcutContext
self' <- a -> IO (Ptr ShortcutContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
accel' <- Text -> IO CString
textToCString Text
accel
    CString
signalName' <- Text -> IO CString
textToCString Text
signalName
    Ptr (GArray (Ptr GValue))
maybeValues <- case Maybe [GValue]
values of
        Maybe [GValue]
Nothing -> Ptr (GArray (Ptr GValue)) -> IO (Ptr (GArray (Ptr GValue)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GArray (Ptr GValue))
forall a. Ptr a
nullPtr
        Just [GValue]
jValues -> do
            [Ptr GValue]
jValues' <- (GValue -> IO (Ptr GValue)) -> [GValue] -> IO [Ptr GValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [GValue]
jValues
            Ptr (GArray (Ptr GValue))
jValues'' <- [Ptr GValue] -> IO (Ptr (GArray (Ptr GValue)))
forall a. Storable a => [a] -> IO (Ptr (GArray a))
packGArray [Ptr GValue]
jValues'
            Ptr (GArray (Ptr GValue)) -> IO (Ptr (GArray (Ptr GValue)))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GArray (Ptr GValue))
jValues''
    Ptr ShortcutContext
-> CString -> CString -> Ptr (GArray (Ptr GValue)) -> IO ()
dzl_shortcut_context_add_signalv Ptr ShortcutContext
self' CString
accel' CString
signalName' Ptr (GArray (Ptr GValue))
maybeValues
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe [GValue] -> ([GValue] -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe [GValue]
values ((GValue -> IO ()) -> [GValue] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr)
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
accel'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
signalName'
    Ptr (GArray (Ptr GValue)) -> IO ()
forall a. Ptr (GArray a) -> IO ()
unrefGArray Ptr (GArray (Ptr GValue))
maybeValues
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutContextAddSignalvMethodInfo
instance (signature ~ (T.Text -> T.Text -> Maybe ([GValue]) -> m ()), MonadIO m, IsShortcutContext a) => O.OverloadedMethod ShortcutContextAddSignalvMethodInfo a signature where
    overloadedMethod = shortcutContextAddSignalv

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


#endif

-- method ShortcutContext::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutContext" }
--           , 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 (TBasicType TUTF8)
-- throws : False
-- Skip return : False

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

-- | /No description available in the introspection data./
shortcutContextGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutContext a) =>
    a
    -> m T.Text
shortcutContextGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutContext a) =>
a -> m Text
shortcutContextGetName a
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutContext
self' <- a -> IO (Ptr ShortcutContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ShortcutContext -> IO CString
dzl_shortcut_context_get_name Ptr ShortcutContext
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutContextGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutContextGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsShortcutContext a) => O.OverloadedMethod ShortcutContextGetNameMethodInfo a signature where
    overloadedMethod = shortcutContextGetName

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


#endif

-- method ShortcutContext::load_from_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , 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 = "len"
--           , argType = TBasicType TSSize
--           , 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 (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "dzl_shortcut_context_load_from_data" dzl_shortcut_context_load_from_data :: 
    Ptr ShortcutContext ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutContext"})
    CString ->                              -- data : TBasicType TUTF8
    DI.Int64 ->                             -- len : TBasicType TSSize
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
shortcutContextLoadFromData ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutContext a) =>
    a
    -> T.Text
    -> DI.Int64
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
shortcutContextLoadFromData :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutContext a) =>
a -> Text -> Int64 -> m ()
shortcutContextLoadFromData a
self Text
data_ Int64
len = 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 ShortcutContext
self' <- a -> IO (Ptr ShortcutContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
data_' <- Text -> IO CString
textToCString Text
data_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ShortcutContext
-> CString -> Int64 -> Ptr (Ptr GError) -> IO CInt
dzl_shortcut_context_load_from_data Ptr ShortcutContext
self' CString
data_' Int64
len
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
data_'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
data_'
     )

#if defined(ENABLE_OVERLOADING)
data ShortcutContextLoadFromDataMethodInfo
instance (signature ~ (T.Text -> DI.Int64 -> m ()), MonadIO m, IsShortcutContext a) => O.OverloadedMethod ShortcutContextLoadFromDataMethodInfo a signature where
    overloadedMethod = shortcutContextLoadFromData

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


#endif

-- method ShortcutContext::load_from_resource
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "resource_path"
--           , 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: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "dzl_shortcut_context_load_from_resource" dzl_shortcut_context_load_from_resource :: 
    Ptr ShortcutContext ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutContext"})
    CString ->                              -- resource_path : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
shortcutContextLoadFromResource ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutContext a) =>
    a
    -> T.Text
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
shortcutContextLoadFromResource :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutContext a) =>
a -> Text -> m ()
shortcutContextLoadFromResource a
self Text
resourcePath = 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 ShortcutContext
self' <- a -> IO (Ptr ShortcutContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
resourcePath' <- Text -> IO CString
textToCString Text
resourcePath
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ShortcutContext -> CString -> Ptr (Ptr GError) -> IO CInt
dzl_shortcut_context_load_from_resource Ptr ShortcutContext
self' CString
resourcePath'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
resourcePath'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
resourcePath'
     )

#if defined(ENABLE_OVERLOADING)
data ShortcutContextLoadFromResourceMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsShortcutContext a) => O.OverloadedMethod ShortcutContextLoadFromResourceMethodInfo a signature where
    overloadedMethod = shortcutContextLoadFromResource

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


#endif

-- method ShortcutContext::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutContext" }
--           , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

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

-- | /No description available in the introspection data./
shortcutContextRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutContext a) =>
    a
    -> T.Text
    -> m Bool
shortcutContextRemove :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutContext a) =>
a -> Text -> m Bool
shortcutContextRemove a
self Text
accel = 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 ShortcutContext
self' <- a -> IO (Ptr ShortcutContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
accel' <- Text -> IO CString
textToCString Text
accel
    CInt
result <- Ptr ShortcutContext -> CString -> IO CInt
dzl_shortcut_context_remove Ptr ShortcutContext
self' CString
accel'
    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
accel'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

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


#endif