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

-- * Exported types
    ShortcutManager(..)                     ,
    IsShortcutManager                       ,
    toShortcutManager                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addAction]("GI.Dazzle.Objects.ShortcutManager#g:method:addAction"), [addCommand]("GI.Dazzle.Objects.ShortcutManager#g:method:addCommand"), [addShortcutEntries]("GI.Dazzle.Objects.ShortcutManager#g:method:addShortcutEntries"), [addShortcutsToWindow]("GI.Dazzle.Objects.ShortcutManager#g:method:addShortcutsToWindow"), [appendSearchPath]("GI.Dazzle.Objects.ShortcutManager#g:method:appendSearchPath"), [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"), [handleEvent]("GI.Dazzle.Objects.ShortcutManager#g:method:handleEvent"), [init]("GI.Gio.Interfaces.Initable#g:method:init"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [itemsChanged]("GI.Gio.Interfaces.ListModel#g:method:itemsChanged"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [prependSearchPath]("GI.Dazzle.Objects.ShortcutManager#g:method:prependSearchPath"), [queueReload]("GI.Dazzle.Objects.ShortcutManager#g:method:queueReload"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [reload]("GI.Dazzle.Objects.ShortcutManager#g:method:reload"), [removeSearchPath]("GI.Dazzle.Objects.ShortcutManager#g:method:removeSearchPath"), [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"), [getItem]("GI.Gio.Interfaces.ListModel#g:method:getItem"), [getItemType]("GI.Gio.Interfaces.ListModel#g:method:getItemType"), [getNItems]("GI.Gio.Interfaces.ListModel#g:method:getNItems"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTheme]("GI.Dazzle.Objects.ShortcutManager#g:method:getTheme"), [getThemeByName]("GI.Dazzle.Objects.ShortcutManager#g:method:getThemeByName"), [getThemeName]("GI.Dazzle.Objects.ShortcutManager#g:method:getThemeName"), [getUserDir]("GI.Dazzle.Objects.ShortcutManager#g:method:getUserDir").
-- 
-- ==== 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"), [setTheme]("GI.Dazzle.Objects.ShortcutManager#g:method:setTheme"), [setThemeName]("GI.Dazzle.Objects.ShortcutManager#g:method:setThemeName"), [setUserDir]("GI.Dazzle.Objects.ShortcutManager#g:method:setUserDir").

#if defined(ENABLE_OVERLOADING)
    ResolveShortcutManagerMethod            ,
#endif

-- ** addAction #method:addAction#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerAddActionMethodInfo      ,
#endif
    shortcutManagerAddAction                ,


-- ** addCommand #method:addCommand#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerAddCommandMethodInfo     ,
#endif
    shortcutManagerAddCommand               ,


-- ** addShortcutEntries #method:addShortcutEntries#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerAddShortcutEntriesMethodInfo,
#endif
    shortcutManagerAddShortcutEntries       ,


-- ** addShortcutsToWindow #method:addShortcutsToWindow#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerAddShortcutsToWindowMethodInfo,
#endif
    shortcutManagerAddShortcutsToWindow     ,


-- ** appendSearchPath #method:appendSearchPath#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerAppendSearchPathMethodInfo,
#endif
    shortcutManagerAppendSearchPath         ,


-- ** getDefault #method:getDefault#

    shortcutManagerGetDefault               ,


-- ** getTheme #method:getTheme#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerGetThemeMethodInfo       ,
#endif
    shortcutManagerGetTheme                 ,


-- ** getThemeByName #method:getThemeByName#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerGetThemeByNameMethodInfo ,
#endif
    shortcutManagerGetThemeByName           ,


-- ** getThemeName #method:getThemeName#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerGetThemeNameMethodInfo   ,
#endif
    shortcutManagerGetThemeName             ,


-- ** getUserDir #method:getUserDir#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerGetUserDirMethodInfo     ,
#endif
    shortcutManagerGetUserDir               ,


-- ** handleEvent #method:handleEvent#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerHandleEventMethodInfo    ,
#endif
    shortcutManagerHandleEvent              ,


-- ** prependSearchPath #method:prependSearchPath#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerPrependSearchPathMethodInfo,
#endif
    shortcutManagerPrependSearchPath        ,


-- ** queueReload #method:queueReload#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerQueueReloadMethodInfo    ,
#endif
    shortcutManagerQueueReload              ,


-- ** reload #method:reload#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerReloadMethodInfo         ,
#endif
    shortcutManagerReload                   ,


-- ** removeSearchPath #method:removeSearchPath#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerRemoveSearchPathMethodInfo,
#endif
    shortcutManagerRemoveSearchPath         ,


-- ** setTheme #method:setTheme#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerSetThemeMethodInfo       ,
#endif
    shortcutManagerSetTheme                 ,


-- ** setThemeName #method:setThemeName#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerSetThemeNameMethodInfo   ,
#endif
    shortcutManagerSetThemeName             ,


-- ** setUserDir #method:setUserDir#

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerSetUserDirMethodInfo     ,
#endif
    shortcutManagerSetUserDir               ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerThemePropertyInfo        ,
#endif
    constructShortcutManagerTheme           ,
    getShortcutManagerTheme                 ,
    setShortcutManagerTheme                 ,
#if defined(ENABLE_OVERLOADING)
    shortcutManagerTheme                    ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerThemeNamePropertyInfo    ,
#endif
    constructShortcutManagerThemeName       ,
    getShortcutManagerThemeName             ,
    setShortcutManagerThemeName             ,
#if defined(ENABLE_OVERLOADING)
    shortcutManagerThemeName                ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    ShortcutManagerUserDirPropertyInfo      ,
#endif
    constructShortcutManagerUserDir         ,
    getShortcutManagerUserDir               ,
    setShortcutManagerUserDir               ,
#if defined(ENABLE_OVERLOADING)
    shortcutManagerUserDir                  ,
#endif




 -- * Signals


-- ** changed #signal:changed#

    ShortcutManagerChangedCallback          ,
#if defined(ENABLE_OVERLOADING)
    ShortcutManagerChangedSignalInfo        ,
#endif
    afterShortcutManagerChanged             ,
    onShortcutManagerChanged                ,




    ) 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.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.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.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.Objects.ShortcutTheme as Dazzle.ShortcutTheme
import {-# SOURCE #-} qualified GI.Dazzle.Objects.ShortcutsWindow as Dazzle.ShortcutsWindow
import {-# SOURCE #-} qualified GI.Dazzle.Structs.ShortcutEntry as Dazzle.ShortcutEntry
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Structs.EventKey as Gdk.EventKey
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.Gtk.Objects.Widget as Gtk.Widget

#endif

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

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

foreign import ccall "dzl_shortcut_manager_get_type"
    c_dzl_shortcut_manager_get_type :: IO B.Types.GType

instance B.Types.TypedObject ShortcutManager where
    glibType :: IO GType
glibType = IO GType
c_dzl_shortcut_manager_get_type

instance B.Types.GObject ShortcutManager

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

instance O.HasParentTypes ShortcutManager
type instance O.ParentTypes ShortcutManager = '[GObject.Object.Object, Gio.Initable.Initable, Gio.ListModel.ListModel]

-- | Cast to `ShortcutManager`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toShortcutManager :: (MIO.MonadIO m, IsShortcutManager o) => o -> m ShortcutManager
toShortcutManager :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutManager o) =>
o -> m ShortcutManager
toShortcutManager = 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)
-> (o -> IO ShortcutManager) -> o -> m ShortcutManager
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr ShortcutManager -> ShortcutManager)
-> o -> IO ShortcutManager
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr ShortcutManager -> ShortcutManager
ShortcutManager

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

#if defined(ENABLE_OVERLOADING)
type family ResolveShortcutManagerMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveShortcutManagerMethod "addAction" o = ShortcutManagerAddActionMethodInfo
    ResolveShortcutManagerMethod "addCommand" o = ShortcutManagerAddCommandMethodInfo
    ResolveShortcutManagerMethod "addShortcutEntries" o = ShortcutManagerAddShortcutEntriesMethodInfo
    ResolveShortcutManagerMethod "addShortcutsToWindow" o = ShortcutManagerAddShortcutsToWindowMethodInfo
    ResolveShortcutManagerMethod "appendSearchPath" o = ShortcutManagerAppendSearchPathMethodInfo
    ResolveShortcutManagerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveShortcutManagerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveShortcutManagerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveShortcutManagerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveShortcutManagerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveShortcutManagerMethod "handleEvent" o = ShortcutManagerHandleEventMethodInfo
    ResolveShortcutManagerMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolveShortcutManagerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveShortcutManagerMethod "itemsChanged" o = Gio.ListModel.ListModelItemsChangedMethodInfo
    ResolveShortcutManagerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveShortcutManagerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveShortcutManagerMethod "prependSearchPath" o = ShortcutManagerPrependSearchPathMethodInfo
    ResolveShortcutManagerMethod "queueReload" o = ShortcutManagerQueueReloadMethodInfo
    ResolveShortcutManagerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveShortcutManagerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveShortcutManagerMethod "reload" o = ShortcutManagerReloadMethodInfo
    ResolveShortcutManagerMethod "removeSearchPath" o = ShortcutManagerRemoveSearchPathMethodInfo
    ResolveShortcutManagerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveShortcutManagerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveShortcutManagerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveShortcutManagerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveShortcutManagerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveShortcutManagerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveShortcutManagerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveShortcutManagerMethod "getItem" o = Gio.ListModel.ListModelGetItemMethodInfo
    ResolveShortcutManagerMethod "getItemType" o = Gio.ListModel.ListModelGetItemTypeMethodInfo
    ResolveShortcutManagerMethod "getNItems" o = Gio.ListModel.ListModelGetNItemsMethodInfo
    ResolveShortcutManagerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveShortcutManagerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveShortcutManagerMethod "getTheme" o = ShortcutManagerGetThemeMethodInfo
    ResolveShortcutManagerMethod "getThemeByName" o = ShortcutManagerGetThemeByNameMethodInfo
    ResolveShortcutManagerMethod "getThemeName" o = ShortcutManagerGetThemeNameMethodInfo
    ResolveShortcutManagerMethod "getUserDir" o = ShortcutManagerGetUserDirMethodInfo
    ResolveShortcutManagerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveShortcutManagerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveShortcutManagerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveShortcutManagerMethod "setTheme" o = ShortcutManagerSetThemeMethodInfo
    ResolveShortcutManagerMethod "setThemeName" o = ShortcutManagerSetThemeNameMethodInfo
    ResolveShortcutManagerMethod "setUserDir" o = ShortcutManagerSetUserDirMethodInfo
    ResolveShortcutManagerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal ShortcutManager::changed
-- | /No description available in the introspection data./
type ShortcutManagerChangedCallback =
    IO ()

type C_ShortcutManagerChangedCallback =
    Ptr ShortcutManager ->                  -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ShortcutManagerChangedCallback :: 
    GObject a => (a -> ShortcutManagerChangedCallback) ->
    C_ShortcutManagerChangedCallback
wrap_ShortcutManagerChangedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_ShortcutManagerChangedCallback
wrap_ShortcutManagerChangedCallback a -> IO ()
gi'cb Ptr ShortcutManager
gi'selfPtr Ptr ()
_ = do
    Ptr ShortcutManager -> (ShortcutManager -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr ShortcutManager
gi'selfPtr ((ShortcutManager -> IO ()) -> IO ())
-> (ShortcutManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ShortcutManager
gi'self -> a -> IO ()
gi'cb (ShortcutManager -> a
forall a b. Coercible a b => a -> b
Coerce.coerce ShortcutManager
gi'self) 


-- | Connect a signal handler for the [changed](#signal:changed) 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' shortcutManager #changed callback
-- @
-- 
-- 
onShortcutManagerChanged :: (IsShortcutManager a, MonadIO m) => a -> ((?self :: a) => ShortcutManagerChangedCallback) -> m SignalHandlerId
onShortcutManagerChanged :: forall a (m :: * -> *).
(IsShortcutManager a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onShortcutManagerChanged 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_ShortcutManagerChangedCallback
wrapped' = (a -> IO ()) -> C_ShortcutManagerChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_ShortcutManagerChangedCallback
wrap_ShortcutManagerChangedCallback a -> IO ()
wrapped
    FunPtr C_ShortcutManagerChangedCallback
wrapped'' <- C_ShortcutManagerChangedCallback
-> IO (FunPtr C_ShortcutManagerChangedCallback)
mk_ShortcutManagerChangedCallback C_ShortcutManagerChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ShortcutManagerChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_ShortcutManagerChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [changed](#signal:changed) 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' shortcutManager #changed 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.
-- 
afterShortcutManagerChanged :: (IsShortcutManager a, MonadIO m) => a -> ((?self :: a) => ShortcutManagerChangedCallback) -> m SignalHandlerId
afterShortcutManagerChanged :: forall a (m :: * -> *).
(IsShortcutManager a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterShortcutManagerChanged 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_ShortcutManagerChangedCallback
wrapped' = (a -> IO ()) -> C_ShortcutManagerChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_ShortcutManagerChangedCallback
wrap_ShortcutManagerChangedCallback a -> IO ()
wrapped
    FunPtr C_ShortcutManagerChangedCallback
wrapped'' <- C_ShortcutManagerChangedCallback
-> IO (FunPtr C_ShortcutManagerChangedCallback)
mk_ShortcutManagerChangedCallback C_ShortcutManagerChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_ShortcutManagerChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_ShortcutManagerChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


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

#endif

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

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

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

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

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

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

-- | Get the value of the “@theme-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shortcutManager #themeName
-- @
getShortcutManagerThemeName :: (MonadIO m, IsShortcutManager o) => o -> m T.Text
getShortcutManagerThemeName :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutManager o) =>
o -> m Text
getShortcutManagerThemeName 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
"getShortcutManagerThemeName" (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
"theme-name"

-- | Set the value of the “@theme-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutManager [ #themeName 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutManagerThemeName :: (MonadIO m, IsShortcutManager o) => o -> T.Text -> m ()
setShortcutManagerThemeName :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutManager o) =>
o -> Text -> m ()
setShortcutManagerThemeName o
obj Text
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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"theme-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

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

-- VVV Prop "user-dir"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@user-dir@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shortcutManager #userDir
-- @
getShortcutManagerUserDir :: (MonadIO m, IsShortcutManager o) => o -> m T.Text
getShortcutManagerUserDir :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutManager o) =>
o -> m Text
getShortcutManagerUserDir 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
"getShortcutManagerUserDir" (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
"user-dir"

-- | Set the value of the “@user-dir@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutManager [ #userDir 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutManagerUserDir :: (MonadIO m, IsShortcutManager o) => o -> T.Text -> m ()
setShortcutManagerUserDir :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutManager o) =>
o -> Text -> m ()
setShortcutManagerUserDir o
obj Text
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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"user-dir" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ShortcutManager
type instance O.AttributeList ShortcutManager = ShortcutManagerAttributeList
type ShortcutManagerAttributeList = ('[ '("theme", ShortcutManagerThemePropertyInfo), '("themeName", ShortcutManagerThemeNamePropertyInfo), '("userDir", ShortcutManagerUserDirPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
shortcutManagerTheme :: AttrLabelProxy "theme"
shortcutManagerTheme = AttrLabelProxy

shortcutManagerThemeName :: AttrLabelProxy "themeName"
shortcutManagerThemeName = AttrLabelProxy

shortcutManagerUserDir :: AttrLabelProxy "userDir"
shortcutManagerUserDir = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ShortcutManager = ShortcutManagerSignalList
type ShortcutManagerSignalList = ('[ '("changed", ShortcutManagerChangedSignalInfo), '("itemsChanged", Gio.ListModel.ListModelItemsChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method ShortcutManager::add_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , 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
--           }
--       , Arg
--           { argCName = "section"
--           , 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 = "group"
--           , 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 = "title"
--           , 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 = "subtitle"
--           , 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_manager_add_action" dzl_shortcut_manager_add_action :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    CString ->                              -- detailed_action_name : TBasicType TUTF8
    CString ->                              -- section : TBasicType TUTF8
    CString ->                              -- group : TBasicType TUTF8
    CString ->                              -- title : TBasicType TUTF8
    CString ->                              -- subtitle : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
shortcutManagerAddAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutManager a) =>
    a
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> m ()
shortcutManagerAddAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutManager a) =>
a -> Text -> Text -> Text -> Text -> Text -> m ()
shortcutManagerAddAction a
self Text
detailedActionName Text
section Text
group Text
title Text
subtitle = 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 ShortcutManager
self' <- a -> IO (Ptr ShortcutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
detailedActionName' <- Text -> IO CString
textToCString Text
detailedActionName
    CString
section' <- Text -> IO CString
textToCString Text
section
    CString
group' <- Text -> IO CString
textToCString Text
group
    CString
title' <- Text -> IO CString
textToCString Text
title
    CString
subtitle' <- Text -> IO CString
textToCString Text
subtitle
    Ptr ShortcutManager
-> CString -> CString -> CString -> CString -> CString -> IO ()
dzl_shortcut_manager_add_action Ptr ShortcutManager
self' CString
detailedActionName' CString
section' CString
group' CString
title' CString
subtitle'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
detailedActionName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
section'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
group'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
subtitle'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method ShortcutManager::add_command
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , 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
--           }
--       , Arg
--           { argCName = "section"
--           , 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 = "group"
--           , 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 = "title"
--           , 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 = "subtitle"
--           , 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_manager_add_command" dzl_shortcut_manager_add_command :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    CString ->                              -- command : TBasicType TUTF8
    CString ->                              -- section : TBasicType TUTF8
    CString ->                              -- group : TBasicType TUTF8
    CString ->                              -- title : TBasicType TUTF8
    CString ->                              -- subtitle : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
shortcutManagerAddCommand ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutManager a) =>
    a
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> m ()
shortcutManagerAddCommand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutManager a) =>
a -> Text -> Text -> Text -> Text -> Text -> m ()
shortcutManagerAddCommand a
self Text
command Text
section Text
group Text
title Text
subtitle = 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 ShortcutManager
self' <- a -> IO (Ptr ShortcutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
command' <- Text -> IO CString
textToCString Text
command
    CString
section' <- Text -> IO CString
textToCString Text
section
    CString
group' <- Text -> IO CString
textToCString Text
group
    CString
title' <- Text -> IO CString
textToCString Text
title
    CString
subtitle' <- Text -> IO CString
textToCString Text
subtitle
    Ptr ShortcutManager
-> CString -> CString -> CString -> CString -> CString -> IO ()
dzl_shortcut_manager_add_command Ptr ShortcutManager
self' CString
command' CString
section' CString
group' CString
title' CString
subtitle'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
command'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
section'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
group'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
subtitle'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method ShortcutManager::add_shortcut_entries
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #DzlShortcutManager or %NULL for the default"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "shortcuts"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Dazzle" , name = "ShortcutEntry" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "shortcuts to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_shortcuts"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of entries in @shortcuts"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "translation_domain"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the gettext domain to use for translations"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_shortcuts"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of entries in @shortcuts"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_manager_add_shortcut_entries" dzl_shortcut_manager_add_shortcut_entries :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    Ptr Dazzle.ShortcutEntry.ShortcutEntry -> -- shortcuts : TCArray False (-1) 2 (TInterface (Name {namespace = "Dazzle", name = "ShortcutEntry"}))
    Word32 ->                               -- n_shortcuts : TBasicType TUInt
    CString ->                              -- translation_domain : TBasicType TUTF8
    IO ()

-- | This method will add /@shortcuts@/ to the t'GI.Dazzle.Objects.ShortcutManager.ShortcutManager'.
-- 
-- This provides a simple way for widgets to add their shortcuts to the manager
-- so that they may be overriden by themes or the end user.
shortcutManagerAddShortcutEntries ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutManager a) =>
    Maybe (a)
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutManager.ShortcutManager' or 'P.Nothing' for the default
    -> [Dazzle.ShortcutEntry.ShortcutEntry]
    -- ^ /@shortcuts@/: shortcuts to add
    -> Maybe (T.Text)
    -- ^ /@translationDomain@/: the gettext domain to use for translations
    -> m ()
shortcutManagerAddShortcutEntries :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutManager a) =>
Maybe a -> [ShortcutEntry] -> Maybe Text -> m ()
shortcutManagerAddShortcutEntries Maybe a
self [ShortcutEntry]
shortcuts Maybe Text
translationDomain = 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
    let nShortcuts :: Word32
nShortcuts = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [ShortcutEntry] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [ShortcutEntry]
shortcuts
    Ptr ShortcutManager
maybeSelf <- case Maybe a
self of
        Maybe a
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 a
jSelf -> do
            Ptr ShortcutManager
jSelf' <- a -> IO (Ptr ShortcutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSelf
            Ptr ShortcutManager -> IO (Ptr ShortcutManager)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ShortcutManager
jSelf'
    [Ptr ShortcutEntry]
shortcuts' <- (ShortcutEntry -> IO (Ptr ShortcutEntry))
-> [ShortcutEntry] -> IO [Ptr ShortcutEntry]
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 ShortcutEntry -> IO (Ptr ShortcutEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [ShortcutEntry]
shortcuts
    Ptr ShortcutEntry
shortcuts'' <- Int -> [Ptr ShortcutEntry] -> IO (Ptr ShortcutEntry)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
56 [Ptr ShortcutEntry]
shortcuts'
    CString
maybeTranslationDomain <- case Maybe Text
translationDomain 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
jTranslationDomain -> do
            CString
jTranslationDomain' <- Text -> IO CString
textToCString Text
jTranslationDomain
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTranslationDomain'
    Ptr ShortcutManager
-> Ptr ShortcutEntry -> Word32 -> CString -> IO ()
dzl_shortcut_manager_add_shortcut_entries Ptr ShortcutManager
maybeSelf Ptr ShortcutEntry
shortcuts'' Word32
nShortcuts CString
maybeTranslationDomain
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
self a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    (ShortcutEntry -> IO ()) -> [ShortcutEntry] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ShortcutEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [ShortcutEntry]
shortcuts
    Ptr ShortcutEntry -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr ShortcutEntry
shortcuts''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTranslationDomain
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutManagerAddShortcutEntriesMethodInfo
instance (signature ~ ([Dazzle.ShortcutEntry.ShortcutEntry] -> Maybe (T.Text) -> m ()), MonadIO m, IsShortcutManager a) => O.OverloadedMethod ShortcutManagerAddShortcutEntriesMethodInfo a signature where
    overloadedMethod i = shortcutManagerAddShortcutEntries (Just i)

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


#endif

-- method ShortcutManager::add_shortcuts_to_window
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlShortcutManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "window"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutsWindow" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlShortcutsWindow"
--                 , 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_manager_add_shortcuts_to_window" dzl_shortcut_manager_add_shortcuts_to_window :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    Ptr Dazzle.ShortcutsWindow.ShortcutsWindow -> -- window : TInterface (Name {namespace = "Dazzle", name = "ShortcutsWindow"})
    IO ()

-- | Adds shortcuts registered with the t'GI.Dazzle.Objects.ShortcutManager.ShortcutManager' to the
-- t'GI.Dazzle.Objects.ShortcutsWindow.ShortcutsWindow'.
shortcutManagerAddShortcutsToWindow ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutManager a, Dazzle.ShortcutsWindow.IsShortcutsWindow b) =>
    a
    -- ^ /@self@/: A t'GI.Dazzle.Objects.ShortcutManager.ShortcutManager'
    -> b
    -- ^ /@window@/: A t'GI.Dazzle.Objects.ShortcutsWindow.ShortcutsWindow'
    -> m ()
shortcutManagerAddShortcutsToWindow :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutManager a,
 IsShortcutsWindow b) =>
a -> b -> m ()
shortcutManagerAddShortcutsToWindow a
self b
window = 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 ShortcutManager
self' <- a -> IO (Ptr ShortcutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ShortcutsWindow
window' <- b -> IO (Ptr ShortcutsWindow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
window
    Ptr ShortcutManager -> Ptr ShortcutsWindow -> IO ()
dzl_shortcut_manager_add_shortcuts_to_window Ptr ShortcutManager
self' Ptr ShortcutsWindow
window'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
window
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutManagerAddShortcutsToWindowMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsShortcutManager a, Dazzle.ShortcutsWindow.IsShortcutsWindow b) => O.OverloadedMethod ShortcutManagerAddShortcutsToWindowMethodInfo a signature where
    overloadedMethod = shortcutManagerAddShortcutsToWindow

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


#endif

-- method ShortcutManager::append_search_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "directory"
--           , 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_manager_append_search_path" dzl_shortcut_manager_append_search_path :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    CString ->                              -- directory : TBasicType TUTF8
    IO ()

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

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

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


#endif

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

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

-- | Gets the \"theme\" property.
shortcutManagerGetTheme ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutManager a) =>
    Maybe (a)
    -- ^ /@self@/: A t'GI.Dazzle.Objects.ShortcutManager.ShortcutManager' or 'P.Nothing'
    -> m Dazzle.ShortcutTheme.ShortcutTheme
    -- ^ __Returns:__ An t'GI.Dazzle.Objects.ShortcutTheme.ShortcutTheme'.
shortcutManagerGetTheme :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutManager a) =>
Maybe a -> m ShortcutTheme
shortcutManagerGetTheme Maybe a
self = IO ShortcutTheme -> m ShortcutTheme
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutTheme -> m ShortcutTheme)
-> IO ShortcutTheme -> m ShortcutTheme
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutManager
maybeSelf <- case Maybe a
self of
        Maybe a
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 a
jSelf -> do
            Ptr ShortcutManager
jSelf' <- a -> IO (Ptr ShortcutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSelf
            Ptr ShortcutManager -> IO (Ptr ShortcutManager)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ShortcutManager
jSelf'
    Ptr ShortcutTheme
result <- Ptr ShortcutManager -> IO (Ptr ShortcutTheme)
dzl_shortcut_manager_get_theme Ptr ShortcutManager
maybeSelf
    Text -> Ptr ShortcutTheme -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutManagerGetTheme" Ptr ShortcutTheme
result
    ShortcutTheme
result' <- ((ManagedPtr ShortcutTheme -> ShortcutTheme)
-> Ptr ShortcutTheme -> IO ShortcutTheme
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ShortcutTheme -> ShortcutTheme
Dazzle.ShortcutTheme.ShortcutTheme) Ptr ShortcutTheme
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
self a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    ShortcutTheme -> IO ShortcutTheme
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutTheme
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutManagerGetThemeMethodInfo
instance (signature ~ (m Dazzle.ShortcutTheme.ShortcutTheme), MonadIO m, IsShortcutManager a) => O.OverloadedMethod ShortcutManagerGetThemeMethodInfo a signature where
    overloadedMethod i = shortcutManagerGetTheme (Just i)

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


#endif

-- method ShortcutManager::get_theme_by_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "theme_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the name of a theme or %NULL of the internal theme"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_manager_get_theme_by_name" dzl_shortcut_manager_get_theme_by_name :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    CString ->                              -- theme_name : TBasicType TUTF8
    IO (Ptr Dazzle.ShortcutTheme.ShortcutTheme)

-- | Locates a theme by the name of the theme.
-- 
-- If /@themeName@/ is 'P.Nothing', then the internal theme is used. You probably dont
-- need to use that as it is used by various controllers to hook up their
-- default actions.
shortcutManagerGetThemeByName ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutManager a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutManager.ShortcutManager'
    -> Maybe (T.Text)
    -- ^ /@themeName@/: the name of a theme or 'P.Nothing' of the internal theme
    -> m (Maybe Dazzle.ShortcutTheme.ShortcutTheme)
    -- ^ __Returns:__ A t'GI.Dazzle.Objects.ShortcutTheme.ShortcutTheme' or 'P.Nothing'.
shortcutManagerGetThemeByName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutManager a) =>
a -> Maybe Text -> m (Maybe ShortcutTheme)
shortcutManagerGetThemeByName a
self Maybe Text
themeName = IO (Maybe ShortcutTheme) -> m (Maybe ShortcutTheme)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ShortcutTheme) -> m (Maybe ShortcutTheme))
-> IO (Maybe ShortcutTheme) -> m (Maybe ShortcutTheme)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutManager
self' <- a -> IO (Ptr ShortcutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeThemeName <- case Maybe Text
themeName 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
jThemeName -> do
            CString
jThemeName' <- Text -> IO CString
textToCString Text
jThemeName
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jThemeName'
    Ptr ShortcutTheme
result <- Ptr ShortcutManager -> CString -> IO (Ptr ShortcutTheme)
dzl_shortcut_manager_get_theme_by_name Ptr ShortcutManager
self' CString
maybeThemeName
    Maybe ShortcutTheme
maybeResult <- Ptr ShortcutTheme
-> (Ptr ShortcutTheme -> IO ShortcutTheme)
-> IO (Maybe ShortcutTheme)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ShortcutTheme
result ((Ptr ShortcutTheme -> IO ShortcutTheme)
 -> IO (Maybe ShortcutTheme))
-> (Ptr ShortcutTheme -> IO ShortcutTheme)
-> IO (Maybe ShortcutTheme)
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutTheme
result' -> do
        ShortcutTheme
result'' <- ((ManagedPtr ShortcutTheme -> ShortcutTheme)
-> Ptr ShortcutTheme -> IO ShortcutTheme
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ShortcutTheme -> ShortcutTheme
Dazzle.ShortcutTheme.ShortcutTheme) Ptr ShortcutTheme
result'
        ShortcutTheme -> IO ShortcutTheme
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutTheme
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeThemeName
    Maybe ShortcutTheme -> IO (Maybe ShortcutTheme)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ShortcutTheme
maybeResult

#if defined(ENABLE_OVERLOADING)
data ShortcutManagerGetThemeByNameMethodInfo
instance (signature ~ (Maybe (T.Text) -> m (Maybe Dazzle.ShortcutTheme.ShortcutTheme)), MonadIO m, IsShortcutManager a) => O.OverloadedMethod ShortcutManagerGetThemeByNameMethodInfo a signature where
    overloadedMethod = shortcutManagerGetThemeByName

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


#endif

-- method ShortcutManager::get_theme_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , 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_manager_get_theme_name" dzl_shortcut_manager_get_theme_name :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    IO CString

-- | /No description available in the introspection data./
shortcutManagerGetThemeName ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutManager a) =>
    a
    -> m T.Text
shortcutManagerGetThemeName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutManager a) =>
a -> m Text
shortcutManagerGetThemeName 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 ShortcutManager
self' <- a -> IO (Ptr ShortcutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ShortcutManager -> IO CString
dzl_shortcut_manager_get_theme_name Ptr ShortcutManager
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutManagerGetThemeName" 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 ShortcutManagerGetThemeNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsShortcutManager a) => O.OverloadedMethod ShortcutManagerGetThemeNameMethodInfo a signature where
    overloadedMethod = shortcutManagerGetThemeName

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


#endif

-- method ShortcutManager::get_user_dir
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , 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_manager_get_user_dir" dzl_shortcut_manager_get_user_dir :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    IO CString

-- | /No description available in the introspection data./
shortcutManagerGetUserDir ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutManager a) =>
    a
    -> m T.Text
shortcutManagerGetUserDir :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutManager a) =>
a -> m Text
shortcutManagerGetUserDir 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 ShortcutManager
self' <- a -> IO (Ptr ShortcutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ShortcutManager -> IO CString
dzl_shortcut_manager_get_user_dir Ptr ShortcutManager
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutManagerGetUserDir" 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 ShortcutManagerGetUserDirMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsShortcutManager a) => O.OverloadedMethod ShortcutManagerGetUserDirMethodInfo a signature where
    overloadedMethod = shortcutManagerGetUserDir

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


#endif

-- method ShortcutManager::handle_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #DzlShortcutManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "EventKey" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GdkEventKey event to handle."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "toplevel"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GtkWidget or %NULL."
--                 , 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_manager_handle_event" dzl_shortcut_manager_handle_event :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    Ptr Gdk.EventKey.EventKey ->            -- event : TInterface (Name {namespace = "Gdk", name = "EventKey"})
    Ptr Gtk.Widget.Widget ->                -- toplevel : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO CInt

-- | This function will try to dispatch /@event@/ to the proper widget and
-- t'GI.Dazzle.Objects.ShortcutContext.ShortcutContext'. If the event is handled, then 'P.True' is returned.
-- 
-- You should call this from [Widget::keyPressEvent]("GI.Gtk.Objects.Widget#g:signal:keyPressEvent") handler in your
-- t'GI.Gtk.Objects.Window.Window' toplevel.
shortcutManagerHandleEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutManager a, Gtk.Widget.IsWidget b) =>
    Maybe (a)
    -- ^ /@self@/: An t'GI.Dazzle.Objects.ShortcutManager.ShortcutManager'
    -> Gdk.EventKey.EventKey
    -- ^ /@event@/: A t'GI.Gdk.Structs.EventKey.EventKey' event to handle.
    -> b
    -- ^ /@toplevel@/: A t'GI.Gtk.Objects.Widget.Widget' or 'P.Nothing'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the event was handled.
shortcutManagerHandleEvent :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutManager a, IsWidget b) =>
Maybe a -> EventKey -> b -> m Bool
shortcutManagerHandleEvent Maybe a
self EventKey
event b
toplevel = 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 ShortcutManager
maybeSelf <- case Maybe a
self of
        Maybe a
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 a
jSelf -> do
            Ptr ShortcutManager
jSelf' <- a -> IO (Ptr ShortcutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jSelf
            Ptr ShortcutManager -> IO (Ptr ShortcutManager)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ShortcutManager
jSelf'
    Ptr EventKey
event' <- EventKey -> IO (Ptr EventKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr EventKey
event
    Ptr Widget
toplevel' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
toplevel
    CInt
result <- Ptr ShortcutManager -> Ptr EventKey -> Ptr Widget -> IO CInt
dzl_shortcut_manager_handle_event Ptr ShortcutManager
maybeSelf Ptr EventKey
event' Ptr Widget
toplevel'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
self a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    EventKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr EventKey
event
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
toplevel
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutManagerHandleEventMethodInfo
instance (signature ~ (Gdk.EventKey.EventKey -> b -> m Bool), MonadIO m, IsShortcutManager a, Gtk.Widget.IsWidget b) => O.OverloadedMethod ShortcutManagerHandleEventMethodInfo a signature where
    overloadedMethod i = shortcutManagerHandleEvent (Just i)

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


#endif

-- method ShortcutManager::prepend_search_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "directory"
--           , 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_manager_prepend_search_path" dzl_shortcut_manager_prepend_search_path :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    CString ->                              -- directory : TBasicType TUTF8
    IO ()

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

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

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


#endif

-- method ShortcutManager::queue_reload
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , 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_manager_queue_reload" dzl_shortcut_manager_queue_reload :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    IO ()

-- | /No description available in the introspection data./
shortcutManagerQueueReload ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutManager a) =>
    a
    -> m ()
shortcutManagerQueueReload :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutManager a) =>
a -> m ()
shortcutManagerQueueReload a
self = 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 ShortcutManager
self' <- a -> IO (Ptr ShortcutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ShortcutManager -> IO ()
dzl_shortcut_manager_queue_reload Ptr ShortcutManager
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutManagerQueueReloadMethodInfo
instance (signature ~ (m ()), MonadIO m, IsShortcutManager a) => O.OverloadedMethod ShortcutManagerQueueReloadMethodInfo a signature where
    overloadedMethod = shortcutManagerQueueReload

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


#endif

-- method ShortcutManager::reload
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , 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_manager_reload" dzl_shortcut_manager_reload :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    IO ()

-- | /No description available in the introspection data./
shortcutManagerReload ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutManager a, Gio.Cancellable.IsCancellable b) =>
    a
    -> Maybe (b)
    -> m ()
shortcutManagerReload :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutManager a, IsCancellable b) =>
a -> Maybe b -> m ()
shortcutManagerReload a
self Maybe b
cancellable = 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 ShortcutManager
self' <- a -> IO (Ptr ShortcutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    Ptr ShortcutManager -> Ptr Cancellable -> IO ()
dzl_shortcut_manager_reload Ptr ShortcutManager
self' Ptr Cancellable
maybeCancellable
    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
cancellable 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 ShortcutManagerReloadMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsShortcutManager a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ShortcutManagerReloadMethodInfo a signature where
    overloadedMethod = shortcutManagerReload

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


#endif

-- method ShortcutManager::remove_search_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "directory"
--           , 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_manager_remove_search_path" dzl_shortcut_manager_remove_search_path :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    CString ->                              -- directory : TBasicType TUTF8
    IO ()

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

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

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


#endif

-- method ShortcutManager::set_theme
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #DzlShortcutManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "theme"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #DzlShortcutTheme"
--                 , 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_manager_set_theme" dzl_shortcut_manager_set_theme :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    Ptr Dazzle.ShortcutTheme.ShortcutTheme -> -- theme : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    IO ()

-- | Sets the theme for the shortcut manager.
shortcutManagerSetTheme ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutManager a, Dazzle.ShortcutTheme.IsShortcutTheme b) =>
    a
    -- ^ /@self@/: An t'GI.Dazzle.Objects.ShortcutManager.ShortcutManager'
    -> b
    -- ^ /@theme@/: An t'GI.Dazzle.Objects.ShortcutTheme.ShortcutTheme'
    -> m ()
shortcutManagerSetTheme :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutManager a,
 IsShortcutTheme b) =>
a -> b -> m ()
shortcutManagerSetTheme a
self b
theme = 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 ShortcutManager
self' <- a -> IO (Ptr ShortcutManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ShortcutTheme
theme' <- b -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
theme
    Ptr ShortcutManager -> Ptr ShortcutTheme -> IO ()
dzl_shortcut_manager_set_theme Ptr ShortcutManager
self' Ptr ShortcutTheme
theme'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
theme
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutManagerSetThemeMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsShortcutManager a, Dazzle.ShortcutTheme.IsShortcutTheme b) => O.OverloadedMethod ShortcutManagerSetThemeMethodInfo a signature where
    overloadedMethod = shortcutManagerSetTheme

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


#endif

-- method ShortcutManager::set_theme_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "theme_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_manager_set_theme_name" dzl_shortcut_manager_set_theme_name :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    CString ->                              -- theme_name : TBasicType TUTF8
    IO ()

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

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

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


#endif

-- method ShortcutManager::set_user_dir
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_dir"
--           , 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_manager_set_user_dir" dzl_shortcut_manager_set_user_dir :: 
    Ptr ShortcutManager ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutManager"})
    CString ->                              -- user_dir : TBasicType TUTF8
    IO ()

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

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

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


#endif

-- method ShortcutManager::get_default
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Dazzle" , name = "ShortcutManager" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_manager_get_default" dzl_shortcut_manager_get_default :: 
    IO (Ptr ShortcutManager)

-- | Gets the singleton t'GI.Dazzle.Objects.ShortcutManager.ShortcutManager' for the process.
shortcutManagerGetDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ShortcutManager
    -- ^ __Returns:__ An t'GI.Dazzle.Objects.ShortcutManager.ShortcutManager'.
shortcutManagerGetDefault :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m ShortcutManager
shortcutManagerGetDefault  = 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 ShortcutManager
result <- IO (Ptr ShortcutManager)
dzl_shortcut_manager_get_default
    Text -> Ptr ShortcutManager -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutManagerGetDefault" 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
ShortcutManager) Ptr ShortcutManager
result
    ShortcutManager -> IO ShortcutManager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutManager
result'

#if defined(ENABLE_OVERLOADING)
#endif