{-# LANGUAGE TypeApplications #-}


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

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

module GI.Dazzle.Objects.ShortcutTooltip
    ( 

-- * Exported types
    ShortcutTooltip(..)                     ,
    IsShortcutTooltip                       ,
    toShortcutTooltip                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAccel]("GI.Dazzle.Objects.ShortcutTooltip#g:method:getAccel"), [getCommandId]("GI.Dazzle.Objects.ShortcutTooltip#g:method:getCommandId"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTitle]("GI.Dazzle.Objects.ShortcutTooltip#g:method:getTitle"), [getWidget]("GI.Dazzle.Objects.ShortcutTooltip#g:method:getWidget").
-- 
-- ==== Setters
-- [setAccel]("GI.Dazzle.Objects.ShortcutTooltip#g:method:setAccel"), [setCommandId]("GI.Dazzle.Objects.ShortcutTooltip#g:method:setCommandId"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTitle]("GI.Dazzle.Objects.ShortcutTooltip#g:method:setTitle"), [setWidget]("GI.Dazzle.Objects.ShortcutTooltip#g:method:setWidget").

#if defined(ENABLE_OVERLOADING)
    ResolveShortcutTooltipMethod            ,
#endif

-- ** getAccel #method:getAccel#

#if defined(ENABLE_OVERLOADING)
    ShortcutTooltipGetAccelMethodInfo       ,
#endif
    shortcutTooltipGetAccel                 ,


-- ** getCommandId #method:getCommandId#

#if defined(ENABLE_OVERLOADING)
    ShortcutTooltipGetCommandIdMethodInfo   ,
#endif
    shortcutTooltipGetCommandId             ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    ShortcutTooltipGetTitleMethodInfo       ,
#endif
    shortcutTooltipGetTitle                 ,


-- ** getWidget #method:getWidget#

#if defined(ENABLE_OVERLOADING)
    ShortcutTooltipGetWidgetMethodInfo      ,
#endif
    shortcutTooltipGetWidget                ,


-- ** new #method:new#

    shortcutTooltipNew                      ,


-- ** setAccel #method:setAccel#

#if defined(ENABLE_OVERLOADING)
    ShortcutTooltipSetAccelMethodInfo       ,
#endif
    shortcutTooltipSetAccel                 ,


-- ** setCommandId #method:setCommandId#

#if defined(ENABLE_OVERLOADING)
    ShortcutTooltipSetCommandIdMethodInfo   ,
#endif
    shortcutTooltipSetCommandId             ,


-- ** setTitle #method:setTitle#

#if defined(ENABLE_OVERLOADING)
    ShortcutTooltipSetTitleMethodInfo       ,
#endif
    shortcutTooltipSetTitle                 ,


-- ** setWidget #method:setWidget#

#if defined(ENABLE_OVERLOADING)
    ShortcutTooltipSetWidgetMethodInfo      ,
#endif
    shortcutTooltipSetWidget                ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    ShortcutTooltipAccelPropertyInfo        ,
#endif
    clearShortcutTooltipAccel               ,
    constructShortcutTooltipAccel           ,
    getShortcutTooltipAccel                 ,
    setShortcutTooltipAccel                 ,
#if defined(ENABLE_OVERLOADING)
    shortcutTooltipAccel                    ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    ShortcutTooltipCommandIdPropertyInfo    ,
#endif
    constructShortcutTooltipCommandId       ,
    getShortcutTooltipCommandId             ,
    setShortcutTooltipCommandId             ,
#if defined(ENABLE_OVERLOADING)
    shortcutTooltipCommandId                ,
#endif


-- ** title #attr:title#
-- | The \"title\" property contains an alternate title for the tooltip
-- instead of discovering the title from the shortcut manager.
-- 
-- /Since: 3.32/

#if defined(ENABLE_OVERLOADING)
    ShortcutTooltipTitlePropertyInfo        ,
#endif
    clearShortcutTooltipTitle               ,
    constructShortcutTooltipTitle           ,
    getShortcutTooltipTitle                 ,
    setShortcutTooltipTitle                 ,
#if defined(ENABLE_OVERLOADING)
    shortcutTooltipTitle                    ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    ShortcutTooltipWidgetPropertyInfo       ,
#endif
    clearShortcutTooltipWidget              ,
    constructShortcutTooltipWidget          ,
    getShortcutTooltipWidget                ,
    setShortcutTooltipWidget                ,
#if defined(ENABLE_OVERLOADING)
    shortcutTooltipWidget                   ,
#endif




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#endif

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

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

foreign import ccall "dzl_shortcut_tooltip_get_type"
    c_dzl_shortcut_tooltip_get_type :: IO B.Types.GType

instance B.Types.TypedObject ShortcutTooltip where
    glibType :: IO GType
glibType = IO GType
c_dzl_shortcut_tooltip_get_type

instance B.Types.GObject ShortcutTooltip

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveShortcutTooltipMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveShortcutTooltipMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveShortcutTooltipMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveShortcutTooltipMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveShortcutTooltipMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveShortcutTooltipMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveShortcutTooltipMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveShortcutTooltipMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveShortcutTooltipMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveShortcutTooltipMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveShortcutTooltipMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveShortcutTooltipMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveShortcutTooltipMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveShortcutTooltipMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveShortcutTooltipMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveShortcutTooltipMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveShortcutTooltipMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveShortcutTooltipMethod "getAccel" o = ShortcutTooltipGetAccelMethodInfo
    ResolveShortcutTooltipMethod "getCommandId" o = ShortcutTooltipGetCommandIdMethodInfo
    ResolveShortcutTooltipMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveShortcutTooltipMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveShortcutTooltipMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveShortcutTooltipMethod "getTitle" o = ShortcutTooltipGetTitleMethodInfo
    ResolveShortcutTooltipMethod "getWidget" o = ShortcutTooltipGetWidgetMethodInfo
    ResolveShortcutTooltipMethod "setAccel" o = ShortcutTooltipSetAccelMethodInfo
    ResolveShortcutTooltipMethod "setCommandId" o = ShortcutTooltipSetCommandIdMethodInfo
    ResolveShortcutTooltipMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveShortcutTooltipMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveShortcutTooltipMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveShortcutTooltipMethod "setTitle" o = ShortcutTooltipSetTitleMethodInfo
    ResolveShortcutTooltipMethod "setWidget" o = ShortcutTooltipSetWidgetMethodInfo
    ResolveShortcutTooltipMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "accel"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

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

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

-- | Set the value of the “@accel@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #accel
-- @
clearShortcutTooltipAccel :: (MonadIO m, IsShortcutTooltip o) => o -> m ()
clearShortcutTooltipAccel :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTooltip o) =>
o -> m ()
clearShortcutTooltipAccel 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
"accel" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

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

-- VVV Prop "command-id"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just False)

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

-- | Set the value of the “@command-id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutTooltip [ #commandId 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutTooltipCommandId :: (MonadIO m, IsShortcutTooltip o) => o -> T.Text -> m ()
setShortcutTooltipCommandId :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTooltip o) =>
o -> Text -> m ()
setShortcutTooltipCommandId 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
"command-id" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

#if defined(ENABLE_OVERLOADING)
data ShortcutTooltipCommandIdPropertyInfo
instance AttrInfo ShortcutTooltipCommandIdPropertyInfo where
    type AttrAllowedOps ShortcutTooltipCommandIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ShortcutTooltipCommandIdPropertyInfo = IsShortcutTooltip
    type AttrSetTypeConstraint ShortcutTooltipCommandIdPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ShortcutTooltipCommandIdPropertyInfo = (~) T.Text
    type AttrTransferType ShortcutTooltipCommandIdPropertyInfo = T.Text
    type AttrGetType ShortcutTooltipCommandIdPropertyInfo = (Maybe T.Text)
    type AttrLabel ShortcutTooltipCommandIdPropertyInfo = "command-id"
    type AttrOrigin ShortcutTooltipCommandIdPropertyInfo = ShortcutTooltip
    attrGet = getShortcutTooltipCommandId
    attrSet = setShortcutTooltipCommandId
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutTooltipCommandId
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTooltip.commandId"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTooltip.html#g:attr:commandId"
        })
#endif

-- VVV Prop "title"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutTooltip [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutTooltipTitle :: (MonadIO m, IsShortcutTooltip o) => o -> T.Text -> m ()
setShortcutTooltipTitle :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTooltip o) =>
o -> Text -> m ()
setShortcutTooltipTitle 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)

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

-- | Set the value of the “@title@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #title
-- @
clearShortcutTooltipTitle :: (MonadIO m, IsShortcutTooltip o) => o -> m ()
clearShortcutTooltipTitle :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTooltip o) =>
o -> m ()
clearShortcutTooltipTitle 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 ShortcutTooltipTitlePropertyInfo
instance AttrInfo ShortcutTooltipTitlePropertyInfo where
    type AttrAllowedOps ShortcutTooltipTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutTooltipTitlePropertyInfo = IsShortcutTooltip
    type AttrSetTypeConstraint ShortcutTooltipTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ShortcutTooltipTitlePropertyInfo = (~) T.Text
    type AttrTransferType ShortcutTooltipTitlePropertyInfo = T.Text
    type AttrGetType ShortcutTooltipTitlePropertyInfo = (Maybe T.Text)
    type AttrLabel ShortcutTooltipTitlePropertyInfo = "title"
    type AttrOrigin ShortcutTooltipTitlePropertyInfo = ShortcutTooltip
    attrGet = getShortcutTooltipTitle
    attrSet = setShortcutTooltipTitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutTooltipTitle
    attrClear = clearShortcutTooltipTitle
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTooltip.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTooltip.html#g:attr:title"
        })
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@widget@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructShortcutTooltipWidget :: (IsShortcutTooltip o, MIO.MonadIO m, Gtk.Widget.IsWidget a) => a -> m (GValueConstruct o)
constructShortcutTooltipWidget :: forall o (m :: * -> *) a.
(IsShortcutTooltip o, MonadIO m, IsWidget a) =>
a -> m (GValueConstruct o)
constructShortcutTooltipWidget a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"widget" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@widget@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #widget
-- @
clearShortcutTooltipWidget :: (MonadIO m, IsShortcutTooltip o) => o -> m ()
clearShortcutTooltipWidget :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTooltip o) =>
o -> m ()
clearShortcutTooltipWidget 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 Widget -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"widget" (Maybe Widget
forall a. Maybe a
Nothing :: Maybe Gtk.Widget.Widget)

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ShortcutTooltip
type instance O.AttributeList ShortcutTooltip = ShortcutTooltipAttributeList
type ShortcutTooltipAttributeList = ('[ '("accel", ShortcutTooltipAccelPropertyInfo), '("commandId", ShortcutTooltipCommandIdPropertyInfo), '("title", ShortcutTooltipTitlePropertyInfo), '("widget", ShortcutTooltipWidgetPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
shortcutTooltipAccel :: AttrLabelProxy "accel"
shortcutTooltipAccel = AttrLabelProxy

shortcutTooltipCommandId :: AttrLabelProxy "commandId"
shortcutTooltipCommandId = AttrLabelProxy

shortcutTooltipTitle :: AttrLabelProxy "title"
shortcutTooltipTitle = AttrLabelProxy

shortcutTooltipWidget :: AttrLabelProxy "widget"
shortcutTooltipWidget = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "dzl_shortcut_tooltip_new" dzl_shortcut_tooltip_new :: 
    IO (Ptr ShortcutTooltip)

-- | Create a new t'GI.Dazzle.Objects.ShortcutTooltip.ShortcutTooltip'.
-- 
-- /Since: 3.32/
shortcutTooltipNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ShortcutTooltip
    -- ^ __Returns:__ a newly created t'GI.Dazzle.Objects.ShortcutTooltip.ShortcutTooltip'
shortcutTooltipNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m ShortcutTooltip
shortcutTooltipNew  = IO ShortcutTooltip -> m ShortcutTooltip
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutTooltip -> m ShortcutTooltip)
-> IO ShortcutTooltip -> m ShortcutTooltip
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutTooltip
result <- IO (Ptr ShortcutTooltip)
dzl_shortcut_tooltip_new
    Text -> Ptr ShortcutTooltip -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutTooltipNew" Ptr ShortcutTooltip
result
    ShortcutTooltip
result' <- ((ManagedPtr ShortcutTooltip -> ShortcutTooltip)
-> Ptr ShortcutTooltip -> IO ShortcutTooltip
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ShortcutTooltip -> ShortcutTooltip
ShortcutTooltip) Ptr ShortcutTooltip
result
    ShortcutTooltip -> IO ShortcutTooltip
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutTooltip
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ShortcutTooltip::get_accel
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTooltip" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutTooltip"
--                 , 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_tooltip_get_accel" dzl_shortcut_tooltip_get_accel :: 
    Ptr ShortcutTooltip ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTooltip"})
    IO CString

-- | Gets the [ShortcutTooltip:accel]("GI.Dazzle.Objects.ShortcutTooltip#g:attr:accel") property, which can be used to override
-- the commands accel.
-- 
-- /Since: 3.32/
shortcutTooltipGetAccel ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTooltip a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutTooltip.ShortcutTooltip'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ an override accel, or 'P.Nothing'
shortcutTooltipGetAccel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTooltip a) =>
a -> m (Maybe Text)
shortcutTooltipGetAccel 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 ShortcutTooltip
self' <- a -> IO (Ptr ShortcutTooltip)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ShortcutTooltip -> IO CString
dzl_shortcut_tooltip_get_accel Ptr ShortcutTooltip
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 ShortcutTooltipGetAccelMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsShortcutTooltip a) => O.OverloadedMethod ShortcutTooltipGetAccelMethodInfo a signature where
    overloadedMethod = shortcutTooltipGetAccel

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


#endif

-- method ShortcutTooltip::get_command_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTooltip" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutTooltip"
--                 , 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_tooltip_get_command_id" dzl_shortcut_tooltip_get_command_id :: 
    Ptr ShortcutTooltip ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTooltip"})
    IO CString

-- | Gets the [ShortcutTooltip:commandId]("GI.Dazzle.Objects.ShortcutTooltip#g:attr:commandId") property.
-- 
-- /Since: 3.32/
shortcutTooltipGetCommandId ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTooltip a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutTooltip.ShortcutTooltip'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a string containing the command id
shortcutTooltipGetCommandId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTooltip a) =>
a -> m (Maybe Text)
shortcutTooltipGetCommandId 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 ShortcutTooltip
self' <- a -> IO (Ptr ShortcutTooltip)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ShortcutTooltip -> IO CString
dzl_shortcut_tooltip_get_command_id Ptr ShortcutTooltip
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 ShortcutTooltipGetCommandIdMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsShortcutTooltip a) => O.OverloadedMethod ShortcutTooltipGetCommandIdMethodInfo a signature where
    overloadedMethod = shortcutTooltipGetCommandId

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


#endif

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

-- | Gets the [ShortcutTooltip:title]("GI.Dazzle.Objects.ShortcutTooltip#g:attr:title") property, if set.
-- 
-- /Since: 3.32/
shortcutTooltipGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTooltip a) =>
    a
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a string containing the title, or 'P.Nothing'
shortcutTooltipGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTooltip a) =>
a -> m (Maybe Text)
shortcutTooltipGetTitle 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 ShortcutTooltip
self' <- a -> IO (Ptr ShortcutTooltip)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ShortcutTooltip -> IO CString
dzl_shortcut_tooltip_get_title Ptr ShortcutTooltip
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 ShortcutTooltipGetTitleMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsShortcutTooltip a) => O.OverloadedMethod ShortcutTooltipGetTitleMethodInfo a signature where
    overloadedMethod = shortcutTooltipGetTitle

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


#endif

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

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

-- | Gets the t'GI.Gtk.Objects.Widget.Widget' that the shortcut-tooltip is wrapping.
-- 
-- /Since: 3.32/
shortcutTooltipGetWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTooltip a) =>
    a
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ a t'GI.Gtk.Objects.Widget.Widget' or 'P.Nothing' if unset
shortcutTooltipGetWidget :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTooltip a) =>
a -> m (Maybe Widget)
shortcutTooltipGetWidget a
self = IO (Maybe Widget) -> m (Maybe Widget)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutTooltip
self' <- a -> IO (Ptr ShortcutTooltip)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
result <- Ptr ShortcutTooltip -> IO (Ptr Widget)
dzl_shortcut_tooltip_get_widget Ptr ShortcutTooltip
self'
    Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
result' -> do
        Widget
result'' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result'
        Widget -> IO Widget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Widget -> IO (Maybe Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data ShortcutTooltipGetWidgetMethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsShortcutTooltip a) => O.OverloadedMethod ShortcutTooltipGetWidgetMethodInfo a signature where
    overloadedMethod = shortcutTooltipGetWidget

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


#endif

-- method ShortcutTooltip::set_accel
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTooltip" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#DzlShortcutTooltip"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accel"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Sets the accelerator to use, or %NULL to unset\n  and use the default"
--                 , 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_tooltip_set_accel" dzl_shortcut_tooltip_set_accel :: 
    Ptr ShortcutTooltip ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTooltip"})
    CString ->                              -- accel : TBasicType TUTF8
    IO ()

-- | Allows overriding the accel that is used.
-- 
-- /Since: 3.32/
shortcutTooltipSetAccel ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTooltip a) =>
    a
    -- ^ /@self@/: t'GI.Dazzle.Objects.ShortcutTooltip.ShortcutTooltip'
    -> Maybe (T.Text)
    -- ^ /@accel@/: Sets the accelerator to use, or 'P.Nothing' to unset
    --   and use the default
    -> m ()
shortcutTooltipSetAccel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTooltip a) =>
a -> Maybe Text -> m ()
shortcutTooltipSetAccel a
self Maybe Text
accel = 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 ShortcutTooltip
self' <- a -> IO (Ptr ShortcutTooltip)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    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'
    Ptr ShortcutTooltip -> CString -> IO ()
dzl_shortcut_tooltip_set_accel Ptr ShortcutTooltip
self' CString
maybeAccel
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    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 ShortcutTooltipSetAccelMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsShortcutTooltip a) => O.OverloadedMethod ShortcutTooltipSetAccelMethodInfo a signature where
    overloadedMethod = shortcutTooltipSetAccel

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


#endif

-- method ShortcutTooltip::set_command_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTooltip" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutTooltip"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "command_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the command-id of the shortcut registered"
--                 , 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_tooltip_set_command_id" dzl_shortcut_tooltip_set_command_id :: 
    Ptr ShortcutTooltip ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTooltip"})
    CString ->                              -- command_id : TBasicType TUTF8
    IO ()

-- | This sets the [ShortcutTooltip:commandId]("GI.Dazzle.Objects.ShortcutTooltip#g:attr:commandId") property which denotes which
-- shortcut registered with libdazzle to display when a tooltip request is
-- received.
-- 
-- /Since: 3.32/
shortcutTooltipSetCommandId ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTooltip a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutTooltip.ShortcutTooltip'
    -> T.Text
    -- ^ /@commandId@/: the command-id of the shortcut registered
    -> m ()
shortcutTooltipSetCommandId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTooltip a) =>
a -> Text -> m ()
shortcutTooltipSetCommandId a
self Text
commandId = 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 ShortcutTooltip
self' <- a -> IO (Ptr ShortcutTooltip)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
commandId' <- Text -> IO CString
textToCString Text
commandId
    Ptr ShortcutTooltip -> CString -> IO ()
dzl_shortcut_tooltip_set_command_id Ptr ShortcutTooltip
self' CString
commandId'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commandId'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method ShortcutTooltip::set_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTooltip" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutTooltip"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a title for the tooltip, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets the [ShortcutTooltip:title]("GI.Dazzle.Objects.ShortcutTooltip#g:attr:title") property, which can be used to
-- override the default title for the tooltip as discovered from the
-- shortcut manager.
-- 
-- /Since: 3.32/
shortcutTooltipSetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTooltip a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutTooltip.ShortcutTooltip'
    -> Maybe (T.Text)
    -- ^ /@title@/: a title for the tooltip, or 'P.Nothing'
    -> m ()
shortcutTooltipSetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTooltip a) =>
a -> Maybe Text -> m ()
shortcutTooltipSetTitle a
self Maybe Text
title = 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 ShortcutTooltip
self' <- a -> IO (Ptr ShortcutTooltip)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeTitle <- case Maybe Text
title 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
jTitle -> do
            CString
jTitle' <- Text -> IO CString
textToCString Text
jTitle
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTitle'
    Ptr ShortcutTooltip -> CString -> IO ()
dzl_shortcut_tooltip_set_title Ptr ShortcutTooltip
self' CString
maybeTitle
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTitle
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method ShortcutTooltip::set_widget
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTooltip" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutTooltip"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkWidget or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets the widget to connect to the [Widget::queryTooltip]("GI.Gtk.Objects.Widget#g:signal:queryTooltip") signal.
-- 
-- If configured, the widget will be displayed with an appropriate tooltip
-- message matching the shortcut from [ShortcutTooltip:commandId]("GI.Dazzle.Objects.ShortcutTooltip#g:attr:commandId").
-- 
-- /Since: 3.32/
shortcutTooltipSetWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTooltip a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutTooltip.ShortcutTooltip'
    -> Maybe (b)
    -- ^ /@widget@/: a t'GI.Gtk.Objects.Widget.Widget' or 'P.Nothing'
    -> m ()
shortcutTooltipSetWidget :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutTooltip a, IsWidget b) =>
a -> Maybe b -> m ()
shortcutTooltipSetWidget a
self Maybe b
widget = 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 ShortcutTooltip
self' <- a -> IO (Ptr ShortcutTooltip)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
maybeWidget <- case Maybe b
widget of
        Maybe b
Nothing -> Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
        Just b
jWidget -> do
            Ptr Widget
jWidget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jWidget
            Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jWidget'
    Ptr ShortcutTooltip -> Ptr Widget -> IO ()
dzl_shortcut_tooltip_set_widget Ptr ShortcutTooltip
self' Ptr Widget
maybeWidget
    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
widget 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 ShortcutTooltipSetWidgetMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsShortcutTooltip a, Gtk.Widget.IsWidget b) => O.OverloadedMethod ShortcutTooltipSetWidgetMethodInfo a signature where
    overloadedMethod = shortcutTooltipSetWidget

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


#endif