1-- a demo that shows how to create a normal tree view and a tree view in
2-- which only a chosen subset of rows are shown (namely those with upper case letters)
3module Main ( main ) where
4
5import Graphics.UI.Gtk
6import Data.List
7import Data.Char
8import Debug.Trace
9
10-- | Define a virtual column of the model that determines the visibility of a row in
11--   the model.
12visCol :: ColumnId String Bool
13visCol = makeColumnIdBool 0
14
15main = do
16  initGUI
17
18  win <- windowNew
19  on win objectDestroy mainQuit
20
21  content <- readFile "FilterDemo.hs"
22
23  -- create a view that shows all lines
24  model <- listStoreNew (lines content)
25  viewAll <- treeViewNewWithModel model
26  col <- treeViewColumnNew
27  ren <- cellRendererTextNew
28  cellLayoutPackStart col ren True
29  cellLayoutSetAttributes col ren model $ \row -> [ cellText := row ]
30  treeViewAppendColumn viewAll col
31
32  -- create a view that only shows lines with upper case characters
33  fModel <- treeModelFilterNew model []
34
35  -- create a virtual column 'visCol' that contains @True@ if a certain row has
36  -- upper case letters. Then set this column to determine the visibility of a row.
37  customStoreSetColumn model visCol (any isUpper)
38  treeModelFilterSetVisibleColumn fModel visCol
39
40{-
41  -- this is an alternative way to determine the visibility of a row. In this case,
42  -- it is not necessary to create the column 'visCol'.
43  treeModelFilterSetVisibleFunc fModel $ Just $ \iter -> do
44     row <- treeModelGetRow model iter
45     return (any isUpper row)
46-}
47  -- note: it is important to insert the model into the view after the visibility
48  -- row or the visibility function have been set. Otherwise, the view is filled
49  -- first and setting a new visibility column/function will not update the view.
50  viewFew <- treeViewNewWithModel fModel
51  col <- treeViewColumnNew
52  ren <- cellRendererTextNew
53  cellLayoutPackStart col ren True
54  cellLayoutSetAttributes col ren model $ \row -> [ cellText := row ]
55
56  treeViewAppendColumn viewFew col
57
58
59
60  box <- vBoxNew False 0
61  swAll <- scrolledWindowNew Nothing Nothing
62  containerAdd swAll viewAll
63  boxPackStart box swAll PackGrow 4
64
65  swFew <- scrolledWindowNew Nothing Nothing
66  containerAdd swFew viewFew
67  boxPackEnd box swFew PackGrow 4
68
69  containerAdd win box
70  widgetShowAll win
71  mainGUI
72