module GI.Gtk.Structs.RcProperty
(
RcProperty(..) ,
newZeroRcProperty ,
noRcProperty ,
rcPropertyParseBorder ,
rcPropertyParseColor ,
rcPropertyParseEnum ,
rcPropertyParseFlags ,
rcPropertyParseRequisition ,
clearRcPropertyOrigin ,
getRcPropertyOrigin ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
rcProperty_origin ,
#endif
setRcPropertyOrigin ,
getRcPropertyPropertyName ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
rcProperty_propertyName ,
#endif
setRcPropertyPropertyName ,
getRcPropertyTypeName ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
rcProperty_typeName ,
#endif
setRcPropertyTypeName ,
getRcPropertyValue ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
rcProperty_value ,
#endif
) where
import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P
import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GI.GLib.Structs.String as GLib.String
newtype RcProperty = RcProperty (ManagedPtr RcProperty)
instance WrappedPtr RcProperty where
wrappedPtrCalloc = callocBytes 40
wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 40 >=> wrapPtr RcProperty)
wrappedPtrFree = Just ptr_to_g_free
newZeroRcProperty :: MonadIO m => m RcProperty
newZeroRcProperty = liftIO $ wrappedPtrCalloc >>= wrapPtr RcProperty
instance tag ~ 'AttrSet => Constructible RcProperty tag where
new _ attrs = do
o <- newZeroRcProperty
GI.Attributes.set o attrs
return o
noRcProperty :: Maybe RcProperty
noRcProperty = Nothing
getRcPropertyTypeName :: MonadIO m => RcProperty -> m Word32
getRcPropertyTypeName s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 0) :: IO Word32
return val
setRcPropertyTypeName :: MonadIO m => RcProperty -> Word32 -> m ()
setRcPropertyTypeName s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 0) (val :: Word32)
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data RcPropertyTypeNameFieldInfo
instance AttrInfo RcPropertyTypeNameFieldInfo where
type AttrAllowedOps RcPropertyTypeNameFieldInfo = '[ 'AttrSet, 'AttrGet]
type AttrSetTypeConstraint RcPropertyTypeNameFieldInfo = (~) Word32
type AttrBaseTypeConstraint RcPropertyTypeNameFieldInfo = (~) RcProperty
type AttrGetType RcPropertyTypeNameFieldInfo = Word32
type AttrLabel RcPropertyTypeNameFieldInfo = "type_name"
type AttrOrigin RcPropertyTypeNameFieldInfo = RcProperty
attrGet _ = getRcPropertyTypeName
attrSet _ = setRcPropertyTypeName
attrConstruct = undefined
attrClear _ = undefined
rcProperty_typeName :: AttrLabelProxy "typeName"
rcProperty_typeName = AttrLabelProxy
#endif
getRcPropertyPropertyName :: MonadIO m => RcProperty -> m Word32
getRcPropertyPropertyName s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 4) :: IO Word32
return val
setRcPropertyPropertyName :: MonadIO m => RcProperty -> Word32 -> m ()
setRcPropertyPropertyName s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 4) (val :: Word32)
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data RcPropertyPropertyNameFieldInfo
instance AttrInfo RcPropertyPropertyNameFieldInfo where
type AttrAllowedOps RcPropertyPropertyNameFieldInfo = '[ 'AttrSet, 'AttrGet]
type AttrSetTypeConstraint RcPropertyPropertyNameFieldInfo = (~) Word32
type AttrBaseTypeConstraint RcPropertyPropertyNameFieldInfo = (~) RcProperty
type AttrGetType RcPropertyPropertyNameFieldInfo = Word32
type AttrLabel RcPropertyPropertyNameFieldInfo = "property_name"
type AttrOrigin RcPropertyPropertyNameFieldInfo = RcProperty
attrGet _ = getRcPropertyPropertyName
attrSet _ = setRcPropertyPropertyName
attrConstruct = undefined
attrClear _ = undefined
rcProperty_propertyName :: AttrLabelProxy "propertyName"
rcProperty_propertyName = AttrLabelProxy
#endif
getRcPropertyOrigin :: MonadIO m => RcProperty -> m (Maybe T.Text)
getRcPropertyOrigin s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 8) :: IO CString
result <- SP.convertIfNonNull val $ \val' -> do
val'' <- cstringToText val'
return val''
return result
setRcPropertyOrigin :: MonadIO m => RcProperty -> CString -> m ()
setRcPropertyOrigin s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 8) (val :: CString)
clearRcPropertyOrigin :: MonadIO m => RcProperty -> m ()
clearRcPropertyOrigin s = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 8) (FP.nullPtr :: CString)
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data RcPropertyOriginFieldInfo
instance AttrInfo RcPropertyOriginFieldInfo where
type AttrAllowedOps RcPropertyOriginFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
type AttrSetTypeConstraint RcPropertyOriginFieldInfo = (~) CString
type AttrBaseTypeConstraint RcPropertyOriginFieldInfo = (~) RcProperty
type AttrGetType RcPropertyOriginFieldInfo = Maybe T.Text
type AttrLabel RcPropertyOriginFieldInfo = "origin"
type AttrOrigin RcPropertyOriginFieldInfo = RcProperty
attrGet _ = getRcPropertyOrigin
attrSet _ = setRcPropertyOrigin
attrConstruct = undefined
attrClear _ = clearRcPropertyOrigin
rcProperty_origin :: AttrLabelProxy "origin"
rcProperty_origin = AttrLabelProxy
#endif
getRcPropertyValue :: MonadIO m => RcProperty -> m GValue
getRcPropertyValue s = liftIO $ withManagedPtr s $ \ptr -> do
let val = ptr `plusPtr` 16 :: (Ptr GValue)
val' <- (newBoxed GValue) val
return val'
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data RcPropertyValueFieldInfo
instance AttrInfo RcPropertyValueFieldInfo where
type AttrAllowedOps RcPropertyValueFieldInfo = '[ 'AttrGet]
type AttrSetTypeConstraint RcPropertyValueFieldInfo = (~) (Ptr GValue)
type AttrBaseTypeConstraint RcPropertyValueFieldInfo = (~) RcProperty
type AttrGetType RcPropertyValueFieldInfo = GValue
type AttrLabel RcPropertyValueFieldInfo = "value"
type AttrOrigin RcPropertyValueFieldInfo = RcProperty
attrGet _ = getRcPropertyValue
attrSet _ = undefined
attrConstruct = undefined
attrClear _ = undefined
rcProperty_value :: AttrLabelProxy "value"
rcProperty_value = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
instance O.HasAttributeList RcProperty
type instance O.AttributeList RcProperty = RcPropertyAttributeList
type RcPropertyAttributeList = ('[ '("typeName", RcPropertyTypeNameFieldInfo), '("propertyName", RcPropertyPropertyNameFieldInfo), '("origin", RcPropertyOriginFieldInfo), '("value", RcPropertyValueFieldInfo)] :: [(Symbol, *)])
#endif
foreign import ccall "gtk_rc_property_parse_border" gtk_rc_property_parse_border ::
Ptr GParamSpec ->
Ptr GLib.String.String ->
Ptr GValue ->
IO CInt
rcPropertyParseBorder ::
(B.CallStack.HasCallStack, MonadIO m) =>
GParamSpec
-> GLib.String.String
-> GValue
-> m Bool
rcPropertyParseBorder pspec gstring propertyValue = liftIO $ do
pspec' <- unsafeManagedPtrGetPtr pspec
gstring' <- unsafeManagedPtrGetPtr gstring
propertyValue' <- unsafeManagedPtrGetPtr propertyValue
result <- gtk_rc_property_parse_border pspec' gstring' propertyValue'
let result' = (/= 0) result
touchManagedPtr pspec
touchManagedPtr gstring
touchManagedPtr propertyValue
return result'
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
#endif
foreign import ccall "gtk_rc_property_parse_color" gtk_rc_property_parse_color ::
Ptr GParamSpec ->
Ptr GLib.String.String ->
Ptr GValue ->
IO CInt
rcPropertyParseColor ::
(B.CallStack.HasCallStack, MonadIO m) =>
GParamSpec
-> GLib.String.String
-> GValue
-> m Bool
rcPropertyParseColor pspec gstring propertyValue = liftIO $ do
pspec' <- unsafeManagedPtrGetPtr pspec
gstring' <- unsafeManagedPtrGetPtr gstring
propertyValue' <- unsafeManagedPtrGetPtr propertyValue
result <- gtk_rc_property_parse_color pspec' gstring' propertyValue'
let result' = (/= 0) result
touchManagedPtr pspec
touchManagedPtr gstring
touchManagedPtr propertyValue
return result'
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
#endif
foreign import ccall "gtk_rc_property_parse_enum" gtk_rc_property_parse_enum ::
Ptr GParamSpec ->
Ptr GLib.String.String ->
Ptr GValue ->
IO CInt
rcPropertyParseEnum ::
(B.CallStack.HasCallStack, MonadIO m) =>
GParamSpec
-> GLib.String.String
-> GValue
-> m Bool
rcPropertyParseEnum pspec gstring propertyValue = liftIO $ do
pspec' <- unsafeManagedPtrGetPtr pspec
gstring' <- unsafeManagedPtrGetPtr gstring
propertyValue' <- unsafeManagedPtrGetPtr propertyValue
result <- gtk_rc_property_parse_enum pspec' gstring' propertyValue'
let result' = (/= 0) result
touchManagedPtr pspec
touchManagedPtr gstring
touchManagedPtr propertyValue
return result'
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
#endif
foreign import ccall "gtk_rc_property_parse_flags" gtk_rc_property_parse_flags ::
Ptr GParamSpec ->
Ptr GLib.String.String ->
Ptr GValue ->
IO CInt
rcPropertyParseFlags ::
(B.CallStack.HasCallStack, MonadIO m) =>
GParamSpec
-> GLib.String.String
-> GValue
-> m Bool
rcPropertyParseFlags pspec gstring propertyValue = liftIO $ do
pspec' <- unsafeManagedPtrGetPtr pspec
gstring' <- unsafeManagedPtrGetPtr gstring
propertyValue' <- unsafeManagedPtrGetPtr propertyValue
result <- gtk_rc_property_parse_flags pspec' gstring' propertyValue'
let result' = (/= 0) result
touchManagedPtr pspec
touchManagedPtr gstring
touchManagedPtr propertyValue
return result'
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
#endif
foreign import ccall "gtk_rc_property_parse_requisition" gtk_rc_property_parse_requisition ::
Ptr GParamSpec ->
Ptr GLib.String.String ->
Ptr GValue ->
IO CInt
rcPropertyParseRequisition ::
(B.CallStack.HasCallStack, MonadIO m) =>
GParamSpec
-> GLib.String.String
-> GValue
-> m Bool
rcPropertyParseRequisition pspec gstring propertyValue = liftIO $ do
pspec' <- unsafeManagedPtrGetPtr pspec
gstring' <- unsafeManagedPtrGetPtr gstring
propertyValue' <- unsafeManagedPtrGetPtr propertyValue
result <- gtk_rc_property_parse_requisition pspec' gstring' propertyValue'
let result' = (/= 0) result
touchManagedPtr pspec
touchManagedPtr gstring
touchManagedPtr propertyValue
return result'
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
#endif
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
type family ResolveRcPropertyMethod (t :: Symbol) (o :: *) :: * where
ResolveRcPropertyMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveRcPropertyMethod t RcProperty, O.MethodInfo info RcProperty p) => O.IsLabelProxy t (RcProperty -> p) where
fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveRcPropertyMethod t RcProperty, O.MethodInfo info RcProperty p) => O.IsLabel t (RcProperty -> p) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#else
fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif
#endif
#endif