{-# LINE 2 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget TreeSelection
--
-- Author : Axel Simon
--
-- Created: 8 May 2001
--
-- Copyright (C) 1999-2005 Axel Simon
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- The selection object for 'TreeView'
--
module Graphics.UI.Gtk.ModelView.TreeSelection (
-- * Detail
--
-- | The 'TreeSelection' object is a helper object to manage the selection for
-- a 'TreeView' widget. The 'TreeSelection' object is automatically created
-- when a new 'TreeView' widget is created, and cannot exist independentally of
-- this widget. The primary reason the 'TreeSelection' objects exists is for
-- cleanliness of code and API. That is, there is no conceptual reason all
-- these functions could not be methods on the 'TreeView' widget instead of a
-- separate function.
--
-- The 'TreeSelection' object is gotten from a 'TreeView' by calling
-- 'treeViewGetSelection'. It can be
-- manipulated to check the selection status of the tree, as well as select
-- and deselect individual rows. Selection is done completely on the
-- 'TreeView' side. As a result, multiple views of the same model can
-- have completely different selections. Additionally, you cannot change the
-- selection of a row on the model that is not currently displayed by the view
-- without expanding its parents first.
--
-- One of the important things to remember when monitoring the selection of
-- a view is that the \"changed\" signal is mostly a hint. That is, it may only
-- emit one signal when a range of rows is selected. Additionally, it may on
-- occasion emit a \"changed\" signal when nothing has happened (mostly as a
-- result of programmers calling select_row on an already selected row).

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----TreeSelection
-- @

-- * Types
  TreeSelection,
  TreeSelectionClass,
  castToTreeSelection, gTypeTreeSelection,
  toTreeSelection,
  SelectionMode(..),
  TreeSelectionCB,
  TreeSelectionForeachCB,

-- * Methods
  treeSelectionSetMode,
  treeSelectionGetMode,
  treeSelectionSetSelectFunction,
  treeSelectionGetTreeView,
  treeSelectionGetSelected,
  treeSelectionSelectedForeach,

  treeSelectionGetSelectedRows,
  treeSelectionCountSelectedRows,

  treeSelectionSelectPath,
  treeSelectionUnselectPath,
  treeSelectionPathIsSelected,
  treeSelectionSelectIter,
  treeSelectionUnselectIter,
  treeSelectionIterIsSelected,
  treeSelectionSelectAll,
  treeSelectionUnselectAll,
  treeSelectionSelectRange,

  treeSelectionUnselectRange,


-- * Attributes
  treeSelectionMode,

-- * Signals
  treeSelectionSelectionChanged,






  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.GList (fromGList)
import System.Glib.Attributes
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types
{-# LINE 114 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 115 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
import Graphics.UI.Gtk.General.Enums (SelectionMode(..))
import Graphics.UI.Gtk.ModelView.TreeModel
{-# LINE 117 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
import Graphics.UI.Gtk.ModelView.Types
{-# LINE 118 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}


{-# LINE 120 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}

--------------------
-- Methods

-- | Set single or multiple choice.
--
treeSelectionSetMode :: TreeSelectionClass self => self
 -> SelectionMode
 -> IO ()
treeSelectionSetMode :: forall self.
TreeSelectionClass self =>
self -> SelectionMode -> IO ()
treeSelectionSetMode self
self SelectionMode
type_ =
  (\(TreeSelection ForeignPtr TreeSelection
arg1) CInt
arg2 -> ForeignPtr TreeSelection -> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO ()) -> IO ())
-> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection -> CInt -> IO ()
gtk_tree_selection_set_mode Ptr TreeSelection
argPtr1 CInt
arg2)
{-# LINE 131 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)
    ((Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (SelectionMode -> Int) -> SelectionMode -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionMode -> Int
forall a. Enum a => a -> Int
fromEnum) SelectionMode
type_)

-- | Gets the selection mode.
--
treeSelectionGetMode :: TreeSelectionClass self => self
 -> IO SelectionMode
treeSelectionGetMode :: forall self. TreeSelectionClass self => self -> IO SelectionMode
treeSelectionGetMode self
self =
  (CInt -> SelectionMode) -> IO CInt -> IO SelectionMode
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> SelectionMode
forall a. Enum a => Int -> a
toEnum (Int -> SelectionMode) -> (CInt -> Int) -> CInt -> SelectionMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO SelectionMode) -> IO CInt -> IO SelectionMode
forall a b. (a -> b) -> a -> b
$
  (\(TreeSelection ForeignPtr TreeSelection
arg1) -> ForeignPtr TreeSelection
-> (Ptr TreeSelection -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO CInt) -> IO CInt)
-> (Ptr TreeSelection -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection -> IO CInt
gtk_tree_selection_get_mode Ptr TreeSelection
argPtr1)
{-# LINE 141 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)

-- | Set a callback function if selection changes.
--
-- * If set, this function is called before any
-- node is selected or unselected, giving some control over which nodes are
-- selected. The select function should return @True@ if the state of the node
-- may be toggled, and @False@ if the state of the node should be left
-- unchanged.
treeSelectionSetSelectFunction :: TreeSelectionClass self => self
 -> TreeSelectionCB -> IO ()
treeSelectionSetSelectFunction :: forall self.
TreeSelectionClass self =>
self -> TreeSelectionCB -> IO ()
treeSelectionSetSelectFunction self
ts TreeSelectionCB
fun = do
  TreeSelectionFunc
fPtr <- (Ptr TreeSelection
 -> Ptr TreeModel
 -> Ptr NativeTreePath
 -> CInt
 -> Ptr ()
 -> IO CInt)
-> IO TreeSelectionFunc
mkTreeSelectionFunc (\Ptr TreeSelection
_ Ptr TreeModel
_ Ptr NativeTreePath
tp CInt
_ Ptr ()
_ -> do
    TreePath
path <- Ptr NativeTreePath -> IO TreePath
peekTreePath (Ptr NativeTreePath -> Ptr NativeTreePath
forall a b. Ptr a -> Ptr b
castPtr Ptr NativeTreePath
tp)
    (Bool -> CInt) -> IO Bool -> IO CInt
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bool -> CInt
forall a. Num a => Bool -> a
fromBool (IO Bool -> IO CInt) -> IO Bool -> IO CInt
forall a b. (a -> b) -> a -> b
$ TreeSelectionCB
fun TreePath
path
    )
  (\(TreeSelection ForeignPtr TreeSelection
arg1) TreeSelectionFunc
arg2 Ptr ()
arg3 FunPtr (Ptr () -> IO ())
arg4 -> ForeignPtr TreeSelection -> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO ()) -> IO ())
-> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection
-> TreeSelectionFunc -> Ptr () -> FunPtr (Ptr () -> IO ()) -> IO ()
gtk_tree_selection_set_select_function Ptr TreeSelection
argPtr1 TreeSelectionFunc
arg2 Ptr ()
arg3 FunPtr (Ptr () -> IO ())
arg4)
{-# LINE 158 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection ts)
    TreeSelectionFunc
fPtr
    (TreeSelectionFunc -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr TreeSelectionFunc
fPtr)
    FunPtr (Ptr () -> IO ())
destroyFunPtr

-- | Callback type for a function that is called everytime the selection
-- changes. This function is set with 'treeSelectionSetSelectFunction'.
--
type TreeSelectionCB = TreePath -> IO Bool
type TreeSelectionFunc = FunPtr (((Ptr TreeSelection) -> ((Ptr TreeModel) -> ((Ptr NativeTreePath) -> (CInt -> ((Ptr ()) -> (IO CInt)))))))
{-# LINE 168 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}

foreign import ccall "wrapper" mkTreeSelectionFunc ::
  (Ptr TreeSelection -> Ptr TreeModel -> Ptr NativeTreePath -> (CInt) -> Ptr () -> IO CInt)->
  IO TreeSelectionFunc

-- | Retrieve the 'TreeView' widget that this 'TreeSelection' works on.
--
treeSelectionGetTreeView :: TreeSelectionClass self => self -> IO TreeView
treeSelectionGetTreeView :: forall self. TreeSelectionClass self => self -> IO TreeView
treeSelectionGetTreeView self
self =
  (ForeignPtr TreeView -> TreeView, FinalizerPtr TreeView)
-> IO (Ptr TreeView) -> IO TreeView
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr TreeView -> TreeView, FinalizerPtr TreeView)
forall {a}. (ForeignPtr TreeView -> TreeView, FinalizerPtr a)
mkTreeView (IO (Ptr TreeView) -> IO TreeView)
-> IO (Ptr TreeView) -> IO TreeView
forall a b. (a -> b) -> a -> b
$
  (\(TreeSelection ForeignPtr TreeSelection
arg1) -> ForeignPtr TreeSelection
-> (Ptr TreeSelection -> IO (Ptr TreeView)) -> IO (Ptr TreeView)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO (Ptr TreeView)) -> IO (Ptr TreeView))
-> (Ptr TreeSelection -> IO (Ptr TreeView)) -> IO (Ptr TreeView)
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection -> IO (Ptr TreeView)
gtk_tree_selection_get_tree_view Ptr TreeSelection
argPtr1)
{-# LINE 179 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)

-- | Retrieves the selection of a single choice 'TreeSelection'.
--
treeSelectionGetSelected :: TreeSelectionClass self => self ->
                            IO (Maybe TreeIter)
treeSelectionGetSelected :: forall self. TreeSelectionClass self => self -> IO (Maybe TreeIter)
treeSelectionGetSelected self
self =
  (Ptr TreeIter -> IO CInt) -> IO (Maybe TreeIter)
receiveTreeIter ((Ptr TreeIter -> IO CInt) -> IO (Maybe TreeIter))
-> (Ptr TreeIter -> IO CInt) -> IO (Maybe TreeIter)
forall a b. (a -> b) -> a -> b
$ \Ptr TreeIter
iterPtr ->
  (\(TreeSelection ForeignPtr TreeSelection
arg1) Ptr TreeModel
arg2 Ptr TreeIter
arg3 -> ForeignPtr TreeSelection
-> (Ptr TreeSelection -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO CInt) -> IO CInt)
-> (Ptr TreeSelection -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection -> Ptr TreeModel -> Ptr TreeIter -> IO CInt
gtk_tree_selection_get_selected Ptr TreeSelection
argPtr1 Ptr TreeModel
arg2 Ptr TreeIter
arg3)
{-# LINE 188 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)
    Ptr TreeModel
forall a. Ptr a
nullPtr
    Ptr TreeIter
iterPtr

-- | Execute a function for each selected node.
--
-- * Note that you cannot modify the tree or selection from within this
-- function. Hence, 'treeSelectionGetSelectedRows' might be more useful.
--
treeSelectionSelectedForeach :: TreeSelectionClass self => self
 -> TreeSelectionForeachCB
 -> IO ()
treeSelectionSelectedForeach :: forall self.
TreeSelectionClass self =>
self -> TreeSelectionForeachCB -> IO ()
treeSelectionSelectedForeach self
self TreeSelectionForeachCB
fun = do
  TreeSelectionForeachFunc
fPtr <- (Ptr TreeModel
 -> Ptr NativeTreePath -> Ptr TreeIter -> Ptr () -> IO ())
-> IO TreeSelectionForeachFunc
mkTreeSelectionForeachFunc (\Ptr TreeModel
_ Ptr NativeTreePath
_ Ptr TreeIter
iterPtr Ptr ()
_ -> do
    -- make a deep copy of the iterator. This makes it possible to store this
    -- iterator in Haskell land somewhere. The TreeModel parameter is not
    -- passed to the function due to performance reasons. But since it is
    -- a constant member of Selection this does not matter.
    TreeIter
iter <- Ptr TreeIter -> IO TreeIter
forall a. Storable a => Ptr a -> IO a
peek Ptr TreeIter
iterPtr
    TreeSelectionForeachCB
fun TreeIter
iter
    )
  (\(TreeSelection ForeignPtr TreeSelection
arg1) TreeSelectionForeachFunc
arg2 Ptr ()
arg3 -> ForeignPtr TreeSelection -> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO ()) -> IO ())
-> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection -> TreeSelectionForeachFunc -> Ptr () -> IO ()
gtk_tree_selection_selected_foreach Ptr TreeSelection
argPtr1 TreeSelectionForeachFunc
arg2 Ptr ()
arg3)
{-# LINE 210 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)
    TreeSelectionForeachFunc
fPtr
    Ptr ()
forall a. Ptr a
nullPtr
  TreeSelectionForeachFunc -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr TreeSelectionForeachFunc
fPtr

-- | Callback function type for 'treeSelectionSelectedForeach'.
--
type TreeSelectionForeachCB = TreeIter -> IO ()
type TreeSelectionForeachFunc = FunPtr (((Ptr TreeModel) -> ((Ptr NativeTreePath) -> ((Ptr TreeIter) -> ((Ptr ()) -> (IO ()))))))
{-# LINE 219 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}

foreign import ccall "wrapper" mkTreeSelectionForeachFunc ::
  (Ptr TreeModel -> Ptr NativeTreePath -> Ptr TreeIter -> Ptr () -> IO ()) -> IO TreeSelectionForeachFunc


-- | Creates a list of paths of all selected rows.
--
-- * Additionally, if you are
-- planning on modifying the model after calling this function, you may want to
-- convert the returned list into a list of 'TreeRowReference's. To do this,
-- you can use 'treeRowReferenceNew'.
--
-- * Available since Gtk+ version 2.2
--
treeSelectionGetSelectedRows :: TreeSelectionClass self => self
 -> IO [TreePath] -- ^ returns a list containing a 'TreePath' for
                  -- each selected row.
treeSelectionGetSelectedRows :: forall self. TreeSelectionClass self => self -> IO [TreePath]
treeSelectionGetSelectedRows self
self =
  (\(TreeSelection ForeignPtr TreeSelection
arg1) Ptr TreeModel
arg2 -> ForeignPtr TreeSelection
-> (Ptr TreeSelection -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr TreeSelection -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection -> Ptr TreeModel -> IO (Ptr ())
gtk_tree_selection_get_selected_rows Ptr TreeSelection
argPtr1 Ptr TreeModel
arg2)
{-# LINE 238 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)
    Ptr TreeModel
forall a. Ptr a
nullPtr
  IO (Ptr ())
-> (Ptr () -> IO [Ptr NativeTreePath]) -> IO [Ptr NativeTreePath]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr () -> IO [Ptr NativeTreePath]
forall a. Ptr () -> IO [Ptr a]
fromGList
  IO [Ptr NativeTreePath]
-> ([Ptr NativeTreePath] -> IO [TreePath]) -> IO [TreePath]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr NativeTreePath -> IO TreePath)
-> [Ptr NativeTreePath] -> IO [TreePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ptr NativeTreePath -> IO TreePath
fromTreePath

-- | Returns the number of rows that are selected.
--
-- * Available since Gtk+ version 2.2
--
treeSelectionCountSelectedRows :: TreeSelectionClass self => self
 -> IO Int -- ^ returns The number of rows selected.
treeSelectionCountSelectedRows :: forall self. TreeSelectionClass self => self -> IO Int
treeSelectionCountSelectedRows self
self =
  (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  (\(TreeSelection ForeignPtr TreeSelection
arg1) -> ForeignPtr TreeSelection
-> (Ptr TreeSelection -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO CInt) -> IO CInt)
-> (Ptr TreeSelection -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection -> IO CInt
gtk_tree_selection_count_selected_rows Ptr TreeSelection
argPtr1)
{-# LINE 252 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)


-- | Select a specific item by 'TreePath'.
--
treeSelectionSelectPath :: TreeSelectionClass self => self
 -> TreePath
 -> IO ()
treeSelectionSelectPath :: forall self. TreeSelectionClass self => self -> TreePath -> IO ()
treeSelectionSelectPath self
self [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
treeSelectionSelectPath self
self TreePath
path =
  TreePath -> (NativeTreePath -> IO ()) -> IO ()
forall a. TreePath -> (NativeTreePath -> IO a) -> IO a
withTreePath TreePath
path ((NativeTreePath -> IO ()) -> IO ())
-> (NativeTreePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NativeTreePath
path ->
  (\(TreeSelection ForeignPtr TreeSelection
arg1) (NativeTreePath Ptr NativeTreePath
arg2) -> ForeignPtr TreeSelection -> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO ()) -> IO ())
-> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection -> Ptr NativeTreePath -> IO ()
gtk_tree_selection_select_path Ptr TreeSelection
argPtr1 Ptr NativeTreePath
arg2)
{-# LINE 264 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)
    NativeTreePath
path

-- | Deselect a specific item by 'TreePath'.
--
treeSelectionUnselectPath :: TreeSelectionClass self => self
 -> TreePath
 -> IO ()
treeSelectionUnselectPath :: forall self. TreeSelectionClass self => self -> TreePath -> IO ()
treeSelectionUnselectPath self
self TreePath
path =
  TreePath -> (NativeTreePath -> IO ()) -> IO ()
forall a. TreePath -> (NativeTreePath -> IO a) -> IO a
withTreePath TreePath
path ((NativeTreePath -> IO ()) -> IO ())
-> (NativeTreePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NativeTreePath
path ->
  (\(TreeSelection ForeignPtr TreeSelection
arg1) (NativeTreePath Ptr NativeTreePath
arg2) -> ForeignPtr TreeSelection -> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO ()) -> IO ())
-> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection -> Ptr NativeTreePath -> IO ()
gtk_tree_selection_unselect_path Ptr TreeSelection
argPtr1 Ptr NativeTreePath
arg2)
{-# LINE 275 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)
    NativeTreePath
path

-- | Returns True if the row at the given path is currently selected.
--
treeSelectionPathIsSelected :: TreeSelectionClass self => self
 -> TreePath -> IO Bool
treeSelectionPathIsSelected :: forall self. TreeSelectionClass self => self -> TreeSelectionCB
treeSelectionPathIsSelected self
self TreePath
path =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  TreePath -> (NativeTreePath -> IO CInt) -> IO CInt
forall a. TreePath -> (NativeTreePath -> IO a) -> IO a
withTreePath TreePath
path ((NativeTreePath -> IO CInt) -> IO CInt)
-> (NativeTreePath -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \NativeTreePath
path ->
  (\(TreeSelection ForeignPtr TreeSelection
arg1) (NativeTreePath Ptr NativeTreePath
arg2) -> ForeignPtr TreeSelection
-> (Ptr TreeSelection -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO CInt) -> IO CInt)
-> (Ptr TreeSelection -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection -> Ptr NativeTreePath -> IO CInt
gtk_tree_selection_path_is_selected Ptr TreeSelection
argPtr1 Ptr NativeTreePath
arg2)
{-# LINE 286 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)
    NativeTreePath
path

-- | Select a specific item by 'TreeIter'.
--
treeSelectionSelectIter :: TreeSelectionClass self => self -> TreeIter -> IO ()
treeSelectionSelectIter :: forall self.
TreeSelectionClass self =>
self -> TreeSelectionForeachCB
treeSelectionSelectIter self
self TreeIter
iter =
  TreeIter -> (Ptr TreeIter -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TreeIter
iter ((Ptr TreeIter -> IO ()) -> IO ())
-> (Ptr TreeIter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TreeIter
iterPtr ->
  (\(TreeSelection ForeignPtr TreeSelection
arg1) Ptr TreeIter
arg2 -> ForeignPtr TreeSelection -> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO ()) -> IO ())
-> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection -> Ptr TreeIter -> IO ()
gtk_tree_selection_select_iter Ptr TreeSelection
argPtr1 Ptr TreeIter
arg2)
{-# LINE 295 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)
    Ptr TreeIter
iterPtr

-- | Deselect a specific item by 'TreeIter'.
--
treeSelectionUnselectIter :: TreeSelectionClass self => self -> TreeIter -> IO ()
treeSelectionUnselectIter :: forall self.
TreeSelectionClass self =>
self -> TreeSelectionForeachCB
treeSelectionUnselectIter self
self TreeIter
iter =
  TreeIter -> (Ptr TreeIter -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TreeIter
iter ((Ptr TreeIter -> IO ()) -> IO ())
-> (Ptr TreeIter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TreeIter
iterPtr ->
  (\(TreeSelection ForeignPtr TreeSelection
arg1) Ptr TreeIter
arg2 -> ForeignPtr TreeSelection -> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO ()) -> IO ())
-> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection -> Ptr TreeIter -> IO ()
gtk_tree_selection_unselect_iter Ptr TreeSelection
argPtr1 Ptr TreeIter
arg2)
{-# LINE 304 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)
    Ptr TreeIter
iterPtr

-- | Returns True if the row at the given iter is currently selected.
--
treeSelectionIterIsSelected :: TreeSelectionClass self => self
 -> TreeIter
 -> IO Bool
treeSelectionIterIsSelected :: forall self. TreeSelectionClass self => self -> TreeIter -> IO Bool
treeSelectionIterIsSelected self
self TreeIter
iter =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  TreeIter -> (Ptr TreeIter -> IO CInt) -> IO CInt
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with TreeIter
iter ((Ptr TreeIter -> IO CInt) -> IO CInt)
-> (Ptr TreeIter -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr TreeIter
iterPtr ->
  (\(TreeSelection ForeignPtr TreeSelection
arg1) Ptr TreeIter
arg2 -> ForeignPtr TreeSelection
-> (Ptr TreeSelection -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO CInt) -> IO CInt)
-> (Ptr TreeSelection -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection -> Ptr TreeIter -> IO CInt
gtk_tree_selection_iter_is_selected Ptr TreeSelection
argPtr1 Ptr TreeIter
arg2)
{-# LINE 316 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)
    Ptr TreeIter
iterPtr

-- | Selects all the nodes. The tree selection must be set to
-- 'SelectionMultiple' mode.
--
treeSelectionSelectAll :: TreeSelectionClass self => self -> IO ()
treeSelectionSelectAll :: forall self. TreeSelectionClass self => self -> IO ()
treeSelectionSelectAll self
self =
  (\(TreeSelection ForeignPtr TreeSelection
arg1) -> ForeignPtr TreeSelection -> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO ()) -> IO ())
-> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection -> IO ()
gtk_tree_selection_select_all Ptr TreeSelection
argPtr1)
{-# LINE 325 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)

-- | Unselects all the nodes.
--
treeSelectionUnselectAll :: TreeSelectionClass self => self -> IO ()
treeSelectionUnselectAll :: forall self. TreeSelectionClass self => self -> IO ()
treeSelectionUnselectAll self
self =
  (\(TreeSelection ForeignPtr TreeSelection
arg1) -> ForeignPtr TreeSelection -> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO ()) -> IO ())
-> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection -> IO ()
gtk_tree_selection_unselect_all Ptr TreeSelection
argPtr1)
{-# LINE 332 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)

-- | Selects a range of nodes, determined by @startPath@ and @endPath@
-- inclusive. @selection@ must be set to 'SelectionMultiple' mode.
--
treeSelectionSelectRange :: TreeSelectionClass self => self
 -> TreePath -- ^ @startPath@ - The initial node of the range.
 -> TreePath -- ^ @endPath@ - The final node of the range.
 -> IO ()
treeSelectionSelectRange :: forall self.
TreeSelectionClass self =>
self -> TreePath -> TreePath -> IO ()
treeSelectionSelectRange self
self TreePath
startPath TreePath
endPath =
  TreePath -> (NativeTreePath -> IO ()) -> IO ()
forall a. TreePath -> (NativeTreePath -> IO a) -> IO a
withTreePath TreePath
endPath ((NativeTreePath -> IO ()) -> IO ())
-> (NativeTreePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NativeTreePath
endPath ->
  TreePath -> (NativeTreePath -> IO ()) -> IO ()
forall a. TreePath -> (NativeTreePath -> IO a) -> IO a
withTreePath TreePath
startPath ((NativeTreePath -> IO ()) -> IO ())
-> (NativeTreePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NativeTreePath
startPath ->
  (\(TreeSelection ForeignPtr TreeSelection
arg1) (NativeTreePath Ptr NativeTreePath
arg2) (NativeTreePath Ptr NativeTreePath
arg3) -> ForeignPtr TreeSelection -> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO ()) -> IO ())
-> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection
-> Ptr NativeTreePath -> Ptr NativeTreePath -> IO ()
gtk_tree_selection_select_range Ptr TreeSelection
argPtr1 Ptr NativeTreePath
arg2 Ptr NativeTreePath
arg3)
{-# LINE 345 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)
    NativeTreePath
startPath
    NativeTreePath
endPath


-- | Unselects a range of nodes, determined by @startPath@ and @endPath@
-- inclusive.
--
-- * Available since Gtk+ version 2.2
--
treeSelectionUnselectRange :: TreeSelectionClass self => self
 -> TreePath -- ^ @startPath@ - The initial node of the range.
 -> TreePath -- ^ @endPath@ - The initial node of the range.
 -> IO ()
treeSelectionUnselectRange :: forall self.
TreeSelectionClass self =>
self -> TreePath -> TreePath -> IO ()
treeSelectionUnselectRange self
self TreePath
startPath TreePath
endPath =
  TreePath -> (NativeTreePath -> IO ()) -> IO ()
forall a. TreePath -> (NativeTreePath -> IO a) -> IO a
withTreePath TreePath
endPath ((NativeTreePath -> IO ()) -> IO ())
-> (NativeTreePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NativeTreePath
endPath ->
  TreePath -> (NativeTreePath -> IO ()) -> IO ()
forall a. TreePath -> (NativeTreePath -> IO a) -> IO a
withTreePath TreePath
startPath ((NativeTreePath -> IO ()) -> IO ())
-> (NativeTreePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NativeTreePath
startPath ->
  (\(TreeSelection ForeignPtr TreeSelection
arg1) (NativeTreePath Ptr NativeTreePath
arg2) (NativeTreePath Ptr NativeTreePath
arg3) -> ForeignPtr TreeSelection -> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr TreeSelection
arg1 ((Ptr TreeSelection -> IO ()) -> IO ())
-> (Ptr TreeSelection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr TreeSelection
argPtr1 ->Ptr TreeSelection
-> Ptr NativeTreePath -> Ptr NativeTreePath -> IO ()
gtk_tree_selection_unselect_range Ptr TreeSelection
argPtr1 Ptr NativeTreePath
arg2 Ptr NativeTreePath
arg3)
{-# LINE 363 "./Graphics/UI/Gtk/ModelView/TreeSelection.chs" #-}
    (toTreeSelection self)
    NativeTreePath
startPath
    NativeTreePath
endPath


--------------------
-- Attributes

-- | \'mode\' property. See 'treeSelectionGetMode' and 'treeSelectionSetMode'
--
treeSelectionMode :: TreeSelectionClass self => Attr self SelectionMode
treeSelectionMode :: forall self. TreeSelectionClass self => Attr self SelectionMode
treeSelectionMode = (self -> IO SelectionMode)
-> (self -> SelectionMode -> IO ())
-> ReadWriteAttr self SelectionMode SelectionMode
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO SelectionMode
forall self. TreeSelectionClass self => self -> IO SelectionMode
treeSelectionGetMode
  self -> SelectionMode -> IO ()
forall self.
TreeSelectionClass self =>
self -> SelectionMode -> IO ()
treeSelectionSetMode

--------------------
-- Signals

-- | Emitted whenever the selection has (possibly) changed. Please note that
-- this signal is mostly a hint. It may only be emitted once when a range of
-- rows are selected, and it may occasionally be emitted when nothing has
-- happened.
--
treeSelectionSelectionChanged :: TreeSelectionClass self => Signal self (IO ())
treeSelectionSelectionChanged :: forall self. TreeSelectionClass self => Signal self (IO ())
treeSelectionSelectionChanged = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (SignalName -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
SignalName -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE SignalName
"changed")

foreign import ccall safe "gtk_tree_selection_set_mode"
  gtk_tree_selection_set_mode :: ((Ptr TreeSelection) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_tree_selection_get_mode"
  gtk_tree_selection_get_mode :: ((Ptr TreeSelection) -> (IO CInt))

foreign import ccall safe "gtk_tree_selection_set_select_function"
  gtk_tree_selection_set_select_function :: ((Ptr TreeSelection) -> ((FunPtr ((Ptr TreeSelection) -> ((Ptr TreeModel) -> ((Ptr NativeTreePath) -> (CInt -> ((Ptr ()) -> (IO CInt))))))) -> ((Ptr ()) -> ((FunPtr ((Ptr ()) -> (IO ()))) -> (IO ())))))

foreign import ccall unsafe "gtk_tree_selection_get_tree_view"
  gtk_tree_selection_get_tree_view :: ((Ptr TreeSelection) -> (IO (Ptr TreeView)))

foreign import ccall safe "gtk_tree_selection_get_selected"
  gtk_tree_selection_get_selected :: ((Ptr TreeSelection) -> ((Ptr TreeModel) -> ((Ptr TreeIter) -> (IO CInt))))

foreign import ccall safe "gtk_tree_selection_selected_foreach"
  gtk_tree_selection_selected_foreach :: ((Ptr TreeSelection) -> ((FunPtr ((Ptr TreeModel) -> ((Ptr NativeTreePath) -> ((Ptr TreeIter) -> ((Ptr ()) -> (IO ())))))) -> ((Ptr ()) -> (IO ()))))

foreign import ccall safe "gtk_tree_selection_get_selected_rows"
  gtk_tree_selection_get_selected_rows :: ((Ptr TreeSelection) -> ((Ptr TreeModel) -> (IO (Ptr ()))))

foreign import ccall safe "gtk_tree_selection_count_selected_rows"
  gtk_tree_selection_count_selected_rows :: ((Ptr TreeSelection) -> (IO CInt))

foreign import ccall safe "gtk_tree_selection_select_path"
  gtk_tree_selection_select_path :: ((Ptr TreeSelection) -> ((Ptr NativeTreePath) -> (IO ())))

foreign import ccall safe "gtk_tree_selection_unselect_path"
  gtk_tree_selection_unselect_path :: ((Ptr TreeSelection) -> ((Ptr NativeTreePath) -> (IO ())))

foreign import ccall safe "gtk_tree_selection_path_is_selected"
  gtk_tree_selection_path_is_selected :: ((Ptr TreeSelection) -> ((Ptr NativeTreePath) -> (IO CInt)))

foreign import ccall safe "gtk_tree_selection_select_iter"
  gtk_tree_selection_select_iter :: ((Ptr TreeSelection) -> ((Ptr TreeIter) -> (IO ())))

foreign import ccall safe "gtk_tree_selection_unselect_iter"
  gtk_tree_selection_unselect_iter :: ((Ptr TreeSelection) -> ((Ptr TreeIter) -> (IO ())))

foreign import ccall safe "gtk_tree_selection_iter_is_selected"
  gtk_tree_selection_iter_is_selected :: ((Ptr TreeSelection) -> ((Ptr TreeIter) -> (IO CInt)))

foreign import ccall safe "gtk_tree_selection_select_all"
  gtk_tree_selection_select_all :: ((Ptr TreeSelection) -> (IO ()))

foreign import ccall safe "gtk_tree_selection_unselect_all"
  gtk_tree_selection_unselect_all :: ((Ptr TreeSelection) -> (IO ()))

foreign import ccall safe "gtk_tree_selection_select_range"
  gtk_tree_selection_select_range :: ((Ptr TreeSelection) -> ((Ptr NativeTreePath) -> ((Ptr NativeTreePath) -> (IO ()))))

foreign import ccall safe "gtk_tree_selection_unselect_range"
  gtk_tree_selection_unselect_range :: ((Ptr TreeSelection) -> ((Ptr NativeTreePath) -> ((Ptr NativeTreePath) -> (IO ()))))