Menu
▾
▴
[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/TreeList TreeModelSort.chs.pp,NONE,1.1 TreeSelection.chs.pp,NONE,1.1 TreeViewColumn.chs.pp,NONE,1.1 TreeModel.chs.pp,1.2,1.3 TreeView.chs.pp,1.2,1.3 TreeModelSort.chs,1.2,NONE TreeSelection.chs,1.2,NONE TreeViewColumn.chs,1.2,NONE
|
From: Axel S. <as...@us...> - 2005-02-17 00:13:30
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/TreeList In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30366/gtk/Graphics/UI/Gtk/TreeList Modified Files: TreeModel.chs.pp TreeView.chs.pp Added Files: TreeModelSort.chs.pp TreeSelection.chs.pp TreeViewColumn.chs.pp Removed Files: TreeModelSort.chs TreeSelection.chs TreeViewColumn.chs Log Message: Made Mogul's TreePath which is [Int] the only TreePath, even in TreeModel. Completed DrawWindow (gdk_window). Make apiGen Makefile work with different versions. --- NEW FILE: TreeSelection.chs.pp --- -- -*-haskell-*- -- GIMP Toolkit (GTK) Widget TreeSelection -- -- Author : Axel Simon -- -- Created: 8 May 2001 -- -- Version $Revision: 1.1 $ from $Date: 2005/02/17 00:13:20 $ -- -- 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 : gtk...@li... -- Stability : provisional -- Portability : portable (depends on GHC) -- -- The selection object for GtkTreeView module Graphics.UI.Gtk.TreeList.TreeSelection ( -- * Description -- -- | 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" -- | +----GtkTreeSelection -- @ -- * Types TreeSelection, TreeSelectionClass, castToTreeSelection, SelectionMode(..), TreeSelectionCB, TreeSelectionForeachCB, -- * Methods treeSelectionSetMode, treeSelectionGetMode, treeSelectionSetSelectFunction, treeSelectionGetTreeView, treeSelectionGetSelected, treeSelectionSelectedForeach, #if GTK_CHECK_VERSION(2,2,0) treeSelectionGetSelectedRows, treeSelectionCountSelectedRows, #endif treeSelectionSelectPath, treeSelectionUnselectPath, treeSelectionPathIsSelected, treeSelectionSelectIter, treeSelectionUnselectIter, treeSelectionIterIsSelected, treeSelectionSelectAll, treeSelectionUnselectAll, treeSelectionSelectRange, #if GTK_CHECK_VERSION(2,2,0) treeSelectionUnselectRange, #endif -- * Signals onSelectionChanged, afterSelectionChanged ) where import Monad (liftM) import Data.IORef (newIORef, readIORef, writeIORef) import System.Glib.FFI import System.Glib.GList (GList, fromGList, toGList) import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.Enums (SelectionMode(..)) {#import Graphics.UI.Gtk.TreeList.TreeModel#} import Graphics.UI.Gtk.General.Structs (treeIterSize) import Graphics.UI.Gtk.General.General (mkDestructor) {# context lib="gtk" prefix="gtk" #} -- methods -- | Set single or multiple choice. -- treeSelectionSetMode :: (TreeSelectionClass ts) => ts -> SelectionMode -> IO () treeSelectionSetMode ts sm = {#call tree_selection_set_mode#} (toTreeSelection ts) ((fromIntegral.fromEnum) sm) -- | Gets the selection mode. -- treeSelectionGetMode :: (TreeSelectionClass ts) => ts -> IO SelectionMode treeSelectionGetMode ts = liftM (toEnum.fromIntegral) $ {#call unsafe tree_selection_get_mode#} (toTreeSelection ts) -- | 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 ts) => ts -> TreeSelectionCB -> IO () treeSelectionSetSelectFunction ts fun = do fPtr <- mkTreeSelectionFunc (\_ _ tp _ -> do path <- nativeTreePathGetIndices (NativeTreePath (castPtr tp)) liftM fromBool $ fun path ) dRef <- newIORef nullFunPtr dPtr <- mkDestructor $ do dPtr <- readIORef dRef freeHaskellFunPtr dPtr freeHaskellFunPtr fPtr writeIORef dRef dPtr {#call tree_selection_set_select_function#} (toTreeSelection ts) fPtr nullPtr dPtr -- | Callback type for a function that is called everytime the selection -- changes. This function is set with 'treeSelectionSetSelectFunction'. -- type TreeSelectionCB = TreePath -> IO Bool {#pointer TreeSelectionFunc#} foreign import ccall "wrapper" mkTreeSelectionFunc :: (Ptr () -> Ptr () -> Ptr TreePath -> Ptr () -> IO CInt)-> IO TreeSelectionFunc -- | Retrieve the 'TreeView' widget that this 'TreeSelection' works on. -- treeSelectionGetTreeView :: (TreeSelectionClass ts) => ts -> IO TreeView treeSelectionGetTreeView ts = makeNewObject mkTreeView $ {#call unsafe tree_selection_get_tree_view#} (toTreeSelection ts) -- | Retrieves the selection of a single choice 'TreeSelection'. -- treeSelectionGetSelected :: (TreeSelectionClass ts) => ts -> IO (Maybe TreeIter) treeSelectionGetSelected ts = do iterPtr <- mallocBytes treeIterSize iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr) res <- {#call tree_selection_get_selected#} (toTreeSelection ts) (nullPtr) iter return $ if (toBool res) then Just iter else Nothing -- | 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 ts) => ts -> TreeSelectionForeachCB -> IO () treeSelectionSelectedForeach ts fun = do fPtr <- mkTreeSelectionForeachFunc (\_ ti _ -> 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. iterPtr <- mallocBytes treeIterSize copyBytes iterPtr ti treeIterSize iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr) fun iter ) {#call tree_selection_selected_foreach#} (toTreeSelection ts) fPtr nullPtr freeHaskellFunPtr fPtr -- | Callback function type for 'treeSelectionSelectedForeach'. -- type TreeSelectionForeachCB = TreeIter -> IO () {#pointer TreeSelectionForeachFunc#} foreign import ccall "wrapper" mkTreeSelectionForeachFunc :: (Ptr () -> Ptr TreeIter -> Ptr () -> IO ()) -> IO TreeSelectionForeachFunc #if GTK_CHECK_VERSION(2,2,0) -- | 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 self = {# call gtk_tree_selection_get_selected_rows #} (toTreeSelection self) nullPtr >>= fromGList >>= mapM 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 self = liftM fromIntegral $ {# call gtk_tree_selection_count_selected_rows #} (toTreeSelection self) #endif -- | Select a specific item by 'TreePath'. -- treeSelectionSelectPath :: (TreeSelectionClass ts) => ts -> TreePath -> IO () treeSelectionSelectPath ts [] = return () treeSelectionSelectPath ts tp = do nativePath <- nativeTreePathNew mapM_ ({#call unsafe tree_path_append_index#} nativePath . fromIntegral) tp {#call tree_selection_select_path#} (toTreeSelection ts) nativePath nativeTreePathFree nativePath -- | Deselect a specific item by 'TreePath'. -- treeSelectionUnselectPath :: (TreeSelectionClass ts) => ts -> TreePath -> IO () treeSelectionUnselectPath ts tp = do nativePath <- nativeTreePathNew mapM_ ({#call unsafe tree_path_append_index#} nativePath . fromIntegral) tp {#call tree_selection_unselect_path#} (toTreeSelection ts) nativePath nativeTreePathFree nativePath -- | Returns True if the row at the given path is currently selected. -- treeSelectionPathIsSelected :: (TreeSelectionClass ts) => ts -> TreePath -> IO Bool treeSelectionPathIsSelected ts tp = do nativePath <- nativeTreePathNew mapM_ ({#call unsafe tree_path_append_index#} nativePath . fromIntegral) tp res <- {#call unsafe tree_selection_path_is_selected#} (toTreeSelection ts) nativePath nativeTreePathFree nativePath return (toBool res) -- | Select a specific item by 'TreeIter'. -- treeSelectionSelectIter :: (TreeSelectionClass ts) => ts -> TreeIter -> IO () treeSelectionSelectIter ts ti = {#call tree_selection_select_iter#} (toTreeSelection ts) ti -- | Deselect a specific item by 'TreeIter'. -- treeSelectionUnselectIter :: (TreeSelectionClass ts) => ts -> TreeIter -> IO () treeSelectionUnselectIter ts ti = {#call tree_selection_unselect_iter#} (toTreeSelection ts) ti -- | Returns True if the row at the given iter is currently selected. -- treeSelectionIterIsSelected :: (TreeSelectionClass ts) => ts -> TreeIter -> IO Bool treeSelectionIterIsSelected ts ti = liftM toBool $ {#call unsafe tree_selection_iter_is_selected#} (toTreeSelection ts) ti -- | Select everything. -- treeSelectionSelectAll :: (TreeSelectionClass ts) => ts -> IO () treeSelectionSelectAll ts = {#call tree_selection_select_all#} (toTreeSelection ts) -- | Deselect everything. -- treeSelectionUnselectAll :: (TreeSelectionClass ts) => ts -> IO () treeSelectionUnselectAll ts = {#call tree_selection_unselect_all#} (toTreeSelection ts) -- | Select a range specified by two 'TreePath's. -- treeSelectionSelectRange :: (TreeSelectionClass ts) => ts -> TreePath -> TreePath -> IO () treeSelectionSelectRange ts start end = do nP1 <- nativeTreePathNew mapM_ ({#call unsafe tree_path_append_index#} nP1 . fromIntegral) start nP2 <- nativeTreePathNew mapM_ ({#call unsafe tree_path_append_index#} nP2 . fromIntegral) end {#call tree_selection_select_range#} (toTreeSelection ts) nP1 nP2 nativeTreePathFree nP1 nativeTreePathFree nP2 #if GTK_CHECK_VERSION(2,2,0) -- | Unselects a range of nodes. -- -- * Available since Gtk version 2.2 -- treeSelectionUnselectRange :: TreeSelectionClass self => self -> TreePath -> TreePath -> IO () treeSelectionUnselectRange ts start end = do nP1 <- nativeTreePathNew mapM_ ({#call unsafe tree_path_append_index#} nP1 . fromIntegral) start nP2 <- nativeTreePathNew mapM_ ({#call unsafe tree_path_append_index#} nP2 . fromIntegral) end {#call tree_selection_unselect_range#} (toTreeSelection ts) nP1 nP2 nativeTreePathFree nP1 nativeTreePathFree nP2 #endif -- | Emitted each time the user changes the selection. -- onSelectionChanged, afterSelectionChanged :: TreeSelectionClass ts => ts -> IO () -> IO (ConnectId ts) onSelectionChanged = connect_NONE__NONE "changed" False afterSelectionChanged = connect_NONE__NONE "changed" True --- TreeModelSort.chs DELETED --- --- NEW FILE: TreeViewColumn.chs.pp --- -- -*-haskell-*- -- GIMP Toolkit (GTK) TreeViewColumn TreeView -- -- Author : Axel Simon -- -- Created: 9 May 2001 -- -- Version $Revision: 1.1 $ from $Date: 2005/02/17 00:13:20 $ -- -- Copyright (c) 2001 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 : gtk...@li... -- Stability : provisional -- Portability : portable (depends on GHC) -- -- * tree_view_column_new_with_attributes and tree_view_column_set_attributes -- are variadic and the funcitonality can be achieved through other -- functions. -- -- * tree_view_column_set_cell_data and tree_view_column_cell_get_size are not -- bound because I am not sure what they do and when they are useful -- -- TODO -- -- * treeViewColumnSetCellData is not bound. With this function the user has -- control over how data in the store is mapped to the attributes of a -- cell renderer. This functin should be bound in the future to allow the -- user to insert Haskell data types into the store and convert these -- values to attributes of cell renderers. -- module Graphics.UI.Gtk.TreeList.TreeViewColumn ( TreeViewColumn, TreeViewColumnClass, castToTreeViewColumn, treeViewColumnNew, treeViewColumnNewWithAttributes, treeViewColumnPackStart, treeViewColumnPackEnd, treeViewColumnClear, treeViewColumnGetCellRenderers, treeViewColumnAddAttribute, treeViewColumnAddAttributes, treeViewColumnSetAttributes, treeViewColumnClearAttributes, treeViewColumnSetSpacing, treeViewColumnGetSpacing, treeViewColumnSetVisible, treeViewColumnGetVisible, treeViewColumnSetResizable, treeViewColumnGetResizable, TreeViewColumnSizing(..), treeViewColumnSetSizing, treeViewColumnGetSizing, treeViewColumnGetWidth, treeViewColumnSetFixedWidth, treeViewColumnGetFixedWidth, treeViewColumnSetMinWidth, treeViewColumnGetMinWidth, treeViewColumnSetMaxWidth, treeViewColumnGetMaxWidth, treeViewColumnClicked, treeViewColumnSetTitle, treeViewColumnGetTitle, treeViewColumnSetClickable, treeViewColumnGetClickable, treeViewColumnSetWidget, treeViewColumnGetWidget, treeViewColumnSetAlignment, treeViewColumnGetAlignment, treeViewColumnSetReorderable, treeViewColumnGetReorderable, treeViewColumnSetSortColumnId, treeViewColumnGetSortColumnId, treeViewColumnSetSortIndicator, treeViewColumnGetSortIndicator, treeViewColumnSetSortOrder, treeViewColumnGetSortOrder, SortType(..), onColClicked, afterColClicked ) where import Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import Graphics.UI.Gtk.Abstract.Object (makeNewObject) {#import Graphics.UI.Gtk.Types#} {#import Graphics.UI.Gtk.Signals#} import Graphics.UI.Gtk.General.Enums (TreeViewColumnSizing(..), SortType(..)) {#import Graphics.UI.Gtk.TreeList.TreeModel#} import Graphics.UI.Gtk.TreeList.CellRenderer (Attribute(..)) {#import System.Glib.GList#} {# context lib="gtk" prefix="gtk" #} -- TreeViewColumn type declaration -- methods -- | Generate a new TreeViewColumn widget. -- treeViewColumnNew :: IO TreeViewColumn treeViewColumnNew = makeNewObject mkTreeViewColumn {#call tree_view_column_new#} -- | Returns a new TreeViewColumn with title @title@, cell renderer @cr@, and -- attributes @attribs@. -- treeViewColumnNewWithAttributes :: CellRendererClass cr => String -> cr -> [(String, Int)] -> IO TreeViewColumn treeViewColumnNewWithAttributes title cr attribs = do tvc <- treeViewColumnNew treeViewColumnSetTitle tvc title treeViewColumnPackStart tvc cr True treeViewColumnAddAttributes tvc cr attribs return tvc -- | Add a cell renderer at the beginning of -- a column. -- -- * Excess space is divided equally among all renderers which have -- @expand@ set to True. -- treeViewColumnPackStart :: (TreeViewColumnClass tvc, CellRendererClass cr) => tvc -> cr -> Bool -> IO () treeViewColumnPackStart tvc cr expand = {#call unsafe tree_view_column_pack_start#} (toTreeViewColumn tvc) (toCellRenderer cr) (fromBool expand) -- | Add a cell renderer at the end of a column. -- -- * Excess space is divided equally among all renderers which have -- @expand@ set to True. -- treeViewColumnPackEnd :: (TreeViewColumnClass tvc, CellRendererClass cr) => tvc -> cr -> Bool -> IO () treeViewColumnPackEnd tvc cr expand = {#call unsafe tree_view_column_pack_end#} (toTreeViewColumn tvc) (toCellRenderer cr) (fromBool expand) -- | Remove the associations of attributes -- to a store for all 'CellRenderers'. -- treeViewColumnClear :: TreeViewColumnClass tvc => tvc -> IO () treeViewColumnClear tvc = {#call tree_view_column_clear#} (toTreeViewColumn tvc) -- | Retrieve all -- 'CellRenderer's that are contained in this column. -- treeViewColumnGetCellRenderers :: TreeViewColumnClass tvc => tvc -> IO [CellRenderer] treeViewColumnGetCellRenderers tvc = do glist <- {#call unsafe tree_view_column_get_cell_renderers#} (toTreeViewColumn tvc) crs <- fromGList glist mapM (makeNewObject mkCellRenderer) (map return crs) -- | Insert an attribute to change the -- behaviour of the column's cell renderer. -- -- * The 'CellRenderer' @cr@ must already be in -- 'TreeViewColumn'. -- treeViewColumnAddAttribute :: (TreeViewColumnClass tvc, CellRendererClass cr) => tvc -> cr -> String -> Int -> IO () treeViewColumnAddAttribute tvc cr attr col = withUTFString attr $ \cstr -> {#call unsafe tree_view_column_add_attribute#} (toTreeViewColumn tvc) (toCellRenderer cr) cstr (fromIntegral col) -- | Insert attributes @attribs@ -- to change the behaviour of column @tvc@'s cell renderer -- @cr@. -- treeViewColumnAddAttributes :: (TreeViewColumnClass tvc, CellRendererClass cr) => tvc -> cr -> [(String,Int)] -> IO () treeViewColumnAddAttributes tvc cr attribs = mapM_ (\ (attr, col) -> treeViewColumnAddAttribute tvc cr attr col) attribs -- | Set the attributes of -- the cell renderer @cr@ in the tree column @tvc@ -- be @attribs@. -- The attributes are given as a list of attribute\/column pairs. -- All existing attributes are removed, and replaced with the new attributes. -- treeViewColumnSetAttributes :: (TreeViewColumnClass tvc, CellRendererClass cr) => tvc -> cr -> [(String, Int)] -> IO () treeViewColumnSetAttributes tvc cr attribs = do treeViewColumnClearAttributes tvc cr treeViewColumnAddAttributes tvc cr attribs -- | Clears all existing attributes -- of the column @tvc@. -- treeViewColumnClearAttributes :: (TreeViewColumnClass tvc, CellRendererClass cr) => tvc -> cr -> IO () treeViewColumnClearAttributes tvc cr = {#call tree_view_column_clear_attributes#} (toTreeViewColumn tvc) (toCellRenderer cr) -- | Set the number of pixels between two -- cell renderers. -- treeViewColumnSetSpacing :: TreeViewColumnClass tvc => tvc -> Int -> IO () treeViewColumnSetSpacing tvc vis = {#call tree_view_column_set_spacing#} (toTreeViewColumn tvc) (fromIntegral vis) -- | Get the number of pixels between two -- cell renderers. -- treeViewColumnGetSpacing :: TreeViewColumnClass tvc => tvc -> IO Int treeViewColumnGetSpacing tvc = liftM fromIntegral $ {#call unsafe tree_view_column_get_spacing#} (toTreeViewColumn tvc) -- | Set the visibility of a given column. -- treeViewColumnSetVisible :: TreeViewColumnClass tvc => tvc -> Bool -> IO () treeViewColumnSetVisible tvc vis = {#call tree_view_column_set_visible#} (toTreeViewColumn tvc) (fromBool vis) -- | Get the visibility of a given column. -- treeViewColumnGetVisible :: TreeViewColumnClass tvc => tvc -> IO Bool treeViewColumnGetVisible tvc = liftM toBool $ {#call unsafe tree_view_column_get_visible#} (toTreeViewColumn tvc) -- | Set if a given column is resizable -- by the user. -- treeViewColumnSetResizable :: TreeViewColumnClass tvc => tvc -> Bool -> IO () treeViewColumnSetResizable tvc vis = {#call tree_view_column_set_resizable#} (toTreeViewColumn tvc) (fromBool vis) -- | Get if a given column is resizable -- by the user. -- treeViewColumnGetResizable :: TreeViewColumnClass tvc => tvc -> IO Bool treeViewColumnGetResizable tvc = liftM toBool $ {#call unsafe tree_view_column_get_resizable#} (toTreeViewColumn tvc) -- | Set wether the column can be resized. -- treeViewColumnSetSizing :: TreeViewColumnClass tvc => tvc -> TreeViewColumnSizing -> IO () treeViewColumnSetSizing tvc size = {#call tree_view_column_set_sizing#} (toTreeViewColumn tvc) ((fromIntegral.fromEnum) size) -- | Return the resizing type of the column. -- treeViewColumnGetSizing :: TreeViewColumnClass tvc => tvc -> IO TreeViewColumnSizing treeViewColumnGetSizing tvc = liftM (toEnum.fromIntegral) $ {#call unsafe tree_view_column_get_sizing#} (toTreeViewColumn tvc) -- | Query the current width of the column. -- treeViewColumnGetWidth :: TreeViewColumnClass tvc => tvc -> IO Int treeViewColumnGetWidth tvc = liftM fromIntegral $ {#call unsafe tree_view_column_get_width#} (toTreeViewColumn tvc) -- | Set the width of the column. -- -- * This is meaningful only if the sizing type is 'TreeViewColumnFixed'. -- treeViewColumnSetFixedWidth :: TreeViewColumnClass tvc => tvc -> Int -> IO () treeViewColumnSetFixedWidth tvc width = {#call tree_view_column_set_fixed_width#} (toTreeViewColumn tvc) (fromIntegral width) -- | Gets the fixed width of the column. -- -- * This is meaningful only if the sizing type is 'TreeViewColumnFixed'. -- -- * This value is only meaning may not be the actual width of the column on the -- screen, just what is requested. -- treeViewColumnGetFixedWidth :: TreeViewColumnClass tvc => tvc -> IO Int treeViewColumnGetFixedWidth tvc = liftM fromIntegral $ {#call unsafe tree_view_column_get_fixed_width#} (toTreeViewColumn tvc) -- | Set minimum width of the column. -- treeViewColumnSetMinWidth :: TreeViewColumnClass tvc => tvc -> Int -> IO () treeViewColumnSetMinWidth tvc width = {#call tree_view_column_set_min_width#} (toTreeViewColumn tvc) (fromIntegral width) -- | Get the minimum width of a column. -- Returns -1 if this width was not set. -- treeViewColumnGetMinWidth :: TreeViewColumnClass tvc => tvc -> IO Int treeViewColumnGetMinWidth tvc = liftM fromIntegral $ {#call unsafe tree_view_column_get_min_width#} (toTreeViewColumn tvc) -- | Set maximum width of the column. -- treeViewColumnSetMaxWidth :: TreeViewColumnClass tvc => tvc -> Int -> IO () treeViewColumnSetMaxWidth tvc width = {#call tree_view_column_set_max_width#} (toTreeViewColumn tvc) (fromIntegral width) -- | Get the maximum width of a column. -- Returns -1 if this width was not set. -- treeViewColumnGetMaxWidth :: TreeViewColumnClass tvc => tvc -> IO Int treeViewColumnGetMaxWidth tvc = liftM fromIntegral $ {#call unsafe tree_view_column_get_max_width#} (toTreeViewColumn tvc) -- | Emit the @clicked@ signal on the -- column. -- treeViewColumnClicked :: TreeViewColumnClass tvc => tvc -> IO () treeViewColumnClicked tvc = {#call tree_view_column_clicked#} (toTreeViewColumn tvc) -- | Set the widget's title if a custom widget -- has not been set. -- treeViewColumnSetTitle :: TreeViewColumnClass tvc => tvc -> String -> IO () treeViewColumnSetTitle tvc title = withUTFString title $ {#call tree_view_column_set_title#} (toTreeViewColumn tvc) -- | Get the widget's title. -- treeViewColumnGetTitle :: TreeViewColumnClass tvc => tvc -> IO (Maybe String) treeViewColumnGetTitle tvc = do strPtr <- {#call unsafe tree_view_column_get_title#} (toTreeViewColumn tvc) if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr -- | Set if the column should be sensitive to mouse clicks. -- treeViewColumnSetClickable :: TreeViewColumnClass tvc => tvc -> Bool -> IO () treeViewColumnSetClickable tvc click = {#call tree_view_column_set_clickable#} (toTreeViewColumn tvc) (fromBool click) -- | Returns True if the user can click on the header for the column. -- treeViewColumnGetClickable :: TreeViewColumnClass tvc => tvc -> IO Bool treeViewColumnGetClickable tvc = liftM toBool $ {#call tree_view_column_get_clickable#} (toTreeViewColumn tvc) -- | Set the column's title to this widget. -- treeViewColumnSetWidget :: (TreeViewColumnClass tvc, WidgetClass w) => tvc -> w -> IO () treeViewColumnSetWidget tvc w = {#call tree_view_column_set_widget#} (toTreeViewColumn tvc) (toWidget w) -- | Retrieve the widget responsible for -- showing the column title. In case only a text title was set this will be a -- 'Alignment' widget with a 'Label' inside. -- treeViewColumnGetWidget :: TreeViewColumnClass tvc => tvc -> IO Widget treeViewColumnGetWidget tvc = makeNewObject mkWidget $ {#call unsafe tree_view_column_get_widget#} (toTreeViewColumn tvc) -- | Set the alignment of the title. -- treeViewColumnSetAlignment :: TreeViewColumnClass tvc => tvc -> Float -> IO () treeViewColumnSetAlignment tvc align = {#call tree_view_column_set_alignment#} (toTreeViewColumn tvc) (realToFrac align) -- | Get the alignment of the titlte. -- treeViewColumnGetAlignment :: TreeViewColumnClass tvc => tvc -> IO Float treeViewColumnGetAlignment tvc = liftM realToFrac $ {#call unsafe tree_view_column_get_alignment#} (toTreeViewColumn tvc) -- | Set if a given column is reorderable -- by the user. -- treeViewColumnSetReorderable :: TreeViewColumnClass tvc => tvc -> Bool -> IO () treeViewColumnSetReorderable tvc vis = {#call tree_view_column_set_reorderable#} (toTreeViewColumn tvc) (fromBool vis) -- | Get if a given column is reorderable -- by the user. -- treeViewColumnGetReorderable :: TreeViewColumnClass tvc => tvc -> IO Bool treeViewColumnGetReorderable tvc = liftM toBool $ {#call unsafe tree_view_column_get_reorderable#} (toTreeViewColumn tvc) -- | Set the column by which to sort. -- -- * Sets the logical @columnId@ that this column sorts on when -- this column is selected for sorting. The selected column's header -- will be clickable after this call. Logical refers to the column in -- the 'TreeModel'. -- treeViewColumnSetSortColumnId :: TreeViewColumnClass tvc => tvc -> Int -> IO () treeViewColumnSetSortColumnId tvc columnId = {#call tree_view_column_set_sort_column_id#} (toTreeViewColumn tvc) (fromIntegral columnId) -- | Get the column by which to sort. -- -- * Retrieves the logical @columnId@ that the model sorts on when -- this column is selected for sorting. -- -- * Returns -1 if this column can't be used for sorting. -- treeViewColumnGetSortColumnId :: TreeViewColumnClass tvc => tvc -> IO Int treeViewColumnGetSortColumnId tvc = liftM fromIntegral $ {#call unsafe tree_view_column_get_sort_column_id#} (toTreeViewColumn tvc) -- | Set if a given column has -- sorting arrows in its heading. -- treeViewColumnSetSortIndicator :: TreeViewColumnClass tvc => tvc -> Bool -> IO () treeViewColumnSetSortIndicator tvc sort = {#call tree_view_column_set_sort_indicator#} (toTreeViewColumn tvc) (fromBool sort) -- | Query if a given column has -- sorting arrows in its heading. -- treeViewColumnGetSortIndicator :: TreeViewColumnClass tvc => tvc -> IO Bool treeViewColumnGetSortIndicator tvc = liftM toBool $ {#call unsafe tree_view_column_get_sort_indicator#} (toTreeViewColumn tvc) -- | Set if a given column is sorted -- in ascending or descending order. -- -- * In order for sorting to work, it is necessary to either use automatic -- sorting via 'treeViewColumnSetSortColumnId' or to use a -- user defined sorting on the elements in a 'TreeModel'. -- treeViewColumnSetSortOrder :: TreeViewColumnClass tvc => tvc -> SortType -> IO () treeViewColumnSetSortOrder tvc sort = {#call tree_view_column_set_sort_order#} (toTreeViewColumn tvc) ((fromIntegral.fromEnum) sort) -- | Query if a given column is sorted -- in ascending or descending order. -- treeViewColumnGetSortOrder :: TreeViewColumnClass tvc => tvc -> IO SortType treeViewColumnGetSortOrder tvc = liftM (toEnum.fromIntegral) $ {#call unsafe tree_view_column_get_sort_order#} (toTreeViewColumn tvc) -- | Emitted when the header of this column has been -- clicked on. -- onColClicked, afterColClicked :: TreeViewColumnClass tvc => tvc -> IO () -> IO (ConnectId tvc) onColClicked = connect_NONE__NONE "clicked" False afterColClicked = connect_NONE__NONE "clicked" True --- TreeSelection.chs DELETED --- Index: TreeModel.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/TreeList/TreeModel.chs.pp,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- TreeModel.chs.pp 12 Feb 2005 17:19:26 -0000 1.2 +++ TreeModel.chs.pp 17 Feb 2005 00:13:20 -0000 1.3 @@ -24,47 +24,95 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- A 'TreeModel' is the abstract base class for --- 'TreeStore' and 'ListStore'. +-- The tree interface used by GtkTreeView -- --- * Most functions are defined in the latter two classes. This module --- provides the 'TreeIter' and 'TreePath' objects. +-- * Description +-- +-- | The "TreeModel" interface defines a generic storage object for use by the +-- "TreeView" widget. It is purely abstract, concrete implementations that +-- store data for a list or tree widget are e.g. "ListStore" and "TreeStore". +-- +-- The model is represented as a hierarchical tree of strongly-typed, +-- columned data. In other words, the model can be seen as a tree where every +-- node has different values depending on which column is being queried. The +-- type of data found in a column can be arbitrary, ranging from basic +-- types like 'String's or 'Int' to user specific types. The types are +-- homogeneous per column across all nodes. It is important to note that this +-- interface only provides a way of examining a model and observing changes. +-- The implementation of each individual model decides how and if changes are +-- made. +-- +-- Two generic models are provided that implement the "TreeModel" interface: +-- the +-- "TreeStore" and the "ListStore". To use these, the developer simply pushes +-- data into these models as necessary. These models provide the data +-- structure as well as the "TreeModel" interface. In fact, they implement +-- other interfaces making drag +-- and drop, sorting, and storing data trivial. +-- +-- Models are accessed on a node\/column level of granularity. One can query +-- for the value of a model at a certain node and a certain column on that +-- node. There are two structures used to reference a particular node in a +-- model. They are the "TreePath" and the "TreeIter" Most of the interface +-- consists of operations on a "TreeIter". +-- +-- A path is essentially a potential node. It is a location on a model that +-- may or may not actually correspond to a node on a specific model. A +-- "TreePath" is in fact just a list of "Int"s and hence are easy to +-- manipulate. Each number refers to the offset at that level. Thus, the +-- path @[0]@ refers to the +-- root node and the path @[2,4]@ refers to the fifth child of the third node. +-- +-- By contrast, a "TreeIter" is a reference to a specific node on a specific +-- model. It is an abstract data type filled in by the model. One can convert a +-- path to an iterator by calling 'treeModelGetIter'. These iterators are the +-- primary way of accessing a model and are similar to the iterators used by +-- "TextBuffer". The model interface defines a set of operations using +-- them for navigating the model. +-- +-- The lifecycle of an iterator can be a little confusing at first. +-- Iterators are expected to always be valid for as long as the model is +-- unchanged (and doesn\'t emit a signal). +-- Additionally, the "TreeStore" and "ListStore" models guarantee that +-- an iterator is valid for as long as the node it refers to is valid. +-- Although generally uninteresting, as one +-- always has to allow for the case where iterators do not persist beyond a +-- signal, some very important performance enhancements were made in the sort +-- model. As a result, the "TreeModelItersPersist" flag was added to +-- indicate this behavior. +-- +-- +-- Class Hierarchy +-- | +-- @ +-- | "GInterface" +-- | +----GtkTreeModel +-- @ -- module Graphics.UI.Gtk.TreeList.TreeModel ( +-- * Types TreeModel, TreeModelClass, castToTreeModel, + TreeModelFlags(..), + TreePath, + NativeTreePath(NativeTreePath), -- internal + TreeRowReference(..), + TreeIter(..), + +-- * Methods + treeModelGetFlags, treeModelGetNColumns, treeModelGetColumnType, treeModelGetValue, - TreeModelFlags(..), - treeModelGetFlags, - TreePath(..), - createTreePath, -- internal - tree_path_copy, -- internal - tree_path_free, -- internal - treePathNew, - treePathNewFromString, - treePathNewFromIndicies, - treePathToString, - treePathNewFirst, - treePathAppendIndex, - treePathPrependIndex, - treePathGetDepth, - treePathGetIndices, - treePathCopy, - treePathCompare, - treePathNext, - treePathPrev, - treePathUp, - treePathDown, - treePathIsAncestor, - treePathIsDescendant, - TreeRowReference(..), + nativeTreePathFree, -- internal + nativeTreePathNew, -- internal + withTreePath, -- internal + nativeTreePathGetIndices, -- internal + fromTreePath, -- internal treeRowReferenceNew, treeRowReferenceGetPath, treeRowReferenceValid, - TreeIter(..), createTreeIter, -- internal treeModelGetIter, treeModelGetIterFromString, @@ -76,9 +124,7 @@ treeModelIterHasChild, treeModelIterNChildren, treeModelIterNthChild, - treeModelIterParent, - treeModelRefNode, - treeModelUnrefNode + treeModelIterParent ) where import Monad (liftM, when) @@ -103,7 +149,9 @@ -- | TreePath : a list of indices to specify a subtree or node in the -- hierarchical 'TreeStore' database. -- -{#pointer * TreePath foreign newtype#} +type TreePath = [Int] + +{#pointer * TreePath as NativeTreePath newtype#} -- | Tree Row Reference : like a 'TreePath' it points to a subtree or node, but -- it is persistent. It identifies the same node (so long as it exists) even @@ -111,9 +159,13 @@ -- {#pointer * TreeRowReference foreign newtype#} --- | These flags indicate various properties of a 'TreeModel'. These are --- probably not terribly interesting for app developers. See the C documentation --- for details. +-- | These flags indicate various properties of a 'TreeModel'. +-- +-- * If a model has "TreeModelItersPersist" set, iterators remain valid +-- after a "TreeModel" signal was emitted. +-- +-- * The "TreeModelListOnly" flag is set if the rows are arranged in a +-- simple flat list. This is set in the "ListStore" implementation. -- {#enum TreeModelFlags {underscoreToCase} deriving(Bounded)#} @@ -121,11 +173,25 @@ -- methods --- | Read the number of columns this 'TreeModel' currently stores. +-- | Returns a set of flags supported by this interface. -- -treeModelGetNColumns :: TreeModelClass tm => tm -> IO Int -treeModelGetNColumns tm = liftM fromIntegral $ - {#call unsafe tree_model_get_n_columns#} (toTreeModel tm) +-- * The returned flags do not +-- change during the lifecycle of the tree_model. +-- +treeModelGetFlags :: TreeModelClass self => self -> IO [TreeModelFlags] +treeModelGetFlags self = + liftM (toFlags . fromIntegral) $ + {# call unsafe gtk_tree_model_get_flags #} + (toTreeModel self) + +-- | Returns the number of columns supported by the "TreeModel". +-- +treeModelGetNColumns :: TreeModelClass self => self + -> IO Int -- ^ returns The number of columns. +treeModelGetNColumns self = + liftM fromIntegral $ + {# call gtk_tree_model_get_n_columns #} + (toTreeModel self) -- | Retrieves the type of a specific column. -- @@ -170,170 +236,42 @@ foreign import ccall "wrapper" mkTreeModelForeachFunc :: (Ptr () -> Ptr () -> Ptr TreeIter -> Ptr () -> IO CInt) -> IO TreeModelForeachFunc --- | Returns a set of flags supported by this interface. The flags supported --- should not change during the lifecycle of the model. --- -treeModelGetFlags :: TreeModelClass tm => tm -> IO [TreeModelFlags] -treeModelGetFlags tm = liftM (toFlags.fromIntegral) $ - {#call unsafe tree_model_get_flags#} (toTreeModel tm) - -- utilities related to tree models --- Create a TreePath from a pointer. -createTreePath :: Ptr TreePath -> IO TreePath -createTreePath tpPtr = do - tpPtr' <- tree_path_copy tpPtr - liftM TreePath $ newForeignPtr tpPtr' (tree_path_free tpPtr') - -#if __GLASGOW_HASKELL__>=600 - -foreign import ccall unsafe ">k_tree_path_free" - tree_path_free' :: FinalizerPtr TreePath - -tree_path_free :: Ptr TreePath -> FinalizerPtr TreePath -tree_path_free _ = tree_path_free' - -#elif __GLASGOW_HASKELL__>=504 - -foreign import ccall unsafe "gtk_tree_path_free" - tree_path_free :: Ptr TreePath -> IO () - -#else - -foreign import ccall "gtk_tree_path_free" unsafe - tree_path_free :: Ptr TreePath -> IO () - -#endif - - - --- | Create a new 'TreePath'. --- --- * A 'TreePath' is an hierarchical index. It is independent of a specific --- 'TreeModel'. --- -treePathNew :: IO TreePath -treePathNew = do - tpPtr <- {#call unsafe tree_path_new#} - liftM TreePath $ newForeignPtr tpPtr (tree_path_free tpPtr) - --- | Turn a @String@ into a 'TreePath'. --- --- * For example, the string \"10:4:0\" would create a path of depth 3 pointing --- to the 11th child of the root node, the 5th child of that 11th child, and the --- 1st child of that 5th child. --- -treePathNewFromString :: String -> IO TreePath -treePathNewFromString path = do - tpPtr <- throwIfNull "treePathNewFromString: invalid path given" $ - withUTFString path {#call unsafe tree_path_new_from_string#} - liftM TreePath $ newForeignPtr tpPtr (tree_path_free tpPtr) - --- | Turn a list of indicies into a 'TreePath'. See 'treePathNewFromString' for --- the meaning of these indicies. --- -treePathNewFromIndicies :: [Int] -> IO TreePath -treePathNewFromIndicies = - treePathNewFromString . concat . intersperse ":" . map show - --- | Turn a 'TreePath' into a @String@. --- -treePathToString :: TreePath -> IO String -treePathToString tp = do - strPtr <- {#call tree_path_to_string#} tp - str <- peekUTFString strPtr - {#call unsafe g_free#} (castPtr strPtr) - return str - --- | Create a 'TreePath'. --- --- * The returned 'TreePath' is an index to the first element. --- -treePathNewFirst :: IO TreePath -treePathNewFirst = do - tpPtr <- {#call unsafe tree_path_new_first#} - liftM TreePath $ newForeignPtr tpPtr (tree_path_free tpPtr) - --- | Add an index on the next level. -treePathAppendIndex :: TreePath -> Int -> IO () -treePathAppendIndex tp ind = - {#call unsafe tree_path_append_index#} tp (fromIntegral ind) - +nativeTreePathFree :: NativeTreePath -> IO () +nativeTreePathFree = {#call unsafe tree_path_free#} -treePathPrependIndex :: TreePath -> Int -> IO () -treePathPrependIndex tp ind = - {#call unsafe tree_path_prepend_index#} tp (fromIntegral ind) +nativeTreePathNew :: IO NativeTreePath +nativeTreePathNew = liftM NativeTreePath {#call unsafe tree_path_new#} -treePathGetDepth :: TreePath -> IO Int -treePathGetDepth tp = liftM fromIntegral $ - {#call unsafe tree_path_get_depth#} tp +withTreePath :: TreePath -> (NativeTreePath -> IO a) -> IO a +withTreePath tp act = do + nativePath <- nativeTreePathNew + mapM_ ({#call unsafe tree_path_append_index#} nativePath . fromIntegral) tp + res <- act nativePath + nativeTreePathFree nativePath + return res -treePathGetIndices :: TreePath -> IO [Int] -treePathGetIndices tp = do - depth <- treePathGetDepth tp +nativeTreePathGetIndices :: NativeTreePath -> IO [Int] +nativeTreePathGetIndices tp = do + depth <- liftM fromIntegral $ {#call unsafe tree_path_get_depth#} tp arrayPtr <- {#call unsafe tree_path_get_indices#} tp if (depth==0 || arrayPtr==nullPtr) then return [] else sequence [liftM fromIntegral $ peekElemOff arrayPtr e | e <- [0..depth-1]] -treePathCopy :: TreePath -> IO TreePath -treePathCopy tp = do - tpPtr' <- {#call unsafe tree_path_copy#} tp - liftM TreePath $ newForeignPtr tpPtr' (tree_path_free tpPtr') - -#if __GLASGOW_HASKELL__>=504 - -foreign import ccall unsafe "gtk_tree_path_copy" - tree_path_copy :: Ptr TreePath -> IO (Ptr TreePath) - -#else - -foreign import ccall "gtk_tree_path_copy" unsafe - tree_path_copy :: Ptr TreePath -> IO (Ptr TreePath) - -#endif - - -treePathCompare :: TreePath -> TreePath -> IO Ordering -treePathCompare tp1 tp2 = do - res <- {#call unsafe tree_path_compare#} tp1 tp2 - return $ case res of - (-1) -> LT - 0 -> EQ - 1 -> GT - -treePathNext :: TreePath -> IO () -treePathNext = {#call unsafe tree_path_next#} - -treePathPrev :: TreePath -> IO Bool -treePathPrev tp = liftM toBool $ {#call unsafe tree_path_prev#} tp - -treePathUp :: TreePath -> IO Bool -treePathUp tp = liftM toBool $ {#call unsafe tree_path_up#} tp - -treePathDown :: TreePath -> IO () -treePathDown = {#call unsafe tree_path_down#} - --- | Returns True if the second path is a descendant of the first. --- -treePathIsAncestor :: TreePath -- ^ A 'TreePath' - -> TreePath -- ^ A possible descendant - -> IO Bool -treePathIsAncestor path descendant = liftM toBool $ - {#call unsafe tree_path_is_ancestor#} path descendant - --- | Returns True if the first path is a descendant of the second. --- -treePathIsDescendant :: TreePath -- ^ A possible descendant - -> TreePath -- ^ A 'TreePath' - -> IO Bool -treePathIsDescendant path ancestor = liftM toBool $ - {#call unsafe tree_path_is_descendant#} path ancestor +fromTreePath :: Ptr NativeTreePath -> IO TreePath +fromTreePath tpPtr | tpPtr==nullPtr = return [] + | otherwise = do + path <- nativeTreePathGetIndices (NativeTreePath tpPtr) + nativeTreePathFree (NativeTreePath tpPtr) + return path -- | Creates a row reference based on a path. This reference will keep pointing -- to the node pointed to by the given path, so long as it exists. -- -treeRowReferenceNew :: TreeModelClass tm => tm -> TreePath -> IO TreeRowReference +treeRowReferenceNew :: TreeModelClass tm => tm -> NativeTreePath -> + IO TreeRowReference treeRowReferenceNew tm path = do rowRefPtr <- throwIfNull "treeRowReferenceNew: invalid path given" $ {#call unsafe gtk_tree_row_reference_new#} (toTreeModel tm) path @@ -355,14 +293,17 @@ #endif --- | Returns a path that the row reference currently points to, or @Nothing@ if --- the path pointed to is no longer valid. +-- | Returns a path that the row reference currently points to. -- -treeRowReferenceGetPath :: TreeRowReference -> IO (Maybe TreePath) +-- * The returned path may be the empty list if the reference was invalid. +-- +treeRowReferenceGetPath :: TreeRowReference -> IO TreePath treeRowReferenceGetPath ref = do - pathPtr <- {#call unsafe tree_row_reference_get_path#} ref - if pathPtr == nullPtr then return Nothing else - liftM (Just . TreePath) $ newForeignPtr pathPtr (tree_path_free pathPtr) + tpPtr <- {#call unsafe tree_row_reference_get_path#} ref + if tpPtr==nullPtr then return [] else do + path <- nativeTreePathGetIndices (NativeTreePath tpPtr) + nativeTreePathFree (NativeTreePath tpPtr) + return path -- | Returns True if the reference refers to a current valid path. -- @@ -408,34 +349,35 @@ #endif - --- | Turn a 'TreePath' into a --- 'TreeIter'. +-- | Turn a @String@ into a 'TreeIter'. -- --- * Returns @Nothing@ if the @tp@ is invalid. +-- * Returns @Nothing@ if the string is not a colon separated list of numbers +-- that references a valid node. -- -treeModelGetIter :: TreeModelClass tm => tm -> TreePath -> IO (Maybe TreeIter) -treeModelGetIter tm tp = do +treeModelGetIterFromString :: TreeModelClass tm => tm -> String -> + IO (Maybe TreeIter) +treeModelGetIterFromString tm str = do iterPtr <- mallocBytes treeIterSize iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr) - res <- {#call unsafe tree_model_get_iter#} (toTreeModel tm) iter tp + res <- withUTFString str $ \strPtr -> + {#call unsafe tree_model_get_iter_from_string#} (toTreeModel tm) iter + strPtr return $ if (toBool res) then Just iter else Nothing - --- | Turn a @String@ into a --- 'TreeIter'. + +-- | Turn a 'TreePath' into a 'TreeIter'. -- --- * Returns @Nothing@ if the table is empty. +-- * Returns "Nothing" if the given "TreePath" was invalid. The empty list +-- is always invalid. The root node of a tree can be accessed by passing +-- @[0]@ as "TreePath". -- -treeModelGetIterFromString :: TreeModelClass tm => tm -> String -> - IO (Maybe TreeIter) -treeModelGetIterFromString tm str = do +treeModelGetIter :: TreeModelClass tm => tm -> TreePath -> IO (Maybe TreeIter) +treeModelGetIter _ [] = return Nothing +treeModelGetIter tm tp = withTreePath tp $ \nativePath -> do iterPtr <- mallocBytes treeIterSize iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr) - res <- withUTFString str $ \strPtr -> - {#call unsafe tree_model_get_iter_from_string#} (toTreeModel tm) iter - strPtr + res <- {#call unsafe tree_model_get_iter#} (toTreeModel tm) iter nativePath return $ if (toBool res) then Just iter else Nothing - + -- | Retrieves an 'TreeIter' to the -- first entry. -- @@ -448,11 +390,17 @@ res <- {#call unsafe tree_model_get_iter_first#} (toTreeModel tm) iter return $ if (toBool res) then Just iter else Nothing +-- | Turn an abstract "TreeIter" into a "TreePath". +-- +-- * In case the given "TreeIter" was invalid, an empty list is returned. +-- treeModelGetPath :: TreeModelClass tm => tm -> TreeIter -> IO TreePath treeModelGetPath tm iter = do - tpPtr <- throwIfNull "treeModelGetPath: illegal iterator" $ - {#call unsafe tree_model_get_path#} (toTreeModel tm) iter - liftM TreePath $ newForeignPtr tpPtr (tree_path_free tpPtr) + tpPtr <- {#call unsafe tree_model_get_path#} (toTreeModel tm) iter + if tpPtr==nullPtr then return [] else do + path <- nativeTreePathGetIndices (NativeTreePath tpPtr) + nativeTreePathFree (NativeTreePath tpPtr) + return path -- | Advance the iterator to the next element. -- @@ -513,15 +461,3 @@ res <- {#call unsafe tree_model_iter_parent#} (toTreeModel tm) iter child return $ if (toBool res) then Just iter else Nothing --- | No clue. --- -treeModelRefNode :: TreeModelClass tm => tm -> TreeIter -> IO () -treeModelRefNode tm iter = - {#call unsafe tree_model_ref_node#} (toTreeModel tm) iter - --- | No clue either. --- -treeModelUnrefNode :: TreeModelClass tm => tm -> TreeIter -> IO () -treeModelUnrefNode tm iter = - {#call unsafe tree_model_unref_node#} (toTreeModel tm) iter - --- TreeViewColumn.chs DELETED --- Index: TreeView.chs.pp =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/TreeList/TreeView.chs.pp,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- TreeView.chs.pp 12 Feb 2005 17:19:26 -0000 1.2 +++ TreeView.chs.pp 17 Feb 2005 00:13:20 -0000 1.3 @@ -24,8 +24,10 @@ -- Stability : provisional -- Portability : portable (depends on GHC) -- --- This widget constitutes the main widget for displaying lists and other --- structured data. +-- A widget for displaying both trees and lists. +-- +-- Widget that displays any object that implements the GtkTreeModel +-- interface. -- -- * The widget supports scrolling natively. This implies that pixel -- coordinates can be given in two formats: relative to the current view's @@ -61,12 +63,28 @@ -- * set_scroll_adjustment makes sense if the user monitors the scroll bars -- *and* the scroll bars can be replaced anytime (the latter is odd) -- +-- Class Hierarchy +-- | +-- @ +-- | "GObject" +-- | +----"Object" +-- | +----"Widget" +-- | +----"Container" +-- | +----GtkTreeView +-- @ + module Graphics.UI.Gtk.TreeList.TreeView ( +-- * Types TreeView, TreeViewClass, castToTreeView, + Point, + +-- * Constructors treeViewNew, treeViewNewWithModel, + +-- * Methods treeViewGetModel, treeViewSetModel, treeViewGetSelection, @@ -110,19 +128,22 @@ treeViewRowExpanded, treeViewGetReorderable, treeViewSetReorderable, - Point, treeViewGetPathAtPos, treeViewGetCellArea, treeViewGetBackgroundArea, treeViewGetVisibleRect, treeViewWidgetToTreeCoords, treeViewTreeToWidgetCoords, + treeViewCreateRowDragIcon, + treeViewGetEnableSearch, treeViewSetEnableSearch, treeViewGetSearchColumn, treeViewSetSearchColumn, treeViewSetSearchEqualFunc, + +-- * Signals onColumnsChanged, afterColumnsChanged, onCursorChanged, @@ -434,7 +455,6 @@ -- | Scroll to a coordinate. -- - -- * Scrolls the tree view such that the top-left corner of the -- visible area is @treeX@, @treeY@, where @treeX@ -- and @treeY@ are specified in tree window coordinates. @@ -457,10 +477,12 @@ -- treeViewScrollToCell :: TreeViewClass tv => tv -> TreePath -> TreeViewColumn -> Maybe (Float,Float) -> IO () -treeViewScrollToCell tv path tvc (Just (ver,hor)) = +treeViewScrollToCell tv path tvc (Just (ver,hor)) = + withTreePath path $ \path -> {#call tree_view_scroll_to_cell#} (toTreeView tv) path tvc 1 (realToFrac ver) (realToFrac hor) treeViewScrollToCell tv path tvc Nothing = + withTreePath path $ \path -> {#call tree_view_scroll_to_cell#} (toTreeView tv) path tvc 0 0.0 0.0 @@ -468,7 +490,7 @@ -- | Selects a specific row. -- -- * Sets the current keyboard focus to be at @path@, and --- selects it. This is useful when you want to focus the user's +-- selects it. This is useful when you want to focus the user\'s -- attention on a particular row. If @focusColumn@ is given, -- then the input focus is given to the column specified by -- it. Additionally, if @focusColumn@ is specified, and @@ -481,10 +503,11 @@ treeViewSetCursor :: TreeViewClass tv => tv -> TreePath -> (Maybe (TreeViewColumn, Bool)) -> IO () -treeViewSetCursor tv tp Nothing = +treeViewSetCursor tv tp Nothing = withTreePath tp $ \tp -> {#call tree_view_set_cursor#} (toTreeView tv) tp (mkTreeViewColumn nullForeignPtr) (fromBool False) treeViewSetCursor tv tp (Just (focusColumn, startEditing)) = + withTreePath tp $ \tp -> {#call tree_view_set_cursor#} (toTreeView tv) tp focusColumn (fromBool startEditing) @@ -501,6 +524,7 @@ CellRenderer -> Bool -> IO () treeViewSetCursorOnCell tv tp focusColumn focusCell startEditing = + withTreePath tp $ \tp -> {#call tree_view_set_cursor_on_cell#} (toTreeView tv) tp focusColumn focusCell (fromBool startEditing) #endif @@ -508,18 +532,17 @@ -- | Retrieves the position of the focus. -- -- * Returns a pair @(path, column)@.If the cursor is not currently --- set, @path@ will be @Nothing@. If no column is currently +-- set, @path@ will be @[]@. If no column is currently -- selected, @column@ will be @Nothing@. -- treeViewGetCursor :: TreeViewClass tv => tv -> - IO (Maybe TreePath, Maybe TreeViewColumn) + IO (TreePath, Maybe TreeViewColumn) treeViewGetCursor tv = alloca $ \tpPtrPtr -> alloca $ \tvcPtrPtr -> do {#call unsafe tree_view_get_cursor#} (toTreeView tv) (castPtr tpPtrPtr) (castPtr tvcPtrPtr) tpPtr <- peek tpPtrPtr tvcPtr <- peek tvcPtrPtr - tp <- if tpPtr==nullPtr then return Nothing else liftM (Just . TreePath) $ - newForeignPtr tpPtr (tree_path_free tpPtr) + tp <- fromTreePath tpPtr tvc <- if tvcPtr==nullPtr then return Nothing else liftM Just $ makeNewObject mkTreeViewColumn (return tvcPtr) return (tp,tvc) @@ -528,7 +551,7 @@ -- treeViewRowActivated :: TreeViewClass tv => tv -> TreePath -> TreeViewColumn -> IO () -treeViewRowActivated tv tp tvc = +treeViewRowActivated tv tp tvc = withTreePath tp $ \tp -> {#call tree_view_row_activated#} (toTreeView tv) tp tvc -- | Expand all nodes in the 'TreeView'. @@ -550,7 +573,7 @@ -- * Only available in Gtk 2.2 and higher. -- treeViewExpandToPath :: TreeViewClass tv => tv -> TreePath -> IO () -treeViewExpandToPath tv tp = +treeViewExpandToPath tv tp = withTreePath tp $ \tp -> {#call tree_view_expand_to_path#} (toTreeView tv) tp #endif @@ -562,37 +585,35 @@ -- existed and had children. -- treeViewExpandRow :: TreeViewClass tv => TreePath -> Bool -> tv -> IO Bool -treeViewExpandRow path all tv = liftM toBool $ - {#call tree_view_expand_row#} (toTreeView tv) path (fromBool all) +treeViewExpandRow tp all tv = withTreePath tp $ \tp -> liftM toBool $ + {#call tree_view_expand_row#} (toTreeView tv) tp (fromBool all) -- | Collapse a row. Returns @True@ if the -- row existed. -- treeViewCollapseRow :: TreeViewClass tv => tv -> TreePath -> IO Bool -treeViewCollapseRow tv path = liftM toBool $ - {#call tree_view_collapse_row#} (toTreeView tv) path +treeViewCollapseRow tv tp = withTreePath tp $ \tp -> liftM toBool $ + {#call tree_view_collapse_row#} (toTreeView tv) tp -- | Call function for every expaned row. -- treeViewMapExpandedRows :: TreeViewClass tv => tv -> (TreePath -> IO ()) -> IO () treeViewMapExpandedRows tv func = do - fPtr <- mkTreeViewMappingFunc $ \_ tpPtr _ -> do - tp <- liftM TreePath $ newForeignPtr tpPtr (tree_path_free tpPtr) - func tp + fPtr <- mkTreeViewMappingFunc $ \_ tpPtr _ -> fromTreePath tpPtr >>= func {#call tree_view_map_expanded_rows#} (toTreeView tv) fPtr nullPtr freeHaskellFunPtr fPtr {#pointer TreeViewMappingFunc#} foreign import ccall "wrapper" mkTreeViewMappingFunc :: - (Ptr TreeView -> Ptr TreePath -> Ptr () -> IO ()) -> + (Ptr () -> Ptr NativeTreePath -> Ptr () -> IO ()) -> IO TreeViewMappingFunc -- | Check if row is expanded. -- treeViewRowExpanded :: TreeViewClass tv => tv -> TreePath -> IO Bool -treeViewRowExpanded tv tp = liftM toBool $ +treeViewRowExpanded tv tp = withTreePath tp $ \tp -> liftM toBool $ {#call unsafe tree_view_row_expanded#} (toTreeView tv) tp -- | Query if rows can be moved around. @@ -644,7 +665,7 @@ xCell <- peek xPtr yCell <- peek yPtr if not res then return Nothing else do - tp <- liftM TreePath $ newForeignPtr tpPtr (tree_path_free tpPtr) + tp <- fromTreePath tpPtr tvc <- makeNewObject mkTreeViewColumn (return tvcPtr) return (Just (tp,tvc,(fromIntegral xCell, fromIntegral yCell))) @@ -663,14 +684,14 @@ TreeViewColumn -> IO Rectangle treeViewGetCellArea tv Nothing tvc = alloca $ \rPtr -> {#call unsafe tree_view_get_cell_area#} (toTreeView tv) - (TreePath nullForeignPtr) tvc (castPtr (rPtr :: Ptr Rectangle)) + (NativeTreePath nullPtr) tvc (castPtr (rPtr :: Ptr Rectangle)) >> peek rPtr -treeViewGetCellArea tv (Just tp) tvc = alloca $ \rPtr -> do +treeViewGetCellArea tv (Just tp) tvc = + withTreePath tp $ \tp -> alloca $ \rPtr -> do {#call unsafe tree_view_get_cell_area#} (toTreeView tv) tp tvc (castPtr (rPtr :: Ptr Rectangle)) >> peek rPtr --- | Retrieve the largest bounding box --- of a cell. +-- | Retrieve the largest bounding box of a cell. -- -- * Fills the bounding rectangle in tree window coordinates for the -- cell at the row specified by @tp@ and the column specified by @@ -686,9 +707,10 @@ TreeViewColumn -> IO Rectangle treeViewGetBackgroundArea tv Nothing tvc = alloca $ \rPtr -> {#call unsafe tree_view_get_background_area#} (toTreeView tv) - (TreePath nullForeignPtr) tvc (castPtr (rPtr :: Ptr Rectangle)) + (NativeTreePath nullPtr) tvc (castPtr (rPtr :: Ptr Rectangle)) >> peek rPtr -treeViewGetBackgroundArea tv (Just tp) tvc = alloca $ \rPtr -> do +treeViewGetBackgroundArea tv (Just tp) tvc = + withTreePath tp $ \tp -> alloca $ \rPtr -> do {#call unsafe tree_view_get_background_area#} (toTreeView tv) tp tvc (castPtr (rPtr :: Ptr Rectangle)) >> peek rPtr @@ -731,9 +753,9 @@ -- can be used for a drag icon. -- treeViewCreateRowDragIcon :: TreeViewClass tv => tv -> TreePath -> IO Pixmap -treeViewCreateRowDragIcon tv path = +treeViewCreateRowDragIcon tv tp = withTreePath tp $ \tp -> makeNewGObject mkPixmap $ - {#call unsafe tree_view_create_row_drag_icon#} (toTreeView tv) path + {#call unsafe tree_view_create_row_drag_icon#} (toTreeView tv) tp -- | Set if user can search entries. -- @@ -798,6 +820,11 @@ (Ptr TreeModel -> {#type gint#} -> CString -> Ptr TreeIter -> Ptr () -> IO {#type gboolean#}) -> IO TreeViewSearchEqualFunc + +-- helper to marshal native tree paths to TreePaths +readNTP :: Ptr TreePath -> IO TreePath +readNTP ptr = nativeTreePathGetIndices (NativeTreePath (castPtr ptr)) + -- | The user has dragged a column to another -- position. -- @@ -821,9 +848,9 @@ (TreePath -> TreeViewColumn -> IO ()) -> IO (ConnectId tv) onRowActivated = connect_BOXED_OBJECT__NONE "row_activated" - createTreePath False + readNTP False afterRowActivated = connect_BOXED_OBJECT__NONE "row_activated" - createTreePath True + readNTP True -- | Children of this node were hidden. -- @@ -831,9 +858,9 @@ (TreeIter -> TreePath -> IO ()) -> IO (ConnectId tv) onRowCollapsed = connect_BOXED_BOXED__NONE "row_collapsed" - createTreeIter createTreePath False + createTreeIter readNTP False afterRowCollapsed = connect_BOXED_BOXED__NONE "row_collapsed" - createTreeIter createTreePath True + createTreeIter readNTP True -- | Children of this node are made visible. -- @@ -841,9 +868,9 @@ (TreeIter -> TreePath -> IO ()) -> IO (ConnectId tv) onRowExpanded = connect_BOXED_BOXED__NONE "row_expanded" - createTreeIter createTreePath False + createTreeIter readNTP False afterRowExpanded = connect_BOXED_BOXED__NONE "row_expanded" - createTreeIter createTreePath True + createTreeIter readNTP True -- | The user wants to search -- interactively. @@ -879,9 +906,9 @@ (TreeIter -> TreePath -> IO Bool) -> IO (ConnectId tv) onTestCollapseRow = connect_BOXED_BOXED__BOOL "test_collapse_row" - createTreeIter createTreePath False + createTreeIter readNTP False afterTestCollapseRow = connect_BOXED_BOXED__BOOL "test_collapse_row" - createTreeIter createTreePath True + createTreeIter readNTP True -- | Determine if this row should be expanded. -- @@ -892,7 +919,7 @@ (TreeIter -> TreePath -> IO Bool) -> IO (ConnectId tv) onTestExpandRow = connect_BOXED_BOXED__BOOL "test_expand_row" - createTreeIter createTreePath False + createTreeIter readNTP False afterTestExpandRow = connect_BOXED_BOXED__BOOL "test_expand_row" - createTreeIter createTreePath True + createTreeIter readNTP True --- NEW FILE: TreeModelSort.chs.pp --- -- -*-haskell-*- -- GIMP Toolkit (GTK) TreeModelSort -- -- Author : Duncan Coutts -- Created: 4 August 2004 -- -- Copyr... [truncated message content] |
