{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Gtk.Objects.Label
    ( 

-- * Exported types
    Label(..)                               ,
    LabelK                                  ,
    toLabel                                 ,
    noLabel                                 ,


 -- * Methods
-- ** labelGetAngle
    labelGetAngle                           ,


-- ** labelGetAttributes
    labelGetAttributes                      ,


-- ** labelGetCurrentUri
    labelGetCurrentUri                      ,


-- ** labelGetEllipsize
    labelGetEllipsize                       ,


-- ** labelGetJustify
    labelGetJustify                         ,


-- ** labelGetLabel
    labelGetLabel                           ,


-- ** labelGetLayout
    labelGetLayout                          ,


-- ** labelGetLayoutOffsets
    labelGetLayoutOffsets                   ,


-- ** labelGetLineWrap
    labelGetLineWrap                        ,


-- ** labelGetLineWrapMode
    labelGetLineWrapMode                    ,


-- ** labelGetLines
    labelGetLines                           ,


-- ** labelGetMaxWidthChars
    labelGetMaxWidthChars                   ,


-- ** labelGetMnemonicKeyval
    labelGetMnemonicKeyval                  ,


-- ** labelGetMnemonicWidget
    labelGetMnemonicWidget                  ,


-- ** labelGetSelectable
    labelGetSelectable                      ,


-- ** labelGetSelectionBounds
    labelGetSelectionBounds                 ,


-- ** labelGetSingleLineMode
    labelGetSingleLineMode                  ,


-- ** labelGetText
    labelGetText                            ,


-- ** labelGetTrackVisitedLinks
    labelGetTrackVisitedLinks               ,


-- ** labelGetUseMarkup
    labelGetUseMarkup                       ,


-- ** labelGetUseUnderline
    labelGetUseUnderline                    ,


-- ** labelGetWidthChars
    labelGetWidthChars                      ,


-- ** labelGetXalign
    labelGetXalign                          ,


-- ** labelGetYalign
    labelGetYalign                          ,


-- ** labelNew
    labelNew                                ,


-- ** labelNewWithMnemonic
    labelNewWithMnemonic                    ,


-- ** labelSelectRegion
    labelSelectRegion                       ,


-- ** labelSetAngle
    labelSetAngle                           ,


-- ** labelSetAttributes
    labelSetAttributes                      ,


-- ** labelSetEllipsize
    labelSetEllipsize                       ,


-- ** labelSetJustify
    labelSetJustify                         ,


-- ** labelSetLabel
    labelSetLabel                           ,


-- ** labelSetLineWrap
    labelSetLineWrap                        ,


-- ** labelSetLineWrapMode
    labelSetLineWrapMode                    ,


-- ** labelSetLines
    labelSetLines                           ,


-- ** labelSetMarkup
    labelSetMarkup                          ,


-- ** labelSetMarkupWithMnemonic
    labelSetMarkupWithMnemonic              ,


-- ** labelSetMaxWidthChars
    labelSetMaxWidthChars                   ,


-- ** labelSetMnemonicWidget
    labelSetMnemonicWidget                  ,


-- ** labelSetPattern
    labelSetPattern                         ,


-- ** labelSetSelectable
    labelSetSelectable                      ,


-- ** labelSetSingleLineMode
    labelSetSingleLineMode                  ,


-- ** labelSetText
    labelSetText                            ,


-- ** labelSetTextWithMnemonic
    labelSetTextWithMnemonic                ,


-- ** labelSetTrackVisitedLinks
    labelSetTrackVisitedLinks               ,


-- ** labelSetUseMarkup
    labelSetUseMarkup                       ,


-- ** labelSetUseUnderline
    labelSetUseUnderline                    ,


-- ** labelSetWidthChars
    labelSetWidthChars                      ,


-- ** labelSetXalign
    labelSetXalign                          ,


-- ** labelSetYalign
    labelSetYalign                          ,




 -- * Properties
-- ** Angle
    LabelAnglePropertyInfo                  ,
    constructLabelAngle                     ,
    getLabelAngle                           ,
    setLabelAngle                           ,


-- ** Attributes
    LabelAttributesPropertyInfo             ,
    constructLabelAttributes                ,
    getLabelAttributes                      ,
    setLabelAttributes                      ,


-- ** CursorPosition
    LabelCursorPositionPropertyInfo         ,
    getLabelCursorPosition                  ,


-- ** Ellipsize
    LabelEllipsizePropertyInfo              ,
    constructLabelEllipsize                 ,
    getLabelEllipsize                       ,
    setLabelEllipsize                       ,


-- ** Justify
    LabelJustifyPropertyInfo                ,
    constructLabelJustify                   ,
    getLabelJustify                         ,
    setLabelJustify                         ,


-- ** Label
    LabelLabelPropertyInfo                  ,
    constructLabelLabel                     ,
    getLabelLabel                           ,
    setLabelLabel                           ,


-- ** Lines
    LabelLinesPropertyInfo                  ,
    constructLabelLines                     ,
    getLabelLines                           ,
    setLabelLines                           ,


-- ** MaxWidthChars
    LabelMaxWidthCharsPropertyInfo          ,
    constructLabelMaxWidthChars             ,
    getLabelMaxWidthChars                   ,
    setLabelMaxWidthChars                   ,


-- ** MnemonicKeyval
    LabelMnemonicKeyvalPropertyInfo         ,
    getLabelMnemonicKeyval                  ,


-- ** MnemonicWidget
    LabelMnemonicWidgetPropertyInfo         ,
    constructLabelMnemonicWidget            ,
    getLabelMnemonicWidget                  ,
    setLabelMnemonicWidget                  ,


-- ** Pattern
    LabelPatternPropertyInfo                ,
    constructLabelPattern                   ,
    setLabelPattern                         ,


-- ** Selectable
    LabelSelectablePropertyInfo             ,
    constructLabelSelectable                ,
    getLabelSelectable                      ,
    setLabelSelectable                      ,


-- ** SelectionBound
    LabelSelectionBoundPropertyInfo         ,
    getLabelSelectionBound                  ,


-- ** SingleLineMode
    LabelSingleLineModePropertyInfo         ,
    constructLabelSingleLineMode            ,
    getLabelSingleLineMode                  ,
    setLabelSingleLineMode                  ,


-- ** TrackVisitedLinks
    LabelTrackVisitedLinksPropertyInfo      ,
    constructLabelTrackVisitedLinks         ,
    getLabelTrackVisitedLinks               ,
    setLabelTrackVisitedLinks               ,


-- ** UseMarkup
    LabelUseMarkupPropertyInfo              ,
    constructLabelUseMarkup                 ,
    getLabelUseMarkup                       ,
    setLabelUseMarkup                       ,


-- ** UseUnderline
    LabelUseUnderlinePropertyInfo           ,
    constructLabelUseUnderline              ,
    getLabelUseUnderline                    ,
    setLabelUseUnderline                    ,


-- ** WidthChars
    LabelWidthCharsPropertyInfo             ,
    constructLabelWidthChars                ,
    getLabelWidthChars                      ,
    setLabelWidthChars                      ,


-- ** Wrap
    LabelWrapPropertyInfo                   ,
    constructLabelWrap                      ,
    getLabelWrap                            ,
    setLabelWrap                            ,


-- ** WrapMode
    LabelWrapModePropertyInfo               ,
    constructLabelWrapMode                  ,
    getLabelWrapMode                        ,
    setLabelWrapMode                        ,


-- ** Xalign
    LabelXalignPropertyInfo                 ,
    constructLabelXalign                    ,
    getLabelXalign                          ,
    setLabelXalign                          ,


-- ** Yalign
    LabelYalignPropertyInfo                 ,
    constructLabelYalign                    ,
    getLabelYalign                          ,
    setLabelYalign                          ,




 -- * Signals
-- ** ActivateCurrentLink
    LabelActivateCurrentLinkCallback        ,
    LabelActivateCurrentLinkCallbackC       ,
    LabelActivateCurrentLinkSignalInfo      ,
    afterLabelActivateCurrentLink           ,
    labelActivateCurrentLinkCallbackWrapper ,
    labelActivateCurrentLinkClosure         ,
    mkLabelActivateCurrentLinkCallback      ,
    noLabelActivateCurrentLinkCallback      ,
    onLabelActivateCurrentLink              ,


-- ** ActivateLink
    LabelActivateLinkCallback               ,
    LabelActivateLinkCallbackC              ,
    LabelActivateLinkSignalInfo             ,
    afterLabelActivateLink                  ,
    labelActivateLinkCallbackWrapper        ,
    labelActivateLinkClosure                ,
    mkLabelActivateLinkCallback             ,
    noLabelActivateLinkCallback             ,
    onLabelActivateLink                     ,


-- ** CopyClipboard
    LabelCopyClipboardCallback              ,
    LabelCopyClipboardCallbackC             ,
    LabelCopyClipboardSignalInfo            ,
    afterLabelCopyClipboard                 ,
    labelCopyClipboardCallbackWrapper       ,
    labelCopyClipboardClosure               ,
    mkLabelCopyClipboardCallback            ,
    noLabelCopyClipboardCallback            ,
    onLabelCopyClipboard                    ,


-- ** MoveCursor
    LabelMoveCursorCallback                 ,
    LabelMoveCursorCallbackC                ,
    LabelMoveCursorSignalInfo               ,
    afterLabelMoveCursor                    ,
    labelMoveCursorCallbackWrapper          ,
    labelMoveCursorClosure                  ,
    mkLabelMoveCursorCallback               ,
    noLabelMoveCursorCallback               ,
    onLabelMoveCursor                       ,


-- ** PopulatePopup
    LabelPopulatePopupCallback              ,
    LabelPopulatePopupCallbackC             ,
    LabelPopulatePopupSignalInfo            ,
    afterLabelPopulatePopup                 ,
    labelPopulatePopupCallbackWrapper       ,
    labelPopulatePopupClosure               ,
    mkLabelPopulatePopupCallback            ,
    noLabelPopulatePopupCallback            ,
    onLabelPopulatePopup                    ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gtk.Types
import GI.Gtk.Callbacks
import qualified GI.Atk as Atk
import qualified GI.GObject as GObject
import qualified GI.Pango as Pango

newtype Label = Label (ForeignPtr Label)
foreign import ccall "gtk_label_get_type"
    c_gtk_label_get_type :: IO GType

type instance ParentTypes Label = LabelParentTypes
type LabelParentTypes = '[Misc, Widget, GObject.Object, Atk.ImplementorIface, Buildable]

instance GObject Label where
    gobjectIsInitiallyUnowned _ = True
    gobjectType _ = c_gtk_label_get_type
    

class GObject o => LabelK o
instance (GObject o, IsDescendantOf Label o) => LabelK o

toLabel :: LabelK o => o -> IO Label
toLabel = unsafeCastTo Label

noLabel :: Maybe Label
noLabel = Nothing

-- signal Label::activate-current-link
type LabelActivateCurrentLinkCallback =
    IO ()

noLabelActivateCurrentLinkCallback :: Maybe LabelActivateCurrentLinkCallback
noLabelActivateCurrentLinkCallback = Nothing

type LabelActivateCurrentLinkCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkLabelActivateCurrentLinkCallback :: LabelActivateCurrentLinkCallbackC -> IO (FunPtr LabelActivateCurrentLinkCallbackC)

labelActivateCurrentLinkClosure :: LabelActivateCurrentLinkCallback -> IO Closure
labelActivateCurrentLinkClosure cb = newCClosure =<< mkLabelActivateCurrentLinkCallback wrapped
    where wrapped = labelActivateCurrentLinkCallbackWrapper cb

labelActivateCurrentLinkCallbackWrapper ::
    LabelActivateCurrentLinkCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
labelActivateCurrentLinkCallbackWrapper _cb _ _ = do
    _cb 

onLabelActivateCurrentLink :: (GObject a, MonadIO m) => a -> LabelActivateCurrentLinkCallback -> m SignalHandlerId
onLabelActivateCurrentLink obj cb = liftIO $ connectLabelActivateCurrentLink obj cb SignalConnectBefore
afterLabelActivateCurrentLink :: (GObject a, MonadIO m) => a -> LabelActivateCurrentLinkCallback -> m SignalHandlerId
afterLabelActivateCurrentLink obj cb = connectLabelActivateCurrentLink obj cb SignalConnectAfter

connectLabelActivateCurrentLink :: (GObject a, MonadIO m) =>
                                   a -> LabelActivateCurrentLinkCallback -> SignalConnectMode -> m SignalHandlerId
connectLabelActivateCurrentLink obj cb after = liftIO $ do
    cb' <- mkLabelActivateCurrentLinkCallback (labelActivateCurrentLinkCallbackWrapper cb)
    connectSignalFunPtr obj "activate-current-link" cb' after

-- signal Label::activate-link
type LabelActivateLinkCallback =
    T.Text ->
    IO Bool

noLabelActivateLinkCallback :: Maybe LabelActivateLinkCallback
noLabelActivateLinkCallback = Nothing

type LabelActivateLinkCallbackC =
    Ptr () ->                               -- object
    CString ->
    Ptr () ->                               -- user_data
    IO CInt

foreign import ccall "wrapper"
    mkLabelActivateLinkCallback :: LabelActivateLinkCallbackC -> IO (FunPtr LabelActivateLinkCallbackC)

labelActivateLinkClosure :: LabelActivateLinkCallback -> IO Closure
labelActivateLinkClosure cb = newCClosure =<< mkLabelActivateLinkCallback wrapped
    where wrapped = labelActivateLinkCallbackWrapper cb

labelActivateLinkCallbackWrapper ::
    LabelActivateLinkCallback ->
    Ptr () ->
    CString ->
    Ptr () ->
    IO CInt
labelActivateLinkCallbackWrapper _cb _ uri _ = do
    uri' <- cstringToText uri
    result <- _cb  uri'
    let result' = (fromIntegral . fromEnum) result
    return result'

onLabelActivateLink :: (GObject a, MonadIO m) => a -> LabelActivateLinkCallback -> m SignalHandlerId
onLabelActivateLink obj cb = liftIO $ connectLabelActivateLink obj cb SignalConnectBefore
afterLabelActivateLink :: (GObject a, MonadIO m) => a -> LabelActivateLinkCallback -> m SignalHandlerId
afterLabelActivateLink obj cb = connectLabelActivateLink obj cb SignalConnectAfter

connectLabelActivateLink :: (GObject a, MonadIO m) =>
                            a -> LabelActivateLinkCallback -> SignalConnectMode -> m SignalHandlerId
connectLabelActivateLink obj cb after = liftIO $ do
    cb' <- mkLabelActivateLinkCallback (labelActivateLinkCallbackWrapper cb)
    connectSignalFunPtr obj "activate-link" cb' after

-- signal Label::copy-clipboard
type LabelCopyClipboardCallback =
    IO ()

noLabelCopyClipboardCallback :: Maybe LabelCopyClipboardCallback
noLabelCopyClipboardCallback = Nothing

type LabelCopyClipboardCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkLabelCopyClipboardCallback :: LabelCopyClipboardCallbackC -> IO (FunPtr LabelCopyClipboardCallbackC)

labelCopyClipboardClosure :: LabelCopyClipboardCallback -> IO Closure
labelCopyClipboardClosure cb = newCClosure =<< mkLabelCopyClipboardCallback wrapped
    where wrapped = labelCopyClipboardCallbackWrapper cb

labelCopyClipboardCallbackWrapper ::
    LabelCopyClipboardCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
labelCopyClipboardCallbackWrapper _cb _ _ = do
    _cb 

onLabelCopyClipboard :: (GObject a, MonadIO m) => a -> LabelCopyClipboardCallback -> m SignalHandlerId
onLabelCopyClipboard obj cb = liftIO $ connectLabelCopyClipboard obj cb SignalConnectBefore
afterLabelCopyClipboard :: (GObject a, MonadIO m) => a -> LabelCopyClipboardCallback -> m SignalHandlerId
afterLabelCopyClipboard obj cb = connectLabelCopyClipboard obj cb SignalConnectAfter

connectLabelCopyClipboard :: (GObject a, MonadIO m) =>
                             a -> LabelCopyClipboardCallback -> SignalConnectMode -> m SignalHandlerId
connectLabelCopyClipboard obj cb after = liftIO $ do
    cb' <- mkLabelCopyClipboardCallback (labelCopyClipboardCallbackWrapper cb)
    connectSignalFunPtr obj "copy-clipboard" cb' after

-- signal Label::move-cursor
type LabelMoveCursorCallback =
    MovementStep ->
    Int32 ->
    Bool ->
    IO ()

noLabelMoveCursorCallback :: Maybe LabelMoveCursorCallback
noLabelMoveCursorCallback = Nothing

type LabelMoveCursorCallbackC =
    Ptr () ->                               -- object
    CUInt ->
    Int32 ->
    CInt ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkLabelMoveCursorCallback :: LabelMoveCursorCallbackC -> IO (FunPtr LabelMoveCursorCallbackC)

labelMoveCursorClosure :: LabelMoveCursorCallback -> IO Closure
labelMoveCursorClosure cb = newCClosure =<< mkLabelMoveCursorCallback wrapped
    where wrapped = labelMoveCursorCallbackWrapper cb

labelMoveCursorCallbackWrapper ::
    LabelMoveCursorCallback ->
    Ptr () ->
    CUInt ->
    Int32 ->
    CInt ->
    Ptr () ->
    IO ()
labelMoveCursorCallbackWrapper _cb _ step count extend_selection _ = do
    let step' = (toEnum . fromIntegral) step
    let extend_selection' = (/= 0) extend_selection
    _cb  step' count extend_selection'

onLabelMoveCursor :: (GObject a, MonadIO m) => a -> LabelMoveCursorCallback -> m SignalHandlerId
onLabelMoveCursor obj cb = liftIO $ connectLabelMoveCursor obj cb SignalConnectBefore
afterLabelMoveCursor :: (GObject a, MonadIO m) => a -> LabelMoveCursorCallback -> m SignalHandlerId
afterLabelMoveCursor obj cb = connectLabelMoveCursor obj cb SignalConnectAfter

connectLabelMoveCursor :: (GObject a, MonadIO m) =>
                          a -> LabelMoveCursorCallback -> SignalConnectMode -> m SignalHandlerId
connectLabelMoveCursor obj cb after = liftIO $ do
    cb' <- mkLabelMoveCursorCallback (labelMoveCursorCallbackWrapper cb)
    connectSignalFunPtr obj "move-cursor" cb' after

-- signal Label::populate-popup
type LabelPopulatePopupCallback =
    Menu ->
    IO ()

noLabelPopulatePopupCallback :: Maybe LabelPopulatePopupCallback
noLabelPopulatePopupCallback = Nothing

type LabelPopulatePopupCallbackC =
    Ptr () ->                               -- object
    Ptr Menu ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkLabelPopulatePopupCallback :: LabelPopulatePopupCallbackC -> IO (FunPtr LabelPopulatePopupCallbackC)

labelPopulatePopupClosure :: LabelPopulatePopupCallback -> IO Closure
labelPopulatePopupClosure cb = newCClosure =<< mkLabelPopulatePopupCallback wrapped
    where wrapped = labelPopulatePopupCallbackWrapper cb

labelPopulatePopupCallbackWrapper ::
    LabelPopulatePopupCallback ->
    Ptr () ->
    Ptr Menu ->
    Ptr () ->
    IO ()
labelPopulatePopupCallbackWrapper _cb _ menu _ = do
    menu' <- (newObject Menu) menu
    _cb  menu'

onLabelPopulatePopup :: (GObject a, MonadIO m) => a -> LabelPopulatePopupCallback -> m SignalHandlerId
onLabelPopulatePopup obj cb = liftIO $ connectLabelPopulatePopup obj cb SignalConnectBefore
afterLabelPopulatePopup :: (GObject a, MonadIO m) => a -> LabelPopulatePopupCallback -> m SignalHandlerId
afterLabelPopulatePopup obj cb = connectLabelPopulatePopup obj cb SignalConnectAfter

connectLabelPopulatePopup :: (GObject a, MonadIO m) =>
                             a -> LabelPopulatePopupCallback -> SignalConnectMode -> m SignalHandlerId
connectLabelPopulatePopup obj cb after = liftIO $ do
    cb' <- mkLabelPopulatePopupCallback (labelPopulatePopupCallbackWrapper cb)
    connectSignalFunPtr obj "populate-popup" cb' after

--- XXX Duplicated object with different types:
  --- Name {namespace = "Gtk", name = "Label"} -> Property {propName = "xalign", propType = TBasicType TFloat, propFlags = [PropertyReadable,PropertyWritable], propTransfer = TransferNothing, propDeprecated = Nothing}
  --- Name {namespace = "Gtk", name = "Misc"} -> Property {propName = "xalign", propType = TBasicType TFloat, propFlags = [PropertyReadable,PropertyWritable], propTransfer = TransferNothing, propDeprecated = Just (DeprecationInfo {deprecatedSinceVersion = Just "3.14", deprecationMessage = Just "Use gtk_widget_set_halign() instead. If you are using\n  #GtkLabel, use #GtkLabel:xalign instead."})}
--- XXX Duplicated object with different types:
  --- Name {namespace = "Gtk", name = "Label"} -> Property {propName = "yalign", propType = TBasicType TFloat, propFlags = [PropertyReadable,PropertyWritable], propTransfer = TransferNothing, propDeprecated = Nothing}
  --- Name {namespace = "Gtk", name = "Misc"} -> Property {propName = "yalign", propType = TBasicType TFloat, propFlags = [PropertyReadable,PropertyWritable], propTransfer = TransferNothing, propDeprecated = Just (DeprecationInfo {deprecatedSinceVersion = Just "3.14", deprecationMessage = Just "Use gtk_widget_set_valign() instead. If you are using\n  #GtkLabel, use #GtkLabel:yalign instead."})}
-- VVV Prop "angle"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelAngle :: (MonadIO m, LabelK o) => o -> m Double
getLabelAngle obj = liftIO $ getObjectPropertyDouble obj "angle"

setLabelAngle :: (MonadIO m, LabelK o) => o -> Double -> m ()
setLabelAngle obj val = liftIO $ setObjectPropertyDouble obj "angle" val

constructLabelAngle :: Double -> IO ([Char], GValue)
constructLabelAngle val = constructObjectPropertyDouble "angle" val

data LabelAnglePropertyInfo
instance AttrInfo LabelAnglePropertyInfo where
    type AttrAllowedOps LabelAnglePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelAnglePropertyInfo = (~) Double
    type AttrBaseTypeConstraint LabelAnglePropertyInfo = LabelK
    type AttrGetType LabelAnglePropertyInfo = Double
    type AttrLabel LabelAnglePropertyInfo = "Label::angle"
    attrGet _ = getLabelAngle
    attrSet _ = setLabelAngle
    attrConstruct _ = constructLabelAngle

-- VVV Prop "attributes"
   -- Type: TInterface "Pango" "AttrList"
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelAttributes :: (MonadIO m, LabelK o) => o -> m Pango.AttrList
getLabelAttributes obj = liftIO $ getObjectPropertyBoxed obj "attributes" Pango.AttrList

setLabelAttributes :: (MonadIO m, LabelK o) => o -> Pango.AttrList -> m ()
setLabelAttributes obj val = liftIO $ setObjectPropertyBoxed obj "attributes" val

constructLabelAttributes :: Pango.AttrList -> IO ([Char], GValue)
constructLabelAttributes val = constructObjectPropertyBoxed "attributes" val

data LabelAttributesPropertyInfo
instance AttrInfo LabelAttributesPropertyInfo where
    type AttrAllowedOps LabelAttributesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelAttributesPropertyInfo = (~) Pango.AttrList
    type AttrBaseTypeConstraint LabelAttributesPropertyInfo = LabelK
    type AttrGetType LabelAttributesPropertyInfo = Pango.AttrList
    type AttrLabel LabelAttributesPropertyInfo = "Label::attributes"
    attrGet _ = getLabelAttributes
    attrSet _ = setLabelAttributes
    attrConstruct _ = constructLabelAttributes

-- VVV Prop "cursor-position"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable]

getLabelCursorPosition :: (MonadIO m, LabelK o) => o -> m Int32
getLabelCursorPosition obj = liftIO $ getObjectPropertyCInt obj "cursor-position"

data LabelCursorPositionPropertyInfo
instance AttrInfo LabelCursorPositionPropertyInfo where
    type AttrAllowedOps LabelCursorPositionPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint LabelCursorPositionPropertyInfo = (~) ()
    type AttrBaseTypeConstraint LabelCursorPositionPropertyInfo = LabelK
    type AttrGetType LabelCursorPositionPropertyInfo = Int32
    type AttrLabel LabelCursorPositionPropertyInfo = "Label::cursor-position"
    attrGet _ = getLabelCursorPosition
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "ellipsize"
   -- Type: TInterface "Pango" "EllipsizeMode"
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelEllipsize :: (MonadIO m, LabelK o) => o -> m Pango.EllipsizeMode
getLabelEllipsize obj = liftIO $ getObjectPropertyEnum obj "ellipsize"

setLabelEllipsize :: (MonadIO m, LabelK o) => o -> Pango.EllipsizeMode -> m ()
setLabelEllipsize obj val = liftIO $ setObjectPropertyEnum obj "ellipsize" val

constructLabelEllipsize :: Pango.EllipsizeMode -> IO ([Char], GValue)
constructLabelEllipsize val = constructObjectPropertyEnum "ellipsize" val

data LabelEllipsizePropertyInfo
instance AttrInfo LabelEllipsizePropertyInfo where
    type AttrAllowedOps LabelEllipsizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelEllipsizePropertyInfo = (~) Pango.EllipsizeMode
    type AttrBaseTypeConstraint LabelEllipsizePropertyInfo = LabelK
    type AttrGetType LabelEllipsizePropertyInfo = Pango.EllipsizeMode
    type AttrLabel LabelEllipsizePropertyInfo = "Label::ellipsize"
    attrGet _ = getLabelEllipsize
    attrSet _ = setLabelEllipsize
    attrConstruct _ = constructLabelEllipsize

-- VVV Prop "justify"
   -- Type: TInterface "Gtk" "Justification"
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelJustify :: (MonadIO m, LabelK o) => o -> m Justification
getLabelJustify obj = liftIO $ getObjectPropertyEnum obj "justify"

setLabelJustify :: (MonadIO m, LabelK o) => o -> Justification -> m ()
setLabelJustify obj val = liftIO $ setObjectPropertyEnum obj "justify" val

constructLabelJustify :: Justification -> IO ([Char], GValue)
constructLabelJustify val = constructObjectPropertyEnum "justify" val

data LabelJustifyPropertyInfo
instance AttrInfo LabelJustifyPropertyInfo where
    type AttrAllowedOps LabelJustifyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelJustifyPropertyInfo = (~) Justification
    type AttrBaseTypeConstraint LabelJustifyPropertyInfo = LabelK
    type AttrGetType LabelJustifyPropertyInfo = Justification
    type AttrLabel LabelJustifyPropertyInfo = "Label::justify"
    attrGet _ = getLabelJustify
    attrSet _ = setLabelJustify
    attrConstruct _ = constructLabelJustify

-- VVV Prop "label"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelLabel :: (MonadIO m, LabelK o) => o -> m T.Text
getLabelLabel obj = liftIO $ getObjectPropertyString obj "label"

setLabelLabel :: (MonadIO m, LabelK o) => o -> T.Text -> m ()
setLabelLabel obj val = liftIO $ setObjectPropertyString obj "label" val

constructLabelLabel :: T.Text -> IO ([Char], GValue)
constructLabelLabel val = constructObjectPropertyString "label" val

data LabelLabelPropertyInfo
instance AttrInfo LabelLabelPropertyInfo where
    type AttrAllowedOps LabelLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelLabelPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint LabelLabelPropertyInfo = LabelK
    type AttrGetType LabelLabelPropertyInfo = T.Text
    type AttrLabel LabelLabelPropertyInfo = "Label::label"
    attrGet _ = getLabelLabel
    attrSet _ = setLabelLabel
    attrConstruct _ = constructLabelLabel

-- VVV Prop "lines"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelLines :: (MonadIO m, LabelK o) => o -> m Int32
getLabelLines obj = liftIO $ getObjectPropertyCInt obj "lines"

setLabelLines :: (MonadIO m, LabelK o) => o -> Int32 -> m ()
setLabelLines obj val = liftIO $ setObjectPropertyCInt obj "lines" val

constructLabelLines :: Int32 -> IO ([Char], GValue)
constructLabelLines val = constructObjectPropertyCInt "lines" val

data LabelLinesPropertyInfo
instance AttrInfo LabelLinesPropertyInfo where
    type AttrAllowedOps LabelLinesPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelLinesPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint LabelLinesPropertyInfo = LabelK
    type AttrGetType LabelLinesPropertyInfo = Int32
    type AttrLabel LabelLinesPropertyInfo = "Label::lines"
    attrGet _ = getLabelLines
    attrSet _ = setLabelLines
    attrConstruct _ = constructLabelLines

-- VVV Prop "max-width-chars"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelMaxWidthChars :: (MonadIO m, LabelK o) => o -> m Int32
getLabelMaxWidthChars obj = liftIO $ getObjectPropertyCInt obj "max-width-chars"

setLabelMaxWidthChars :: (MonadIO m, LabelK o) => o -> Int32 -> m ()
setLabelMaxWidthChars obj val = liftIO $ setObjectPropertyCInt obj "max-width-chars" val

constructLabelMaxWidthChars :: Int32 -> IO ([Char], GValue)
constructLabelMaxWidthChars val = constructObjectPropertyCInt "max-width-chars" val

data LabelMaxWidthCharsPropertyInfo
instance AttrInfo LabelMaxWidthCharsPropertyInfo where
    type AttrAllowedOps LabelMaxWidthCharsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelMaxWidthCharsPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint LabelMaxWidthCharsPropertyInfo = LabelK
    type AttrGetType LabelMaxWidthCharsPropertyInfo = Int32
    type AttrLabel LabelMaxWidthCharsPropertyInfo = "Label::max-width-chars"
    attrGet _ = getLabelMaxWidthChars
    attrSet _ = setLabelMaxWidthChars
    attrConstruct _ = constructLabelMaxWidthChars

-- VVV Prop "mnemonic-keyval"
   -- Type: TBasicType TUInt32
   -- Flags: [PropertyReadable]

getLabelMnemonicKeyval :: (MonadIO m, LabelK o) => o -> m Word32
getLabelMnemonicKeyval obj = liftIO $ getObjectPropertyCUInt obj "mnemonic-keyval"

data LabelMnemonicKeyvalPropertyInfo
instance AttrInfo LabelMnemonicKeyvalPropertyInfo where
    type AttrAllowedOps LabelMnemonicKeyvalPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint LabelMnemonicKeyvalPropertyInfo = (~) ()
    type AttrBaseTypeConstraint LabelMnemonicKeyvalPropertyInfo = LabelK
    type AttrGetType LabelMnemonicKeyvalPropertyInfo = Word32
    type AttrLabel LabelMnemonicKeyvalPropertyInfo = "Label::mnemonic-keyval"
    attrGet _ = getLabelMnemonicKeyval
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "mnemonic-widget"
   -- Type: TInterface "Gtk" "Widget"
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelMnemonicWidget :: (MonadIO m, LabelK o) => o -> m Widget
getLabelMnemonicWidget obj = liftIO $ getObjectPropertyObject obj "mnemonic-widget" Widget

setLabelMnemonicWidget :: (MonadIO m, LabelK o, WidgetK a) => o -> a -> m ()
setLabelMnemonicWidget obj val = liftIO $ setObjectPropertyObject obj "mnemonic-widget" val

constructLabelMnemonicWidget :: (WidgetK a) => a -> IO ([Char], GValue)
constructLabelMnemonicWidget val = constructObjectPropertyObject "mnemonic-widget" val

data LabelMnemonicWidgetPropertyInfo
instance AttrInfo LabelMnemonicWidgetPropertyInfo where
    type AttrAllowedOps LabelMnemonicWidgetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelMnemonicWidgetPropertyInfo = WidgetK
    type AttrBaseTypeConstraint LabelMnemonicWidgetPropertyInfo = LabelK
    type AttrGetType LabelMnemonicWidgetPropertyInfo = Widget
    type AttrLabel LabelMnemonicWidgetPropertyInfo = "Label::mnemonic-widget"
    attrGet _ = getLabelMnemonicWidget
    attrSet _ = setLabelMnemonicWidget
    attrConstruct _ = constructLabelMnemonicWidget

-- VVV Prop "pattern"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyWritable]

setLabelPattern :: (MonadIO m, LabelK o) => o -> T.Text -> m ()
setLabelPattern obj val = liftIO $ setObjectPropertyString obj "pattern" val

constructLabelPattern :: T.Text -> IO ([Char], GValue)
constructLabelPattern val = constructObjectPropertyString "pattern" val

data LabelPatternPropertyInfo
instance AttrInfo LabelPatternPropertyInfo where
    type AttrAllowedOps LabelPatternPropertyInfo = '[ 'AttrSet, 'AttrConstruct]
    type AttrSetTypeConstraint LabelPatternPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint LabelPatternPropertyInfo = LabelK
    type AttrGetType LabelPatternPropertyInfo = ()
    type AttrLabel LabelPatternPropertyInfo = "Label::pattern"
    attrGet _ = undefined
    attrSet _ = setLabelPattern
    attrConstruct _ = constructLabelPattern

-- VVV Prop "selectable"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelSelectable :: (MonadIO m, LabelK o) => o -> m Bool
getLabelSelectable obj = liftIO $ getObjectPropertyBool obj "selectable"

setLabelSelectable :: (MonadIO m, LabelK o) => o -> Bool -> m ()
setLabelSelectable obj val = liftIO $ setObjectPropertyBool obj "selectable" val

constructLabelSelectable :: Bool -> IO ([Char], GValue)
constructLabelSelectable val = constructObjectPropertyBool "selectable" val

data LabelSelectablePropertyInfo
instance AttrInfo LabelSelectablePropertyInfo where
    type AttrAllowedOps LabelSelectablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelSelectablePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint LabelSelectablePropertyInfo = LabelK
    type AttrGetType LabelSelectablePropertyInfo = Bool
    type AttrLabel LabelSelectablePropertyInfo = "Label::selectable"
    attrGet _ = getLabelSelectable
    attrSet _ = setLabelSelectable
    attrConstruct _ = constructLabelSelectable

-- VVV Prop "selection-bound"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable]

getLabelSelectionBound :: (MonadIO m, LabelK o) => o -> m Int32
getLabelSelectionBound obj = liftIO $ getObjectPropertyCInt obj "selection-bound"

data LabelSelectionBoundPropertyInfo
instance AttrInfo LabelSelectionBoundPropertyInfo where
    type AttrAllowedOps LabelSelectionBoundPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint LabelSelectionBoundPropertyInfo = (~) ()
    type AttrBaseTypeConstraint LabelSelectionBoundPropertyInfo = LabelK
    type AttrGetType LabelSelectionBoundPropertyInfo = Int32
    type AttrLabel LabelSelectionBoundPropertyInfo = "Label::selection-bound"
    attrGet _ = getLabelSelectionBound
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "single-line-mode"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelSingleLineMode :: (MonadIO m, LabelK o) => o -> m Bool
getLabelSingleLineMode obj = liftIO $ getObjectPropertyBool obj "single-line-mode"

setLabelSingleLineMode :: (MonadIO m, LabelK o) => o -> Bool -> m ()
setLabelSingleLineMode obj val = liftIO $ setObjectPropertyBool obj "single-line-mode" val

constructLabelSingleLineMode :: Bool -> IO ([Char], GValue)
constructLabelSingleLineMode val = constructObjectPropertyBool "single-line-mode" val

data LabelSingleLineModePropertyInfo
instance AttrInfo LabelSingleLineModePropertyInfo where
    type AttrAllowedOps LabelSingleLineModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelSingleLineModePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint LabelSingleLineModePropertyInfo = LabelK
    type AttrGetType LabelSingleLineModePropertyInfo = Bool
    type AttrLabel LabelSingleLineModePropertyInfo = "Label::single-line-mode"
    attrGet _ = getLabelSingleLineMode
    attrSet _ = setLabelSingleLineMode
    attrConstruct _ = constructLabelSingleLineMode

-- VVV Prop "track-visited-links"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelTrackVisitedLinks :: (MonadIO m, LabelK o) => o -> m Bool
getLabelTrackVisitedLinks obj = liftIO $ getObjectPropertyBool obj "track-visited-links"

setLabelTrackVisitedLinks :: (MonadIO m, LabelK o) => o -> Bool -> m ()
setLabelTrackVisitedLinks obj val = liftIO $ setObjectPropertyBool obj "track-visited-links" val

constructLabelTrackVisitedLinks :: Bool -> IO ([Char], GValue)
constructLabelTrackVisitedLinks val = constructObjectPropertyBool "track-visited-links" val

data LabelTrackVisitedLinksPropertyInfo
instance AttrInfo LabelTrackVisitedLinksPropertyInfo where
    type AttrAllowedOps LabelTrackVisitedLinksPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelTrackVisitedLinksPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint LabelTrackVisitedLinksPropertyInfo = LabelK
    type AttrGetType LabelTrackVisitedLinksPropertyInfo = Bool
    type AttrLabel LabelTrackVisitedLinksPropertyInfo = "Label::track-visited-links"
    attrGet _ = getLabelTrackVisitedLinks
    attrSet _ = setLabelTrackVisitedLinks
    attrConstruct _ = constructLabelTrackVisitedLinks

-- VVV Prop "use-markup"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelUseMarkup :: (MonadIO m, LabelK o) => o -> m Bool
getLabelUseMarkup obj = liftIO $ getObjectPropertyBool obj "use-markup"

setLabelUseMarkup :: (MonadIO m, LabelK o) => o -> Bool -> m ()
setLabelUseMarkup obj val = liftIO $ setObjectPropertyBool obj "use-markup" val

constructLabelUseMarkup :: Bool -> IO ([Char], GValue)
constructLabelUseMarkup val = constructObjectPropertyBool "use-markup" val

data LabelUseMarkupPropertyInfo
instance AttrInfo LabelUseMarkupPropertyInfo where
    type AttrAllowedOps LabelUseMarkupPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelUseMarkupPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint LabelUseMarkupPropertyInfo = LabelK
    type AttrGetType LabelUseMarkupPropertyInfo = Bool
    type AttrLabel LabelUseMarkupPropertyInfo = "Label::use-markup"
    attrGet _ = getLabelUseMarkup
    attrSet _ = setLabelUseMarkup
    attrConstruct _ = constructLabelUseMarkup

-- VVV Prop "use-underline"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelUseUnderline :: (MonadIO m, LabelK o) => o -> m Bool
getLabelUseUnderline obj = liftIO $ getObjectPropertyBool obj "use-underline"

setLabelUseUnderline :: (MonadIO m, LabelK o) => o -> Bool -> m ()
setLabelUseUnderline obj val = liftIO $ setObjectPropertyBool obj "use-underline" val

constructLabelUseUnderline :: Bool -> IO ([Char], GValue)
constructLabelUseUnderline val = constructObjectPropertyBool "use-underline" val

data LabelUseUnderlinePropertyInfo
instance AttrInfo LabelUseUnderlinePropertyInfo where
    type AttrAllowedOps LabelUseUnderlinePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelUseUnderlinePropertyInfo = (~) Bool
    type AttrBaseTypeConstraint LabelUseUnderlinePropertyInfo = LabelK
    type AttrGetType LabelUseUnderlinePropertyInfo = Bool
    type AttrLabel LabelUseUnderlinePropertyInfo = "Label::use-underline"
    attrGet _ = getLabelUseUnderline
    attrSet _ = setLabelUseUnderline
    attrConstruct _ = constructLabelUseUnderline

-- VVV Prop "width-chars"
   -- Type: TBasicType TInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelWidthChars :: (MonadIO m, LabelK o) => o -> m Int32
getLabelWidthChars obj = liftIO $ getObjectPropertyCInt obj "width-chars"

setLabelWidthChars :: (MonadIO m, LabelK o) => o -> Int32 -> m ()
setLabelWidthChars obj val = liftIO $ setObjectPropertyCInt obj "width-chars" val

constructLabelWidthChars :: Int32 -> IO ([Char], GValue)
constructLabelWidthChars val = constructObjectPropertyCInt "width-chars" val

data LabelWidthCharsPropertyInfo
instance AttrInfo LabelWidthCharsPropertyInfo where
    type AttrAllowedOps LabelWidthCharsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelWidthCharsPropertyInfo = (~) Int32
    type AttrBaseTypeConstraint LabelWidthCharsPropertyInfo = LabelK
    type AttrGetType LabelWidthCharsPropertyInfo = Int32
    type AttrLabel LabelWidthCharsPropertyInfo = "Label::width-chars"
    attrGet _ = getLabelWidthChars
    attrSet _ = setLabelWidthChars
    attrConstruct _ = constructLabelWidthChars

-- VVV Prop "wrap"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelWrap :: (MonadIO m, LabelK o) => o -> m Bool
getLabelWrap obj = liftIO $ getObjectPropertyBool obj "wrap"

setLabelWrap :: (MonadIO m, LabelK o) => o -> Bool -> m ()
setLabelWrap obj val = liftIO $ setObjectPropertyBool obj "wrap" val

constructLabelWrap :: Bool -> IO ([Char], GValue)
constructLabelWrap val = constructObjectPropertyBool "wrap" val

data LabelWrapPropertyInfo
instance AttrInfo LabelWrapPropertyInfo where
    type AttrAllowedOps LabelWrapPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelWrapPropertyInfo = (~) Bool
    type AttrBaseTypeConstraint LabelWrapPropertyInfo = LabelK
    type AttrGetType LabelWrapPropertyInfo = Bool
    type AttrLabel LabelWrapPropertyInfo = "Label::wrap"
    attrGet _ = getLabelWrap
    attrSet _ = setLabelWrap
    attrConstruct _ = constructLabelWrap

-- VVV Prop "wrap-mode"
   -- Type: TInterface "Pango" "WrapMode"
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelWrapMode :: (MonadIO m, LabelK o) => o -> m Pango.WrapMode
getLabelWrapMode obj = liftIO $ getObjectPropertyEnum obj "wrap-mode"

setLabelWrapMode :: (MonadIO m, LabelK o) => o -> Pango.WrapMode -> m ()
setLabelWrapMode obj val = liftIO $ setObjectPropertyEnum obj "wrap-mode" val

constructLabelWrapMode :: Pango.WrapMode -> IO ([Char], GValue)
constructLabelWrapMode val = constructObjectPropertyEnum "wrap-mode" val

data LabelWrapModePropertyInfo
instance AttrInfo LabelWrapModePropertyInfo where
    type AttrAllowedOps LabelWrapModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelWrapModePropertyInfo = (~) Pango.WrapMode
    type AttrBaseTypeConstraint LabelWrapModePropertyInfo = LabelK
    type AttrGetType LabelWrapModePropertyInfo = Pango.WrapMode
    type AttrLabel LabelWrapModePropertyInfo = "Label::wrap-mode"
    attrGet _ = getLabelWrapMode
    attrSet _ = setLabelWrapMode
    attrConstruct _ = constructLabelWrapMode

-- VVV Prop "xalign"
   -- Type: TBasicType TFloat
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelXalign :: (MonadIO m, LabelK o) => o -> m Float
getLabelXalign obj = liftIO $ getObjectPropertyFloat obj "xalign"

setLabelXalign :: (MonadIO m, LabelK o) => o -> Float -> m ()
setLabelXalign obj val = liftIO $ setObjectPropertyFloat obj "xalign" val

constructLabelXalign :: Float -> IO ([Char], GValue)
constructLabelXalign val = constructObjectPropertyFloat "xalign" val

data LabelXalignPropertyInfo
instance AttrInfo LabelXalignPropertyInfo where
    type AttrAllowedOps LabelXalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelXalignPropertyInfo = (~) Float
    type AttrBaseTypeConstraint LabelXalignPropertyInfo = LabelK
    type AttrGetType LabelXalignPropertyInfo = Float
    type AttrLabel LabelXalignPropertyInfo = "Label::xalign"
    attrGet _ = getLabelXalign
    attrSet _ = setLabelXalign
    attrConstruct _ = constructLabelXalign

-- VVV Prop "yalign"
   -- Type: TBasicType TFloat
   -- Flags: [PropertyReadable,PropertyWritable]

getLabelYalign :: (MonadIO m, LabelK o) => o -> m Float
getLabelYalign obj = liftIO $ getObjectPropertyFloat obj "yalign"

setLabelYalign :: (MonadIO m, LabelK o) => o -> Float -> m ()
setLabelYalign obj val = liftIO $ setObjectPropertyFloat obj "yalign" val

constructLabelYalign :: Float -> IO ([Char], GValue)
constructLabelYalign val = constructObjectPropertyFloat "yalign" val

data LabelYalignPropertyInfo
instance AttrInfo LabelYalignPropertyInfo where
    type AttrAllowedOps LabelYalignPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint LabelYalignPropertyInfo = (~) Float
    type AttrBaseTypeConstraint LabelYalignPropertyInfo = LabelK
    type AttrGetType LabelYalignPropertyInfo = Float
    type AttrLabel LabelYalignPropertyInfo = "Label::yalign"
    attrGet _ = getLabelYalign
    attrSet _ = setLabelYalign
    attrConstruct _ = constructLabelYalign

type instance AttributeList Label = LabelAttributeList
type LabelAttributeList = ('[ '("angle", LabelAnglePropertyInfo), '("app-paintable", WidgetAppPaintablePropertyInfo), '("attributes", LabelAttributesPropertyInfo), '("can-default", WidgetCanDefaultPropertyInfo), '("can-focus", WidgetCanFocusPropertyInfo), '("composite-child", WidgetCompositeChildPropertyInfo), '("cursor-position", LabelCursorPositionPropertyInfo), '("double-buffered", WidgetDoubleBufferedPropertyInfo), '("ellipsize", LabelEllipsizePropertyInfo), '("events", WidgetEventsPropertyInfo), '("expand", WidgetExpandPropertyInfo), '("halign", WidgetHalignPropertyInfo), '("has-default", WidgetHasDefaultPropertyInfo), '("has-focus", WidgetHasFocusPropertyInfo), '("has-tooltip", WidgetHasTooltipPropertyInfo), '("height-request", WidgetHeightRequestPropertyInfo), '("hexpand", WidgetHexpandPropertyInfo), '("hexpand-set", WidgetHexpandSetPropertyInfo), '("is-focus", WidgetIsFocusPropertyInfo), '("justify", LabelJustifyPropertyInfo), '("label", LabelLabelPropertyInfo), '("lines", LabelLinesPropertyInfo), '("margin", WidgetMarginPropertyInfo), '("margin-bottom", WidgetMarginBottomPropertyInfo), '("margin-end", WidgetMarginEndPropertyInfo), '("margin-left", WidgetMarginLeftPropertyInfo), '("margin-right", WidgetMarginRightPropertyInfo), '("margin-start", WidgetMarginStartPropertyInfo), '("margin-top", WidgetMarginTopPropertyInfo), '("max-width-chars", LabelMaxWidthCharsPropertyInfo), '("mnemonic-keyval", LabelMnemonicKeyvalPropertyInfo), '("mnemonic-widget", LabelMnemonicWidgetPropertyInfo), '("name", WidgetNamePropertyInfo), '("no-show-all", WidgetNoShowAllPropertyInfo), '("opacity", WidgetOpacityPropertyInfo), '("parent", WidgetParentPropertyInfo), '("pattern", LabelPatternPropertyInfo), '("receives-default", WidgetReceivesDefaultPropertyInfo), '("scale-factor", WidgetScaleFactorPropertyInfo), '("selectable", LabelSelectablePropertyInfo), '("selection-bound", LabelSelectionBoundPropertyInfo), '("sensitive", WidgetSensitivePropertyInfo), '("single-line-mode", LabelSingleLineModePropertyInfo), '("style", WidgetStylePropertyInfo), '("tooltip-markup", WidgetTooltipMarkupPropertyInfo), '("tooltip-text", WidgetTooltipTextPropertyInfo), '("track-visited-links", LabelTrackVisitedLinksPropertyInfo), '("use-markup", LabelUseMarkupPropertyInfo), '("use-underline", LabelUseUnderlinePropertyInfo), '("valign", WidgetValignPropertyInfo), '("vexpand", WidgetVexpandPropertyInfo), '("vexpand-set", WidgetVexpandSetPropertyInfo), '("visible", WidgetVisiblePropertyInfo), '("width-chars", LabelWidthCharsPropertyInfo), '("width-request", WidgetWidthRequestPropertyInfo), '("window", WidgetWindowPropertyInfo), '("wrap", LabelWrapPropertyInfo), '("wrap-mode", LabelWrapModePropertyInfo), '("xpad", MiscXpadPropertyInfo), '("ypad", MiscYpadPropertyInfo)] :: [(Symbol, *)])

data LabelActivateCurrentLinkSignalInfo
instance SignalInfo LabelActivateCurrentLinkSignalInfo where
    type HaskellCallbackType LabelActivateCurrentLinkSignalInfo = LabelActivateCurrentLinkCallback
    connectSignal _ = connectLabelActivateCurrentLink

data LabelActivateLinkSignalInfo
instance SignalInfo LabelActivateLinkSignalInfo where
    type HaskellCallbackType LabelActivateLinkSignalInfo = LabelActivateLinkCallback
    connectSignal _ = connectLabelActivateLink

data LabelCopyClipboardSignalInfo
instance SignalInfo LabelCopyClipboardSignalInfo where
    type HaskellCallbackType LabelCopyClipboardSignalInfo = LabelCopyClipboardCallback
    connectSignal _ = connectLabelCopyClipboard

data LabelMoveCursorSignalInfo
instance SignalInfo LabelMoveCursorSignalInfo where
    type HaskellCallbackType LabelMoveCursorSignalInfo = LabelMoveCursorCallback
    connectSignal _ = connectLabelMoveCursor

data LabelPopulatePopupSignalInfo
instance SignalInfo LabelPopulatePopupSignalInfo where
    type HaskellCallbackType LabelPopulatePopupSignalInfo = LabelPopulatePopupCallback
    connectSignal _ = connectLabelPopulatePopup

type instance SignalList Label = LabelSignalList
type LabelSignalList = ('[ '("accel-closures-changed", WidgetAccelClosuresChangedSignalInfo), '("activate-current-link", LabelActivateCurrentLinkSignalInfo), '("activate-link", LabelActivateLinkSignalInfo), '("button-press-event", WidgetButtonPressEventSignalInfo), '("button-release-event", WidgetButtonReleaseEventSignalInfo), '("can-activate-accel", WidgetCanActivateAccelSignalInfo), '("child-notify", WidgetChildNotifySignalInfo), '("composited-changed", WidgetCompositedChangedSignalInfo), '("configure-event", WidgetConfigureEventSignalInfo), '("copy-clipboard", LabelCopyClipboardSignalInfo), '("damage-event", WidgetDamageEventSignalInfo), '("delete-event", WidgetDeleteEventSignalInfo), '("destroy", WidgetDestroySignalInfo), '("destroy-event", WidgetDestroyEventSignalInfo), '("direction-changed", WidgetDirectionChangedSignalInfo), '("drag-begin", WidgetDragBeginSignalInfo), '("drag-data-delete", WidgetDragDataDeleteSignalInfo), '("drag-data-get", WidgetDragDataGetSignalInfo), '("drag-data-received", WidgetDragDataReceivedSignalInfo), '("drag-drop", WidgetDragDropSignalInfo), '("drag-end", WidgetDragEndSignalInfo), '("drag-failed", WidgetDragFailedSignalInfo), '("drag-leave", WidgetDragLeaveSignalInfo), '("drag-motion", WidgetDragMotionSignalInfo), '("draw", WidgetDrawSignalInfo), '("enter-notify-event", WidgetEnterNotifyEventSignalInfo), '("event", WidgetEventSignalInfo), '("event-after", WidgetEventAfterSignalInfo), '("focus", WidgetFocusSignalInfo), '("focus-in-event", WidgetFocusInEventSignalInfo), '("focus-out-event", WidgetFocusOutEventSignalInfo), '("grab-broken-event", WidgetGrabBrokenEventSignalInfo), '("grab-focus", WidgetGrabFocusSignalInfo), '("grab-notify", WidgetGrabNotifySignalInfo), '("hide", WidgetHideSignalInfo), '("hierarchy-changed", WidgetHierarchyChangedSignalInfo), '("key-press-event", WidgetKeyPressEventSignalInfo), '("key-release-event", WidgetKeyReleaseEventSignalInfo), '("keynav-failed", WidgetKeynavFailedSignalInfo), '("leave-notify-event", WidgetLeaveNotifyEventSignalInfo), '("map", WidgetMapSignalInfo), '("map-event", WidgetMapEventSignalInfo), '("mnemonic-activate", WidgetMnemonicActivateSignalInfo), '("motion-notify-event", WidgetMotionNotifyEventSignalInfo), '("move-cursor", LabelMoveCursorSignalInfo), '("move-focus", WidgetMoveFocusSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("parent-set", WidgetParentSetSignalInfo), '("populate-popup", LabelPopulatePopupSignalInfo), '("popup-menu", WidgetPopupMenuSignalInfo), '("property-notify-event", WidgetPropertyNotifyEventSignalInfo), '("proximity-in-event", WidgetProximityInEventSignalInfo), '("proximity-out-event", WidgetProximityOutEventSignalInfo), '("query-tooltip", WidgetQueryTooltipSignalInfo), '("realize", WidgetRealizeSignalInfo), '("screen-changed", WidgetScreenChangedSignalInfo), '("scroll-event", WidgetScrollEventSignalInfo), '("selection-clear-event", WidgetSelectionClearEventSignalInfo), '("selection-get", WidgetSelectionGetSignalInfo), '("selection-notify-event", WidgetSelectionNotifyEventSignalInfo), '("selection-received", WidgetSelectionReceivedSignalInfo), '("selection-request-event", WidgetSelectionRequestEventSignalInfo), '("show", WidgetShowSignalInfo), '("show-help", WidgetShowHelpSignalInfo), '("size-allocate", WidgetSizeAllocateSignalInfo), '("state-changed", WidgetStateChangedSignalInfo), '("state-flags-changed", WidgetStateFlagsChangedSignalInfo), '("style-set", WidgetStyleSetSignalInfo), '("style-updated", WidgetStyleUpdatedSignalInfo), '("touch-event", WidgetTouchEventSignalInfo), '("unmap", WidgetUnmapSignalInfo), '("unmap-event", WidgetUnmapEventSignalInfo), '("unrealize", WidgetUnrealizeSignalInfo), '("visibility-notify-event", WidgetVisibilityNotifyEventSignalInfo), '("window-state-event", WidgetWindowStateEventSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method Label::new
-- method type : Constructor
-- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Label"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_new" gtk_label_new :: 
    CString ->                              -- str : TBasicType TUTF8
    IO (Ptr Label)


labelNew ::
    (MonadIO m) =>
    Maybe (T.Text) ->                       -- str
    m Label
labelNew str = liftIO $ do
    maybeStr <- case str of
        Nothing -> return nullPtr
        Just jStr -> do
            jStr' <- textToCString jStr
            return jStr'
    result <- gtk_label_new maybeStr
    checkUnexpectedReturnNULL "gtk_label_new" result
    result' <- (newObject Label) result
    freeMem maybeStr
    return result'

-- method Label::new_with_mnemonic
-- method type : Constructor
-- Args : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Label"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_new_with_mnemonic" gtk_label_new_with_mnemonic :: 
    CString ->                              -- str : TBasicType TUTF8
    IO (Ptr Label)


labelNewWithMnemonic ::
    (MonadIO m) =>
    Maybe (T.Text) ->                       -- str
    m Label
labelNewWithMnemonic str = liftIO $ do
    maybeStr <- case str of
        Nothing -> return nullPtr
        Just jStr -> do
            jStr' <- textToCString jStr
            return jStr'
    result <- gtk_label_new_with_mnemonic maybeStr
    checkUnexpectedReturnNULL "gtk_label_new_with_mnemonic" result
    result' <- (newObject Label) result
    freeMem maybeStr
    return result'

-- method Label::get_angle
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TDouble
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_angle" gtk_label_get_angle :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO CDouble


labelGetAngle ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Double
labelGetAngle _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_angle _obj'
    let result' = realToFrac result
    touchManagedPtr _obj
    return result'

-- method Label::get_attributes
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Pango" "AttrList"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_attributes" gtk_label_get_attributes :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO (Ptr Pango.AttrList)


labelGetAttributes ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Pango.AttrList
labelGetAttributes _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_attributes _obj'
    checkUnexpectedReturnNULL "gtk_label_get_attributes" result
    result' <- (newBoxed Pango.AttrList) result
    touchManagedPtr _obj
    return result'

-- method Label::get_current_uri
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_current_uri" gtk_label_get_current_uri :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO CString


labelGetCurrentUri ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m T.Text
labelGetCurrentUri _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_current_uri _obj'
    checkUnexpectedReturnNULL "gtk_label_get_current_uri" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'

-- method Label::get_ellipsize
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Pango" "EllipsizeMode"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_ellipsize" gtk_label_get_ellipsize :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO CUInt


labelGetEllipsize ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Pango.EllipsizeMode
labelGetEllipsize _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_ellipsize _obj'
    let result' = (toEnum . fromIntegral) result
    touchManagedPtr _obj
    return result'

-- method Label::get_justify
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Justification"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_justify" gtk_label_get_justify :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO CUInt


labelGetJustify ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Justification
labelGetJustify _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_justify _obj'
    let result' = (toEnum . fromIntegral) result
    touchManagedPtr _obj
    return result'

-- method Label::get_label
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_label" gtk_label_get_label :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO CString


labelGetLabel ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m T.Text
labelGetLabel _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_label _obj'
    checkUnexpectedReturnNULL "gtk_label_get_label" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'

-- method Label::get_layout
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Pango" "Layout"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_layout" gtk_label_get_layout :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO (Ptr Pango.Layout)


labelGetLayout ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Pango.Layout
labelGetLayout _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_layout _obj'
    checkUnexpectedReturnNULL "gtk_label_get_layout" result
    result' <- (newObject Pango.Layout) result
    touchManagedPtr _obj
    return result'

-- method Label::get_layout_offsets
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "x", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "y", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_layout_offsets" gtk_label_get_layout_offsets :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    Ptr Int32 ->                            -- x : TBasicType TInt32
    Ptr Int32 ->                            -- y : TBasicType TInt32
    IO ()


labelGetLayoutOffsets ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m (Int32,Int32)
labelGetLayoutOffsets _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    x <- allocMem :: IO (Ptr Int32)
    y <- allocMem :: IO (Ptr Int32)
    gtk_label_get_layout_offsets _obj' x y
    x' <- peek x
    y' <- peek y
    touchManagedPtr _obj
    freeMem x
    freeMem y
    return (x', y')

-- method Label::get_line_wrap
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_line_wrap" gtk_label_get_line_wrap :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO CInt


labelGetLineWrap ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Bool
labelGetLineWrap _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_line_wrap _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Label::get_line_wrap_mode
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Pango" "WrapMode"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_line_wrap_mode" gtk_label_get_line_wrap_mode :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO CUInt


labelGetLineWrapMode ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Pango.WrapMode
labelGetLineWrapMode _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_line_wrap_mode _obj'
    let result' = (toEnum . fromIntegral) result
    touchManagedPtr _obj
    return result'

-- method Label::get_lines
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_lines" gtk_label_get_lines :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO Int32


labelGetLines ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Int32
labelGetLines _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_lines _obj'
    touchManagedPtr _obj
    return result

-- method Label::get_max_width_chars
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_max_width_chars" gtk_label_get_max_width_chars :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO Int32


labelGetMaxWidthChars ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Int32
labelGetMaxWidthChars _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_max_width_chars _obj'
    touchManagedPtr _obj
    return result

-- method Label::get_mnemonic_keyval
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUInt32
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_mnemonic_keyval" gtk_label_get_mnemonic_keyval :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO Word32


labelGetMnemonicKeyval ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Word32
labelGetMnemonicKeyval _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_mnemonic_keyval _obj'
    touchManagedPtr _obj
    return result

-- method Label::get_mnemonic_widget
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gtk" "Widget"
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_mnemonic_widget" gtk_label_get_mnemonic_widget :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO (Ptr Widget)


labelGetMnemonicWidget ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Widget
labelGetMnemonicWidget _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_mnemonic_widget _obj'
    checkUnexpectedReturnNULL "gtk_label_get_mnemonic_widget" result
    result' <- (newObject Widget) result
    touchManagedPtr _obj
    return result'

-- method Label::get_selectable
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_selectable" gtk_label_get_selectable :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO CInt


labelGetSelectable ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Bool
labelGetSelectable _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_selectable _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Label::get_selection_bounds
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything},Arg {argName = "end", argType = TBasicType TInt32, direction = DirectionOut, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferEverything}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_selection_bounds" gtk_label_get_selection_bounds :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    Ptr Int32 ->                            -- start : TBasicType TInt32
    Ptr Int32 ->                            -- end : TBasicType TInt32
    IO CInt


labelGetSelectionBounds ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m (Bool,Int32,Int32)
labelGetSelectionBounds _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    start <- allocMem :: IO (Ptr Int32)
    end <- allocMem :: IO (Ptr Int32)
    result <- gtk_label_get_selection_bounds _obj' start end
    let result' = (/= 0) result
    start' <- peek start
    end' <- peek end
    touchManagedPtr _obj
    freeMem start
    freeMem end
    return (result', start', end')

-- method Label::get_single_line_mode
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_single_line_mode" gtk_label_get_single_line_mode :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO CInt


labelGetSingleLineMode ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Bool
labelGetSingleLineMode _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_single_line_mode _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Label::get_text
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_text" gtk_label_get_text :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO CString


labelGetText ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m T.Text
labelGetText _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_text _obj'
    checkUnexpectedReturnNULL "gtk_label_get_text" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'

-- method Label::get_track_visited_links
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_track_visited_links" gtk_label_get_track_visited_links :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO CInt


labelGetTrackVisitedLinks ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Bool
labelGetTrackVisitedLinks _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_track_visited_links _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Label::get_use_markup
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_use_markup" gtk_label_get_use_markup :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO CInt


labelGetUseMarkup ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Bool
labelGetUseMarkup _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_use_markup _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Label::get_use_underline
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_use_underline" gtk_label_get_use_underline :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO CInt


labelGetUseUnderline ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Bool
labelGetUseUnderline _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_use_underline _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Label::get_width_chars
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_width_chars" gtk_label_get_width_chars :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO Int32


labelGetWidthChars ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Int32
labelGetWidthChars _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_width_chars _obj'
    touchManagedPtr _obj
    return result

-- method Label::get_xalign
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TFloat
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_xalign" gtk_label_get_xalign :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO CFloat


labelGetXalign ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Float
labelGetXalign _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_xalign _obj'
    let result' = realToFrac result
    touchManagedPtr _obj
    return result'

-- method Label::get_yalign
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TFloat
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_get_yalign" gtk_label_get_yalign :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    IO CFloat


labelGetYalign ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    m Float
labelGetYalign _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- gtk_label_get_yalign _obj'
    let result' = realToFrac result
    touchManagedPtr _obj
    return result'

-- method Label::select_region
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "start_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "end_offset", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_select_region" gtk_label_select_region :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    Int32 ->                                -- start_offset : TBasicType TInt32
    Int32 ->                                -- end_offset : TBasicType TInt32
    IO ()


labelSelectRegion ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- start_offset
    Int32 ->                                -- end_offset
    m ()
labelSelectRegion _obj start_offset end_offset = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_label_select_region _obj' start_offset end_offset
    touchManagedPtr _obj
    return ()

-- method Label::set_angle
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "angle", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "angle", argType = TBasicType TDouble, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_angle" gtk_label_set_angle :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CDouble ->                              -- angle : TBasicType TDouble
    IO ()


labelSetAngle ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Double ->                               -- angle
    m ()
labelSetAngle _obj angle = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let angle' = realToFrac angle
    gtk_label_set_angle _obj' angle'
    touchManagedPtr _obj
    return ()

-- method Label::set_attributes
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "attrs", argType = TInterface "Pango" "AttrList", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_attributes" gtk_label_set_attributes :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    Ptr Pango.AttrList ->                   -- attrs : TInterface "Pango" "AttrList"
    IO ()


labelSetAttributes ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Maybe (Pango.AttrList) ->               -- attrs
    m ()
labelSetAttributes _obj attrs = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeAttrs <- case attrs of
        Nothing -> return nullPtr
        Just jAttrs -> do
            let jAttrs' = unsafeManagedPtrGetPtr jAttrs
            return jAttrs'
    gtk_label_set_attributes _obj' maybeAttrs
    touchManagedPtr _obj
    whenJust attrs touchManagedPtr
    return ()

-- method Label::set_ellipsize
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TInterface "Pango" "EllipsizeMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "mode", argType = TInterface "Pango" "EllipsizeMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_ellipsize" gtk_label_set_ellipsize :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CUInt ->                                -- mode : TInterface "Pango" "EllipsizeMode"
    IO ()


labelSetEllipsize ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Pango.EllipsizeMode ->                  -- mode
    m ()
labelSetEllipsize _obj mode = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let mode' = (fromIntegral . fromEnum) mode
    gtk_label_set_ellipsize _obj' mode'
    touchManagedPtr _obj
    return ()

-- method Label::set_justify
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "jtype", argType = TInterface "Gtk" "Justification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "jtype", argType = TInterface "Gtk" "Justification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_justify" gtk_label_set_justify :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CUInt ->                                -- jtype : TInterface "Gtk" "Justification"
    IO ()


labelSetJustify ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Justification ->                        -- jtype
    m ()
labelSetJustify _obj jtype = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let jtype' = (fromIntegral . fromEnum) jtype
    gtk_label_set_justify _obj' jtype'
    touchManagedPtr _obj
    return ()

-- method Label::set_label
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_label" gtk_label_set_label :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CString ->                              -- str : TBasicType TUTF8
    IO ()


labelSetLabel ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- str
    m ()
labelSetLabel _obj str = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    str' <- textToCString str
    gtk_label_set_label _obj' str'
    touchManagedPtr _obj
    freeMem str'
    return ()

-- method Label::set_line_wrap
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wrap", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wrap", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_line_wrap" gtk_label_set_line_wrap :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CInt ->                                 -- wrap : TBasicType TBoolean
    IO ()


labelSetLineWrap ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- wrap
    m ()
labelSetLineWrap _obj wrap = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let wrap' = (fromIntegral . fromEnum) wrap
    gtk_label_set_line_wrap _obj' wrap'
    touchManagedPtr _obj
    return ()

-- method Label::set_line_wrap_mode
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wrap_mode", argType = TInterface "Pango" "WrapMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "wrap_mode", argType = TInterface "Pango" "WrapMode", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_line_wrap_mode" gtk_label_set_line_wrap_mode :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CUInt ->                                -- wrap_mode : TInterface "Pango" "WrapMode"
    IO ()


labelSetLineWrapMode ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Pango.WrapMode ->                       -- wrap_mode
    m ()
labelSetLineWrapMode _obj wrap_mode = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let wrap_mode' = (fromIntegral . fromEnum) wrap_mode
    gtk_label_set_line_wrap_mode _obj' wrap_mode'
    touchManagedPtr _obj
    return ()

-- method Label::set_lines
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lines", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "lines", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_lines" gtk_label_set_lines :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    Int32 ->                                -- lines : TBasicType TInt32
    IO ()


labelSetLines ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- lines
    m ()
labelSetLines _obj lines = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_label_set_lines _obj' lines
    touchManagedPtr _obj
    return ()

-- method Label::set_markup
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_markup" gtk_label_set_markup :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CString ->                              -- str : TBasicType TUTF8
    IO ()


labelSetMarkup ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- str
    m ()
labelSetMarkup _obj str = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    str' <- textToCString str
    gtk_label_set_markup _obj' str'
    touchManagedPtr _obj
    freeMem str'
    return ()

-- method Label::set_markup_with_mnemonic
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_markup_with_mnemonic" gtk_label_set_markup_with_mnemonic :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CString ->                              -- str : TBasicType TUTF8
    IO ()


labelSetMarkupWithMnemonic ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- str
    m ()
labelSetMarkupWithMnemonic _obj str = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    str' <- textToCString str
    gtk_label_set_markup_with_mnemonic _obj' str'
    touchManagedPtr _obj
    freeMem str'
    return ()

-- method Label::set_max_width_chars
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_chars", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_chars", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_max_width_chars" gtk_label_set_max_width_chars :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    Int32 ->                                -- n_chars : TBasicType TInt32
    IO ()


labelSetMaxWidthChars ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- n_chars
    m ()
labelSetMaxWidthChars _obj n_chars = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_label_set_max_width_chars _obj' n_chars
    touchManagedPtr _obj
    return ()

-- method Label::set_mnemonic_widget
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "widget", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "widget", argType = TInterface "Gtk" "Widget", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_mnemonic_widget" gtk_label_set_mnemonic_widget :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    Ptr Widget ->                           -- widget : TInterface "Gtk" "Widget"
    IO ()


labelSetMnemonicWidget ::
    (MonadIO m, LabelK a, WidgetK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- widget
    m ()
labelSetMnemonicWidget _obj widget = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeWidget <- case widget of
        Nothing -> return nullPtr
        Just jWidget -> do
            let jWidget' = unsafeManagedPtrCastPtr jWidget
            return jWidget'
    gtk_label_set_mnemonic_widget _obj' maybeWidget
    touchManagedPtr _obj
    whenJust widget touchManagedPtr
    return ()

-- method Label::set_pattern
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "pattern", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_pattern" gtk_label_set_pattern :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CString ->                              -- pattern : TBasicType TUTF8
    IO ()


labelSetPattern ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- pattern
    m ()
labelSetPattern _obj pattern = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    pattern' <- textToCString pattern
    gtk_label_set_pattern _obj' pattern'
    touchManagedPtr _obj
    freeMem pattern'
    return ()

-- method Label::set_selectable
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_selectable" gtk_label_set_selectable :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CInt ->                                 -- setting : TBasicType TBoolean
    IO ()


labelSetSelectable ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- setting
    m ()
labelSetSelectable _obj setting = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let setting' = (fromIntegral . fromEnum) setting
    gtk_label_set_selectable _obj' setting'
    touchManagedPtr _obj
    return ()

-- method Label::set_single_line_mode
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "single_line_mode", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "single_line_mode", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_single_line_mode" gtk_label_set_single_line_mode :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CInt ->                                 -- single_line_mode : TBasicType TBoolean
    IO ()


labelSetSingleLineMode ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- single_line_mode
    m ()
labelSetSingleLineMode _obj single_line_mode = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let single_line_mode' = (fromIntegral . fromEnum) single_line_mode
    gtk_label_set_single_line_mode _obj' single_line_mode'
    touchManagedPtr _obj
    return ()

-- method Label::set_text
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_text" gtk_label_set_text :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CString ->                              -- str : TBasicType TUTF8
    IO ()


labelSetText ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- str
    m ()
labelSetText _obj str = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    str' <- textToCString str
    gtk_label_set_text _obj' str'
    touchManagedPtr _obj
    freeMem str'
    return ()

-- method Label::set_text_with_mnemonic
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "str", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_text_with_mnemonic" gtk_label_set_text_with_mnemonic :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CString ->                              -- str : TBasicType TUTF8
    IO ()


labelSetTextWithMnemonic ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- str
    m ()
labelSetTextWithMnemonic _obj str = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    str' <- textToCString str
    gtk_label_set_text_with_mnemonic _obj' str'
    touchManagedPtr _obj
    freeMem str'
    return ()

-- method Label::set_track_visited_links
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "track_links", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "track_links", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_track_visited_links" gtk_label_set_track_visited_links :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CInt ->                                 -- track_links : TBasicType TBoolean
    IO ()


labelSetTrackVisitedLinks ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- track_links
    m ()
labelSetTrackVisitedLinks _obj track_links = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let track_links' = (fromIntegral . fromEnum) track_links
    gtk_label_set_track_visited_links _obj' track_links'
    touchManagedPtr _obj
    return ()

-- method Label::set_use_markup
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_use_markup" gtk_label_set_use_markup :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CInt ->                                 -- setting : TBasicType TBoolean
    IO ()


labelSetUseMarkup ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- setting
    m ()
labelSetUseMarkup _obj setting = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let setting' = (fromIntegral . fromEnum) setting
    gtk_label_set_use_markup _obj' setting'
    touchManagedPtr _obj
    return ()

-- method Label::set_use_underline
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "setting", argType = TBasicType TBoolean, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_use_underline" gtk_label_set_use_underline :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CInt ->                                 -- setting : TBasicType TBoolean
    IO ()


labelSetUseUnderline ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Bool ->                                 -- setting
    m ()
labelSetUseUnderline _obj setting = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let setting' = (fromIntegral . fromEnum) setting
    gtk_label_set_use_underline _obj' setting'
    touchManagedPtr _obj
    return ()

-- method Label::set_width_chars
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_chars", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_chars", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_width_chars" gtk_label_set_width_chars :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    Int32 ->                                -- n_chars : TBasicType TInt32
    IO ()


labelSetWidthChars ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Int32 ->                                -- n_chars
    m ()
labelSetWidthChars _obj n_chars = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    gtk_label_set_width_chars _obj' n_chars
    touchManagedPtr _obj
    return ()

-- method Label::set_xalign
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "xalign", argType = TBasicType TFloat, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "xalign", argType = TBasicType TFloat, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_xalign" gtk_label_set_xalign :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CFloat ->                               -- xalign : TBasicType TFloat
    IO ()


labelSetXalign ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Float ->                                -- xalign
    m ()
labelSetXalign _obj xalign = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let xalign' = realToFrac xalign
    gtk_label_set_xalign _obj' xalign'
    touchManagedPtr _obj
    return ()

-- method Label::set_yalign
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "yalign", argType = TBasicType TFloat, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gtk" "Label", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "yalign", argType = TBasicType TFloat, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "gtk_label_set_yalign" gtk_label_set_yalign :: 
    Ptr Label ->                            -- _obj : TInterface "Gtk" "Label"
    CFloat ->                               -- yalign : TBasicType TFloat
    IO ()


labelSetYalign ::
    (MonadIO m, LabelK a) =>
    a ->                                    -- _obj
    Float ->                                -- yalign
    m ()
labelSetYalign _obj yalign = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let yalign' = realToFrac yalign
    gtk_label_set_yalign _obj' yalign'
    touchManagedPtr _obj
    return ()