Ticket #1114: Test.hs

File Test.hs, 1.1 kB (added by guest, 7 years ago)
Line 
1import Graphics.UI.Gtk
2import qualified Graphics.UI.Gtk.ModelView as New
3import Data.Char (toLower)
4import Data.List (isPrefixOf)
5
6main =
7    do
8      initGUI
9      window <- windowNew
10      store <- New.listStoreNew ["red","green","magenta"]
11      entry <- entryNew
12      completion <- New.entryCompletionNew
13      New.entryCompletionSetModel completion (Just store)
14      cell <- New.cellRendererTextNew
15      New.cellLayoutPackStart completion cell True
16      New.cellLayoutSetAttributes completion cell store (\str -> [New.cellText := str])
17      New.entryCompletionSetMatchFunc completion (matchFunc store)
18
19      entrySetCompletion entry completion
20      set window [containerChild := entry]
21      widgetShowAll window
22      onDestroy window mainQuit
23      mainGUI
24
25matchFunc :: New.ListStore String -> String -> New.TreeIter -> IO Bool
26matchFunc model str iter = do
27  tp <- New.treeModelGetPath model iter
28  r <- case tp of
29         (i:_) -> do row <- New.listStoreGetValue model i
30                     return $ isPrefixOf (map toLower str) (map toLower row)
31         otherwise -> return False
32  return r