{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Gtk.Objects.ColumnViewRow
(
ColumnViewRow(..) ,
IsColumnViewRow ,
toColumnViewRow ,
#if defined(ENABLE_OVERLOADING)
ResolveColumnViewRowMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
ColumnViewRowGetAccessibleDescriptionMethodInfo,
#endif
columnViewRowGetAccessibleDescription ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowGetAccessibleLabelMethodInfo,
#endif
columnViewRowGetAccessibleLabel ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowGetActivatableMethodInfo ,
#endif
columnViewRowGetActivatable ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowGetFocusableMethodInfo ,
#endif
columnViewRowGetFocusable ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowGetItemMethodInfo ,
#endif
columnViewRowGetItem ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowGetPositionMethodInfo ,
#endif
columnViewRowGetPosition ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowGetSelectableMethodInfo ,
#endif
columnViewRowGetSelectable ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowGetSelectedMethodInfo ,
#endif
columnViewRowGetSelected ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowSetAccessibleDescriptionMethodInfo,
#endif
columnViewRowSetAccessibleDescription ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowSetAccessibleLabelMethodInfo,
#endif
columnViewRowSetAccessibleLabel ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowSetActivatableMethodInfo ,
#endif
columnViewRowSetActivatable ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowSetFocusableMethodInfo ,
#endif
columnViewRowSetFocusable ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowSetSelectableMethodInfo ,
#endif
columnViewRowSetSelectable ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowAccessibleDescriptionPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
columnViewRowAccessibleDescription ,
#endif
constructColumnViewRowAccessibleDescription,
getColumnViewRowAccessibleDescription ,
setColumnViewRowAccessibleDescription ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowAccessibleLabelPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
columnViewRowAccessibleLabel ,
#endif
constructColumnViewRowAccessibleLabel ,
getColumnViewRowAccessibleLabel ,
setColumnViewRowAccessibleLabel ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowActivatablePropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
columnViewRowActivatable ,
#endif
constructColumnViewRowActivatable ,
getColumnViewRowActivatable ,
setColumnViewRowActivatable ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowFocusablePropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
columnViewRowFocusable ,
#endif
constructColumnViewRowFocusable ,
getColumnViewRowFocusable ,
setColumnViewRowFocusable ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowItemPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
columnViewRowItem ,
#endif
getColumnViewRowItem ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowPositionPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
columnViewRowPosition ,
#endif
getColumnViewRowPosition ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowSelectablePropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
columnViewRowSelectable ,
#endif
constructColumnViewRowSelectable ,
getColumnViewRowSelectable ,
setColumnViewRowSelectable ,
#if defined(ENABLE_OVERLOADING)
ColumnViewRowSelectedPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
columnViewRowSelected ,
#endif
getColumnViewRowSelected ,
) where
import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P
import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT
#if MIN_VERSION_base(4,18,0)
import qualified GI.GObject.Objects.Object as GObject.Object
#else
import qualified GI.GObject.Objects.Object as GObject.Object
#endif
newtype ColumnViewRow = ColumnViewRow (SP.ManagedPtr ColumnViewRow)
deriving (ColumnViewRow -> ColumnViewRow -> Bool
(ColumnViewRow -> ColumnViewRow -> Bool)
-> (ColumnViewRow -> ColumnViewRow -> Bool) -> Eq ColumnViewRow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnViewRow -> ColumnViewRow -> Bool
== :: ColumnViewRow -> ColumnViewRow -> Bool
$c/= :: ColumnViewRow -> ColumnViewRow -> Bool
/= :: ColumnViewRow -> ColumnViewRow -> Bool
Eq)
instance SP.ManagedPtrNewtype ColumnViewRow where
toManagedPtr :: ColumnViewRow -> ManagedPtr ColumnViewRow
toManagedPtr (ColumnViewRow ManagedPtr ColumnViewRow
p) = ManagedPtr ColumnViewRow
p
foreign import ccall "gtk_column_view_row_get_type"
c_gtk_column_view_row_get_type :: IO B.Types.GType
instance B.Types.TypedObject ColumnViewRow where
glibType :: IO GType
glibType = IO GType
c_gtk_column_view_row_get_type
instance B.Types.GObject ColumnViewRow
class (SP.GObject o, O.IsDescendantOf ColumnViewRow o) => IsColumnViewRow o
instance (SP.GObject o, O.IsDescendantOf ColumnViewRow o) => IsColumnViewRow o
instance O.HasParentTypes ColumnViewRow
type instance O.ParentTypes ColumnViewRow = '[GObject.Object.Object]
toColumnViewRow :: (MIO.MonadIO m, IsColumnViewRow o) => o -> m ColumnViewRow
toColumnViewRow :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewRow o) =>
o -> m ColumnViewRow
toColumnViewRow = IO ColumnViewRow -> m ColumnViewRow
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ColumnViewRow -> m ColumnViewRow)
-> (o -> IO ColumnViewRow) -> o -> m ColumnViewRow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr ColumnViewRow -> ColumnViewRow)
-> o -> IO ColumnViewRow
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr ColumnViewRow -> ColumnViewRow
ColumnViewRow
instance B.GValue.IsGValue (Maybe ColumnViewRow) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_column_view_row_get_type
gvalueSet_ :: Ptr GValue -> Maybe ColumnViewRow -> IO ()
gvalueSet_ Ptr GValue
gv Maybe ColumnViewRow
P.Nothing = Ptr GValue -> Ptr ColumnViewRow -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr ColumnViewRow
forall a. Ptr a
FP.nullPtr :: FP.Ptr ColumnViewRow)
gvalueSet_ Ptr GValue
gv (P.Just ColumnViewRow
obj) = ColumnViewRow -> (Ptr ColumnViewRow -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ColumnViewRow
obj (Ptr GValue -> Ptr ColumnViewRow -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe ColumnViewRow)
gvalueGet_ Ptr GValue
gv = do
ptr <- Ptr GValue -> IO (Ptr ColumnViewRow)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr ColumnViewRow)
if ptr /= FP.nullPtr
then P.Just <$> B.ManagedPtr.newObject ColumnViewRow ptr
else return P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveColumnViewRowMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveColumnViewRowMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveColumnViewRowMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveColumnViewRowMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveColumnViewRowMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveColumnViewRowMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveColumnViewRowMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveColumnViewRowMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveColumnViewRowMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveColumnViewRowMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveColumnViewRowMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveColumnViewRowMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveColumnViewRowMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveColumnViewRowMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveColumnViewRowMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveColumnViewRowMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveColumnViewRowMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveColumnViewRowMethod "getAccessibleDescription" o = ColumnViewRowGetAccessibleDescriptionMethodInfo
ResolveColumnViewRowMethod "getAccessibleLabel" o = ColumnViewRowGetAccessibleLabelMethodInfo
ResolveColumnViewRowMethod "getActivatable" o = ColumnViewRowGetActivatableMethodInfo
ResolveColumnViewRowMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveColumnViewRowMethod "getFocusable" o = ColumnViewRowGetFocusableMethodInfo
ResolveColumnViewRowMethod "getItem" o = ColumnViewRowGetItemMethodInfo
ResolveColumnViewRowMethod "getPosition" o = ColumnViewRowGetPositionMethodInfo
ResolveColumnViewRowMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveColumnViewRowMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveColumnViewRowMethod "getSelectable" o = ColumnViewRowGetSelectableMethodInfo
ResolveColumnViewRowMethod "getSelected" o = ColumnViewRowGetSelectedMethodInfo
ResolveColumnViewRowMethod "setAccessibleDescription" o = ColumnViewRowSetAccessibleDescriptionMethodInfo
ResolveColumnViewRowMethod "setAccessibleLabel" o = ColumnViewRowSetAccessibleLabelMethodInfo
ResolveColumnViewRowMethod "setActivatable" o = ColumnViewRowSetActivatableMethodInfo
ResolveColumnViewRowMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveColumnViewRowMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveColumnViewRowMethod "setFocusable" o = ColumnViewRowSetFocusableMethodInfo
ResolveColumnViewRowMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveColumnViewRowMethod "setSelectable" o = ColumnViewRowSetSelectableMethodInfo
ResolveColumnViewRowMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveColumnViewRowMethod t ColumnViewRow, O.OverloadedMethod info ColumnViewRow p) => OL.IsLabel t (ColumnViewRow -> p) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.overloadedMethod @info
#else
fromLabel _ = O.overloadedMethod @info
#endif
#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveColumnViewRowMethod t ColumnViewRow, O.OverloadedMethod info ColumnViewRow p, R.HasField t ColumnViewRow p) => R.HasField t ColumnViewRow p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveColumnViewRowMethod t ColumnViewRow, O.OverloadedMethodInfo info ColumnViewRow) => OL.IsLabel t (O.MethodProxy info ColumnViewRow) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
getColumnViewRowAccessibleDescription :: (MonadIO m, IsColumnViewRow o) => o -> m T.Text
getColumnViewRowAccessibleDescription :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewRow o) =>
o -> m Text
getColumnViewRowAccessibleDescription o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getColumnViewRowAccessibleDescription" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"accessible-description"
setColumnViewRowAccessibleDescription :: (MonadIO m, IsColumnViewRow o) => o -> T.Text -> m ()
setColumnViewRowAccessibleDescription :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewRow o) =>
o -> Text -> m ()
setColumnViewRowAccessibleDescription o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"accessible-description" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructColumnViewRowAccessibleDescription :: (IsColumnViewRow o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructColumnViewRowAccessibleDescription :: forall o (m :: * -> *).
(IsColumnViewRow o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructColumnViewRowAccessibleDescription Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"accessible-description" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowAccessibleDescriptionPropertyInfo
instance AttrInfo ColumnViewRowAccessibleDescriptionPropertyInfo where
type AttrAllowedOps ColumnViewRowAccessibleDescriptionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint ColumnViewRowAccessibleDescriptionPropertyInfo = IsColumnViewRow
type AttrSetTypeConstraint ColumnViewRowAccessibleDescriptionPropertyInfo = (~) T.Text
type AttrTransferTypeConstraint ColumnViewRowAccessibleDescriptionPropertyInfo = (~) T.Text
type AttrTransferType ColumnViewRowAccessibleDescriptionPropertyInfo = T.Text
type AttrGetType ColumnViewRowAccessibleDescriptionPropertyInfo = T.Text
type AttrLabel ColumnViewRowAccessibleDescriptionPropertyInfo = "accessible-description"
type AttrOrigin ColumnViewRowAccessibleDescriptionPropertyInfo = ColumnViewRow
attrGet = getColumnViewRowAccessibleDescription
attrSet = setColumnViewRowAccessibleDescription
attrTransfer _ v = do
return v
attrConstruct = constructColumnViewRowAccessibleDescription
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.accessibleDescription"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#g:attr:accessibleDescription"
})
#endif
getColumnViewRowAccessibleLabel :: (MonadIO m, IsColumnViewRow o) => o -> m T.Text
getColumnViewRowAccessibleLabel :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewRow o) =>
o -> m Text
getColumnViewRowAccessibleLabel o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getColumnViewRowAccessibleLabel" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"accessible-label"
setColumnViewRowAccessibleLabel :: (MonadIO m, IsColumnViewRow o) => o -> T.Text -> m ()
setColumnViewRowAccessibleLabel :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewRow o) =>
o -> Text -> m ()
setColumnViewRowAccessibleLabel o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"accessible-label" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)
constructColumnViewRowAccessibleLabel :: (IsColumnViewRow o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructColumnViewRowAccessibleLabel :: forall o (m :: * -> *).
(IsColumnViewRow o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructColumnViewRowAccessibleLabel Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"accessible-label" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowAccessibleLabelPropertyInfo
instance AttrInfo ColumnViewRowAccessibleLabelPropertyInfo where
type AttrAllowedOps ColumnViewRowAccessibleLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint ColumnViewRowAccessibleLabelPropertyInfo = IsColumnViewRow
type AttrSetTypeConstraint ColumnViewRowAccessibleLabelPropertyInfo = (~) T.Text
type AttrTransferTypeConstraint ColumnViewRowAccessibleLabelPropertyInfo = (~) T.Text
type AttrTransferType ColumnViewRowAccessibleLabelPropertyInfo = T.Text
type AttrGetType ColumnViewRowAccessibleLabelPropertyInfo = T.Text
type AttrLabel ColumnViewRowAccessibleLabelPropertyInfo = "accessible-label"
type AttrOrigin ColumnViewRowAccessibleLabelPropertyInfo = ColumnViewRow
attrGet = getColumnViewRowAccessibleLabel
attrSet = setColumnViewRowAccessibleLabel
attrTransfer _ v = do
return v
attrConstruct = constructColumnViewRowAccessibleLabel
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.accessibleLabel"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#g:attr:accessibleLabel"
})
#endif
getColumnViewRowActivatable :: (MonadIO m, IsColumnViewRow o) => o -> m Bool
getColumnViewRowActivatable :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewRow o) =>
o -> m Bool
getColumnViewRowActivatable o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"activatable"
setColumnViewRowActivatable :: (MonadIO m, IsColumnViewRow o) => o -> Bool -> m ()
setColumnViewRowActivatable :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewRow o) =>
o -> Bool -> m ()
setColumnViewRowActivatable o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"activatable" Bool
val
constructColumnViewRowActivatable :: (IsColumnViewRow o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructColumnViewRowActivatable :: forall o (m :: * -> *).
(IsColumnViewRow o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructColumnViewRowActivatable Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"activatable" Bool
val
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowActivatablePropertyInfo
instance AttrInfo ColumnViewRowActivatablePropertyInfo where
type AttrAllowedOps ColumnViewRowActivatablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint ColumnViewRowActivatablePropertyInfo = IsColumnViewRow
type AttrSetTypeConstraint ColumnViewRowActivatablePropertyInfo = (~) Bool
type AttrTransferTypeConstraint ColumnViewRowActivatablePropertyInfo = (~) Bool
type AttrTransferType ColumnViewRowActivatablePropertyInfo = Bool
type AttrGetType ColumnViewRowActivatablePropertyInfo = Bool
type AttrLabel ColumnViewRowActivatablePropertyInfo = "activatable"
type AttrOrigin ColumnViewRowActivatablePropertyInfo = ColumnViewRow
attrGet = getColumnViewRowActivatable
attrSet = setColumnViewRowActivatable
attrTransfer _ v = do
return v
attrConstruct = constructColumnViewRowActivatable
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.activatable"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#g:attr:activatable"
})
#endif
getColumnViewRowFocusable :: (MonadIO m, IsColumnViewRow o) => o -> m Bool
getColumnViewRowFocusable :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewRow o) =>
o -> m Bool
getColumnViewRowFocusable o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"focusable"
setColumnViewRowFocusable :: (MonadIO m, IsColumnViewRow o) => o -> Bool -> m ()
setColumnViewRowFocusable :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewRow o) =>
o -> Bool -> m ()
setColumnViewRowFocusable o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"focusable" Bool
val
constructColumnViewRowFocusable :: (IsColumnViewRow o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructColumnViewRowFocusable :: forall o (m :: * -> *).
(IsColumnViewRow o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructColumnViewRowFocusable Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"focusable" Bool
val
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowFocusablePropertyInfo
instance AttrInfo ColumnViewRowFocusablePropertyInfo where
type AttrAllowedOps ColumnViewRowFocusablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint ColumnViewRowFocusablePropertyInfo = IsColumnViewRow
type AttrSetTypeConstraint ColumnViewRowFocusablePropertyInfo = (~) Bool
type AttrTransferTypeConstraint ColumnViewRowFocusablePropertyInfo = (~) Bool
type AttrTransferType ColumnViewRowFocusablePropertyInfo = Bool
type AttrGetType ColumnViewRowFocusablePropertyInfo = Bool
type AttrLabel ColumnViewRowFocusablePropertyInfo = "focusable"
type AttrOrigin ColumnViewRowFocusablePropertyInfo = ColumnViewRow
attrGet = getColumnViewRowFocusable
attrSet = setColumnViewRowFocusable
attrTransfer _ v = do
return v
attrConstruct = constructColumnViewRowFocusable
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.focusable"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#g:attr:focusable"
})
#endif
getColumnViewRowItem :: (MonadIO m, IsColumnViewRow o) => o -> m (Maybe GObject.Object.Object)
getColumnViewRowItem :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewRow o) =>
o -> m (Maybe Object)
getColumnViewRowItem o
obj = IO (Maybe Object) -> m (Maybe Object)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Object -> Object) -> IO (Maybe Object)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"item" ManagedPtr Object -> Object
GObject.Object.Object
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowItemPropertyInfo
instance AttrInfo ColumnViewRowItemPropertyInfo where
type AttrAllowedOps ColumnViewRowItemPropertyInfo = '[ 'AttrGet, 'AttrClear]
type AttrBaseTypeConstraint ColumnViewRowItemPropertyInfo = IsColumnViewRow
type AttrSetTypeConstraint ColumnViewRowItemPropertyInfo = (~) ()
type AttrTransferTypeConstraint ColumnViewRowItemPropertyInfo = (~) ()
type AttrTransferType ColumnViewRowItemPropertyInfo = ()
type AttrGetType ColumnViewRowItemPropertyInfo = (Maybe GObject.Object.Object)
type AttrLabel ColumnViewRowItemPropertyInfo = "item"
type AttrOrigin ColumnViewRowItemPropertyInfo = ColumnViewRow
attrGet = getColumnViewRowItem
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.item"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#g:attr:item"
})
#endif
getColumnViewRowPosition :: (MonadIO m, IsColumnViewRow o) => o -> m Word32
getColumnViewRowPosition :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewRow o) =>
o -> m Word32
getColumnViewRowPosition o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"position"
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowPositionPropertyInfo
instance AttrInfo ColumnViewRowPositionPropertyInfo where
type AttrAllowedOps ColumnViewRowPositionPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint ColumnViewRowPositionPropertyInfo = IsColumnViewRow
type AttrSetTypeConstraint ColumnViewRowPositionPropertyInfo = (~) ()
type AttrTransferTypeConstraint ColumnViewRowPositionPropertyInfo = (~) ()
type AttrTransferType ColumnViewRowPositionPropertyInfo = ()
type AttrGetType ColumnViewRowPositionPropertyInfo = Word32
type AttrLabel ColumnViewRowPositionPropertyInfo = "position"
type AttrOrigin ColumnViewRowPositionPropertyInfo = ColumnViewRow
attrGet = getColumnViewRowPosition
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.position"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#g:attr:position"
})
#endif
getColumnViewRowSelectable :: (MonadIO m, IsColumnViewRow o) => o -> m Bool
getColumnViewRowSelectable :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewRow o) =>
o -> m Bool
getColumnViewRowSelectable o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"selectable"
setColumnViewRowSelectable :: (MonadIO m, IsColumnViewRow o) => o -> Bool -> m ()
setColumnViewRowSelectable :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewRow o) =>
o -> Bool -> m ()
setColumnViewRowSelectable o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"selectable" Bool
val
constructColumnViewRowSelectable :: (IsColumnViewRow o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructColumnViewRowSelectable :: forall o (m :: * -> *).
(IsColumnViewRow o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructColumnViewRowSelectable Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"selectable" Bool
val
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowSelectablePropertyInfo
instance AttrInfo ColumnViewRowSelectablePropertyInfo where
type AttrAllowedOps ColumnViewRowSelectablePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint ColumnViewRowSelectablePropertyInfo = IsColumnViewRow
type AttrSetTypeConstraint ColumnViewRowSelectablePropertyInfo = (~) Bool
type AttrTransferTypeConstraint ColumnViewRowSelectablePropertyInfo = (~) Bool
type AttrTransferType ColumnViewRowSelectablePropertyInfo = Bool
type AttrGetType ColumnViewRowSelectablePropertyInfo = Bool
type AttrLabel ColumnViewRowSelectablePropertyInfo = "selectable"
type AttrOrigin ColumnViewRowSelectablePropertyInfo = ColumnViewRow
attrGet = getColumnViewRowSelectable
attrSet = setColumnViewRowSelectable
attrTransfer _ v = do
return v
attrConstruct = constructColumnViewRowSelectable
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.selectable"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#g:attr:selectable"
})
#endif
getColumnViewRowSelected :: (MonadIO m, IsColumnViewRow o) => o -> m Bool
getColumnViewRowSelected :: forall (m :: * -> *) o.
(MonadIO m, IsColumnViewRow o) =>
o -> m Bool
getColumnViewRowSelected o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"selected"
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowSelectedPropertyInfo
instance AttrInfo ColumnViewRowSelectedPropertyInfo where
type AttrAllowedOps ColumnViewRowSelectedPropertyInfo = '[ 'AttrGet]
type AttrBaseTypeConstraint ColumnViewRowSelectedPropertyInfo = IsColumnViewRow
type AttrSetTypeConstraint ColumnViewRowSelectedPropertyInfo = (~) ()
type AttrTransferTypeConstraint ColumnViewRowSelectedPropertyInfo = (~) ()
type AttrTransferType ColumnViewRowSelectedPropertyInfo = ()
type AttrGetType ColumnViewRowSelectedPropertyInfo = Bool
type AttrLabel ColumnViewRowSelectedPropertyInfo = "selected"
type AttrOrigin ColumnViewRowSelectedPropertyInfo = ColumnViewRow
attrGet = getColumnViewRowSelected
attrSet = undefined
attrTransfer _ = undefined
attrConstruct = undefined
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.selected"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#g:attr:selected"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ColumnViewRow
type instance O.AttributeList ColumnViewRow = ColumnViewRowAttributeList
type ColumnViewRowAttributeList = ('[ '("accessibleDescription", ColumnViewRowAccessibleDescriptionPropertyInfo), '("accessibleLabel", ColumnViewRowAccessibleLabelPropertyInfo), '("activatable", ColumnViewRowActivatablePropertyInfo), '("focusable", ColumnViewRowFocusablePropertyInfo), '("item", ColumnViewRowItemPropertyInfo), '("position", ColumnViewRowPositionPropertyInfo), '("selectable", ColumnViewRowSelectablePropertyInfo), '("selected", ColumnViewRowSelectedPropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
columnViewRowAccessibleDescription :: AttrLabelProxy "accessibleDescription"
columnViewRowAccessibleDescription = AttrLabelProxy
columnViewRowAccessibleLabel :: AttrLabelProxy "accessibleLabel"
columnViewRowAccessibleLabel = AttrLabelProxy
columnViewRowActivatable :: AttrLabelProxy "activatable"
columnViewRowActivatable = AttrLabelProxy
columnViewRowFocusable :: AttrLabelProxy "focusable"
columnViewRowFocusable = AttrLabelProxy
columnViewRowItem :: AttrLabelProxy "item"
columnViewRowItem = AttrLabelProxy
columnViewRowPosition :: AttrLabelProxy "position"
columnViewRowPosition = AttrLabelProxy
columnViewRowSelectable :: AttrLabelProxy "selectable"
columnViewRowSelectable = AttrLabelProxy
columnViewRowSelected :: AttrLabelProxy "selected"
columnViewRowSelected = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ColumnViewRow = ColumnViewRowSignalList
type ColumnViewRowSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "gtk_column_view_row_get_accessible_description" gtk_column_view_row_get_accessible_description ::
Ptr ColumnViewRow ->
IO CString
columnViewRowGetAccessibleDescription ::
(B.CallStack.HasCallStack, MonadIO m, IsColumnViewRow a) =>
a
-> m T.Text
columnViewRowGetAccessibleDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewRow a) =>
a -> m Text
columnViewRowGetAccessibleDescription a
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr ColumnViewRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- gtk_column_view_row_get_accessible_description self'
checkUnexpectedReturnNULL "columnViewRowGetAccessibleDescription" result
result' <- cstringToText result
touchManagedPtr self
return result'
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowGetAccessibleDescriptionMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsColumnViewRow a) => O.OverloadedMethod ColumnViewRowGetAccessibleDescriptionMethodInfo a signature where
overloadedMethod = columnViewRowGetAccessibleDescription
instance O.OverloadedMethodInfo ColumnViewRowGetAccessibleDescriptionMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.columnViewRowGetAccessibleDescription",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#v:columnViewRowGetAccessibleDescription"
})
#endif
foreign import ccall "gtk_column_view_row_get_accessible_label" gtk_column_view_row_get_accessible_label ::
Ptr ColumnViewRow ->
IO CString
columnViewRowGetAccessibleLabel ::
(B.CallStack.HasCallStack, MonadIO m, IsColumnViewRow a) =>
a
-> m T.Text
columnViewRowGetAccessibleLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewRow a) =>
a -> m Text
columnViewRowGetAccessibleLabel a
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr ColumnViewRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- gtk_column_view_row_get_accessible_label self'
checkUnexpectedReturnNULL "columnViewRowGetAccessibleLabel" result
result' <- cstringToText result
touchManagedPtr self
return result'
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowGetAccessibleLabelMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsColumnViewRow a) => O.OverloadedMethod ColumnViewRowGetAccessibleLabelMethodInfo a signature where
overloadedMethod = columnViewRowGetAccessibleLabel
instance O.OverloadedMethodInfo ColumnViewRowGetAccessibleLabelMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.columnViewRowGetAccessibleLabel",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#v:columnViewRowGetAccessibleLabel"
})
#endif
foreign import ccall "gtk_column_view_row_get_activatable" gtk_column_view_row_get_activatable ::
Ptr ColumnViewRow ->
IO CInt
columnViewRowGetActivatable ::
(B.CallStack.HasCallStack, MonadIO m, IsColumnViewRow a) =>
a
-> m Bool
columnViewRowGetActivatable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewRow a) =>
a -> m Bool
columnViewRowGetActivatable a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr ColumnViewRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- gtk_column_view_row_get_activatable self'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr self
return result'
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowGetActivatableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsColumnViewRow a) => O.OverloadedMethod ColumnViewRowGetActivatableMethodInfo a signature where
overloadedMethod = columnViewRowGetActivatable
instance O.OverloadedMethodInfo ColumnViewRowGetActivatableMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.columnViewRowGetActivatable",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#v:columnViewRowGetActivatable"
})
#endif
foreign import ccall "gtk_column_view_row_get_focusable" gtk_column_view_row_get_focusable ::
Ptr ColumnViewRow ->
IO CInt
columnViewRowGetFocusable ::
(B.CallStack.HasCallStack, MonadIO m, IsColumnViewRow a) =>
a
-> m Bool
columnViewRowGetFocusable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewRow a) =>
a -> m Bool
columnViewRowGetFocusable a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr ColumnViewRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- gtk_column_view_row_get_focusable self'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr self
return result'
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowGetFocusableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsColumnViewRow a) => O.OverloadedMethod ColumnViewRowGetFocusableMethodInfo a signature where
overloadedMethod = columnViewRowGetFocusable
instance O.OverloadedMethodInfo ColumnViewRowGetFocusableMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.columnViewRowGetFocusable",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#v:columnViewRowGetFocusable"
})
#endif
foreign import ccall "gtk_column_view_row_get_item" gtk_column_view_row_get_item ::
Ptr ColumnViewRow ->
IO (Ptr GObject.Object.Object)
columnViewRowGetItem ::
(B.CallStack.HasCallStack, MonadIO m, IsColumnViewRow a) =>
a
-> m (Maybe GObject.Object.Object)
columnViewRowGetItem :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewRow a) =>
a -> m (Maybe Object)
columnViewRowGetItem a
self = IO (Maybe Object) -> m (Maybe Object)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr ColumnViewRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- gtk_column_view_row_get_item self'
maybeResult <- convertIfNonNull result $ \Ptr Object
result' -> do
result'' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
result'
return result''
touchManagedPtr self
return maybeResult
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowGetItemMethodInfo
instance (signature ~ (m (Maybe GObject.Object.Object)), MonadIO m, IsColumnViewRow a) => O.OverloadedMethod ColumnViewRowGetItemMethodInfo a signature where
overloadedMethod = columnViewRowGetItem
instance O.OverloadedMethodInfo ColumnViewRowGetItemMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.columnViewRowGetItem",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#v:columnViewRowGetItem"
})
#endif
foreign import ccall "gtk_column_view_row_get_position" gtk_column_view_row_get_position ::
Ptr ColumnViewRow ->
IO Word32
columnViewRowGetPosition ::
(B.CallStack.HasCallStack, MonadIO m, IsColumnViewRow a) =>
a
-> m Word32
columnViewRowGetPosition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewRow a) =>
a -> m Word32
columnViewRowGetPosition a
self = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr ColumnViewRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- gtk_column_view_row_get_position self'
touchManagedPtr self
return result
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowGetPositionMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsColumnViewRow a) => O.OverloadedMethod ColumnViewRowGetPositionMethodInfo a signature where
overloadedMethod = columnViewRowGetPosition
instance O.OverloadedMethodInfo ColumnViewRowGetPositionMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.columnViewRowGetPosition",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#v:columnViewRowGetPosition"
})
#endif
foreign import ccall "gtk_column_view_row_get_selectable" gtk_column_view_row_get_selectable ::
Ptr ColumnViewRow ->
IO CInt
columnViewRowGetSelectable ::
(B.CallStack.HasCallStack, MonadIO m, IsColumnViewRow a) =>
a
-> m Bool
columnViewRowGetSelectable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewRow a) =>
a -> m Bool
columnViewRowGetSelectable a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr ColumnViewRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- gtk_column_view_row_get_selectable self'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr self
return result'
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowGetSelectableMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsColumnViewRow a) => O.OverloadedMethod ColumnViewRowGetSelectableMethodInfo a signature where
overloadedMethod = columnViewRowGetSelectable
instance O.OverloadedMethodInfo ColumnViewRowGetSelectableMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.columnViewRowGetSelectable",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#v:columnViewRowGetSelectable"
})
#endif
foreign import ccall "gtk_column_view_row_get_selected" gtk_column_view_row_get_selected ::
Ptr ColumnViewRow ->
IO CInt
columnViewRowGetSelected ::
(B.CallStack.HasCallStack, MonadIO m, IsColumnViewRow a) =>
a
-> m Bool
columnViewRowGetSelected :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewRow a) =>
a -> m Bool
columnViewRowGetSelected a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr ColumnViewRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
result <- gtk_column_view_row_get_selected self'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr self
return result'
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowGetSelectedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsColumnViewRow a) => O.OverloadedMethod ColumnViewRowGetSelectedMethodInfo a signature where
overloadedMethod = columnViewRowGetSelected
instance O.OverloadedMethodInfo ColumnViewRowGetSelectedMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.columnViewRowGetSelected",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#v:columnViewRowGetSelected"
})
#endif
foreign import ccall "gtk_column_view_row_set_accessible_description" gtk_column_view_row_set_accessible_description ::
Ptr ColumnViewRow ->
CString ->
IO ()
columnViewRowSetAccessibleDescription ::
(B.CallStack.HasCallStack, MonadIO m, IsColumnViewRow a) =>
a
-> T.Text
-> m ()
columnViewRowSetAccessibleDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewRow a) =>
a -> Text -> m ()
columnViewRowSetAccessibleDescription a
self Text
description = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr ColumnViewRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
description' <- textToCString description
gtk_column_view_row_set_accessible_description self' description'
touchManagedPtr self
freeMem description'
return ()
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowSetAccessibleDescriptionMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsColumnViewRow a) => O.OverloadedMethod ColumnViewRowSetAccessibleDescriptionMethodInfo a signature where
overloadedMethod = columnViewRowSetAccessibleDescription
instance O.OverloadedMethodInfo ColumnViewRowSetAccessibleDescriptionMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.columnViewRowSetAccessibleDescription",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#v:columnViewRowSetAccessibleDescription"
})
#endif
foreign import ccall "gtk_column_view_row_set_accessible_label" gtk_column_view_row_set_accessible_label ::
Ptr ColumnViewRow ->
CString ->
IO ()
columnViewRowSetAccessibleLabel ::
(B.CallStack.HasCallStack, MonadIO m, IsColumnViewRow a) =>
a
-> T.Text
-> m ()
columnViewRowSetAccessibleLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewRow a) =>
a -> Text -> m ()
columnViewRowSetAccessibleLabel a
self Text
label = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr ColumnViewRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
label' <- textToCString label
gtk_column_view_row_set_accessible_label self' label'
touchManagedPtr self
freeMem label'
return ()
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowSetAccessibleLabelMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsColumnViewRow a) => O.OverloadedMethod ColumnViewRowSetAccessibleLabelMethodInfo a signature where
overloadedMethod = columnViewRowSetAccessibleLabel
instance O.OverloadedMethodInfo ColumnViewRowSetAccessibleLabelMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.columnViewRowSetAccessibleLabel",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#v:columnViewRowSetAccessibleLabel"
})
#endif
foreign import ccall "gtk_column_view_row_set_activatable" gtk_column_view_row_set_activatable ::
Ptr ColumnViewRow ->
CInt ->
IO ()
columnViewRowSetActivatable ::
(B.CallStack.HasCallStack, MonadIO m, IsColumnViewRow a) =>
a
-> Bool
-> m ()
columnViewRowSetActivatable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewRow a) =>
a -> Bool -> m ()
columnViewRowSetActivatable a
self Bool
activatable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr ColumnViewRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
let activatable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
activatable
gtk_column_view_row_set_activatable self' activatable'
touchManagedPtr self
return ()
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowSetActivatableMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsColumnViewRow a) => O.OverloadedMethod ColumnViewRowSetActivatableMethodInfo a signature where
overloadedMethod = columnViewRowSetActivatable
instance O.OverloadedMethodInfo ColumnViewRowSetActivatableMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.columnViewRowSetActivatable",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#v:columnViewRowSetActivatable"
})
#endif
foreign import ccall "gtk_column_view_row_set_focusable" gtk_column_view_row_set_focusable ::
Ptr ColumnViewRow ->
CInt ->
IO ()
columnViewRowSetFocusable ::
(B.CallStack.HasCallStack, MonadIO m, IsColumnViewRow a) =>
a
-> Bool
-> m ()
columnViewRowSetFocusable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewRow a) =>
a -> Bool -> m ()
columnViewRowSetFocusable a
self Bool
focusable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr ColumnViewRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
let focusable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
focusable
gtk_column_view_row_set_focusable self' focusable'
touchManagedPtr self
return ()
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowSetFocusableMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsColumnViewRow a) => O.OverloadedMethod ColumnViewRowSetFocusableMethodInfo a signature where
overloadedMethod = columnViewRowSetFocusable
instance O.OverloadedMethodInfo ColumnViewRowSetFocusableMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.columnViewRowSetFocusable",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#v:columnViewRowSetFocusable"
})
#endif
foreign import ccall "gtk_column_view_row_set_selectable" gtk_column_view_row_set_selectable ::
Ptr ColumnViewRow ->
CInt ->
IO ()
columnViewRowSetSelectable ::
(B.CallStack.HasCallStack, MonadIO m, IsColumnViewRow a) =>
a
-> Bool
-> m ()
columnViewRowSetSelectable :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsColumnViewRow a) =>
a -> Bool -> m ()
columnViewRowSetSelectable a
self Bool
selectable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
self' <- a -> IO (Ptr ColumnViewRow)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
let selectable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
selectable
gtk_column_view_row_set_selectable self' selectable'
touchManagedPtr self
return ()
#if defined(ENABLE_OVERLOADING)
data ColumnViewRowSetSelectableMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsColumnViewRow a) => O.OverloadedMethod ColumnViewRowSetSelectableMethodInfo a signature where
overloadedMethod = columnViewRowSetSelectable
instance O.OverloadedMethodInfo ColumnViewRowSetSelectableMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.ColumnViewRow.columnViewRowSetSelectable",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-ColumnViewRow.html#v:columnViewRowSetSelectable"
})
#endif