{-# 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 @/gtk_accel_label_set_accel_widget()/@.
-- 
-- For example, a menu item 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 menu item widget, and
-- @/gtk_accel_label_set_accel_widget()/@ is called with the item as the
-- second argument. The t'GI.Gtk.Objects.AccelLabel.AccelLabel' will now display “Ctrl+S” after its label.
-- 
-- Note that accel labels are typically set up automatically when menus
-- are created.
-- 
-- A t'GI.Gtk.Objects.AccelLabel.AccelLabel' will only display accelerators which have @/GTK_ACCEL_VISIBLE/@
-- set (see @/GtkAccelFlags/@).
-- 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.
-- 
-- = CSS nodes
-- 
-- 
-- === /plain code/
-- >
-- >accellabel
-- >  ├── label
-- >  ╰── accelerator
-- 
-- 
-- t'GI.Gtk.Objects.AccelLabel.AccelLabel' has a main CSS node with the name accellabel.
-- It contains the 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                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAccelLabelMethod                 ,
#endif


-- ** getAccel #method:getAccel#

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


-- ** 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                      ,


-- ** setLabel #method:setLabel#

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


-- ** setUseUnderline #method:setUseUnderline#

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




 -- * Properties
-- ** 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.BasicTypes as B.Types
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 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 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.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

-- | Memory-managed wrapper type.
newtype AccelLabel = AccelLabel (SP.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)

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

foreign import ccall "gtk_accel_label_get_type"
    c_gtk_accel_label_get_type :: IO B.Types.GType

instance B.Types.TypedObject AccelLabel where
    glibType :: IO GType
glibType = IO GType
c_gtk_accel_label_get_type

instance B.Types.GObject AccelLabel

-- | 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 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 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 (SP.GObject o, O.IsDescendantOf AccelLabel o) => IsAccelLabel o
instance (SP.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, Gtk.ConstraintTarget.ConstraintTarget]

-- | 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, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr AccelLabel -> AccelLabel
AccelLabel

#if defined(ENABLE_OVERLOADING)
type family ResolveAccelLabelMethod (t :: Symbol) (o :: *) :: * where
    ResolveAccelLabelMethod "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
    ResolveAccelLabelMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveAccelLabelMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveAccelLabelMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveAccelLabelMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveAccelLabelMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveAccelLabelMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
    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 "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 "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
    ResolveAccelLabelMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveAccelLabelMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveAccelLabelMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAccelLabelMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAccelLabelMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAccelLabelMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveAccelLabelMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
    ResolveAccelLabelMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveAccelLabelMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    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 "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 "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveAccelLabelMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    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 "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveAccelLabelMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveAccelLabelMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveAccelLabelMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAccelLabelMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAccelLabelMethod "refetch" o = AccelLabelRefetchMethodInfo
    ResolveAccelLabelMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveAccelLabelMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
    ResolveAccelLabelMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveAccelLabelMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveAccelLabelMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAccelLabelMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
    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 "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveAccelLabelMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAccelLabelMethod "getAccel" o = AccelLabelGetAccelMethodInfo
    ResolveAccelLabelMethod "getAccelWidth" o = AccelLabelGetAccelWidthMethodInfo
    ResolveAccelLabelMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
    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 "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
    ResolveAccelLabelMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
    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 "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
    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 "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 "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveAccelLabelMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
    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 "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 "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveAccelLabelMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveAccelLabelMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    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 "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveAccelLabelMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveAccelLabelMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveAccelLabelMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveAccelLabelMethod "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
    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 "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
    ResolveAccelLabelMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveAccelLabelMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveAccelLabelMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    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 "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveAccelLabelMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    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 "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 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 Text
"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 String
"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 o
obj 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 String
"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, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructAccelLabelLabel :: Text -> m (GValueConstruct o)
constructAccelLabelLabel 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
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"label" (Text -> Maybe Text
forall a. a -> Maybe a
P.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 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 String
"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 o
obj 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 String
"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, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructAccelLabelUseUnderline :: Bool -> m (GValueConstruct o)
constructAccelLabelUseUnderline 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
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"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 = ('[ '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("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), '("label", AccelLabelLabelPropertyInfo), '("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), '("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)
accelLabelLabel :: AttrLabelProxy "label"
accelLabelLabel = AttrLabelProxy

accelLabelUseUnderline :: AttrLabelProxy "useUnderline"
accelLabelUseUnderline = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList AccelLabel = AccelLabelSignalList
type AccelLabelSignalList = ('[ '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("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), '("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

-- 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 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 Text
"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 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_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 menu item 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 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 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 Text
"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 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
/= CInt
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 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
/= CInt
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 a
accelLabel Word32
acceleratorKey [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_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 a
accelLabel 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 a
accelLabel 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