{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Dazzle.Objects.ShortcutTheme
(
#if defined(ENABLE_OVERLOADING)
ShortcutThemeAddCommandMethodInfo ,
#endif
ShortcutTheme(..) ,
IsShortcutTheme ,
toShortcutTheme ,
#if defined(ENABLE_OVERLOADING)
ResolveShortcutThemeMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
ShortcutThemeAddContextMethodInfo ,
#endif
shortcutThemeAddContext ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeAddCssResourceMethodInfo ,
#endif
shortcutThemeAddCssResource ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeFindContextByNameMethodInfo,
#endif
shortcutThemeFindContextByName ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeFindDefaultContextMethodInfo,
#endif
shortcutThemeFindDefaultContext ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeGetChordForActionMethodInfo,
#endif
shortcutThemeGetChordForAction ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeGetChordForCommandMethodInfo,
#endif
shortcutThemeGetChordForCommand ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeGetNameMethodInfo ,
#endif
shortcutThemeGetName ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeGetParentMethodInfo ,
#endif
shortcutThemeGetParent ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeGetParentNameMethodInfo ,
#endif
shortcutThemeGetParentName ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeGetSubtitleMethodInfo ,
#endif
shortcutThemeGetSubtitle ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeGetTitleMethodInfo ,
#endif
shortcutThemeGetTitle ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeLoadFromDataMethodInfo ,
#endif
shortcutThemeLoadFromData ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeLoadFromFileMethodInfo ,
#endif
shortcutThemeLoadFromFile ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeLoadFromPathMethodInfo ,
#endif
shortcutThemeLoadFromPath ,
shortcutThemeNew ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeRemoveCssResourceMethodInfo,
#endif
shortcutThemeRemoveCssResource ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeSaveToFileMethodInfo ,
#endif
shortcutThemeSaveToFile ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeSaveToPathMethodInfo ,
#endif
shortcutThemeSaveToPath ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeSaveToStreamMethodInfo ,
#endif
shortcutThemeSaveToStream ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeSetAccelForActionMethodInfo,
#endif
shortcutThemeSetAccelForAction ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeSetAccelForCommandMethodInfo,
#endif
shortcutThemeSetAccelForCommand ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeSetChordForActionMethodInfo,
#endif
shortcutThemeSetChordForAction ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeSetChordForCommandMethodInfo,
#endif
shortcutThemeSetChordForCommand ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeSetParentNameMethodInfo ,
#endif
shortcutThemeSetParentName ,
#if defined(ENABLE_OVERLOADING)
ShortcutThemeNamePropertyInfo ,
#endif
constructShortcutThemeName ,
getShortcutThemeName ,
#if defined(ENABLE_OVERLOADING)
shortcutThemeName ,
#endif
#if defined(ENABLE_OVERLOADING)
ShortcutThemeParentNamePropertyInfo ,
#endif
constructShortcutThemeParentName ,
getShortcutThemeParentName ,
setShortcutThemeParentName ,
#if defined(ENABLE_OVERLOADING)
shortcutThemeParentName ,
#endif
#if defined(ENABLE_OVERLOADING)
ShortcutThemeSubtitlePropertyInfo ,
#endif
clearShortcutThemeSubtitle ,
constructShortcutThemeSubtitle ,
getShortcutThemeSubtitle ,
setShortcutThemeSubtitle ,
#if defined(ENABLE_OVERLOADING)
shortcutThemeSubtitle ,
#endif
#if defined(ENABLE_OVERLOADING)
ShortcutThemeTitlePropertyInfo ,
#endif
clearShortcutThemeTitle ,
constructShortcutThemeTitle ,
getShortcutThemeTitle ,
setShortcutThemeTitle ,
#if defined(ENABLE_OVERLOADING)
shortcutThemeTitle ,
#endif
) where
import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P
import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT
#if MIN_VERSION_base(4,18,0)
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.Structs.ShortcutChord as Dazzle.ShortcutChord
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Structs.EventKey as Gdk.EventKey
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.OutputStream as Gio.OutputStream
import qualified GI.Gtk.Objects.Widget as Gtk.Widget
#else
import {-# SOURCE #-} qualified GI.Dazzle.Flags as Dazzle.Flags
import {-# SOURCE #-} qualified GI.Dazzle.Objects.ShortcutContext as Dazzle.ShortcutContext
import {-# SOURCE #-} qualified GI.Dazzle.Structs.ShortcutChord as Dazzle.ShortcutChord
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.OutputStream as Gio.OutputStream
import qualified GI.Gtk.Objects.Widget as Gtk.Widget
#endif
newtype ShortcutTheme = ShortcutTheme (SP.ManagedPtr ShortcutTheme)
deriving (ShortcutTheme -> ShortcutTheme -> Bool
(ShortcutTheme -> ShortcutTheme -> Bool)
-> (ShortcutTheme -> ShortcutTheme -> Bool) -> Eq ShortcutTheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShortcutTheme -> ShortcutTheme -> Bool
== :: ShortcutTheme -> ShortcutTheme -> Bool
$c/= :: ShortcutTheme -> ShortcutTheme -> Bool
/= :: ShortcutTheme -> ShortcutTheme -> Bool
Eq)
instance SP.ManagedPtrNewtype ShortcutTheme where
toManagedPtr :: ShortcutTheme -> ManagedPtr ShortcutTheme
toManagedPtr (ShortcutTheme ManagedPtr ShortcutTheme
p) = ManagedPtr ShortcutTheme
p
foreign import ccall "dzl_shortcut_theme_get_type"
c_dzl_shortcut_theme_get_type :: IO B.Types.GType
instance B.Types.TypedObject ShortcutTheme where
glibType :: IO GType
glibType = IO GType
c_dzl_shortcut_theme_get_type
instance B.Types.GObject ShortcutTheme
class (SP.GObject o, O.IsDescendantOf ShortcutTheme o) => IsShortcutTheme o
instance (SP.GObject o, O.IsDescendantOf ShortcutTheme o) => IsShortcutTheme o
instance O.HasParentTypes ShortcutTheme
type instance O.ParentTypes ShortcutTheme = '[GObject.Object.Object]
toShortcutTheme :: (MIO.MonadIO m, IsShortcutTheme o) => o -> m ShortcutTheme
toShortcutTheme :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTheme o) =>
o -> m ShortcutTheme
toShortcutTheme = 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)
-> (o -> IO ShortcutTheme) -> o -> m ShortcutTheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr ShortcutTheme -> ShortcutTheme)
-> o -> IO ShortcutTheme
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr ShortcutTheme -> ShortcutTheme
ShortcutTheme
instance B.GValue.IsGValue (Maybe ShortcutTheme) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_dzl_shortcut_theme_get_type
gvalueSet_ :: Ptr GValue -> Maybe ShortcutTheme -> IO ()
gvalueSet_ Ptr GValue
gv Maybe ShortcutTheme
P.Nothing = Ptr GValue -> Ptr ShortcutTheme -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr ShortcutTheme
forall a. Ptr a
FP.nullPtr :: FP.Ptr ShortcutTheme)
gvalueSet_ Ptr GValue
gv (P.Just ShortcutTheme
obj) = ShortcutTheme -> (Ptr ShortcutTheme -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ShortcutTheme
obj (Ptr GValue -> Ptr ShortcutTheme -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe ShortcutTheme)
gvalueGet_ Ptr GValue
gv = do
Ptr ShortcutTheme
ptr <- Ptr GValue -> IO (Ptr ShortcutTheme)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr ShortcutTheme)
if Ptr ShortcutTheme
ptr Ptr ShortcutTheme -> Ptr ShortcutTheme -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ShortcutTheme
forall a. Ptr a
FP.nullPtr
then ShortcutTheme -> Maybe ShortcutTheme
forall a. a -> Maybe a
P.Just (ShortcutTheme -> Maybe ShortcutTheme)
-> IO ShortcutTheme -> IO (Maybe ShortcutTheme)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr ShortcutTheme -> ShortcutTheme)
-> Ptr ShortcutTheme -> IO ShortcutTheme
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr ShortcutTheme -> ShortcutTheme
ShortcutTheme Ptr ShortcutTheme
ptr
else Maybe ShortcutTheme -> IO (Maybe ShortcutTheme)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ShortcutTheme
forall a. Maybe a
P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveShortcutThemeMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveShortcutThemeMethod "addCommand" o = ShortcutThemeAddCommandMethodInfo
ResolveShortcutThemeMethod "addContext" o = ShortcutThemeAddContextMethodInfo
ResolveShortcutThemeMethod "addCssResource" o = ShortcutThemeAddCssResourceMethodInfo
ResolveShortcutThemeMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveShortcutThemeMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveShortcutThemeMethod "findContextByName" o = ShortcutThemeFindContextByNameMethodInfo
ResolveShortcutThemeMethod "findDefaultContext" o = ShortcutThemeFindDefaultContextMethodInfo
ResolveShortcutThemeMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveShortcutThemeMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveShortcutThemeMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveShortcutThemeMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveShortcutThemeMethod "loadFromData" o = ShortcutThemeLoadFromDataMethodInfo
ResolveShortcutThemeMethod "loadFromFile" o = ShortcutThemeLoadFromFileMethodInfo
ResolveShortcutThemeMethod "loadFromPath" o = ShortcutThemeLoadFromPathMethodInfo
ResolveShortcutThemeMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveShortcutThemeMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveShortcutThemeMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveShortcutThemeMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveShortcutThemeMethod "removeCssResource" o = ShortcutThemeRemoveCssResourceMethodInfo
ResolveShortcutThemeMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveShortcutThemeMethod "saveToFile" o = ShortcutThemeSaveToFileMethodInfo
ResolveShortcutThemeMethod "saveToPath" o = ShortcutThemeSaveToPathMethodInfo
ResolveShortcutThemeMethod "saveToStream" o = ShortcutThemeSaveToStreamMethodInfo
ResolveShortcutThemeMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveShortcutThemeMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveShortcutThemeMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveShortcutThemeMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveShortcutThemeMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveShortcutThemeMethod "getChordForAction" o = ShortcutThemeGetChordForActionMethodInfo
ResolveShortcutThemeMethod "getChordForCommand" o = ShortcutThemeGetChordForCommandMethodInfo
ResolveShortcutThemeMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveShortcutThemeMethod "getName" o = ShortcutThemeGetNameMethodInfo
ResolveShortcutThemeMethod "getParent" o = ShortcutThemeGetParentMethodInfo
ResolveShortcutThemeMethod "getParentName" o = ShortcutThemeGetParentNameMethodInfo
ResolveShortcutThemeMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveShortcutThemeMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveShortcutThemeMethod "getSubtitle" o = ShortcutThemeGetSubtitleMethodInfo
ResolveShortcutThemeMethod "getTitle" o = ShortcutThemeGetTitleMethodInfo
ResolveShortcutThemeMethod "setAccelForAction" o = ShortcutThemeSetAccelForActionMethodInfo
ResolveShortcutThemeMethod "setAccelForCommand" o = ShortcutThemeSetAccelForCommandMethodInfo
ResolveShortcutThemeMethod "setChordForAction" o = ShortcutThemeSetChordForActionMethodInfo
ResolveShortcutThemeMethod "setChordForCommand" o = ShortcutThemeSetChordForCommandMethodInfo
ResolveShortcutThemeMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveShortcutThemeMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveShortcutThemeMethod "setParentName" o = ShortcutThemeSetParentNameMethodInfo
ResolveShortcutThemeMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveShortcutThemeMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveShortcutThemeMethod t ShortcutTheme, O.OverloadedMethod info ShortcutTheme p) => OL.IsLabel t (ShortcutTheme -> 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 ~ ResolveShortcutThemeMethod t ShortcutTheme, O.OverloadedMethod info ShortcutTheme p, R.HasField t ShortcutTheme p) => R.HasField t ShortcutTheme p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveShortcutThemeMethod t ShortcutTheme, O.OverloadedMethodInfo info ShortcutTheme) => OL.IsLabel t (O.MethodProxy info ShortcutTheme) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getShortcutThemeName :: (MonadIO m, IsShortcutTheme o) => o -> m T.Text
getShortcutThemeName :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTheme o) =>
o -> m Text
getShortcutThemeName 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
"getShortcutThemeName" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"name"
constructShortcutThemeName :: (IsShortcutTheme o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructShortcutThemeName :: forall o (m :: * -> *).
(IsShortcutTheme o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructShortcutThemeName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeNamePropertyInfo
instance AttrInfo ShortcutThemeNamePropertyInfo where
type AttrAllowedOps ShortcutThemeNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ShortcutThemeNamePropertyInfo = IsShortcutTheme
type AttrSetTypeConstraint ShortcutThemeNamePropertyInfo = (~) T.Text
type AttrTransferTypeConstraint ShortcutThemeNamePropertyInfo = (~) T.Text
type AttrTransferType ShortcutThemeNamePropertyInfo = T.Text
type AttrGetType ShortcutThemeNamePropertyInfo = T.Text
type AttrLabel ShortcutThemeNamePropertyInfo = "name"
type AttrOrigin ShortcutThemeNamePropertyInfo = ShortcutTheme
attrGet = getShortcutThemeName
attrSet = undefined
attrTransfer _ v = do
return v
attrConstruct = constructShortcutThemeName
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.name"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#g:attr:name"
})
#endif
getShortcutThemeParentName :: (MonadIO m, IsShortcutTheme o) => o -> m (Maybe T.Text)
getShortcutThemeParentName :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTheme o) =>
o -> m (Maybe Text)
getShortcutThemeParentName o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe 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
"parent-name"
setShortcutThemeParentName :: (MonadIO m, IsShortcutTheme o) => o -> T.Text -> m ()
setShortcutThemeParentName :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTheme o) =>
o -> Text -> m ()
setShortcutThemeParentName 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
"parent-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructShortcutThemeParentName :: (IsShortcutTheme o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructShortcutThemeParentName :: forall o (m :: * -> *).
(IsShortcutTheme o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructShortcutThemeParentName 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
"parent-name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeParentNamePropertyInfo
instance AttrInfo ShortcutThemeParentNamePropertyInfo where
type AttrAllowedOps ShortcutThemeParentNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint ShortcutThemeParentNamePropertyInfo = IsShortcutTheme
type AttrSetTypeConstraint ShortcutThemeParentNamePropertyInfo = (~) T.Text
type AttrTransferTypeConstraint ShortcutThemeParentNamePropertyInfo = (~) T.Text
type AttrTransferType ShortcutThemeParentNamePropertyInfo = T.Text
type AttrGetType ShortcutThemeParentNamePropertyInfo = (Maybe T.Text)
type AttrLabel ShortcutThemeParentNamePropertyInfo = "parent-name"
type AttrOrigin ShortcutThemeParentNamePropertyInfo = ShortcutTheme
attrGet = getShortcutThemeParentName
attrSet = setShortcutThemeParentName
attrTransfer _ v = do
return v
attrConstruct = constructShortcutThemeParentName
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.parentName"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#g:attr:parentName"
})
#endif
getShortcutThemeSubtitle :: (MonadIO m, IsShortcutTheme o) => o -> m T.Text
getShortcutThemeSubtitle :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTheme o) =>
o -> m Text
getShortcutThemeSubtitle 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
"getShortcutThemeSubtitle" (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
"subtitle"
setShortcutThemeSubtitle :: (MonadIO m, IsShortcutTheme o) => o -> T.Text -> m ()
setShortcutThemeSubtitle :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTheme o) =>
o -> Text -> m ()
setShortcutThemeSubtitle 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
"subtitle" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructShortcutThemeSubtitle :: (IsShortcutTheme o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructShortcutThemeSubtitle :: forall o (m :: * -> *).
(IsShortcutTheme o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructShortcutThemeSubtitle 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
"subtitle" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearShortcutThemeSubtitle :: (MonadIO m, IsShortcutTheme o) => o -> m ()
clearShortcutThemeSubtitle :: forall (m :: * -> *) o. (MonadIO m, IsShortcutTheme o) => o -> m ()
clearShortcutThemeSubtitle o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"subtitle" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSubtitlePropertyInfo
instance AttrInfo ShortcutThemeSubtitlePropertyInfo where
type AttrAllowedOps ShortcutThemeSubtitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ShortcutThemeSubtitlePropertyInfo = IsShortcutTheme
type AttrSetTypeConstraint ShortcutThemeSubtitlePropertyInfo = (~) T.Text
type AttrTransferTypeConstraint ShortcutThemeSubtitlePropertyInfo = (~) T.Text
type AttrTransferType ShortcutThemeSubtitlePropertyInfo = T.Text
type AttrGetType ShortcutThemeSubtitlePropertyInfo = T.Text
type AttrLabel ShortcutThemeSubtitlePropertyInfo = "subtitle"
type AttrOrigin ShortcutThemeSubtitlePropertyInfo = ShortcutTheme
attrGet = getShortcutThemeSubtitle
attrSet = setShortcutThemeSubtitle
attrTransfer _ v = do
return v
attrConstruct = constructShortcutThemeSubtitle
attrClear = clearShortcutThemeSubtitle
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.subtitle"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#g:attr:subtitle"
})
#endif
getShortcutThemeTitle :: (MonadIO m, IsShortcutTheme o) => o -> m T.Text
getShortcutThemeTitle :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTheme o) =>
o -> m Text
getShortcutThemeTitle 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
"getShortcutThemeTitle" (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
"title"
setShortcutThemeTitle :: (MonadIO m, IsShortcutTheme o) => o -> T.Text -> m ()
setShortcutThemeTitle :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTheme o) =>
o -> Text -> m ()
setShortcutThemeTitle 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
"title" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructShortcutThemeTitle :: (IsShortcutTheme o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructShortcutThemeTitle :: forall o (m :: * -> *).
(IsShortcutTheme o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructShortcutThemeTitle 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
"title" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearShortcutThemeTitle :: (MonadIO m, IsShortcutTheme o) => o -> m ()
clearShortcutThemeTitle :: forall (m :: * -> *) o. (MonadIO m, IsShortcutTheme o) => o -> m ()
clearShortcutThemeTitle o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"title" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeTitlePropertyInfo
instance AttrInfo ShortcutThemeTitlePropertyInfo where
type AttrAllowedOps ShortcutThemeTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ShortcutThemeTitlePropertyInfo = IsShortcutTheme
type AttrSetTypeConstraint ShortcutThemeTitlePropertyInfo = (~) T.Text
type AttrTransferTypeConstraint ShortcutThemeTitlePropertyInfo = (~) T.Text
type AttrTransferType ShortcutThemeTitlePropertyInfo = T.Text
type AttrGetType ShortcutThemeTitlePropertyInfo = T.Text
type AttrLabel ShortcutThemeTitlePropertyInfo = "title"
type AttrOrigin ShortcutThemeTitlePropertyInfo = ShortcutTheme
attrGet = getShortcutThemeTitle
attrSet = setShortcutThemeTitle
attrTransfer _ v = do
return v
attrConstruct = constructShortcutThemeTitle
attrClear = clearShortcutThemeTitle
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.title"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#g:attr:title"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ShortcutTheme
type instance O.AttributeList ShortcutTheme = ShortcutThemeAttributeList
type ShortcutThemeAttributeList = ('[ '("name", ShortcutThemeNamePropertyInfo), '("parentName", ShortcutThemeParentNamePropertyInfo), '("subtitle", ShortcutThemeSubtitlePropertyInfo), '("title", ShortcutThemeTitlePropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
shortcutThemeName :: AttrLabelProxy "name"
shortcutThemeName = AttrLabelProxy
shortcutThemeParentName :: AttrLabelProxy "parentName"
shortcutThemeParentName = AttrLabelProxy
shortcutThemeSubtitle :: AttrLabelProxy "subtitle"
shortcutThemeSubtitle = AttrLabelProxy
shortcutThemeTitle :: AttrLabelProxy "title"
shortcutThemeTitle = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ShortcutTheme = ShortcutThemeSignalList
type ShortcutThemeSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "dzl_shortcut_theme_new" dzl_shortcut_theme_new ::
CString ->
IO (Ptr ShortcutTheme)
shortcutThemeNew ::
(B.CallStack.HasCallStack, MonadIO m) =>
T.Text
-> m ShortcutTheme
shortcutThemeNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m ShortcutTheme
shortcutThemeNew Text
name = 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
CString
name' <- Text -> IO CString
textToCString Text
name
Ptr ShortcutTheme
result <- CString -> IO (Ptr ShortcutTheme)
dzl_shortcut_theme_new CString
name'
Text -> Ptr ShortcutTheme -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutThemeNew" 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
wrapObject ManagedPtr ShortcutTheme -> ShortcutTheme
ShortcutTheme) Ptr ShortcutTheme
result
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
ShortcutTheme -> IO ShortcutTheme
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutTheme
result'
#if defined(ENABLE_OVERLOADING)
#endif
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeAddCommandMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "addCommand" ShortcutTheme) => O.OverloadedMethod ShortcutThemeAddCommandMethodInfo o p where
overloadedMethod = undefined
instance (o ~ O.UnsupportedMethodError "addCommand" ShortcutTheme) => O.OverloadedMethodInfo ShortcutThemeAddCommandMethodInfo o where
overloadedMethodInfo = undefined
#endif
foreign import ccall "dzl_shortcut_theme_add_context" dzl_shortcut_theme_add_context ::
Ptr ShortcutTheme ->
Ptr Dazzle.ShortcutContext.ShortcutContext ->
IO ()
shortcutThemeAddContext ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a, Dazzle.ShortcutContext.IsShortcutContext b) =>
a
-> b
-> m ()
shortcutThemeAddContext :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutTheme a,
IsShortcutContext b) =>
a -> b -> m ()
shortcutThemeAddContext a
self b
context = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr ShortcutContext
context' <- b -> IO (Ptr ShortcutContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
Ptr ShortcutTheme -> Ptr ShortcutContext -> IO ()
dzl_shortcut_theme_add_context Ptr ShortcutTheme
self' Ptr ShortcutContext
context'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeAddContextMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsShortcutTheme a, Dazzle.ShortcutContext.IsShortcutContext b) => O.OverloadedMethod ShortcutThemeAddContextMethodInfo a signature where
overloadedMethod = shortcutThemeAddContext
instance O.OverloadedMethodInfo ShortcutThemeAddContextMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeAddContext",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeAddContext"
})
#endif
foreign import ccall "dzl_shortcut_theme_add_css_resource" dzl_shortcut_theme_add_css_resource ::
Ptr ShortcutTheme ->
CString ->
IO ()
shortcutThemeAddCssResource ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> T.Text
-> m ()
shortcutThemeAddCssResource :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> m ()
shortcutThemeAddCssResource a
self Text
path = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
path' <- Text -> IO CString
textToCString Text
path
Ptr ShortcutTheme -> CString -> IO ()
dzl_shortcut_theme_add_css_resource Ptr ShortcutTheme
self' CString
path'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeAddCssResourceMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeAddCssResourceMethodInfo a signature where
overloadedMethod = shortcutThemeAddCssResource
instance O.OverloadedMethodInfo ShortcutThemeAddCssResourceMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeAddCssResource",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeAddCssResource"
})
#endif
foreign import ccall "dzl_shortcut_theme_find_context_by_name" dzl_shortcut_theme_find_context_by_name ::
Ptr ShortcutTheme ->
CString ->
IO (Ptr Dazzle.ShortcutContext.ShortcutContext)
shortcutThemeFindContextByName ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> T.Text
-> m Dazzle.ShortcutContext.ShortcutContext
shortcutThemeFindContextByName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> m ShortcutContext
shortcutThemeFindContextByName a
self Text
name = IO ShortcutContext -> m ShortcutContext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutContext -> m ShortcutContext)
-> IO ShortcutContext -> m ShortcutContext
forall a b. (a -> b) -> a -> b
$ do
Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
name' <- Text -> IO CString
textToCString Text
name
Ptr ShortcutContext
result <- Ptr ShortcutTheme -> CString -> IO (Ptr ShortcutContext)
dzl_shortcut_theme_find_context_by_name Ptr ShortcutTheme
self' CString
name'
Text -> Ptr ShortcutContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutThemeFindContextByName" Ptr ShortcutContext
result
ShortcutContext
result' <- ((ManagedPtr ShortcutContext -> ShortcutContext)
-> Ptr ShortcutContext -> IO ShortcutContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ShortcutContext -> ShortcutContext
Dazzle.ShortcutContext.ShortcutContext) Ptr ShortcutContext
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
ShortcutContext -> IO ShortcutContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutContext
result'
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeFindContextByNameMethodInfo
instance (signature ~ (T.Text -> m Dazzle.ShortcutContext.ShortcutContext), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeFindContextByNameMethodInfo a signature where
overloadedMethod = shortcutThemeFindContextByName
instance O.OverloadedMethodInfo ShortcutThemeFindContextByNameMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeFindContextByName",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeFindContextByName"
})
#endif
foreign import ccall "dzl_shortcut_theme_find_default_context" dzl_shortcut_theme_find_default_context ::
Ptr ShortcutTheme ->
Ptr Gtk.Widget.Widget ->
IO (Ptr Dazzle.ShortcutContext.ShortcutContext)
shortcutThemeFindDefaultContext ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a, Gtk.Widget.IsWidget b) =>
a
-> b
-> m (Maybe Dazzle.ShortcutContext.ShortcutContext)
shortcutThemeFindDefaultContext :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutTheme a, IsWidget b) =>
a -> b -> m (Maybe ShortcutContext)
shortcutThemeFindDefaultContext a
self b
widget = IO (Maybe ShortcutContext) -> m (Maybe ShortcutContext)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ShortcutContext) -> m (Maybe ShortcutContext))
-> IO (Maybe ShortcutContext) -> m (Maybe ShortcutContext)
forall a b. (a -> b) -> a -> b
$ do
Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr Widget
widget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
widget
Ptr ShortcutContext
result <- Ptr ShortcutTheme -> Ptr Widget -> IO (Ptr ShortcutContext)
dzl_shortcut_theme_find_default_context Ptr ShortcutTheme
self' Ptr Widget
widget'
Maybe ShortcutContext
maybeResult <- Ptr ShortcutContext
-> (Ptr ShortcutContext -> IO ShortcutContext)
-> IO (Maybe ShortcutContext)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ShortcutContext
result ((Ptr ShortcutContext -> IO ShortcutContext)
-> IO (Maybe ShortcutContext))
-> (Ptr ShortcutContext -> IO ShortcutContext)
-> IO (Maybe ShortcutContext)
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutContext
result' -> do
ShortcutContext
result'' <- ((ManagedPtr ShortcutContext -> ShortcutContext)
-> Ptr ShortcutContext -> IO ShortcutContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ShortcutContext -> ShortcutContext
Dazzle.ShortcutContext.ShortcutContext) Ptr ShortcutContext
result'
ShortcutContext -> IO ShortcutContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutContext
result''
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
widget
Maybe ShortcutContext -> IO (Maybe ShortcutContext)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ShortcutContext
maybeResult
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeFindDefaultContextMethodInfo
instance (signature ~ (b -> m (Maybe Dazzle.ShortcutContext.ShortcutContext)), MonadIO m, IsShortcutTheme a, Gtk.Widget.IsWidget b) => O.OverloadedMethod ShortcutThemeFindDefaultContextMethodInfo a signature where
overloadedMethod = shortcutThemeFindDefaultContext
instance O.OverloadedMethodInfo ShortcutThemeFindDefaultContextMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeFindDefaultContext",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeFindDefaultContext"
})
#endif
foreign import ccall "dzl_shortcut_theme_get_chord_for_action" dzl_shortcut_theme_get_chord_for_action ::
Ptr ShortcutTheme ->
CString ->
IO (Ptr Dazzle.ShortcutChord.ShortcutChord)
shortcutThemeGetChordForAction ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> T.Text
-> m Dazzle.ShortcutChord.ShortcutChord
shortcutThemeGetChordForAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> m ShortcutChord
shortcutThemeGetChordForAction a
self Text
detailedActionName = IO ShortcutChord -> m ShortcutChord
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutChord -> m ShortcutChord)
-> IO ShortcutChord -> m ShortcutChord
forall a b. (a -> b) -> a -> b
$ do
Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
detailedActionName' <- Text -> IO CString
textToCString Text
detailedActionName
Ptr ShortcutChord
result <- Ptr ShortcutTheme -> CString -> IO (Ptr ShortcutChord)
dzl_shortcut_theme_get_chord_for_action Ptr ShortcutTheme
self' CString
detailedActionName'
Text -> Ptr ShortcutChord -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutThemeGetChordForAction" Ptr ShortcutChord
result
ShortcutChord
result' <- ((ManagedPtr ShortcutChord -> ShortcutChord)
-> Ptr ShortcutChord -> IO ShortcutChord
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr ShortcutChord -> ShortcutChord
Dazzle.ShortcutChord.ShortcutChord) Ptr ShortcutChord
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
detailedActionName'
ShortcutChord -> IO ShortcutChord
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutChord
result'
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeGetChordForActionMethodInfo
instance (signature ~ (T.Text -> m Dazzle.ShortcutChord.ShortcutChord), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeGetChordForActionMethodInfo a signature where
overloadedMethod = shortcutThemeGetChordForAction
instance O.OverloadedMethodInfo ShortcutThemeGetChordForActionMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeGetChordForAction",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeGetChordForAction"
})
#endif
foreign import ccall "dzl_shortcut_theme_get_chord_for_command" dzl_shortcut_theme_get_chord_for_command ::
Ptr ShortcutTheme ->
CString ->
IO (Ptr Dazzle.ShortcutChord.ShortcutChord)
shortcutThemeGetChordForCommand ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> T.Text
-> m Dazzle.ShortcutChord.ShortcutChord
shortcutThemeGetChordForCommand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> m ShortcutChord
shortcutThemeGetChordForCommand a
self Text
command = IO ShortcutChord -> m ShortcutChord
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutChord -> m ShortcutChord)
-> IO ShortcutChord -> m ShortcutChord
forall a b. (a -> b) -> a -> b
$ do
Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
command' <- Text -> IO CString
textToCString Text
command
Ptr ShortcutChord
result <- Ptr ShortcutTheme -> CString -> IO (Ptr ShortcutChord)
dzl_shortcut_theme_get_chord_for_command Ptr ShortcutTheme
self' CString
command'
Text -> Ptr ShortcutChord -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutThemeGetChordForCommand" Ptr ShortcutChord
result
ShortcutChord
result' <- ((ManagedPtr ShortcutChord -> ShortcutChord)
-> Ptr ShortcutChord -> IO ShortcutChord
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr ShortcutChord -> ShortcutChord
Dazzle.ShortcutChord.ShortcutChord) Ptr ShortcutChord
result
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
command'
ShortcutChord -> IO ShortcutChord
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutChord
result'
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeGetChordForCommandMethodInfo
instance (signature ~ (T.Text -> m Dazzle.ShortcutChord.ShortcutChord), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeGetChordForCommandMethodInfo a signature where
overloadedMethod = shortcutThemeGetChordForCommand
instance O.OverloadedMethodInfo ShortcutThemeGetChordForCommandMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeGetChordForCommand",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeGetChordForCommand"
})
#endif
foreign import ccall "dzl_shortcut_theme_get_name" dzl_shortcut_theme_get_name ::
Ptr ShortcutTheme ->
IO CString
shortcutThemeGetName ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> m T.Text
shortcutThemeGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> m Text
shortcutThemeGetName 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
result <- Ptr ShortcutTheme -> IO CString
dzl_shortcut_theme_get_name Ptr ShortcutTheme
self'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutThemeGetName" 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 ShortcutThemeGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeGetNameMethodInfo a signature where
overloadedMethod = shortcutThemeGetName
instance O.OverloadedMethodInfo ShortcutThemeGetNameMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeGetName",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeGetName"
})
#endif
foreign import ccall "dzl_shortcut_theme_get_parent" dzl_shortcut_theme_get_parent ::
Ptr ShortcutTheme ->
IO (Ptr ShortcutTheme)
shortcutThemeGetParent ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> m (Maybe ShortcutTheme)
shortcutThemeGetParent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> m (Maybe ShortcutTheme)
shortcutThemeGetParent a
self = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr ShortcutTheme
result <- Ptr ShortcutTheme -> IO (Ptr ShortcutTheme)
dzl_shortcut_theme_get_parent Ptr ShortcutTheme
self'
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
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
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 ShortcutThemeGetParentMethodInfo
instance (signature ~ (m (Maybe ShortcutTheme)), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeGetParentMethodInfo a signature where
overloadedMethod = shortcutThemeGetParent
instance O.OverloadedMethodInfo ShortcutThemeGetParentMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeGetParent",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeGetParent"
})
#endif
foreign import ccall "dzl_shortcut_theme_get_parent_name" dzl_shortcut_theme_get_parent_name ::
Ptr ShortcutTheme ->
IO CString
shortcutThemeGetParentName ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> m (Maybe T.Text)
shortcutThemeGetParentName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> m (Maybe Text)
shortcutThemeGetParentName a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
result <- Ptr ShortcutTheme -> IO CString
dzl_shortcut_theme_get_parent_name Ptr ShortcutTheme
self'
Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeGetParentNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeGetParentNameMethodInfo a signature where
overloadedMethod = shortcutThemeGetParentName
instance O.OverloadedMethodInfo ShortcutThemeGetParentNameMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeGetParentName",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeGetParentName"
})
#endif
foreign import ccall "dzl_shortcut_theme_get_subtitle" dzl_shortcut_theme_get_subtitle ::
Ptr ShortcutTheme ->
IO CString
shortcutThemeGetSubtitle ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> m T.Text
shortcutThemeGetSubtitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> m Text
shortcutThemeGetSubtitle 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
result <- Ptr ShortcutTheme -> IO CString
dzl_shortcut_theme_get_subtitle Ptr ShortcutTheme
self'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutThemeGetSubtitle" 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 ShortcutThemeGetSubtitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeGetSubtitleMethodInfo a signature where
overloadedMethod = shortcutThemeGetSubtitle
instance O.OverloadedMethodInfo ShortcutThemeGetSubtitleMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeGetSubtitle",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeGetSubtitle"
})
#endif
foreign import ccall "dzl_shortcut_theme_get_title" dzl_shortcut_theme_get_title ::
Ptr ShortcutTheme ->
IO CString
shortcutThemeGetTitle ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> m T.Text
shortcutThemeGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> m Text
shortcutThemeGetTitle 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
result <- Ptr ShortcutTheme -> IO CString
dzl_shortcut_theme_get_title Ptr ShortcutTheme
self'
Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutThemeGetTitle" 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 ShortcutThemeGetTitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeGetTitleMethodInfo a signature where
overloadedMethod = shortcutThemeGetTitle
instance O.OverloadedMethodInfo ShortcutThemeGetTitleMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeGetTitle",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeGetTitle"
})
#endif
foreign import ccall "dzl_shortcut_theme_load_from_data" dzl_shortcut_theme_load_from_data ::
Ptr ShortcutTheme ->
CString ->
DI.Int64 ->
Ptr (Ptr GError) ->
IO CInt
shortcutThemeLoadFromData ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> T.Text
-> DI.Int64
-> m ()
shortcutThemeLoadFromData :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> Int64 -> m ()
shortcutThemeLoadFromData a
self Text
data_ Int64
len = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
data_' <- Text -> IO CString
textToCString Text
data_
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ShortcutTheme
-> CString -> Int64 -> Ptr (Ptr GError) -> IO CInt
dzl_shortcut_theme_load_from_data Ptr ShortcutTheme
self' CString
data_' Int64
len
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
data_'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) (do
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
data_'
)
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeLoadFromDataMethodInfo
instance (signature ~ (T.Text -> DI.Int64 -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeLoadFromDataMethodInfo a signature where
overloadedMethod = shortcutThemeLoadFromData
instance O.OverloadedMethodInfo ShortcutThemeLoadFromDataMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeLoadFromData",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeLoadFromData"
})
#endif
foreign import ccall "dzl_shortcut_theme_load_from_file" dzl_shortcut_theme_load_from_file ::
Ptr ShortcutTheme ->
Ptr Gio.File.File ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
shortcutThemeLoadFromFile ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) =>
a
-> b
-> Maybe (c)
-> m ()
shortcutThemeLoadFromFile :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsShortcutTheme a, IsFile b,
IsCancellable c) =>
a -> b -> Maybe c -> m ()
shortcutThemeLoadFromFile a
self b
file Maybe c
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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr File
file' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
file
Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
Maybe c
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 c
jCancellable -> do
Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ShortcutTheme
-> Ptr File -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
dzl_shortcut_theme_load_from_file Ptr ShortcutTheme
self' Ptr File
file' Ptr Cancellable
maybeCancellable
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
file
Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) (do
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeLoadFromFileMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsShortcutTheme a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod ShortcutThemeLoadFromFileMethodInfo a signature where
overloadedMethod = shortcutThemeLoadFromFile
instance O.OverloadedMethodInfo ShortcutThemeLoadFromFileMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeLoadFromFile",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeLoadFromFile"
})
#endif
foreign import ccall "dzl_shortcut_theme_load_from_path" dzl_shortcut_theme_load_from_path ::
Ptr ShortcutTheme ->
CString ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
shortcutThemeLoadFromPath ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a, Gio.Cancellable.IsCancellable b) =>
a
-> T.Text
-> Maybe (b)
-> m ()
shortcutThemeLoadFromPath :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutTheme a, IsCancellable b) =>
a -> Text -> Maybe b -> m ()
shortcutThemeLoadFromPath a
self Text
path 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
path' <- Text -> IO CString
textToCString Text
path
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'
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ShortcutTheme
-> CString -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
dzl_shortcut_theme_load_from_path Ptr ShortcutTheme
self' CString
path' 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
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) (do
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
)
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeLoadFromPathMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m ()), MonadIO m, IsShortcutTheme a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ShortcutThemeLoadFromPathMethodInfo a signature where
overloadedMethod = shortcutThemeLoadFromPath
instance O.OverloadedMethodInfo ShortcutThemeLoadFromPathMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeLoadFromPath",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeLoadFromPath"
})
#endif
foreign import ccall "dzl_shortcut_theme_remove_css_resource" dzl_shortcut_theme_remove_css_resource ::
Ptr ShortcutTheme ->
CString ->
IO ()
shortcutThemeRemoveCssResource ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> T.Text
-> m ()
shortcutThemeRemoveCssResource :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> m ()
shortcutThemeRemoveCssResource a
self Text
path = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
path' <- Text -> IO CString
textToCString Text
path
Ptr ShortcutTheme -> CString -> IO ()
dzl_shortcut_theme_remove_css_resource Ptr ShortcutTheme
self' CString
path'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeRemoveCssResourceMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeRemoveCssResourceMethodInfo a signature where
overloadedMethod = shortcutThemeRemoveCssResource
instance O.OverloadedMethodInfo ShortcutThemeRemoveCssResourceMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeRemoveCssResource",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeRemoveCssResource"
})
#endif
foreign import ccall "dzl_shortcut_theme_save_to_file" dzl_shortcut_theme_save_to_file ::
Ptr ShortcutTheme ->
Ptr Gio.File.File ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
shortcutThemeSaveToFile ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) =>
a
-> b
-> Maybe (c)
-> m ()
shortcutThemeSaveToFile :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsShortcutTheme a, IsFile b,
IsCancellable c) =>
a -> b -> Maybe c -> m ()
shortcutThemeSaveToFile a
self b
file Maybe c
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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr File
file' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
file
Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
Maybe c
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 c
jCancellable -> do
Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ShortcutTheme
-> Ptr File -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
dzl_shortcut_theme_save_to_file Ptr ShortcutTheme
self' Ptr File
file' Ptr Cancellable
maybeCancellable
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
file
Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) (do
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSaveToFileMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsShortcutTheme a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod ShortcutThemeSaveToFileMethodInfo a signature where
overloadedMethod = shortcutThemeSaveToFile
instance O.OverloadedMethodInfo ShortcutThemeSaveToFileMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSaveToFile",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSaveToFile"
})
#endif
foreign import ccall "dzl_shortcut_theme_save_to_path" dzl_shortcut_theme_save_to_path ::
Ptr ShortcutTheme ->
CString ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
shortcutThemeSaveToPath ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a, Gio.Cancellable.IsCancellable b) =>
a
-> T.Text
-> Maybe (b)
-> m ()
shortcutThemeSaveToPath :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutTheme a, IsCancellable b) =>
a -> Text -> Maybe b -> m ()
shortcutThemeSaveToPath a
self Text
path 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
path' <- Text -> IO CString
textToCString Text
path
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'
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ShortcutTheme
-> CString -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
dzl_shortcut_theme_save_to_path Ptr ShortcutTheme
self' CString
path' 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
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) (do
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
)
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSaveToPathMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m ()), MonadIO m, IsShortcutTheme a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ShortcutThemeSaveToPathMethodInfo a signature where
overloadedMethod = shortcutThemeSaveToPath
instance O.OverloadedMethodInfo ShortcutThemeSaveToPathMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSaveToPath",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSaveToPath"
})
#endif
foreign import ccall "dzl_shortcut_theme_save_to_stream" dzl_shortcut_theme_save_to_stream ::
Ptr ShortcutTheme ->
Ptr Gio.OutputStream.OutputStream ->
Ptr Gio.Cancellable.Cancellable ->
Ptr (Ptr GError) ->
IO CInt
shortcutThemeSaveToStream ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a, Gio.OutputStream.IsOutputStream b, Gio.Cancellable.IsCancellable c) =>
a
-> b
-> Maybe (c)
-> m ()
shortcutThemeSaveToStream :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsShortcutTheme a, IsOutputStream b,
IsCancellable c) =>
a -> b -> Maybe c -> m ()
shortcutThemeSaveToStream a
self b
stream Maybe c
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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
Ptr OutputStream
stream' <- b -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
stream
Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
Maybe c
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 c
jCancellable -> do
Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ShortcutTheme
-> Ptr OutputStream
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
dzl_shortcut_theme_save_to_stream Ptr ShortcutTheme
self' Ptr OutputStream
stream' Ptr Cancellable
maybeCancellable
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
stream
Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) (do
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
)
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSaveToStreamMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsShortcutTheme a, Gio.OutputStream.IsOutputStream b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod ShortcutThemeSaveToStreamMethodInfo a signature where
overloadedMethod = shortcutThemeSaveToStream
instance O.OverloadedMethodInfo ShortcutThemeSaveToStreamMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSaveToStream",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSaveToStream"
})
#endif
foreign import ccall "dzl_shortcut_theme_set_accel_for_action" dzl_shortcut_theme_set_accel_for_action ::
Ptr ShortcutTheme ->
CString ->
CString ->
CUInt ->
IO ()
shortcutThemeSetAccelForAction ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> T.Text
-> T.Text
-> [Dazzle.Flags.ShortcutPhase]
-> m ()
shortcutThemeSetAccelForAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> Text -> [ShortcutPhase] -> m ()
shortcutThemeSetAccelForAction a
self Text
detailedActionName Text
accel [ShortcutPhase]
phase = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
detailedActionName' <- Text -> IO CString
textToCString Text
detailedActionName
CString
accel' <- Text -> IO CString
textToCString Text
accel
let phase' :: CUInt
phase' = [ShortcutPhase] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ShortcutPhase]
phase
Ptr ShortcutTheme -> CString -> CString -> CUInt -> IO ()
dzl_shortcut_theme_set_accel_for_action Ptr ShortcutTheme
self' CString
detailedActionName' CString
accel' CUInt
phase'
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
accel'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSetAccelForActionMethodInfo
instance (signature ~ (T.Text -> T.Text -> [Dazzle.Flags.ShortcutPhase] -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeSetAccelForActionMethodInfo a signature where
overloadedMethod = shortcutThemeSetAccelForAction
instance O.OverloadedMethodInfo ShortcutThemeSetAccelForActionMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSetAccelForAction",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSetAccelForAction"
})
#endif
foreign import ccall "dzl_shortcut_theme_set_accel_for_command" dzl_shortcut_theme_set_accel_for_command ::
Ptr ShortcutTheme ->
CString ->
CString ->
CUInt ->
IO ()
shortcutThemeSetAccelForCommand ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> Maybe (T.Text)
-> Maybe (T.Text)
-> [Dazzle.Flags.ShortcutPhase]
-> m ()
shortcutThemeSetAccelForCommand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Maybe Text -> Maybe Text -> [ShortcutPhase] -> m ()
shortcutThemeSetAccelForCommand a
self Maybe Text
command Maybe Text
accel [ShortcutPhase]
phase = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
maybeCommand <- case Maybe Text
command 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
jCommand -> do
CString
jCommand' <- Text -> IO CString
textToCString Text
jCommand
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jCommand'
CString
maybeAccel <- case Maybe Text
accel 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
jAccel -> do
CString
jAccel' <- Text -> IO CString
textToCString Text
jAccel
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jAccel'
let phase' :: CUInt
phase' = [ShortcutPhase] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ShortcutPhase]
phase
Ptr ShortcutTheme -> CString -> CString -> CUInt -> IO ()
dzl_shortcut_theme_set_accel_for_command Ptr ShortcutTheme
self' CString
maybeCommand CString
maybeAccel CUInt
phase'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCommand
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeAccel
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSetAccelForCommandMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (T.Text) -> [Dazzle.Flags.ShortcutPhase] -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeSetAccelForCommandMethodInfo a signature where
overloadedMethod = shortcutThemeSetAccelForCommand
instance O.OverloadedMethodInfo ShortcutThemeSetAccelForCommandMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSetAccelForCommand",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSetAccelForCommand"
})
#endif
foreign import ccall "dzl_shortcut_theme_set_chord_for_action" dzl_shortcut_theme_set_chord_for_action ::
Ptr ShortcutTheme ->
CString ->
Ptr Dazzle.ShortcutChord.ShortcutChord ->
CUInt ->
IO ()
shortcutThemeSetChordForAction ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> T.Text
-> Dazzle.ShortcutChord.ShortcutChord
-> [Dazzle.Flags.ShortcutPhase]
-> m ()
shortcutThemeSetChordForAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> ShortcutChord -> [ShortcutPhase] -> m ()
shortcutThemeSetChordForAction a
self Text
detailedActionName ShortcutChord
chord [ShortcutPhase]
phase = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
detailedActionName' <- Text -> IO CString
textToCString Text
detailedActionName
Ptr ShortcutChord
chord' <- ShortcutChord -> IO (Ptr ShortcutChord)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChord
chord
let phase' :: CUInt
phase' = [ShortcutPhase] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ShortcutPhase]
phase
Ptr ShortcutTheme -> CString -> Ptr ShortcutChord -> CUInt -> IO ()
dzl_shortcut_theme_set_chord_for_action Ptr ShortcutTheme
self' CString
detailedActionName' Ptr ShortcutChord
chord' CUInt
phase'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
ShortcutChord -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChord
chord
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
detailedActionName'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSetChordForActionMethodInfo
instance (signature ~ (T.Text -> Dazzle.ShortcutChord.ShortcutChord -> [Dazzle.Flags.ShortcutPhase] -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeSetChordForActionMethodInfo a signature where
overloadedMethod = shortcutThemeSetChordForAction
instance O.OverloadedMethodInfo ShortcutThemeSetChordForActionMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSetChordForAction",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSetChordForAction"
})
#endif
foreign import ccall "dzl_shortcut_theme_set_chord_for_command" dzl_shortcut_theme_set_chord_for_command ::
Ptr ShortcutTheme ->
CString ->
Ptr Dazzle.ShortcutChord.ShortcutChord ->
CUInt ->
IO ()
shortcutThemeSetChordForCommand ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> Maybe (T.Text)
-> Maybe (Dazzle.ShortcutChord.ShortcutChord)
-> [Dazzle.Flags.ShortcutPhase]
-> m ()
shortcutThemeSetChordForCommand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Maybe Text -> Maybe ShortcutChord -> [ShortcutPhase] -> m ()
shortcutThemeSetChordForCommand a
self Maybe Text
command Maybe ShortcutChord
chord [ShortcutPhase]
phase = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
maybeCommand <- case Maybe Text
command 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
jCommand -> do
CString
jCommand' <- Text -> IO CString
textToCString Text
jCommand
CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jCommand'
Ptr ShortcutChord
maybeChord <- case Maybe ShortcutChord
chord of
Maybe ShortcutChord
Nothing -> Ptr ShortcutChord -> IO (Ptr ShortcutChord)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ShortcutChord
forall a. Ptr a
nullPtr
Just ShortcutChord
jChord -> do
Ptr ShortcutChord
jChord' <- ShortcutChord -> IO (Ptr ShortcutChord)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChord
jChord
Ptr ShortcutChord -> IO (Ptr ShortcutChord)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ShortcutChord
jChord'
let phase' :: CUInt
phase' = [ShortcutPhase] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ShortcutPhase]
phase
Ptr ShortcutTheme -> CString -> Ptr ShortcutChord -> CUInt -> IO ()
dzl_shortcut_theme_set_chord_for_command Ptr ShortcutTheme
self' CString
maybeCommand Ptr ShortcutChord
maybeChord CUInt
phase'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
Maybe ShortcutChord -> (ShortcutChord -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe ShortcutChord
chord ShortcutChord -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCommand
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSetChordForCommandMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (Dazzle.ShortcutChord.ShortcutChord) -> [Dazzle.Flags.ShortcutPhase] -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeSetChordForCommandMethodInfo a signature where
overloadedMethod = shortcutThemeSetChordForCommand
instance O.OverloadedMethodInfo ShortcutThemeSetChordForCommandMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSetChordForCommand",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSetChordForCommand"
})
#endif
foreign import ccall "dzl_shortcut_theme_set_parent_name" dzl_shortcut_theme_set_parent_name ::
Ptr ShortcutTheme ->
CString ->
IO ()
shortcutThemeSetParentName ::
(B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
a
-> T.Text
-> m ()
shortcutThemeSetParentName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> m ()
shortcutThemeSetParentName a
self Text
parentName = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
CString
parentName' <- Text -> IO CString
textToCString Text
parentName
Ptr ShortcutTheme -> CString -> IO ()
dzl_shortcut_theme_set_parent_name Ptr ShortcutTheme
self' CString
parentName'
a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
parentName'
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSetParentNameMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeSetParentNameMethodInfo a signature where
overloadedMethod = shortcutThemeSetParentName
instance O.OverloadedMethodInfo ShortcutThemeSetParentNameMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSetParentName",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSetParentName"
})
#endif