{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Gtk.Objects.TreeSelection
(
TreeSelection(..) ,
IsTreeSelection ,
toTreeSelection ,
#if defined(ENABLE_OVERLOADING)
ResolveTreeSelectionMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
TreeSelectionCountSelectedRowsMethodInfo,
#endif
treeSelectionCountSelectedRows ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionGetModeMethodInfo ,
#endif
treeSelectionGetMode ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionGetSelectedMethodInfo ,
#endif
treeSelectionGetSelected ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionGetSelectedRowsMethodInfo ,
#endif
treeSelectionGetSelectedRows ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionGetTreeViewMethodInfo ,
#endif
treeSelectionGetTreeView ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionIterIsSelectedMethodInfo ,
#endif
treeSelectionIterIsSelected ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionPathIsSelectedMethodInfo ,
#endif
treeSelectionPathIsSelected ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionSelectAllMethodInfo ,
#endif
treeSelectionSelectAll ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionSelectIterMethodInfo ,
#endif
treeSelectionSelectIter ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionSelectPathMethodInfo ,
#endif
treeSelectionSelectPath ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionSelectRangeMethodInfo ,
#endif
treeSelectionSelectRange ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionSelectedForeachMethodInfo ,
#endif
treeSelectionSelectedForeach ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionSetModeMethodInfo ,
#endif
treeSelectionSetMode ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionSetSelectFunctionMethodInfo,
#endif
treeSelectionSetSelectFunction ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionUnselectAllMethodInfo ,
#endif
treeSelectionUnselectAll ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionUnselectIterMethodInfo ,
#endif
treeSelectionUnselectIter ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionUnselectPathMethodInfo ,
#endif
treeSelectionUnselectPath ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionUnselectRangeMethodInfo ,
#endif
treeSelectionUnselectRange ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionModePropertyInfo ,
#endif
constructTreeSelectionMode ,
getTreeSelectionMode ,
setTreeSelectionMode ,
#if defined(ENABLE_OVERLOADING)
treeSelectionMode ,
#endif
TreeSelectionChangedCallback ,
#if defined(ENABLE_OVERLOADING)
TreeSelectionChangedSignalInfo ,
#endif
afterTreeSelectionChanged ,
onTreeSelectionChanged ,
) 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.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.FontOptions as Cairo.FontOptions
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.GObject.Structs.ObjectClass as GObject.ObjectClass
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.Gdk.Objects.Clipboard as Gdk.Clipboard
import qualified GI.Gdk.Objects.Cursor as Gdk.Cursor
import qualified GI.Gdk.Objects.Device as Gdk.Device
import qualified GI.Gdk.Objects.Display as Gdk.Display
import qualified GI.Gdk.Objects.Event as Gdk.Event
import qualified GI.Gdk.Objects.FrameClock as Gdk.FrameClock
import qualified GI.Gdk.Objects.Snapshot as Gdk.Snapshot
import qualified GI.Gdk.Objects.Surface as Gdk.Surface
import qualified GI.Gdk.Objects.Texture as Gdk.Texture
import qualified GI.Gdk.Structs.ContentFormats as Gdk.ContentFormats
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.Gio.Interfaces.ActionGroup as Gio.ActionGroup
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Graphene.Structs.Matrix as Graphene.Matrix
import qualified GI.Graphene.Structs.Point as Graphene.Point
import qualified GI.Graphene.Structs.Point3D as Graphene.Point3D
import qualified GI.Graphene.Structs.Rect as Graphene.Rect
import qualified GI.Graphene.Structs.Size as Graphene.Size
import qualified GI.Graphene.Structs.Vec3 as Graphene.Vec3
import qualified GI.Graphene.Structs.Vec4 as Graphene.Vec4
import qualified GI.Gsk.Enums as Gsk.Enums
import qualified GI.Gsk.Objects.GLShader as Gsk.GLShader
import qualified GI.Gsk.Objects.RenderNode as Gsk.RenderNode
import qualified GI.Gsk.Objects.Renderer as Gsk.Renderer
import qualified GI.Gsk.Structs.ColorStop as Gsk.ColorStop
import qualified GI.Gsk.Structs.Path as Gsk.Path
import qualified GI.Gsk.Structs.RoundedRect as Gsk.RoundedRect
import qualified GI.Gsk.Structs.Shadow as Gsk.Shadow
import qualified GI.Gsk.Structs.Stroke as Gsk.Stroke
import qualified GI.Gsk.Structs.Transform as Gsk.Transform
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.CellEditable as Gtk.CellEditable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.CellLayout as Gtk.CellLayout
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Editable as Gtk.Editable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Native as Gtk.Native
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Root as Gtk.Root
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Scrollable as Gtk.Scrollable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.StyleProvider as Gtk.StyleProvider
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.TreeModel as Gtk.TreeModel
import {-# SOURCE #-} qualified GI.Gtk.Objects.ATContext as Gtk.ATContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.Adjustment as Gtk.Adjustment
import {-# SOURCE #-} qualified GI.Gtk.Objects.CellArea as Gtk.CellArea
import {-# SOURCE #-} qualified GI.Gtk.Objects.CellAreaContext as Gtk.CellAreaContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.CellRenderer as Gtk.CellRenderer
import {-# SOURCE #-} qualified GI.Gtk.Objects.EventController as Gtk.EventController
import {-# SOURCE #-} qualified GI.Gtk.Objects.LayoutChild as Gtk.LayoutChild
import {-# SOURCE #-} qualified GI.Gtk.Objects.LayoutManager as Gtk.LayoutManager
import {-# SOURCE #-} qualified GI.Gtk.Objects.Settings as Gtk.Settings
import {-# SOURCE #-} qualified GI.Gtk.Objects.Snapshot as Gtk.Snapshot
import {-# SOURCE #-} qualified GI.Gtk.Objects.StyleContext as Gtk.StyleContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.Tooltip as Gtk.Tooltip
import {-# SOURCE #-} qualified GI.Gtk.Objects.TreeView as Gtk.TreeView
import {-# SOURCE #-} qualified GI.Gtk.Objects.TreeViewColumn as Gtk.TreeViewColumn
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
import {-# SOURCE #-} qualified GI.Gtk.Structs.Border as Gtk.Border
import {-# SOURCE #-} qualified GI.Gtk.Structs.Requisition as Gtk.Requisition
import {-# SOURCE #-} qualified GI.Gtk.Structs.TreeIter as Gtk.TreeIter
import {-# SOURCE #-} qualified GI.Gtk.Structs.TreePath as Gtk.TreePath
import qualified GI.Pango.Enums as Pango.Enums
import qualified GI.Pango.Objects.Context as Pango.Context
import qualified GI.Pango.Objects.FontMap as Pango.FontMap
import qualified GI.Pango.Objects.Layout as Pango.Layout
#else
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.TreeModel as Gtk.TreeModel
import {-# SOURCE #-} qualified GI.Gtk.Objects.TreeView as Gtk.TreeView
import {-# SOURCE #-} qualified GI.Gtk.Structs.TreeIter as Gtk.TreeIter
import {-# SOURCE #-} qualified GI.Gtk.Structs.TreePath as Gtk.TreePath
#endif
newtype TreeSelection = TreeSelection (SP.ManagedPtr TreeSelection)
deriving (TreeSelection -> TreeSelection -> Bool
(TreeSelection -> TreeSelection -> Bool)
-> (TreeSelection -> TreeSelection -> Bool) -> Eq TreeSelection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TreeSelection -> TreeSelection -> Bool
== :: TreeSelection -> TreeSelection -> Bool
$c/= :: TreeSelection -> TreeSelection -> Bool
/= :: TreeSelection -> TreeSelection -> Bool
Eq)
instance SP.ManagedPtrNewtype TreeSelection where
toManagedPtr :: TreeSelection -> ManagedPtr TreeSelection
toManagedPtr (TreeSelection ManagedPtr TreeSelection
p) = ManagedPtr TreeSelection
p
foreign import ccall "gtk_tree_selection_get_type"
c_gtk_tree_selection_get_type :: IO B.Types.GType
instance B.Types.TypedObject TreeSelection where
glibType :: IO GType
glibType = IO GType
c_gtk_tree_selection_get_type
instance B.Types.GObject TreeSelection
class (SP.GObject o, O.IsDescendantOf TreeSelection o) => IsTreeSelection o
instance (SP.GObject o, O.IsDescendantOf TreeSelection o) => IsTreeSelection o
instance O.HasParentTypes TreeSelection
type instance O.ParentTypes TreeSelection = '[GObject.Object.Object]
toTreeSelection :: (MIO.MonadIO m, IsTreeSelection o) => o -> m TreeSelection
toTreeSelection :: forall (m :: * -> *) o.
(MonadIO m, IsTreeSelection o) =>
o -> m TreeSelection
toTreeSelection = IO TreeSelection -> m TreeSelection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO TreeSelection -> m TreeSelection)
-> (o -> IO TreeSelection) -> o -> m TreeSelection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr TreeSelection -> TreeSelection)
-> o -> IO TreeSelection
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr TreeSelection -> TreeSelection
TreeSelection
instance B.GValue.IsGValue (Maybe TreeSelection) where
gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_tree_selection_get_type
gvalueSet_ :: Ptr GValue -> Maybe TreeSelection -> IO ()
gvalueSet_ Ptr GValue
gv Maybe TreeSelection
P.Nothing = Ptr GValue -> Ptr TreeSelection -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr TreeSelection
forall a. Ptr a
FP.nullPtr :: FP.Ptr TreeSelection)
gvalueSet_ Ptr GValue
gv (P.Just TreeSelection
obj) = TreeSelection -> (Ptr TreeSelection -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr TreeSelection
obj (Ptr GValue -> Ptr TreeSelection -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
gvalueGet_ :: Ptr GValue -> IO (Maybe TreeSelection)
gvalueGet_ Ptr GValue
gv = do
ptr <- Ptr GValue -> IO (Ptr TreeSelection)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr TreeSelection)
if ptr /= FP.nullPtr
then P.Just <$> B.ManagedPtr.newObject TreeSelection ptr
else return P.Nothing
#if defined(ENABLE_OVERLOADING)
type family ResolveTreeSelectionMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
ResolveTreeSelectionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
ResolveTreeSelectionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
ResolveTreeSelectionMethod "countSelectedRows" o = TreeSelectionCountSelectedRowsMethodInfo
ResolveTreeSelectionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
ResolveTreeSelectionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
ResolveTreeSelectionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
ResolveTreeSelectionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
ResolveTreeSelectionMethod "iterIsSelected" o = TreeSelectionIterIsSelectedMethodInfo
ResolveTreeSelectionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
ResolveTreeSelectionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
ResolveTreeSelectionMethod "pathIsSelected" o = TreeSelectionPathIsSelectedMethodInfo
ResolveTreeSelectionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
ResolveTreeSelectionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
ResolveTreeSelectionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
ResolveTreeSelectionMethod "selectAll" o = TreeSelectionSelectAllMethodInfo
ResolveTreeSelectionMethod "selectIter" o = TreeSelectionSelectIterMethodInfo
ResolveTreeSelectionMethod "selectPath" o = TreeSelectionSelectPathMethodInfo
ResolveTreeSelectionMethod "selectRange" o = TreeSelectionSelectRangeMethodInfo
ResolveTreeSelectionMethod "selectedForeach" o = TreeSelectionSelectedForeachMethodInfo
ResolveTreeSelectionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
ResolveTreeSelectionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
ResolveTreeSelectionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
ResolveTreeSelectionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
ResolveTreeSelectionMethod "unselectAll" o = TreeSelectionUnselectAllMethodInfo
ResolveTreeSelectionMethod "unselectIter" o = TreeSelectionUnselectIterMethodInfo
ResolveTreeSelectionMethod "unselectPath" o = TreeSelectionUnselectPathMethodInfo
ResolveTreeSelectionMethod "unselectRange" o = TreeSelectionUnselectRangeMethodInfo
ResolveTreeSelectionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
ResolveTreeSelectionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
ResolveTreeSelectionMethod "getMode" o = TreeSelectionGetModeMethodInfo
ResolveTreeSelectionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
ResolveTreeSelectionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
ResolveTreeSelectionMethod "getSelected" o = TreeSelectionGetSelectedMethodInfo
ResolveTreeSelectionMethod "getSelectedRows" o = TreeSelectionGetSelectedRowsMethodInfo
ResolveTreeSelectionMethod "getTreeView" o = TreeSelectionGetTreeViewMethodInfo
ResolveTreeSelectionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
ResolveTreeSelectionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
ResolveTreeSelectionMethod "setMode" o = TreeSelectionSetModeMethodInfo
ResolveTreeSelectionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
ResolveTreeSelectionMethod "setSelectFunction" o = TreeSelectionSetSelectFunctionMethodInfo
ResolveTreeSelectionMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveTreeSelectionMethod t TreeSelection, O.OverloadedMethod info TreeSelection p) => OL.IsLabel t (TreeSelection -> 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 ~ ResolveTreeSelectionMethod t TreeSelection, O.OverloadedMethod info TreeSelection p, R.HasField t TreeSelection p) => R.HasField t TreeSelection p where
getField = O.overloadedMethod @info
#endif
instance (info ~ ResolveTreeSelectionMethod t TreeSelection, O.OverloadedMethodInfo info TreeSelection) => OL.IsLabel t (O.MethodProxy info TreeSelection) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.MethodProxy
#else
fromLabel _ = O.MethodProxy
#endif
#endif
type TreeSelectionChangedCallback =
IO ()
type C_TreeSelectionChangedCallback =
Ptr TreeSelection ->
Ptr () ->
IO ()
foreign import ccall "wrapper"
mk_TreeSelectionChangedCallback :: C_TreeSelectionChangedCallback -> IO (FunPtr C_TreeSelectionChangedCallback)
wrap_TreeSelectionChangedCallback ::
GObject a => (a -> TreeSelectionChangedCallback) ->
C_TreeSelectionChangedCallback
wrap_TreeSelectionChangedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_TreeSelectionChangedCallback
wrap_TreeSelectionChangedCallback a -> IO ()
gi'cb Ptr TreeSelection
gi'selfPtr Ptr ()
_ = do
Ptr TreeSelection -> (TreeSelection -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr TreeSelection
gi'selfPtr ((TreeSelection -> IO ()) -> IO ())
-> (TreeSelection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TreeSelection
gi'self -> a -> IO ()
gi'cb (TreeSelection -> a
forall a b. Coercible a b => a -> b
Coerce.coerce TreeSelection
gi'self)
onTreeSelectionChanged :: (IsTreeSelection a, MonadIO m) => a -> ((?self :: a) => TreeSelectionChangedCallback) -> m SignalHandlerId
onTreeSelectionChanged :: forall a (m :: * -> *).
(IsTreeSelection a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onTreeSelectionChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
let wrapped' :: C_TreeSelectionChangedCallback
wrapped' = (a -> IO ()) -> C_TreeSelectionChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_TreeSelectionChangedCallback
wrap_TreeSelectionChangedCallback a -> IO ()
wrapped
wrapped'' <- C_TreeSelectionChangedCallback
-> IO (FunPtr C_TreeSelectionChangedCallback)
mk_TreeSelectionChangedCallback C_TreeSelectionChangedCallback
wrapped'
connectSignalFunPtr obj "changed" wrapped'' SignalConnectBefore Nothing
afterTreeSelectionChanged :: (IsTreeSelection a, MonadIO m) => a -> ((?self :: a) => TreeSelectionChangedCallback) -> m SignalHandlerId
afterTreeSelectionChanged :: forall a (m :: * -> *).
(IsTreeSelection a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterTreeSelectionChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
let wrapped' :: C_TreeSelectionChangedCallback
wrapped' = (a -> IO ()) -> C_TreeSelectionChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_TreeSelectionChangedCallback
wrap_TreeSelectionChangedCallback a -> IO ()
wrapped
wrapped'' <- C_TreeSelectionChangedCallback
-> IO (FunPtr C_TreeSelectionChangedCallback)
mk_TreeSelectionChangedCallback C_TreeSelectionChangedCallback
wrapped'
connectSignalFunPtr obj "changed" wrapped'' SignalConnectAfter Nothing
#if defined(ENABLE_OVERLOADING)
data TreeSelectionChangedSignalInfo
instance SignalInfo TreeSelectionChangedSignalInfo where
type HaskellCallbackType TreeSelectionChangedSignalInfo = TreeSelectionChangedCallback
connectSignal obj cb connectMode detail = do
let cb' = wrap_TreeSelectionChangedCallback cb
cb'' <- mk_TreeSelectionChangedCallback cb'
connectSignalFunPtr obj "changed" cb'' connectMode detail
dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection::changed"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#g:signal:changed"})
#endif
getTreeSelectionMode :: (MonadIO m, IsTreeSelection o) => o -> m Gtk.Enums.SelectionMode
getTreeSelectionMode :: forall (m :: * -> *) o.
(MonadIO m, IsTreeSelection o) =>
o -> m SelectionMode
getTreeSelectionMode o
obj = IO SelectionMode -> m SelectionMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO SelectionMode -> m SelectionMode)
-> IO SelectionMode -> m SelectionMode
forall a b. (a -> b) -> a -> b
$ o -> String -> IO SelectionMode
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"mode"
setTreeSelectionMode :: (MonadIO m, IsTreeSelection o) => o -> Gtk.Enums.SelectionMode -> m ()
setTreeSelectionMode :: forall (m :: * -> *) o.
(MonadIO m, IsTreeSelection o) =>
o -> SelectionMode -> m ()
setTreeSelectionMode o
obj SelectionMode
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 -> SelectionMode -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"mode" SelectionMode
val
constructTreeSelectionMode :: (IsTreeSelection o, MIO.MonadIO m) => Gtk.Enums.SelectionMode -> m (GValueConstruct o)
constructTreeSelectionMode :: forall o (m :: * -> *).
(IsTreeSelection o, MonadIO m) =>
SelectionMode -> m (GValueConstruct o)
constructTreeSelectionMode SelectionMode
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 -> SelectionMode -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"mode" SelectionMode
val
#if defined(ENABLE_OVERLOADING)
data TreeSelectionModePropertyInfo
instance AttrInfo TreeSelectionModePropertyInfo where
type AttrAllowedOps TreeSelectionModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
type AttrBaseTypeConstraint TreeSelectionModePropertyInfo = IsTreeSelection
type AttrSetTypeConstraint TreeSelectionModePropertyInfo = (~) Gtk.Enums.SelectionMode
type AttrTransferTypeConstraint TreeSelectionModePropertyInfo = (~) Gtk.Enums.SelectionMode
type AttrTransferType TreeSelectionModePropertyInfo = Gtk.Enums.SelectionMode
type AttrGetType TreeSelectionModePropertyInfo = Gtk.Enums.SelectionMode
type AttrLabel TreeSelectionModePropertyInfo = "mode"
type AttrOrigin TreeSelectionModePropertyInfo = TreeSelection
attrGet = getTreeSelectionMode
attrSet = setTreeSelectionMode
attrTransfer _ v = do
return v
attrConstruct = constructTreeSelectionMode
attrClear = undefined
dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.mode"
, O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#g:attr:mode"
})
#endif
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TreeSelection
type instance O.AttributeList TreeSelection = TreeSelectionAttributeList
type TreeSelectionAttributeList = ('[ '("mode", TreeSelectionModePropertyInfo)] :: [(Symbol, DK.Type)])
#endif
#if defined(ENABLE_OVERLOADING)
treeSelectionMode :: AttrLabelProxy "mode"
treeSelectionMode = AttrLabelProxy
#endif
#if defined(ENABLE_OVERLOADING)
type instance O.SignalList TreeSelection = TreeSelectionSignalList
type TreeSelectionSignalList = ('[ '("changed", TreeSelectionChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])
#endif
foreign import ccall "gtk_tree_selection_count_selected_rows" gtk_tree_selection_count_selected_rows ::
Ptr TreeSelection ->
IO Int32
{-# DEPRECATED treeSelectionCountSelectedRows ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionCountSelectedRows ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> m Int32
treeSelectionCountSelectedRows :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> m Int32
treeSelectionCountSelectedRows a
selection = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
result <- gtk_tree_selection_count_selected_rows selection'
touchManagedPtr selection
return result
#if defined(ENABLE_OVERLOADING)
data TreeSelectionCountSelectedRowsMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionCountSelectedRowsMethodInfo a signature where
overloadedMethod = treeSelectionCountSelectedRows
instance O.OverloadedMethodInfo TreeSelectionCountSelectedRowsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionCountSelectedRows",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionCountSelectedRows"
})
#endif
foreign import ccall "gtk_tree_selection_get_mode" gtk_tree_selection_get_mode ::
Ptr TreeSelection ->
IO CUInt
{-# DEPRECATED treeSelectionGetMode ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionGetMode ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> m Gtk.Enums.SelectionMode
treeSelectionGetMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> m SelectionMode
treeSelectionGetMode a
selection = IO SelectionMode -> m SelectionMode
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SelectionMode -> m SelectionMode)
-> IO SelectionMode -> m SelectionMode
forall a b. (a -> b) -> a -> b
$ do
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
result <- gtk_tree_selection_get_mode selection'
let result' = (Int -> SelectionMode
forall a. Enum a => Int -> a
toEnum (Int -> SelectionMode) -> (CUInt -> Int) -> CUInt -> SelectionMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
touchManagedPtr selection
return result'
#if defined(ENABLE_OVERLOADING)
data TreeSelectionGetModeMethodInfo
instance (signature ~ (m Gtk.Enums.SelectionMode), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionGetModeMethodInfo a signature where
overloadedMethod = treeSelectionGetMode
instance O.OverloadedMethodInfo TreeSelectionGetModeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionGetMode",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionGetMode"
})
#endif
foreign import ccall "gtk_tree_selection_get_selected" gtk_tree_selection_get_selected ::
Ptr TreeSelection ->
Ptr (Ptr Gtk.TreeModel.TreeModel) ->
Ptr Gtk.TreeIter.TreeIter ->
IO CInt
{-# DEPRECATED treeSelectionGetSelected ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionGetSelected ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> m ((Bool, Gtk.TreeModel.TreeModel, Gtk.TreeIter.TreeIter))
treeSelectionGetSelected :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> m (Bool, TreeModel, TreeIter)
treeSelectionGetSelected a
selection = IO (Bool, TreeModel, TreeIter) -> m (Bool, TreeModel, TreeIter)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, TreeModel, TreeIter) -> m (Bool, TreeModel, TreeIter))
-> IO (Bool, TreeModel, TreeIter) -> m (Bool, TreeModel, TreeIter)
forall a b. (a -> b) -> a -> b
$ do
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
model <- callocMem :: IO (Ptr (Ptr Gtk.TreeModel.TreeModel))
iter <- SP.callocBoxedBytes 32 :: IO (Ptr Gtk.TreeIter.TreeIter)
result <- gtk_tree_selection_get_selected selection' model iter
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
model' <- peek model
model'' <- (newObject Gtk.TreeModel.TreeModel) model'
iter' <- (wrapBoxed Gtk.TreeIter.TreeIter) iter
touchManagedPtr selection
freeMem model
return (result', model'', iter')
#if defined(ENABLE_OVERLOADING)
data TreeSelectionGetSelectedMethodInfo
instance (signature ~ (m ((Bool, Gtk.TreeModel.TreeModel, Gtk.TreeIter.TreeIter))), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionGetSelectedMethodInfo a signature where
overloadedMethod = treeSelectionGetSelected
instance O.OverloadedMethodInfo TreeSelectionGetSelectedMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionGetSelected",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionGetSelected"
})
#endif
foreign import ccall "gtk_tree_selection_get_selected_rows" gtk_tree_selection_get_selected_rows ::
Ptr TreeSelection ->
Ptr (Ptr Gtk.TreeModel.TreeModel) ->
IO (Ptr (GList (Ptr Gtk.TreePath.TreePath)))
{-# DEPRECATED treeSelectionGetSelectedRows ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionGetSelectedRows ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> m (([Gtk.TreePath.TreePath], Gtk.TreeModel.TreeModel))
treeSelectionGetSelectedRows :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> m ([TreePath], TreeModel)
treeSelectionGetSelectedRows a
selection = IO ([TreePath], TreeModel) -> m ([TreePath], TreeModel)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([TreePath], TreeModel) -> m ([TreePath], TreeModel))
-> IO ([TreePath], TreeModel) -> m ([TreePath], TreeModel)
forall a b. (a -> b) -> a -> b
$ do
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
model <- callocMem :: IO (Ptr (Ptr Gtk.TreeModel.TreeModel))
result <- gtk_tree_selection_get_selected_rows selection' model
result' <- unpackGList result
result'' <- mapM (wrapBoxed Gtk.TreePath.TreePath) result'
g_list_free result
model' <- peek model
model'' <- (newObject Gtk.TreeModel.TreeModel) model'
touchManagedPtr selection
freeMem model
return (result'', model'')
#if defined(ENABLE_OVERLOADING)
data TreeSelectionGetSelectedRowsMethodInfo
instance (signature ~ (m (([Gtk.TreePath.TreePath], Gtk.TreeModel.TreeModel))), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionGetSelectedRowsMethodInfo a signature where
overloadedMethod = treeSelectionGetSelectedRows
instance O.OverloadedMethodInfo TreeSelectionGetSelectedRowsMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionGetSelectedRows",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionGetSelectedRows"
})
#endif
foreign import ccall "gtk_tree_selection_get_tree_view" gtk_tree_selection_get_tree_view ::
Ptr TreeSelection ->
IO (Ptr Gtk.TreeView.TreeView)
{-# DEPRECATED treeSelectionGetTreeView ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionGetTreeView ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> m Gtk.TreeView.TreeView
treeSelectionGetTreeView :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> m TreeView
treeSelectionGetTreeView a
selection = IO TreeView -> m TreeView
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TreeView -> m TreeView) -> IO TreeView -> m TreeView
forall a b. (a -> b) -> a -> b
$ do
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
result <- gtk_tree_selection_get_tree_view selection'
checkUnexpectedReturnNULL "treeSelectionGetTreeView" result
result' <- (newObject Gtk.TreeView.TreeView) result
touchManagedPtr selection
return result'
#if defined(ENABLE_OVERLOADING)
data TreeSelectionGetTreeViewMethodInfo
instance (signature ~ (m Gtk.TreeView.TreeView), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionGetTreeViewMethodInfo a signature where
overloadedMethod = treeSelectionGetTreeView
instance O.OverloadedMethodInfo TreeSelectionGetTreeViewMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionGetTreeView",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionGetTreeView"
})
#endif
foreign import ccall "gtk_tree_selection_iter_is_selected" gtk_tree_selection_iter_is_selected ::
Ptr TreeSelection ->
Ptr Gtk.TreeIter.TreeIter ->
IO CInt
{-# DEPRECATED treeSelectionIterIsSelected ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionIterIsSelected ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> Gtk.TreeIter.TreeIter
-> m Bool
treeSelectionIterIsSelected :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> TreeIter -> m Bool
treeSelectionIterIsSelected a
selection TreeIter
iter = 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
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
iter' <- unsafeManagedPtrGetPtr iter
result <- gtk_tree_selection_iter_is_selected selection' iter'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr selection
touchManagedPtr iter
return result'
#if defined(ENABLE_OVERLOADING)
data TreeSelectionIterIsSelectedMethodInfo
instance (signature ~ (Gtk.TreeIter.TreeIter -> m Bool), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionIterIsSelectedMethodInfo a signature where
overloadedMethod = treeSelectionIterIsSelected
instance O.OverloadedMethodInfo TreeSelectionIterIsSelectedMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionIterIsSelected",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionIterIsSelected"
})
#endif
foreign import ccall "gtk_tree_selection_path_is_selected" gtk_tree_selection_path_is_selected ::
Ptr TreeSelection ->
Ptr Gtk.TreePath.TreePath ->
IO CInt
{-# DEPRECATED treeSelectionPathIsSelected ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionPathIsSelected ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> Gtk.TreePath.TreePath
-> m Bool
treeSelectionPathIsSelected :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> TreePath -> m Bool
treeSelectionPathIsSelected a
selection TreePath
path = 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
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
path' <- unsafeManagedPtrGetPtr path
result <- gtk_tree_selection_path_is_selected selection' path'
let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
touchManagedPtr selection
touchManagedPtr path
return result'
#if defined(ENABLE_OVERLOADING)
data TreeSelectionPathIsSelectedMethodInfo
instance (signature ~ (Gtk.TreePath.TreePath -> m Bool), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionPathIsSelectedMethodInfo a signature where
overloadedMethod = treeSelectionPathIsSelected
instance O.OverloadedMethodInfo TreeSelectionPathIsSelectedMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionPathIsSelected",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionPathIsSelected"
})
#endif
foreign import ccall "gtk_tree_selection_select_all" gtk_tree_selection_select_all ::
Ptr TreeSelection ->
IO ()
{-# DEPRECATED treeSelectionSelectAll ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionSelectAll ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> m ()
treeSelectionSelectAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> m ()
treeSelectionSelectAll a
selection = 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
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
gtk_tree_selection_select_all selection'
touchManagedPtr selection
return ()
#if defined(ENABLE_OVERLOADING)
data TreeSelectionSelectAllMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionSelectAllMethodInfo a signature where
overloadedMethod = treeSelectionSelectAll
instance O.OverloadedMethodInfo TreeSelectionSelectAllMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionSelectAll",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionSelectAll"
})
#endif
foreign import ccall "gtk_tree_selection_select_iter" gtk_tree_selection_select_iter ::
Ptr TreeSelection ->
Ptr Gtk.TreeIter.TreeIter ->
IO ()
{-# DEPRECATED treeSelectionSelectIter ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionSelectIter ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> Gtk.TreeIter.TreeIter
-> m ()
treeSelectionSelectIter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> TreeIter -> m ()
treeSelectionSelectIter a
selection TreeIter
iter = 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
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
iter' <- unsafeManagedPtrGetPtr iter
gtk_tree_selection_select_iter selection' iter'
touchManagedPtr selection
touchManagedPtr iter
return ()
#if defined(ENABLE_OVERLOADING)
data TreeSelectionSelectIterMethodInfo
instance (signature ~ (Gtk.TreeIter.TreeIter -> m ()), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionSelectIterMethodInfo a signature where
overloadedMethod = treeSelectionSelectIter
instance O.OverloadedMethodInfo TreeSelectionSelectIterMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionSelectIter",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionSelectIter"
})
#endif
foreign import ccall "gtk_tree_selection_select_path" gtk_tree_selection_select_path ::
Ptr TreeSelection ->
Ptr Gtk.TreePath.TreePath ->
IO ()
{-# DEPRECATED treeSelectionSelectPath ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionSelectPath ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> Gtk.TreePath.TreePath
-> m ()
treeSelectionSelectPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> TreePath -> m ()
treeSelectionSelectPath a
selection TreePath
path = 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
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
path' <- unsafeManagedPtrGetPtr path
gtk_tree_selection_select_path selection' path'
touchManagedPtr selection
touchManagedPtr path
return ()
#if defined(ENABLE_OVERLOADING)
data TreeSelectionSelectPathMethodInfo
instance (signature ~ (Gtk.TreePath.TreePath -> m ()), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionSelectPathMethodInfo a signature where
overloadedMethod = treeSelectionSelectPath
instance O.OverloadedMethodInfo TreeSelectionSelectPathMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionSelectPath",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionSelectPath"
})
#endif
foreign import ccall "gtk_tree_selection_select_range" gtk_tree_selection_select_range ::
Ptr TreeSelection ->
Ptr Gtk.TreePath.TreePath ->
Ptr Gtk.TreePath.TreePath ->
IO ()
{-# DEPRECATED treeSelectionSelectRange ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionSelectRange ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> Gtk.TreePath.TreePath
-> Gtk.TreePath.TreePath
-> m ()
treeSelectionSelectRange :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> TreePath -> TreePath -> m ()
treeSelectionSelectRange a
selection TreePath
startPath TreePath
endPath = 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
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
startPath' <- unsafeManagedPtrGetPtr startPath
endPath' <- unsafeManagedPtrGetPtr endPath
gtk_tree_selection_select_range selection' startPath' endPath'
touchManagedPtr selection
touchManagedPtr startPath
touchManagedPtr endPath
return ()
#if defined(ENABLE_OVERLOADING)
data TreeSelectionSelectRangeMethodInfo
instance (signature ~ (Gtk.TreePath.TreePath -> Gtk.TreePath.TreePath -> m ()), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionSelectRangeMethodInfo a signature where
overloadedMethod = treeSelectionSelectRange
instance O.OverloadedMethodInfo TreeSelectionSelectRangeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionSelectRange",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionSelectRange"
})
#endif
foreign import ccall "gtk_tree_selection_selected_foreach" gtk_tree_selection_selected_foreach ::
Ptr TreeSelection ->
FunPtr Gtk.Callbacks.C_TreeSelectionForeachFunc ->
Ptr () ->
IO ()
{-# DEPRECATED treeSelectionSelectedForeach ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionSelectedForeach ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> Gtk.Callbacks.TreeSelectionForeachFunc
-> m ()
treeSelectionSelectedForeach :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> TreeSelectionForeachFunc -> m ()
treeSelectionSelectedForeach a
selection TreeSelectionForeachFunc
func = 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
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
func' <- Gtk.Callbacks.mk_TreeSelectionForeachFunc (Gtk.Callbacks.wrap_TreeSelectionForeachFunc Nothing (Gtk.Callbacks.drop_closures_TreeSelectionForeachFunc func))
let data_ = Ptr a
forall a. Ptr a
nullPtr
gtk_tree_selection_selected_foreach selection' func' data_
safeFreeFunPtr $ castFunPtrToPtr func'
touchManagedPtr selection
return ()
#if defined(ENABLE_OVERLOADING)
data TreeSelectionSelectedForeachMethodInfo
instance (signature ~ (Gtk.Callbacks.TreeSelectionForeachFunc -> m ()), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionSelectedForeachMethodInfo a signature where
overloadedMethod = treeSelectionSelectedForeach
instance O.OverloadedMethodInfo TreeSelectionSelectedForeachMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionSelectedForeach",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionSelectedForeach"
})
#endif
foreign import ccall "gtk_tree_selection_set_mode" gtk_tree_selection_set_mode ::
Ptr TreeSelection ->
CUInt ->
IO ()
{-# DEPRECATED treeSelectionSetMode ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionSetMode ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> Gtk.Enums.SelectionMode
-> m ()
treeSelectionSetMode :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> SelectionMode -> m ()
treeSelectionSetMode a
selection SelectionMode
type_ = 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
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
let type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SelectionMode -> Int) -> SelectionMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionMode -> Int
forall a. Enum a => a -> Int
fromEnum) SelectionMode
type_
gtk_tree_selection_set_mode selection' type_'
touchManagedPtr selection
return ()
#if defined(ENABLE_OVERLOADING)
data TreeSelectionSetModeMethodInfo
instance (signature ~ (Gtk.Enums.SelectionMode -> m ()), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionSetModeMethodInfo a signature where
overloadedMethod = treeSelectionSetMode
instance O.OverloadedMethodInfo TreeSelectionSetModeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionSetMode",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionSetMode"
})
#endif
foreign import ccall "gtk_tree_selection_set_select_function" gtk_tree_selection_set_select_function ::
Ptr TreeSelection ->
FunPtr Gtk.Callbacks.C_TreeSelectionFunc ->
Ptr () ->
FunPtr GLib.Callbacks.C_DestroyNotify ->
IO ()
{-# DEPRECATED treeSelectionSetSelectFunction ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionSetSelectFunction ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> Maybe (Gtk.Callbacks.TreeSelectionFunc)
-> m ()
treeSelectionSetSelectFunction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> Maybe TreeSelectionFunc -> m ()
treeSelectionSetSelectFunction a
selection Maybe TreeSelectionFunc
func = 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
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
maybeFunc <- case func of
Maybe TreeSelectionFunc
Nothing -> FunPtr C_TreeSelectionFunc -> IO (FunPtr C_TreeSelectionFunc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_TreeSelectionFunc
forall a. FunPtr a
FP.nullFunPtr
Just TreeSelectionFunc
jFunc -> do
jFunc' <- C_TreeSelectionFunc -> IO (FunPtr C_TreeSelectionFunc)
Gtk.Callbacks.mk_TreeSelectionFunc (Maybe (Ptr (FunPtr C_TreeSelectionFunc))
-> TreeSelectionFunc_WithClosures -> C_TreeSelectionFunc
Gtk.Callbacks.wrap_TreeSelectionFunc Maybe (Ptr (FunPtr C_TreeSelectionFunc))
forall a. Maybe a
Nothing (TreeSelectionFunc -> TreeSelectionFunc_WithClosures
Gtk.Callbacks.drop_closures_TreeSelectionFunc TreeSelectionFunc
jFunc))
return jFunc'
let data_ = FunPtr C_TreeSelectionFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_TreeSelectionFunc
maybeFunc
let destroy = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
gtk_tree_selection_set_select_function selection' maybeFunc data_ destroy
touchManagedPtr selection
return ()
#if defined(ENABLE_OVERLOADING)
data TreeSelectionSetSelectFunctionMethodInfo
instance (signature ~ (Maybe (Gtk.Callbacks.TreeSelectionFunc) -> m ()), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionSetSelectFunctionMethodInfo a signature where
overloadedMethod = treeSelectionSetSelectFunction
instance O.OverloadedMethodInfo TreeSelectionSetSelectFunctionMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionSetSelectFunction",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionSetSelectFunction"
})
#endif
foreign import ccall "gtk_tree_selection_unselect_all" gtk_tree_selection_unselect_all ::
Ptr TreeSelection ->
IO ()
{-# DEPRECATED treeSelectionUnselectAll ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionUnselectAll ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> m ()
treeSelectionUnselectAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> m ()
treeSelectionUnselectAll a
selection = 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
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
gtk_tree_selection_unselect_all selection'
touchManagedPtr selection
return ()
#if defined(ENABLE_OVERLOADING)
data TreeSelectionUnselectAllMethodInfo
instance (signature ~ (m ()), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionUnselectAllMethodInfo a signature where
overloadedMethod = treeSelectionUnselectAll
instance O.OverloadedMethodInfo TreeSelectionUnselectAllMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionUnselectAll",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionUnselectAll"
})
#endif
foreign import ccall "gtk_tree_selection_unselect_iter" gtk_tree_selection_unselect_iter ::
Ptr TreeSelection ->
Ptr Gtk.TreeIter.TreeIter ->
IO ()
{-# DEPRECATED treeSelectionUnselectIter ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionUnselectIter ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> Gtk.TreeIter.TreeIter
-> m ()
treeSelectionUnselectIter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> TreeIter -> m ()
treeSelectionUnselectIter a
selection TreeIter
iter = 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
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
iter' <- unsafeManagedPtrGetPtr iter
gtk_tree_selection_unselect_iter selection' iter'
touchManagedPtr selection
touchManagedPtr iter
return ()
#if defined(ENABLE_OVERLOADING)
data TreeSelectionUnselectIterMethodInfo
instance (signature ~ (Gtk.TreeIter.TreeIter -> m ()), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionUnselectIterMethodInfo a signature where
overloadedMethod = treeSelectionUnselectIter
instance O.OverloadedMethodInfo TreeSelectionUnselectIterMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionUnselectIter",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionUnselectIter"
})
#endif
foreign import ccall "gtk_tree_selection_unselect_path" gtk_tree_selection_unselect_path ::
Ptr TreeSelection ->
Ptr Gtk.TreePath.TreePath ->
IO ()
{-# DEPRECATED treeSelectionUnselectPath ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionUnselectPath ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> Gtk.TreePath.TreePath
-> m ()
treeSelectionUnselectPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> TreePath -> m ()
treeSelectionUnselectPath a
selection TreePath
path = 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
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
path' <- unsafeManagedPtrGetPtr path
gtk_tree_selection_unselect_path selection' path'
touchManagedPtr selection
touchManagedPtr path
return ()
#if defined(ENABLE_OVERLOADING)
data TreeSelectionUnselectPathMethodInfo
instance (signature ~ (Gtk.TreePath.TreePath -> m ()), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionUnselectPathMethodInfo a signature where
overloadedMethod = treeSelectionUnselectPath
instance O.OverloadedMethodInfo TreeSelectionUnselectPathMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionUnselectPath",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionUnselectPath"
})
#endif
foreign import ccall "gtk_tree_selection_unselect_range" gtk_tree_selection_unselect_range ::
Ptr TreeSelection ->
Ptr Gtk.TreePath.TreePath ->
Ptr Gtk.TreePath.TreePath ->
IO ()
{-# DEPRECATED treeSelectionUnselectRange ["(Since version 4.10)","Use GtkListView or GtkColumnView"] #-}
treeSelectionUnselectRange ::
(B.CallStack.HasCallStack, MonadIO m, IsTreeSelection a) =>
a
-> Gtk.TreePath.TreePath
-> Gtk.TreePath.TreePath
-> m ()
treeSelectionUnselectRange :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> TreePath -> TreePath -> m ()
treeSelectionUnselectRange a
selection TreePath
startPath TreePath
endPath = 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
selection' <- a -> IO (Ptr TreeSelection)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
selection
startPath' <- unsafeManagedPtrGetPtr startPath
endPath' <- unsafeManagedPtrGetPtr endPath
gtk_tree_selection_unselect_range selection' startPath' endPath'
touchManagedPtr selection
touchManagedPtr startPath
touchManagedPtr endPath
return ()
#if defined(ENABLE_OVERLOADING)
data TreeSelectionUnselectRangeMethodInfo
instance (signature ~ (Gtk.TreePath.TreePath -> Gtk.TreePath.TreePath -> m ()), MonadIO m, IsTreeSelection a) => O.OverloadedMethod TreeSelectionUnselectRangeMethodInfo a signature where
overloadedMethod = treeSelectionUnselectRange
instance O.OverloadedMethodInfo TreeSelectionUnselectRangeMethodInfo a where
overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
O.resolvedSymbolName = "GI.Gtk.Objects.TreeSelection.treeSelectionUnselectRange",
O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-TreeSelection.html#v:treeSelectionUnselectRange"
})
#endif