Menu
▾
▴
[Gtk2hs-commit] More fixes for the treelist widgets.
|
From: Axel S. <A....@ke...> - 2006-03-26 12:55:53
|
Sun Mar 19 10:41:39 PST 2006 Axel Simon <A....@ke...>
* More fixes for the treelist widgets.
This patch incorporates some of the fixes necessary to make the new
custom store available to the widgets that use the treelist stores.
It is far from complete. For a typed set of widgets some of these changes
need to be changed (and partly reverted perhaps).
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 43
--- the text column of the model (see 'entryCompletionSetTextColumn'), but this
+-- the text in a model (see 'entryCompletionSetTextModel'), but this
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 82
- entryCompletionGetModel,
+ entryCompletionSetTextModel,
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 90
- entryCompletionSetTextColumn,
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 92
- entryCompletionGetTextColumn,
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 108
- entryCompletionTextColumn,
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 138
+{#import Graphics.UI.Gtk.TreeList.CustomStore#}
+import Graphics.UI.Gtk.TreeList.CellRendererText
+import Graphics.UI.Gtk.TreeList.CellLayout
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 172
-entryCompletionSetModel :: TreeModelClass model => EntryCompletion
- -> Maybe model -- ^ @model@ - The 'TreeModel'.
+entryCompletionSetModel :: StoreClass model => EntryCompletion
+ -> Maybe (model row) -- ^ @model@ - The 'TreeModel'.
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 178
- (maybe (TreeModel nullForeignPtr) toTreeModel model)
+ (maybe (TreeModel nullForeignPtr) storeGetModel model)
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 180
--- | Returns the model the 'EntryCompletion' is using as data source. Returns
--- @Nothing@ if the model is unset.
+-- | Convenience function for setting up the most used case of this code: a
+-- completion list with just strings. This function will set up @completion@ to
+-- have a list displaying all (and just) strings in the completion list, and to
+-- get those strings from @model@. This functions creates and adds a [_$_]
+-- 'CellRendererText' which retrieves its content from the given model.
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 186
-entryCompletionGetModel :: EntryCompletion
- -> IO (Maybe TreeModel) -- ^ returns A 'TreeModel', or @Nothing@ if none is
- -- currently being used.
-entryCompletionGetModel self =
- maybeNull (makeNewGObject mkTreeModel) $
- {# call gtk_entry_completion_get_model #}
- self
+entryCompletionSetTextModel :: StoreClass model =>
+ EntryCompletion -- ^ @completion@
+ -> model String -- ^ the model containing 'String's
+ -> IO ()
+entryCompletionSetTextModel self model = do
+ entryCompletionSetModel self (Just model)
+ cell <- cellRendererTextNew
+ cellLayoutPackStart self cell True
+ cellLayoutSetAttributes self cell model (\str -> [cellText := Just str])
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 296
--- | Convenience function for setting up the most used case of this code: a
--- completion list with just strings. This function will set up @completion@ to
--- have a list displaying all (and just) strings in the completion list, and to
--- get those strings from @column@ in the model of @completion@.
---
--- This functions creates and adds a 'CellRendererText' for the selected
--- column.
---
-entryCompletionSetTextColumn :: EntryCompletion
- -> Int -- ^ @column@ - The column in the model of @completion@ to
- -- get strings from.
- -> IO ()
-entryCompletionSetTextColumn self column =
- {# call gtk_entry_completion_set_text_column #}
- self
- (fromIntegral column)
-
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 306
--- | Returns the column in the model of the completion to get strings from.
---
--- * Available since Gtk+ version 2.6
---
-entryCompletionGetTextColumn :: EntryCompletion
- -> IO Int -- ^ returns the column containing the strings
-entryCompletionGetTextColumn self =
- liftM fromIntegral $
- {# call gtk_entry_completion_get_text_column #}
- self
-
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 417
-entryCompletionModel :: TreeModelClass model => ReadWriteAttr EntryCompletion (Maybe TreeModel) (Maybe model)
-entryCompletionModel = newAttr
- entryCompletionGetModel
+entryCompletionModel :: StoreClass model => WriteAttr EntryCompletion (Maybe (model row))
+entryCompletionModel = writeAttr
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 433
--- | The column of the model containing the strings.
---
--- Allowed values: >= -1
---
--- Default value: -1
---
-entryCompletionTextColumn :: Attr EntryCompletion Int
-entryCompletionTextColumn = newAttr
- entryCompletionGetTextColumn
- entryCompletionSetTextColumn
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs.pp 87
- comboBoxGetModel,
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs.pp 133
+{#import Graphics.UI.Gtk.TreeList.CustomStore#}
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs.pp 163
-comboBoxNewWithModel :: TreeModelClass model => [_$_]
- model -- ^ @model@ - A 'TreeModel'.
+comboBoxNewWithModel :: StoreClass model => [_$_]
+ model row -- ^ @model@ - A 'TreeModel'.
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs.pp 170
- (toTreeModel model)
+ (storeGetModel model)
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs.pp 254
--- | Returns the 'TreeModel' which is acting as data source for the combo box.
---
-comboBoxGetModel :: ComboBoxClass self => self
- -> IO (Maybe TreeModel) -- ^ returns the 'TreeModel' which was passed during
- -- construction.
-comboBoxGetModel self =
- maybeNull (makeNewGObject mkTreeModel) $
- {# call gtk_combo_box_get_model #}
- (toComboBox self)
-
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs.pp 262
-comboBoxSetModel :: (ComboBoxClass self, TreeModelClass model) => self -> Maybe model -> IO ()
+comboBoxSetModel :: (ComboBoxClass self, StoreClass model) => self ->
+ Maybe (model row) -> IO ()
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs.pp 267
- (maybe (TreeModel nullForeignPtr) toTreeModel model)
+ (maybe (TreeModel nullForeignPtr) storeGetModel model)
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs.pp 438
-comboBoxModel :: (ComboBoxClass self, TreeModelClass model) => ReadWriteAttr self (Maybe TreeModel) (Maybe model)
-comboBoxModel = newAttr
- comboBoxGetModel
+comboBoxModel :: (ComboBoxClass self, StoreClass model) =>
+ WriteAttr self (Maybe (model row))
+comboBoxModel = writeAttr
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs.pp 71
+ comboBoxEntrySetTextModel
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs.pp 73
--- * Methods
- comboBoxEntrySetTextColumn,
- comboBoxEntryGetTextColumn,
-
--- * Attributes
- comboBoxEntryTextColumn,
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs.pp 83
+import Graphics.UI.Gtk.TreeList.CustomStore
+import Graphics.UI.Gtk.MenuComboToolbar.ComboBox
+import Graphics.UI.Gtk.TreeList.CellRendererText
+import Graphics.UI.Gtk.TreeList.CellLayout
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs.pp 109
-comboBoxEntryNewWithModel :: TreeModelClass model => [_$_]
- model -- ^ @model@ - A 'TreeModel'.
- -> Int -- ^ @textColumn@ - A column in @model@ to get the
- -- strings from.
+comboBoxEntryNewWithModel :: StoreClass model => [_$_]
+ model String -- ^ @model@ - A 'CustomStore'.
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs.pp 112
-comboBoxEntryNewWithModel model textColumn =
- makeNewObject mkComboBoxEntry $
- liftM (castPtr :: Ptr Widget -> Ptr ComboBoxEntry) $
- {# call gtk_combo_box_entry_new_with_model #}
- (toTreeModel model)
- (fromIntegral textColumn)
+comboBoxEntryNewWithModel model = do
+ combo <- comboBoxEntryNew
+ comboBoxSetModel combo (Just model)
+ return combo
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs.pp 129
---------------------
--- Methods
-
--- | Sets the model column which the entry box should use to get strings from to
--- be @textColumn@.
+-- | Sets the model of 'String's, inserts a 'CellRendererText'.
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs.pp 131
-comboBoxEntrySetTextColumn :: ComboBoxEntryClass self => self
- -> Int -- ^ @textColumn@ - A column in the model to get the strings from.
+comboBoxEntrySetTextModel :: StoreClass model
+ => ComboBoxEntry
+ -> model String -- ^ @model@ - The model of 'String's.
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs.pp 135
-comboBoxEntrySetTextColumn self textColumn =
- {# call gtk_combo_box_entry_set_text_column #}
- (toComboBoxEntry self)
- (fromIntegral textColumn)
+comboBoxEntrySetTextModel self model = do
+ comboBoxSetModel self (Just model)
+ cell <- cellRendererTextNew
+ cellLayoutPackStart self cell True
+ cellLayoutSetAttributes self cell model (\str -> [cellText := Just str])
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs.pp 141
--- | Returns the column which the entry box is using to get the strings from.
---
-comboBoxEntryGetTextColumn :: ComboBoxEntryClass self => self
- -> IO Int -- ^ returns a column in the data source model of the entry box.
-comboBoxEntryGetTextColumn self =
- liftM fromIntegral $
- {# call gtk_combo_box_entry_get_text_column #}
- (toComboBoxEntry self)
-
---------------------
--- Attributes
-
--- | A column in the data source model to get the strings from.
---
--- Allowed values: >= -1
---
--- Default value: -1
---
-comboBoxEntryTextColumn :: ComboBoxEntryClass self => Attr self Int
-comboBoxEntryTextColumn = newAttr
- comboBoxEntryGetTextColumn
- comboBoxEntrySetTextColumn
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellLayout.chs.pp 63
+ cellLayoutSetAttributesM,
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellLayout.chs.pp 84
---instance CellLayoutClass EntryCompletion
+instance CellLayoutClass EntryCompletion
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellLayout.chs.pp 90
-
merger 0.0 (
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellLayout.chs.pp 160
-cellLayoutSetAttributes self cell store attributes = do
- fPtr <- mkSetAttributeFunc $ \_ cellPtr modelPtr iterPtr _ -> do
+cellLayoutSetAttributes self cell model attributes = do
+ fPtr <- mkSetAttributeFunc $ \_ cellPtr' modelPtr' iterPtr _ -> do
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellLayout.chs.pp 160
-cellLayoutSetAttributes self cell store attributes = do
+cellLayoutSetAttributes self cell store attributes =
+ cellLayoutSetAttributesM self cell store (\val -> set cell (attributes val))
+
+-- | Insert a 'CellRenderer' @cell@ into the layout and specify how a
+-- row of the @store@ defines the attributes of this renderer. Setting
+-- the attributes occurs in the IO monad.
+--
+cellLayoutSetAttributesM :: (CellLayoutClass self, CellRendererClass cell,
+ StoreClass store) => self
+ -> cell -- ^ @cell@ - A 'CellRenderer'.
+ -> store a -- ^ @store@ - A store (model) containing rows of type @a@.
+ -> (a -> IO ()) -- ^ Attributes to be set on the renderer.
+ -> IO ()
+cellLayoutSetAttributesM self cell store setAttrs = do
)
merger 0.0 (
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellLayout.chs.pp 170
- val <- storeGetValue store iter
- set cell (attributes val)
+ row <- treeModelGetRow model iter
+ set cell (attributes row)
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellLayout.chs.pp 171
- set cell (attributes val)
+ setAttrs val
)
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellRenderer.chs 93
+
+-- * Signals
+ onEditingStarted,
+ afterEditingStarted
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellRenderer.chs 104
-
+{#import Graphics.UI.Gtk.Signals#}
+{#import Graphics.UI.Gtk.TreeList.TreePath#}
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellRendererCombo.chs.pp 66
- cellComboModel,
- cellComboTextColumn,
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellRendererCombo.chs.pp 67
+
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellRendererCombo.chs.pp 76
+import System.Glib.StoreValue (TMType(TMstring))
+import System.Glib.GObject (constructNewGObject)
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellRendererCombo.chs.pp 87
--- | Creates a new 'CellRendererCombo'. Adjust how text is drawn using object
--- properties. Object properties can be set globally (with 'cellRendererSet').
--- Also, with 'TreeViewColumn', you can bind a property to a value in a
--- 'TreeModel'. For example, you can bind the \"text\" property on the cell
--- renderer to a string value in the model, thus rendering a different string
--- in each row of the 'TreeView'.
+-- | Creates a new 'CellRendererCombo'. This 'Renderer' allows for displaying
+-- a fixed set of options the user can choose from, or, using
+-- 'cellComboHasEntry', allows the user to add new elements. [_$_]
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellRendererCombo.chs.pp 92
-cellRendererComboNew =
- makeNewObject mkCellRendererCombo $
- liftM (castPtr :: Ptr CellRenderer -> Ptr CellRendererCombo) $
- {# call gtk_cell_renderer_combo_new #}
+cellRendererComboNew = do
+ ren <- makeNewObject mkCellRendererCombo $
+ liftM (castPtr :: Ptr CellRenderer -> Ptr CellRendererCombo) $
+ {# call gtk_cell_renderer_combo_new #}
+ -- Create a fake model with one string column in it. The model itself is
+ -- never used.
+ mod <- constructNewGObject mkListStore $
+ withArray [fromIntegral (fromEnum TMstring)] $ \typesArr ->
+ {# call unsafe list_store_newv #} 1 typesArr
+ objectSetPropertyGObject {# call pure unsafe gtk_tree_model_get_type #}
+ "model" ren mod
+ objectSetPropertyInt "text-column" ren 0 [_$_]
+ return ren
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellRendererCombo.chs.pp 109
--- | Holds a tree model containing the possible values for the combo box. Use
--- the text_column property to specify the column holding the values.
---
-cellComboModel :: (CellRendererComboClass self, TreeModelClass treeModel) => ReadWriteAttr self TreeModel treeModel
-cellComboModel = newAttrFromObjectProperty "model"
- {# call pure unsafe gtk_tree_model_get_type #}
-
--- | Specifies the model column which holds the possible values for the combo
--- box. Note that this refers to the model specified in the model property,
--- /not/ the model backing the tree view to which this cell renderer is
--- attached.
---
--- Allowed values: >= -1
---
--- Default value: -1
---
-cellComboTextColumn :: CellRendererComboClass self => Attr self Int
-cellComboTextColumn = newAttrFromIntProperty "text-column"
-
--- | If @True@, the cell renderer will include an entry and allow to enter
+-- | If @True@, the cell renderer will allow the user to enter
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellRendererCombo.chs.pp 116
+
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellRendererText.chs.pp 27
--- Renders text in a cell
+-- A 'CellRenderer' which displays a single-line text.
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellRendererText.chs.pp 62
- cellText,
- cellMarkup,
--- cellAttributes,
- cellTextSingleParagraphMode,
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellView.chs.pp 62
- cellViewSetDisplayedRow,
- cellViewGetDisplayedRow,
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellView.chs.pp 67
- cellViewBackground,
- cellViewDisplayedRow,
+ cellViewBackground
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellView.chs.pp 80
-{#import Graphics.UI.Gtk.TreeList.TreeModel#}
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellView.chs.pp 82
+{#import Graphics.UI.Gtk.TreeList.CustomStore#}
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellView.chs.pp 99
--- makes its show @markup@. The text can text can be marked up with the Pango
+-- makes its show @markup@. The text can be marked up with the Pango
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellView.chs.pp 144
-cellViewSetModel :: (CellViewClass self, TreeModelClass model) => self
- -> Maybe model -- ^ @model@ - a 'TreeModel'
+cellViewSetModel :: (CellViewClass self, StoreClass model) => self
+ -> Maybe (model row) -- ^ @model@ - a 'TreeModel'
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellView.chs.pp 150
- (maybe (TreeModel nullForeignPtr) toTreeModel model)
-
--- | Sets the row of the model that is currently displayed by the 'CellView'.
--- If the path is unset, then the contents of the cellview \"stick\" at their
--- last value; this is not normally a desired result, but may be a needed
--- intermediate state if say, the model for the 'CellView' becomes temporarily
--- empty.
---
-cellViewSetDisplayedRow :: CellViewClass self => self
- -> TreePath -- ^ @path@ - a 'TreePath' or @[]@ to unset.
- -> IO ()
-cellViewSetDisplayedRow self [] =
- {# call gtk_cell_view_set_displayed_row #}
- (toCellView self)
- (NativeTreePath nullPtr)
-cellViewSetDisplayedRow self path =
- withTreePath path $ \path ->
- {# call gtk_cell_view_set_displayed_row #}
- (toCellView self)
- path
-
--- | Returns a 'TreePath' referring to the currently displayed row. If no row
--- is currently displayed, @Nothing@ is returned.
---
-cellViewGetDisplayedRow :: CellViewClass self => self -> IO (Maybe TreePath)
-cellViewGetDisplayedRow self =
- {# call gtk_cell_view_get_displayed_row #}
- (toCellView self)
- >>= \ptr -> if ptr == nullPtr
- then return Nothing
- else liftM Just (fromTreePath ptr)
+ (maybe (TreeModel nullForeignPtr) storeGetModel model)
hunk ./gtk/Graphics/UI/Gtk/TreeList/CellView.chs.pp 197
--- | 'cellViewDisplayedRow' attribute. See 'cellViewGetDisplayedRow' and
--- 'cellViewSetDisplayedRow'
---
-cellViewDisplayedRow :: CellViewClass self => ReadWriteAttr self (Maybe TreePath) TreePath
-cellViewDisplayedRow = newAttr
- cellViewGetDisplayedRow
- cellViewSetDisplayedRow
hunk ./gtk/Graphics/UI/Gtk/TreeList/CustomStore.chs 318
--- be called by models after the child state of a node changes.
+-- be called by models after a node went from having no children to having
+-- at least one child or vice versa.
hunk ./gtk/Graphics/UI/Gtk/TreeList/ListStoreNew.hs.pp 1
+
merger 0.0 (
hunk ./gtk/Graphics/UI/Gtk/TreeList/ListStoreNew.hs.pp 32
-import System.IO ( hPutStr, hPutChar, hFlush, stderr )
-import System.Mem ( performGC )
-
-putStrLn str = hPutStr stderr str >> hPutChar stderr '\n'
-putStr str = hPutStr stderr str
-flush = hFlush stderr
-
-data ListStore a = ListStore {
- model :: TreeModel,
- rows :: IORef (Seq a)
- }
-
-instance StoreClass ListStore where
- storeGetModel = model
- storeGetValue ListStore { rows = rowsRef } (TreeIter _ n _ _) = do
- rows <- readIORef rowsRef
- return (rows `Seq.index` fromIntegral n)
+newtype ListStore a = ListStore (CustomTreeModel (IORef (Seq a)))
hunk ./gtk/Graphics/UI/Gtk/TreeList/ListStoreNew.hs.pp 33
-import System.Mem ( performGC )
)
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeModel.chs.pp 121
- treeModelIterParent,
+ treeModelIterParent
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeModel.chs.pp 369
+
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 31
- treeStoreNew
+ treeStoreNew,
+ treeStoreInsert,
+ treeStoreRemove,
+ treeStoreChange,
+ treeStoreChangeM,
+ treeStoreGet
merger 0.0 (
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 43
+import Control.Monad (liftM)
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 42
-import Data.Maybe ( fromMaybe, isJust )
+import Data.Maybe ( fromMaybe, isJust, fromJust )
+import Data.Tree
+import Control.Monad ( when )
)
merger 0.0 (
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 46
-import System.Glib.FFI ( CInt )
-import Graphics.UI.Gtk.TreeList.TreeModel
+
+import Graphics.UI.Gtk.Types (GObjectClass, TreeModelClass)
+import Graphics.UI.Gtk.TreeList.TreePath (TreePath)
merger 0.0 (
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 44
-import Control.Concurrent.MVar
-
+import Data.IORef
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 46
-import Data.Tree
)
)
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 56
--- | The abstract store for hierarchical data.
+-- | A store for hierarchical data.
merger 0.0 (
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 77
--- | Ask for the time stamp of a 'TreeIter'.
---
-iterTime :: TreeIter -> Timestamp
-iterTime (TreeIter t _ _ _) = t
-
-instance StoreClass TreeStore where
- storeGetModel = model
- storeGetValue TreeStore { store = mVar } iter = modifyMVar mVar $
- \Store { depth = d, timestamp = t, content = cache } ->
- if iterTime iter/=t then
- error "TreeStore.storeGetValue: iter has wrong time stamp" else
+instance TypedTreeModelClass TreeStore where
+ treeModelGetRow (TreeStore store) iter =
+ readIORef (customStoreGetPrivate store) >>=
+ \Store { depth = d, content = cache } ->
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 77
+type Cache a = [(TreeIter, Forest a)]
+
)
merger 0.0 (
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 112
- customStoreGetIter = \path -> readMVar mVar >>=
- \Store { depth = d, timestamp = t } -> return (fromPath t d path),
- customStoreGetPath = \iter -> readMVar mVar >>=
- \store@Store { depth = d, timestamp = t } ->
- return (if iterTime iter/=t then [] else toPath d iter),
- customStoreIterNext = \iter -> modifyMVar mVar $
- \store@Store { depth = d, timestamp = t, content = cache } ->
- let (mIter', cache') = iterNext d iter cache in
- return (if iterTime iter/=t then (store, Nothing) else
- (Store { depth = d, timestamp = t, content = cache' }, mIter')),
- customStoreIterChildren = \mIter -> modifyMVar mVar $
- \store@Store { depth = d, timestamp = t, content = cache } ->
- let iter = fromMaybe (invalidIter t) mIter
- (mIter', cache') = iterNthChild d 0 iter cache in
- return (if iterTime iter/=t then (store, Nothing) else
- (Store { depth = d, timestamp = t, content = cache' }, mIter')),
- customStoreIterHasChild = \iter -> modifyMVar mVar $
- \store@Store { depth = d, timestamp = t, content = cache } ->
- let (mIter', cache') = iterNthChild d 0 iter cache in
- return (if iterTime iter/=t then (store, False) else
- (Store { depth = d, timestamp = t, content = cache' }, isJust mIter')),
- customStoreIterNChildren = \mIter -> modifyMVar mVar $
- \store@Store { depth = d, timestamp = t, content = cache } ->
- let iter = fromMaybe (invalidIter t) mIter
- (no, cache') = iterNChildren d iter cache in
- return (if iterTime iter/=t then (store, 0) else
- (Store { depth = d, timestamp = t, content = cache' }, no)),
- customStoreIterNthChild = \mIter idx -> modifyMVar mVar $
- \store@Store { depth = d, timestamp = t, content = cache } ->
- let iter = fromMaybe (invalidIter t) mIter
- (mIter', cache') = iterNthChild d idx iter cache in
- return (if iterTime iter/=t then (store, Nothing) else
- (Store { depth = d, timestamp = t, content = cache' }, mIter')),
- customStoreIterParent = \iter -> do
- Store { depth = d, timestamp = t } <- readMVar mVar
- return (if iterTime iter/=t then Nothing else iterParent d iter),
+
+ customStoreGetIter = \path -> withStore $
+ \Store { depth = d } -> fromPath d path,
+
+ customStoreGetPath = \iter -> withStore $
+ \Store { depth = d } -> toPath d iter,
+
+ customStoreIterNext = \iter -> withStoreUpdateCache $
+ \Store { depth = d, content = cache } -> iterNext d iter cache,
+
+ customStoreIterChildren = \mIter -> withStoreUpdateCache $
+ \Store { depth = d, content = cache } ->
+ let iter = fromMaybe invalidIter mIter
+ in iterNthChild d 0 iter cache,
+
+ customStoreIterHasChild = \iter -> withStoreUpdateCache $
+ \Store { depth = d, content = cache } ->
+ let (mIter, cache') = iterNthChild d 0 iter cache
+ in (isJust mIter, cache'),
+
+ customStoreIterNChildren = \mIter -> withStoreUpdateCache $
+ \Store { depth = d, content = cache } ->
+ let iter = fromMaybe invalidIter mIter
+ in iterNChildren d iter cache,
+
+ customStoreIterNthChild = \mIter idx -> withStoreUpdateCache $
+ \Store { depth = d, content = cache } ->
+ let iter = fromMaybe invalidIter mIter
+ in iterNthChild d idx iter cache,
+
+ customStoreIterParent = \iter -> withStore $
+ \Store { depth = d } -> iterParent d iter,
+
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 113
- \Store { depth = d, timestamp = t } -> return (fromPath t d path),
+ \Store { depth = d, timestamp = t } -> return (pathToIter t d path),
)
merger 0.0 (
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 228
-fromPath :: Timestamp -> Depth -> TreePath -> Maybe TreeIter
-fromPath t = fP 0 (invalidIter t)
+fromPath :: Depth -> TreePath -> Maybe TreeIter
+fromPath = fP 0 invalidIter
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 228
-fromPath :: Timestamp -> Depth -> TreePath -> Maybe TreeIter
-fromPath t = fP 0 (invalidIter t)
+pathToIter :: Timestamp -> Depth -> TreePath -> Maybe TreeIter
+pathToIter t = fP 0 (invalidIter t)
)
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 237
-type Cache a = [(TreeIter, Forest a)]
-
-
+-- | Convert a path to an iterator.
+--
+fromPath :: Timestamp -> Depth -> TreePath -> TreeIter
+fromPath t d tp = fromJust $ pathToIter t d tp
+[_^I_][_^I_] [_$_]
merger 0.0 (
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 249
-storeToCache :: Timestamp -> Forest a -> Cache a
-storeToCache time [] = []
-storeToCache time forest = [(invalidIter time, [Node root forest])]
+storeToCache :: Forest a -> Cache a
+storeToCache [] = []
+storeToCache forest = [(invalidIter, [Node root forest])]
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 250
-storeToCache time [] = []
)
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreAxel.hs 380
+
+-- | Insert nodes into the store.
+--
+-- * The given list of nodes is inserted into given parent at @pos@.
+-- If the parent existed, the function returns @Just path@ where @path@
+-- is the position of the newly inserted elements. If @pos@ is negative
+-- or greater or equal to the number of children of the node at @path@,
+-- the new nodes are appended to the list.
+--
+treeStoreInsert :: TreeStore a -> TreePath -> Int -> Forest a ->
+ IO (Maybe TreePath)
+treeStoreInsert TreeStore { model = m, store = mVar } path pos nodes = do
+ (paths, toggle) <- modifyMVar mVar $ \store@Store { depth = d,
+ timestamp = t,
+ content = cache } ->
+ return $
+ case insertIntoForest (snd (last cache)) nodes path pos of
+ Nothing -> (store, ([], False))
+ Just (newForest, idx, toggle) ->
+ let depth = calcForestDepth newForest
+ t' = t+1
+ in (Store { depth = depth,
+ timestamp = t',
+ content = storeToCache t' newForest },
+ (map (\idx -> path++[idx]) [idx..idx+length nodes-1], toggle))
+ if null paths then return Nothing else do
+ Store { depth = depth,
+ timestamp = t } <- readMVar mVar
+ mapM_ (\path -> treeModelRowInserted m path (fromPath t depth path)) paths
+ when toggle $ treeModelRowHasChildToggled m path (fromPath t depth path)
+ return (Just (head paths))
+
+-- | Insert nodes into a forest.
+--
+-- * If the parent was found, returns the new tree, the child number
+-- and a flag denoting if these new nodes were the first children
+-- of the parent.
+--
+insertIntoForest :: Forest a -> Forest a -> TreePath -> Int ->
+ Maybe (Forest a, Int, Bool)
+insertIntoForest forest nodes [] pos
+ | pos<0 = Just (forest++nodes, length forest, null forest)
+ | otherwise = Just (prev++nodes++next, length prev, null forest)
+ where (prev, next) = splitAt pos forest
+insertIntoForest forest nodes (p:ps) pos = case splitAt p forest of
+ (prev, []) -> Nothing
+ (prev, Node { rootLabel = val,
+ subForest = for}:next) ->
+ case insertIntoForest for nodes ps pos of
+ Nothing -> Nothing
+ Just (for, pos, toggle) -> Just (prev++Node { rootLabel = val,
+ subForest = for }:next,
+ pos, toggle)
+[_^I_][_^I_][_^I_][_^I_][_^I_] [_$_]
+-- | Remove a node from the store.
+--
+-- * The node denoted by the path is removed, along with all its children.
+-- The function returns @True@ if the given node was found.
+--
+treeStoreRemove :: TreeStore a -> TreePath -> IO Bool
+treeStoreRemove TreeStore { model = m, store = mVar } path = do
+ (found, toggle) <- modifyMVar mVar $ \store@Store { depth = d,
+ timestamp = t,
+ content = cache } ->
+ return $
+ if null cache then (store, (False, False)) else
+ case deleteFromForest (snd (last cache)) path of
+ Nothing -> (store, (False, False))
+ Just (newForest, toggle) ->
+ (Store { depth = d, -- no need to invalidate iters
+ timestamp = t,
+ content = storeToCache t newForest }, (True, toggle))
+ when found $ do
+ when (toggle && not (null path)) $ do
+ Store { depth = depth,
+ timestamp = t } <- readMVar mVar
+ let parent = init path
+ treeModelRowHasChildToggled m parent (fromPath t depth parent)
+ treeModelRowDeleted m path
+ return found
+
+-- | Remove a node from a rose tree.
+--
+-- * Returns the new tree if the node was found. The returned flag is
+-- @True@ if deleting the node left the parent without any children.
+--
+deleteFromForest :: Forest a -> TreePath -> Maybe (Forest a, Bool)
+deleteFromForest forest [] = Just ([], False)
+deleteFromForest forest (p:ps) =
+ case splitAt p forest of
+ (prev, kill@Node { rootLabel = val,
+ subForest = for}:next) ->
+ if null ps then Just (prev++next, null prev && null next) else
+ case deleteFromForest for ps of
+ Nothing -> Nothing
+ Just (for,toggle) -> Just (prev++Node {rootLabel = val,
+ subForest = for }:next, toggle)
+ (prev, []) -> Nothing
+
+
+
+-- | Change a node in the store.
+--
+-- * Returns @True@ if the node was found. For a monadic version, see
+-- 'treeStoreChangeM'.
+--
+treeStoreChange :: TreeStore a -> (a -> a) -> TreePath -> IO Bool
+treeStoreChange store func path = treeStoreChangeM store (return . func) path
+
+
+-- | Change a node in the store.
+--
+-- * Returns @True@ if the node was found. For a purely functional version, see
+-- 'treeStoreChange'.
+--
+treeStoreChangeM :: TreeStore a -> (a -> IO a) -> TreePath -> IO Bool
+treeStoreChangeM TreeStore { model = m, store = mVar } act path = do
+ found <- modifyMVar mVar $ \store@Store { depth = d,
+ timestamp = t,
+ content = cache } -> do
+ mRes <- changeForest (snd (last cache)) act path
+ return $ case mRes of
+ Nothing -> (store, False)
+ Just newForest -> (Store { depth = d,
+ timestamp = t,
+ content = storeToCache t newForest }, True)
+ when found $ do
+ Store { depth = depth,
+ timestamp = t } <- readMVar mVar
+ treeModelRowChanged m path (fromPath t depth path)
+ return found
+
+-- | Change a node in the forest.
+--
+-- * Returns @True@ if the given node was found.
+--
+changeForest :: Forest a -> (a -> IO a) -> TreePath -> IO (Maybe (Forest a))
+changeForest forest act [] = return Nothing
+changeForest forest act (p:ps) = case splitAt p forest of
+ (prev, []) -> return Nothing
+ (prev, Node { rootLabel = val,
+ subForest = for}:next) ->
+ if null ps then do
+ val' <- act val
+ return (Just (prev++Node { rootLabel = val',
+ subForest = for }:next))
+ else do
+ mFor <- changeForest for act ps
+ case mFor of
+ Nothing -> return Nothing
+ Just for -> return $ Just (prev++Node { rootLabel = val,
+ subForest = for }:next)
+
+-- | Extract the current data from the model.
+--
+treeStoreGet :: TreeStore a -> IO (Forest a)
+treeStoreGet TreeStore { store = mVar } = do
+ Store { content = cache } <- readMVar mVar
+ return (if null cache then [] else (snd (last cache)))
+
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeStoreNew.hs.pp 68
- customStoreGetNColumns = return (length rs),
- customStoreGetColumnType = \n -> return $! columnGType (cols Array.! n),
+-- customStoreGetNColumns = return (length rs),
+-- customStoreGetColumnType = \n -> return $! columnGType (cols Array.! n),
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeView.chs.pp 203
-{#import Graphics.UI.Gtk.TreeList.TreeModel#}
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeViewColumn.chs.pp 152
-import Graphics.UI.Gtk.General.Enums (TreeViewColumnSizing(..), SortType(..))
+import Graphics.UI.Gtk.General.Enums (TreeViewColumnSizing(..),
+ SortType(..))
hunk ./tools/hierarchyGen/hierarchy.list 167
-# GtkCellRendererTextPixbuf
+ GtkCellRendererCombo if gtk-2.6
hunk ./tools/hierarchyGen/hierarchy.list 170
- GtkCellRendererCombo if gtk-2.6
hunk ./tools/hierarchyGen/hierarchy.list 171
-# This one is actually an interface, but all objects that implement it are at
-# least GObjects.
+# These are actually interface, but all objects that implement it are at
+# least Widget or GObjects, repectively
+ GtkCellEditable if gtk-2.4
|