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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
-- Duncan Coutts 2006-2007
-- Requires gtk2hs 0.9.11
import qualified Data.Map as Map
import System.Directory
import System.Environment
import Control.Concurrent
import Data.IORef
import Control.Monad (liftM)
import Ix (inRange)
import System.INotify
import Graphics.UI.Gtk hiding (TreeModelFlags(TreeModelListOnly), cellText)
import Graphics.UI.Gtk.ModelView.CellLayout
import Graphics.UI.Gtk.ModelView.Types (TypedTreeModelClass)
import Graphics.UI.Gtk.ModelView.TreeModel (TreeModelFlags(TreeModelListOnly))
import Graphics.UI.Gtk.ModelView.CellRendererText (cellText)
import Graphics.UI.Gtk.ModelView.CustomStore
import Graphics.UI.Gtk.TreeList.TreeIter
instance TypedTreeModelClass (CustomTreeModel a)
dirModelNew :: FilePath -> IO (CustomTreeModel () FilePath)
dirModelNew path = do
dirContents <- getDirectoryContents path
rows <- newIORef (Map.fromList (zip dirContents (repeat ())))
model <- customTreeModelNew () CustomTreeModelImplementation {
customTreeModelGetFlags = return [TreeModelListOnly],
customTreeModelGetIter = \[n] -> return (Just (TreeIter 0 (fromIntegral n) 0 0)),
customTreeModelGetPath = \(TreeIter _ n _ _) -> return [fromIntegral n],
customTreeModelGetRow = \(TreeIter _ n _ _) ->
readIORef rows >>= \rows ->
if inRange (0, Map.size rows - 1) (fromIntegral n)
then return (fst $ Map.elemAt (fromIntegral n) rows)
else fail "DirModel.getRow: iter does not refer to a valid entry",
customTreeModelIterNext = \(TreeIter _ n _ _) ->
readIORef rows >>= \rows ->
if n >= fromIntegral (Map.size rows) - 1
then return Nothing
else return (Just (TreeIter 0 (n+1) 0 0)),
customTreeModelIterChildren = \_ -> return Nothing,
customTreeModelIterHasChild = \_ -> return False,
customTreeModelIterNChildren = \index -> readIORef rows >>= \rows ->
case index of
Nothing -> return $! Map.size rows
_ -> return 0,
customTreeModelIterNthChild = \index n -> case index of
Nothing -> return (Just (TreeIter 0 (fromIntegral n) 0 0))
_ -> return Nothing,
customTreeModelIterParent = \_ -> return Nothing,
customTreeModelRefNode = \_ -> return (),
customTreeModelUnrefNode = \_ -> return ()
}
notify <- initINotify
watch <- addWatch notify [Move, Create, Delete] path $ \event ->
let add file = do
index <- atomicModifyIORef rows (\map ->
let map' = Map.insert file () map
in (map', Map.findIndex file map'))
treeModelRowInserted model [index] (TreeIter 0 (fromIntegral index) 0 0)
remove file = do
index <- atomicModifyIORef rows (\map ->
let map' = Map.delete file map
in (map', Map.findIndex file map))
treeModelRowDeleted model [index]
in case event of
MovedIn _ file _ -> add file
MovedOut _ file _ -> remove file
Created _ file -> add file
Deleted _ file -> remove file
_ -> putStrLn $ "other event: " ++ show event
-- TODO: on destroy model (INotify.removeWatch watch)
return model
main = do
initGUI
win <- windowNew
win `onDestroy` mainQuit
args <- getArgs
let dir = case args of
[d] -> d
_ -> "."
model <- dirModelNew dir
tv <- treeViewNewWithModel model
win `containerAdd` tv
tvc <- treeViewColumnNew
treeViewAppendColumn tv tvc
text <- cellRendererTextNew
cellLayoutPackStart tvc text True
cellLayoutSetAttributes tvc text model
(\file -> [cellText := file])
widgetShowAll win
timeoutAddFull (yield >> return True) priorityDefaultIdle 50
mainGUI
|
