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