{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Gtk.Objects.AccelLabel.AccelLabel' is a widget that shows an accelerator next to a description
-- of said accelerator, e.g. “Save Document Ctrl+S”.
-- It is commonly used in menus to show the keyboard short-cuts for commands.
-- 
-- The accelerator key to display is typically not set explicitly (although it
-- can be, with 'GI.Gtk.Objects.AccelLabel.accelLabelSetAccel'). Instead, the t'GI.Gtk.Objects.AccelLabel.AccelLabel' displays
-- the accelerators which have been added to a particular widget. This widget is
-- set by calling 'GI.Gtk.Objects.AccelLabel.accelLabelSetAccelWidget'.
-- 
-- For example, a t'GI.Gtk.Objects.MenuItem.MenuItem' widget may have an accelerator added to emit
-- the “activate” signal when the “Ctrl+S” key combination is pressed.
-- A t'GI.Gtk.Objects.AccelLabel.AccelLabel' is created and added to the t'GI.Gtk.Objects.MenuItem.MenuItem', and
-- 'GI.Gtk.Objects.AccelLabel.accelLabelSetAccelWidget' is called with the t'GI.Gtk.Objects.MenuItem.MenuItem' as the
-- second argument. The t'GI.Gtk.Objects.AccelLabel.AccelLabel' will now display “Ctrl+S” after its label.
-- 
-- Note that creating a t'GI.Gtk.Objects.MenuItem.MenuItem' with 'GI.Gtk.Objects.MenuItem.menuItemNewWithLabel' (or
-- one of the similar functions for t'GI.Gtk.Objects.CheckMenuItem.CheckMenuItem' and t'GI.Gtk.Objects.RadioMenuItem.RadioMenuItem')
-- automatically adds a t'GI.Gtk.Objects.AccelLabel.AccelLabel' to the t'GI.Gtk.Objects.MenuItem.MenuItem' and calls
-- 'GI.Gtk.Objects.AccelLabel.accelLabelSetAccelWidget' to set it up for you.
-- 
-- A t'GI.Gtk.Objects.AccelLabel.AccelLabel' will only display accelerators which have 'GI.Gtk.Flags.AccelFlagsVisible'
-- set (see t'GI.Gtk.Flags.AccelFlags').
-- A t'GI.Gtk.Objects.AccelLabel.AccelLabel' can display multiple accelerators and even signal names,
-- though it is almost always used to display just one accelerator key.
-- 
-- == Creating a simple menu item with an accelerator key.
-- 
-- 
-- === /C code/
-- >
-- >  GtkWidget *window = gtk_window_new (GTK_WINDOW_TOPLEVEL);
-- >  GtkWidget *menu = gtk_menu_new ();
-- >  GtkWidget *save_item;
-- >  GtkAccelGroup *accel_group;
-- >
-- >  // Create a GtkAccelGroup and add it to the window.
-- >  accel_group = gtk_accel_group_new ();
-- >  gtk_window_add_accel_group (GTK_WINDOW (window), accel_group);
-- >
-- >  // Create the menu item using the convenience function.
-- >  save_item = gtk_menu_item_new_with_label ("Save");
-- >  gtk_container_add (GTK_CONTAINER (menu), save_item);
-- >
-- >  // Now add the accelerator to the GtkMenuItem. Note that since we
-- >  // called gtk_menu_item_new_with_label() to create the GtkMenuItem
-- >  // the GtkAccelLabel is automatically set up to display the
-- >  // GtkMenuItem accelerators. We just need to make sure we use
-- >  // GTK_ACCEL_VISIBLE here.
-- >  gtk_widget_add_accelerator (save_item, "activate", accel_group,
-- >                              GDK_KEY_s, GDK_CONTROL_MASK, GTK_ACCEL_VISIBLE);
-- 
-- 
-- = CSS nodes
-- 
-- 
-- === /plain code/
-- >
-- >accellabel
-- >╰── box
-- >    ├── label
-- >    ╰── accelerator
-- 
-- 
-- t'GI.Gtk.Objects.AccelLabel.AccelLabel' has a main CSS node with the name accellabel.
-- It adds a subnode with name box, containing two child nodes with
-- name label and accelerator.

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

module GI.Gtk.Objects.AccelLabel
    ( 

-- * Exported types
    AccelLabel(..)                          ,
    IsAccelLabel                            ,
    toAccelLabel                            ,
    noAccelLabel                            ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveAccelLabelMethod                 ,
#endif


-- ** getAccel #method:getAccel#

#if defined(ENABLE_OVERLOADING)
    AccelLabelGetAccelMethodInfo            ,
#endif
    accelLabelGetAccel                      ,


-- ** getAccelWidget #method:getAccelWidget#

#if defined(ENABLE_OVERLOADING)
    AccelLabelGetAccelWidgetMethodInfo      ,
#endif
    accelLabelGetAccelWidget                ,


-- ** getAccelWidth #method:getAccelWidth#

#if defined(ENABLE_OVERLOADING)
    AccelLabelGetAccelWidthMethodInfo       ,
#endif
    accelLabelGetAccelWidth                 ,


-- ** getLabel #method:getLabel#

#if defined(ENABLE_OVERLOADING)
    AccelLabelGetLabelMethodInfo            ,
#endif
    accelLabelGetLabel                      ,


-- ** getUseUnderline #method:getUseUnderline#

#if defined(ENABLE_OVERLOADING)
    AccelLabelGetUseUnderlineMethodInfo     ,
#endif
    accelLabelGetUseUnderline               ,


-- ** new #method:new#

    accelLabelNew                           ,


-- ** refetch #method:refetch#

#if defined(ENABLE_OVERLOADING)
    AccelLabelRefetchMethodInfo             ,
#endif
    accelLabelRefetch                       ,


-- ** setAccel #method:setAccel#

#if defined(ENABLE_OVERLOADING)
    AccelLabelSetAccelMethodInfo            ,
#endif
    accelLabelSetAccel                      ,


-- ** setAccelClosure #method:setAccelClosure#

#if defined(ENABLE_OVERLOADING)
    AccelLabelSetAccelClosureMethodInfo     ,
#endif
    accelLabelSetAccelClosure               ,


-- ** setAccelWidget #method:setAccelWidget#

#if defined(ENABLE_OVERLOADING)
    AccelLabelSetAccelWidgetMethodInfo      ,
#endif
    accelLabelSetAccelWidget                ,


-- ** setLabel #method:setLabel#

#if defined(ENABLE_OVERLOADING)
    AccelLabelSetLabelMethodInfo            ,
#endif
    accelLabelSetLabel                      ,


-- ** setUseUnderline #method:setUseUnderline#

#if defined(ENABLE_OVERLOADING)
    AccelLabelSetUseUnderlineMethodInfo     ,
#endif
    accelLabelSetUseUnderline               ,




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

#if defined(ENABLE_OVERLOADING)
    AccelLabelAccelClosurePropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    accelLabelAccelClosure                  ,
#endif
    clearAccelLabelAccelClosure             ,
    constructAccelLabelAccelClosure         ,
    getAccelLabelAccelClosure               ,
    setAccelLabelAccelClosure               ,


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

#if defined(ENABLE_OVERLOADING)
    AccelLabelAccelWidgetPropertyInfo       ,
#endif
#if defined(ENABLE_OVERLOADING)
    accelLabelAccelWidget                   ,
#endif
    clearAccelLabelAccelWidget              ,
    constructAccelLabelAccelWidget          ,
    getAccelLabelAccelWidget                ,
    setAccelLabelAccelWidget                ,


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

#if defined(ENABLE_OVERLOADING)
    AccelLabelLabelPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    accelLabelLabel                         ,
#endif
    constructAccelLabelLabel                ,
    getAccelLabelLabel                      ,
    setAccelLabelLabel                      ,


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

#if defined(ENABLE_OVERLOADING)
    AccelLabelUseUnderlinePropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    accelLabelUseUnderline                  ,
#endif
    constructAccelLabelUseUnderline         ,
    getAccelLabelUseUnderline               ,
    setAccelLabelUseUnderline               ,




    ) 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.ManagedPtr as B.ManagedPtr
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 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 GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Flags as Gdk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

-- | Memory-managed wrapper type.
newtype AccelLabel = AccelLabel (ManagedPtr AccelLabel)
    deriving (AccelLabel -> AccelLabel -> Bool
(AccelLabel -> AccelLabel -> Bool)
-> (AccelLabel -> AccelLabel -> Bool) -> Eq AccelLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccelLabel -> AccelLabel -> Bool
$c/= :: AccelLabel -> AccelLabel -> Bool
== :: AccelLabel -> AccelLabel -> Bool
$c== :: AccelLabel -> AccelLabel -> Bool
Eq)
foreign import ccall "gtk_accel_label_get_type"
    c_gtk_accel_label_get_type :: IO GType

instance GObject AccelLabel where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_accel_label_get_type
    

-- | Convert 'AccelLabel' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue AccelLabel where
    toGValue :: AccelLabel -> IO GValue
toGValue o :: AccelLabel
o = do
        GType
gtype <- IO GType
c_gtk_accel_label_get_type
        AccelLabel -> (Ptr AccelLabel -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr AccelLabel
o (GType
-> (GValue -> Ptr AccelLabel -> IO ())
-> Ptr AccelLabel
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr AccelLabel -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO AccelLabel
fromGValue gv :: GValue
gv = do
        Ptr AccelLabel
ptr <- GValue -> IO (Ptr AccelLabel)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr AccelLabel)
        (ManagedPtr AccelLabel -> AccelLabel)
-> Ptr AccelLabel -> IO AccelLabel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr AccelLabel -> AccelLabel
AccelLabel Ptr AccelLabel
ptr
        
    

-- | Type class for types which can be safely cast to `AccelLabel`, for instance with `toAccelLabel`.
class (GObject o, O.IsDescendantOf AccelLabel o) => IsAccelLabel o
instance (GObject o, O.IsDescendantOf AccelLabel o) => IsAccelLabel o

instance O.HasParentTypes AccelLabel
type instance O.ParentTypes AccelLabel = '[Gtk.Widget.Widget, GObject.Object.Object, Atk.ImplementorIface.ImplementorIface, Gtk.Buildable.Buildable]

-- | Cast to `AccelLabel`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toAccelLabel :: (MonadIO m, IsAccelLabel o) => o -> m AccelLabel
toAccelLabel :: o -> m AccelLabel
toAccelLabel = IO AccelLabel -> m AccelLabel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AccelLabel -> m AccelLabel)
-> (o -> IO AccelLabel) -> o -> m AccelLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr AccelLabel -> AccelLabel) -> o -> IO AccelLabel
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr AccelLabel -> AccelLabel
AccelLabel

-- | A convenience alias for `Nothing` :: `Maybe` `AccelLabel`.
noAccelLabel :: Maybe AccelLabel
noAccelLabel :: Maybe AccelLabel
noAccelLabel = Maybe AccelLabel
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveAccelLabelMethod (t :: Symbol) (o :: *) :: * where
    ResolveAccelLabelMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveAccelLabelMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveAccelLabelMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveAccelLabelMethod "addAccelerator" o = Gtk.Widget.WidgetAddAcceleratorMethodInfo
    ResolveAccelLabelMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveAccelLabelMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveAccelLabelMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveAccelLabelMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveAccelLabelMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveAccelLabelMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAccelLabelMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAccelLabelMethod "canActivateAccel" o = Gtk.Widget.WidgetCanActivateAccelMethodInfo
    ResolveAccelLabelMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveAccelLabelMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveAccelLabelMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveAccelLabelMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveAccelLabelMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveAccelLabelMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveAccelLabelMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveAccelLabelMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveAccelLabelMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveAccelLabelMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveAccelLabelMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveAccelLabelMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveAccelLabelMethod "destroy" o = Gtk.Widget.WidgetDestroyMethodInfo
    ResolveAccelLabelMethod "destroyed" o = Gtk.Widget.WidgetDestroyedMethodInfo
    ResolveAccelLabelMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
    ResolveAccelLabelMethod "dragBegin" o = Gtk.Widget.WidgetDragBeginMethodInfo
    ResolveAccelLabelMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveAccelLabelMethod "dragDestAddImageTargets" o = Gtk.Widget.WidgetDragDestAddImageTargetsMethodInfo
    ResolveAccelLabelMethod "dragDestAddTextTargets" o = Gtk.Widget.WidgetDragDestAddTextTargetsMethodInfo
    ResolveAccelLabelMethod "dragDestAddUriTargets" o = Gtk.Widget.WidgetDragDestAddUriTargetsMethodInfo
    ResolveAccelLabelMethod "dragDestFindTarget" o = Gtk.Widget.WidgetDragDestFindTargetMethodInfo
    ResolveAccelLabelMethod "dragDestGetTargetList" o = Gtk.Widget.WidgetDragDestGetTargetListMethodInfo
    ResolveAccelLabelMethod "dragDestGetTrackMotion" o = Gtk.Widget.WidgetDragDestGetTrackMotionMethodInfo
    ResolveAccelLabelMethod "dragDestSet" o = Gtk.Widget.WidgetDragDestSetMethodInfo
    ResolveAccelLabelMethod "dragDestSetTargetList" o = Gtk.Widget.WidgetDragDestSetTargetListMethodInfo
    ResolveAccelLabelMethod "dragDestSetTrackMotion" o = Gtk.Widget.WidgetDragDestSetTrackMotionMethodInfo
    ResolveAccelLabelMethod "dragDestUnset" o = Gtk.Widget.WidgetDragDestUnsetMethodInfo
    ResolveAccelLabelMethod "dragGetData" o = Gtk.Widget.WidgetDragGetDataMethodInfo
    ResolveAccelLabelMethod "dragHighlight" o = Gtk.Widget.WidgetDragHighlightMethodInfo
    ResolveAccelLabelMethod "dragSourceAddImageTargets" o = Gtk.Widget.WidgetDragSourceAddImageTargetsMethodInfo
    ResolveAccelLabelMethod "dragSourceAddTextTargets" o = Gtk.Widget.WidgetDragSourceAddTextTargetsMethodInfo
    ResolveAccelLabelMethod "dragSourceAddUriTargets" o = Gtk.Widget.WidgetDragSourceAddUriTargetsMethodInfo
    ResolveAccelLabelMethod "dragSourceGetTargetList" o = Gtk.Widget.WidgetDragSourceGetTargetListMethodInfo
    ResolveAccelLabelMethod "dragSourceSet" o = Gtk.Widget.WidgetDragSourceSetMethodInfo
    ResolveAccelLabelMethod "dragSourceSetIconGicon" o = Gtk.Widget.WidgetDragSourceSetIconGiconMethodInfo
    ResolveAccelLabelMethod "dragSourceSetIconName" o = Gtk.Widget.WidgetDragSourceSetIconNameMethodInfo
    ResolveAccelLabelMethod "dragSourceSetIconPaintable" o = Gtk.Widget.WidgetDragSourceSetIconPaintableMethodInfo
    ResolveAccelLabelMethod "dragSourceSetTargetList" o = Gtk.Widget.WidgetDragSourceSetTargetListMethodInfo
    ResolveAccelLabelMethod "dragSourceUnset" o = Gtk.Widget.WidgetDragSourceUnsetMethodInfo
    ResolveAccelLabelMethod "dragUnhighlight" o = Gtk.Widget.WidgetDragUnhighlightMethodInfo
    ResolveAccelLabelMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveAccelLabelMethod "event" o = Gtk.Widget.WidgetEventMethodInfo
    ResolveAccelLabelMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAccelLabelMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAccelLabelMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAccelLabelMethod "grabAdd" o = Gtk.Widget.WidgetGrabAddMethodInfo
    ResolveAccelLabelMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveAccelLabelMethod "grabRemove" o = Gtk.Widget.WidgetGrabRemoveMethodInfo
    ResolveAccelLabelMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveAccelLabelMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveAccelLabelMethod "hasGrab" o = Gtk.Widget.WidgetHasGrabMethodInfo
    ResolveAccelLabelMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolveAccelLabelMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolveAccelLabelMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolveAccelLabelMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolveAccelLabelMethod "inputShapeCombineRegion" o = Gtk.Widget.WidgetInputShapeCombineRegionMethodInfo
    ResolveAccelLabelMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolveAccelLabelMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolveAccelLabelMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolveAccelLabelMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolveAccelLabelMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolveAccelLabelMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAccelLabelMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolveAccelLabelMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolveAccelLabelMethod "isToplevel" o = Gtk.Widget.WidgetIsToplevelMethodInfo
    ResolveAccelLabelMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveAccelLabelMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveAccelLabelMethod "listAccelClosures" o = Gtk.Widget.WidgetListAccelClosuresMethodInfo
    ResolveAccelLabelMethod "listActionPrefixes" o = Gtk.Widget.WidgetListActionPrefixesMethodInfo
    ResolveAccelLabelMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolveAccelLabelMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolveAccelLabelMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolveAccelLabelMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolveAccelLabelMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAccelLabelMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAccelLabelMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolveAccelLabelMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolveAccelLabelMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveAccelLabelMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveAccelLabelMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveAccelLabelMethod "queueComputeExpand" o = Gtk.Widget.WidgetQueueComputeExpandMethodInfo
    ResolveAccelLabelMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveAccelLabelMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveAccelLabelMethod "queueResizeNoRedraw" o = Gtk.Widget.WidgetQueueResizeNoRedrawMethodInfo
    ResolveAccelLabelMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveAccelLabelMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAccelLabelMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAccelLabelMethod "refetch" o = AccelLabelRefetchMethodInfo
    ResolveAccelLabelMethod "registerSurface" o = Gtk.Widget.WidgetRegisterSurfaceMethodInfo
    ResolveAccelLabelMethod "removeAccelerator" o = Gtk.Widget.WidgetRemoveAcceleratorMethodInfo
    ResolveAccelLabelMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveAccelLabelMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveAccelLabelMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveAccelLabelMethod "resetStyle" o = Gtk.Widget.WidgetResetStyleMethodInfo
    ResolveAccelLabelMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAccelLabelMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolveAccelLabelMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolveAccelLabelMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolveAccelLabelMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAccelLabelMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAccelLabelMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAccelLabelMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolveAccelLabelMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolveAccelLabelMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolveAccelLabelMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolveAccelLabelMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolveAccelLabelMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAccelLabelMethod "unregisterSurface" o = Gtk.Widget.WidgetUnregisterSurfaceMethodInfo
    ResolveAccelLabelMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveAccelLabelMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAccelLabelMethod "getAccel" o = AccelLabelGetAccelMethodInfo
    ResolveAccelLabelMethod "getAccelWidget" o = AccelLabelGetAccelWidgetMethodInfo
    ResolveAccelLabelMethod "getAccelWidth" o = AccelLabelGetAccelWidthMethodInfo
    ResolveAccelLabelMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
    ResolveAccelLabelMethod "getActionGroup" o = Gtk.Widget.WidgetGetActionGroupMethodInfo
    ResolveAccelLabelMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolveAccelLabelMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolveAccelLabelMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolveAccelLabelMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolveAccelLabelMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolveAccelLabelMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolveAccelLabelMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolveAccelLabelMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolveAccelLabelMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolveAccelLabelMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveAccelLabelMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAccelLabelMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveAccelLabelMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveAccelLabelMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveAccelLabelMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveAccelLabelMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveAccelLabelMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolveAccelLabelMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolveAccelLabelMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolveAccelLabelMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolveAccelLabelMethod "getHasSurface" o = Gtk.Widget.WidgetGetHasSurfaceMethodInfo
    ResolveAccelLabelMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveAccelLabelMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveAccelLabelMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveAccelLabelMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolveAccelLabelMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveAccelLabelMethod "getLabel" o = AccelLabelGetLabelMethodInfo
    ResolveAccelLabelMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveAccelLabelMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveAccelLabelMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolveAccelLabelMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolveAccelLabelMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolveAccelLabelMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolveAccelLabelMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolveAccelLabelMethod "getModifierMask" o = Gtk.Widget.WidgetGetModifierMaskMethodInfo
    ResolveAccelLabelMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveAccelLabelMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolveAccelLabelMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolveAccelLabelMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolveAccelLabelMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolveAccelLabelMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolveAccelLabelMethod "getPath" o = Gtk.Widget.WidgetGetPathMethodInfo
    ResolveAccelLabelMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolveAccelLabelMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolveAccelLabelMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolveAccelLabelMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAccelLabelMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAccelLabelMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolveAccelLabelMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolveAccelLabelMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolveAccelLabelMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolveAccelLabelMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolveAccelLabelMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolveAccelLabelMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolveAccelLabelMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveAccelLabelMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveAccelLabelMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveAccelLabelMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
    ResolveAccelLabelMethod "getSurface" o = Gtk.Widget.WidgetGetSurfaceMethodInfo
    ResolveAccelLabelMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveAccelLabelMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveAccelLabelMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolveAccelLabelMethod "getTooltipWindow" o = Gtk.Widget.WidgetGetTooltipWindowMethodInfo
    ResolveAccelLabelMethod "getToplevel" o = Gtk.Widget.WidgetGetToplevelMethodInfo
    ResolveAccelLabelMethod "getUseUnderline" o = AccelLabelGetUseUnderlineMethodInfo
    ResolveAccelLabelMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolveAccelLabelMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolveAccelLabelMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolveAccelLabelMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolveAccelLabelMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolveAccelLabelMethod "setAccel" o = AccelLabelSetAccelMethodInfo
    ResolveAccelLabelMethod "setAccelClosure" o = AccelLabelSetAccelClosureMethodInfo
    ResolveAccelLabelMethod "setAccelPath" o = Gtk.Widget.WidgetSetAccelPathMethodInfo
    ResolveAccelLabelMethod "setAccelWidget" o = AccelLabelSetAccelWidgetMethodInfo
    ResolveAccelLabelMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveAccelLabelMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveAccelLabelMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveAccelLabelMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveAccelLabelMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolveAccelLabelMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolveAccelLabelMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAccelLabelMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAccelLabelMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolveAccelLabelMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveAccelLabelMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveAccelLabelMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveAccelLabelMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveAccelLabelMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveAccelLabelMethod "setHasSurface" o = Gtk.Widget.WidgetSetHasSurfaceMethodInfo
    ResolveAccelLabelMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolveAccelLabelMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolveAccelLabelMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolveAccelLabelMethod "setLabel" o = AccelLabelSetLabelMethodInfo
    ResolveAccelLabelMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolveAccelLabelMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolveAccelLabelMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolveAccelLabelMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolveAccelLabelMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolveAccelLabelMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolveAccelLabelMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolveAccelLabelMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolveAccelLabelMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolveAccelLabelMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAccelLabelMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolveAccelLabelMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolveAccelLabelMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolveAccelLabelMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolveAccelLabelMethod "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
    ResolveAccelLabelMethod "setSurface" o = Gtk.Widget.WidgetSetSurfaceMethodInfo
    ResolveAccelLabelMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveAccelLabelMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveAccelLabelMethod "setTooltipWindow" o = Gtk.Widget.WidgetSetTooltipWindowMethodInfo
    ResolveAccelLabelMethod "setUseUnderline" o = AccelLabelSetUseUnderlineMethodInfo
    ResolveAccelLabelMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolveAccelLabelMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolveAccelLabelMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolveAccelLabelMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolveAccelLabelMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveAccelLabelMethod t AccelLabel, O.MethodInfo info AccelLabel p) => OL.IsLabel t (AccelLabel -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

-- VVV Prop "accel-closure"
   -- Type: TGClosure Nothing
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just True)

-- | Get the value of the “@accel-closure@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' accelLabel #accelClosure
-- @
getAccelLabelAccelClosure :: (MonadIO m, IsAccelLabel o) => o -> m (Maybe (GClosure ()))
getAccelLabelAccelClosure :: o -> m (Maybe (GClosure ()))
getAccelLabelAccelClosure obj :: o
obj = IO (Maybe (GClosure ())) -> m (Maybe (GClosure ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (GClosure ())) -> m (Maybe (GClosure ())))
-> IO (Maybe (GClosure ())) -> m (Maybe (GClosure ()))
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe (GClosure ()))
forall a b. GObject a => a -> String -> IO (Maybe (GClosure b))
B.Properties.getObjectPropertyClosure o
obj "accel-closure"

-- | Set the value of the “@accel-closure@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' accelLabel [ #accelClosure 'Data.GI.Base.Attributes.:=' value ]
-- @
setAccelLabelAccelClosure :: (MonadIO m, IsAccelLabel o) => o -> GClosure a -> m ()
setAccelLabelAccelClosure :: o -> GClosure a -> m ()
setAccelLabelAccelClosure obj :: o
obj val :: GClosure a
val = 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 (GClosure a) -> IO ()
forall a b. GObject a => a -> String -> Maybe (GClosure b) -> IO ()
B.Properties.setObjectPropertyClosure o
obj "accel-closure" (GClosure a -> Maybe (GClosure a)
forall a. a -> Maybe a
Just GClosure a
val)

-- | Construct a `GValueConstruct` with valid value for the “@accel-closure@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAccelLabelAccelClosure :: (IsAccelLabel o) => GClosure a -> IO (GValueConstruct o)
constructAccelLabelAccelClosure :: GClosure a -> IO (GValueConstruct o)
constructAccelLabelAccelClosure val :: GClosure a
val = String -> Maybe (GClosure a) -> IO (GValueConstruct o)
forall a o. String -> Maybe (GClosure a) -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyClosure "accel-closure" (GClosure a -> Maybe (GClosure a)
forall a. a -> Maybe a
Just GClosure a
val)

-- | Set the value of the “@accel-closure@” 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' #accelClosure
-- @
clearAccelLabelAccelClosure :: (MonadIO m, IsAccelLabel o) => o -> m ()
clearAccelLabelAccelClosure :: o -> m ()
clearAccelLabelAccelClosure obj :: 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 (GClosure Any) -> IO ()
forall a b. GObject a => a -> String -> Maybe (GClosure b) -> IO ()
B.Properties.setObjectPropertyClosure o
obj "accel-closure" (forall a. Maybe a
forall a. Maybe (GClosure a)
Nothing :: Maybe (GClosure a))

#if defined(ENABLE_OVERLOADING)
data AccelLabelAccelClosurePropertyInfo
instance AttrInfo AccelLabelAccelClosurePropertyInfo where
    type AttrAllowedOps AccelLabelAccelClosurePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint AccelLabelAccelClosurePropertyInfo = IsAccelLabel
    type AttrSetTypeConstraint AccelLabelAccelClosurePropertyInfo = (~) (GClosure ())
    type AttrTransferTypeConstraint AccelLabelAccelClosurePropertyInfo = (~) (GClosure ())
    type AttrTransferType AccelLabelAccelClosurePropertyInfo = GClosure ()
    type AttrGetType AccelLabelAccelClosurePropertyInfo = (Maybe (GClosure ()))
    type AttrLabel AccelLabelAccelClosurePropertyInfo = "accel-closure"
    type AttrOrigin AccelLabelAccelClosurePropertyInfo = AccelLabel
    attrGet = getAccelLabelAccelClosure
    attrSet = setAccelLabelAccelClosure
    attrTransfer _ v = do
        return v
    attrConstruct = constructAccelLabelAccelClosure
    attrClear = clearAccelLabelAccelClosure
#endif

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

-- | Get the value of the “@accel-widget@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' accelLabel #accelWidget
-- @
getAccelLabelAccelWidget :: (MonadIO m, IsAccelLabel o) => o -> m (Maybe Gtk.Widget.Widget)
getAccelLabelAccelWidget :: o -> m (Maybe Widget)
getAccelLabelAccelWidget obj :: o
obj = IO (Maybe Widget) -> m (Maybe Widget)
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
$ 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 "accel-widget" ManagedPtr Widget -> Widget
Gtk.Widget.Widget

-- | Set the value of the “@accel-widget@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' accelLabel [ #accelWidget 'Data.GI.Base.Attributes.:=' value ]
-- @
setAccelLabelAccelWidget :: (MonadIO m, IsAccelLabel o, Gtk.Widget.IsWidget a) => o -> a -> m ()
setAccelLabelAccelWidget :: o -> a -> m ()
setAccelLabelAccelWidget obj :: o
obj val :: a
val = 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 a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "accel-widget" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@accel-widget@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAccelLabelAccelWidget :: (IsAccelLabel o, Gtk.Widget.IsWidget a) => a -> IO (GValueConstruct o)
constructAccelLabelAccelWidget :: a -> IO (GValueConstruct o)
constructAccelLabelAccelWidget val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "accel-widget" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Set the value of the “@accel-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' #accelWidget
-- @
clearAccelLabelAccelWidget :: (MonadIO m, IsAccelLabel o) => o -> m ()
clearAccelLabelAccelWidget :: o -> m ()
clearAccelLabelAccelWidget obj :: 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 Widget -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj "accel-widget" (Maybe Widget
forall a. Maybe a
Nothing :: Maybe Gtk.Widget.Widget)

#if defined(ENABLE_OVERLOADING)
data AccelLabelAccelWidgetPropertyInfo
instance AttrInfo AccelLabelAccelWidgetPropertyInfo where
    type AttrAllowedOps AccelLabelAccelWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint AccelLabelAccelWidgetPropertyInfo = IsAccelLabel
    type AttrSetTypeConstraint AccelLabelAccelWidgetPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint AccelLabelAccelWidgetPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType AccelLabelAccelWidgetPropertyInfo = Gtk.Widget.Widget
    type AttrGetType AccelLabelAccelWidgetPropertyInfo = (Maybe Gtk.Widget.Widget)
    type AttrLabel AccelLabelAccelWidgetPropertyInfo = "accel-widget"
    type AttrOrigin AccelLabelAccelWidgetPropertyInfo = AccelLabel
    attrGet = getAccelLabelAccelWidget
    attrSet = setAccelLabelAccelWidget
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructAccelLabelAccelWidget
    attrClear = clearAccelLabelAccelWidget
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@label@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAccelLabelLabel :: (IsAccelLabel o) => T.Text -> IO (GValueConstruct o)
constructAccelLabelLabel :: Text -> IO (GValueConstruct o)
constructAccelLabelLabel val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "label" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

#if defined(ENABLE_OVERLOADING)
data AccelLabelLabelPropertyInfo
instance AttrInfo AccelLabelLabelPropertyInfo where
    type AttrAllowedOps AccelLabelLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AccelLabelLabelPropertyInfo = IsAccelLabel
    type AttrSetTypeConstraint AccelLabelLabelPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint AccelLabelLabelPropertyInfo = (~) T.Text
    type AttrTransferType AccelLabelLabelPropertyInfo = T.Text
    type AttrGetType AccelLabelLabelPropertyInfo = T.Text
    type AttrLabel AccelLabelLabelPropertyInfo = "label"
    type AttrOrigin AccelLabelLabelPropertyInfo = AccelLabel
    attrGet = getAccelLabelLabel
    attrSet = setAccelLabelLabel
    attrTransfer _ v = do
        return v
    attrConstruct = constructAccelLabelLabel
    attrClear = undefined
#endif

-- VVV Prop "use-underline"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@use-underline@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAccelLabelUseUnderline :: (IsAccelLabel o) => Bool -> IO (GValueConstruct o)
constructAccelLabelUseUnderline :: Bool -> IO (GValueConstruct o)
constructAccelLabelUseUnderline val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "use-underline" Bool
val

#if defined(ENABLE_OVERLOADING)
data AccelLabelUseUnderlinePropertyInfo
instance AttrInfo AccelLabelUseUnderlinePropertyInfo where
    type AttrAllowedOps AccelLabelUseUnderlinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AccelLabelUseUnderlinePropertyInfo = IsAccelLabel
    type AttrSetTypeConstraint AccelLabelUseUnderlinePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint AccelLabelUseUnderlinePropertyInfo = (~) Bool
    type AttrTransferType AccelLabelUseUnderlinePropertyInfo = Bool
    type AttrGetType AccelLabelUseUnderlinePropertyInfo = Bool
    type AttrLabel AccelLabelUseUnderlinePropertyInfo = "use-underline"
    type AttrOrigin AccelLabelUseUnderlinePropertyInfo = AccelLabel
    attrGet = getAccelLabelUseUnderline
    attrSet = setAccelLabelUseUnderline
    attrTransfer _ v = do
        return v
    attrConstruct = constructAccelLabelUseUnderline
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AccelLabel
type instance O.AttributeList AccelLabel = AccelLabelAttributeList
type AccelLabelAttributeList = ('[ '("accelClosure", AccelLabelAccelClosurePropertyInfo), '("accelWidget", AccelLabelAccelWidgetPropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("expand", Gtk.Widget.WidgetExpandPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("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), '("isFocus", Gtk.Widget.WidgetIsFocusPropertyInfo), '("label", AccelLabelLabelPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("margin", Gtk.Widget.WidgetMarginPropertyInfo), '("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), '("surface", Gtk.Widget.WidgetSurfacePropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("useUnderline", AccelLabelUseUnderlinePropertyInfo), '("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)
accelLabelAccelClosure :: AttrLabelProxy "accelClosure"
accelLabelAccelClosure = AttrLabelProxy

accelLabelAccelWidget :: AttrLabelProxy "accelWidget"
accelLabelAccelWidget = AttrLabelProxy

accelLabelLabel :: AttrLabelProxy "label"
accelLabelLabel = AttrLabelProxy

accelLabelUseUnderline :: AttrLabelProxy "useUnderline"
accelLabelUseUnderline = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList AccelLabel = AccelLabelSignalList
type AccelLabelSignalList = ('[ '("accelClosuresChanged", Gtk.Widget.WidgetAccelClosuresChangedSignalInfo), '("canActivateAccel", Gtk.Widget.WidgetCanActivateAccelSignalInfo), '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("dragBegin", Gtk.Widget.WidgetDragBeginSignalInfo), '("dragDataDelete", Gtk.Widget.WidgetDragDataDeleteSignalInfo), '("dragDataGet", Gtk.Widget.WidgetDragDataGetSignalInfo), '("dragDataReceived", Gtk.Widget.WidgetDragDataReceivedSignalInfo), '("dragDrop", Gtk.Widget.WidgetDragDropSignalInfo), '("dragEnd", Gtk.Widget.WidgetDragEndSignalInfo), '("dragFailed", Gtk.Widget.WidgetDragFailedSignalInfo), '("dragLeave", Gtk.Widget.WidgetDragLeaveSignalInfo), '("dragMotion", Gtk.Widget.WidgetDragMotionSignalInfo), '("grabNotify", Gtk.Widget.WidgetGrabNotifySignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("popupMenu", Gtk.Widget.WidgetPopupMenuSignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("sizeAllocate", Gtk.Widget.WidgetSizeAllocateSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("styleUpdated", Gtk.Widget.WidgetStyleUpdatedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, *)])

#endif

-- method AccelLabel::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the label string. Must be non-%NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "AccelLabel" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_label_new" gtk_accel_label_new :: 
    CString ->                              -- string : TBasicType TUTF8
    IO (Ptr AccelLabel)

-- | Creates a new t'GI.Gtk.Objects.AccelLabel.AccelLabel'.
accelLabelNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@string@/: the label string. Must be non-'P.Nothing'.
    -> m AccelLabel
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.AccelLabel.AccelLabel'.
accelLabelNew :: Text -> m AccelLabel
accelLabelNew string :: Text
string = IO AccelLabel -> m AccelLabel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AccelLabel -> m AccelLabel) -> IO AccelLabel -> m AccelLabel
forall a b. (a -> b) -> a -> b
$ do
    CString
string' <- Text -> IO CString
textToCString Text
string
    Ptr AccelLabel
result <- CString -> IO (Ptr AccelLabel)
gtk_accel_label_new CString
string'
    Text -> Ptr AccelLabel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "accelLabelNew" Ptr AccelLabel
result
    AccelLabel
result' <- ((ManagedPtr AccelLabel -> AccelLabel)
-> Ptr AccelLabel -> IO AccelLabel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr AccelLabel -> AccelLabel
AccelLabel) Ptr AccelLabel
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
string'
    AccelLabel -> IO AccelLabel
forall (m :: * -> *) a. Monad m => a -> m a
return AccelLabel
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method AccelLabel::get_accel
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "accel_label"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AccelLabel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAccelLabel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accelerator_key"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the keyval"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "accelerator_mods"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ModifierType" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the modifier mask"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_label_get_accel" gtk_accel_label_get_accel :: 
    Ptr AccelLabel ->                       -- accel_label : TInterface (Name {namespace = "Gtk", name = "AccelLabel"})
    Ptr Word32 ->                           -- accelerator_key : TBasicType TUInt
    Ptr CUInt ->                            -- accelerator_mods : TInterface (Name {namespace = "Gdk", name = "ModifierType"})
    IO ()

-- | Gets the keyval and modifier mask set with
-- 'GI.Gtk.Objects.AccelLabel.accelLabelSetAccel'.
accelLabelGetAccel ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccelLabel a) =>
    a
    -- ^ /@accelLabel@/: a t'GI.Gtk.Objects.AccelLabel.AccelLabel'
    -> m ((Word32, [Gdk.Flags.ModifierType]))
accelLabelGetAccel :: a -> m (Word32, [ModifierType])
accelLabelGetAccel accelLabel :: a
accelLabel = IO (Word32, [ModifierType]) -> m (Word32, [ModifierType])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word32, [ModifierType]) -> m (Word32, [ModifierType]))
-> IO (Word32, [ModifierType]) -> m (Word32, [ModifierType])
forall a b. (a -> b) -> a -> b
$ do
    Ptr AccelLabel
accelLabel' <- a -> IO (Ptr AccelLabel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
accelLabel
    Ptr Word32
acceleratorKey <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr CUInt
acceleratorMods <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    Ptr AccelLabel -> Ptr Word32 -> Ptr CUInt -> IO ()
gtk_accel_label_get_accel Ptr AccelLabel
accelLabel' Ptr Word32
acceleratorKey Ptr CUInt
acceleratorMods
    Word32
acceleratorKey' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
acceleratorKey
    CUInt
acceleratorMods' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
acceleratorMods
    let acceleratorMods'' :: [ModifierType]
acceleratorMods'' = CUInt -> [ModifierType]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
acceleratorMods'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
accelLabel
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
acceleratorKey
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
acceleratorMods
    (Word32, [ModifierType]) -> IO (Word32, [ModifierType])
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
acceleratorKey', [ModifierType]
acceleratorMods'')

#if defined(ENABLE_OVERLOADING)
data AccelLabelGetAccelMethodInfo
instance (signature ~ (m ((Word32, [Gdk.Flags.ModifierType]))), MonadIO m, IsAccelLabel a) => O.MethodInfo AccelLabelGetAccelMethodInfo a signature where
    overloadedMethod = accelLabelGetAccel

#endif

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

foreign import ccall "gtk_accel_label_get_accel_widget" gtk_accel_label_get_accel_widget :: 
    Ptr AccelLabel ->                       -- accel_label : TInterface (Name {namespace = "Gtk", name = "AccelLabel"})
    IO (Ptr Gtk.Widget.Widget)

-- | Fetches the widget monitored by this accelerator label. See
-- 'GI.Gtk.Objects.AccelLabel.accelLabelSetAccelWidget'.
accelLabelGetAccelWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccelLabel a) =>
    a
    -- ^ /@accelLabel@/: a t'GI.Gtk.Objects.AccelLabel.AccelLabel'
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ the object monitored by the accelerator label, or 'P.Nothing'.
accelLabelGetAccelWidget :: a -> m (Maybe Widget)
accelLabelGetAccelWidget accelLabel :: a
accelLabel = IO (Maybe Widget) -> m (Maybe Widget)
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 AccelLabel
accelLabel' <- a -> IO (Ptr AccelLabel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
accelLabel
    Ptr Widget
result <- Ptr AccelLabel -> IO (Ptr Widget)
gtk_accel_label_get_accel_widget Ptr AccelLabel
accelLabel'
    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
$ \result' :: 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 (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
accelLabel
    Maybe Widget -> IO (Maybe Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data AccelLabelGetAccelWidgetMethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsAccelLabel a) => O.MethodInfo AccelLabelGetAccelWidgetMethodInfo a signature where
    overloadedMethod = accelLabelGetAccelWidget

#endif

-- method AccelLabel::get_accel_width
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "accel_label"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AccelLabel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAccelLabel." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_label_get_accel_width" gtk_accel_label_get_accel_width :: 
    Ptr AccelLabel ->                       -- accel_label : TInterface (Name {namespace = "Gtk", name = "AccelLabel"})
    IO Word32

-- | Returns the width needed to display the accelerator key(s).
-- This is used by menus to align all of the t'GI.Gtk.Objects.MenuItem.MenuItem' widgets, and shouldn\'t
-- be needed by applications.
accelLabelGetAccelWidth ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccelLabel a) =>
    a
    -- ^ /@accelLabel@/: a t'GI.Gtk.Objects.AccelLabel.AccelLabel'.
    -> m Word32
    -- ^ __Returns:__ the width needed to display the accelerator key(s).
accelLabelGetAccelWidth :: a -> m Word32
accelLabelGetAccelWidth accelLabel :: a
accelLabel = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr AccelLabel
accelLabel' <- a -> IO (Ptr AccelLabel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
accelLabel
    Word32
result <- Ptr AccelLabel -> IO Word32
gtk_accel_label_get_accel_width Ptr AccelLabel
accelLabel'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
accelLabel
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data AccelLabelGetAccelWidthMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsAccelLabel a) => O.MethodInfo AccelLabelGetAccelWidthMethodInfo a signature where
    overloadedMethod = accelLabelGetAccelWidth

#endif

-- method AccelLabel::get_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "accel_label"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AccelLabel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAccelLabel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_label_get_label" gtk_accel_label_get_label :: 
    Ptr AccelLabel ->                       -- accel_label : TInterface (Name {namespace = "Gtk", name = "AccelLabel"})
    IO CString

-- | Returns the current label, set via 'GI.Gtk.Objects.AccelLabel.accelLabelSetLabel'
accelLabelGetLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccelLabel a) =>
    a
    -- ^ /@accelLabel@/: a t'GI.Gtk.Objects.AccelLabel.AccelLabel'
    -> m T.Text
    -- ^ __Returns:__ /@accelLabel@/\'s label
accelLabelGetLabel :: a -> m Text
accelLabelGetLabel accelLabel :: a
accelLabel = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr AccelLabel
accelLabel' <- a -> IO (Ptr AccelLabel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
accelLabel
    CString
result <- Ptr AccelLabel -> IO CString
gtk_accel_label_get_label Ptr AccelLabel
accelLabel'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "accelLabelGetLabel" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
accelLabel
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AccelLabelGetLabelMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAccelLabel a) => O.MethodInfo AccelLabelGetLabelMethodInfo a signature where
    overloadedMethod = accelLabelGetLabel

#endif

-- method AccelLabel::get_use_underline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "accel_label"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AccelLabel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAccelLabel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_label_get_use_underline" gtk_accel_label_get_use_underline :: 
    Ptr AccelLabel ->                       -- accel_label : TInterface (Name {namespace = "Gtk", name = "AccelLabel"})
    IO CInt

-- | Returns whether the accel label interprets underscores in it\'s
-- label property as mnemonic indicators.
-- See 'GI.Gtk.Objects.AccelLabel.accelLabelSetUseUnderline' and 'GI.Gtk.Objects.Label.labelSetUseUnderline';
accelLabelGetUseUnderline ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccelLabel a) =>
    a
    -- ^ /@accelLabel@/: a t'GI.Gtk.Objects.AccelLabel.AccelLabel'
    -> m Bool
    -- ^ __Returns:__ whether the accel label uses mnemonic underlines
accelLabelGetUseUnderline :: a -> m Bool
accelLabelGetUseUnderline accelLabel :: a
accelLabel = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AccelLabel
accelLabel' <- a -> IO (Ptr AccelLabel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
accelLabel
    CInt
result <- Ptr AccelLabel -> IO CInt
gtk_accel_label_get_use_underline Ptr AccelLabel
accelLabel'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
accelLabel
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AccelLabelGetUseUnderlineMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAccelLabel a) => O.MethodInfo AccelLabelGetUseUnderlineMethodInfo a signature where
    overloadedMethod = accelLabelGetUseUnderline

#endif

-- method AccelLabel::refetch
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "accel_label"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AccelLabel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAccelLabel." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_label_refetch" gtk_accel_label_refetch :: 
    Ptr AccelLabel ->                       -- accel_label : TInterface (Name {namespace = "Gtk", name = "AccelLabel"})
    IO CInt

-- | Recreates the string representing the accelerator keys.
-- This should not be needed since the string is automatically updated whenever
-- accelerators are added or removed from the associated widget.
accelLabelRefetch ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccelLabel a) =>
    a
    -- ^ /@accelLabel@/: a t'GI.Gtk.Objects.AccelLabel.AccelLabel'.
    -> m Bool
    -- ^ __Returns:__ always returns 'P.False'.
accelLabelRefetch :: a -> m Bool
accelLabelRefetch accelLabel :: a
accelLabel = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AccelLabel
accelLabel' <- a -> IO (Ptr AccelLabel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
accelLabel
    CInt
result <- Ptr AccelLabel -> IO CInt
gtk_accel_label_refetch Ptr AccelLabel
accelLabel'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
accelLabel
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AccelLabelRefetchMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAccelLabel a) => O.MethodInfo AccelLabelRefetchMethodInfo a signature where
    overloadedMethod = accelLabelRefetch

#endif

-- method AccelLabel::set_accel
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "accel_label"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AccelLabel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAccelLabel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accelerator_key"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a keyval, or 0" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accelerator_mods"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ModifierType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the modifier mask for the accel"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_label_set_accel" gtk_accel_label_set_accel :: 
    Ptr AccelLabel ->                       -- accel_label : TInterface (Name {namespace = "Gtk", name = "AccelLabel"})
    Word32 ->                               -- accelerator_key : TBasicType TUInt
    CUInt ->                                -- accelerator_mods : TInterface (Name {namespace = "Gdk", name = "ModifierType"})
    IO ()

-- | Manually sets a keyval and modifier mask as the accelerator rendered
-- by /@accelLabel@/.
-- 
-- If a keyval and modifier are explicitly set then these values are
-- used regardless of any associated accel closure or widget.
-- 
-- Providing an /@acceleratorKey@/ of 0 removes the manual setting.
accelLabelSetAccel ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccelLabel a) =>
    a
    -- ^ /@accelLabel@/: a t'GI.Gtk.Objects.AccelLabel.AccelLabel'
    -> Word32
    -- ^ /@acceleratorKey@/: a keyval, or 0
    -> [Gdk.Flags.ModifierType]
    -- ^ /@acceleratorMods@/: the modifier mask for the accel
    -> m ()
accelLabelSetAccel :: a -> Word32 -> [ModifierType] -> m ()
accelLabelSetAccel accelLabel :: a
accelLabel acceleratorKey :: Word32
acceleratorKey acceleratorMods :: [ModifierType]
acceleratorMods = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AccelLabel
accelLabel' <- a -> IO (Ptr AccelLabel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
accelLabel
    let acceleratorMods' :: CUInt
acceleratorMods' = [ModifierType] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ModifierType]
acceleratorMods
    Ptr AccelLabel -> Word32 -> CUInt -> IO ()
gtk_accel_label_set_accel Ptr AccelLabel
accelLabel' Word32
acceleratorKey CUInt
acceleratorMods'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
accelLabel
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AccelLabelSetAccelMethodInfo
instance (signature ~ (Word32 -> [Gdk.Flags.ModifierType] -> m ()), MonadIO m, IsAccelLabel a) => O.MethodInfo AccelLabelSetAccelMethodInfo a signature where
    overloadedMethod = accelLabelSetAccel

#endif

-- method AccelLabel::set_accel_closure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "accel_label"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AccelLabel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAccelLabel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accel_closure"
--           , argType = TGClosure Nothing
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the closure to monitor for accelerator changes,\nor %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_label_set_accel_closure" gtk_accel_label_set_accel_closure :: 
    Ptr AccelLabel ->                       -- accel_label : TInterface (Name {namespace = "Gtk", name = "AccelLabel"})
    Ptr (GClosure ()) ->                    -- accel_closure : TGClosure Nothing
    IO ()

-- | Sets the closure to be monitored by this accelerator label. The closure
-- must be connected to an accelerator group; see 'GI.Gtk.Objects.AccelGroup.accelGroupConnect'.
-- Passing 'P.Nothing' for /@accelClosure@/ will dissociate /@accelLabel@/ from its
-- current closure, if any.
accelLabelSetAccelClosure ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccelLabel a) =>
    a
    -- ^ /@accelLabel@/: a t'GI.Gtk.Objects.AccelLabel.AccelLabel'
    -> Maybe (GClosure b)
    -- ^ /@accelClosure@/: the closure to monitor for accelerator changes,
    -- or 'P.Nothing'
    -> m ()
accelLabelSetAccelClosure :: a -> Maybe (GClosure b) -> m ()
accelLabelSetAccelClosure accelLabel :: a
accelLabel accelClosure :: Maybe (GClosure b)
accelClosure = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AccelLabel
accelLabel' <- a -> IO (Ptr AccelLabel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
accelLabel
    Ptr (GClosure ())
maybeAccelClosure <- case Maybe (GClosure b)
accelClosure of
        Nothing -> Ptr (GClosure ()) -> IO (Ptr (GClosure ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GClosure ())
forall a. Ptr a
nullPtr
        Just jAccelClosure :: GClosure b
jAccelClosure -> do
            Ptr (GClosure ())
jAccelClosure' <- GClosure b -> IO (Ptr (GClosure ()))
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr GClosure b
jAccelClosure
            Ptr (GClosure ()) -> IO (Ptr (GClosure ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GClosure ())
jAccelClosure'
    Ptr AccelLabel -> Ptr (GClosure ()) -> IO ()
gtk_accel_label_set_accel_closure Ptr AccelLabel
accelLabel' Ptr (GClosure ())
maybeAccelClosure
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
accelLabel
    Maybe (GClosure b) -> (GClosure b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (GClosure b)
accelClosure GClosure b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AccelLabelSetAccelClosureMethodInfo
instance (signature ~ (Maybe (GClosure b) -> m ()), MonadIO m, IsAccelLabel a) => O.MethodInfo AccelLabelSetAccelClosureMethodInfo a signature where
    overloadedMethod = accelLabelSetAccelClosure

#endif

-- method AccelLabel::set_accel_widget
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "accel_label"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AccelLabel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAccelLabel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accel_widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the widget to be monitored, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_label_set_accel_widget" gtk_accel_label_set_accel_widget :: 
    Ptr AccelLabel ->                       -- accel_label : TInterface (Name {namespace = "Gtk", name = "AccelLabel"})
    Ptr Gtk.Widget.Widget ->                -- accel_widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | Sets the widget to be monitored by this accelerator label. Passing 'P.Nothing' for
-- /@accelWidget@/ will dissociate /@accelLabel@/ from its current widget, if any.
accelLabelSetAccelWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccelLabel a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@accelLabel@/: a t'GI.Gtk.Objects.AccelLabel.AccelLabel'
    -> Maybe (b)
    -- ^ /@accelWidget@/: the widget to be monitored, or 'P.Nothing'
    -> m ()
accelLabelSetAccelWidget :: a -> Maybe b -> m ()
accelLabelSetAccelWidget accelLabel :: a
accelLabel accelWidget :: Maybe b
accelWidget = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AccelLabel
accelLabel' <- a -> IO (Ptr AccelLabel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
accelLabel
    Ptr Widget
maybeAccelWidget <- case Maybe b
accelWidget of
        Nothing -> Ptr Widget -> IO (Ptr Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
        Just jAccelWidget :: b
jAccelWidget -> do
            Ptr Widget
jAccelWidget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jAccelWidget
            Ptr Widget -> IO (Ptr Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jAccelWidget'
    Ptr AccelLabel -> Ptr Widget -> IO ()
gtk_accel_label_set_accel_widget Ptr AccelLabel
accelLabel' Ptr Widget
maybeAccelWidget
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
accelLabel
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
accelWidget b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AccelLabelSetAccelWidgetMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsAccelLabel a, Gtk.Widget.IsWidget b) => O.MethodInfo AccelLabelSetAccelWidgetMethodInfo a signature where
    overloadedMethod = accelLabelSetAccelWidget

#endif

-- method AccelLabel::set_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "accel_label"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AccelLabel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAccelLabel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new label text" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_label_set_label" gtk_accel_label_set_label :: 
    Ptr AccelLabel ->                       -- accel_label : TInterface (Name {namespace = "Gtk", name = "AccelLabel"})
    CString ->                              -- text : TBasicType TUTF8
    IO ()

-- | Sets the label part of the accel label.
accelLabelSetLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccelLabel a) =>
    a
    -- ^ /@accelLabel@/: a t'GI.Gtk.Objects.AccelLabel.AccelLabel'
    -> T.Text
    -- ^ /@text@/: The new label text
    -> m ()
accelLabelSetLabel :: a -> Text -> m ()
accelLabelSetLabel accelLabel :: a
accelLabel text :: Text
text = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AccelLabel
accelLabel' <- a -> IO (Ptr AccelLabel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
accelLabel
    CString
text' <- Text -> IO CString
textToCString Text
text
    Ptr AccelLabel -> CString -> IO ()
gtk_accel_label_set_label Ptr AccelLabel
accelLabel' CString
text'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
accelLabel
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AccelLabelSetLabelMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsAccelLabel a) => O.MethodInfo AccelLabelSetLabelMethodInfo a signature where
    overloadedMethod = accelLabelSetLabel

#endif

-- method AccelLabel::set_use_underline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "accel_label"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "AccelLabel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkAccelLabel" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "setting"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether to use underlines in the label or not"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_accel_label_set_use_underline" gtk_accel_label_set_use_underline :: 
    Ptr AccelLabel ->                       -- accel_label : TInterface (Name {namespace = "Gtk", name = "AccelLabel"})
    CInt ->                                 -- setting : TBasicType TBoolean
    IO ()

-- | Controls whether to interpret underscores in the text label of /@accelLabel@/
-- as mnemonic indicators. See also 'GI.Gtk.Objects.Label.labelSetUseUnderline'
accelLabelSetUseUnderline ::
    (B.CallStack.HasCallStack, MonadIO m, IsAccelLabel a) =>
    a
    -- ^ /@accelLabel@/: a t'GI.Gtk.Objects.AccelLabel.AccelLabel'
    -> Bool
    -- ^ /@setting@/: Whether to use underlines in the label or not
    -> m ()
accelLabelSetUseUnderline :: a -> Bool -> m ()
accelLabelSetUseUnderline accelLabel :: a
accelLabel setting :: Bool
setting = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AccelLabel
accelLabel' <- a -> IO (Ptr AccelLabel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
accelLabel
    let setting' :: CInt
setting' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
setting
    Ptr AccelLabel -> CInt -> IO ()
gtk_accel_label_set_use_underline Ptr AccelLabel
accelLabel' CInt
setting'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
accelLabel
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AccelLabelSetUseUnderlineMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAccelLabel a) => O.MethodInfo AccelLabelSetUseUnderlineMethodInfo a signature where
    overloadedMethod = accelLabelSetUseUnderline

#endif