1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
import Graphics.UI.Gtk
import Data.Char
import Data.List
import Data.Maybe
data RowInfo = RowInfo { rowString :: String, rowCase :: Maybe Bool }
mkCase Nothing str = str
mkCase (Just False) str = map toLower str
mkCase (Just True) str = map toUpper str
advCase Nothing = Just False
advCase (Just False) = Just True
advCase (Just True) = Nothing
main :: IO ()
main = do
unsafeInitGUIForThreadedRTS
win <- windowNew
win `on` objectDestroy $ mainQuit
content <- readFile "ListText.hs"
model <- listStoreNew (map (\r -> RowInfo r Nothing) (lines content))
view <- treeViewNewWithModel model
-- add a column showing the index
col <- treeViewColumnNew
treeViewAppendColumn view col
cell <- cellRendererTextNew
cellLayoutPackStart col cell True
cellLayoutSetAttributeFunc col cell model $ \(TreeIter _ n _ _) ->
set cell [cellText := show n]
set col [treeViewColumnTitle := "line",
treeViewColumnReorderable := True ]
-- add a column showing the line in the file
col <- treeViewColumnNew
treeViewAppendColumn view col
set col [treeViewColumnTitle := "line in file",
treeViewColumnReorderable := True ]
cell <- cellRendererTextNew
cellLayoutPackStart col cell True
cellLayoutSetAttributes col cell model $
\row -> [cellText := mkCase (rowCase row) (rowString row)]
-- add a column showing if it is forced to a specific case
col <- treeViewColumnNew
treeViewAppendColumn view col
set col [treeViewColumnTitle := "case",
treeViewColumnReorderable := True ]
cell <- cellRendererToggleNew
cellLayoutPackStart col cell True
cellLayoutSetAttributes col cell model $
\row -> [cellToggleActive := fromMaybe False (rowCase row),
cellToggleInconsistent := rowCase row==Nothing]
cell `on` cellToggled $ \tpStr -> do
let [i] = stringToTreePath tpStr
row@RowInfo { rowCase = c } <- listStoreGetValue model i
listStoreSetValue model i row { rowCase = advCase c }
-- to annoy the user: don't allow any columns to be dropped at the far right
treeViewSetColumnDragFunction view $ Just $ \_ rCol _ -> do
return (rCol /= Nothing)
treeViewSetSearchEqualFunc view $ Just $ \str (TreeIter _ n _ _) -> do
row <- listStoreGetValue model (fromIntegral n)
return (map toLower str `isPrefixOf` map toLower (filter isAlphaNum (rowString row)))
swin <- scrolledWindowNew Nothing Nothing
set swin [ containerChild := view ]
set win [ containerChild := swin ]
widgetShowAll win
mainGUI
|
