From: Duncan C. <dun...@us...> - 2004-08-04 18:42:11
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/treeList In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15544/gtk/treeList Modified Files: TreeSelection.chs TreeModelSort.chs TreeViewColumn.chs TreeModel.chs api.ignore Log Message: Add missing functions and list more ignored functions. Index: TreeModelSort.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/treeList/TreeModelSort.chs,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- TreeModelSort.chs 23 May 2004 16:16:43 -0000 1.3 +++ TreeModelSort.chs 4 Aug 2004 18:42:00 -0000 1.4 @@ -1,41 +1,128 @@ -- -*-haskell-*- --- GIMP Toolkit (GTK) TreeModelSort --- --- Author : Axel Simon --- --- Created: 9 July 2002 +-- GIMP Toolkit (GTK) TreeModelSort -- --- Version $Revision$ from $Date$ +-- Author : Duncan Coutts +-- Created: 4 August 2004 -- --- Copyright (c) 1999..2002 Axel Simon +-- Copyright (c) 2004 Duncan Coutts -- --- This file is free software; you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation; either version 2 of the License, or --- (at your option) any later version. +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Library General Public +-- License as published by the Free Software Foundation; either +-- version 2 of the License, or (at your option) any later version. -- --- This file is distributed in the hope that it will be useful, +-- 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 General Public License for more details. +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Library General Public License for more details. -- -- | +-- +-- The 'TreeModelSort' is a model that turns any object that implements the +-- 'TreeModel' interface into a store that is sorted. -- --- 'TreeModelSort' is an aggregated class to 'TreeModel'. --- It turns any object derived from 'TreeModel' into a store that --- is sorted. +-- It does not hold any data itself, but rather is created with a child model +-- and proxies its data. It has identical column types to this child model, and +-- the changes in the child are propagated. The primary purpose of this model is +-- to provide a way to sort a different model without modifying it. -- -module TreeModelSort( - TreeModelSort, - TreeModelSortClass +module TreeModelSort ( + TreeModelSort, + TreeModelSortClass, + treeModelSortNewWithModel, + treeModelSortGetModel, + treeModelSortConvertChildPathToPath, + treeModelSortConvertPathToChildPath, + treeModelSortConvertChildIterToIter, + treeModelSortConvertIterToChildIter, + treeModelSortResetDefaultSortFunc ) where import Monad (liftM, when) import FFI +import GObject (makeNewGObject) {#import Hierarchy#} -import Signal +{#import TreeModel#} +import Structs (treeIterSize) {# context lib="gtk" prefix="gtk" #} + +-- | Creates a new 'TreeModelSort', that will be a sorted view of the given +-- model. +-- +treeModelSortNewWithModel :: TreeModelClass tm => tm -> IO TreeModelSort +treeModelSortNewWithModel model = + makeNewGObject mkTreeModelSort $ liftM castPtr $ + {#call unsafe tree_model_sort_new_with_model#} (toTreeModel model) + +-- | Returns the underlying model the 'TreeModelSort' is sorting. +-- +treeModelSortGetModel :: TreeModelSortClass obj => obj -> IO TreeModel +treeModelSortGetModel obj = + makeNewGObject mkTreeModel $ + {#call tree_model_sort_get_model#} (toTreeModelSort obj) + +-- | Converts the given path to a path relative to the given sorted model. That +-- is, the given path points to a row in the child model. The returned path will +-- point to the same row in the sorted model. +-- +treeModelSortConvertChildPathToPath :: TreeModelSortClass obj => obj + -> TreePath -> IO TreePath +treeModelSortConvertChildPathToPath obj childPath = do + pathPtr <- + throwIfNull "treeModelSortConvertChildPathToPath: invalid path given" $ + {#call unsafe tree_model_sort_convert_child_path_to_path#} + (toTreeModelSort obj) childPath + liftM TreePath $ newForeignPtr pathPtr (tree_path_free pathPtr) + +-- | Converts path in the sorted model to a path on the unsorted model on which +-- the given 'TreeModelSort' is based. That is, the given path points to a +-- location in the given 'TreeModelSort'. The returned path will point to the +-- same location in the underlying unsorted model. +-- +treeModelSortConvertPathToChildPath :: TreeModelSortClass obj => obj + -> TreePath -> IO TreePath +treeModelSortConvertPathToChildPath obj sortedPath = do + pathPtr <- + throwIfNull "treeModelSortConvertPathToChildPath: invalid path given" $ + {#call unsafe tree_model_sort_convert_path_to_child_path#} + (toTreeModelSort obj) sortedPath + liftM TreePath $ newForeignPtr pathPtr (tree_path_free pathPtr) + +-- | Return an iterator in the sorted model that points to the row pointed to +-- by the given iter from the unsorted model. +-- +treeModelSortConvertChildIterToIter :: TreeModelSortClass obj => obj + -> TreeIter -> IO TreeIter +treeModelSortConvertChildIterToIter obj childIter = do + sortIterPtr <- mallocBytes treeIterSize + sortIter <- liftM TreeIter $ newForeignPtr sortIterPtr + (foreignFree sortIterPtr) + {#call tree_model_sort_convert_child_iter_to_iter#} (toTreeModelSort obj) + sortIter childIter + return sortIter + +-- | Return an iterator in the unsorted model that points to the row pointed to +-- by the given iter from the sorted model. +-- +treeModelSortConvertIterToChildIter :: TreeModelSortClass obj => obj + -> TreeIter -> IO TreeIter +treeModelSortConvertIterToChildIter obj sortedIter = do + childIterPtr <- mallocBytes treeIterSize + childIter <- liftM TreeIter $ newForeignPtr childIterPtr + (foreignFree childIterPtr) + {#call unsafe tree_model_sort_convert_iter_to_child_iter#} + (toTreeModelSort obj) childIter sortedIter + return childIter + +-- | This resets the default sort function to be in the \'unsorted\' state. That +-- is, it is in the same order as the child model. It will re-sort the model to +-- be in the same order as the child model only if the 'TreeModelSort' is in +-- \'unsorted\' state. +-- +treeModelSortResetDefaultSortFunc :: TreeModelSortClass obj => obj -> IO () +treeModelSortResetDefaultSortFunc obj = + {#call tree_model_sort_reset_default_sort_func#} (toTreeModelSort obj) Index: TreeModel.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/treeList/TreeModel.chs,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- TreeModel.chs 23 May 2004 16:16:43 -0000 1.12 +++ TreeModel.chs 4 Aug 2004 18:42:00 -0000 1.13 @@ -35,12 +35,15 @@ treeModelGetNColumns, treeModelGetColumnType, treeModelGetValue, + TreeModelFlags(..), + treeModelGetFlags, TreePath(..), createTreePath, -- internal tree_path_copy, -- internal tree_path_free, -- internal treePathNew, treePathNewFromString, + treePathNewFromIndicies, treePathToString, treePathNewFirst, treePathAppendIndex, @@ -53,6 +56,12 @@ treePathPrev, treePathUp, treePathDown, + treePathIsAncestor, + treePathIsDescendant, + TreeRowReference(..), + treeRowReferenceNew, + treeRowReferenceGetPath, + treeRowReferenceValid, TreeIter(..), createTreeIter, -- internal treeModelGetIter, @@ -72,29 +81,43 @@ import Monad (liftM, when) import Maybe (fromMaybe) +import List (intersperse) import FFI {#import Hierarchy#} {#import Signal#} import Structs (treeIterSize) +import GdkEnums (Flags(..)) import StoreValue (TMType) {#import GValue#} (GValue, GenericValue, valueUnset) {# context lib="gtk" prefix="gtk" #} --- | Tree Iterator : A pointer to an entry in a --- 'TreeStore' or 'ListStore'. +-- | Tree Iterator : A pointer to an entry in a 'TreeStore' or 'ListStore'. -- {#pointer * TreeIter foreign newtype#} --- | TreePath : a list of indices to specify a subtree or node --- in the hierarchical 'TreeStore' database. +-- | TreePath : a list of indices to specify a subtree or node in the +-- hierarchical 'TreeStore' database. -- {#pointer * TreePath foreign 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 +-- when items are added, removed, or reordered. +-- +{#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. +-- +{#enum TreeModelFlags {underscoreToCase} deriving(Bounded)#} + +instance Flags TreeModelFlags + -- methods --- | Read the number of columns this --- 'TreeModel' currently stores. +-- | Read the number of columns this 'TreeModel' currently stores. -- treeModelGetNColumns :: TreeModelClass tm => tm -> IO Int treeModelGetNColumns tm = liftM fromIntegral $ @@ -107,8 +130,7 @@ {#call unsafe tree_model_get_column_type#} (toTreeModel tm) (fromIntegral col) --- | Read the value of at a specific column and --- 'Iterator'. +-- | Read the value of at a specific column and 'Iterator'. -- treeModelGetValue :: TreeModelClass tm => tm -> TreeIter -> Int -> IO GenericValue @@ -121,6 +143,45 @@ valueUnset vaPtr return val +-- | Maps a function over each node in model in a depth-first fashion. If the +-- function returns True, the tree walk stops. +-- +treeModelForeach :: TreeModelClass tm => tm -> (TreeIter -> IO Bool) -> IO () +treeModelForeach tm fun = do + fPtr <- mkTreeModelForeachFunc (\_ _ 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 this does not matter. + iterPtr <- mallocBytes treeIterSize + copyBytes iterPtr ti treeIterSize + iter <- liftM TreeIter $ newForeignPtr iterPtr (foreignFree iterPtr) + liftM (fromIntegral.fromBool) $ fun iter + ) + {#call tree_model_foreach#} (toTreeModel tm) fPtr nullPtr + freeHaskellFunPtr fPtr + +{#pointer TreeModelForeachFunc#} + +#if __GLASGOW_HASKELL__>=600 + +foreign import ccall "wrapper" mkTreeModelForeachFunc :: + (Ptr () -> Ptr () -> Ptr TreeIter -> Ptr () -> IO CInt) -> IO TreeModelForeachFunc + +#else + +foreign export dynamic mkTreeModelForeachFunc :: + (Ptr () -> Ptr () -> Ptr TreePath -> Ptr () -> IO CInt)-> IO TreeModelForeachFunc + +#endif + +-- | 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. @@ -153,16 +214,19 @@ -- | Create a new 'TreePath'. -- --- * A 'TreePath' is an hierarchical index. It is independent of --- a specific 'TreeModel'. +-- * 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'. +-- | 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 @@ -170,8 +234,14 @@ withUTFString path {#call unsafe tree_path_new_from_string#} liftM TreePath $ newForeignPtr tpPtr (tree_path_free tpPtr) --- | Turn a 'TreePath' into a --- @String@. +-- | 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 @@ -249,6 +319,48 @@ 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 + +-- | 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 tm path = do + rowRefPtr <- throwIfNull "treeRowReferenceNew: invalid path given" $ + {#call unsafe gtk_tree_row_reference_new#} (toTreeModel tm) path + liftM TreeRowReference $ newForeignPtr rowRefPtr tree_row_reference_free + +foreign import ccall unsafe "&tree_row_reference_free" + tree_row_reference_free :: FinalizerPtr TreeRowReference + +-- | Returns a path that the row reference currently points to, or @Nothing@ if +-- the path pointed to is no longer valid. +-- +treeRowReferenceGetPath :: TreeRowReference -> IO (Maybe 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) + +-- | Returns True if the reference refers to a current valid path. +-- +treeRowReferenceValid :: TreeRowReference -> IO Bool +treeRowReferenceValid ref = liftM toBool $ + {#call unsafe tree_row_reference_valid#} ref createTreeIter :: Ptr TreeIter -> IO TreeIter createTreeIter tiPtr = do Index: TreeViewColumn.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/treeList/TreeViewColumn.chs,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- TreeViewColumn.chs 23 May 2004 16:16:43 -0000 1.8 +++ TreeViewColumn.chs 4 Aug 2004 18:42:00 -0000 1.9 @@ -61,6 +61,7 @@ treeViewColumnGetSizing, treeViewColumnGetWidth, treeViewColumnSetFixedWidth, + treeViewColumnGetFixedWidth, treeViewColumnSetMinWidth, treeViewColumnGetMinWidth, treeViewColumnSetMaxWidth, @@ -69,6 +70,7 @@ treeViewColumnSetTitle, treeViewColumnGetTitle, treeViewColumnSetClickable, + treeViewColumnGetClickable, treeViewColumnSetWidget, treeViewColumnGetWidget, treeViewColumnSetAlignment, @@ -285,15 +287,26 @@ -- | Set the width of the column. -- --- * This is meaningful only if the sizing type is --- 'TreeViewColumnFixed'. +-- * This is meaningful only if the sizing type is 'TreeViewColumnFixed'. -- -treeViewColumnSetFixedWidth :: TreeViewColumnClass tvc => Int -> tvc -> IO () -treeViewColumnSetFixedWidth width tvc = +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 () @@ -341,13 +354,18 @@ 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. +-- | 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 -> Index: api.ignore =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/treeList/api.ignore,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- api.ignore 1 Aug 2004 16:08:14 -0000 1.2 +++ api.ignore 4 Aug 2004 18:42:00 -0000 1.3 @@ -22,9 +22,55 @@ #vararg constructor func, we use newv instead always exclude gtk_list_store_new$ +always exclude gtk_tree_store_new$ #vararg set function -always exclude gtk_list_store_set +always exclude gtk_list_store_set$ +always exclude gtk_tree_store_set$ + +#more vararg stuff +always exclude gtk_tree_path_new_from_indices + +#only for subclasses +always exclude gtk_list_store_set_column_types +always exclude gtk_tree_store_set_column_types #debugging function always exclude gtk_list_store_iter_is_valid + +#internal reference stuff +always exclude gtk_tree_row_reference_deleted +always exclude gtk_tree_row_reference_inserted +always exclude gtk_tree_row_reference_new_proxy +always exclude gtk_tree_row_reference_reordered +always exclude gtk_tree_row_reference_copy + +#not useful for us +always exclude gtk_tree_selection_get_user_data + +#TreeModel vararg stuff +always exclude gtk_tree_model_get$ + +#only for TreeModel implementations +always exclude gtk_tree_model_row_deleted +always exclude gtk_tree_model_rows_reordered +always exclude gtk_tree_model_row_has_child_toggled +always exclude gtk_tree_model_row_inserted +always exclude gtk_tree_model_row_changed + +#very low level control +always exclude gtk_tree_model_sort_clear_cache + +#for debugging only +always exclude gtk_tree_model_sort_iter_is_valid + +#TreeViewColumn stuff +#vararg attributes stuff +always exclude gtk_tree_view_column_new_with_attributes +always exclude gtk_tree_view_column_set_attributes + +#internal, only used by TreeView +always exclude gtk_tree_view_column_cell_get_size +always exclude gtk_tree_view_column_cell_set_cell_data +always exclude gtk_tree_view_column_cell_is_visible + Index: TreeSelection.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/treeList/TreeSelection.chs,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- TreeSelection.chs 23 May 2004 16:16:43 -0000 1.9 +++ TreeSelection.chs 4 Aug 2004 18:42:00 -0000 1.10 @@ -38,6 +38,7 @@ castToTreeSelection, SelectionMode(..), treeSelectionSetMode, + treeSelectionGetMode, TreeSelectionCB, treeSelectionSetSelectFunction, treeSelectionGetTreeView, @@ -46,8 +47,10 @@ treeSelectionSelectedForeach, treeSelectionSelectPath, treeSelectionUnselectPath, + treeSelectionPathIsSelected, treeSelectionSelectIter, treeSelectionUnselectIter, + treeSelectionIterIsSelected, treeSelectionSelectAll, treeSelectionUnselectAll, treeSelectionSelectRange, @@ -77,6 +80,12 @@ 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. -- @@ -154,8 +163,7 @@ {#call tree_selection_selected_foreach#} (toTreeSelection ts) fPtr nullPtr freeHaskellFunPtr fPtr --- | Callback function type for --- 'treeSelectionSelectedForeach'. +-- | Callback function type for 'treeSelectionSelectedForeach'. -- type TreeSelectionForeachCB = TreeIter -> IO () {#pointer TreeSelectionForeachFunc#} @@ -184,6 +192,12 @@ treeSelectionUnselectPath ts tp = {#call tree_selection_unselect_path#} (toTreeSelection ts) tp +-- | Returns True if the row at the given path is currently selected. +-- +treeSelectionPathIsSelected :: (TreeSelectionClass ts) => ts -> TreePath -> IO Bool +treeSelectionPathIsSelected ts tp = liftM toBool $ + {#call unsafe tree_selection_path_is_selected#} (toTreeSelection ts) tp + -- | Select a specific item by TreeIter. -- treeSelectionSelectIter :: (TreeSelectionClass ts) => ts -> TreeIter -> IO () @@ -196,6 +210,11 @@ 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. -- |