1module GUI.BookmarkView ( 2 BookmarkView, 3 bookmarkViewNew, 4 BookmarkViewActions(..), 5 6 bookmarkViewGet, 7 bookmarkViewAdd, 8 bookmarkViewRemove, 9 bookmarkViewClear, 10 bookmarkViewSetLabel, 11 ) where 12 13import GHC.RTS.Events (Timestamp) 14 15import Graphics.UI.Gtk 16import qualified Graphics.UI.Gtk.ModelView.TreeView.Compat as Compat 17import Numeric 18import Data.Text (Text) 19 20--------------------------------------------------------------------------- 21 22-- | Abstract bookmark view object. 23-- 24data BookmarkView = BookmarkView { 25 bookmarkStore :: ListStore (Timestamp, Text) 26 } 27 28-- | The actions to take in response to TraceView events. 29-- 30data BookmarkViewActions = BookmarkViewActions { 31 bookmarkViewAddBookmark :: IO (), 32 bookmarkViewRemoveBookmark :: Int -> IO (), 33 bookmarkViewGotoBookmark :: Timestamp -> IO (), 34 bookmarkViewEditLabel :: Int -> Text -> IO () 35 } 36 37--------------------------------------------------------------------------- 38 39bookmarkViewAdd :: BookmarkView -> Timestamp -> Text -> IO () 40bookmarkViewAdd BookmarkView{bookmarkStore} ts label = do 41 listStoreAppend bookmarkStore (ts, label) 42 return () 43 44bookmarkViewRemove :: BookmarkView -> Int -> IO () 45bookmarkViewRemove BookmarkView{bookmarkStore} n = do 46 listStoreRemove bookmarkStore n 47 return () 48 49bookmarkViewClear :: BookmarkView -> IO () 50bookmarkViewClear BookmarkView{bookmarkStore} = 51 listStoreClear bookmarkStore 52 53bookmarkViewGet :: BookmarkView -> IO [(Timestamp, Text)] 54bookmarkViewGet BookmarkView{bookmarkStore} = 55 listStoreToList bookmarkStore 56 57bookmarkViewSetLabel :: BookmarkView -> Int -> Text -> IO () 58bookmarkViewSetLabel BookmarkView{bookmarkStore} n label = do 59 (ts,_) <- listStoreGetValue bookmarkStore n 60 listStoreSetValue bookmarkStore n (ts, label) 61 62--------------------------------------------------------------------------- 63 64bookmarkViewNew :: Builder -> BookmarkViewActions -> IO BookmarkView 65bookmarkViewNew builder BookmarkViewActions{..} = do 66 67 let getWidget cast name = builderGetObject builder cast name 68 69 --------------------------------------------------------------------------- 70 71 bookmarkTreeView <- getWidget castToTreeView "bookmark_list" 72 bookmarkStore <- listStoreNew [] 73 columnTs <- treeViewColumnNew 74 cellTs <- cellRendererTextNew 75 columnLabel <- treeViewColumnNew 76 cellLabel <- cellRendererTextNew 77 selection <- treeViewGetSelection bookmarkTreeView 78 79 treeViewColumnSetTitle columnTs "Time" 80 treeViewColumnSetTitle columnLabel "Label" 81 treeViewColumnPackStart columnTs cellTs False 82 treeViewColumnPackStart columnLabel cellLabel True 83 treeViewAppendColumn bookmarkTreeView columnTs 84 treeViewAppendColumn bookmarkTreeView columnLabel 85 86 Compat.treeViewSetModel bookmarkTreeView (Just bookmarkStore) 87 88 cellLayoutSetAttributes columnTs cellTs bookmarkStore $ \(ts,_) -> 89 [ cellText := showFFloat (Just 6) (fromIntegral ts / 1000000) "s" ] 90 91 cellLayoutSetAttributes columnLabel cellLabel bookmarkStore $ \(_,label) -> 92 [ cellText := label ] 93 94 --------------------------------------------------------------------------- 95 96 addBookmarkButton <- getWidget castToToolButton "add_bookmark_button" 97 deleteBookmarkButton <- getWidget castToToolButton "delete_bookmark" 98 gotoBookmarkButton <- getWidget castToToolButton "goto_bookmark_button" 99 100 onToolButtonClicked addBookmarkButton $ 101 bookmarkViewAddBookmark 102 103 onToolButtonClicked deleteBookmarkButton $ do 104 selected <- treeSelectionGetSelected selection 105 case selected of 106 Nothing -> return () 107 Just iter -> 108 let pos = listStoreIterToIndex iter 109 in bookmarkViewRemoveBookmark pos 110 111 onToolButtonClicked gotoBookmarkButton $ do 112 selected <- treeSelectionGetSelected selection 113 case selected of 114 Nothing -> return () 115 Just iter -> do 116 let pos = listStoreIterToIndex iter 117 (ts,_) <- listStoreGetValue bookmarkStore pos 118 bookmarkViewGotoBookmark ts 119 120 onRowActivated bookmarkTreeView $ \[pos] _ -> do 121 (ts, _) <- listStoreGetValue bookmarkStore pos 122 bookmarkViewGotoBookmark ts 123 124 set cellLabel [ cellTextEditable := True ] 125 on cellLabel edited $ \[pos] val -> do 126 bookmarkViewEditLabel pos val 127 128 --------------------------------------------------------------------------- 129 130 return BookmarkView{..} 131