{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Gtk.Objects.ShortcutsShortcut
    ( 
    ShortcutsShortcut(..)                   ,
    IsShortcutsShortcut                     ,
    toShortcutsShortcut                     ,
 
#if defined(ENABLE_OVERLOADING)
    ResolveShortcutsShortcutMethod          ,
#endif
 
#if defined(ENABLE_OVERLOADING)
    ShortcutsShortcutAccelSizeGroupPropertyInfo,
#endif
    clearShortcutsShortcutAccelSizeGroup    ,
    constructShortcutsShortcutAccelSizeGroup,
    setShortcutsShortcutAccelSizeGroup      ,
#if defined(ENABLE_OVERLOADING)
    shortcutsShortcutAccelSizeGroup         ,
#endif
#if defined(ENABLE_OVERLOADING)
    ShortcutsShortcutAcceleratorPropertyInfo,
#endif
    clearShortcutsShortcutAccelerator       ,
    constructShortcutsShortcutAccelerator   ,
    getShortcutsShortcutAccelerator         ,
    setShortcutsShortcutAccelerator         ,
#if defined(ENABLE_OVERLOADING)
    shortcutsShortcutAccelerator            ,
#endif
#if defined(ENABLE_OVERLOADING)
    ShortcutsShortcutActionNamePropertyInfo ,
#endif
    clearShortcutsShortcutActionName        ,
    constructShortcutsShortcutActionName    ,
    getShortcutsShortcutActionName          ,
    setShortcutsShortcutActionName          ,
#if defined(ENABLE_OVERLOADING)
    shortcutsShortcutActionName             ,
#endif
#if defined(ENABLE_OVERLOADING)
    ShortcutsShortcutDirectionPropertyInfo  ,
#endif
    constructShortcutsShortcutDirection     ,
    getShortcutsShortcutDirection           ,
    setShortcutsShortcutDirection           ,
#if defined(ENABLE_OVERLOADING)
    shortcutsShortcutDirection              ,
#endif
#if defined(ENABLE_OVERLOADING)
    ShortcutsShortcutIconPropertyInfo       ,
#endif
    clearShortcutsShortcutIcon              ,
    constructShortcutsShortcutIcon          ,
    getShortcutsShortcutIcon                ,
    setShortcutsShortcutIcon                ,
#if defined(ENABLE_OVERLOADING)
    shortcutsShortcutIcon                   ,
#endif
#if defined(ENABLE_OVERLOADING)
    ShortcutsShortcutIconSetPropertyInfo    ,
#endif
    constructShortcutsShortcutIconSet       ,
    getShortcutsShortcutIconSet             ,
    setShortcutsShortcutIconSet             ,
#if defined(ENABLE_OVERLOADING)
    shortcutsShortcutIconSet                ,
#endif
#if defined(ENABLE_OVERLOADING)
    ShortcutsShortcutShortcutTypePropertyInfo,
#endif
    constructShortcutsShortcutShortcutType  ,
    getShortcutsShortcutShortcutType        ,
    setShortcutsShortcutShortcutType        ,
#if defined(ENABLE_OVERLOADING)
    shortcutsShortcutShortcutType           ,
#endif
#if defined(ENABLE_OVERLOADING)
    ShortcutsShortcutSubtitlePropertyInfo   ,
#endif
    clearShortcutsShortcutSubtitle          ,
    constructShortcutsShortcutSubtitle      ,
    getShortcutsShortcutSubtitle            ,
    setShortcutsShortcutSubtitle            ,
#if defined(ENABLE_OVERLOADING)
    shortcutsShortcutSubtitle               ,
#endif
#if defined(ENABLE_OVERLOADING)
    ShortcutsShortcutSubtitleSetPropertyInfo,
#endif
    constructShortcutsShortcutSubtitleSet   ,
    getShortcutsShortcutSubtitleSet         ,
    setShortcutsShortcutSubtitleSet         ,
#if defined(ENABLE_OVERLOADING)
    shortcutsShortcutSubtitleSet            ,
#endif
#if defined(ENABLE_OVERLOADING)
    ShortcutsShortcutTitlePropertyInfo      ,
#endif
    clearShortcutsShortcutTitle             ,
    constructShortcutsShortcutTitle         ,
    getShortcutsShortcutTitle               ,
    setShortcutsShortcutTitle               ,
#if defined(ENABLE_OVERLOADING)
    shortcutsShortcutTitle                  ,
#endif
#if defined(ENABLE_OVERLOADING)
    ShortcutsShortcutTitleSizeGroupPropertyInfo,
#endif
    clearShortcutsShortcutTitleSizeGroup    ,
    constructShortcutsShortcutTitleSizeGroup,
    setShortcutsShortcutTitleSizeGroup      ,
#if defined(ENABLE_OVERLOADING)
    shortcutsShortcutTitleSizeGroup         ,
#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.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.Text as T
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 GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import {-# SOURCE #-} qualified GI.Gtk.Objects.SizeGroup as Gtk.SizeGroup
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
newtype ShortcutsShortcut = ShortcutsShortcut (SP.ManagedPtr ShortcutsShortcut)
    deriving (ShortcutsShortcut -> ShortcutsShortcut -> Bool
(ShortcutsShortcut -> ShortcutsShortcut -> Bool)
-> (ShortcutsShortcut -> ShortcutsShortcut -> Bool)
-> Eq ShortcutsShortcut
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShortcutsShortcut -> ShortcutsShortcut -> Bool
$c/= :: ShortcutsShortcut -> ShortcutsShortcut -> Bool
== :: ShortcutsShortcut -> ShortcutsShortcut -> Bool
$c== :: ShortcutsShortcut -> ShortcutsShortcut -> Bool
Eq)
instance SP.ManagedPtrNewtype ShortcutsShortcut where
    toManagedPtr :: ShortcutsShortcut -> ManagedPtr ShortcutsShortcut
toManagedPtr (ShortcutsShortcut ManagedPtr ShortcutsShortcut
p) = ManagedPtr ShortcutsShortcut
p
foreign import ccall "gtk_shortcuts_shortcut_get_type"
    c_gtk_shortcuts_shortcut_get_type :: IO B.Types.GType
instance B.Types.TypedObject ShortcutsShortcut where
    glibType :: IO GType
glibType = IO GType
c_gtk_shortcuts_shortcut_get_type
instance B.Types.GObject ShortcutsShortcut
class (SP.GObject o, O.IsDescendantOf ShortcutsShortcut o) => IsShortcutsShortcut o
instance (SP.GObject o, O.IsDescendantOf ShortcutsShortcut o) => IsShortcutsShortcut o
instance O.HasParentTypes ShortcutsShortcut
type instance O.ParentTypes ShortcutsShortcut = '[Gtk.Widget.Widget, GObject.Object.Object, Gtk.Accessible.Accessible, Gtk.Buildable.Buildable, Gtk.ConstraintTarget.ConstraintTarget]
toShortcutsShortcut :: (MIO.MonadIO m, IsShortcutsShortcut o) => o -> m ShortcutsShortcut
toShortcutsShortcut :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m ShortcutsShortcut
toShortcutsShortcut = IO ShortcutsShortcut -> m ShortcutsShortcut
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ShortcutsShortcut -> m ShortcutsShortcut)
-> (o -> IO ShortcutsShortcut) -> o -> m ShortcutsShortcut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr ShortcutsShortcut -> ShortcutsShortcut)
-> o -> IO ShortcutsShortcut
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr ShortcutsShortcut -> ShortcutsShortcut
ShortcutsShortcut
instance B.GValue.IsGValue (Maybe ShortcutsShortcut) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_shortcuts_shortcut_get_type
    gvalueSet_ :: Ptr GValue -> Maybe ShortcutsShortcut -> IO ()
gvalueSet_ Ptr GValue
gv Maybe ShortcutsShortcut
P.Nothing = Ptr GValue -> Ptr ShortcutsShortcut -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr ShortcutsShortcut
forall a. Ptr a
FP.nullPtr :: FP.Ptr ShortcutsShortcut)
    gvalueSet_ Ptr GValue
gv (P.Just ShortcutsShortcut
obj) = ShortcutsShortcut -> (Ptr ShortcutsShortcut -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ShortcutsShortcut
obj (Ptr GValue -> Ptr ShortcutsShortcut -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe ShortcutsShortcut)
gvalueGet_ Ptr GValue
gv = do
        Ptr ShortcutsShortcut
ptr <- Ptr GValue -> IO (Ptr ShortcutsShortcut)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr ShortcutsShortcut)
        if Ptr ShortcutsShortcut
ptr Ptr ShortcutsShortcut -> Ptr ShortcutsShortcut -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ShortcutsShortcut
forall a. Ptr a
FP.nullPtr
        then ShortcutsShortcut -> Maybe ShortcutsShortcut
forall a. a -> Maybe a
P.Just (ShortcutsShortcut -> Maybe ShortcutsShortcut)
-> IO ShortcutsShortcut -> IO (Maybe ShortcutsShortcut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr ShortcutsShortcut -> ShortcutsShortcut)
-> Ptr ShortcutsShortcut -> IO ShortcutsShortcut
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr ShortcutsShortcut -> ShortcutsShortcut
ShortcutsShortcut Ptr ShortcutsShortcut
ptr
        else Maybe ShortcutsShortcut -> IO (Maybe ShortcutsShortcut)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ShortcutsShortcut
forall a. Maybe a
P.Nothing
        
    
#if defined(ENABLE_OVERLOADING)
type family ResolveShortcutsShortcutMethod (t :: Symbol) (o :: *) :: * where
    ResolveShortcutsShortcutMethod "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
    ResolveShortcutsShortcutMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveShortcutsShortcutMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveShortcutsShortcutMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveShortcutsShortcutMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveShortcutsShortcutMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
    ResolveShortcutsShortcutMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveShortcutsShortcutMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveShortcutsShortcutMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveShortcutsShortcutMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveShortcutsShortcutMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveShortcutsShortcutMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveShortcutsShortcutMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveShortcutsShortcutMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveShortcutsShortcutMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveShortcutsShortcutMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveShortcutsShortcutMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveShortcutsShortcutMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveShortcutsShortcutMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveShortcutsShortcutMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveShortcutsShortcutMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveShortcutsShortcutMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveShortcutsShortcutMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveShortcutsShortcutMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveShortcutsShortcutMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveShortcutsShortcutMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
    ResolveShortcutsShortcutMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveShortcutsShortcutMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveShortcutsShortcutMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolveShortcutsShortcutMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolveShortcutsShortcutMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolveShortcutsShortcutMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolveShortcutsShortcutMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolveShortcutsShortcutMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolveShortcutsShortcutMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolveShortcutsShortcutMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolveShortcutsShortcutMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolveShortcutsShortcutMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveShortcutsShortcutMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolveShortcutsShortcutMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolveShortcutsShortcutMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveShortcutsShortcutMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveShortcutsShortcutMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolveShortcutsShortcutMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolveShortcutsShortcutMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolveShortcutsShortcutMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolveShortcutsShortcutMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveShortcutsShortcutMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveShortcutsShortcutMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolveShortcutsShortcutMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolveShortcutsShortcutMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveShortcutsShortcutMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveShortcutsShortcutMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveShortcutsShortcutMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveShortcutsShortcutMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveShortcutsShortcutMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveShortcutsShortcutMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveShortcutsShortcutMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveShortcutsShortcutMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
    ResolveShortcutsShortcutMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveShortcutsShortcutMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveShortcutsShortcutMethod "resetProperty" o = Gtk.Accessible.AccessibleResetPropertyMethodInfo
    ResolveShortcutsShortcutMethod "resetRelation" o = Gtk.Accessible.AccessibleResetRelationMethodInfo
    ResolveShortcutsShortcutMethod "resetState" o = Gtk.Accessible.AccessibleResetStateMethodInfo
    ResolveShortcutsShortcutMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveShortcutsShortcutMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
    ResolveShortcutsShortcutMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolveShortcutsShortcutMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolveShortcutsShortcutMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolveShortcutsShortcutMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveShortcutsShortcutMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveShortcutsShortcutMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveShortcutsShortcutMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolveShortcutsShortcutMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolveShortcutsShortcutMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolveShortcutsShortcutMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolveShortcutsShortcutMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolveShortcutsShortcutMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveShortcutsShortcutMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveShortcutsShortcutMethod "updateProperty" o = Gtk.Accessible.AccessibleUpdatePropertyMethodInfo
    ResolveShortcutsShortcutMethod "updateRelation" o = Gtk.Accessible.AccessibleUpdateRelationMethodInfo
    ResolveShortcutsShortcutMethod "updateState" o = Gtk.Accessible.AccessibleUpdateStateMethodInfo
    ResolveShortcutsShortcutMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveShortcutsShortcutMethod "getAccessibleRole" o = Gtk.Accessible.AccessibleGetAccessibleRoleMethodInfo
    ResolveShortcutsShortcutMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolveShortcutsShortcutMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolveShortcutsShortcutMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolveShortcutsShortcutMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolveShortcutsShortcutMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolveShortcutsShortcutMethod "getBuildableId" o = Gtk.Buildable.BuildableGetBuildableIdMethodInfo
    ResolveShortcutsShortcutMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolveShortcutsShortcutMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolveShortcutsShortcutMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolveShortcutsShortcutMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolveShortcutsShortcutMethod "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
    ResolveShortcutsShortcutMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
    ResolveShortcutsShortcutMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveShortcutsShortcutMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveShortcutsShortcutMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveShortcutsShortcutMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveShortcutsShortcutMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveShortcutsShortcutMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveShortcutsShortcutMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveShortcutsShortcutMethod "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
    ResolveShortcutsShortcutMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolveShortcutsShortcutMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolveShortcutsShortcutMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolveShortcutsShortcutMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolveShortcutsShortcutMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveShortcutsShortcutMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveShortcutsShortcutMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveShortcutsShortcutMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolveShortcutsShortcutMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveShortcutsShortcutMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveShortcutsShortcutMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolveShortcutsShortcutMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolveShortcutsShortcutMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolveShortcutsShortcutMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolveShortcutsShortcutMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolveShortcutsShortcutMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveShortcutsShortcutMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
    ResolveShortcutsShortcutMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolveShortcutsShortcutMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolveShortcutsShortcutMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolveShortcutsShortcutMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolveShortcutsShortcutMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolveShortcutsShortcutMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolveShortcutsShortcutMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolveShortcutsShortcutMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolveShortcutsShortcutMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveShortcutsShortcutMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveShortcutsShortcutMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolveShortcutsShortcutMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolveShortcutsShortcutMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolveShortcutsShortcutMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolveShortcutsShortcutMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolveShortcutsShortcutMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolveShortcutsShortcutMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolveShortcutsShortcutMethod "getSize" o = Gtk.Widget.WidgetGetSizeMethodInfo
    ResolveShortcutsShortcutMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveShortcutsShortcutMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveShortcutsShortcutMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveShortcutsShortcutMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveShortcutsShortcutMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveShortcutsShortcutMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolveShortcutsShortcutMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolveShortcutsShortcutMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolveShortcutsShortcutMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolveShortcutsShortcutMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolveShortcutsShortcutMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolveShortcutsShortcutMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveShortcutsShortcutMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveShortcutsShortcutMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveShortcutsShortcutMethod "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
    ResolveShortcutsShortcutMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolveShortcutsShortcutMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolveShortcutsShortcutMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveShortcutsShortcutMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveShortcutsShortcutMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolveShortcutsShortcutMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveShortcutsShortcutMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveShortcutsShortcutMethod "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
    ResolveShortcutsShortcutMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveShortcutsShortcutMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveShortcutsShortcutMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveShortcutsShortcutMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolveShortcutsShortcutMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolveShortcutsShortcutMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolveShortcutsShortcutMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolveShortcutsShortcutMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolveShortcutsShortcutMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolveShortcutsShortcutMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolveShortcutsShortcutMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolveShortcutsShortcutMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolveShortcutsShortcutMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolveShortcutsShortcutMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolveShortcutsShortcutMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolveShortcutsShortcutMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveShortcutsShortcutMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolveShortcutsShortcutMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolveShortcutsShortcutMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolveShortcutsShortcutMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolveShortcutsShortcutMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveShortcutsShortcutMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveShortcutsShortcutMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolveShortcutsShortcutMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolveShortcutsShortcutMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolveShortcutsShortcutMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolveShortcutsShortcutMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveShortcutsShortcutMethod t ShortcutsShortcut, O.OverloadedMethod info ShortcutsShortcut p) => OL.IsLabel t (ShortcutsShortcut -> 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 ~ ResolveShortcutsShortcutMethod t ShortcutsShortcut, O.OverloadedMethod info ShortcutsShortcut p, R.HasField t ShortcutsShortcut p) => R.HasField t ShortcutsShortcut p where
    getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveShortcutsShortcutMethod t ShortcutsShortcut, O.OverloadedMethodInfo info ShortcutsShortcut) => OL.IsLabel t (O.MethodProxy info ShortcutsShortcut) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif
#endif
   
   
   
setShortcutsShortcutAccelSizeGroup :: (MonadIO m, IsShortcutsShortcut o, Gtk.SizeGroup.IsSizeGroup a) => o -> a -> m ()
setShortcutsShortcutAccelSizeGroup :: forall (m :: * -> *) o a.
(MonadIO m, IsShortcutsShortcut o, IsSizeGroup a) =>
o -> a -> m ()
setShortcutsShortcutAccelSizeGroup o
obj a
val = IO () -> m ()
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
"accel-size-group" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)
constructShortcutsShortcutAccelSizeGroup :: (IsShortcutsShortcut o, MIO.MonadIO m, Gtk.SizeGroup.IsSizeGroup a) => a -> m (GValueConstruct o)
constructShortcutsShortcutAccelSizeGroup :: forall o (m :: * -> *) a.
(IsShortcutsShortcut o, MonadIO m, IsSizeGroup a) =>
a -> m (GValueConstruct o)
constructShortcutsShortcutAccelSizeGroup a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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
"accel-size-group" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)
clearShortcutsShortcutAccelSizeGroup :: (MonadIO m, IsShortcutsShortcut o) => o -> m ()
clearShortcutsShortcutAccelSizeGroup :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m ()
clearShortcutsShortcutAccelSizeGroup o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe SizeGroup -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"accel-size-group" (Maybe SizeGroup
forall a. Maybe a
Nothing :: Maybe Gtk.SizeGroup.SizeGroup)
#if defined(ENABLE_OVERLOADING)
data ShortcutsShortcutAccelSizeGroupPropertyInfo
instance AttrInfo ShortcutsShortcutAccelSizeGroupPropertyInfo where
    type AttrAllowedOps ShortcutsShortcutAccelSizeGroupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutsShortcutAccelSizeGroupPropertyInfo = IsShortcutsShortcut
    type AttrSetTypeConstraint ShortcutsShortcutAccelSizeGroupPropertyInfo = Gtk.SizeGroup.IsSizeGroup
    type AttrTransferTypeConstraint ShortcutsShortcutAccelSizeGroupPropertyInfo = Gtk.SizeGroup.IsSizeGroup
    type AttrTransferType ShortcutsShortcutAccelSizeGroupPropertyInfo = Gtk.SizeGroup.SizeGroup
    type AttrGetType ShortcutsShortcutAccelSizeGroupPropertyInfo = ()
    type AttrLabel ShortcutsShortcutAccelSizeGroupPropertyInfo = "accel-size-group"
    type AttrOrigin ShortcutsShortcutAccelSizeGroupPropertyInfo = ShortcutsShortcut
    attrGet = undefined
    attrSet = setShortcutsShortcutAccelSizeGroup
    attrTransfer _ v = do
        unsafeCastTo Gtk.SizeGroup.SizeGroup v
    attrConstruct = constructShortcutsShortcutAccelSizeGroup
    attrClear = clearShortcutsShortcutAccelSizeGroup
#endif
   
   
   
getShortcutsShortcutAccelerator :: (MonadIO m, IsShortcutsShortcut o) => o -> m (Maybe T.Text)
getShortcutsShortcutAccelerator :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m (Maybe Text)
getShortcutsShortcutAccelerator o
obj = IO (Maybe Text) -> m (Maybe Text)
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
"accelerator"
setShortcutsShortcutAccelerator :: (MonadIO m, IsShortcutsShortcut o) => o -> T.Text -> m ()
setShortcutsShortcutAccelerator :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> Text -> m ()
setShortcutsShortcutAccelerator o
obj Text
val = IO () -> m ()
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
"accelerator" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructShortcutsShortcutAccelerator :: (IsShortcutsShortcut o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructShortcutsShortcutAccelerator :: forall o (m :: * -> *).
(IsShortcutsShortcut o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructShortcutsShortcutAccelerator Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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
"accelerator" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearShortcutsShortcutAccelerator :: (MonadIO m, IsShortcutsShortcut o) => o -> m ()
clearShortcutsShortcutAccelerator :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m ()
clearShortcutsShortcutAccelerator o
obj = IO () -> m ()
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
"accelerator" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data ShortcutsShortcutAcceleratorPropertyInfo
instance AttrInfo ShortcutsShortcutAcceleratorPropertyInfo where
    type AttrAllowedOps ShortcutsShortcutAcceleratorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutsShortcutAcceleratorPropertyInfo = IsShortcutsShortcut
    type AttrSetTypeConstraint ShortcutsShortcutAcceleratorPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ShortcutsShortcutAcceleratorPropertyInfo = (~) T.Text
    type AttrTransferType ShortcutsShortcutAcceleratorPropertyInfo = T.Text
    type AttrGetType ShortcutsShortcutAcceleratorPropertyInfo = (Maybe T.Text)
    type AttrLabel ShortcutsShortcutAcceleratorPropertyInfo = "accelerator"
    type AttrOrigin ShortcutsShortcutAcceleratorPropertyInfo = ShortcutsShortcut
    attrGet = getShortcutsShortcutAccelerator
    attrSet = setShortcutsShortcutAccelerator
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutsShortcutAccelerator
    attrClear = clearShortcutsShortcutAccelerator
#endif
   
   
   
getShortcutsShortcutActionName :: (MonadIO m, IsShortcutsShortcut o) => o -> m (Maybe T.Text)
getShortcutsShortcutActionName :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m (Maybe Text)
getShortcutsShortcutActionName o
obj = IO (Maybe Text) -> m (Maybe Text)
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
"action-name"
setShortcutsShortcutActionName :: (MonadIO m, IsShortcutsShortcut o) => o -> T.Text -> m ()
setShortcutsShortcutActionName :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> Text -> m ()
setShortcutsShortcutActionName o
obj Text
val = IO () -> m ()
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
"action-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructShortcutsShortcutActionName :: (IsShortcutsShortcut o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructShortcutsShortcutActionName :: forall o (m :: * -> *).
(IsShortcutsShortcut o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructShortcutsShortcutActionName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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
"action-name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
clearShortcutsShortcutActionName :: (MonadIO m, IsShortcutsShortcut o) => o -> m ()
clearShortcutsShortcutActionName :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m ()
clearShortcutsShortcutActionName o
obj = IO () -> m ()
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
"action-name" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)
#if defined(ENABLE_OVERLOADING)
data ShortcutsShortcutActionNamePropertyInfo
instance AttrInfo ShortcutsShortcutActionNamePropertyInfo where
    type AttrAllowedOps ShortcutsShortcutActionNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutsShortcutActionNamePropertyInfo = IsShortcutsShortcut
    type AttrSetTypeConstraint ShortcutsShortcutActionNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ShortcutsShortcutActionNamePropertyInfo = (~) T.Text
    type AttrTransferType ShortcutsShortcutActionNamePropertyInfo = T.Text
    type AttrGetType ShortcutsShortcutActionNamePropertyInfo = (Maybe T.Text)
    type AttrLabel ShortcutsShortcutActionNamePropertyInfo = "action-name"
    type AttrOrigin ShortcutsShortcutActionNamePropertyInfo = ShortcutsShortcut
    attrGet = getShortcutsShortcutActionName
    attrSet = setShortcutsShortcutActionName
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutsShortcutActionName
    attrClear = clearShortcutsShortcutActionName
#endif
   
   
   
getShortcutsShortcutDirection :: (MonadIO m, IsShortcutsShortcut o) => o -> m Gtk.Enums.TextDirection
getShortcutsShortcutDirection :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m TextDirection
getShortcutsShortcutDirection o
obj = IO TextDirection -> m TextDirection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO TextDirection -> m TextDirection)
-> IO TextDirection -> m TextDirection
forall a b. (a -> b) -> a -> b
$ o -> String -> IO TextDirection
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"direction"
setShortcutsShortcutDirection :: (MonadIO m, IsShortcutsShortcut o) => o -> Gtk.Enums.TextDirection -> m ()
setShortcutsShortcutDirection :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> TextDirection -> m ()
setShortcutsShortcutDirection o
obj TextDirection
val = IO () -> m ()
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 -> TextDirection -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"direction" TextDirection
val
constructShortcutsShortcutDirection :: (IsShortcutsShortcut o, MIO.MonadIO m) => Gtk.Enums.TextDirection -> m (GValueConstruct o)
constructShortcutsShortcutDirection :: forall o (m :: * -> *).
(IsShortcutsShortcut o, MonadIO m) =>
TextDirection -> m (GValueConstruct o)
constructShortcutsShortcutDirection TextDirection
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> TextDirection -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"direction" TextDirection
val
#if defined(ENABLE_OVERLOADING)
data ShortcutsShortcutDirectionPropertyInfo
instance AttrInfo ShortcutsShortcutDirectionPropertyInfo where
    type AttrAllowedOps ShortcutsShortcutDirectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ShortcutsShortcutDirectionPropertyInfo = IsShortcutsShortcut
    type AttrSetTypeConstraint ShortcutsShortcutDirectionPropertyInfo = (~) Gtk.Enums.TextDirection
    type AttrTransferTypeConstraint ShortcutsShortcutDirectionPropertyInfo = (~) Gtk.Enums.TextDirection
    type AttrTransferType ShortcutsShortcutDirectionPropertyInfo = Gtk.Enums.TextDirection
    type AttrGetType ShortcutsShortcutDirectionPropertyInfo = Gtk.Enums.TextDirection
    type AttrLabel ShortcutsShortcutDirectionPropertyInfo = "direction"
    type AttrOrigin ShortcutsShortcutDirectionPropertyInfo = ShortcutsShortcut
    attrGet = getShortcutsShortcutDirection
    attrSet = setShortcutsShortcutDirection
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutsShortcutDirection
    attrClear = undefined
#endif
   
   
   
getShortcutsShortcutIcon :: (MonadIO m, IsShortcutsShortcut o) => o -> m (Maybe Gio.Icon.Icon)
getShortcutsShortcutIcon :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m (Maybe Icon)
getShortcutsShortcutIcon o
obj = IO (Maybe Icon) -> m (Maybe Icon)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Icon) -> m (Maybe Icon))
-> IO (Maybe Icon) -> m (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Icon -> Icon) -> IO (Maybe Icon)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"icon" ManagedPtr Icon -> Icon
Gio.Icon.Icon
setShortcutsShortcutIcon :: (MonadIO m, IsShortcutsShortcut o, Gio.Icon.IsIcon a) => o -> a -> m ()
setShortcutsShortcutIcon :: forall (m :: * -> *) o a.
(MonadIO m, IsShortcutsShortcut o, IsIcon a) =>
o -> a -> m ()
setShortcutsShortcutIcon o
obj a
val = IO () -> m ()
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
"icon" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)
constructShortcutsShortcutIcon :: (IsShortcutsShortcut o, MIO.MonadIO m, Gio.Icon.IsIcon a) => a -> m (GValueConstruct o)
constructShortcutsShortcutIcon :: forall o (m :: * -> *) a.
(IsShortcutsShortcut o, MonadIO m, IsIcon a) =>
a -> m (GValueConstruct o)
constructShortcutsShortcutIcon a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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
"icon" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)
clearShortcutsShortcutIcon :: (MonadIO m, IsShortcutsShortcut o) => o -> m ()
clearShortcutsShortcutIcon :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m ()
clearShortcutsShortcutIcon o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Icon -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"icon" (Maybe Icon
forall a. Maybe a
Nothing :: Maybe Gio.Icon.Icon)
#if defined(ENABLE_OVERLOADING)
data ShortcutsShortcutIconPropertyInfo
instance AttrInfo ShortcutsShortcutIconPropertyInfo where
    type AttrAllowedOps ShortcutsShortcutIconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutsShortcutIconPropertyInfo = IsShortcutsShortcut
    type AttrSetTypeConstraint ShortcutsShortcutIconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferTypeConstraint ShortcutsShortcutIconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferType ShortcutsShortcutIconPropertyInfo = Gio.Icon.Icon
    type AttrGetType ShortcutsShortcutIconPropertyInfo = (Maybe Gio.Icon.Icon)
    type AttrLabel ShortcutsShortcutIconPropertyInfo = "icon"
    type AttrOrigin ShortcutsShortcutIconPropertyInfo = ShortcutsShortcut
    attrGet = getShortcutsShortcutIcon
    attrSet = setShortcutsShortcutIcon
    attrTransfer _ v = do
        unsafeCastTo Gio.Icon.Icon v
    attrConstruct = constructShortcutsShortcutIcon
    attrClear = clearShortcutsShortcutIcon
#endif
   
   
   
getShortcutsShortcutIconSet :: (MonadIO m, IsShortcutsShortcut o) => o -> m Bool
getShortcutsShortcutIconSet :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m Bool
getShortcutsShortcutIconSet o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"icon-set"
setShortcutsShortcutIconSet :: (MonadIO m, IsShortcutsShortcut o) => o -> Bool -> m ()
setShortcutsShortcutIconSet :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> Bool -> m ()
setShortcutsShortcutIconSet o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"icon-set" Bool
val
constructShortcutsShortcutIconSet :: (IsShortcutsShortcut o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructShortcutsShortcutIconSet :: forall o (m :: * -> *).
(IsShortcutsShortcut o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructShortcutsShortcutIconSet Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"icon-set" Bool
val
#if defined(ENABLE_OVERLOADING)
data ShortcutsShortcutIconSetPropertyInfo
instance AttrInfo ShortcutsShortcutIconSetPropertyInfo where
    type AttrAllowedOps ShortcutsShortcutIconSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ShortcutsShortcutIconSetPropertyInfo = IsShortcutsShortcut
    type AttrSetTypeConstraint ShortcutsShortcutIconSetPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ShortcutsShortcutIconSetPropertyInfo = (~) Bool
    type AttrTransferType ShortcutsShortcutIconSetPropertyInfo = Bool
    type AttrGetType ShortcutsShortcutIconSetPropertyInfo = Bool
    type AttrLabel ShortcutsShortcutIconSetPropertyInfo = "icon-set"
    type AttrOrigin ShortcutsShortcutIconSetPropertyInfo = ShortcutsShortcut
    attrGet = getShortcutsShortcutIconSet
    attrSet = setShortcutsShortcutIconSet
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutsShortcutIconSet
    attrClear = undefined
#endif
   
   
   
getShortcutsShortcutShortcutType :: (MonadIO m, IsShortcutsShortcut o) => o -> m Gtk.Enums.ShortcutType
getShortcutsShortcutShortcutType :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m ShortcutType
getShortcutsShortcutShortcutType o
obj = IO ShortcutType -> m ShortcutType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ShortcutType -> m ShortcutType)
-> IO ShortcutType -> m ShortcutType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO ShortcutType
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"shortcut-type"
setShortcutsShortcutShortcutType :: (MonadIO m, IsShortcutsShortcut o) => o -> Gtk.Enums.ShortcutType -> m ()
setShortcutsShortcutShortcutType :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> ShortcutType -> m ()
setShortcutsShortcutShortcutType o
obj ShortcutType
val = IO () -> m ()
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 -> ShortcutType -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"shortcut-type" ShortcutType
val
constructShortcutsShortcutShortcutType :: (IsShortcutsShortcut o, MIO.MonadIO m) => Gtk.Enums.ShortcutType -> m (GValueConstruct o)
constructShortcutsShortcutShortcutType :: forall o (m :: * -> *).
(IsShortcutsShortcut o, MonadIO m) =>
ShortcutType -> m (GValueConstruct o)
constructShortcutsShortcutShortcutType ShortcutType
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 -> ShortcutType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"shortcut-type" ShortcutType
val
#if defined(ENABLE_OVERLOADING)
data ShortcutsShortcutShortcutTypePropertyInfo
instance AttrInfo ShortcutsShortcutShortcutTypePropertyInfo where
    type AttrAllowedOps ShortcutsShortcutShortcutTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ShortcutsShortcutShortcutTypePropertyInfo = IsShortcutsShortcut
    type AttrSetTypeConstraint ShortcutsShortcutShortcutTypePropertyInfo = (~) Gtk.Enums.ShortcutType
    type AttrTransferTypeConstraint ShortcutsShortcutShortcutTypePropertyInfo = (~) Gtk.Enums.ShortcutType
    type AttrTransferType ShortcutsShortcutShortcutTypePropertyInfo = Gtk.Enums.ShortcutType
    type AttrGetType ShortcutsShortcutShortcutTypePropertyInfo = Gtk.Enums.ShortcutType
    type AttrLabel ShortcutsShortcutShortcutTypePropertyInfo = "shortcut-type"
    type AttrOrigin ShortcutsShortcutShortcutTypePropertyInfo = ShortcutsShortcut
    attrGet = getShortcutsShortcutShortcutType
    attrSet = setShortcutsShortcutShortcutType
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutsShortcutShortcutType
    attrClear = undefined
#endif
   
   
   
getShortcutsShortcutSubtitle :: (MonadIO m, IsShortcutsShortcut o) => o -> m (Maybe T.Text)
getShortcutsShortcutSubtitle :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m (Maybe Text)
getShortcutsShortcutSubtitle o
obj = IO (Maybe Text) -> m (Maybe Text)
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
"subtitle"
setShortcutsShortcutSubtitle :: (MonadIO m, IsShortcutsShortcut o) => o -> T.Text -> m ()
setShortcutsShortcutSubtitle :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> Text -> m ()
setShortcutsShortcutSubtitle o
obj Text
val = IO () -> m ()
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)
constructShortcutsShortcutSubtitle :: (IsShortcutsShortcut o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructShortcutsShortcutSubtitle :: forall o (m :: * -> *).
(IsShortcutsShortcut o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructShortcutsShortcutSubtitle Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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)
clearShortcutsShortcutSubtitle :: (MonadIO m, IsShortcutsShortcut o) => o -> m ()
clearShortcutsShortcutSubtitle :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m ()
clearShortcutsShortcutSubtitle o
obj = IO () -> m ()
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 ShortcutsShortcutSubtitlePropertyInfo
instance AttrInfo ShortcutsShortcutSubtitlePropertyInfo where
    type AttrAllowedOps ShortcutsShortcutSubtitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutsShortcutSubtitlePropertyInfo = IsShortcutsShortcut
    type AttrSetTypeConstraint ShortcutsShortcutSubtitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ShortcutsShortcutSubtitlePropertyInfo = (~) T.Text
    type AttrTransferType ShortcutsShortcutSubtitlePropertyInfo = T.Text
    type AttrGetType ShortcutsShortcutSubtitlePropertyInfo = (Maybe T.Text)
    type AttrLabel ShortcutsShortcutSubtitlePropertyInfo = "subtitle"
    type AttrOrigin ShortcutsShortcutSubtitlePropertyInfo = ShortcutsShortcut
    attrGet = getShortcutsShortcutSubtitle
    attrSet = setShortcutsShortcutSubtitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutsShortcutSubtitle
    attrClear = clearShortcutsShortcutSubtitle
#endif
   
   
   
getShortcutsShortcutSubtitleSet :: (MonadIO m, IsShortcutsShortcut o) => o -> m Bool
getShortcutsShortcutSubtitleSet :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m Bool
getShortcutsShortcutSubtitleSet o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"subtitle-set"
setShortcutsShortcutSubtitleSet :: (MonadIO m, IsShortcutsShortcut o) => o -> Bool -> m ()
setShortcutsShortcutSubtitleSet :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> Bool -> m ()
setShortcutsShortcutSubtitleSet o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"subtitle-set" Bool
val
constructShortcutsShortcutSubtitleSet :: (IsShortcutsShortcut o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructShortcutsShortcutSubtitleSet :: forall o (m :: * -> *).
(IsShortcutsShortcut o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructShortcutsShortcutSubtitleSet Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"subtitle-set" Bool
val
#if defined(ENABLE_OVERLOADING)
data ShortcutsShortcutSubtitleSetPropertyInfo
instance AttrInfo ShortcutsShortcutSubtitleSetPropertyInfo where
    type AttrAllowedOps ShortcutsShortcutSubtitleSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ShortcutsShortcutSubtitleSetPropertyInfo = IsShortcutsShortcut
    type AttrSetTypeConstraint ShortcutsShortcutSubtitleSetPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ShortcutsShortcutSubtitleSetPropertyInfo = (~) Bool
    type AttrTransferType ShortcutsShortcutSubtitleSetPropertyInfo = Bool
    type AttrGetType ShortcutsShortcutSubtitleSetPropertyInfo = Bool
    type AttrLabel ShortcutsShortcutSubtitleSetPropertyInfo = "subtitle-set"
    type AttrOrigin ShortcutsShortcutSubtitleSetPropertyInfo = ShortcutsShortcut
    attrGet = getShortcutsShortcutSubtitleSet
    attrSet = setShortcutsShortcutSubtitleSet
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutsShortcutSubtitleSet
    attrClear = undefined
#endif
   
   
   
getShortcutsShortcutTitle :: (MonadIO m, IsShortcutsShortcut o) => o -> m (Maybe T.Text)
getShortcutsShortcutTitle :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m (Maybe Text)
getShortcutsShortcutTitle o
obj = IO (Maybe Text) -> m (Maybe Text)
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"
setShortcutsShortcutTitle :: (MonadIO m, IsShortcutsShortcut o) => o -> T.Text -> m ()
setShortcutsShortcutTitle :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> Text -> m ()
setShortcutsShortcutTitle o
obj Text
val = IO () -> m ()
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)
constructShortcutsShortcutTitle :: (IsShortcutsShortcut o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructShortcutsShortcutTitle :: forall o (m :: * -> *).
(IsShortcutsShortcut o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructShortcutsShortcutTitle Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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)
clearShortcutsShortcutTitle :: (MonadIO m, IsShortcutsShortcut o) => o -> m ()
clearShortcutsShortcutTitle :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m ()
clearShortcutsShortcutTitle o
obj = IO () -> m ()
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 ShortcutsShortcutTitlePropertyInfo
instance AttrInfo ShortcutsShortcutTitlePropertyInfo where
    type AttrAllowedOps ShortcutsShortcutTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutsShortcutTitlePropertyInfo = IsShortcutsShortcut
    type AttrSetTypeConstraint ShortcutsShortcutTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ShortcutsShortcutTitlePropertyInfo = (~) T.Text
    type AttrTransferType ShortcutsShortcutTitlePropertyInfo = T.Text
    type AttrGetType ShortcutsShortcutTitlePropertyInfo = (Maybe T.Text)
    type AttrLabel ShortcutsShortcutTitlePropertyInfo = "title"
    type AttrOrigin ShortcutsShortcutTitlePropertyInfo = ShortcutsShortcut
    attrGet = getShortcutsShortcutTitle
    attrSet = setShortcutsShortcutTitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutsShortcutTitle
    attrClear = clearShortcutsShortcutTitle
#endif
   
   
   
setShortcutsShortcutTitleSizeGroup :: (MonadIO m, IsShortcutsShortcut o, Gtk.SizeGroup.IsSizeGroup a) => o -> a -> m ()
setShortcutsShortcutTitleSizeGroup :: forall (m :: * -> *) o a.
(MonadIO m, IsShortcutsShortcut o, IsSizeGroup a) =>
o -> a -> m ()
setShortcutsShortcutTitleSizeGroup o
obj a
val = IO () -> m ()
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
"title-size-group" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)
constructShortcutsShortcutTitleSizeGroup :: (IsShortcutsShortcut o, MIO.MonadIO m, Gtk.SizeGroup.IsSizeGroup a) => a -> m (GValueConstruct o)
constructShortcutsShortcutTitleSizeGroup :: forall o (m :: * -> *) a.
(IsShortcutsShortcut o, MonadIO m, IsSizeGroup a) =>
a -> m (GValueConstruct o)
constructShortcutsShortcutTitleSizeGroup a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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
"title-size-group" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)
clearShortcutsShortcutTitleSizeGroup :: (MonadIO m, IsShortcutsShortcut o) => o -> m ()
clearShortcutsShortcutTitleSizeGroup :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutsShortcut o) =>
o -> m ()
clearShortcutsShortcutTitleSizeGroup o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe SizeGroup -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"title-size-group" (Maybe SizeGroup
forall a. Maybe a
Nothing :: Maybe Gtk.SizeGroup.SizeGroup)
#if defined(ENABLE_OVERLOADING)
data ShortcutsShortcutTitleSizeGroupPropertyInfo
instance AttrInfo ShortcutsShortcutTitleSizeGroupPropertyInfo where
    type AttrAllowedOps ShortcutsShortcutTitleSizeGroupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutsShortcutTitleSizeGroupPropertyInfo = IsShortcutsShortcut
    type AttrSetTypeConstraint ShortcutsShortcutTitleSizeGroupPropertyInfo = Gtk.SizeGroup.IsSizeGroup
    type AttrTransferTypeConstraint ShortcutsShortcutTitleSizeGroupPropertyInfo = Gtk.SizeGroup.IsSizeGroup
    type AttrTransferType ShortcutsShortcutTitleSizeGroupPropertyInfo = Gtk.SizeGroup.SizeGroup
    type AttrGetType ShortcutsShortcutTitleSizeGroupPropertyInfo = ()
    type AttrLabel ShortcutsShortcutTitleSizeGroupPropertyInfo = "title-size-group"
    type AttrOrigin ShortcutsShortcutTitleSizeGroupPropertyInfo = ShortcutsShortcut
    attrGet = undefined
    attrSet = setShortcutsShortcutTitleSizeGroup
    attrTransfer _ v = do
        unsafeCastTo Gtk.SizeGroup.SizeGroup v
    attrConstruct = constructShortcutsShortcutTitleSizeGroup
    attrClear = clearShortcutsShortcutTitleSizeGroup
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ShortcutsShortcut
type instance O.AttributeList ShortcutsShortcut = ShortcutsShortcutAttributeList
type ShortcutsShortcutAttributeList = ('[ '("accelSizeGroup", ShortcutsShortcutAccelSizeGroupPropertyInfo), '("accelerator", ShortcutsShortcutAcceleratorPropertyInfo), '("accessibleRole", Gtk.Accessible.AccessibleAccessibleRolePropertyInfo), '("actionName", ShortcutsShortcutActionNamePropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("direction", ShortcutsShortcutDirectionPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("icon", ShortcutsShortcutIconPropertyInfo), '("iconSet", ShortcutsShortcutIconSetPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("shortcutType", ShortcutsShortcutShortcutTypePropertyInfo), '("subtitle", ShortcutsShortcutSubtitlePropertyInfo), '("subtitleSet", ShortcutsShortcutSubtitleSetPropertyInfo), '("title", ShortcutsShortcutTitlePropertyInfo), '("titleSizeGroup", ShortcutsShortcutTitleSizeGroupPropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo)] :: [(Symbol, *)])
#endif
#if defined(ENABLE_OVERLOADING)
shortcutsShortcutAccelSizeGroup :: AttrLabelProxy "accelSizeGroup"
shortcutsShortcutAccelSizeGroup = AttrLabelProxy
shortcutsShortcutAccelerator :: AttrLabelProxy "accelerator"
shortcutsShortcutAccelerator = AttrLabelProxy
shortcutsShortcutActionName :: AttrLabelProxy "actionName"
shortcutsShortcutActionName = AttrLabelProxy
shortcutsShortcutDirection :: AttrLabelProxy "direction"
shortcutsShortcutDirection = AttrLabelProxy
shortcutsShortcutIcon :: AttrLabelProxy "icon"
shortcutsShortcutIcon = AttrLabelProxy
shortcutsShortcutIconSet :: AttrLabelProxy "iconSet"
shortcutsShortcutIconSet = AttrLabelProxy
shortcutsShortcutShortcutType :: AttrLabelProxy "shortcutType"
shortcutsShortcutShortcutType = AttrLabelProxy
shortcutsShortcutSubtitle :: AttrLabelProxy "subtitle"
shortcutsShortcutSubtitle = AttrLabelProxy
shortcutsShortcutSubtitleSet :: AttrLabelProxy "subtitleSet"
shortcutsShortcutSubtitleSet = AttrLabelProxy
shortcutsShortcutTitle :: AttrLabelProxy "title"
shortcutsShortcutTitle = AttrLabelProxy
shortcutsShortcutTitleSizeGroup :: AttrLabelProxy "titleSizeGroup"
shortcutsShortcutTitleSizeGroup = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ShortcutsShortcut = ShortcutsShortcutSignalList
type ShortcutsShortcutSignalList = ('[ '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, *)])
#endif